Jump to content
Fivewin Brasil

ar-siste

Membros
  • Posts

    164
  • Joined

  • Last visited

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

ar-siste's Achievements

Newbie

Newbie (1/14)

0

Reputation

  1. UP Abraços Arlindo Reis SKYPE: arsistemas E-mail: arsistemas.ar@gmail.com xHarbour 1.2.1 + FWH 12.09 + BCC582 + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  2. Alguém tem Sistema de Cartão Resposta para correção de prova? Abraços Arlindo Reis SKYPE: arsistemas E-mail: arsistemas.ar@gmail.com xHarbour 1.2.1 + FWH 12.09 + BCC582 + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  3. Alguém tem Sistema de Cartão Resposta para correção de prova? Abraços Arlindo Reis SKYPE: arsistemas E-mail: arsistemas.ar@gmail.com xHarbour 1.2.1 + FWH 12.09 + BCC582 + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  4. ar-siste

    TWord

    Boa tarde Rone Resolveu é isso mesmo. Obrigado. Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  5. ar-siste

    TWord

    Alguém pode dar essa força ai? Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  6. ar-siste

    TWord

    Rone Manda pro meu email sua classe talvez a minha seja antiga. arsistemas.ar@gail.com Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  7. ar-siste

    TWord

    Bom dia Rone Obrigado por responder Por favor faça um teste com meu exemplo. Pegue neste link: http://www.arsistemas.com.br/backup/rec.zip Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  8. ar-siste

    TWord

    Local cFile:="recibo.dot" oWord := TWord():New() If ( oWord:IsVisible() ) oWord:Hide() Endif TRY oWord:OpenDoc(cFile) oWord:Replace( "{bruto}", "120,00") oWord:Replace( "{desconto}", "0") oWord:Replace( "{liquido}", "120,00") oWord:Replace( "{recebi}", "Y YAMADA S/A") oWord:Replace( "{quantia1}", "CENTOS E VINTE REAISxxxxxxxxxxxxxxxxxxxxxxxxxxx") oWord:Replace( "{quantia2}", "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") oWord:Replace( "{referente1}", "SERVIÇOS PRESTADOS") oWord:Replace( "{referente2}", "") oWord:Replace( "{referente3}", "") oWord:Replace( "{localidade}", BELÉM(PA), 12 de dezembro de 2012") oWord:Replace( "{empresa}", "AR SISTEMAS R/S") oWord:Replace( "{cnpj}", "99.999.999/0001-99") CATCH oError MsgStop("Erro ao Abrir Gerenciador de Textos.", "Recibo!") Return NIL End oWord:Preview() oWord:Printdoc(.F.) oWord:End() Pessoal este é meu trecho de código para usar a TWord, compilo e não dá nenhum erro, mas, no recibo não sai as informações declaradas, alguém saberia me dizer? Abs, Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  9. ar-siste

    TWord

    Local cFile:="recibo.dot" oWord := TWord():New() If ( oWord:IsVisible() ) oWord:Hide() Endif TRY oWord:OpenDoc(cFile) oWord:Replace( "{bruto}", "120,00") oWord:Replace( "{desconto}", "0") oWord:Replace( "{liquido}", "120,00") oWord:Replace( "{recebi}", "Y YAMADA S/A") oWord:Replace( "{quantia1}", "CENTOS E VINTE REAISxxxxxxxxxxxxxxxxxxxxxxxxxxx") oWord:Replace( "{quantia2}", "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") oWord:Replace( "{referente1}", "SERVIÇOS PRESTADOS") oWord:Replace( "{referente2}", "") oWord:Replace( "{referente3}", "") oWord:Replace( "{localidade}", BELÉM(PA), 12 de dezembro de 2012") oWord:Replace( "{empresa}", "AR SISTEMAS R/S") oWord:Replace( "{cnpj}", "99.999.999/0001-99") CATCH oError MsgStop("Erro ao Abrir Gerenciador de Textos.", "Recibo!") Return NIL End oWord:Preview() oWord:Printdoc(.F.) oWord:End() Pessoal este é meu trecho de código para usar a TWord, compilo e não dá nenhum erro, mas, no recibo não sai as informações declaradas, alguém saberia me dizer? Abs, Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  10. Bom tarde Pessoal, estou com a nova versão do FWH - 12.09 - tentei alterar a RPREVIEW.PRG pra ficar igual a que usava, ela tinha a opção de escolher a impressora, entretanto, as alterações não deram muito certo, quando seleciono uma outra impressora ele dá um erro. Alguém poderia ajudar? A NOVA RPREVIEW.PRG VERSÃO 12.09 É ESTA AI Jà ALTERADA MAIS COM ERRO. #define DEVICE oWnd:cargo #define GO_POS 0 #define GO_UP 1 #define GO_DOWN 2 #define GO_LEFT 1 #define GO_RIGHT 2 #define GO_PAGE .T. #define VSCROLL_RANGE 20 * ::nZFactor #define HSCROLL_RANGE 20 * ::nZFactor #define TXT_FIRST LoadString( GetResources(), 07 ) #define TXT_PREVIOUS LoadString( GetResources(), 08 ) #define TXT_NEXT LoadString( GetResources(), 09 ) #define TXT_LAST LoadString( GetResources(), 10 ) #define TXT_ZOOM LoadString( GetResources(), 11 ) #define TXT_UNZOOM LoadString( GetResources(), 12 ) #define TXT_TWOPAGES LoadString( GetResources(), 13 ) #define TXT_ONEPAGE LoadString( GetResources(), 14 ) #define TXT_PRINT LoadString( GetResources(), 15 ) #define TXT_EXIT LoadString( GetResources(), 16 ) #define TXT_FILE LoadString( GetResources(), 17 ) #define TXT_PAGE LoadString( GetResources(), 18 ) #define TXT_PREVIEW LoadString( GetResources(), 03 ) #define TXT_PAGENUM LoadString( GetResources(), 19 ) #define TXT_A_WINDOW_PREVIEW_IS_ALLREADY_RUNNING ; LoadString( GetResources(), 20 ) #define TXT_GOTO_FIRST_PAGE ; LoadString( GetResources(), 21 ) #define TXT_GOTO_PREVIOUS_PAGE ; LoadString( GetResources(), 22 ) #define TXT_GOTO_NEXT_PAGE ; LoadString( GetResources(), 23 ) #define TXT_GOTO_LAST_PAGE ; LoadString( GetResources(), 24 ) #define TXT_ZOOM_THE_PREVIEW ; LoadString( GetResources(), 25 ) #define TXT_UNZOOM_THE_PREVIEW ; LoadString( GetResources(), 26 ) #define TXT_PREVIEW_ON_TWO_PAGES ; LoadString( GetResources(), 27 ) #define TXT_PREVIEW_ON_ONE_PAGE ; LoadString( GetResources(), 28 ) #define TXT_PRINT_CURRENT_PAGE ; LoadString( GetResources(), 29 ) #define TXT_EXIT_PREVIEW ; LoadString( GetResources(), 30 ) #define TXT_FACTOR ; LoadString( GetResources(), 31 ) #define TXT_ZOOM_FACTOR ; LoadString( GetResources(), 32 ) #define TXT_EXPORT_MSWORD ; LoadString( GetResources(), 33 ) #define MK_MBUTTON 16 //----------------------------------------------------------------------------// static bUserBtns, lRebar, nBtnW, nBtnH static nStyle := nil static oDevice := nil //NOVO //----------------------------------------------------------------------------// CLASS TPreview DATA oWnd, oBar, oFont, oImageList DATA oDevice, oReport DATA oHand, oCursor DATA oMeta1, oMeta2, oSay, oFactor, oSay2 DATA oPage, oTwoPages, oZoom DATA oMenuZoom, oMenuTwoPages, oMenuUnZoom, oMenuOnePage DATA cResFile DATA aFactor, nPage, nZFactor DATA lTwoPages, lZoom, lExit DATA cPageNum DATA hOldRes, hNewRes CLASSDATA cResFile CLASSDATA oWndMain CLASSDATA bPrint, bExportToWord, bSaveAsWord, bSaveAsPDF METHOD New( oDevice ) METHOD Activate() METHOD BuildButtonBar() METHOD BuildWindow() METHOD BuildMenu() METHOD PaintMeta() METHOD NextPage() METHOD PrevPage() METHOD TopPage() METHOD BottomPage() METHOD TwoPages( lMenu ) METHOD Zoom( lMenu ) METHOD VScroll( nType, lPage, nSteps ) METHOD HScroll( nType, lPage, nSteps ) METHOD SetOrg1( nX, nY ) METHOD SetOrg2( nX, nY ) METHOD CheckKey( nKey, nFlags ) METHOD CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) METHOD SetFactor( nValue ) METHOD PrintPage() METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd ) METHOD ExportToMSWord() METHOD SaveAsMenu() METHOD SaveAs( lPDF ) METHOD CheckStyle() PROTECTED ENDCLASS //----------------------------------------------------------------------------// METHOD New( oDevice ) CLASS TPreview if oDevice == nil PRINTER oDevice PREVIEW PAGE ENDPAGE MsgInfo( oDevice:aMeta[ 1 ] ) // ENDPRINTER endif ::oDevice := oDevice ::nPage := 1 ::nZFactor := 1 ::lTwoPages := .F. ::lZoom := .F. ::lExit := .F. ::BuildWindow() return Self //----------------------------------------------------------------------------// METHOD Activate() CLASS TPreview ACTIVATE WINDOW ::oWnd MAXIMIZED ; ON RESIZE ::PaintMeta() ; ON UP ::VScroll( GO_UP ) ; ON DOWN ::VScroll( GO_DOWN ) ; ON PAGEUP ::VScroll( GO_UP, GO_PAGE) ; ON PAGEDOWN ::VScroll( GO_DOWN, GO_PAGE) ; ON LEFT ::HScroll( GO_LEFT ) ; ON RIGHT ::HScroll( GO_RIGHT ) ; ON PAGELEFT ::HScroll( GO_LEFT, GO_PAGE ) ; ON PAGERIGHT ::HScroll( GO_RIGHT, GO_PAGE ) ; VALID ( ::oWnd:oIcon := nil ,; ::oFont:End() ,; ::oMeta1:End() ,; ::oMeta2:End() ,; ::oDevice:End() ,; ::oHand:End() ,; ::oWnd := nil ,; If( Empty( ::oImageList ),, (::oImageList:End(), ::oImageList := nil ) ),; ::lExit := .t. ,; .t. ) if ::oDevice:lPrvModal if ::oWndMain == nil StopUntil( { || ::lExit } ) else StopUntil( { || ::lExit .or. !IsWindow( WndMain():hWnd ) } ) endif endif return nil //----------------------------------------------------------------------------// METHOD BuildButtonBar() CLASS TPreview local oImageList, oReBar, oBar, oHand, uRet DEFINE CURSOR ::oHand HAND if lRebar DEFINE IMAGELIST oImageList SIZE 16, 16 oImageList:AddMasked( TBitmap():Define( "top2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "previous2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "next2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "bottom2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "zoom2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "two_pages2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "printer2",, ::oWnd ), nRGB( 255, 0, 255 ) ) oImageList:AddMasked( TBitmap():Define( "save",, ::oWnd ), nRGB( 255, 0, 255 ) ) oImageList:AddMasked( TBitmap():Define( "word",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "exit2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "unzoom2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "one_page2",, ::oWnd ), nRGB( 192, 192, 192 ) ) ::oImageList = oImageList oReBar = TReBar():New( ::oWnd ) DEFINE TOOLBAR oBar OF oReBar SIZE 25, 25 IMAGELIST oImageList ::oBar = oBar oReBar:InsertBand( oBar ) oBar:nHeight -= 2 DEFINE TBBUTTON OF oBar ; ACTION ::TopPage() ; TOOLTIP Strtran( TXT_FIRST, "&", "" ) ; MESSAGE TXT_GOTO_FIRST_PAGE DEFINE TBBUTTON OF oBar ; ACTION ::PrevPage() ; TOOLTIP Strtran( TXT_PREVIOUS, "&", "" ) ; MESSAGE TXT_GOTO_PREVIOUS_PAGE DEFINE TBBUTTON OF oBar ; ACTION ::NextPage() ; TOOLTIP Strtran( TXT_NEXT, "&", "" ) ; MESSAGE TXT_GOTO_NEXT_PAGE DEFINE TBBUTTON OF oBar ; ACTION ::BottomPage() ; TOOLTIP Strtran( TXT_LAST, "&", "" ) ; MESSAGE TXT_GOTO_LAST_PAGE DEFINE TBSEPARATOR OF oBar DEFINE TBBUTTON OF oBar ; ACTION ::Zoom() ; TOOLTIP Strtran( TXT_ZOOM, "&", "" ) ; MESSAGE TXT_ZOOM_THE_PREVIEW DEFINE TBBUTTON OF oBar ; ACTION ::TwoPages() ; TOOLTIP StrTran( Strtran( TXT_TWOPAGES, "&", "" ), "á", "a" ) ; MESSAGE TXT_PREVIEW_ON_TWO_PAGES DEFINE TBSEPARATOR OF oBar DEFINE TBBUTTON OF oBar ; ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ; TOOLTIP Strtran(TXT_PRINT,"&","") ; MESSAGE TXT_PRINT_CURRENT_PAGE DEFINE TBMENU OF oBar ; ACTION ::SaveAs( .f. ) ; TOOLTIP "SaveAs" ; MESSAGE "Save As Word Document" ; MENU ::SaveAsMenu() DEFINE TBBUTTON OF oBar ; ACTION ::ExportToMSWord() ; TOOLTIP TXT_EXPORT_MSWORD ; MESSAGE TXT_EXPORT_MSWORD DEFINE TBSEPARATOR OF oBar DEFINE TBBUTTON OF oBar ; ACTION ::oWnd:End() ; TOOLTIP Strtran( TXT_EXIT, "&", "" ) ; MESSAGE TXT_EXIT_PREVIEW else /* if oBar != nil .and. oBar:l2007 DEFINE BUTTONBAR oBar SIZE 26, If( LargeFonts(), 30, 26 ) OF ::oWnd 2007 oBar:bPainted = { || oBar:Say( 7, 285+40, "Factor:",,, ::oFont, .T., .T. ),; If( Len( ::oDevice:aMeta ) > 1,; oBar:Say( 7, 380+40, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( ::oDevice:aMeta ) ) ),,, ::oFont, .T., .T. ),; oBar:Say( 7, 380+40, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ),; ,,, ::oFont, .T., .T. ) ) } else DEFINE BUTTONBAR oBar _3D SIZE 26, If( LargeFonts(), 30, 26 ) OF ::oWnd endif */ DEFINE BUTTONBAR oBar _3D SIZE IfNil( nBtnW, 26 ), IfNil( nBtnH, If( LargeFonts(), 30, 26 ) ) OF ::oWnd ::oBar = oBar oBar:l2007 := ( nStyle >= 2007 ) oBar:l97Look := ( nStyle == 97 ) oBar:bRClicked := { || nil } // to retain the bar on top only DEFINE BUTTON RESOURCE "Top2" OF oBar ; MESSAGE TXT_GOTO_FIRST_PAGE ; ACTION ::TopPage() ; TOOLTIP Strtran( TXT_FIRST, "&", "" ) DEFINE BUTTON RESOURCE "Previous2" OF oBar ; MESSAGE TXT_GOTO_PREVIOUS_PAGE ; ACTION ::PrevPage() ; TOOLTIP Strtran( TXT_PREVIOUS, "&", "" ) DEFINE BUTTON RESOURCE "Next2" OF oBar ; MESSAGE TXT_GOTO_NEXT_PAGE ; ACTION ::NextPage() ; TOOLTIP Strtran( TXT_NEXT, "&", "" ) DEFINE BUTTON RESOURCE "Bottom2" OF oBar ; MESSAGE TXT_GOTO_LAST_PAGE ; ACTION ::BottomPage() ; TOOLTIP Strtran( TXT_LAST, "&", "" ) DEFINE BUTTON ::oZoom RESOURCE "Zoom2" OF oBar GROUP ; MESSAGE TXT_ZOOM_THE_PREVIEW ; ACTION ::Zoom() ; TOOLTIP Strtran( TXT_ZOOM, "&", "" ) DEFINE BUTTON ::oTwoPages RESOURCE "Two_Pages2" OF oBar ; MESSAGE TXT_PREVIEW_ON_TWO_PAGES ; ACTION ::TwoPages() ; TOOLTIP Strtran( TXT_TWOPAGES, "&", "" ) DEFINE BUTTON RESOURCE "Printer2" OF oBar GROUP ; MESSAGE TXT_PRINT_CURRENT_PAGE ; ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ; TOOLTIP Strtran( TXT_PRINT, "&", "" ) if ! Empty( bUserBtns ) SetResources( ::hOldRes ) uRet := Eval( bUserBtns, Self, oBar ) SetResources( ::hNewRes ) endif if !( ValType( uRet ) == 'L' .and. uRet == .f. ) DEFINE BUTTON RESOURCE "Save" OF oBar ; MENU ::SaveAsMenu() ; MESSAGE "Save as DOC/PDF" ; ACTION This:ShowPopUp() ; TOOLTIP "Save as Doc/Pdf" DEFINE BUTTON RESOURCE "Word" OF oBar ; MESSAGE TXT_EXPORT_MSWORD ; ACTION ::ExportToMSWord() ; TOOLTIP TXT_EXPORT_MSWORD endif DEFINE BUTTON RESOURCE "Exit2" OF oBar GROUP ; MESSAGE TXT_EXIT_PREVIEW ; ACTION ::oWnd:End() ; TOOLTIP Strtran( TXT_EXIT, "&", "" ) AEval( oBar:aControls, { | o | o:oCursor := ::oHand } ) endif return nil //----------------------------------------------------------------------------// METHOD BuildWindow() CLASS TPreview local oIcon, cTitle := "FiveWin Printing Preview", oCursor, oBar, nCol := 325 local oThis := Self local nRow := 7 // NOVO // ---- local aImpre := aGetPrinters(), oCbx, cCbx := PrnGetName(), cImpre := cCbx // mcn valdenebro // ------------------------------------------------------------------------------------------- DEFAULT ::oWndMain := WndMain() ::hOldRes := GetResources() if ! File( ::cResFile ) #ifdef __CLIPPER__ ::cResFile := "Preview.dll" #else if ! IsWin64() ::cResFile := "Prev32.dll" else ::cResFile = "Prev64.dll" endif #endif endif if SetResources( ::cResFile ) < 32 MsgStop( ::cResFile + " not found, imposible to continue",; "FiveWin Printing Error" ) return nil endif ::hNewRes := GetResources() if ::oDevice != nil cTitle = ::oDevice:cDocument endif if ::oWndMain != nil oIcon = ::oWndMain:oIcon else DEFINE ICON oIcon RESOURCE "Print" endif DEFINE FONT ::oFont NAME GetSysFont() SIZE 0, -12 ::CheckStyle() if !::oDevice:lPrvModal .and. ::oWndMain != nil .and. ; Upper( ::oWndMain:ClassName() ) == "TMDIFRAME" DEFINE WINDOW ::oWnd ; TITLE cTitle ; COLOR CLR_BLACK,CLR_LIGHTGRAY ; ICON oIcon ; VSCROLL HSCROLL MDICHILD else DEFINE WINDOW ::oWnd /*FROM 0, 0 TO 24, 80*/ ; TITLE cTitle ; COLOR CLR_BLACK,CLR_LIGHTGRAY ; ICON oIcon ; VSCROLL HSCROLL MENU ::BuildMenu() endif ::oWnd:SetFont( ::oFont ) ::oWnd:oVScroll:SetRange( 0, 0 ) ::oWnd:oHScroll:SetRange( 0, 0 ) ::cPageNum = TXT_PAGENUM ::BuildButtonBar() /* #ifdef __CLIPPER__ SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ; NOINSET CLOCK DATE KEYBOARD #else if l2007 SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ; NOINSET CLOCK DATE KEYBOARD 2007 else DEFINE STATUSBAR OF ::oWnd PROMPT " " + TXT_PREVIEW endif #endif */ if lRebar DEFINE STATUSBAR OF ::oWnd PROMPT " " + TXT_PREVIEW else SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ; NOINSET CLOCK DATE KEYBOARD ::oWnd:oMsgBar:l2007 := ( nStyle == 2007 ) ::oWnd:oMsgBar:l2010 := ( nStyle == 2010 ) endif ::oMeta1 := TMetaFile():New( 0, 0, 0, 0,; ::oDevice:aMeta[ 1 ],; ::oWnd,; CLR_BLACK,; CLR_WHITE,; ::oDevice:nHorzRes(),; ::oDevice:nVertRes() ) if ! IsWin64() DEFINE CURSOR ::oCursor RESOURCE "LUPA" else DEFINE CURSOR ::oCursor RESOURCE "search" endif ::oMeta1:oCursor := ::oCursor ::oMeta1:blDblClick := { | nRow, nCol, nKeyFlags | ; ::SetOrg1( nCol, nRow, nKeyFlags ) } ::oMeta1:bKeyDown := { | nKey, nFlags | ::CheckKey( nKey, nFlags ) } ::oMeta1:bMouseWheel := { | nKeys, nDelta, nXPos, nYPos | ; ::CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) } #ifndef __XPP__ // XBPP bug. Warning: don't change this into #ifdef __CLIPPER__ ::oMeta2 := TMetaFile():New( 0, 0, 0, 0, "",; ::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),; ::oDevice:nVertRes() ) #else ::oMeta2 := TMetaFile():New():_New( 0, 0, 0, 0, "",; ::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),; ::oDevice:nVertRes() ) #endif ::oMeta2:oCursor = ::oCursor ::oMeta2:blDblClick := { | nRow, nCol, nKeyFlags | ; ::SetOrg2( nCol, nRow, nKeyFlags ) } ::oMeta2:hide() ::SetFactor() oBar := ::oBar if !lRebar nCol := ATail( oBar:aControls ):nRight + 30 nRow := Int( oBar:nHeight / 2 ) - 6 endif if nStyle >= 2007 oBar:bPainted = { || oBar:Say( nRow, nCol, "Fator:",,, ::oFont, .T., .T. ),; If( Len( ::oDevice:aMeta ) > 1,; oBar:Say( nRow, nCol+100, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( ::oDevice:aMeta ) ) ),,, ::oFont, .T., .T. ),; oBar:Say( nRow, nCol+100, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ),; ,,, ::oFont, .T., .T. ) ) } endif if nStyle < 2007 @ nRow, nCol SAY ::oSay PROMPT "Fator:" ; SIZE 45, 15 PIXEL OF ::oBar FONT ::oFont ::oSay:lTransparent = .T. endif @ nRow-4, nCol+40 COMBOBOX ::oFactor VAR ::nZFactor ; ITEMS { "1", "2", "3", "4", "5", "6", "7", "8", "9" } ; OF ::oBar FONT ::oFont PIXEL SIZE 35,200 ; ON CHANGE oThis:SetFactor( oThis:nZFactor ) if nStyle < 2007 if Len( ::oDevice:aMeta ) > 1 @ nRow, nCol+100 SAY ::oPage PROMPT TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( ::oDevice:aMeta ) ) ) ; SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont else @ nRow, nCol + 100 SAY ::oPage PROMPT TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) ; SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont endif ::oPage:lTransparent = .T. endif // --------------------------------------------------- // NOVO: exibir impressora para impressao Arlindo Reis //------------------------------------------------ //if nStyle >= 2007 // oBar:bPainted = { || oBar:Say( nRow, nCol+340, "Impressora:",,, ::oFont, .T., .T. )} //endif @ nRow-4, nCol+250 COMBOBOX oCbx VAR cCbx ; PROMPTS aImpre; OF ::oBar FONT ::oFont PIXEL SIZE 310,200 ; ON CHANGE F_CamImpre( oDevice, cCbx ) //---------- F I M ------------------------------- //------------------------------------------------ // if IsAppThemed() .or. l2007 if lRebar .or. nStyle >= 2007 #define NULL_BRUSH 5 FixSays( ::oBar:hWnd, GetStockObject( NULL_BRUSH ) ) endif #ifndef __XPP__ ::oFactor:Set3dLook( .T. ) #endif SetResources( ::hOldRes ) ::oWnd:oHScroll:bPos := { | nPos | ::HScroll( GO_POS, .f., nPos ) } ::oWnd:oVScroll:bPos := { | nPos | ::VScroll( GO_POS, .f., nPos ) } return nil //----------------------------------------------------------------------------// METHOD BuildMenu() CLASS TPreview local nFor, oMenu local lThemed := IsAppThemed() local cPrinter := If( lThemed, "Printer2", "Printer" ) local cTop := If( lThemed, "Top2", "Top" ) local cPrevious := If( lThemed, "Previous2", "Previous" ) local cNext := If( lThemed, "Next2", "Next" ) local cBottom := If( lThemed, "Bottom2", "Bottom" ) local cZoom := If( lThemed, "Zoom2", "Zoom" ) local cUnZoom := If( lThemed, "UnZoom2", "UnZoom" ) local cOne_Page := If( lThemed, "One_page2", "One_page" ) local cTwo_Pages := If( lThemed, "Two_pages2", "Two_pages" ) local cExit := If( lThemed, "Exit2", "Exit" ) ::aFactor := Array( 9 ) MENU oMenu oMenu:l2007 := ( nStyle == 2007 ) oMenu:l2010 := ( nStyle == 2010 ) MENUITEM TXT_FILE MENU MENUITEM TXT_PRINT ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ; MESSAGE TXT_PRINT_CURRENT_PAGE RESOURCE cPrinter SEPARATOR MENUITEM TXT_EXIT ACTION ::oWnd:End() ; MESSAGE TXT_EXIT_PREVIEW RESOURCE cExit ENDMENU MENUITEM TXT_PAGE MENU MENUITEM TXT_FIRST ACTION ::TopPage() ; MESSAGE TXT_GOTO_FIRST_PAGE RESOURCE cTop MENUITEM TXT_PREVIOUS ACTION ::PrevPage() ; MESSAGE TXT_GOTO_PREVIOUS_PAGE RESOURCE cPrevious MENUITEM TXT_NEXT ACTION ::NextPage() ; MESSAGE TXT_GOTO_NEXT_PAGE RESOURCE cNext MENUITEM TXT_LAST ACTION ::BottomPage() ; MESSAGE TXT_GOTO_LAST_PAGE RESOURCE cBottom SEPARATOR MENUITEM ::oMenuZoom PROMPT TXT_ZOOM ACTION ::Zoom( .T. ) ; MESSAGE TXT_ZOOM_THE_PREVIEW RESOURCE cZoom MENUITEM ::oMenuUnZoom PROMPT TXT_UNZOOM ACTION ::Zoom( .T. ) ; MESSAGE TXT_UNZOOM_THE_PREVIEW RESOURCE cUnZoom MENUITEM "&Fator" MESSAGE TXT_ZOOM_FACTOR MENU for nFor := 1 to Len( ::aFactor ) MENUITEM ::aFactor[ nFor ] ; PROMPT "&" + LTrim( Str( nFor ) ) ; MESSAGE "Fator " + LTrim( Str( nFor ) ) ; ACTION ( ::oFactor:Set( oMenuItem:nHelpId ),; Eval( ::oFactor:bChange ) ) next ENDMENU SEPARATOR MENUITEM ::oMenuTwoPages PROMPT TXT_TWOPAGES ACTION ::TwoPages( .T. ) ; ENABLED ; MESSAGE TXT_PREVIEW_ON_TWO_PAGES RESOURCE cTwo_Pages MENUITEM ::oMenuOnePage PROMPT TXT_ONEPAGE ACTION ::TwoPages(.T.) ; MESSAGE TXT_PREVIEW_ON_ONE_PAGE RESOURCE cOne_Page ENDMENU ENDMENU ::oMenuUnZoom:Disable() ::oMenuOnePage:Disable() return oMenu //----------------------------------------------------------------------------// METHOD CheckStyle() CLASS TPreview local o if nStyle == nil nStyle := 0 DEFAULT ::oWndMain := WndMain() if ::oWndMain != nil if ( o := ::oWndMain:oMenu ) != nil nStyle := Max( nStyle, If( o:l2010, 2010, 0 ) ) endif if nStyle < 2010 .and. ( o := ::oWndMain:oMsgBar ) != nil nStyle := Max( nStyle, If( o:l2010, 2010, If( o:l2007, 2007, 0 ) ) ) endif if nStyle < 2010 .and. ( o := ::oWndMain:oTop ) != nil if o:IsKindOf( "TRIBBONBAR" ) nStyle := Max( nStyle, If( o:l2010, 2010, 2007 ) ) elseif o:IsKindOf( "TBAR" ) nStyle := Max( nStyle, If( o:l2007, 2007, 0 ) ) if Empty( nStyle ) .and. Len( o:aControls ) > 0 .and. o:aControls[ 1 ]:l97look nStyle := 97 endif endif endif endif endif lRebar := ( IsAppThemed() .and. Empty( nStyle ) .and. bUserBtns == nil .and. nBtnW == nil .and. nBtnH == nil ) return Self //----------------------------------------------------------------------------// METHOD PaintMeta() CLASS TPreview local oRect, oRect1, oRect2 local aFiles := ::oDevice:aMeta // DEVICE local nWidth, nHeight, nMaxWidth, nAspect, nMetaWidth, nGutter if ::oWnd != nil if IsIconic( ::oWnd:hWnd ) return nil endif oRect := ::oWnd:GetCliRect() oRect:nTop += ( ::oBar:nHeight + 4 ) oRect:nBottom -= ( IfNil( ::oWnd:oMsgBar, ::oWnd:oBottom ):nHeight + 4 + 5 ) // 5 shadow depth nMaxWidth := oRect:nWidth * If( ::lTwoPages, 0.40, 0.95 ) nGutter := oRect:nWidth * 0.05 nAspect := ::oDevice:nHorzSize() / ::oDevice:nVertSize() nMetaWidth := If( ::lZoom, nMaxWidth, oRect:nHeight * nAspect ) nHeight := oRect:nHeight if nMetaWidth > nMaxWidth nMetaWidth := nMaxWidth nHeight := nMetaWidth / nAspect endif if ::lTwoPages oRect1 := OClone( oRect ) WITH OBJECT oRect1 :nTop += ( oRect:nHeight - nHeight ) / 2 :nLeft := oRect:nLeft + oRect:nWidth / 2 - nMetaWidth - nGutter :nWidth := nMetaWidth :nHeight := nHeight END oRect2 := OClone( oRect1 ) WITH OBJECT oRect2 :nLeft := oRect:nLeft + oRect:nWidth / 2 + nGutter :nWidth := nMetaWidth END if ::nPage == Len( aFiles ) ::oMeta2:SetFile( "" ) else ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) endif ::oMeta1:SetCoors( oRect1 ) ::oMeta2:SetCoors( oRect2 ) ::oMeta1:Refresh() ::oMeta2:Show() else oRect1 := OClone( oRect ) WITH OBJECT oRect1 :nTop += ( oRect:nHeight - nHeight ) / 2 :nLeft += ( oRect:nWidth - nMetaWidth ) / 2 :nWidth := nMetaWidth :nHeight := nHeight END ::oMeta2:Hide() ::oMeta1:SetCoors( oRect1 ) ::oMeta1:Refresh() endif ::oMeta1:SetFocus() endif return nil //----------------------------------------------------------------------------// METHOD NextPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage >= Len( aFiles ) MsgBeep() return nil endif ::nPage++ SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages if Len( aFiles ) >= ::nPage + 1 ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) else ::oMeta2:SetFile( "" ) endif ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD PrevPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage == 1 MsgBeep() return nil endif ::nPage-- SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages if Len( aFiles ) >= ::nPage + 1 ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) else ::oMeta2:SetFile( "" ) endif ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD TopPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage == 1 MsgBeep() return nil endif ::nPage = 1 SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages if Len( aFiles ) >= ::nPage + 1 ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) else ::oMeta2:SetFile( "" ) endif ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD BottomPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage == Len( aFiles ) MsgBeep() return nil endif ::nPage = Len( aFiles ) SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages ::oMeta2:SetFile( "" ) ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD TwoPages( lMenu ) CLASS TPreview local hOldRes := GetResources() SET RESOURCES TO ::cResFile DEFAULT lMenu := .F. ::lTwoPages := ! ::lTwoPages if ::lTwoPages if Len( ::oDevice:aMeta) == 1 // solo hay una pagina // DEVICE ::lTwoPages := ! ::lTwoPages MsgBeep() SetResources( hOldRes ) return nil endif if ::oDevice:nHorzSize() >= ; // Apaisado // DEVICE ::oDevice:nVertSize() // DEVICE ::lTwoPages := ! ::lTwoPages MsgBeep() SetResources( hOldRes ) return nil endif if ::lZoom ::Zoom( .T. ) endif if ! lRebar ::oTwoPages:FreeBitmaps() ::oTwoPages:LoadBitmaps( "One_Page2" ) ::oTwoPages:cMsg := TXT_PREVIEW_ON_ONE_PAGE ::oTwoPages:cTooltip := StrTran( TXT_ONEPAGE, "&", "" ) else ::oBar:ChangeBitmap( 6, 10+2 ) ::oBar:SetTooltip( 6, StrTran( TXT_ONEPAGE, "&", "" ) ) ::oBar:SetMessage( 6, TXT_PREVIEW_ON_ONE_PAGE ) endif if ::oWnd:oMenu != nil ::oMenuTwoPages:Disable() ::oMenuOnePage:Enable() endif else if ! lRebar ::oTwoPages:FreeBitmaps() ::oTwoPages:LoadBitmaps( "Two_Pages2" ) ::oTwoPages:cMsg := TXT_PREVIEW_ON_TWO_PAGES ::oTwoPages:cTooltip := StrTran( TXT_TWOPAGES, "&", "" ) else ::oBar:ChangeBitmap( 6, 6 ) ::oBar:SetTooltip( 6, StrTran( TXT_TWOPAGES, "&", "" ) ) ::oBar:SetMessage( 6, TXT_PREVIEW_ON_TWO_PAGES ) endif if ::oWnd:oMenu != nil ::oMenuTwoPages:Enable() ::oMenuOnePage:Disable() endif endif if lMenu .and. ! IsAppThemed() ::oTwoPages:Refresh() endif ::oWnd:Refresh() ::PaintMeta() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD Zoom( lMenu ) CLASS TPreview local hOldRes := GetResources() SET RESOURCES TO ::cResFile DEFAULT lMenu := .F. ::lZoom := ! ::lZoom if ::lZoom if ::lTwoPages ::TwoPages( .T. ) endif if ! lRebar ::oZoom:FreeBitmaps() ::oZoom:LoadBitmaps( "Unzoom2" ) ::oZoom:cMsg := TXT_UNZOOM_THE_PREVIEW ::oZoom:cTooltip := StrTran( TXT_UNZOOM, "&", "" ) else ::oBar:ChangeBitmap( 5, 9+2 ) ::oBar:SetTooltip( 5, StrTran( TXT_UNZOOM, "&", "" ) ) ::oBar:SetMessage( 5, TXT_UNZOOM_THE_PREVIEW ) endif if ::oWnd:oMenu != nil ::oMenuZoom:Disable() ::oMenuUnZoom:Enable() endif ::oWnd:oVScroll:SetRange( 1, VSCROLL_RANGE ) if ::nZFactor > 1 ::oWnd:oHScroll:SetRange( 1, HSCROLL_RANGE ) endif ::oMeta1:ZoomIn() else if ! lRebar ::oZoom:FreeBitmaps() ::oZoom:LoadBitmaps( "Zoom2" ) ::oZoom:cMsg := TXT_ZOOM_THE_PREVIEW ::oZoom:cTooltip := StrTran( TXT_ZOOM, "&", "" ) else ::oBar:ChangeBitmap( 5, 5 ) ::oBar:SetTooltip( 5, StrTran( TXT_ZOOM, "&", "" ) ) ::oBar:SetMessage( 5, TXT_ZOOM_THE_PREVIEW ) endif if ::oWnd:oMenu != nil ::oMenuZoom:Enable() ::oMenuUnZoom:Disable() endif ::oWnd:oVScroll:SetRange( 0, 0 ) ::oWnd:oHScroll:SetRange( 0, 0 ) ::oMeta1:ZoomOut() ::nZFactor = 1 if ::oWnd:oMenu != nil AEval( ::aFactor, { | val, elem | val:SetCheck( ( elem == 1 ) ) } ) endif ::oFactor:Set( 1 ) endif if lMenu .and. ! IsAppThemed() ::oZoom:Refresh() endif ::oWnd:Refresh() // Fix for clearing shadows when unzoomed .. fwh 11.5 ::PaintMeta() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD VScroll( nType, lPage, nSteps ) CLASS TPreview local nYfactor, nYorig, nStep DEFAULT lPage := .F. if nType == GO_UP if ::oWnd:oVScroll:GetPos() <= ::oWnd:oVScroll:nMin return nil endif else if ::oWnd:oVScroll:GetPos() > ::oWnd:oVScroll:nMax return nil endif endif nYfactor := Int( ::oDevice:nVertRes() / ::oWnd:oVScroll:nMax ) // DEVICE if nSteps != nil nStep := nSteps elseif lPage nStep := ::oWnd:oVScroll:nMax / 10 else nStep := 1 endif if nType == GO_UP nStep := -nStep elseif nType == GO_POS ::oWnd:oVscroll:SetPos( nSteps ) nStep := 0 endif nYorig := nYfactor * ( ::oWnd:oVScroll:GetPos() + nStep - 1 ) if nYorig > ::oDevice:nVertRes() // DEVICE nYorig := ::oDevice:nVertRes() // DEVICE endif if nYorig < 0 nYorig := 0 endif #ifdef __CLIPPER__ ::oMeta1:SetOrg( nil, nYorig ) #else ::oMeta1:SetOrg( nil, nYorig / ::oDevice:nVertRes() * 10 ) // DEVICE #endif ::oMeta1:Refresh() return nil //----------------------------------------------------------------------------// METHOD HScroll( nType, lPage, nSteps ) CLASS TPreview local nXfactor, nXorig, nStep DEFAULT lPage := .F. if nType == GO_UP if ::oWnd:oHScroll:GetPos() <= ::oWnd:oHScroll:nMin return nil endif else if ::oWnd:oHScroll:GetPos() > ::oWnd:oHScroll:nMax return nil endif endif nXfactor := Int( ::oDevice:nHorzRes() / ::oWnd:oHScroll:nMax ) // DEVICE if nSteps != nil nStep := nSteps elseif lPage nStep := ::oWnd:oHScroll:nMax/10 else nStep := 1 endif if nType == GO_LEFT nStep := -nStep elseif nType == GO_POS ::oWnd:oHscroll:SetPos( nSteps ) nStep := 0 endif nXorig := nXfactor * ( ::oWnd:oHScroll:GetPos() + nStep - 1 ) if nXorig > ::oDevice:nHorzRes() // DEVICE nXorig := ::oDevice:nHorzRes() // DEVICE endif if nXorig < 0 nXorig := 0 endif #ifdef __CLIPPER__ ::oMeta1:SetOrg( nXorig, nil ) #else ::oMeta1:SetOrg( nXorig / ::oDevice:nHorzRes() * 10, nil ) // DEVICE #endif ::oMeta1:Refresh() return nil //----------------------------------------------------------------------------// METHOD SetOrg1( nX, nY ) CLASS TPreview local oCoors local nXStep, nYStep, nXFactor, nYFactor,; nWidth, nHeight, nXOrg if ::lZoom ::Zoom( .T. ) return nil endif oCoors := ::oMeta1:GetRect() nWidth := oCoors:nRight - oCoors:nLeft + 1 nHeight := oCoors:nBottom - oCoors:nTop + 1 if .f. nXStep := Max( Int( nX / nWidth * HSCROLL_RANGE ) - 9, 0 ) nXFactor := Int( ::oDevice:nHorzRes() / HSCROLL_RANGE ) // DEVICE endif if .f. nYStep := Max( Int( nY / nHeight * VSCROLL_RANGE ) - 9, 0 ) nYFactor := Int( ::oDevice:nVertRes() / VSCROLL_RANGE ) // DEVICE endif ::Zoom( .T. ) if ! Empty( nXStep ) ::HScroll( 2,, nxStep ) ::oWnd:oHScroll:SetPos( nxStep ) endif if ! Empty( nYStep ) ::VScroll( 2,, nyStep ) ::oWnd:oVScroll:SetPos( nyStep ) endif return nil //----------------------------------------------------------------------------// METHOD SetOrg2( nX, nY ) CLASS TPreview local oCoors local aFiles local nXStep, nYStep, nXFactor, nYFactor,; nWidth, nHeight, nXOrg if ::oMeta2:cCaption == "" return nil endif if ::lZoom ::Zoom( .T. ) return nil endif oCoors := ::oMeta2:GetRect() nWidth := oCoors:nRight - oCoors:nLeft + 1 nHeight := oCoors:nBottom - oCoors:nTop + 1 if .f. nXStep := Max( Int( nX / nWidth * HSCROLL_RANGE ) - 9, 0 ) nXFactor := Int( ::oDevice:nHorzRes() / HSCROLL_RANGE ) endif if .f. nYStep := Max( Int( nY / nHeight * VSCROLL_RANGE ) - 9, 0 ) nYFactor := Int( ::oDevice:nVertRes() / VSCROLL_RANGE ) // DEVICE endif ::oMeta1:SetFile( ::oMeta2:cCaption ) aFiles := ::oDevice:aMeta // DEVICE if ::nPage = Len( aFiles ) ::oMeta2:SetFile( "" ) else ::oMeta2:SetFile( aFiles[ ++::nPage ] ) endif if nStyle < 2007 ::oPage:Refresh() endif ::oBar:Refresh() ::Zoom( .T. ) if ! Empty( nXStep ) ::HScroll( 2,, nxStep ) ::oWnd:oHScroll:SetPos( nxStep ) endif if ! Empty( nYStep ) ::VScroll( 2,, nyStep ) ::oWnd:oVScroll:SetPos( nyStep ) endif return nil //----------------------------------------------------------------------------// METHOD CheckKey( nKey, nFlags ) CLASS TPreview if ! ::lZoom do case case nKey == VK_HOME ::TopPage() case nKey == VK_END ::BottomPage() case nKey == VK_PRIOR ::PrevPage() case nKey == VK_NEXT ::NextPage() endcase else do case case nKey == VK_UP ::oWnd:oVScroll:GoUp() case nKey == VK_PRIOR ::oWnd:oVScroll:PageUp() case nKey == VK_DOWN ::oWnd:oVScroll:GoDown() case nKey == VK_NEXT ::oWnd:oVScroll:PageDown() case nKey == VK_LEFT ::oWnd:oHScroll:GoUp() case nKey == VK_RIGHT if ::oWnd:oHScroll != nil .and. ::oWnd:oHScroll:nMax > 0 ::oWnd:oHScroll:GoDown() endif case nKey == VK_HOME ::oWnd:oVScroll:GoTop() ::oWnd:oHScroll:GoTop() ::oMeta1:SetOrg( 0, 0 ) ::oMeta1:Refresh() case nKey == VK_END ::oWnd:oVScroll:GoBottom() ::oWnd:oHScroll:GoBottom() ::oMeta1:SetOrg( .8 * ::oDevice:nHorzRes(), .8 * ::oDevice:nVertRes() ) // DEVICE ::oMeta1:Refresh() endcase endif return nil //----------------------------------------------------------------------------// METHOD CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) CLASS TPreview if ! ::lZoom if lAnd( nKeys, MK_MBUTTON ) if nDelta > 0 ::TopPage() else ::BottomPage() endif else if nDelta > 0 ::PrevPage() else ::NextPage() endif endif else if lAnd( nKeys, MK_MBUTTON ) if nDelta > 0 if ::oWnd:oVScroll:GetPos() > ::oWnd:oVScroll:nMin ::oWnd:oVScroll:PageUp() endif else if ::oWnd:oVScroll:GetPos() < ::oWnd:oVScroll:nMax ::oWnd:oVScroll:PageDown() endif endif else if nDelta > 0 if ::oWnd:oVScroll:GetPos() > ::oWnd:oVScroll:nMin ::oWnd:oVScroll:GoUp() endif else if ::oWnd:oVScroll:GetPos() < ::oWnd:oVScroll:nMax ::oWnd:oVScroll:GoDown() endif endif endif endif return nil //----------------------------------------------------------------------------// METHOD SetFactor( nValue ) CLASS TPreview local lInit := .F. if nValue == nil .and. ::oWnd:oMenu != nil AEval( ::aFactor, { | v, e | v:nHelpId := e } ) nValue := ::nZFactor lInit := .T. endif if ::oWnd:oMenu != nil AEval( ::aFactor, { | val, elem | val:SetCheck( elem == nValue ) } ) endif ::oMeta1:SetZoomFactor( ::nZFactor, ::nZFactor * 2 ) if ! ::lZoom .and. ! lInit // ::Zoom( .T. ) --> Fix from 12.05 to 12.06 endif if ::lZoom ::oWnd:oVScroll:SetRange( 1, VSCROLL_RANGE ) if ::nZFactor > 1 ::oWnd:oHScroll:SetRange( 1, HSCROLL_RANGE ) else ::oWnd:oHScroll:SetRange( 0, 0 ) endif endif ::oMeta1:SetFocus() return nil //----------------------------------------------------------------------------// METHOD PrintPage() CLASS TPreview local hOldRes := GetResources() local hMeta := ::oMeta1:hMeta local oDlg, oRad, oPageIni, oPageFin local nOption := 1, nFirst := 1, nLast := Len( ::oDevice:aMeta ) // DEVICE local oThis := Self if nLast == 1 ::PrintPrv( nil, nOption, nFirst, nLast ) return nil endif SET RESOURCES TO ::cResFile DEFINE DIALOG oDlg RESOURCE "PRINT" REDEFINE BUTTON ID 101 OF oDlg ; ACTION oThis:PrintPrv( oDlg, nOption, nFirst, nLast ) REDEFINE BUTTON ID 102 OF oDlg ACTION oDlg:End() REDEFINE RADIO oRad VAR nOption ID 103, 104, 105 OF oDlg ; ON CHANGE If( nOption==3 ,; ( oPageIni:Enable(), oPageFin:Enable() ),; ( oPageIni:Disable(), oPageFin:Disable() ) ) REDEFINE GET oPageIni ; VAR nFirst ID 106 PICTURE "@K 99999" ; VALID If( nFirst < 1 .or. nFirst > nLast, ( MsgBeep(), .F. ), .T. ) ; OF oDlg REDEFINE GET oPageFin ; VAR nLast ID 107 PICTURE "@K 99999" ; VALID If( nLast < nFirst .or. nLast > Len( ::oDevice:aMeta ), ; // DEVICE ( MsgBeep(),.F. ), .T.) OF oDlg oPageIni:Disable() oPageFin:Disable() SetResources( hOldRes ) ACTIVATE DIALOG oDlg return nil //----------------------------------------------------------------------------// METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd ) CLASS TPreview local oDevice := ::oDevice // DEVICE local aFiles := oDevice:aMeta local hMeta := ::oMeta1:hMeta local nFor CursorWait() StartDoc( oDevice:hDC, oDevice:cDocument ) do case case nOption == 1 // All for nFor := 1 to Len( aFiles ) #ifdef __CLIPPER__ StartPage( oDevice:hDC ) hMeta := GetMetaFile( aFiles[ nFor ] ) PlayMetaFile( oDevice:hDC, hMeta ) DeleteMetafile( hMeta ) EndPage( oDevice:hDC ) #else StartPage( oDevice:hDC ) hMeta := GetEnhMetaFile( aFiles[ nFor ] ) PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. ) DeleteEnhMetafile( hMeta ) EndPage( oDevice:hDC ) #endif next case nOption == 2 // Current page StartPage( oDevice:hDC ) hMeta := ::oMeta1:hMeta #ifdef __CLIPPER__ PlayMetaFile( oDevice:hDC, hMeta ) #else PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. ) #endif EndPage( oDevice:hDC ) case nOption == 3 // Range for nFor := nPageIni to nPageEnd StartPage( oDevice:hDC ) #ifdef __CLIPPER__ hMeta := GetMetaFile( aFiles[ nFor ] ) PlayMetaFile( oDevice:hDC, hMeta ) DeleteMetafile( hMeta ) #else hMeta := GetEnhMetaFile( aFiles[ nFor ] ) PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. ) DeleteEnhMetafile( hMeta ) #endif EndPage( oDevice:hDC ) next endcase EndDoc( oDevice:hDC ) CursorArrow() if oDlg != nil oDlg:End() endif return nil //----------------------------------------------------------------------------// METHOD ExportToMSWord() CLASS TPreview local oDoc if ValType( ::bExportToWord ) == 'B' return Eval( ::bExportToWord, Self ) endif oDoc := ConvertToWordDoc( Self ) if oDoc != nil oDoc:Application:Visible := .t. endif return Self //----------------------------------------------------------------------------// METHOD SaveAsMenu() CLASS TPreview local oPop MENU oPop POPUP oPop:l2007 := ( nStyle == 2007 ) oPop:l2010 := ( nStyle == 2010 ) MENUITEM "DOC Format" RESOURCE "Word" ACTION ::SaveAs( .f. ) MENUITEM "PDF Format" RESOURCE "PDF" ACTION ::SaveAs( .t. ) ENDMENU return oPop //----------------------------------------------------------------------------// METHOD SaveAs( lPDF ) CLASS TPreview local oWord, nVer, oDoc local cFile, cExt, cMsg, lView if lPDF if ValType( ::bSaveAsPDF ) == 'B' return Eval( ::bSaveAsPDF, Self ) endif else if ValType( ::bSaveAsWord ) == 'B' return Eval( ::bSaveAsWord, Self ) endif endif oWord := WinWordObj() if oWord == nil if lPDF Return FWSavePreviewToPDF( Self ) ELSE Return ToWordDocViaWriter( Self, , "W") Endif endif nVer := Val( oWord:Version ) if lPDF /* if nVer < 12.0 MsgInfo( "This option requires Word 2007 or later" ) return nil elseif !WordHasPDFPlugIn() MsgInfo( "Download and Install" + CRLF + ; "SaveAsPDF plugin from" + CRLF + ; "Microsoft Office Online Website" ) return nil endif */ if nVer >= 12.0 .and. WordHasPDFPlugIn() cExt := "*.pdf" else return FWSavePreviewToPDF( Self ) endif else cExt := If( nVer < 12.0, "*.doc", "*.docx; *.doc" ) endif cMsg := If( lPDF, "PDF", "Doc" ) + ; " File to Save( " + cExt + ") |" + cExt + "|" if Empty( cFile := cGetFile( cMsg, "File to Save", 1, CurDir(), , .t. ) ) return nil endif if !( Lower( cFileExt( cFile ) ) $ cExt ) cFile := cFilePath( cFile ) + cFileNoExt( cFile ) + ; If( lPDF, ".pdf", If( nVer < 12.0, ".doc", ".docx" ) ) endif lView := MsgYesNo( "View " + cFile + "?" ) oDoc := ConvertToWordDoc( Self ) if oDoc != nil TRY oDoc:ExportAsFixedFormat( cFile, 17, lView ) CATCH MsgInfo( "PDF Plugin Error" ) END if lPDF oDoc:Close( .f. ) else if nVer >= 12.0 oDoc:SaveAs( cFile, If( Lower( cFileExt( cFile ) ) == 'doc', 0, 16 ) ) else oDoc:SaveAs( cFile ) endif if lView oDoc:Application:Visible := .t. else oDoc:Close( .f. ) endif endif endif return nil //----------------------------------------------------------------------------// function RPreview( oDevice, oReport ) local oPreview := TPreview():New( oDevice ) oPreview:oReport := oReport oPreview:Activate() return nil //----------------------------------------------------------------------------// function ConvertToWordDoc( oPreview ) local aFiles := oPreview:oDevice:aMeta local oWord, oDoc, cEMF if Len( aFiles ) > 0 // oDoc:=ToWordDocViaWriter( oPreview, aFiles, "W" ) // W -> Word Doc, P -> PDF /* Anser :- For testing purpose, I have commented the lines below. On production, * uncomment the lines below and delete the line just above this comment * ie oDoc:=ToWordDocViaWriter( oPreview, aFiles) */ if ( oWord := WinWordObj() ) == nil MsgAlert( "MS Word not installed" ) oDoc:=ToWordDocViaWriter( oPreview, aFiles, "W" ) else oDoc := oWord:Documents:Add() if oDoc == nil MsgAlert( "Failed to Create Word Document" ) else oDoc:PageSetup:Orientation := If( oPreview:oDevice:GetOrientation() == 1, 0, 1 ) WITH OBJECT oDoc:PageSetup :LeftMargin := 0 :TopMargin := 0 :RightMargin := 0 :BottomMargin := 0 END for each cEMF in aFiles oWord:Selection:InlineShapes:AddPicture( cEMF, .f., .t. ) next // oDoc:Application:Visible := .t. endif endif else MsgAlert( "There is no output for export" ) /**/ endif return oDoc //----------------------------------------------------------------------------// Function ToWordDocViaWriter( oPreview, aFiles, cFileType ) Local oWriter,oDesktop,oDoc,oCusor,oText,oGraphic,cEMF,cURL,i,aProp,oStyle,nPageWidth,nPageHeight,aPdfFilters Local cExt,cMsg,cFile,oSize, oCursor DEFAULT cFileType:="W" // ByDefault Word File DEFAULT aFiles:=oPreview:oDevice:aMeta if Len( aFiles ) == 0 MsgAlert( "There is no output for export" ) Return nil Endif if ( oWriter := SunCalcObj() ) == nil MsgAlert( "No .Doc file manipulation software installed" ) Return NIL Endif oDesktop := oWriter:CreateInstance( "com.sun.star.frame.Desktop" ) // Create OpenOffice Word Instance with the Window Hidden Property aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "Hidden", .T. ) ) oDoc := oDesktop:LoadComponentFromURL( "private:factory/swriter", "_blank", 0, aProp ) oDoc:Refresh() // Set Page Orientation Properties ie Portrait/Landscape aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "PaperOrientation", If( oPreview:oDevice:GetOrientation() == 1, 0, 1 ) ) ) // 0-> Portrait, 1-> Landscape oDoc:Printer:= aProp oStyle = oDoc:StyleFamilies:getByName("PageStyles"):getByName("Standard") // Set Page Margins oStyle:LeftMargin :=0 oStyle:TopMargin :=0 oStyle:RightMargin :=0 oStyle:BottomMargin:=0 // Find out the Page's Size ie Height and width. Later this size is used to set the EMF image size // while inserting on the page nPageWidth:= oStyle:Size:Width - oStyle:LeftMargin - oStyle:RightMargin nPageHeight:=oStyle:Size:Height - oStyle:TopMargin - oStyle:BottomMargin // Create a Size Structure. This size structure is later used to set the image size oSize:= oWriter:Bridge_GetStruct( "com.sun.star.awt.Size" ) oSize:Width:=nPageWidth oSize:Height = nPageHeight i:=1 For each cEMF in aFiles cURL:=ConvertToOoURL(cEMF) oText:=oDoc:GetText() oCursor:= oText:CreateTextCursor() oCursor:GotoEnd(.F.) If i > 1 // Applicable only for page nos > 1 oText:InsertControlCharacter( oCursor, 0, .F. ) // 0->New Paragraph, 1->New line in a paragraph, 5->This control character appends a new paragraph. Endif oGraphic:= oDoc:CreateInstance("com.sun.star.text.GraphicObject") oGraphic:SetPropertyValue("GraphicURL", cURL ) oGraphic:SetPropertyValue("AnchorType",1) // com.sun.star.text.TextContentAnchorType.AS_CHARACTER oGraphic:SetSize(oSize) oText:InsertTextContent( oCursor:End, oGraphic, .F.) i++ next // Convert the image links and then Embedd the images onto the document OoEmbeddGraphics(oWriter,oDoc) cExt := If( cFileType == "W", "*.doc", "*.pdf" ) cMsg := If( cFileType == "W", "Doc", "PDF" ) + ; " File to Save( " + cExt + ") |" + cExt + "|" if Empty( cFile := cGetFile( cMsg, "File to Save", 1, CurDir(), , .t. ) ) oDoc:Close(1) // To Close OpenOffice Writer oDesktop:terminate() // To close the OpenOffice QuickOpen Window Return nil endif if !( Lower( cFileExt( cFile ) ) $ cExt ) cFile := cFilePath( cFile ) + cFileNoExt( cFile ) + ; If( cFileType == "W", ".doc", ".pdf" ) endif // Convert the FileName and Path to OpenOffice Standard URL cURL:=ConvertToOoURL(cFile) // The Word or PDF file will be saved in the Temp Folder * cURL:=ConvertToOoURL(Getenv("TMP")+"\") * cURL:=cURL+cTempFile() if cFileType == "W" // Word * cURL:=cURL+"Doc" // Save the Writer File as Word 97/2000/XP .Doc file. This is the most compatible format aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "FilterName", "MS Word 97" ) ) oDoc:StoreToURL( cURL, aProp ) Else // PDF * cURL:=cURL+"Pdf" // Save the Writer File as PDF file aPdfFilters:={} AAdd(aPdfFilters,GetPropertyValue(oWriter, "UseLosslessCompression", .T. ) ) // Specifies if graphics are exported // to PDF using a lossless compression. If this property is set to true, it overwrites the "Quality" property AAdd(aPdfFilters,GetPropertyValue(oWriter, "ReduceImageResolution", .F. ) ) AAdd(aPdfFilters,GetPropertyValue(oWriter, "Quality", 50 ) ) // Value can be between 1 to 100 aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "FilterName", "writer_pdf_Export" ) ) AAdd(aProp,GetPropertyValue(oWriter, "FilterData", aPdfFilters ) ) oDoc:StoreToURL( cURL, aProp ) Endif // Inform the user about the Exported Filename along with the Full path * MsgInfo(cUrl) * oDoc:GetCurrentController():GetFrame():GetContainerWindow():SetVisible(.T.) oDoc:Close(1) // To Close OpenOffice Word oDesktop:terminate() // To close the OpenOffice QuickOpen Window oDoc:=nil Return nil //------------------------------------// Static Function OoEmbeddGraphics(oWriter,oDoc) Local oDrawPage,oProvider,aProp,i,oGraphic oDrawPage = oDoc:DrawPage oProvider = oWriter:CreateInstance("com.sun.star.graphic.GraphicProvider") If oDrawPage:hasElements() For i = 0 To oDrawPage:Count - 1 oGraphic = oDrawPage:getByIndex(i) If oGraphic:supportsService("com.sun.star.text.TextGraphicObject") aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "URL", oGraphic:GraphicUrl ) ) oGraphic:Graphic = oProvider:queryGraphic(aProp) EndIf Next i EndIf Return NIL //----------------------------------------------------------------------------// static function WordHasPDFPlugIn() static lPDF local oWord, oFilter if lPDF == nil lPDF := .f. if ( oWord := WinWordObj() ) != nil .and. Val( oWord:Version ) >= 12.0 for each oFilter in oWord:FileDialog( 2 ):Filters if "*.pdf" $ oFilter:Extensions lPDF := .t. exit endif next endif endif return lPDF //--------------------------------------------------------------------// function RPrevUserBtns( bNewUserBtns, nBarStyle, aSize ) local bPrev := bUserBtns if PCount() > 0 bUserBtns := bNewUserBtns if PCount() > 1 if nBarStyle == nil nStyle := nil elseif ValType( nBarStyle ) == 'L' .and. nBarStyle == .t. nStyle := 2007 elseif ValType( nBarStyle ) == 'N' .and. AScan( { 97, 2007, 2010 }, nBarStyle ) > 0 nStyle := nBarStyle endif if PCount() > 2 if ValType( aSize ) == 'A' .and. Len( aSize ) >= 2 nBtnW := aSize[ 1 ] nBtnH := aSize[ 2 ] endif endif endif endif return bPrev //--------------------------------------------------------------------// #ifdef __CLIPPER__ static function IsAppThemed() return .f. static function TToolBar() return nil static function TRebar() return nil #endif //------------------------------------------------------------------------ // función para cambiar la impresora desde previo mcn valdenebro //------------------------------------------------------------------------ Func f_CamImpre (oDevice, cCbx ) local cPrinter /* IF VALTYPE(oDevice)=="U" oDevice:=" " Endif */ cPrinter := GetProfString( "windows", "device" , "" ) WriteProfString( "windows", "device", cCbx ) SysRefresh() PrinterInit() //DeleteDC( oDevice:hDC ) // Sugestion by Enrico M. Giordano // Insert here the function to create the report // oWnd:End() // George - To close current preview oDevice:hDC := GetPrintDefault( GetActiveWindow() ) SysRefresh() //WriteProfString( "windows", "device", cPrinter ) RETURN nil id=code>id=code>Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd Editado por - ar-siste on 19/11/2012 13:56:35 Editado por - ar-siste on 19/11/2012 13:57:35 Editado por - ar-siste on 19/11/2012 13:59:41 Editado por - ar-siste on 19/11/2012 14:03:02
  11. Bom tarde Pessoal, estou com a nova versão do FWH - 12.09 - tentei alterar a RPREVIEW.PRG pra ficar igual a que usava, ela tinha a opção de escolher a impressora, entretanto, as alterações não deram muito certo, quando seleciono uma outra impressora ele dá um erro. Alguém poderia ajudar? A NOVA RPREVIEW.PRG VERSÃO 12.09 É ESTA AI Jà ALTERADA MAIS COM ERRO. #define DEVICE oWnd:cargo #define GO_POS 0 #define GO_UP 1 #define GO_DOWN 2 #define GO_LEFT 1 #define GO_RIGHT 2 #define GO_PAGE .T. #define VSCROLL_RANGE 20 * ::nZFactor #define HSCROLL_RANGE 20 * ::nZFactor #define TXT_FIRST LoadString( GetResources(), 07 ) #define TXT_PREVIOUS LoadString( GetResources(), 08 ) #define TXT_NEXT LoadString( GetResources(), 09 ) #define TXT_LAST LoadString( GetResources(), 10 ) #define TXT_ZOOM LoadString( GetResources(), 11 ) #define TXT_UNZOOM LoadString( GetResources(), 12 ) #define TXT_TWOPAGES LoadString( GetResources(), 13 ) #define TXT_ONEPAGE LoadString( GetResources(), 14 ) #define TXT_PRINT LoadString( GetResources(), 15 ) #define TXT_EXIT LoadString( GetResources(), 16 ) #define TXT_FILE LoadString( GetResources(), 17 ) #define TXT_PAGE LoadString( GetResources(), 18 ) #define TXT_PREVIEW LoadString( GetResources(), 03 ) #define TXT_PAGENUM LoadString( GetResources(), 19 ) #define TXT_A_WINDOW_PREVIEW_IS_ALLREADY_RUNNING ; LoadString( GetResources(), 20 ) #define TXT_GOTO_FIRST_PAGE ; LoadString( GetResources(), 21 ) #define TXT_GOTO_PREVIOUS_PAGE ; LoadString( GetResources(), 22 ) #define TXT_GOTO_NEXT_PAGE ; LoadString( GetResources(), 23 ) #define TXT_GOTO_LAST_PAGE ; LoadString( GetResources(), 24 ) #define TXT_ZOOM_THE_PREVIEW ; LoadString( GetResources(), 25 ) #define TXT_UNZOOM_THE_PREVIEW ; LoadString( GetResources(), 26 ) #define TXT_PREVIEW_ON_TWO_PAGES ; LoadString( GetResources(), 27 ) #define TXT_PREVIEW_ON_ONE_PAGE ; LoadString( GetResources(), 28 ) #define TXT_PRINT_CURRENT_PAGE ; LoadString( GetResources(), 29 ) #define TXT_EXIT_PREVIEW ; LoadString( GetResources(), 30 ) #define TXT_FACTOR ; LoadString( GetResources(), 31 ) #define TXT_ZOOM_FACTOR ; LoadString( GetResources(), 32 ) #define TXT_EXPORT_MSWORD ; LoadString( GetResources(), 33 ) #define MK_MBUTTON 16 //----------------------------------------------------------------------------// static bUserBtns, lRebar, nBtnW, nBtnH static nStyle := nil static oDevice := nil //NOVO //----------------------------------------------------------------------------// CLASS TPreview DATA oWnd, oBar, oFont, oImageList DATA oDevice, oReport DATA oHand, oCursor DATA oMeta1, oMeta2, oSay, oFactor, oSay2 DATA oPage, oTwoPages, oZoom DATA oMenuZoom, oMenuTwoPages, oMenuUnZoom, oMenuOnePage DATA cResFile DATA aFactor, nPage, nZFactor DATA lTwoPages, lZoom, lExit DATA cPageNum DATA hOldRes, hNewRes CLASSDATA cResFile CLASSDATA oWndMain CLASSDATA bPrint, bExportToWord, bSaveAsWord, bSaveAsPDF METHOD New( oDevice ) METHOD Activate() METHOD BuildButtonBar() METHOD BuildWindow() METHOD BuildMenu() METHOD PaintMeta() METHOD NextPage() METHOD PrevPage() METHOD TopPage() METHOD BottomPage() METHOD TwoPages( lMenu ) METHOD Zoom( lMenu ) METHOD VScroll( nType, lPage, nSteps ) METHOD HScroll( nType, lPage, nSteps ) METHOD SetOrg1( nX, nY ) METHOD SetOrg2( nX, nY ) METHOD CheckKey( nKey, nFlags ) METHOD CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) METHOD SetFactor( nValue ) METHOD PrintPage() METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd ) METHOD ExportToMSWord() METHOD SaveAsMenu() METHOD SaveAs( lPDF ) METHOD CheckStyle() PROTECTED ENDCLASS //----------------------------------------------------------------------------// METHOD New( oDevice ) CLASS TPreview if oDevice == nil PRINTER oDevice PREVIEW PAGE ENDPAGE MsgInfo( oDevice:aMeta[ 1 ] ) // ENDPRINTER endif ::oDevice := oDevice ::nPage := 1 ::nZFactor := 1 ::lTwoPages := .F. ::lZoom := .F. ::lExit := .F. ::BuildWindow() return Self //----------------------------------------------------------------------------// METHOD Activate() CLASS TPreview ACTIVATE WINDOW ::oWnd MAXIMIZED ; ON RESIZE ::PaintMeta() ; ON UP ::VScroll( GO_UP ) ; ON DOWN ::VScroll( GO_DOWN ) ; ON PAGEUP ::VScroll( GO_UP, GO_PAGE) ; ON PAGEDOWN ::VScroll( GO_DOWN, GO_PAGE) ; ON LEFT ::HScroll( GO_LEFT ) ; ON RIGHT ::HScroll( GO_RIGHT ) ; ON PAGELEFT ::HScroll( GO_LEFT, GO_PAGE ) ; ON PAGERIGHT ::HScroll( GO_RIGHT, GO_PAGE ) ; VALID ( ::oWnd:oIcon := nil ,; ::oFont:End() ,; ::oMeta1:End() ,; ::oMeta2:End() ,; ::oDevice:End() ,; ::oHand:End() ,; ::oWnd := nil ,; If( Empty( ::oImageList ),, (::oImageList:End(), ::oImageList := nil ) ),; ::lExit := .t. ,; .t. ) if ::oDevice:lPrvModal if ::oWndMain == nil StopUntil( { || ::lExit } ) else StopUntil( { || ::lExit .or. !IsWindow( WndMain():hWnd ) } ) endif endif return nil //----------------------------------------------------------------------------// METHOD BuildButtonBar() CLASS TPreview local oImageList, oReBar, oBar, oHand, uRet DEFINE CURSOR ::oHand HAND if lRebar DEFINE IMAGELIST oImageList SIZE 16, 16 oImageList:AddMasked( TBitmap():Define( "top2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "previous2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "next2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "bottom2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "zoom2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "two_pages2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "printer2",, ::oWnd ), nRGB( 255, 0, 255 ) ) oImageList:AddMasked( TBitmap():Define( "save",, ::oWnd ), nRGB( 255, 0, 255 ) ) oImageList:AddMasked( TBitmap():Define( "word",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "exit2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "unzoom2",, ::oWnd ), nRGB( 192, 192, 192 ) ) oImageList:AddMasked( TBitmap():Define( "one_page2",, ::oWnd ), nRGB( 192, 192, 192 ) ) ::oImageList = oImageList oReBar = TReBar():New( ::oWnd ) DEFINE TOOLBAR oBar OF oReBar SIZE 25, 25 IMAGELIST oImageList ::oBar = oBar oReBar:InsertBand( oBar ) oBar:nHeight -= 2 DEFINE TBBUTTON OF oBar ; ACTION ::TopPage() ; TOOLTIP Strtran( TXT_FIRST, "&", "" ) ; MESSAGE TXT_GOTO_FIRST_PAGE DEFINE TBBUTTON OF oBar ; ACTION ::PrevPage() ; TOOLTIP Strtran( TXT_PREVIOUS, "&", "" ) ; MESSAGE TXT_GOTO_PREVIOUS_PAGE DEFINE TBBUTTON OF oBar ; ACTION ::NextPage() ; TOOLTIP Strtran( TXT_NEXT, "&", "" ) ; MESSAGE TXT_GOTO_NEXT_PAGE DEFINE TBBUTTON OF oBar ; ACTION ::BottomPage() ; TOOLTIP Strtran( TXT_LAST, "&", "" ) ; MESSAGE TXT_GOTO_LAST_PAGE DEFINE TBSEPARATOR OF oBar DEFINE TBBUTTON OF oBar ; ACTION ::Zoom() ; TOOLTIP Strtran( TXT_ZOOM, "&", "" ) ; MESSAGE TXT_ZOOM_THE_PREVIEW DEFINE TBBUTTON OF oBar ; ACTION ::TwoPages() ; TOOLTIP StrTran( Strtran( TXT_TWOPAGES, "&", "" ), "á", "a" ) ; MESSAGE TXT_PREVIEW_ON_TWO_PAGES DEFINE TBSEPARATOR OF oBar DEFINE TBBUTTON OF oBar ; ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ; TOOLTIP Strtran(TXT_PRINT,"&","") ; MESSAGE TXT_PRINT_CURRENT_PAGE DEFINE TBMENU OF oBar ; ACTION ::SaveAs( .f. ) ; TOOLTIP "SaveAs" ; MESSAGE "Save As Word Document" ; MENU ::SaveAsMenu() DEFINE TBBUTTON OF oBar ; ACTION ::ExportToMSWord() ; TOOLTIP TXT_EXPORT_MSWORD ; MESSAGE TXT_EXPORT_MSWORD DEFINE TBSEPARATOR OF oBar DEFINE TBBUTTON OF oBar ; ACTION ::oWnd:End() ; TOOLTIP Strtran( TXT_EXIT, "&", "" ) ; MESSAGE TXT_EXIT_PREVIEW else /* if oBar != nil .and. oBar:l2007 DEFINE BUTTONBAR oBar SIZE 26, If( LargeFonts(), 30, 26 ) OF ::oWnd 2007 oBar:bPainted = { || oBar:Say( 7, 285+40, "Factor:",,, ::oFont, .T., .T. ),; If( Len( ::oDevice:aMeta ) > 1,; oBar:Say( 7, 380+40, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( ::oDevice:aMeta ) ) ),,, ::oFont, .T., .T. ),; oBar:Say( 7, 380+40, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ),; ,,, ::oFont, .T., .T. ) ) } else DEFINE BUTTONBAR oBar _3D SIZE 26, If( LargeFonts(), 30, 26 ) OF ::oWnd endif */ DEFINE BUTTONBAR oBar _3D SIZE IfNil( nBtnW, 26 ), IfNil( nBtnH, If( LargeFonts(), 30, 26 ) ) OF ::oWnd ::oBar = oBar oBar:l2007 := ( nStyle >= 2007 ) oBar:l97Look := ( nStyle == 97 ) oBar:bRClicked := { || nil } // to retain the bar on top only DEFINE BUTTON RESOURCE "Top2" OF oBar ; MESSAGE TXT_GOTO_FIRST_PAGE ; ACTION ::TopPage() ; TOOLTIP Strtran( TXT_FIRST, "&", "" ) DEFINE BUTTON RESOURCE "Previous2" OF oBar ; MESSAGE TXT_GOTO_PREVIOUS_PAGE ; ACTION ::PrevPage() ; TOOLTIP Strtran( TXT_PREVIOUS, "&", "" ) DEFINE BUTTON RESOURCE "Next2" OF oBar ; MESSAGE TXT_GOTO_NEXT_PAGE ; ACTION ::NextPage() ; TOOLTIP Strtran( TXT_NEXT, "&", "" ) DEFINE BUTTON RESOURCE "Bottom2" OF oBar ; MESSAGE TXT_GOTO_LAST_PAGE ; ACTION ::BottomPage() ; TOOLTIP Strtran( TXT_LAST, "&", "" ) DEFINE BUTTON ::oZoom RESOURCE "Zoom2" OF oBar GROUP ; MESSAGE TXT_ZOOM_THE_PREVIEW ; ACTION ::Zoom() ; TOOLTIP Strtran( TXT_ZOOM, "&", "" ) DEFINE BUTTON ::oTwoPages RESOURCE "Two_Pages2" OF oBar ; MESSAGE TXT_PREVIEW_ON_TWO_PAGES ; ACTION ::TwoPages() ; TOOLTIP Strtran( TXT_TWOPAGES, "&", "" ) DEFINE BUTTON RESOURCE "Printer2" OF oBar GROUP ; MESSAGE TXT_PRINT_CURRENT_PAGE ; ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ; TOOLTIP Strtran( TXT_PRINT, "&", "" ) if ! Empty( bUserBtns ) SetResources( ::hOldRes ) uRet := Eval( bUserBtns, Self, oBar ) SetResources( ::hNewRes ) endif if !( ValType( uRet ) == 'L' .and. uRet == .f. ) DEFINE BUTTON RESOURCE "Save" OF oBar ; MENU ::SaveAsMenu() ; MESSAGE "Save as DOC/PDF" ; ACTION This:ShowPopUp() ; TOOLTIP "Save as Doc/Pdf" DEFINE BUTTON RESOURCE "Word" OF oBar ; MESSAGE TXT_EXPORT_MSWORD ; ACTION ::ExportToMSWord() ; TOOLTIP TXT_EXPORT_MSWORD endif DEFINE BUTTON RESOURCE "Exit2" OF oBar GROUP ; MESSAGE TXT_EXIT_PREVIEW ; ACTION ::oWnd:End() ; TOOLTIP Strtran( TXT_EXIT, "&", "" ) AEval( oBar:aControls, { | o | o:oCursor := ::oHand } ) endif return nil //----------------------------------------------------------------------------// METHOD BuildWindow() CLASS TPreview local oIcon, cTitle := "FiveWin Printing Preview", oCursor, oBar, nCol := 325 local oThis := Self local nRow := 7 // NOVO // ---- local aImpre := aGetPrinters(), oCbx, cCbx := PrnGetName(), cImpre := cCbx // mcn valdenebro // ------------------------------------------------------------------------------------------- DEFAULT ::oWndMain := WndMain() ::hOldRes := GetResources() if ! File( ::cResFile ) #ifdef __CLIPPER__ ::cResFile := "Preview.dll" #else if ! IsWin64() ::cResFile := "Prev32.dll" else ::cResFile = "Prev64.dll" endif #endif endif if SetResources( ::cResFile ) < 32 MsgStop( ::cResFile + " not found, imposible to continue",; "FiveWin Printing Error" ) return nil endif ::hNewRes := GetResources() if ::oDevice != nil cTitle = ::oDevice:cDocument endif if ::oWndMain != nil oIcon = ::oWndMain:oIcon else DEFINE ICON oIcon RESOURCE "Print" endif DEFINE FONT ::oFont NAME GetSysFont() SIZE 0, -12 ::CheckStyle() if !::oDevice:lPrvModal .and. ::oWndMain != nil .and. ; Upper( ::oWndMain:ClassName() ) == "TMDIFRAME" DEFINE WINDOW ::oWnd ; TITLE cTitle ; COLOR CLR_BLACK,CLR_LIGHTGRAY ; ICON oIcon ; VSCROLL HSCROLL MDICHILD else DEFINE WINDOW ::oWnd /*FROM 0, 0 TO 24, 80*/ ; TITLE cTitle ; COLOR CLR_BLACK,CLR_LIGHTGRAY ; ICON oIcon ; VSCROLL HSCROLL MENU ::BuildMenu() endif ::oWnd:SetFont( ::oFont ) ::oWnd:oVScroll:SetRange( 0, 0 ) ::oWnd:oHScroll:SetRange( 0, 0 ) ::cPageNum = TXT_PAGENUM ::BuildButtonBar() /* #ifdef __CLIPPER__ SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ; NOINSET CLOCK DATE KEYBOARD #else if l2007 SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ; NOINSET CLOCK DATE KEYBOARD 2007 else DEFINE STATUSBAR OF ::oWnd PROMPT " " + TXT_PREVIEW endif #endif */ if lRebar DEFINE STATUSBAR OF ::oWnd PROMPT " " + TXT_PREVIEW else SET MESSAGE OF ::oWnd TO TXT_PREVIEW CENTERED ; NOINSET CLOCK DATE KEYBOARD ::oWnd:oMsgBar:l2007 := ( nStyle == 2007 ) ::oWnd:oMsgBar:l2010 := ( nStyle == 2010 ) endif ::oMeta1 := TMetaFile():New( 0, 0, 0, 0,; ::oDevice:aMeta[ 1 ],; ::oWnd,; CLR_BLACK,; CLR_WHITE,; ::oDevice:nHorzRes(),; ::oDevice:nVertRes() ) if ! IsWin64() DEFINE CURSOR ::oCursor RESOURCE "LUPA" else DEFINE CURSOR ::oCursor RESOURCE "search" endif ::oMeta1:oCursor := ::oCursor ::oMeta1:blDblClick := { | nRow, nCol, nKeyFlags | ; ::SetOrg1( nCol, nRow, nKeyFlags ) } ::oMeta1:bKeyDown := { | nKey, nFlags | ::CheckKey( nKey, nFlags ) } ::oMeta1:bMouseWheel := { | nKeys, nDelta, nXPos, nYPos | ; ::CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) } #ifndef __XPP__ // XBPP bug. Warning: don't change this into #ifdef __CLIPPER__ ::oMeta2 := TMetaFile():New( 0, 0, 0, 0, "",; ::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),; ::oDevice:nVertRes() ) #else ::oMeta2 := TMetaFile():New():_New( 0, 0, 0, 0, "",; ::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),; ::oDevice:nVertRes() ) #endif ::oMeta2:oCursor = ::oCursor ::oMeta2:blDblClick := { | nRow, nCol, nKeyFlags | ; ::SetOrg2( nCol, nRow, nKeyFlags ) } ::oMeta2:hide() ::SetFactor() oBar := ::oBar if !lRebar nCol := ATail( oBar:aControls ):nRight + 30 nRow := Int( oBar:nHeight / 2 ) - 6 endif if nStyle >= 2007 oBar:bPainted = { || oBar:Say( nRow, nCol, "Fator:",,, ::oFont, .T., .T. ),; If( Len( ::oDevice:aMeta ) > 1,; oBar:Say( nRow, nCol+100, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( ::oDevice:aMeta ) ) ),,, ::oFont, .T., .T. ),; oBar:Say( nRow, nCol+100, ::cPageNum + LTrim( Str( ::nPage, 4, 0 ) ),; ,,, ::oFont, .T., .T. ) ) } endif if nStyle < 2007 @ nRow, nCol SAY ::oSay PROMPT "Fator:" ; SIZE 45, 15 PIXEL OF ::oBar FONT ::oFont ::oSay:lTransparent = .T. endif @ nRow-4, nCol+40 COMBOBOX ::oFactor VAR ::nZFactor ; ITEMS { "1", "2", "3", "4", "5", "6", "7", "8", "9" } ; OF ::oBar FONT ::oFont PIXEL SIZE 35,200 ; ON CHANGE oThis:SetFactor( oThis:nZFactor ) if nStyle < 2007 if Len( ::oDevice:aMeta ) > 1 @ nRow, nCol+100 SAY ::oPage PROMPT TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( ::oDevice:aMeta ) ) ) ; SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont else @ nRow, nCol + 100 SAY ::oPage PROMPT TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) ; SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont endif ::oPage:lTransparent = .T. endif // --------------------------------------------------- // NOVO: exibir impressora para impressao Arlindo Reis //------------------------------------------------ //if nStyle >= 2007 // oBar:bPainted = { || oBar:Say( nRow, nCol+340, "Impressora:",,, ::oFont, .T., .T. )} //endif @ nRow-4, nCol+250 COMBOBOX oCbx VAR cCbx ; PROMPTS aImpre; OF ::oBar FONT ::oFont PIXEL SIZE 310,200 ; ON CHANGE F_CamImpre( oDevice, cCbx ) //---------- F I M ------------------------------- //------------------------------------------------ // if IsAppThemed() .or. l2007 if lRebar .or. nStyle >= 2007 #define NULL_BRUSH 5 FixSays( ::oBar:hWnd, GetStockObject( NULL_BRUSH ) ) endif #ifndef __XPP__ ::oFactor:Set3dLook( .T. ) #endif SetResources( ::hOldRes ) ::oWnd:oHScroll:bPos := { | nPos | ::HScroll( GO_POS, .f., nPos ) } ::oWnd:oVScroll:bPos := { | nPos | ::VScroll( GO_POS, .f., nPos ) } return nil //----------------------------------------------------------------------------// METHOD BuildMenu() CLASS TPreview local nFor, oMenu local lThemed := IsAppThemed() local cPrinter := If( lThemed, "Printer2", "Printer" ) local cTop := If( lThemed, "Top2", "Top" ) local cPrevious := If( lThemed, "Previous2", "Previous" ) local cNext := If( lThemed, "Next2", "Next" ) local cBottom := If( lThemed, "Bottom2", "Bottom" ) local cZoom := If( lThemed, "Zoom2", "Zoom" ) local cUnZoom := If( lThemed, "UnZoom2", "UnZoom" ) local cOne_Page := If( lThemed, "One_page2", "One_page" ) local cTwo_Pages := If( lThemed, "Two_pages2", "Two_pages" ) local cExit := If( lThemed, "Exit2", "Exit" ) ::aFactor := Array( 9 ) MENU oMenu oMenu:l2007 := ( nStyle == 2007 ) oMenu:l2010 := ( nStyle == 2010 ) MENUITEM TXT_FILE MENU MENUITEM TXT_PRINT ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ; MESSAGE TXT_PRINT_CURRENT_PAGE RESOURCE cPrinter SEPARATOR MENUITEM TXT_EXIT ACTION ::oWnd:End() ; MESSAGE TXT_EXIT_PREVIEW RESOURCE cExit ENDMENU MENUITEM TXT_PAGE MENU MENUITEM TXT_FIRST ACTION ::TopPage() ; MESSAGE TXT_GOTO_FIRST_PAGE RESOURCE cTop MENUITEM TXT_PREVIOUS ACTION ::PrevPage() ; MESSAGE TXT_GOTO_PREVIOUS_PAGE RESOURCE cPrevious MENUITEM TXT_NEXT ACTION ::NextPage() ; MESSAGE TXT_GOTO_NEXT_PAGE RESOURCE cNext MENUITEM TXT_LAST ACTION ::BottomPage() ; MESSAGE TXT_GOTO_LAST_PAGE RESOURCE cBottom SEPARATOR MENUITEM ::oMenuZoom PROMPT TXT_ZOOM ACTION ::Zoom( .T. ) ; MESSAGE TXT_ZOOM_THE_PREVIEW RESOURCE cZoom MENUITEM ::oMenuUnZoom PROMPT TXT_UNZOOM ACTION ::Zoom( .T. ) ; MESSAGE TXT_UNZOOM_THE_PREVIEW RESOURCE cUnZoom MENUITEM "&Fator" MESSAGE TXT_ZOOM_FACTOR MENU for nFor := 1 to Len( ::aFactor ) MENUITEM ::aFactor[ nFor ] ; PROMPT "&" + LTrim( Str( nFor ) ) ; MESSAGE "Fator " + LTrim( Str( nFor ) ) ; ACTION ( ::oFactor:Set( oMenuItem:nHelpId ),; Eval( ::oFactor:bChange ) ) next ENDMENU SEPARATOR MENUITEM ::oMenuTwoPages PROMPT TXT_TWOPAGES ACTION ::TwoPages( .T. ) ; ENABLED ; MESSAGE TXT_PREVIEW_ON_TWO_PAGES RESOURCE cTwo_Pages MENUITEM ::oMenuOnePage PROMPT TXT_ONEPAGE ACTION ::TwoPages(.T.) ; MESSAGE TXT_PREVIEW_ON_ONE_PAGE RESOURCE cOne_Page ENDMENU ENDMENU ::oMenuUnZoom:Disable() ::oMenuOnePage:Disable() return oMenu //----------------------------------------------------------------------------// METHOD CheckStyle() CLASS TPreview local o if nStyle == nil nStyle := 0 DEFAULT ::oWndMain := WndMain() if ::oWndMain != nil if ( o := ::oWndMain:oMenu ) != nil nStyle := Max( nStyle, If( o:l2010, 2010, 0 ) ) endif if nStyle < 2010 .and. ( o := ::oWndMain:oMsgBar ) != nil nStyle := Max( nStyle, If( o:l2010, 2010, If( o:l2007, 2007, 0 ) ) ) endif if nStyle < 2010 .and. ( o := ::oWndMain:oTop ) != nil if o:IsKindOf( "TRIBBONBAR" ) nStyle := Max( nStyle, If( o:l2010, 2010, 2007 ) ) elseif o:IsKindOf( "TBAR" ) nStyle := Max( nStyle, If( o:l2007, 2007, 0 ) ) if Empty( nStyle ) .and. Len( o:aControls ) > 0 .and. o:aControls[ 1 ]:l97look nStyle := 97 endif endif endif endif endif lRebar := ( IsAppThemed() .and. Empty( nStyle ) .and. bUserBtns == nil .and. nBtnW == nil .and. nBtnH == nil ) return Self //----------------------------------------------------------------------------// METHOD PaintMeta() CLASS TPreview local oRect, oRect1, oRect2 local aFiles := ::oDevice:aMeta // DEVICE local nWidth, nHeight, nMaxWidth, nAspect, nMetaWidth, nGutter if ::oWnd != nil if IsIconic( ::oWnd:hWnd ) return nil endif oRect := ::oWnd:GetCliRect() oRect:nTop += ( ::oBar:nHeight + 4 ) oRect:nBottom -= ( IfNil( ::oWnd:oMsgBar, ::oWnd:oBottom ):nHeight + 4 + 5 ) // 5 shadow depth nMaxWidth := oRect:nWidth * If( ::lTwoPages, 0.40, 0.95 ) nGutter := oRect:nWidth * 0.05 nAspect := ::oDevice:nHorzSize() / ::oDevice:nVertSize() nMetaWidth := If( ::lZoom, nMaxWidth, oRect:nHeight * nAspect ) nHeight := oRect:nHeight if nMetaWidth > nMaxWidth nMetaWidth := nMaxWidth nHeight := nMetaWidth / nAspect endif if ::lTwoPages oRect1 := OClone( oRect ) WITH OBJECT oRect1 :nTop += ( oRect:nHeight - nHeight ) / 2 :nLeft := oRect:nLeft + oRect:nWidth / 2 - nMetaWidth - nGutter :nWidth := nMetaWidth :nHeight := nHeight END oRect2 := OClone( oRect1 ) WITH OBJECT oRect2 :nLeft := oRect:nLeft + oRect:nWidth / 2 + nGutter :nWidth := nMetaWidth END if ::nPage == Len( aFiles ) ::oMeta2:SetFile( "" ) else ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) endif ::oMeta1:SetCoors( oRect1 ) ::oMeta2:SetCoors( oRect2 ) ::oMeta1:Refresh() ::oMeta2:Show() else oRect1 := OClone( oRect ) WITH OBJECT oRect1 :nTop += ( oRect:nHeight - nHeight ) / 2 :nLeft += ( oRect:nWidth - nMetaWidth ) / 2 :nWidth := nMetaWidth :nHeight := nHeight END ::oMeta2:Hide() ::oMeta1:SetCoors( oRect1 ) ::oMeta1:Refresh() endif ::oMeta1:SetFocus() endif return nil //----------------------------------------------------------------------------// METHOD NextPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage >= Len( aFiles ) MsgBeep() return nil endif ::nPage++ SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages if Len( aFiles ) >= ::nPage + 1 ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) else ::oMeta2:SetFile( "" ) endif ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD PrevPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage == 1 MsgBeep() return nil endif ::nPage-- SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages if Len( aFiles ) >= ::nPage + 1 ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) else ::oMeta2:SetFile( "" ) endif ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD TopPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage == 1 MsgBeep() return nil endif ::nPage = 1 SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages if Len( aFiles ) >= ::nPage + 1 ::oMeta2:SetFile( aFiles[ ::nPage + 1 ] ) else ::oMeta2:SetFile( "" ) endif ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD BottomPage() CLASS TPreview local hOldRes := GetResources() local aFiles := ::oDevice:aMeta // DEVICE if ::nPage == Len( aFiles ) MsgBeep() return nil endif ::nPage = Len( aFiles ) SET RESOURCES TO ::cResFile ::oMeta1:SetFile( aFiles[ ::nPage ] ) if nStyle < 2007 ::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ; LTrim( Str( Len( aFiles ) ) ) ) endif ::oBar:Refresh() ::oMeta1:Refresh() if ::lTwoPages ::oMeta2:SetFile( "" ) ::oMeta2:Refresh() endif ::oMeta1:SetFocus() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD TwoPages( lMenu ) CLASS TPreview local hOldRes := GetResources() SET RESOURCES TO ::cResFile DEFAULT lMenu := .F. ::lTwoPages := ! ::lTwoPages if ::lTwoPages if Len( ::oDevice:aMeta) == 1 // solo hay una pagina // DEVICE ::lTwoPages := ! ::lTwoPages MsgBeep() SetResources( hOldRes ) return nil endif if ::oDevice:nHorzSize() >= ; // Apaisado // DEVICE ::oDevice:nVertSize() // DEVICE ::lTwoPages := ! ::lTwoPages MsgBeep() SetResources( hOldRes ) return nil endif if ::lZoom ::Zoom( .T. ) endif if ! lRebar ::oTwoPages:FreeBitmaps() ::oTwoPages:LoadBitmaps( "One_Page2" ) ::oTwoPages:cMsg := TXT_PREVIEW_ON_ONE_PAGE ::oTwoPages:cTooltip := StrTran( TXT_ONEPAGE, "&", "" ) else ::oBar:ChangeBitmap( 6, 10+2 ) ::oBar:SetTooltip( 6, StrTran( TXT_ONEPAGE, "&", "" ) ) ::oBar:SetMessage( 6, TXT_PREVIEW_ON_ONE_PAGE ) endif if ::oWnd:oMenu != nil ::oMenuTwoPages:Disable() ::oMenuOnePage:Enable() endif else if ! lRebar ::oTwoPages:FreeBitmaps() ::oTwoPages:LoadBitmaps( "Two_Pages2" ) ::oTwoPages:cMsg := TXT_PREVIEW_ON_TWO_PAGES ::oTwoPages:cTooltip := StrTran( TXT_TWOPAGES, "&", "" ) else ::oBar:ChangeBitmap( 6, 6 ) ::oBar:SetTooltip( 6, StrTran( TXT_TWOPAGES, "&", "" ) ) ::oBar:SetMessage( 6, TXT_PREVIEW_ON_TWO_PAGES ) endif if ::oWnd:oMenu != nil ::oMenuTwoPages:Enable() ::oMenuOnePage:Disable() endif endif if lMenu .and. ! IsAppThemed() ::oTwoPages:Refresh() endif ::oWnd:Refresh() ::PaintMeta() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD Zoom( lMenu ) CLASS TPreview local hOldRes := GetResources() SET RESOURCES TO ::cResFile DEFAULT lMenu := .F. ::lZoom := ! ::lZoom if ::lZoom if ::lTwoPages ::TwoPages( .T. ) endif if ! lRebar ::oZoom:FreeBitmaps() ::oZoom:LoadBitmaps( "Unzoom2" ) ::oZoom:cMsg := TXT_UNZOOM_THE_PREVIEW ::oZoom:cTooltip := StrTran( TXT_UNZOOM, "&", "" ) else ::oBar:ChangeBitmap( 5, 9+2 ) ::oBar:SetTooltip( 5, StrTran( TXT_UNZOOM, "&", "" ) ) ::oBar:SetMessage( 5, TXT_UNZOOM_THE_PREVIEW ) endif if ::oWnd:oMenu != nil ::oMenuZoom:Disable() ::oMenuUnZoom:Enable() endif ::oWnd:oVScroll:SetRange( 1, VSCROLL_RANGE ) if ::nZFactor > 1 ::oWnd:oHScroll:SetRange( 1, HSCROLL_RANGE ) endif ::oMeta1:ZoomIn() else if ! lRebar ::oZoom:FreeBitmaps() ::oZoom:LoadBitmaps( "Zoom2" ) ::oZoom:cMsg := TXT_ZOOM_THE_PREVIEW ::oZoom:cTooltip := StrTran( TXT_ZOOM, "&", "" ) else ::oBar:ChangeBitmap( 5, 5 ) ::oBar:SetTooltip( 5, StrTran( TXT_ZOOM, "&", "" ) ) ::oBar:SetMessage( 5, TXT_ZOOM_THE_PREVIEW ) endif if ::oWnd:oMenu != nil ::oMenuZoom:Enable() ::oMenuUnZoom:Disable() endif ::oWnd:oVScroll:SetRange( 0, 0 ) ::oWnd:oHScroll:SetRange( 0, 0 ) ::oMeta1:ZoomOut() ::nZFactor = 1 if ::oWnd:oMenu != nil AEval( ::aFactor, { | val, elem | val:SetCheck( ( elem == 1 ) ) } ) endif ::oFactor:Set( 1 ) endif if lMenu .and. ! IsAppThemed() ::oZoom:Refresh() endif ::oWnd:Refresh() // Fix for clearing shadows when unzoomed .. fwh 11.5 ::PaintMeta() SetResources( hOldRes ) return nil //----------------------------------------------------------------------------// METHOD VScroll( nType, lPage, nSteps ) CLASS TPreview local nYfactor, nYorig, nStep DEFAULT lPage := .F. if nType == GO_UP if ::oWnd:oVScroll:GetPos() <= ::oWnd:oVScroll:nMin return nil endif else if ::oWnd:oVScroll:GetPos() > ::oWnd:oVScroll:nMax return nil endif endif nYfactor := Int( ::oDevice:nVertRes() / ::oWnd:oVScroll:nMax ) // DEVICE if nSteps != nil nStep := nSteps elseif lPage nStep := ::oWnd:oVScroll:nMax / 10 else nStep := 1 endif if nType == GO_UP nStep := -nStep elseif nType == GO_POS ::oWnd:oVscroll:SetPos( nSteps ) nStep := 0 endif nYorig := nYfactor * ( ::oWnd:oVScroll:GetPos() + nStep - 1 ) if nYorig > ::oDevice:nVertRes() // DEVICE nYorig := ::oDevice:nVertRes() // DEVICE endif if nYorig < 0 nYorig := 0 endif #ifdef __CLIPPER__ ::oMeta1:SetOrg( nil, nYorig ) #else ::oMeta1:SetOrg( nil, nYorig / ::oDevice:nVertRes() * 10 ) // DEVICE #endif ::oMeta1:Refresh() return nil //----------------------------------------------------------------------------// METHOD HScroll( nType, lPage, nSteps ) CLASS TPreview local nXfactor, nXorig, nStep DEFAULT lPage := .F. if nType == GO_UP if ::oWnd:oHScroll:GetPos() <= ::oWnd:oHScroll:nMin return nil endif else if ::oWnd:oHScroll:GetPos() > ::oWnd:oHScroll:nMax return nil endif endif nXfactor := Int( ::oDevice:nHorzRes() / ::oWnd:oHScroll:nMax ) // DEVICE if nSteps != nil nStep := nSteps elseif lPage nStep := ::oWnd:oHScroll:nMax/10 else nStep := 1 endif if nType == GO_LEFT nStep := -nStep elseif nType == GO_POS ::oWnd:oHscroll:SetPos( nSteps ) nStep := 0 endif nXorig := nXfactor * ( ::oWnd:oHScroll:GetPos() + nStep - 1 ) if nXorig > ::oDevice:nHorzRes() // DEVICE nXorig := ::oDevice:nHorzRes() // DEVICE endif if nXorig < 0 nXorig := 0 endif #ifdef __CLIPPER__ ::oMeta1:SetOrg( nXorig, nil ) #else ::oMeta1:SetOrg( nXorig / ::oDevice:nHorzRes() * 10, nil ) // DEVICE #endif ::oMeta1:Refresh() return nil //----------------------------------------------------------------------------// METHOD SetOrg1( nX, nY ) CLASS TPreview local oCoors local nXStep, nYStep, nXFactor, nYFactor,; nWidth, nHeight, nXOrg if ::lZoom ::Zoom( .T. ) return nil endif oCoors := ::oMeta1:GetRect() nWidth := oCoors:nRight - oCoors:nLeft + 1 nHeight := oCoors:nBottom - oCoors:nTop + 1 if .f. nXStep := Max( Int( nX / nWidth * HSCROLL_RANGE ) - 9, 0 ) nXFactor := Int( ::oDevice:nHorzRes() / HSCROLL_RANGE ) // DEVICE endif if .f. nYStep := Max( Int( nY / nHeight * VSCROLL_RANGE ) - 9, 0 ) nYFactor := Int( ::oDevice:nVertRes() / VSCROLL_RANGE ) // DEVICE endif ::Zoom( .T. ) if ! Empty( nXStep ) ::HScroll( 2,, nxStep ) ::oWnd:oHScroll:SetPos( nxStep ) endif if ! Empty( nYStep ) ::VScroll( 2,, nyStep ) ::oWnd:oVScroll:SetPos( nyStep ) endif return nil //----------------------------------------------------------------------------// METHOD SetOrg2( nX, nY ) CLASS TPreview local oCoors local aFiles local nXStep, nYStep, nXFactor, nYFactor,; nWidth, nHeight, nXOrg if ::oMeta2:cCaption == "" return nil endif if ::lZoom ::Zoom( .T. ) return nil endif oCoors := ::oMeta2:GetRect() nWidth := oCoors:nRight - oCoors:nLeft + 1 nHeight := oCoors:nBottom - oCoors:nTop + 1 if .f. nXStep := Max( Int( nX / nWidth * HSCROLL_RANGE ) - 9, 0 ) nXFactor := Int( ::oDevice:nHorzRes() / HSCROLL_RANGE ) endif if .f. nYStep := Max( Int( nY / nHeight * VSCROLL_RANGE ) - 9, 0 ) nYFactor := Int( ::oDevice:nVertRes() / VSCROLL_RANGE ) // DEVICE endif ::oMeta1:SetFile( ::oMeta2:cCaption ) aFiles := ::oDevice:aMeta // DEVICE if ::nPage = Len( aFiles ) ::oMeta2:SetFile( "" ) else ::oMeta2:SetFile( aFiles[ ++::nPage ] ) endif if nStyle < 2007 ::oPage:Refresh() endif ::oBar:Refresh() ::Zoom( .T. ) if ! Empty( nXStep ) ::HScroll( 2,, nxStep ) ::oWnd:oHScroll:SetPos( nxStep ) endif if ! Empty( nYStep ) ::VScroll( 2,, nyStep ) ::oWnd:oVScroll:SetPos( nyStep ) endif return nil //----------------------------------------------------------------------------// METHOD CheckKey( nKey, nFlags ) CLASS TPreview if ! ::lZoom do case case nKey == VK_HOME ::TopPage() case nKey == VK_END ::BottomPage() case nKey == VK_PRIOR ::PrevPage() case nKey == VK_NEXT ::NextPage() endcase else do case case nKey == VK_UP ::oWnd:oVScroll:GoUp() case nKey == VK_PRIOR ::oWnd:oVScroll:PageUp() case nKey == VK_DOWN ::oWnd:oVScroll:GoDown() case nKey == VK_NEXT ::oWnd:oVScroll:PageDown() case nKey == VK_LEFT ::oWnd:oHScroll:GoUp() case nKey == VK_RIGHT if ::oWnd:oHScroll != nil .and. ::oWnd:oHScroll:nMax > 0 ::oWnd:oHScroll:GoDown() endif case nKey == VK_HOME ::oWnd:oVScroll:GoTop() ::oWnd:oHScroll:GoTop() ::oMeta1:SetOrg( 0, 0 ) ::oMeta1:Refresh() case nKey == VK_END ::oWnd:oVScroll:GoBottom() ::oWnd:oHScroll:GoBottom() ::oMeta1:SetOrg( .8 * ::oDevice:nHorzRes(), .8 * ::oDevice:nVertRes() ) // DEVICE ::oMeta1:Refresh() endcase endif return nil //----------------------------------------------------------------------------// METHOD CheckMouseWheel( nKeys, nDelta, nXPos, nYPos ) CLASS TPreview if ! ::lZoom if lAnd( nKeys, MK_MBUTTON ) if nDelta > 0 ::TopPage() else ::BottomPage() endif else if nDelta > 0 ::PrevPage() else ::NextPage() endif endif else if lAnd( nKeys, MK_MBUTTON ) if nDelta > 0 if ::oWnd:oVScroll:GetPos() > ::oWnd:oVScroll:nMin ::oWnd:oVScroll:PageUp() endif else if ::oWnd:oVScroll:GetPos() < ::oWnd:oVScroll:nMax ::oWnd:oVScroll:PageDown() endif endif else if nDelta > 0 if ::oWnd:oVScroll:GetPos() > ::oWnd:oVScroll:nMin ::oWnd:oVScroll:GoUp() endif else if ::oWnd:oVScroll:GetPos() < ::oWnd:oVScroll:nMax ::oWnd:oVScroll:GoDown() endif endif endif endif return nil //----------------------------------------------------------------------------// METHOD SetFactor( nValue ) CLASS TPreview local lInit := .F. if nValue == nil .and. ::oWnd:oMenu != nil AEval( ::aFactor, { | v, e | v:nHelpId := e } ) nValue := ::nZFactor lInit := .T. endif if ::oWnd:oMenu != nil AEval( ::aFactor, { | val, elem | val:SetCheck( elem == nValue ) } ) endif ::oMeta1:SetZoomFactor( ::nZFactor, ::nZFactor * 2 ) if ! ::lZoom .and. ! lInit // ::Zoom( .T. ) --> Fix from 12.05 to 12.06 endif if ::lZoom ::oWnd:oVScroll:SetRange( 1, VSCROLL_RANGE ) if ::nZFactor > 1 ::oWnd:oHScroll:SetRange( 1, HSCROLL_RANGE ) else ::oWnd:oHScroll:SetRange( 0, 0 ) endif endif ::oMeta1:SetFocus() return nil //----------------------------------------------------------------------------// METHOD PrintPage() CLASS TPreview local hOldRes := GetResources() local hMeta := ::oMeta1:hMeta local oDlg, oRad, oPageIni, oPageFin local nOption := 1, nFirst := 1, nLast := Len( ::oDevice:aMeta ) // DEVICE local oThis := Self if nLast == 1 ::PrintPrv( nil, nOption, nFirst, nLast ) return nil endif SET RESOURCES TO ::cResFile DEFINE DIALOG oDlg RESOURCE "PRINT" REDEFINE BUTTON ID 101 OF oDlg ; ACTION oThis:PrintPrv( oDlg, nOption, nFirst, nLast ) REDEFINE BUTTON ID 102 OF oDlg ACTION oDlg:End() REDEFINE RADIO oRad VAR nOption ID 103, 104, 105 OF oDlg ; ON CHANGE If( nOption==3 ,; ( oPageIni:Enable(), oPageFin:Enable() ),; ( oPageIni:Disable(), oPageFin:Disable() ) ) REDEFINE GET oPageIni ; VAR nFirst ID 106 PICTURE "@K 99999" ; VALID If( nFirst < 1 .or. nFirst > nLast, ( MsgBeep(), .F. ), .T. ) ; OF oDlg REDEFINE GET oPageFin ; VAR nLast ID 107 PICTURE "@K 99999" ; VALID If( nLast < nFirst .or. nLast > Len( ::oDevice:aMeta ), ; // DEVICE ( MsgBeep(),.F. ), .T.) OF oDlg oPageIni:Disable() oPageFin:Disable() SetResources( hOldRes ) ACTIVATE DIALOG oDlg return nil //----------------------------------------------------------------------------// METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd ) CLASS TPreview local oDevice := ::oDevice // DEVICE local aFiles := oDevice:aMeta local hMeta := ::oMeta1:hMeta local nFor CursorWait() StartDoc( oDevice:hDC, oDevice:cDocument ) do case case nOption == 1 // All for nFor := 1 to Len( aFiles ) #ifdef __CLIPPER__ StartPage( oDevice:hDC ) hMeta := GetMetaFile( aFiles[ nFor ] ) PlayMetaFile( oDevice:hDC, hMeta ) DeleteMetafile( hMeta ) EndPage( oDevice:hDC ) #else StartPage( oDevice:hDC ) hMeta := GetEnhMetaFile( aFiles[ nFor ] ) PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. ) DeleteEnhMetafile( hMeta ) EndPage( oDevice:hDC ) #endif next case nOption == 2 // Current page StartPage( oDevice:hDC ) hMeta := ::oMeta1:hMeta #ifdef __CLIPPER__ PlayMetaFile( oDevice:hDC, hMeta ) #else PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. ) #endif EndPage( oDevice:hDC ) case nOption == 3 // Range for nFor := nPageIni to nPageEnd StartPage( oDevice:hDC ) #ifdef __CLIPPER__ hMeta := GetMetaFile( aFiles[ nFor ] ) PlayMetaFile( oDevice:hDC, hMeta ) DeleteMetafile( hMeta ) #else hMeta := GetEnhMetaFile( aFiles[ nFor ] ) PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. ) DeleteEnhMetafile( hMeta ) #endif EndPage( oDevice:hDC ) next endcase EndDoc( oDevice:hDC ) CursorArrow() if oDlg != nil oDlg:End() endif return nil //----------------------------------------------------------------------------// METHOD ExportToMSWord() CLASS TPreview local oDoc if ValType( ::bExportToWord ) == 'B' return Eval( ::bExportToWord, Self ) endif oDoc := ConvertToWordDoc( Self ) if oDoc != nil oDoc:Application:Visible := .t. endif return Self //----------------------------------------------------------------------------// METHOD SaveAsMenu() CLASS TPreview local oPop MENU oPop POPUP oPop:l2007 := ( nStyle == 2007 ) oPop:l2010 := ( nStyle == 2010 ) MENUITEM "DOC Format" RESOURCE "Word" ACTION ::SaveAs( .f. ) MENUITEM "PDF Format" RESOURCE "PDF" ACTION ::SaveAs( .t. ) ENDMENU return oPop //----------------------------------------------------------------------------// METHOD SaveAs( lPDF ) CLASS TPreview local oWord, nVer, oDoc local cFile, cExt, cMsg, lView if lPDF if ValType( ::bSaveAsPDF ) == 'B' return Eval( ::bSaveAsPDF, Self ) endif else if ValType( ::bSaveAsWord ) == 'B' return Eval( ::bSaveAsWord, Self ) endif endif oWord := WinWordObj() if oWord == nil if lPDF Return FWSavePreviewToPDF( Self ) ELSE Return ToWordDocViaWriter( Self, , "W") Endif endif nVer := Val( oWord:Version ) if lPDF /* if nVer < 12.0 MsgInfo( "This option requires Word 2007 or later" ) return nil elseif !WordHasPDFPlugIn() MsgInfo( "Download and Install" + CRLF + ; "SaveAsPDF plugin from" + CRLF + ; "Microsoft Office Online Website" ) return nil endif */ if nVer >= 12.0 .and. WordHasPDFPlugIn() cExt := "*.pdf" else return FWSavePreviewToPDF( Self ) endif else cExt := If( nVer < 12.0, "*.doc", "*.docx; *.doc" ) endif cMsg := If( lPDF, "PDF", "Doc" ) + ; " File to Save( " + cExt + ") |" + cExt + "|" if Empty( cFile := cGetFile( cMsg, "File to Save", 1, CurDir(), , .t. ) ) return nil endif if !( Lower( cFileExt( cFile ) ) $ cExt ) cFile := cFilePath( cFile ) + cFileNoExt( cFile ) + ; If( lPDF, ".pdf", If( nVer < 12.0, ".doc", ".docx" ) ) endif lView := MsgYesNo( "View " + cFile + "?" ) oDoc := ConvertToWordDoc( Self ) if oDoc != nil TRY oDoc:ExportAsFixedFormat( cFile, 17, lView ) CATCH MsgInfo( "PDF Plugin Error" ) END if lPDF oDoc:Close( .f. ) else if nVer >= 12.0 oDoc:SaveAs( cFile, If( Lower( cFileExt( cFile ) ) == 'doc', 0, 16 ) ) else oDoc:SaveAs( cFile ) endif if lView oDoc:Application:Visible := .t. else oDoc:Close( .f. ) endif endif endif return nil //----------------------------------------------------------------------------// function RPreview( oDevice, oReport ) local oPreview := TPreview():New( oDevice ) oPreview:oReport := oReport oPreview:Activate() return nil //----------------------------------------------------------------------------// function ConvertToWordDoc( oPreview ) local aFiles := oPreview:oDevice:aMeta local oWord, oDoc, cEMF if Len( aFiles ) > 0 // oDoc:=ToWordDocViaWriter( oPreview, aFiles, "W" ) // W -> Word Doc, P -> PDF /* Anser :- For testing purpose, I have commented the lines below. On production, * uncomment the lines below and delete the line just above this comment * ie oDoc:=ToWordDocViaWriter( oPreview, aFiles) */ if ( oWord := WinWordObj() ) == nil MsgAlert( "MS Word not installed" ) oDoc:=ToWordDocViaWriter( oPreview, aFiles, "W" ) else oDoc := oWord:Documents:Add() if oDoc == nil MsgAlert( "Failed to Create Word Document" ) else oDoc:PageSetup:Orientation := If( oPreview:oDevice:GetOrientation() == 1, 0, 1 ) WITH OBJECT oDoc:PageSetup :LeftMargin := 0 :TopMargin := 0 :RightMargin := 0 :BottomMargin := 0 END for each cEMF in aFiles oWord:Selection:InlineShapes:AddPicture( cEMF, .f., .t. ) next // oDoc:Application:Visible := .t. endif endif else MsgAlert( "There is no output for export" ) /**/ endif return oDoc //----------------------------------------------------------------------------// Function ToWordDocViaWriter( oPreview, aFiles, cFileType ) Local oWriter,oDesktop,oDoc,oCusor,oText,oGraphic,cEMF,cURL,i,aProp,oStyle,nPageWidth,nPageHeight,aPdfFilters Local cExt,cMsg,cFile,oSize, oCursor DEFAULT cFileType:="W" // ByDefault Word File DEFAULT aFiles:=oPreview:oDevice:aMeta if Len( aFiles ) == 0 MsgAlert( "There is no output for export" ) Return nil Endif if ( oWriter := SunCalcObj() ) == nil MsgAlert( "No .Doc file manipulation software installed" ) Return NIL Endif oDesktop := oWriter:CreateInstance( "com.sun.star.frame.Desktop" ) // Create OpenOffice Word Instance with the Window Hidden Property aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "Hidden", .T. ) ) oDoc := oDesktop:LoadComponentFromURL( "private:factory/swriter", "_blank", 0, aProp ) oDoc:Refresh() // Set Page Orientation Properties ie Portrait/Landscape aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "PaperOrientation", If( oPreview:oDevice:GetOrientation() == 1, 0, 1 ) ) ) // 0-> Portrait, 1-> Landscape oDoc:Printer:= aProp oStyle = oDoc:StyleFamilies:getByName("PageStyles"):getByName("Standard") // Set Page Margins oStyle:LeftMargin :=0 oStyle:TopMargin :=0 oStyle:RightMargin :=0 oStyle:BottomMargin:=0 // Find out the Page's Size ie Height and width. Later this size is used to set the EMF image size // while inserting on the page nPageWidth:= oStyle:Size:Width - oStyle:LeftMargin - oStyle:RightMargin nPageHeight:=oStyle:Size:Height - oStyle:TopMargin - oStyle:BottomMargin // Create a Size Structure. This size structure is later used to set the image size oSize:= oWriter:Bridge_GetStruct( "com.sun.star.awt.Size" ) oSize:Width:=nPageWidth oSize:Height = nPageHeight i:=1 For each cEMF in aFiles cURL:=ConvertToOoURL(cEMF) oText:=oDoc:GetText() oCursor:= oText:CreateTextCursor() oCursor:GotoEnd(.F.) If i > 1 // Applicable only for page nos > 1 oText:InsertControlCharacter( oCursor, 0, .F. ) // 0->New Paragraph, 1->New line in a paragraph, 5->This control character appends a new paragraph. Endif oGraphic:= oDoc:CreateInstance("com.sun.star.text.GraphicObject") oGraphic:SetPropertyValue("GraphicURL", cURL ) oGraphic:SetPropertyValue("AnchorType",1) // com.sun.star.text.TextContentAnchorType.AS_CHARACTER oGraphic:SetSize(oSize) oText:InsertTextContent( oCursor:End, oGraphic, .F.) i++ next // Convert the image links and then Embedd the images onto the document OoEmbeddGraphics(oWriter,oDoc) cExt := If( cFileType == "W", "*.doc", "*.pdf" ) cMsg := If( cFileType == "W", "Doc", "PDF" ) + ; " File to Save( " + cExt + ") |" + cExt + "|" if Empty( cFile := cGetFile( cMsg, "File to Save", 1, CurDir(), , .t. ) ) oDoc:Close(1) // To Close OpenOffice Writer oDesktop:terminate() // To close the OpenOffice QuickOpen Window Return nil endif if !( Lower( cFileExt( cFile ) ) $ cExt ) cFile := cFilePath( cFile ) + cFileNoExt( cFile ) + ; If( cFileType == "W", ".doc", ".pdf" ) endif // Convert the FileName and Path to OpenOffice Standard URL cURL:=ConvertToOoURL(cFile) // The Word or PDF file will be saved in the Temp Folder * cURL:=ConvertToOoURL(Getenv("TMP")+"\") * cURL:=cURL+cTempFile() if cFileType == "W" // Word * cURL:=cURL+"Doc" // Save the Writer File as Word 97/2000/XP .Doc file. This is the most compatible format aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "FilterName", "MS Word 97" ) ) oDoc:StoreToURL( cURL, aProp ) Else // PDF * cURL:=cURL+"Pdf" // Save the Writer File as PDF file aPdfFilters:={} AAdd(aPdfFilters,GetPropertyValue(oWriter, "UseLosslessCompression", .T. ) ) // Specifies if graphics are exported // to PDF using a lossless compression. If this property is set to true, it overwrites the "Quality" property AAdd(aPdfFilters,GetPropertyValue(oWriter, "ReduceImageResolution", .F. ) ) AAdd(aPdfFilters,GetPropertyValue(oWriter, "Quality", 50 ) ) // Value can be between 1 to 100 aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "FilterName", "writer_pdf_Export" ) ) AAdd(aProp,GetPropertyValue(oWriter, "FilterData", aPdfFilters ) ) oDoc:StoreToURL( cURL, aProp ) Endif // Inform the user about the Exported Filename along with the Full path * MsgInfo(cUrl) * oDoc:GetCurrentController():GetFrame():GetContainerWindow():SetVisible(.T.) oDoc:Close(1) // To Close OpenOffice Word oDesktop:terminate() // To close the OpenOffice QuickOpen Window oDoc:=nil Return nil //------------------------------------// Static Function OoEmbeddGraphics(oWriter,oDoc) Local oDrawPage,oProvider,aProp,i,oGraphic oDrawPage = oDoc:DrawPage oProvider = oWriter:CreateInstance("com.sun.star.graphic.GraphicProvider") If oDrawPage:hasElements() For i = 0 To oDrawPage:Count - 1 oGraphic = oDrawPage:getByIndex(i) If oGraphic:supportsService("com.sun.star.text.TextGraphicObject") aProp:={} AAdd(aProp,GetPropertyValue(oWriter, "URL", oGraphic:GraphicUrl ) ) oGraphic:Graphic = oProvider:queryGraphic(aProp) EndIf Next i EndIf Return NIL //----------------------------------------------------------------------------// static function WordHasPDFPlugIn() static lPDF local oWord, oFilter if lPDF == nil lPDF := .f. if ( oWord := WinWordObj() ) != nil .and. Val( oWord:Version ) >= 12.0 for each oFilter in oWord:FileDialog( 2 ):Filters if "*.pdf" $ oFilter:Extensions lPDF := .t. exit endif next endif endif return lPDF //--------------------------------------------------------------------// function RPrevUserBtns( bNewUserBtns, nBarStyle, aSize ) local bPrev := bUserBtns if PCount() > 0 bUserBtns := bNewUserBtns if PCount() > 1 if nBarStyle == nil nStyle := nil elseif ValType( nBarStyle ) == 'L' .and. nBarStyle == .t. nStyle := 2007 elseif ValType( nBarStyle ) == 'N' .and. AScan( { 97, 2007, 2010 }, nBarStyle ) > 0 nStyle := nBarStyle endif if PCount() > 2 if ValType( aSize ) == 'A' .and. Len( aSize ) >= 2 nBtnW := aSize[ 1 ] nBtnH := aSize[ 2 ] endif endif endif endif return bPrev //--------------------------------------------------------------------// #ifdef __CLIPPER__ static function IsAppThemed() return .f. static function TToolBar() return nil static function TRebar() return nil #endif //------------------------------------------------------------------------ // función para cambiar la impresora desde previo mcn valdenebro //------------------------------------------------------------------------ Func f_CamImpre (oDevice, cCbx ) local cPrinter /* IF VALTYPE(oDevice)=="U" oDevice:=" " Endif */ cPrinter := GetProfString( "windows", "device" , "" ) WriteProfString( "windows", "device", cCbx ) SysRefresh() PrinterInit() //DeleteDC( oDevice:hDC ) // Sugestion by Enrico M. Giordano // Insert here the function to create the report // oWnd:End() // George - To close current preview oDevice:hDC := GetPrintDefault( GetActiveWindow() ) SysRefresh() //WriteProfString( "windows", "device", cPrinter ) RETURN nil id=code>id=code>Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd Editado por - ar-siste on 19/11/2012 13:56:35 Editado por - ar-siste on 19/11/2012 13:57:35 Editado por - ar-siste on 19/11/2012 13:59:41 Editado por - ar-siste on 19/11/2012 14:03:02
  12. ar-siste

    WebCam

    Obrigado Silva mais estou trabalhando com exemplo da versão 12.09, e seu exemplo não deu certo. Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd
  13. ar-siste

    WebCam

    Olá pessoal! Usando o webcam.ch da nova versão do FWH12.09 o método de gravação esta em formato BMP, como mudar para JPG? Tem como definir um tamanho padrão para o arquivo (exemplo 100 x 140 px - famoso 3x4 fotográfico)? Outro ponto inconveniente é, abre o programa da da webcam mesmo ela não estando conectada, há como dar uma msg antes? Obrigado, Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd Editado por - ar-siste on 16/11/2012 14:08:06
  14. ar-siste

    WebCam

    Olá pessoal! Usando o webcam.ch da nova versão do FWH12.09 o método de gravação esta em formato BMP, como mudar para JPG? Tem como definir um tamanho padrão para o arquivo (exemplo 100 x 140 px - famoso 3x4 fotográfico)? Outro ponto inconveniente é, abre o programa da da webcam mesmo ela não estando conectada, há como dar uma msg antes? Obrigado, Abraços Arlindo Reis SKYPE: arsistemas xHarbour 1.2.1 + FWH 12.09 + BCC582 + xEdit IBM + WorkShop + Dbf Cdx + xBuildW + MySql + SqlRdd Editado por - ar-siste on 16/11/2012 14:08:06
  15. Boa noite Robério conseguiu o arquivo hbzebra.ch? Fiz download pelos links indicados e nada. Obg. Arlindo Reis ar@arsistemas.com.br
×
×
  • Create New...