*---------------------------------------------------------------------------
* TxtPreview - Ednaldo Rolim
(edrol@uol.com.br)* Modificado por Ralph del Castillo para la clase tRichEdit
* MODICACIONES EXTRAS POR:
Víctor Daniel Cuatecatl León
* ==========================================================================
* Utiliza:
Richedit -
* TdosPrn - Ignacio Ortiz
* Baseado em MPreview.prg - Jos‚ Lal¡n
*---------------------------------------------------------------------------
// Desligue a proxima linha se voce nao usa PREVIEW.DLL// Comment the next line if you don't use any PREVIEW.DLL#define _PREV_DLL
// Para Fivewin versao 2.0 ou abaixo, habilite a linha seguinte// #define __CLIPPER__#include "FiveWin.ch"#ifndef COLOR_BTNFACE
#include "WColors.ch"#endif
#include "RichEdit.ch"#ifdef __XPP__
#define New _New
#endif
#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_ZOOM_FACTOR ;
"Fijar el factor de Zoom"#define TXT_ERROR_FWERROR ;
"Error de Impresion"#define TXT_ERROR_NOTFOUND ;
"No encontrado. Imposible continuar."#define TXT_ERROR_TOOMANY_WINDOWS ;
"No se pueden abrir mas ventanas de previsualizacion."STATIC oMdiTmp, nOldArea, oIcon, oUnZoom
STATIC snCurPrev :=
0STATIC saMPrevOpts :=
{ .t.,
10,
1, .f., .f.
}#xtranslate slMdiPrev => saMPrevOpts\
[1\
]#xtranslate snMaxPrev => saMPrevOpts\
[2\
]#xtranslate snZFactor => saMPrevOpts\
[3\
]#xtranslate slWantMenu => saMPrevOpts\
[4\
]#xtranslate slSpool => saMPrevOpts\
[5\
]//----------------------------------------------------------------------------//FUNCTION SetMTxtPreview
( lOnOff, nMaxWnd, nNewZFactor, lMenu, lSpool
) LOCAL aOld := saMPrevOpts
DEFAULT nMaxWnd :=
0, ;
nNewZFactor :=
0, ;
lSpool :=
( "\\" $ PrnGetPort
() ) IF lOnOff !=
nil slMdiPrev := lOnOff
ENDIF IF nMaxWnd >
0 snMaxPrev := nMaxWnd
ENDIF IF nNewZFactor >
0 snZFactor := nNewZFactor
ENDIF IF lMenu !=
nil slWantMenu := lMenu
ENDIF slSpool:= lSpool
RETURN aOld
//----------------------------------------------------------------------------//FUNCTION TxtPreview
( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, oDlg, lKill, lGPrint, cImpre
) // cImpre: Agregado por VDCL LOCAL oPrev
LOCAL hOldRes := GetResources
() LOCAL hDLL := LoadLibrary
( "Riched20.dll" ) IF WndMain
() =
NIL lPrvModal := .t.
oDlg:
Hide() DEFINE ICON oIcon
RESOURCE "REPORTE" DEFINE WINDOW oMdiTmp
FROM 0,
0 TO 20,
79 MDI TITLE "TxtPreview" SET
MESSAGE OF oMdiTmp
TO "Preview" CENTERED NOINSET
oMdiTmp:
SetIcon(oIcon
) ACTIVATE WINDOW oMdiTmp ICONIZED
ON INIT TxtPrevDlg
( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint, cImpre
) //RDC cImpre: Agregado por VDCL oDlg:
Show() oDlg:
SetFocus() ELSE oPrev := TTxtPreview
():
New( cFileTxt,, lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint, cImpre
) //RDC cImpre: Agregado por VDCL oPrev:
Activate() ENDIF FreeLibrary
( hDLL
) SetResources
( hOldRes
) RETURN nil//----------------------------------------------------------------------------//STATIC FUNCTION TxtPrevDlg
( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint, cImpre
) // cImpre: Agregado por VDCL LOCAL oPrev
oPrev := TTxtPreview
():
New( cFileTxt, oMdiTmp , lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint, cImpre
) // cImpre: Agregado por VDCL oPrev:
Activate()RETURN nil//----------------------------------------------------------------------------//CLASS TTxtPreview
DATA oWndMain
DATA oDevice
DATA oDbf
DATA oMenu
DATA oPage, oZoom, oMenuZoom, oSize
DATA oMenuUnZoom, oMenuOnePage, cResFile
DATA lExit
DATA lPrintDlg AS LOGICAL
INIT .t.
DATA lKillFile AS LOGICAL
INIT .t.
//RDC DATA lModoGraf AS LOGICAL
INIT .f.
//RDC DATA oFont
DATA nPage AS NUMERIC
INIT 1 DATA lZoom
DATA hOldRes
DATA oBar
DATA oWnd
DATA oFGet
DATA lPrvModal
DATA cTitle, cDir, cTxtFile, cDbfTmp, cMemTmp, cTextFmt
DATA lSpool
DATA cPort, cCompress, cNormal, cFormFeed, cImpre
// cImpre: Agregado por VDCL DATA cNegOn, cNegOff, cItaOn, cItaOff, cEmpOn, cEmpOff
DATA c10Cpi, c12Cpi, cWidOn, cWidOff
METHOD New( cFileTxt, oWndMain, lModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint, cImpre
) CONSTRUCTOR
// RDC cImpre: Agregado por VDCL METHOD Activate() METHOD END
() INLINE IF( ::
oWnd !=
nil, ::
oWnd:
END(),
) METHOD Command
( xPar1, xPar2, xPar3, xPar4, xPar5
) METHOD Destroy
() METHOD BuildBtnBar
( l97Look
) METHOD BuildFGet
() METHOD BuildMenu
() METHOD NextPage
() METHOD PrevPage
() METHOD TopPage
() METHOD BottomPage
() METHOD Zoom
() METHOD Zoom_in
() // RDC METHOD Zoom_out
() // RDC METHOD KeyDown
( nKey, nFlags
) METHOD KeyChar
( nKey, nFlags
) METHOD PRINT() METHOD PrintPrv
( oDlg, nOption, nPageIni, nPageEnd, cRange, nCopies
) METHOD PrintPage
( oPrn, cTxt
) METHOD GPrint
() // RDC METHOD Text2Lines
() // RDC METHOD AjustFget
() METHOD BuildDbfTmp
() METHOD TxtToRTF
( cText
) METHOD MenuFGet
( nRow, nCol
)ENDCLASS//----------------------------------------------------------------------------------//METHOD New( cFileTxt, oWndMain, lModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint, cImpre
) CLASS TTxtPreview
// cImpre: Agregado por VDCL LOCAL nFor
LOCAL oIcon
LOCAL oBrush
LOCAL l97Look
LOCAL nTmp, lIsLaser, cImpr, cFont
DEFAULT oWndMain := WndMain
(),;
lModal:= !slMdiPrev,;
cTitle:=
"Previsualizacion",;
lSpool:= slSpool,;
lKill := .t.,;
lGPrint := .f.
::
oWndMain := oWndMain
::
lExit := .F.
::
cTxtFile := cFileTxt
::
cTitle := cTitle
::
lPrvModal := lModal
::
lZoom :=
( snZFactor =
1 ) ::
nPage :=
1 ::
lModoGraf := lGPrint
::
lSpool := lSpool
::
lKillFile := lKill
//RDC ::
cPort := cPort
::
cImpre := cImpre
// cImpre: Agregado por VDCL IF oPrn =
Nil cImpr := PrnGetName
() lIsLaser :=
( AT('JET',UPPER
(cImpr
)) >
0 .OR.
AT('LASER',UPPER
(cImpr
)) >
0 ) IF lIsLaser
::
cNormal := ::
Command("27,40,115,49,50,72") ::
cCompress := ::
Command("27,40,115,49,56,72") ELSE ::
cCompress := ::
Command("15") ::
cNormal := ::
Command("18") ENDIF ::
cFormFeed := ::
Command( "12" ) ::
cNegOn := ::
Command("27,71") ::
cNegOff := ::
Command("27,72") ::
c10cpi := ::
Command("27,80") ::
c12cpi := ::
Command("27,77") ::
cWidOn := ::
Command("27,87,1") ::
cWidOff := ::
Command("27,87,0") ELSE ::
cCompress := ::
Command( oPrn:
cCompress ) ::
cNormal := ::
Command( oPrn:
cNormal ) ::
cFormFeed := ::
Command( oPrn:
cFormFeed ) ::
cNegOn := ::
Command( oPrn:
cNegOn ) ::
cNegOff := ::
Command( oPrn:
cNegOff ) ::
c10cpi := ::
Command( oPrn:
c10cpi ) ::
c12cpi := ::
Command( oPrn:
c12cpi ) ::
cWidOn := ::
Command( oPrn:
cWidOn ) ::
cWidOff := ::
Command( oPrn:
cWidOff ) ENDIF ::
cDir := GETENV
("TEMP") IF RIGHT( ::
cDir,
1 ) ==
"\"
::cDir = SUBSTR( ::cDir, 1, LEN( ::cDir ) - 1 )
ENDIF
IF !EMPTY(::cDir)
IF !lIsDir(::cDir)
::cDir := GetWinDir()
ENDIF
ELSE
::cDir := GetWinDir()
ENDIF
nOldArea := SELECT() //RDC
IF RIGHT( ::cDir, 1 ) != "\
"
::cDir += "\
"
ENDIF
l97Look:= .t.
#ifdef _PREV_DLL
::hOldRes := GetResources()
#ifdef __CLIPPER__
::cResFile := "Preview.dll
"
#else
::cResFile := "Prev32.dll
"
#endif
IF SetResources( ::cResFile ) < 32
MsgStop( ::cResFile + " " + TXT_ERROR_NOTFOUND, TXT_ERROR_FWERROR )
SetResources(::hOldRes)
RETURN Self
ENDIF
#endif
/* [jlalin] */
IF snCurPrev == snMaxPrev
MsgStop( TXT_ERROR_TOOMANY_WINDOWS )
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN Self
ENDIF
IF oWndMain != nil
oIcon := oWndMain:oIcon
ENDIF
IF ::lPrvModal = Nil
SetMTxtPreview()
::lPrvModal := slMdiPrev
ENDIF
::BuildDbfTmp()
IF ::lPrvModal .and. oWndMain != nil
oWndMain:Hide()
ELSE
::lExit := .T.
ENDIF
IF oWndMain != nil .and. oWndMain:oFont != nil
::oFont := oWndMain:oFont
ELSE
DEFINE FONT ::oFont NAME "Ms Sans Serif
" SIZE 0,-12
ENDIF
DEFINE ICON oIcon RESOURCE "REPORTE
"
msginfo("llegamos aqui
")
IF !::lPrvModal
DEFINE WINDOW ::oWnd FROM 0, 0 ;
TO oWndMain:nBottom - 100, oWndMain:nRight - 10 - IF( oWndMain:oLeft != nil, oWndMain:oLeft:nWidth(), 0 ) ;
TITLE ::cTitle ;
COLOR CLR_BLACK, GetSysColor( COLOR_BTNFACE ) ;
OF oWndMain ;
PIXEL
* MDICHILD OF oWndMain ;
ELSE
nTmp:= WndHeight(FindWindow( 'Shell_TrayWnd',nil))
DEFINE WINDOW ::oWnd FROM 0, 0 ;
TO WndHeight(GetDesktopwindow())-nTmp, WndWidth(GetDesktopwindow()) ;
PIXEL ;
TITLE ::cTitle ;
COLOR CLR_BLACK, GetSysColor( COLOR_BTNFACE ) ;
MENU ::BuildMenu()
ENDIF
::oWnd:SetIcon(oIcon)
::BuildBtnBar( l97Look )
::cTextFmt:= ::TxtToRTF( ::oDbf:TEXT )
IF slWantMenu
::BuildMenu()
ENDIF
::BuildFGet()
::nPage := 1
SysRefresh()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN Self
//----------------------------------------------------------------------------//
METHOD BuildBtnBar( l97Look ) CLASS TTxtPreview
LOCAL ASIZE := {"100%
","120%
","140%
","160%
","180%
","200%
","300%
" }
LOCAL cSize := ASIZE[1], oObj := self
DEFINE BUTTONBAR ::oBar _3D SIZE 25,25 OF ::oWnd
::oBar:bLClicked := {|| NIL }
::oBar:bRClicked := {|| NIL }
IF l97Look
DEFINE BUTTON RESOURCE "Top
" OF ::oBar ;
MESSAGE TXT_GOTO_FIRST_PAGE ;
ACTION ::TopPage() ;
TOOLTIP STRTRAN( TXT_FIRST, "&
", "" ) NOBORDER ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage > 1
DEFINE BUTTON RESOURCE "Prev
" OF ::oBar ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE ;
ACTION ::PrevPage() ;
TOOLTIP STRTRAN( TXT_PREVIOUS, "&
", "" ) NOBORDER ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage > 1
DEFINE BUTTON RESOURCE "Next" OF ::oBar ;
MESSAGE TXT_GOTO_NEXT_PAGE ;
ACTION ::NextPage() ;
TOOLTIP STRTRAN( TXT_NEXT, "&
", "" ) NOBORDER ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage < ::oDbf:RECCOUNT()
DEFINE BUTTON RESOURCE "Bottom
" OF ::oBar ;
MESSAGE TXT_GOTO_LAST_PAGE ;
ACTION ::BottomPage() ;
TOOLTIP STRTRAN( TXT_LAST, "&
", "" ) NOBORDER ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage < ::oDbf:RECCOUNT()
DEFINE BUTTON ::oZoom RESOURCE "Zoom
" OF ::oBar GROUP ;
MESSAGE TXT_ZOOM_THE_PREVIEW ;
ACTION ::Zoom_in() ;
TOOLTIP STRTRAN( TXT_ZOOM, "&
", "" ) NOBORDER
DEFINE BUTTON oUnZoom RESOURCE "UnZoom
" OF ::oBar GROUP ;
MESSAGE "Deshacer Zoom de la página
" ;
ACTION ::Zoom_Out() ;
TOOLTIP "Alejar
"
/* DEFINE BUTTON RESOURCE "Config
" OF ::oBar GROUP ;
MESSAGE "Seleccionar impresora
" ;
PROMPT "Configurar
" ;
ACTION PrinterSetup() NOBORDER TOOLTIP "Selección de Impresora
"*/
DEFINE BUTTON RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::PRINT() ;
TOOLTIP STRTRAN( TXT_PRINT, "&
", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Exit
" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:END() ;
TOOLTIP STRTRAN( TXT_EXIT, "&
", "" ) NOBORDER
/* @ ::oBar:nTop + 5, ::oBar:GetBtnLeft()+2 COMBOBOX ::oSize ;
VAR cSize ITEMS ASIZE OF ::oBar ;
SIZE 60,300 FONT ::oFont ;
ON CHANGE oObj:Zoom() PIXEL
::oSize:cToolTip := "Factor de Zoom
"*/
ELSE
DEFINE BUTTON RESOURCE "Top
" OF ::oBar ;
MESSAGE TXT_GOTO_FIRST_PAGE ;
ACTION ::TopPage() ;
TOOLTIP STRTRAN( TXT_FIRST, "&
", "" ) ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage > 1
DEFINE BUTTON RESOURCE "Prev
" OF ::oBar ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE ;
ACTION ::PrevPage() ;
TOOLTIP STRTRAN( TXT_PREVIOUS, "&
", "" ) ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage > 1
DEFINE BUTTON RESOURCE "Next" OF ::oBar ;
MESSAGE TXT_GOTO_NEXT_PAGE ;
ACTION ::NextPage() ;
TOOLTIP STRTRAN( TXT_NEXT, "&
", "" ) ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage < ::oDbf:RECCOUNT()
DEFINE BUTTON RESOURCE "Bottom
" OF ::oBar ;
MESSAGE TXT_GOTO_LAST_PAGE ;
ACTION ::BottomPage() ;
TOOLTIP STRTRAN( TXT_LAST, "&
", "" ) ;
WHEN ::oDbf:RECCOUNT() > 1 .and. ::nPage < ::oDbf:RECCOUNT()
DEFINE BUTTON ::oZoom RESOURCE "Zoom
" OF ::oBar GROUP ;
MESSAGE TXT_ZOOM_THE_PREVIEW ;
ACTION ::Zoom_in() ;
TOOLTIP STRTRAN( TXT_ZOOM, "&
", "" )
DEFINE BUTTON oUnZoom RESOURCE "UnZoom
" OF ::oBar GROUP ;
MESSAGE "Deshacer Zoom de la página
" ;
ACTION ::Zoom_Out() ;
TOOLTIP "Alejar
"
/*DEFINE BUTTON RESOURCE "Config
" OF ::oBar GROUP ;
MESSAGE "Seleccionar impresora
" ;
PROMPT "Configurar
" ;
ACTION PrinterSetup() NOBORDER TOOLTIP "Seleccionar Impresora
"*/
DEFINE BUTTON RESOURCE "Print" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::PRINT() ;
TOOLTIP STRTRAN( TXT_PRINT, "&
", "" )
DEFINE BUTTON RESOURCE "Exit
" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:END() ;
TOOLTIP STRTRAN( TXT_EXIT, "&
", "" )
ENDIF
@ ::oBar:nTop + 4, ::oBar:GetBtnLeft()+600 COMBOBOX ::oSize ;
VAR cSize ITEMS ASIZE OF ::oBar ;
SIZE 60,300 FONT ::oFont ;
ON CHANGE oObj:Zoom() PIXEL
@ ::oBar:nTop + 6, ::oBar:nLeft + 700 SAY ::oPage ;
PROMPT TXT_PAGENUM + LTRIM( STR( ::nPage, 3 ) ) + ;
" /
" + LTRIM( STR( ::oDbf:RECCOUNT() ) ) ;
SIZE 100, 15 PIXEL OF ::oBar FONT ::oFont
RETURN nil
//----------------------------------------------------------------------------//
METHOD BuildFGet() CLASS TTxtPreview
LOCAL oObj := self
@ ::oBar:nHeight, 0 RICHEDIT ::oFGet VAR ::cTextFmt OF ::oWnd ;
SIZE ::oWnd:nRight-::oWnd:nLeft-13,(::oWnd:nBottom-::oWnd:nTop)-::oBar:nHeight ;
PIXEL HSCROLL READONLY
::oFGet:Hide()
::oFGet:bRClicked := {| nRow, nCol | Self:MenuFGet( nRow, nCol ) }
::oFGet:bKeyDown := {| nKey, nFlags | oObj:KeyDown( nKey, nFlags ) }
::oFGet:bKeyChar := {| nKey, nFlags | oObj:KeyChar( nKey, nFlags ) }
RETURN nil
//----------------------------------------------------------------------------//
METHOD Activate() CLASS TTxtPreview
IF ::oWnd != nil
++snCurPrev
ACTIVATE WINDOW ::oWnd ;
ON RESIZE ::AjustFGet() ;
VALID ::Destroy()
::zoom(100)
::zoom_in() // se ve mejor asi
::oFGet:Show()
WHILE !::lExit
SysWait( .1 )
ENDDO
IF ::lPrvModal .and. ::oWndMain != nil
::oWndMain:Show()
ENDIF
ENDIF
RETURN nil
//----------------------------------------------------------------------------//
METHOD AjustFget() CLASS TTxtPreview
LOCAL oRect := ::oWnd:GetCliRect()
::oFGet:SetSize( oRect:nWidth-1, oRect:nHeight-( ::oBar:nHeight ) )
RETURN Nil
//----------------------------------------------------------------------------//
METHOD MenuFGet( nRow, nCol ) CLASS TTxtPreview
LOCAL oMenu, lEnd:= .f., i
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
MENU oMenu POPUP
IF ::oDbf:RECCOUNT() > 1 .and. ::nPage > 1
MENUITEM TXT_FIRST RESOURCE "Top
" ACTION ::TopPage()
MENUITEM TXT_PREVIOUS RESOURCE "Prev
" ACTION ::PrevPage()
ELSE
MENUITEM TXT_FIRST RESOURCE "Top
" ACTION ::TopPage() DISABLED
MENUITEM TXT_PREVIOUS RESOURCE "Prev
" ACTION ::PrevPage() DISABLED
ENDIF
IF ::oDbf:RECCOUNT() > 1 .and. ::nPage < ::oDbf:RECCOUNT()
MENUITEM TXT_NEXT RESOURCE "Next" ACTION ::NextPage()
MENUITEM TXT_LAST RESOURCE "Bottom
" ACTION ::BottomPage()
ELSE
MENUITEM TXT_NEXT RESOURCE "Next" ACTION ::NextPage() DISABLED
MENUITEM TXT_LAST RESOURCE "Bottom
" ACTION ::BottomPage() DISABLED
ENDIF
SEPARATOR
MENUITEM "Acercar
" RESOURCE "Zoom
" ACTION ::Zoom_in()
MENUITEM "Alejar
" RESOURCE "UnZoom
" ACTION ::Zoom_Out()
SEPARATOR
MENUITEM TXT_EXIT RESOURCE "Exit
" ACTION ::oWnd:END()
ENDMENU
ACTIVATE POPUP oMenu AT nRow - 60, nCol OF ::oFGet:oWnd
IF ::oBar != Nil
FOR i=1 TO 4
::oBar:aControls[i]:ForWhen()
::oBar:aControls[i]:Refresh()
NEXT i
ENDIF
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN Nil
//----------------------------------------------------------------------------//
METHOD NextPage() CLASS TTxtPreview
IF ::nPage == ::oDbf:RECCOUNT()
MessageBeep()
RETURN nil
ENDIF
::nPage++
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
::oDbf:SKIP(1)
::oFGet:Settext(::TxtToRTF( ::oDbf:TEXT ))
::oPage:SetText( TXT_PAGENUM + LTRIM( STR( ::nPage, 4, 0 ) ) + ;
" /
" + LTRIM( STR( ::oDbf:RECCOUNT() ) ) )
::oFGet:Refresh()
::oFGet:SetFocus()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN nil
//----------------------------------------------------------------------------//
METHOD PrevPage() CLASS TTxtPreview
IF ::nPage == 1
MessageBeep()
RETURN nil
ENDIF
::nPage--
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
::oDbf:SKIP(-1)
::oFGet:Settext(::TxtToRTF( ::oDbf:TEXT ))
::oPage:SetText( TXT_PAGENUM + LTRIM( STR( ::nPage, 4, 0 ) ) + ;
" /
" + LTRIM( STR( ::oDbf:RECCOUNT() ) ) )
::oFGet:Refresh()
::oFGet:SetFocus()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN nil
//----------------------------------------------------------------------------//
METHOD TopPage() CLASS TTxtPreview
IF ::nPage == 1
MessageBeep()
RETURN nil
ENDIF
::nPage:= 1
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
::oDbf:GoTop()
::oFGet:Settext(::TxtToRTF( ::oDbf:TEXT ))
::oPage:SetText( TXT_PAGENUM + LTRIM( STR( ::nPage, 4, 0 ) ) + ;
" /
" + LTRIM( STR( ::oDbf:RECCOUNT() ) ) )
::oFGet:Refresh()
::oFGet:SetFocus()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN nil
//----------------------------------------------------------------------------//
METHOD BottomPage() CLASS TTxtPreview
IF ::nPage == ::oDbf:RECCOUNT()
MessageBeep()
RETURN nil
ENDIF
::nPage := ::oDbf:RECCOUNT()
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
::oDbf:GoBottom()
::oFGet:Settext(::TxtToRTF( ::oDbf:TEXT ))
::oPage:SetText( TXT_PAGENUM + LTRIM( STR( ::nPage, 4, 0 ) ) + ;
" /
" + LTRIM( STR( ::oDbf:RECCOUNT() ) ) )
::oFGet:Refresh()
::oFGet:SetFocus()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN nil
//----------------------------------------------------------------------------//
METHOD Zoom(xFactor) CLASS TTxtPreview
LOCAL afonts := {"",""}
LOCAL nFactor, nw
IF !EMPTY(xFactor)
nfactor:= xFactor / 100
ELSE
nfactor:= VAL(STRTRAN(::oSize:Varget(),"%
","")) / 100
ENDIF
IF ::lModoGraf
// font modo grafico
aFonts[ 1 ] := TFont():New( "Lucida console
", 0, -9*nfactor, ,;
, , , , , , , , , , , )
::oFGet:SetFont(aFonts[ 1 ])
ELSE
// font modo texto
nW := ROUND(4.4 * nFactor,2)
aFonts[ 2 ] := TFont():New( "Courier
New", 0, -10*nFactor, ,;
, , , , , , , , , , , )
::oFGet:SetFont(aFonts[ 2 ])
ENDIF
::oFGet:Refresh()
::oFGet:SetFocus()
RETURN nil
//----------------------------------------------------------------------------//
METHOD Zoom_in() CLASS TTxtPreview
LOCAL oCur1, oCur2
DEFINE CURSOR oCur1 RESOURCE "LUPA1
"
DEFINE CURSOR oCur2 RESOURCE "LUPA2
"
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
IF ::oSize:nAt < LEN(::oSize:aItems )
::oSize:SELECT(::oSize:nAt+1)
::oSize:change()
::zoom()
::oZoom:Enable()
::oZoom:Refresh()
oUnZoom:Enable()
oUnZoom:Refresh()
ELSE
::oZoom:Disable()
::oZoom:Refresh()
RETURN nil
ENDIF
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN nil
//----------------------------------------------------------------------------//
METHOD Zoom_out() CLASS TTxtPreview
LOCAL oCur1, oCur2
DEFINE CURSOR oCur1 RESOURCE "LUPA1
"
DEFINE CURSOR oCur2 RESOURCE "LUPA2
"
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
IF ::oSize:nAt > 1
::oSize:SELECT(::oSize:nAt-1)
::oSize:change()
::zoom()
oUnZoom:Enable()
oUnZoom:Refresh()
::oZoom:Enable()
::oZoom:Refresh()
ELSE
oUnZoom:Disable()
oUnZoom:Refresh()
RETURN nil
ENDIF
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
RETURN nil
//----------------------------------------------------------------------------//
/* Version original de Joerg K. */
METHOD KeyDown( nKey, nFlags ) CLASS TTxtPreview
IF nKey == 27 // VK_ESCAPE
::oWnd:END()
ENDIF
DO CASE
CASE ( nKey == ASC( "I
" ) .OR. nKey == ASC( "i
" ) ) .and. GetKeyState( VK_CONTROL )
::PRINT()
CASE ( nKey == ASC( "P
" ) .OR. nKey == ASC( "p
" ) ) .and. GetKeyState( VK_CONTROL )
::PRINT()
CASE ( nKey == ASC( "Z
" ) .OR. nKey == ASC( "z
" ) ) .and. GetKeyState( VK_CONTROL )
::Zoom_in()
CASE nKey == ASC( "-
" ) .and. GetKeyState( VK_CONTROL )
::Zoom_out()
CASE nKey == ASC( "+
" ) .and. GetKeyState( VK_CONTROL )
::Zoom_in()
ENDCASE
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
ENDIF
RETURN nil
METHOD KeyChar( nKey, nFlags ) CLASS TTxtPreview
DO CASE
CASE nKey == ASC( "+
" ) //.and. GetKeyState( VK_CONTROL )
::Zoom_in()
CASE nKey == ASC( "-
" ) //.and. GetKeyState( VK_CONTROL )
::Zoom_out()
ENDCASE
RETURN nil
//----------------------------------------------------------------------------//
METHOD PRINT() CLASS TTxtPreview
LOCAL oDlg, oRad, oPageIni, oPageFin, oRange, oBtn, oSay, oGet
LOCAL cPrinter:= ::cImpre // cImpre: Agregado por VDCL
LOCAL cDriver:= PrnGetDrive()
LOCAL cPuerto:= ::cPort // cImpre: Modificado por VDCL
LOCAL nOption := 1, ;
nFirst := 1, ;
nLast := ::oDbf:RECCOUNT() , ;
nCopies := 1, ;
nOldCop := nCopies, ;
cRange := SPACE( 30 )
IF nLast == 1 .and. !::lPrintDlg
::PrintPrv( nil, nOption, nFirst, nLast )
RETURN nil
ELSE
DEFINE DIALOG oDlg Resource "IMPRIME
" TITLE "Impresion de Documentos
"
REDEFINE SAY oSay ID 100 OF oDlg
REDEFINE GET oGet VAR cPrinter ID 101 OF oDlg READONLY COLOR Rgb(000,000,000), Rgb(255,255,206)
REDEFINE SAY oSay ID 102 OF oDlg
REDEFINE GET oGet VAR cDriver ID 103 OF oDlg READONLY COLOR Rgb(000,000,000), Rgb(238,255,228)
REDEFINE SAY oSay ID 104 OF oDlg
REDEFINE GET oGet VAR cPuerto ID 105 OF oDlg READONLY COLOR Rgb(000,000,000), Rgb(255,255,206)
REDEFINE RADIO oRad VAR nOption ID 106,107,108,109,110,111 OF oDlg ON CHANGE ( IF( nOption == 5, ;
( oPageIni:Enable(), oPageFin:Enable() ), ;
( oPageIni:Disable(), oPageFin:Disable() ) ), ;
IF( nOption == 6, oRange:Enable(), oRange:Disable() ) ) ;
WHEN ::oDbf:RECCOUNT() > 1
REDEFINE SAY oSay ID 112 OF oDlg
REDEFINE GET oGet VAR nCopies ID 113 OF oDlg UPDATE SPINNER MIN 1 MAX 999 VALID nCopies > 0 .and. nCopies <= 999 PICTURE "999"
REDEFINE GET oPageIni VAR nFirst ID 114 OF oDlg PICTURE "@K
99999" VALID IF( nFirst < 1 .OR. nFirst > nLast, ( MessageBeep() , .F. ), .T. )
REDEFINE SAY oSay ID 115 OF oDlg
REDEFINE GET oPageFin VAR nLast ID 116 OF oDlg PICTURE "@K
99999" VALID IF( nLast < nFirst .OR. nLast > ::oDbf:RECCOUNT(), ( MessageBeep(), .F. ), .T. )
REDEFINE GET oRANGE VAR cRange ID 117 OF oDlg PICTURE "@S!
"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
REDEFINE BUTTONBMP oBtn ID 118 OF oDlg BITMAP "ACEPTAR
" TEXTRIGHT ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
REDEFINE BUTTONBMP oBtn ID 119 OF oDlg BITMAP "CANCELAR
" TEXTRIGHT ACTION oDlg:END()
ACTIVATE DIALOG oDlg CENTERED ON INIT (oDlg:SetIcon(oIcon))
ENDIF
RETURN nil
//----------------------------------------------------------------------------// RDC
METHOD PrintPrv( oDlg, nOption, nPageIni, nPageEnd, cRange, nCopies ) CLASS TTxtPreview
LOCAL nFor, nCopy, oPrn
LOCAL nPages := ::oDbf:RECCOUNT()
LOCAL aPages, aRange, i, nCPage := ::oDbf:RECNO()
DEFAULT nCopies:= 1
CursorWait()
IF ! ::lModoGraf
oPrn:= TDosPrn():New()
oPrn:cPort := PrnGetPort()
FOR nCopy = 1 TO nCopies
DO CASE
//--- Todas
CASE nOption == 1
::oDbf:GoTop()
DO WHILE !( ::oDbf:EOF() )
::PrintPage( oPrn, ::oDbf:TEXT )
::oDbf:SKIP(1)
ENDDO
//--- Atual
CASE nOption == 2
::PrintPage( oPrn, ::oDbf:TEXT )
//--- Pares
CASE nOption == 3
::oDbf:GOTO(2) // Vaí para a pag 2 (reg 2)
DO WHILE !( ::oDbf:EOF() )
::PrintPage( oPrn, ::oDbf:TEXT )
::oDbf:SKIP(2) // Pula 2 registros
ENDDO
//--- Impares
CASE nOption == 4
::oDbf:GoTop() // Vaí para a pag 1 (reg 1)
DO WHILE !( ::oDbf:EOF() )
::PrintPage( oPrn, ::oDbf:TEXT )
::oDbf:SKIP(2) // Pula 2 registros
ENDDO
//--- Seleccion
CASE nOption == 5
::oDbf:GoTop()
::oDbf:GOTO( nPageIni )
DO WHILE !( ::oDbf:EOF() )
IF ::oDbf:Pagina >= nPageIni .and. ::oDbf:Pagina <= nPageEnd
::PrintPage( oPrn, ::oDbf:TEXT )
ENDIF
IF ::oDbf:Pagina > nPageEnd
EXIT
ENDIF
::oDbf:SKIP(1)
ENDDO
//--- Range
CASE nOption == 6
aPages := Str2Arr2( cRange, ",
", "-
" )
FOR nFor := 1 TO LEN( aPages )
IF VALTYPE( aPages[ nFor ] ) == "A
"
aRange := { VAL( aPages[ nFor ][1] ), VAL( aPages[ nFor ][2] ) }
IF aRange[ 1 ] > 0 .and. aRange[ 2 ] > 0 .and. aRange[ 2 ] >= aRange[ 1 ]
FOR i := aRange[ 1 ] TO aRange[ 2 ]
::oDbf:GOTO( i )
::PrintPage( oPrn, ::oDbf:TEXT )
NEXT
ENDIF
ELSE
::oDbf:GOTO( VAL( aPages[ nFor ] ) )
::PrintPage( oPrn, ::oDbf:TEXT )
ENDIF
NEXT
ENDCASE
NEXT nCopy
oPrn:END(,.f.)
CursorArrow()
IF oDlg != nil
oDlg:END()
ENDIF
ELSE
PRINT oPrn NAME "Test
"
FOR nCopy = 1 TO nCopies
DO CASE
//--- Todas
CASE nOption == 1
::oDbf:GoTop()
DO WHILE !( ::oDbf:EOF() )
::GPrint(oPrn,::oDbf:TEXT)
::oDbf:SKIP(1)
ENDDO
//--- Actual
CASE nOption == 2
::GPrint(oPrn,::oDbf:TEXT)
//--- Pares
CASE nOption == 3
::oDbf:GOTO(2) // Vaí para a pag 2 (reg 2)
DO WHILE !( ::oDbf:EOF() )
::GPrint(oPrn,::oDbf:TEXT)
::oDbf:SKIP(2) // Pula 2 registros
ENDDO
//--- Impares
CASE nOption == 4
::oDbf:GoTop() // Vaí para a pag 1 (reg 1)
DO WHILE !( ::oDbf:EOF() )
::GPrint(oPrn,::oDbf:TEXT)
::oDbf:SKIP(2) // Pula 2 registros
ENDDO
//--- Seleccion
CASE nOption == 5
::oDbf:GoTop()
::oDbf:GOTO( nPageIni )
DO WHILE !( ::oDbf:EOF() )
IF ::oDbf:Pagina >= nPageIni .and. ::oDbf:Pagina <= nPageEnd
::GPrint(oPrn,::oDbf:TEXT)
ENDIF
IF ::oDbf:Pagina > nPageEnd
EXIT
ENDIF
::oDbf:SKIP(1)
ENDDO
//--- Range
CASE nOption == 6
aPages := Str2Arr2( cRange, ",
", "-
" )
FOR nFor := 1 TO LEN( aPages )
IF VALTYPE( aPages[ nFor ] ) == "A
"
aRange := { VAL( aPages[ nFor ][1] ), VAL( aPages[ nFor ][2] ) }
IF aRange[ 1 ] > 0 .and. aRange[ 2 ] > 0 .and. aRange[ 2 ] >= aRange[ 1 ]
FOR i := aRange[ 1 ] TO aRange[ 2 ]
::oDbf:GOTO( i )
::GPrint(oPrn,::oDbf:TEXT)
NEXT
ENDIF
ELSE
::oDbf:GOTO( VAL( aPages[ nFor ] ) )
::GPrint(oPrn,::oDbf:TEXT)
ENDIF
NEXT
ENDCASE
NEXT nCopy
::oDbf:GOTO(nCPage) //RDC
::nPage := ::oDbf:RECNO()
::cTextFmt:= ::TxtToRTF( ::oDbf:TEXT )
::oPage:SetText( TXT_PAGENUM + LTRIM( STR( ::nPage, 4, 0 ) ) + ;
" /
" + LTRIM( STR( ::oDbf:RECCOUNT() ) ) )
::oFGet:Refresh()
CursorArrow()
oPrn:END()
IF oDlg != nil
oDlg:END()
ENDIF
ENDIF
RETURN nil
//----------------------------------------------------------------------------//
METHOD PrintPage( oPrn, cTxt ) CLASS TTxtPreview
LOCAL nLines, nLin, cLine, cTmp, cTxt2, cTxtTmp, cPorta
cPorta:= ::cPort
IF Empt( cPorta )
cPorta:= ALLTRIM( PrnGetPort() )
ELSE
cPorta:= ALLTRIM( cPorta )
ENDIF
/*
if ! ( left(upper(cPorta),3) = 'LPT' )
// desactivamos el spool si no son puertos directos
// porque no funciona en XP - Win 200x
::lSpool := .f.
else
::lSpool := .t.
endif
*/
IF ::lSpool
cTxtTmp := UPPER( cTmpName( ::cDir ) )
cTxtTmp := STRTRAN( cTxtTmp, ".DBF
", ".TXT
" )
nLines:= MLCOUNT( cTxt, 240 )
cTxt2:= " "
FOR nLin= 1 TO nLines
cTxt2 += RTRIM( MEMOLINE( cTxt, 240, nLin ) ) + CRLF
NEXT nLin
cTxt := ALLTRIM( cTxt2 )
MEMOWRIT( cTxtTmp, STRTRAN( cTxt, ::cFormFeed, "" ) + ::cFormFeed )
IF FILE('dosprint.bat')
WAITRUN("DOSPRINT.BAT
" + cTxtTmp + " " + cPorta, 0 )
ELSE
cPorta:= "PRN
"
winexec( "start c:\command.com /c copy /b
"+ cTxtTmp + " " + cPorta)
ENDIF
IF FILE( cTxtTmp )
* FERASE( cTxtTmp )
ENDIF
ELSE
oPrn:Startpage()
nLines:= MLCOUNT( cTxt, 240 )
FOR nLin= 1 TO nLines
cLine := RTRIM( MEMOLINE( cTxt, 240, nLin ) )
oPrn:SAY( nLin, 00, STRTRAN( cLine, ::cFormFeed, "" ) )
NEXT nLin
oPrn:EndPage()
ENDIF
RETURN Nil
//----------------------------------------------------------------------------//
METHOD BuildMenu() CLASS TTxtPreview
LOCAL nFor
MENU ::oMenu
MENUITEM TXT_FILE
MENU
MENUITEM TXT_PRINT ACTION ::PRINT() ;
MESSAGE TXT_PRINT_CURRENT_PAGE RESOURCE "Printer"
SEPARATOR
MENUITEM TXT_EXIT ACTION ::oWnd:END() ;
MESSAGE TXT_EXIT_PREVIEW RESOURCE "Exit
"
ENDMENU
MENUITEM TXT_PAGE
MENU
MENUITEM TXT_FIRST ACTION ::TopPage() ;
MESSAGE TXT_GOTO_FIRST_PAGE RESOURCE "Top
"
MENUITEM TXT_PREVIOUS ACTION ::PrevPage() ;
MESSAGE TXT_GOTO_PREVIOUS_PAGE RESOURCE "Previous
"
MENUITEM TXT_NEXT ACTION ::NextPage() ;
MESSAGE TXT_GOTO_NEXT_PAGE RESOURCE "Next"
MENUITEM TXT_LAST ACTION ::BottomPage() ;
MESSAGE TXT_GOTO_LAST_PAGE RESOURCE "Bottom
"
SEPARATOR
MENUITEM ::oMenuZoom PROMPT TXT_ZOOM ACTION ::Zoom_in() ENABLED ;
MESSAGE TXT_ZOOM_THE_PREVIEW RESOURCE "Zoom +
"
MENUITEM ::oMenuUnZoom PROMPT TXT_UNZOOM ACTION ::Zoom_out() ENABLED ;
MESSAGE "Deshacer Zoom de la página
" RESOURCE "Zoom -
"
ENDMENU
ENDMENU
RETURN nil
//----------------------------------------------------------------------------//
METHOD BuildDbfTmp() CLASS TTxtPreview
LOCAL oFile, nPag, cTxt, lFim, oDlg, oBtn
LOCAL cLine, nStart, nEnd, cAlias, oIcono
SysRefresh()
cAlias := cGetNewAlias( "TXTP
" )
::cDbfTmp := UPPER( cTmpName( ::cDir ) )
::cMemTmp := STRTRAN( ::cDbfTmp, ".DBF
", cMemoExt() )
IF FILE( ::cDbfTmp )
FERASE( ::cDbfTmp )
ENDIF
DBCREATE( ::cDbfTmp, { { "PAGINA
", "N
", 5, 00 },;
{ "TEXT", "M
", 10, 00 } } )
USE ( ::cDbfTmp ) EXCLUSIVE ALIAS &( cAlias ) NEW
oFile = TTxtFile():New( ::cTxtFile )
IF ! oFile:Open( 0 )
MsgInfo( "El Archivo
" + ::cTxtFile + ", no puede ser abierto.
" )
RETURN nil
ENDIF
DEFINE DIALOG oDlg Resource "PREVIEW_PROC
" TITLE "Generando Previsualizacion...
"
REDEFINE ICON oIcono ID 105 RESOURCE "XPRINT
" OF oDlg
REDEFINE BUTTONBMP oBtn ID IDCANCEL BITMAP "ESPERA
" TEXTRIGHT OF oDlg ACTION .t.
ACTIVATE DIALOG oDlg CENTER ON INIT (oDlg:SetIcon(oIcon))
CursorWait()
SysRefresh()
nPag= 0
cTxt= ""
lFim= .F.
DO WHILE .T.
cLine = oFile:cLine
IF ::lModoGraf
// eliminamos algunos caracteres de control de la impresora
cLine = STRTRAN(cLine, ::cNegOn , "")
cLine = STRTRAN(cLine, ::cNegOff, "")
cLine = STRTRAN(cLine, ::c10cpi , "")
cLine = STRTRAN(cLine, ::c12cpi , "")
cLine = STRTRAN(cLine, ::cWidOn , "")
cLine = STRTRAN(cLine, ::cWidOff, "")
ENDIF
cTxt += cLine + SPACE(1) + CRLF
oFile:SKIP(1)
//--- si encuentra salto de pagina
IF ::cFormFeed $ cLine .OR. oFile:lEof()
nPag ++ // incrementa Pagina
append blank // adiciona reg
REPLACE PAGINA WITH nPag // grava os dados
REPLACE TEXT WITH cTxt
cTxt = ""
ENDIF
IF oFile:lEof
lFim = .t.
EXIT
ENDIF
ENDDO
oFile:CLOSE()
SELECT ( cAlias )
DATABASE ::oDbf
::oDbf:bEoF = nil
::oDbf:bBoF = nil
::oDbf:GoTop()
CursorArrow()
oDlg:END()
RETURN Nil
//----------------------------------------------------------------------------//
METHOD TxtToRTF( cTxt ) CLASS TTxtPreview
// Esta rutina falta mejorar para convertir los tipos de letras
// en formato RTF
LOCAL cType, cTextFormat, nColor
LOCAL lFlagComp
cTextFormat := ""
cTxt = STRTRAN(cTxt, ::cNegOn , "")
cTxt = STRTRAN(cTxt, ::cNegOff, "")
cTxt = STRTRAN(cTxt, ::c10cpi , "")
cTxt = STRTRAN(cTxt, ::c12cpi , "")
cTxt = STRTRAN(cTxt, ::cWidOn , "")
cTxt = STRTRAN(cTxt, ::cWidOff, "")
cTxt = STRTRAN(cTxt, ::cCompress, "")
cTxt = STRTRAN(cTxt, ::cNormal, "")
IF IsOEM(cTxt)
cTxt := OemToAnsi(cTxt)
ENDIF
IF ( lFlagComp:= ( AT( ::cCompress, cTxt ) > 0 ) )
//define font
::lZoom:= .t.
ELSE
::lZoom:= .f.
ENDIF
cTxt:= STRTRAN( cTxt, ::cFormFeed, "" )
cTextFormat += cTxt
RETURN cTextFormat
//----------------------------------------------------------------------------//
METHOD Command( cStr1, cStr2, cStr3, cStr4, cStr5 ) CLASS TTxtPreview
LOCAL cCommand, cToken, cString
LOCAL nToken
cString := cStr1
IF cStr2 != nil
cString += ",
" + cStr2
ENDIF
IF cStr3 != nil
cString += ",
" + cStr3
ENDIF
IF cStr4 != nil
cString += ",
" + cStr4
ENDIF
IF cStr5 != nil
cString += ",
" + cStr5
ENDIF
cCommand := ""
nToken := 1
DO WHILE ! EMPTY( cToken := StrToken( cString, nToken++, ",
" ) )
cCommand += CHR(VAL(cToken))
ENDDO
RETURN cCommand
//----------------------------------------------------------------------------//
METHOD Destroy() CLASS TTxtPreview
::oWnd:oIcon := nil
::oFGet:END()
::oDbf:CLOSE()
FERASE( ::cDbfTmp )
FERASE( ::cMemTmp )
IF ::lKillFile // RDC
FERASE( ::cTxtFile )
ENDIF
SELECT(nOldArea) //RDC
::lExit := .T.
--snCurPrev
IF oMdiTmp != Nil
oMdiTmp:END()
oMdiTmp:= Nil
ENDIF
IF UPPER( ::oWnd:ClassName() ) == "TMDICHILD
"
::oWnd:oWndClient:ChildClose( ::oWnd )
ENDIF
::oWndMain:Setfocus()
Self:= Nil
RETURN .t.
//----------------------------------------------------------------------------//
// Static functions
//----------------------------------------------------------------------------//
STATIC FUNCTION cTmpName( cDir ) // Toninho@fwi.com.br
LOCAL cFile:= cDir + STRTRAN( LTRIM( STR( SECONDS() ) ), ".
", "" ) + ".dbf
"
WHILE FILE( cFile )
cFile = cDir + STRTRAN( LTRIM( STR( SECONDS() ) ), ".
", "" ) + ".dbf
"
ENDDO
RETURN cFile
//----------------------------------------------------------------------------//
STATIC FUNCTION cMemoExt()
LOCAL cRet, cRddName
cRddName := RDDSETDEFAULT()
#ifdef __HARBOUR__
cRddName := IF( cRddName == "DBF
", "DBFNTX
", cRddName )
#endif
IF "DBFCDX
" $ cRddName .OR. "SIXCDX
" $ cRddName
cRet:= ".FPT
"
ELSEIF cRddName = "ADS
"
cRet:= ".DBT
"
ELSE
cRet:= ".DBT
"
ENDIF
RETURN cRet
//----------------------------------------------------------------------------//
STATIC FUNCTION Str2Arr2( cStr, cDelim, cSubDelim )
LOCAL aArray := {}
LOCAL nPos := 0
LOCAL cTmp
DEFAULT cDelim := ",
"
WHILE ( nPos := AT( cDelim, cStr ) ) != 0
cTmp := SUBSTR( cStr, 1, nPos - 1 )
IF cSubDelim != nil
IF AT( cSubDelim, cTmp ) > 0
cTmp := Str2Arr2( cTmp, cSubDelim )
ENDIF
ENDIF
AADD( aArray, cTmp )
nPos += LEN( cDelim )
cStr := SUBSTR( cStr, nPos )
ENDDO
AADD( aArray, cStr )
RETURN aArray
//----------------------------------------------------------------------------//
#define TA_BASELINE 24
METHOD GPrint(oPrint, cTexto) CLASS TTxtPreview
LOCAL n
LOCAL oPrn
LOCAL nRow := 0
LOCAL nCol := 0
LOCAL nMarg := 100
LOCAL nRowStep
LOCAL cText
LOCAL oFont, nFont
// creamos un array para guardar fonts apropiados para impresora laser
LOCAL aFonts := ARRAY( 4 ), lIsPrt
IF EMPTY(oPrint)
PRINT oPrn NAME "Notes
"
lIsPrt := .t.
ELSE
oPrn := oPrint
lIsPrt := .f.
ENDIF
IF EMPTY( oPrn:hDC )
MsgStop( "Printer not ready!
" )
RETURN self
ENDIF
oPrn:Setpage(9) // A4
cFaceName := "Lucida console
" // este es un font escalable
nWidth := 0
nHeight := -11.9
// definimos escalas equivalentes a los fonts tradicionales modo DOS
// normal, elite, comprimida, elite comprimida
aSizes := {1, 80/96, 10/17, 10/20 }
// Definimos los fonts a usar
aFonts[ 1 ] := TFont():New( cFaceName, nWidth, nHeight, ,;
, , , , , , , , , , , oPrn )
aFonts[ 2 ] := TFont():New( cFaceName, nWidth*aSizes[2], nHeight*aSizes[2], ,;
, , , , , , , , , , , oPrn )
aFonts[ 3 ] := TFont():New( cFaceName, nWidth*aSizes[3], nHeight*aSizes[3], ,;
, , , , , , , , , , , oPrn )
aFonts[ 4 ] := TFont():New( cFaceName, nWidth*aSizes[4], nHeight*aSizes[4], ,;
, , , , , , , , , , , oPrn )
CursorWait()
aText := ::Text2Lines(cTexto)
PAGE
nRowStep := 0
oFont := aFonts[ 1 ]
nMaxlen := 0
FOR n := 1 TO LEN( aText )
cText := aText[ n ]
nMaxlen := MAX( nMaxlen, LEN(cText) )
NEXT
// escojemos el font adecuado para la longitud del texto
// el tamaño maximo de todas las lineas determina el font a usar
// y ese font se usa para calcular el avance de linea
DO CASE
CASE nMaxlen<= 80
nFont := 2 // el font1 es muy grande para imprimir
CASE nMaxlen<= 96
nFont := 2
CASE nMaxlen<= 132
nFont := 3
CASE nMaxlen<= 160
nFont := 4
OTHERWISE
nFont := 4
ENDCASE
nFont := MAX( 1, nFont )
oFont := aFonts[ nFont ]
// vemos si es necesario ajustar el tamaño de fuente por un factor para
// que el texto entre en la hoja horizontalmente
cText := ATAIL(aText)
nWidthLine := ( oPrn:GetTextWidth( RIGHT(ALLTRIM(cText),1), oFont ) * nMaxlen ) + nMarg + 80
IF nWidthLine > oPrn:nHorzRes()
factor := ROUND(oPrn:nHorzRes() / (nWidthLine),4)
msgwait("ajustando texto al ancho de la hoja
"+TRANSFORM(factor*100,"999")+"%
",,1)
oFont := TFont():New( cFaceName, nWidth*aSizes[nFont]*factor, nHeight*aSizes[nFont]*factor, ,;
, , , , , , , , , , , oPrn )
ENDIF
nRowStep := ABS( oFont:nHeight )*1.15 // aumentamos un 15% para mejor legibilidad
//--------------
nCol := 0
FOR n := 1 TO LEN( aText )
cText := aText[ n ]
oPrn:SAY( nRow, nMarg+nCol, cText, oFont )
nRow += nRowStep
IF nRow > oPrn:nVertRes()
nRow := nRowStep
ENDPAGE
PAGE
ENDIF
NEXT
ENDPAGE
IF lIsPrt
ENDPRINT
ENDIF
AEVAL( aFonts, { |oFont| oFont:END() } )
CursorArrow()
RETURN nil
//----------------------------------------------------------------------------//
METHOD Text2Lines( cTxt ) CLASS TTxtPreview
LOCAL cLine, aLines := {}, nLin
// eliminamos algunos caracteres de control de la impresora
// porque vamos a imprimir en formato plano
// asumimos que no hay cambio de font en una misma linea
cTxt = STRTRAN(cTxt, ::cNegOn , "")
cTxt = STRTRAN(cTxt, ::cNegOff, "")
cTxt = STRTRAN(cTxt, ::c10cpi , "")
cTxt = STRTRAN(cTxt, ::c12cpi , "")
cTxt = STRTRAN(cTxt, ::cWidOn , "")
cTxt = STRTRAN(cTxt, ::cWidOff, "")
cTxt = STRTRAN(cTxt, ::cCompress, "")
cTxt = STRTRAN(cTxt, ::cNormal, "")
IF IsOEM(cTxt)
cTxt := OemToAnsi(cTxt)
ENDIF
nCrLF := AT( CRLF, cTxt )
DO WHILE nCrLF > 0
cLine := SUBSTR( cTxt, 1, nCrLF - 1 )
cLine := STRTRAN( cLine, ::cFormFeed, "" )
AADD(aLines, TRIM(cLine))
cTxt := SUBSTR( cTxt, nCrLF+2 )
nCrLF := AT( CRLF, cTxt )
ENDDO
RETURN aLines