RPREVIEW

syspel · September 14, 2016

Alguém consegue corrigir a impressão na tela desse RPREVIEW, ele mostra distorcido na tela, mas imprime corretamente.

#include "FiveWin.ch"
#include "mail.ch"

#ifdef __XHARBOUR__
#xtranslate HB_CurDrive() => CurDrive()
#xtranslate HB_TTOS( <t> ) => TTOS( <t> )
#xtranslate HB_DateTime() => DateTime()
#endif

#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, nStyle
static lWord, lCalc

//----------------------------------------------------------------------------//

CLASS TPreview

DATA oWnd, oBar, oFont, oImageList
DATA oDevice, oReport
DATA oHand, oCursor
DATA oMeta1, oMeta2, oSay, oFactor
DATA oPage, oTwoPages, oZoom
DATA oMenuZoom, oMenuTwoPages, oMenuUnZoom, oMenuOnePage
DATA cResFile
DATA aFactor, nPage, nZFactor
DATA lTwoPages, lZoom, lExit
DATA cPageNum

DATA hOldRes, hNewRes
DATA oLvw, oImageListPages

CLASSDATA cResFile
CLASSDATA oWndMain
CLASSDATA bPrint, bExportToWord, bSaveAsWord, bSaveAsPDF, bEmail

CLASSDATA lListViewHide INIT .F.

METHOD New( oDevice, oReport )
METHOD Activate()
METHOD BuildButtonBar()
METHOD BuildListView() // mini pages viewer
METHOD BuildWindow()
METHOD BuildMenu()
METHOD GoPage( nPage )
METHOD PaintMeta()
METHOD PrintersMenu()
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 SelPrinter( cPrinter )
METHOD SetFactor( nValue )
METHOD PrintPage()
METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd )

ACCESS CanExportToWord INLINE ::bExportToWord != nil .or. lWord != .f. .or. lCalc != .f.
ACCESS CanExportToExcel INLINE ( ::oReport != nil .and. ;
( ::oReport:bInit != nil .or. ::oReport:bToExcel != nil ) )
METHOD ExportToMSWord()

METHOD ExportToMSExcel() INLINE If( ::CanExportToExcel, ::oReport:ToExcel(), ;
MsgInfo( FWString( "Export to Excel is available only" ) + ;
CRLF + ;
FWString( "for Reports with ::bInit defined" ), FWString( "Information" ) ) )

METHOD SaveAsMenu()
METHOD SaveAs( lPDF )
METHOD SendEmail()

METHOD CheckStyle() PROTECTED
METHOD ResizeListView()

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( oDevice, oReport ) CLASS TPreview

if oDevice == nil
PRINTER oDevice PREVIEW
PAGE
ENDPAGE
// MsgInfo( oDevice:aMeta[ 1 ] )
// ENDPRINTER
endif

::oDevice := oDevice
::oReport := oReport
::nPage := 1
::nZFactor := 1
::lTwoPages := .F.
::lZoom := .F.
::lExit := .F.

::BuildWindow()

return Self

//----------------------------------------------------------------------------//

METHOD Activate() CLASS TPreview

local hWndMain

if ::oWnd == nil
return nil
endif

ACTIVATE WINDOW ::oWnd MAXIMIZED ;
ON RESIZE ( ::PaintMeta(), ::ResizeListView() ) ;
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() ,;
If( Empty( ::oImageList ),, ( ::oImageList:End(), ::oImageList := nil ) ),;
If( ! Empty( ::oImageListPages ), ::oImageListPages:End(),),;
::oWnd := nil ,;
::oDevice:oPreview := nil ,;
::lExit := .T. )

if ::oDevice:lPrvModal
if ::oWndMain == nil
StopUntil( { || ::lExit } )
else
// StopUntil( { || ::lExit .or. !IsWindow( WndMain():hWnd ) } ) // errors our when WndMain() becomes nil
hWndMain := WndMain():hWnd
StopUntil( { || ::lExit .or. !IsWindow( hWndMain ) } )
endif
endif

return nil

//----------------------------------------------------------------------------//

METHOD BuildButtonBar() CLASS TPreview

local oImageList, oReBar, oBar, oHand, uRet, oBtn

DEFINE CURSOR ::oHand HAND

if lRebar
DEFINE IMAGELIST oImageList SIZE 16, 16

oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "top2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "previous2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "next2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "bottom2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "zoom2" ) ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "twopages2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "printer" ) ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "save" ) ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "pdf" ) ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "email" ) ), nRGB( 255, 255, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "word2" ) ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "excel" ) ), nRGB( 255, 0, 255 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "exit2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "onepage2" ) ), nRGB( 192, 192, 192 ) )
oImageList:AddMasked( TBitmap():Define( ,,, FWBitmap( "onepage2" ) ), 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 FWString( "First" ) ;
MESSAGE FWString( "Go to first page" )

DEFINE TBBUTTON OF oBar ;
ACTION ::PrevPage() ;
TOOLTIP FWString( "Previous" ) ;
MESSAGE FWString( "Go to previous page" )

DEFINE TBBUTTON OF oBar ;
ACTION ::NextPage() ;
TOOLTIP FWString( "Next" ) ;
MESSAGE FWString( "Go to next page" )

DEFINE TBBUTTON OF oBar ;
ACTION ::BottomPage() ;
TOOLTIP FWString( "Last" ) ;
MESSAGE FWString( "Go to last page" )

DEFINE TBSEPARATOR OF oBar

DEFINE TBBUTTON OF oBar ;
ACTION ::Zoom() ;
TOOLTIP FWString( "Zoom" ) ;
MESSAGE FWString( "Page zoom" )

DEFINE TBBUTTON OF oBar ;
ACTION ::TwoPages() ;
TOOLTIP FWString( "Two pages" ) ;
MESSAGE FWString( "Preview on two pages" )

DEFINE TBSEPARATOR OF oBar

DEFINE TBMENU OF oBar ;
ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ;
TOOLTIP FWString( "Print" ) ;
MESSAGE FWString( "Print actual page" ) ;
MENU ::PrintersMenu()

DEFINE TBMENU OF oBar ;
ACTION ::SaveAs( .f. ) ;
TOOLTIP FWString( "Save as" ) ;
MESSAGE FWString( "Save to DOC/PDF" ) ;
MENU ::SaveAsMenu()

DEFINE TBBUTTON OF oBar ;
ACTION ::SaveAs( .t. ) ; //If( ::bSaveAsPDF == nil, FWSavePreviewToPDF( Self ), Eval( ::bSaveAsPDF, Self ) ) ;
TOOLTIP FWString( "Export to PDF" ) ;
MESSAGE FWString( "Export to PDF" )

DEFINE TBBUTTON OF oBar ;
ACTION ::SendEmail() ;
TOOLTIP FWString( "Send by email as PDF" ) ;
MESSAGE FWString( "Send by email as PDF" )

DEFINE TBBUTTON OF oBar ;
ACTION ::ExportToMSWord() ;
TOOLTIP FWString( "Export to MS Word" ) ;
MESSAGE FWString( "Export to MS Word" )

DEFINE TBBUTTON OF oBar ;
ACTION ::ExportToMSExcel() ;
TOOLTIP FWString( "Export to Excel" ) ;
MESSAGE FWString( "Export to Excel" ) ;
WHEN ::CanExportToExcel

DEFINE TBSEPARATOR OF oBar

DEFINE TBBUTTON OF oBar ;
ACTION ::oWnd:End() ;
TOOLTIP FWString( "Exit" ) ;
MESSAGE FWString( "Exit from preview" )

else
if nStyle == 2010
DEFINE BUTTONBAR oBar OF ::oWnd 2010 ;
SIZE IfNil( nBtnW, 26 ), IfNil( nBtnH, If( LargeFonts(), 30, 26 ) )
else
DEFINE BUTTONBAR oBar OF ::oWnd ;
SIZE IfNil( nBtnW, 26 ), IfNil( nBtnH, If( LargeFonts(), 30, 26 ) )
endif
::oBar = oBar
oBar:l2007 := ( nStyle == 2007 )
oBar:l2010 := ( nStyle == 2010 )
oBar:l97Look := ( nStyle == 97 )
oBar:bRClicked := { || nil } // to retain the bar on top only

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Go to first page" ) ;
ACTION ::TopPage() ;
TOOLTIP FWString( "First" )

oBtn:hBitmap1 = FWBitmap( "top2" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Go to previous page" ) ;
ACTION ::PrevPage() ;
TOOLTIP FWString( "Previous" )

oBtn:hBitmap1 = FWBitmap( "previous2" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Go to next page" ) ;
ACTION ::NextPage() ;
TOOLTIP FWString( "Next" )

oBtn:hBitmap1 = FWBitmap( "Next2" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Go to last page" ) ;
ACTION ::BottomPage() ;
TOOLTIP FWString( "Last" )

oBtn:hBitmap1 = FWBitmap( "Bottom2" )

DEFINE BUTTON ::oZoom OF oBar GROUP ;
MESSAGE FWString( "Page zoom" ) ;
ACTION ::Zoom() ;
TOOLTIP FWString( "Zoom" )

::oZoom:hBitmap1 = FWBitmap( "Zoom2" )

DEFINE BUTTON ::oTwoPages OF oBar ;
MESSAGE FWString( "Preview on two pages" ) ;
ACTION ::TwoPages() ;
TOOLTIP FWString( "Two pages" )

::oTwoPages:hBitmap1 = FWBitmap( "TwoPages2" )

DEFINE BUTTON oBtn OF oBar GROUP ;
MENU ::PrintersMenu() ;
MESSAGE FWString( "Print actual page" ) ;
ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ;
TOOLTIP FWString( "Print" )

oBtn:hBitmap1 = FWBitmap( "Printer" )

if ! Empty( bUserBtns )
uRet = Eval( bUserBtns, Self, oBar )
endif

if ! ( ValType( uRet ) == 'L' .and. uRet == .f. )

DEFINE BUTTON oBtn OF oBar ;
MENU ::SaveAsMenu() ;
MESSAGE FWString( "Save to DOC/PDF" ) ;
ACTION This:ShowPopUp() ;
TOOLTIP FWString( "Save to DOC/PDF" )

oBtn:hBitmap1 = FWBitmap( "Save" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Export to PDF" ) ;
ACTION ::SaveAs( .t. ) ;
TOOLTIP FWString( "Export to PDF" )

oBtn:hBitmap1 = FWBitmap( "PDF" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Send by email as PDF" ) ;
ACTION ::SendEmail() ;
TOOLTIP FWString( "Send by email as PDF" )

oBtn:hBitmap1 = FWBitmap( "email" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Export to MS Word" ) ;
ACTION ::ExportToMSWord() ;
TOOLTIP FWString( "Export to MS Word" ) ;
WHEN ::CanExportToWord

oBtn:hBitmap1 = FWBitmap( "Word2" )

DEFINE BUTTON oBtn OF oBar ;
MESSAGE FWString( "Export to Excel" ) ;
ACTION ::ExportToMSExcel() ;
TOOLTIP FWString( "Export to Excel" ) ;
WHEN ::CanExportToExcel

oBtn:hBitmap1 = FWBitmap( "Excel" )

endif

DEFINE BUTTON oBtn OF oBar GROUP ;
MESSAGE FWString( "Exit from preview" ) ;
ACTION ::oWnd:End() ;
TOOLTIP FWString( "Exit" )

oBtn:hBitmap1 = FWBitmap( "Exit2" )

AEval( oBar:aControls, { | o | o:oCursor := ::oHand } )

endif

return nil

//----------------------------------------------------------------------------//

METHOD BuildWindow() CLASS TPreview

local oIcon, cTitle := FWString( "Printing Preview" )
local oCursor, oBar, nCol := 325
local oThis := Self, nRow := 7

if Len( ::oDevice:aMeta ) < 1
return nil
endif

DEFAULT ::oWndMain := WndMain()

::hNewRes := 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

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 ;
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 = FWString( "Page number:" )
::BuildButtonBar()

if lRebar
DEFINE STATUSBAR OF ::oWnd PROMPT " " + FWString( "Preview" )
else
SET MESSAGE OF ::oWnd TO FWString( "Preview" ) CENTERED ;
NOINSET CLOCK DATE KEYBOARD
::oWnd:oMsgBar:l2007 := ( nStyle == 2007 )
::oWnd:oMsgBar:l2010 := ( nStyle == 2010 )
endif

// We build the left thumbs listview
if ! ::lListViewHide
::BuildListView()
endif

// We build the main metafiles to display the pages

::oMeta1 := TMetaFile():New( 0, 0, 0, 0,;
::oDevice:aMeta[ 1 ],;
::oWnd,;
CLR_BLACK,;
CLR_WHITE,;
::oDevice:nHorzRes(),;
::oDevice:nVertRes() )

DEFINE CURSOR ::oCursor SEARCH

::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 ) }

::oMeta2 := TMetaFile():New( 0, 0, 0, 0, "",;
::oWnd, CLR_BLACK, CLR_WHITE, ::oDevice:nHorzRes(),;
::oDevice:nVertRes() )

::oMeta2:oCursor = ::oCursor
::oMeta2:blDblClick := { | nRow, nCol, nKeyFlags | ;
::SetOrg2( nCol, nRow, nKeyFlags ) }

::oMeta2:hide()

::SetFactor()

oBar := ::oBar

if .T. // ! lRebar
nCol := If( ! Empty( oBar:aControls ), ATail( oBar:aControls ):nRight, Len( oBar:aButtons ) * ( oBar:nBtnWidth + 2 ) ) + 30
nRow := Int( oBar:nHeight / 2 ) - 6
endif

if nStyle >= 2007
oBar:bPainted = { || oBar:Say( nRow, nCol, "Factor:",,, ::oFont, .T., .T. ),;
oBar:Say( nRow, nCol+100, ::cPageNum + " " + ;
LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( ::oDevice:aMeta ) ) ),,, ::oFont, .T., .T. ) }

endif

if nStyle < 2007
@ nRow, nCol SAY ::oSay PROMPT "Factor:" ;
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
@ nRow, nCol + 100 SAY ::oPage PROMPT FWString( "Page number:" ) + ;
LTrim( Str( ::nPage, 4, 0 ) ) + " / " + ;
LTrim( Str( Len( ::oDevice:aMeta ) ) ) ;
SIZE 180, 15 PIXEL OF ::oBar FONT ::oFont
::oPage:lTransparent = .T.
endif

if lRebar .or. nStyle >= 2007
#define NULL_BRUSH 5
FixSays( ::oBar:hWnd, GetStockObject( NULL_BRUSH ) )
endif

::oFactor:Set3dLook( .T. )

::oWnd:oHScroll:bPos := { | nPos | ::HScroll( GO_POS, .f., nPos ) }
::oWnd:oVScroll:bPos := { | nPos | ::VScroll( GO_POS, .f., nPos ) }

return nil

//----------------------------------------------------------------------------//

METHOD BuildListView() CLASS TPreview

local nSizeH, nSizeV, oBmp, n, aPrompts := {}

if ::oDevice:nHorzRes() > ::oDevice:nVertRes()
nSizeH = 100
nSizeV = 80
else
nSizeH = 80
nSizeV = 100
endif

oBmp = TBitmap():Define()
::oImageListPages = TImageList():New( nSizeH, nSizeV )

for n := 1 to Len( ::oDevice:aMeta )
oBmp:hBitmap := PageBitmap( ::oDevice:aMeta[ n ], nSizeH, nSizeV )
::oImageListPages:Add( oBmp )
Aadd( aPrompts, AllTrim( Str( n ) ) )
NEXT

::oLvw = TListView():New( 33 - If( ::oWnd:oTop:IsKindOf( "TBAR" ), 6, 0 ),;
0, aPrompts, { | nPage | ::GoPage( nPage ) }, ::oWnd,;
,, .T.,, nSizeH + 45, ScreenHeight() - ;
If( ::oWnd:oBar != nil, ::oWnd:oBar:nHeight() - 2,;
::oWnd:oTop:nHeight() ) - ;
If( ::oWnd:oMsgBar != nil, ::oWnd:oMsgBar:nHeight(),;
::oWnd:oBottom:nHeight() ) - 38 )
::oLvw:SetImageList( ::oImageListPages )
::oLvw:bRClicked = { || If( ::oLvw:nLeft == 0,;
::oLvw:nLeft := ::oWnd:nWidth - ::oLvw:nWidth - 30,;
::oLvw:nLeft := 0 ) }

return nil

//----------------------------------------------------------------------------//

static function PageBitmap( cEMF, nWidth, nHeight )

local hDC1 := GetDC( GetDesktopWindow() )
local hDC2 := CreateCompatibleDC( hDC1 )
local hBmp := CreateCompatibleBitmap( hDC1, nWidth, nHeight )
local hOldBmp := SelectObject( hDC2, hBmp )
local hEMF := GetEnhMetaFile( cEmf )

Rectangle( hDC2, 0, 0, nHeight, nWidth )
XPlayEnhMetaFile( hDC2, hEMF, 0, 0, nHeight, nWidth )
CloseEnhMetafile( hEMF )

SelectObject( hDC2, hOldBmp )
DeleteDC( hDC2 )
ReleaseDC( hDC1 )

return hBmp

//----------------------------------------------------------------------------//

METHOD BuildMenu() CLASS TPreview

local nFor, oMenu, oMItem
local lThemed := IsAppThemed()

::aFactor := Array( 9 )

MENU oMenu
oMenu:l2007 := ( nStyle == 2007 )
oMenu:l2010 := ( nStyle == 2010 )
MENUITEM FWString( "&File" )
MENU
MENUITEM oMItem PROMPT FWString( "&Print" ) ACTION If( ValType( ::bPrint ) == 'B', Eval( ::bPrint, Self ), ::PrintPage() ) ;
MESSAGE FWString( "Print actual page" )

oMItem:hBitmap = FWBitmap( "printer" )

SEPARATOR

MENUITEM oMItem PROMPT FWString( "&Exit" ) ACTION ::oWnd:End() ;
MESSAGE FWString( "Exit from preview" )

oMItem:hBitmap = FWBitmap( "Exit2" )
ENDMENU

MENUITEM FWString( "&Page" )
MENU
MENUITEM oMItem PROMPT FWString( "&First" ) ACTION ::TopPage() ;
MESSAGE FWString( "Go to first page" )

oMItem:hBitmap = FWBitmap( "top2" )

MENUITEM oMItem PROMPT FWString( "&Previous" ) ACTION ::PrevPage() ;
MESSAGE FWString( "Go to previous page" )

oMItem:hBitmap = FWBitmap( "previous2" )

MENUITEM oMItem PROMPT FWString( "&Next" ) ACTION ::NextPage() ;
MESSAGE FWString( "Go to next page" )

oMItem:hBitmap = FWBitmap( "next2" )

MENUITEM oMItem PROMPT FWString( "&Last" ) ACTION ::BottomPage() ;
MESSAGE FWString( "Go to last page" )

oMItem:hBitmap = FWBitmap( "bottom2" )

SEPARATOR

MENUITEM oMItem PROMPT ::oMenuZoom PROMPT FWString( "&Zoom" ) ACTION ::Zoom( .T. ) ;
MESSAGE FWString( "Page zoom" )

oMItem:hBitmap = FWBitmap( "zoom2" )

MENUITEM oMItem PROMPT ::oMenuUnZoom PROMPT FWString( "&Normal" ) ACTION ::Zoom( .T. ) ;
MESSAGE FWString( "Page unzoom" )

oMItem:hBitmap = FWBitmap( "onepage2" )

MENUITEM FWString( "&Factor" ) MESSAGE FWString( "Zoom factor" )
MENU
for nFor := 1 to Len( ::aFactor )
MENUITEM ::aFactor[ nFor ] ;
PROMPT "&" + LTrim( Str( nFor ) ) ;
MESSAGE FWString( "Factor" ) + " " + LTrim( Str( nFor ) ) ;
ACTION ( ::oFactor:Set( oMenuItem:nHelpId ),;
Eval( ::oFactor:bChange ) )

next
ENDMENU

SEPARATOR

MENUITEM ::oMenuTwoPages PROMPT FWString( "&Two pages" ) ACTION ::TwoPages( .T. ) ;
MESSAGE FWString( "Preview on two pages" )

::oMenuTwoPages:hBitmap = FWBitmap( "TwoPages2" )

MENUITEM ::oMenuOnePage PROMPT FWString( "One &page" ) ACTION ::TwoPages(.T.) ;
MESSAGE FWString( "Preview on one page" )

::oMenuOnePage:hBitmap = FWBitmap( "onepage2" )
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:l2010, 2010, 2007 ) )
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 GoPage( nPage ) CLASS TPreview

local aFiles := ::oDevice:aMeta

if nPage > Len( aFiles ) .OR. nPage < 1
MsgBeep()
return .F.
endif

::nPage := nPage

::oMeta1:SetFile( aFiles[ ::nPage ] )
if nStyle < 2007
::oPage:SetText( FWString( "Page number:" ) + " " + ;
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()

return .T.

//----------------------------------------------------------------------------//

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 aFiles := ::oDevice:aMeta // DEVICE

if ::nPage >= Len( aFiles )
MsgBeep()
return nil
endif

::nPage++

::oMeta1:SetFile( aFiles[ ::nPage ] )
if nStyle < 2007
::oPage:SetText( FWString( "Page number:" ) + 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()

return nil

//----------------------------------------------------------------------------//

METHOD PrevPage() CLASS TPreview

local aFiles := ::oDevice:aMeta // DEVICE

if ::nPage == 1
MsgBeep()
return nil
endif

::nPage--

::oMeta1:SetFile( aFiles[ ::nPage ] )

if nStyle < 2007
::oPage:SetText( FWString( "Page number:" ) + 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()

return nil

//----------------------------------------------------------------------------//

METHOD TopPage() CLASS TPreview

local aFiles := ::oDevice:aMeta // DEVICE

if ::nPage == 1
MsgBeep()
return nil
endif

::nPage = 1

::oMeta1:SetFile( aFiles[ ::nPage ] )
if nStyle < 2007
::oPage:SetText( FWString( "Page number:" ) + " " + 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()

return nil

//----------------------------------------------------------------------------//

METHOD BottomPage() CLASS TPreview

local aFiles := ::oDevice:aMeta // DEVICE

if ::nPage == Len( aFiles )
MsgBeep()
return nil
endif

::nPage = Len( aFiles )

::oMeta1:SetFile( aFiles[ ::nPage ] )
if nStyle < 2007
::oPage:SetText( FWString( "Page number:" ) + " " + LTrim( Str( ::nPage, 4, 0 ) ) + ;
" / " + LTrim( Str( Len( aFiles ) ) ) )
endif
::oBar:Refresh()
::oMeta1:Refresh()

if ::lTwoPages
::oMeta2:SetFile( "" )
::oMeta2:Refresh()
endif

::oMeta1:SetFocus()

return nil

//----------------------------------------------------------------------------//

METHOD TwoPages( lMenu ) CLASS TPreview

DEFAULT lMenu := .F.

::lTwoPages := ! ::lTwoPages

if ::lTwoPages

if Len( ::oDevice:aMeta) == 1 // solo hay una pagina // DEVICE
::lTwoPages := ! ::lTwoPages
MsgBeep()
return nil
endif

if ::oDevice:nHorzSize() >= ; // Apaisado // DEVICE
::oDevice:nVertSize() // DEVICE
::lTwoPages := ! ::lTwoPages
MsgBeep()
return nil
endif

if ::lZoom
::Zoom( .T. )
endif

if ! lRebar
::oTwoPages:FreeBitmaps()
::oTwoPages:hBitmap1 = FWBitmap( "OnePage2" )
::oTwoPages:cMsg = FWString( "Preview on one page" )
::oTwoPages:cTooltip = StrTran( FWString( "One &page" ), '&', '' )
else
::oBar:ChangeBitmap( 6, 10+2 )
::oBar:SetTooltip( 6, StrTran( FWString( "One &page" ), '&', '' ) )
::oBar:SetMessage( 6, FWString( "Preview on one page" ) )
endif

if ::oWnd:oMenu != nil
::oMenuTwoPages:Disable()
::oMenuOnePage:Enable()
endif

::oLvw:Hide()

else

if ! lRebar
::oTwoPages:FreeBitmaps()
::oTwoPages:hBitmap1 = FWBitmap( "twopages2" )
::oTwoPages:cMsg = FWString( "Preview on two pages" )
::oTwoPages:cTooltip = FWString( "Two pages" )
else
::oBar:ChangeBitmap( 6, 6 )
::oBar:SetTooltip( 6, FWString( "&Two pages" ) )
::oBar:SetMessage( 6, FWString( "Preview on two pages" ) )
endif

if ::oWnd:oMenu != nil
::oMenuTwoPages:Enable()
::oMenuOnePage:Disable()
endif

if ! ::lListViewHide
::oLvw:Show()
endif

endif

if lMenu .and. ! IsAppThemed()
::oTwoPages:Refresh()
endif

::oWnd:Refresh()
::PaintMeta()

return nil

//----------------------------------------------------------------------------//

METHOD Zoom( lMenu ) CLASS TPreview

DEFAULT lMenu := .F.

::lZoom := ! ::lZoom

if ::oLvw != nil
if IsWindowVisible( ::oLvw:hWnd )
::oLvw:Hide()
else
::oLvw:Show()
endif
endif

if ::lZoom

if ::lTwoPages
::TwoPages( .T. )
endif

if ! lRebar
::oZoom:FreeBitmaps()
::oZoom:hBitmap1 = FWBitmap( "onepage2" ) //"Unzoom2" )
::oZoom:cMsg := FWString( "Page unzoom" )
::oZoom:cTooltip := StrTran( FWString( "&Normal" ), "&", "" )
else
::oBar:ChangeBitmap( 5,5 )
::oBar:SetTooltip( 5, StrTran( FWString( "&Normal" ), "&", "" ) )
::oBar:SetMessage( 5, FWString( "Page unzoom" ) )
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:hBitmap1 = FWBitmap( "Zoom2" )
::oZoom:cMsg = FWString( "Page zoom" )
::oZoom:cTooltip := FWString( "Zoom" )
else
::oBar:ChangeBitmap( 5, 5 )
::oBar:SetTooltip( 5, FWString( "Zoom" ) )
::oBar:SetMessage( 5, FWString( "Page zoom" ) )
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()

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

::oMeta1:SetOrg( nil, nYorig / ::oDevice:nVertRes() * 10 ) // DEVICE

::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

::oMeta1:SetOrg( nXorig / ::oDevice:nHorzRes() * 10, nil ) // DEVICE

::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 SelPrinter( cPrinter ) CLASS TPreview

local cOldPrinter := GetProfString( "windows", "device" , "" )

WriteProfString( "windows", "device", cPrinter )
SysRefresh()
PrinterInit()

DeleteDC( ::oDevice:hDC )

::oDevice:hDC = GetPrintDefault( GetActiveWindow() )
::oDevice:cModel = cPrinter

SysRefresh()
WriteProfString( "windows", "device", cOldPrinter )

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. )
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 PrintersMenu() CLASS TPreview

local oPop, aPrinters := aGetPrinters()

MENU oPop POPUP
oPop:l2007 = ( nStyle == 2007 )
oPop:l2010 = ( nStyle == 2010 )

AEval( aPrinters, { | cPrinter | MenuAddItem( cPrinter,,;
cPrinter $ ::oDevice:cModel,,;
{ | oMenuItem | ::SelPrinter( oMenuItem:cPrompt ),;
oMenuItem:oMenu:UnCheckAll(), oMenuItem:SetCheck( .T. ) } ) } )
ENDMENU

return oPop

//----------------------------------------------------------------------------//

METHOD PrintPage() CLASS TPreview

local hMeta := ::oMeta1:hMeta
local oDlg, oRad, oPageIni, oPageEnd
local nOption := 1, nFirst := 1, nLast := Len( ::oDevice:aMeta ) // DEVICE
local oThis := Self

if nLast == 1
::PrintPrv( nil, nOption, nFirst, nLast )
return nil
endif

DEFINE DIALOG oDlg SIZE 400, 183 TITLE FWString( "Printing" )

@ 8, 8 GROUP PROMPT FWString( "Printing range" ) SIZE 135, 72 PIXEL OF oDlg

@ 18, 18 RADIO oRad VAR nOption ;
ITEMS FWString( "All" ), FWString( "Current page" ), FWString( "Pages" ) ;
ON CHANGE If( nOption == 3,;
( oPageIni:Enable(), oPageEnd:Enable() ),;
( oPageIni:Disable(), oPageEnd:Disable() ) ) PIXEL

@ 61, 30 SAY FWString( "From" ) OF oDlg PIXEL

@ 60, 53 GET oPageIni ;
VAR nFirst PICTURE "@K 99999" ;
VALID If( nFirst < 1 .or. nFirst > nLast, ( MsgBeep(), .F. ), .T. ) ;
OF oDlg SIZE 22, 11 PIXEL

@ 61, 80 SAY FWString( "To" ) OF oDlg PIXEL

@ 60, 103 GET oPageEnd ;
VAR nLast PICTURE "@K 99999" ;
VALID If( nLast < nFirst .or. nLast > Len( ::oDevice:aMeta ),; // DEVICE
( MsgBeep(),.F. ), .T.) OF oDlg PIXEL

@ 10, 152 BUTTON FWString( "&Ok" ) OF oDlg SIZE 42, 14 ;
ACTION oThis:PrintPrv( oDlg, nOption, nFirst, nLast ) PIXEL

@ 28, 152 BUTTON FWString( "&Cancel" ) OF oDlg SIZE 42, 14 ;
ACTION oDlg:End() PIXEL

ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oPageIni:Disable(), oPageEnd:Disable(), .T. )

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 )
StartPage( oDevice:hDC )
hMeta := GetEnhMetaFile( aFiles[ nFor ] )
PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. )
DeleteEnhMetafile( hMeta )
EndPage( oDevice:hDC )
next

case nOption == 2 // Current page

StartPage( oDevice:hDC )
hMeta := ::oMeta1:hMeta
PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. )
EndPage( oDevice:hDC )

case nOption == 3 // Range

for nFor := nPageIni to nPageEnd
StartPage( oDevice:hDC )
hMeta := GetEnhMetaFile( aFiles[ nFor ] )
PlayEnhMetaFile( oDevice:hDC, hMeta,, .t. )
DeleteEnhMetafile( hMeta )
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, oMItem

MENU oPop POPUP
oPop:l2007 = ( nStyle == 2007 )
oPop:l2010 = ( nStyle == 2010 )

MENUITEM oMItem PROMPT FWString( "DOC Format" ) ;
ACTION ::SaveAs( .f. )

oMItem:hBitmap = FWBitmap( "Word2" )

MENUITEM oMItem PROMPT FWString( "PDF Format" ) ;
ACTION ::SaveAs( .t. )

oMItem:hBitmap = FWBitmap( "pdf" )
ENDMENU

return oPop

//----------------------------------------------------------------------------//

METHOD ResizeListView() CLASS TPreview

if ::oWnd != nil .and. ::oLvw != nil
::oLvw:nHeight = ::oWnd:GetCliRect():nHeight - 2 - ;
If( ::oWnd:oBar != nil, ::oWnd:oBar:nHeight() - 2,;
::oWnd:oTop:nHeight() ) - ;
If( ::oWnd:oMsgBar != nil, ::oWnd:oMsgBar:nHeight(),;
::oWnd:oBottom:nHeight() )
endif

return nil

//----------------------------------------------------------------------------//

METHOD SaveAs( lPDF, cFile, lView ) CLASS TPreview

static lWordPDF := .t.

local oWord, nVer, oDoc
local cExt, cMsg

if lPDF
if ValType( ::bSaveAsPDF ) == 'B'
return Eval( ::bSaveAsPDF, Self, cFile, lView )
elseif ! lWordPDF // tested earlier and found Word with PDF plugin not availble
return FWSavePreviewToPDF( Self, cFile, lView )
endif
else
if ValType( ::bSaveAsWord ) == 'B'
return Eval( ::bSaveAsWord, Self, cFile, lView )
endif
endif

oWord := WinWordObj()
if oWord == nil
lWordPDF := .f.
if lPDF
return FWSavePreviewToPDF( Self, cFile, lView )
ELSE
return ToWordDocViaWriter( Self, , "W" )
Endif
endif
nVer := Val( oWord:Version )

if lPDF
if nVer >= 12.0 .and. WordHasPDFPlugIn()
cExt := "*.pdf"
else
lWordPDF := .f.
return FWSavePreviewToPDF( Self, cFile, lView )
endif
else
cExt = If( nVer < 12.0, "*.doc", "*.docx; *.doc" )
endif
cMsg = If( lPDF, "PDF", "Doc" ) + " " + ;
FWString( "File to Save" ) + "( " + cExt + ") |" + cExt + "|"

if Empty( cFile ) .and. Empty( cFile := cGetFile( cMsg, FWString( "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

DEFAULT lView := MsgYesNo( FWString( "View" ) + " " + cFile + "?", FWString( "Please select" ) )
oDoc = ConvertToWordDoc( Self )

if oDoc != nil
TRY
oDoc:ExportAsFixedFormat( cFile, 17, lView )
CATCH
lWordPDF := .f.
// MsgInfo( FWString( "PDF Plugin Error" ), FWString( "Information" ) )
END
if lPDF
oDoc:Close( .f. )
if ! lWordPDF
// word failed to save as PDF due to PDF Plugin Error
return FWSavePreviewToPDF( Self, cFile, lView )
endif
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 cFile

//----------------------------------------------------------------------------//

METHOD SendEmail() CLASS TPreview

local oMail, cName, cFile

cName := If( ::oReport != nil, ::oReport:cName, ::oDevice:cDocument )
cFile := cFilePath( ::oDevice:aMeta[ 1 ] ) + StrTran( cName, '.', '' ) + ;
Left( HB_TToS( HB_DateTime() ), 14 ) + ".pdf"

CursorWait()
cFile := ::SaveAs( .t., cFile, .f. )
CursorArrow()

if ! File( cFile )
MsgInfo( FWString( "PDF not saved to send Email" ), FWString( "Information" ) )
elseif ::bEmail != nil
Eval( ::bEmail, Self, cName, cFile )
else
DEFINE MAIL oMail ;
SUBJECT cName ;
TEXT "" ;
FILES cFile, cFile ;
FROM USER

ACTIVATE MAIL oMail

// MsgInfo( oMail:nRetCode ) check the returned code!
endif

::oMeta1:SetFocus()

return nil

//----------------------------------------------------------------------------//

function RPreview( oDevice, oReport )

local oPreview := TPreview():New( oDevice, oReport )

oDevice:oPreview := oPreview

oPreview:Activate()

return nil

//----------------------------------------------------------------------------//

function ConvertToWordDoc( oPreview )

local aFiles := oPreview:oDevice:aMeta
local oWord, oDoc, cEMF

if Len( aFiles ) > 0
if ( oWord := WinWordObj() ) == nil
lWord := .f.
MsgAlert( FWString( "MS Word not installed" ), FWString( "Alert" ) )
oDoc = ToWordDocViaWriter( oPreview, aFiles, "W" )
else
lWord := .t.
oDoc = oWord:Documents:Add()
if oDoc == nil
MsgAlert( FWString( "Failed to Create Word Document" ), FWString( "Alert" ) )
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( FWString( "There is no output for export" ), FWString( "Alert" ) )
endif

return oDoc

//----------------------------------------------------------------------------//

Function ToWordDocViaWriter( oPreview, aFiles, cFileType )

local oWriter, oDesktop, oDoc, oCusor, oText, oGraphic, cEMF, cURL, i, aProp
local 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( FWString( "There is no output for export" ), FWString( "Alert" ) )
Return nil
Endif

if ( oWriter := SunCalcObj() ) == nil
lCalc := .f.
MsgAlert( FWString( "No .Doc file manipulation software installed" ), FWString( "Alert" ) )
Return NIL
Endif
lCalc := .t.
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" ) + " " + ;
FWString( "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 += "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 += "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

//--------------------------------------------------------------------//

att: Carlos FWH1404 XHARBOUT123, DBF XDEV

kapiaba · September 14, 2016

Mostre uma imagem e o código, eu acho que você precisa de uma classe do Rafa Carmona compativel com esta versão. E fique no mesmo tópico, você criou outro porquê? Crie tópicos que seja possivel te ajudar. Não tem uma postagem sua que seja plausível te ajudar, tem-se que ficar chutando... Se pergunta, você nunca responde o que se perguntou. Ai, meu caro fica dificil.

syspel · September 23, 2016

nao tem anexar a imagem da erro neste tocho ?

obrigado

kapiaba · September 23, 2016

Oi? Tocho?

Hospede a Imagem aqui e copie e cole a tag:

http://imgur.com/?

Você é aprendiz ou é o dono da Syspel mesmo? Tá confuso pra kralyio().

aferra · September 23, 2016

meus 5 centavos de opinião, não vai ter jeito, esquece isso, a muito tempo atras se tentou e não resolveu...ou atualize sua versão fivewin ou tente a fastreport, cristalreport e por ai vai..

kapiaba · September 23, 2016

meus 5 centavos de opinião, não vai ter jeito, esquece isso, a muito tempo atras se tentou e não resolveu...ou atualize sua versão fivewin ou tente a fastreport, cristalreport e por ai vai..

Como não tenho nem 5 centavos(Aferra é rico. kkkkk), eu diria que só atualizando o Fivewin e deixando as classes de terceiros de lado e usando TREPORT.PRG ou PRINTER.PRG, já resolve na hora. Pelo que vi no forum inter, o novo PREVIEW da Versão: FWHX16.06, está um must, só aqui na espreita, esperando a nova versão de AGOSTO ou SETEMBRO/2016, ai, é nóis.

marcioe · September 24, 2016

Use fast report, recomendo, já tem tudo pronto.

kapiaba · September 26, 2016

Chegou, esperando só os comentários dos users:

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=32992

Abs.

kapiaba · September 26, 2016

Carlos, veja esse exemplo de relatório na nova versão FWH16.08:

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=32994

Abs.

syspel · September 26, 2016

o dono da syspel e o gilberto,eu so o ultimo que fala e o primeiro que apanha

mais consegui fazer um exerto eu acho que ficou bom, so falta para o excell fazer fiquei sem saco

vou anexar a dll e o rpreview foi uma semana de tampo, para mim ja esta bom

obrigado a todos

vou color se eu consequi anexar

Sign In

RPREVIEW

Recommended Posts

syspel

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

syspel

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

aferra

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

marcioe

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

kapiaba

Link to comment

Share on other sites

syspel

Link to comment

Share on other sites

Join the conversation

Browse

Activity