Gente:
se puede salir de un preview con el teclado? por ejemplo con la tecla Enter
FiveTech Software tech support forums
www.FiveTechSoft.com
cerrar ventana preview con teclado
11 posts • Page 1 of 1
cerrar ventana preview con teclado
by artu01 » Thu Jan 19, 2017 12:00 am
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
- artu01
- Posts: 397
- Joined: Fri May 11, 2007 8:20 pm
- Location: Lima
Re: cerrar ventana preview con teclado
by FranciscoA » Thu Jan 19, 2017 1:02 am
De la manera mas simple, puedes hacer: ALT+F Y S.
Si quieres hacer tu propia function, no lo he hecho.
Saludos.
Si quieres hacer tu propia function, no lo he hecho.
Saludos.
Francisco J. Alegría P.
Chinandega, Nicaragua.
Fwxh-MySql-TMySql
Chinandega, Nicaragua.
Fwxh-MySql-TMySql
-
FranciscoA - Posts: 2134
- Joined: Fri Jul 18, 2008 1:24 am
- Location: Chinandega, Nicaragua, C.A.
Re: cerrar ventana preview con teclado
by artu01 » Thu Jan 19, 2017 5:20 am
Hola francisco, quiero evitar la combinación de teclas, lo necesito con una tecla como ESC
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
- artu01
- Posts: 397
- Joined: Fri May 11, 2007 8:20 pm
- Location: Lima
Re: cerrar ventana preview con teclado
by mastintin » Thu Jan 19, 2017 9:43 am
yo lo tengo así :
METHOD BuildWindow() CLASS TPreview
.....
::oWnd:bKeydown := { | nKey, nFlags | Iif( nkey == 27 , ::oWnd:End(),) }
.....
Return
METHOD BuildWindow() CLASS TPreview
.....
::oWnd:bKeydown := { | nKey, nFlags | Iif( nkey == 27 , ::oWnd:End(),) }
.....
Return
-
mastintin - Posts: 1516
- Joined: Thu May 27, 2010 2:06 pm
Re: cerrar ventana preview con teclado
by artu01 » Thu Jan 19, 2017 9:59 pm
mastintin wrote:yo lo tengo así :
METHOD BuildWindow() CLASS TPreview
.....
::oWnd:bKeydown := { | nKey, nFlags | Iif( nkey == 27 , ::oWnd:End(),) }
.....
Return
Mastintin gracias por responder, en realidad estoy usando la clase txtview y si existe la condicion de que al presionar
Esc se cierre la ventana, sin embargo lo ignora, pego el metodo Keydown de la clase donde se define la condición:
- Code: Select all Expand view
- METHOD KeyDown( nKey, nFlags ) CLASS TTxtPreview
if nKey == 27 // VK_ESCAPE ==>ignora esta condicion
::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
Remito toda la clase Txtview
- Code: Select all Expand view
*---------------------------------------------------------------------------
* TxtPreview - Ednaldo Rolim (edrol@uol.com.br)
* Modificado por Ralph del Castillo para la clase tRichEdit
* ==========================================================================
* 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(), 17 ) //16
#define TXT_FILE LoadString( GetResources(), 18 ) //17
#define TXT_PAGE LoadString( GetResources(), 19 ) //
#define TXT_PREVIEW LoadString( GetResources(), 03 )
#define TXT_PAGENUM LoadString( GetResources(), 20 ) //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
static snCurPrev := 0
static 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 )
LOCAL oPrev
local hOldRes := GetResources()
local hDLL := LoadLibrary( "Riched20.dll" )
if WndMain() = NIL
lPrvModal := .t.
oDlg:Hide()
DEFINE WINDOW oMdiTmp FROM 0, 0 TO 20, 79 MDI TITLE "TxtPreview"
SET MESSAGE OF oMdiTmp TO "Preview" CENTERED NOINSET
ACTIVATE WINDOW oMdiTmp ICONIZED ;
ON INIT TxtPrevDlg( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint ) //RDC
oDlg:Show()
oDlg:SetFocus()
else
oPrev := TTxtPreview():New( cFileTxt,, lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint ) //RDC
oPrev:Activate()
endif
FreeLibrary( hDLL )
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
static function TxtPrevDlg( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint )
LOCAL oPrev
oPrev := TTxtPreview():New( cFileTxt, oMdiTmp , lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint )
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 oCursor
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 AS String
DATA cNegOn, cNegOff, cItaOn, cItaOff, cEmpOn, cEmpOff AS String
DATA c10Cpi, c12Cpi, cWidOn, cWidOff AS String
METHOD New( cFileTxt, oWndMain, lModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint ) CONSTRUCTOR // RDC
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 ) CLASS TTxtPreview
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
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("27,71")
::cNegOff := ::Command("27,72")
::c10cpi := ::Command("27,80")
::c12cpi := ::Command("27,77")
::cWidOn := ::Command("27,87,1")
::cWidOff := ::Command("27,87,0")
// se redefinio porque funcion hasta la fwh 10.8
// ::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 CURSOR ::oCursor RESOURCE "Lupa"
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 ) ;
ICON oIcon ;
MDICHILD OF oWndMain ;
PIXEL
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() ;
ICON oIcon
endif
::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 26, if( LargeFonts(), 30, 26 ) 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 "Previous" 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
@ ::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"
DEFINE BUTTON RESOURCE "Printer2" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION PrinterSetup() ;
TOOLTIP "Seleccionar Impresora" NOBORDER
DEFINE BUTTON RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" ) NOBORDER
// DEFINE BUTTON RESOURCE "acrobat" OF ::oBar GROUP ;
// MESSAGE "Generar Archico PDF" ;
// ACTION SavePDF( oDevice ) ;
// TOOLTIP "Generar Archivo PDF" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" ) NOBORDER
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 "Previous" 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 RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" )
// DEFINE BUTTON RESOURCE "acrobat" OF ::oBar GROUP ;
// MESSAGE "Generar Archico PDF" ;
// ACTION SavePDF( oDevice ) ;
// TOOLTIP "Generar Archivo PDF" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" )
endif
@ ::oBar:nTop + 7, ::oBar:nLeft + 390 SAY ::oPage ; //::oBar:nLeft + 330 // el ultimo ::oBar:nLeft + 380
PROMPT TXT_PAGENUM +" "+ LTrim( Str( ::nPage, 3 ) ) + ;
" / " + LTrim( Str( ::oDbf:RecCount() ) ) ;
SIZE 160, 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:oCursor := ::oCursor
::oFGet:blDblClick := {|| ::Zoom_in() }
::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 "Previous" ACTION ::PrevPage()
else
MENUITEM TXT_FIRST RESOURCE "Top" ACTION ::TopPage() DISABLED
MENUITEM TXT_PREVIOUS RESOURCE "Previous" 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 TXT_ZOOM RESOURCE "Zoom" ACTION ::Zoom_in()
MENUITEM TXT_PRINT RESOURCE "Printer" ACTION ::Print()
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
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
if ::oSize:nAt < len(::oSize:aItems )
::oSize:select(::oSize:nAt+1)
::oSize:change()
::zoom()
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Zoom")
::oZoom:Refresh()
else
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Unzoom")
::oZoom:Refresh()
Tone(500,1)
return nil
endif
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
return nil
//----------------------------------------------------------------------------//
METHOD Zoom_out() CLASS TTxtPreview
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
if ::oSize:nAt > 1
::oSize:select(::oSize:nAt-1)
::oSize:change()
::zoom()
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Zoom")
::oZoom:Refresh()
else
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Unzoom")
::oZoom:Refresh()
Tone(500,1)
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
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
// se for fw abaixo da 2.1
if .f. //At( "1.9", FWVERSION ) >0 .or. At( "2", FWVERSION ) >0
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
DEFINE DIALOG oDlg RESOURCE "PRINT" FONT ::oWnd:oFont
REDEFINE SAY PROMPT PrnGetName() ID 101 OF oDlg
REDEFINE SAY PROMPT PrnGetDrive() ID 102 OF oDlg
REDEFINE SAY PROMPT ::cPort ID 103 OF oDlg
REDEFINE RADIO oRad VAR nOption ID 110, 111, 112, 113, 114, 115 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 GET oPageIni VAR nFirst ID 120 ;
PICTURE "@K 99999" ;
VALID if( nFirst < 1 .or. nFirst > nLast, ( MessageBeep() , .F. ), .T. ) ;
OF oDlg
REDEFINE GET oPageFin VAR nLast ID 121 ;
PICTURE "@K 99999" ;
VALID if( nLast < nFirst .or. nLast > ::oDbf:Reccount(), ;
( MessageBeep(), .F. ), .T. ) ;
OF oDlg
REDEFINE GET oRange VAR cRange ID 122 ;
OF oDlg PICTURE "@S!"
REDEFINE GET nCopies ID 130 ;
OF oDlg ;
UPDATE SPINNER MIN 1 MAX 999 ;
VALID nCopies > 0 .and. nCopies <= 999 ;
PICTURE "999"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
REDEFINE BUTTON ID 201 OF oDlg ;
ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
REDEFINE BUTTON ID 202 OF oDlg ;
ACTION oDlg:End()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
else // se for fw 2.1 em diante ou Harbour
DEFINE DIALOG oDlg TITLE "Impresion" ;
FROM 129, 178 TO 459, 635 PIXEL FONT ::oWnd:oFont
@ 006, 008 GROUP OGRP TO 45, 220 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
@ 050, 008 GROUP OGRP TO 145, 115 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
@ 050, 120 GROUP OGRP TO 145, 220 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
// @ 06, 08 TO 45, 220 OF oDlg PIXEL PROMPT "Impresora:" // hasta fwh 11.09 funcionaba
// @ 50, 08 TO 145, 115 OF oDlg PIXEL PROMPT "Páginas a Imprimir:"
// @ 50, 120 TO 145, 220 OF oDlg PIXEL PROMPT "Copias:"
@ 15, 15 SAY "Nombre :" PIXEL OF oDlg SIZE 30, 8
@ 24, 15 SAY "Tipo :" PIXEL OF oDlg SIZE 30, 8
@ 33, 15 SAY "Puerto :" PIXEL OF oDlg SIZE 30, 8
@ 15, 50 SAY PrnGetName() PIXEL OF oDlg SIZE 150, 8
@ 24, 50 SAY PrnGetDrive() PIXEL OF oDlg SIZE 150, 8
* @ 33, 50 SAY PrnGetPort() PIXEL OF oDlg SIZE 150, 8
@ 33, 50 SAY ::cPort PIXEL OF oDlg SIZE 150, 8
@ 113, 65 GET oPageIni VAR nFirst SIZE 18, 11 PIXEL OF oDlg ;
PICTURE "@K 99999" ;
VALID if( nFirst < 1 .or. nFirst > nLast, ( MessageBeep() , .F. ), .T. )
@ 115, 85 SAY "a" PIXEL OF oDlg SIZE 5, 8
@ 113, 92 GET oPageFin VAR nLast SIZE 18, 11 PIXEL OF oDlg ;
PICTURE "@K 99999" ;
VALID if( nLast < nFirst .or. nLast > ::oDbf:Reccount(), ;
( MessageBeep(), .F. ), .T. )
@ 126, 55 GET oRange VAR cRange SIZE 55, 11 PIXEL OF oDlg PICTURE "@S!"
@ 60, 10 RADIO oRad VAR nOption PIXEL OF oDlg ;
ITEMS "&Todo", "&Pagina actual", "Paginas pa&res",;
"Paginas imp&ares", "&De pagina", "Pag&inas" ;
ON CHANGE ( if( nOption == 5, ;
( oPageIni:Enable(), oPageFin:Enable() ), ;
( oPageIni:Disable(), oPageFin:Disable() ) ), ;
if( nOption == 6, oRange:Enable(), oRange:Disable() ) ) ;
WHEN ::oDbf:Reccount() > 1
@ 60, 125 SAY "Numero de Copias :" PIXEL OF oDlg SIZE 50, 18
@ 59, 175 GET nCopies SIZE 20, 11 PIXEL OF oDlg UPDATE ;
SPINNER MIN 1 MAX 999 ;
VALID nCopies > 0 .and. nCopies <= 999 ;
PICTURE "999"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
@ 150, 115 BUTTON "&Ok" SIZE 50, 11 PIXEL OF oDlg ;
ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
@ 150, 170 BUTTON "&Cancelar" SIZE 50, 11 PIXEL OF oDlg ;
ACTION oDlg:End()
endif
ACTIVATE DIALOG oDlg CENTERED
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 := alltrim(PrnGetPort()) //AYA
//Default cPorta := Alltrim( PrnGetPort() ), lErase:= .t.
cPrinter := PrinterPortToName( oPrn:cPort ) //AYA
IF EMPTY( cPrinter )
cPrinter := PrinterPortToName( "USB002" )
IF EMPTY(cPrinter)
cPrinter := PrinterPortToName( "USB001" )
ENDIF
ENDIF
/*
IF .NOT. FILE( cFileTxt )
MsgInfo( OemToAnsi( "No existe el archivo modo texto para imprimir en matricial" ), ;
OemToAnsi( "No existe el archivo modo texto para imprimir en matricial" ) )
RETURN( .F. )
ENDIF
IF .NOT. EMPTY( cPrinter ) // TEM USB
// PrintFileRaw( cPrinter, TrueName( "CUPOM.TXT" ), "Impressão de Vendas" )
PrintFileRaw( cPrinter, TrueName( cFileTxt ), "Impressão de Vendas" )
ELSEIF LEN( cPorta ) <= 5 .and. Left( Upper(cPorta), 4 ) = "LPT1"
//--- Spool Local - Matricial em LPT1
cPorta:= "PRN"
WAITRUN("COMMAND.COM /C COPY /B " + cFileTxt + " " + cPorta, 0 )
ELSE
//--- Spool Remoto - Matricial em LPT1
WAITRUN("COMMAND.COM /C COPY /B " + cFileTxt + " " + cPorta, 0 )
ENDIF
IF lErase // Vem .T. da tela de vendas
FERASE( cFileTxt )
ENDIF */
for nCopy = 1 to nCopies
do case
//--- Todas
case nOption == 1
//PrintFileRaw( cPrinter, TrueName( ::cTxtFile ), "Impressão de Vendas" ) //AYA
::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
PrintFileRaw( cPrinter, TrueName( ::cTxtFile ), "Reporte de Impresion" ) //AYA //IMPRIME REMOTO
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 TXT_UNZOOM_THE_PREVIEW RESOURCE "Zoom -"
ENDMENU
ENDMENU
return nil
//----------------------------------------------------------------------------//
METHOD BuildDbfTmp() CLASS TTxtPreview
local oFile, nPag, cTxt, lFim, oDlg
local cLine, nStart, nEnd, cAlias
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 TITLE "Generando Previsualizacion..." ;
FROM 230, 217 TO 360, 575 PIXEL
@ 010, 008 GROUP OGRP TO 40, 172 OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
//@ 10, 08 TO 40, 172 OF oDlg PIXEL // hasta fwh 11.09 funcionaba
@ 1.4, 2 ICON NAME "PRINT" OF oDlg
@ 25, 55 SAY "Generando Previsualizacion..." PIXEL OF oDlg SIZE 80, 12 CENTER
@ 47, 60 BUTTON "Espere..." SIZE 60, 12 PIXEL OF oDlg ACTION .t.
ACTIVATE DIALOG oDlg CENTER NOWAIT
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
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
- artu01
- Posts: 397
- Joined: Fri May 11, 2007 8:20 pm
- Location: Lima
Re: cerrar ventana preview con teclado
by karinha » Fri Jan 20, 2017 1:13 pm
Intenta asi:
- Code: Select all Expand view
*---------------------------------------------------------------------------
* TxtPreview - Ednaldo Rolim (edrol@uol.com.br)
* Modificado por Ralph del Castillo para la clase tRichEdit
* ==========================================================================
* 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(), 17 ) //16
#define TXT_FILE LoadString( GetResources(), 18 ) //17
#define TXT_PAGE LoadString( GetResources(), 19 ) //
#define TXT_PREVIEW LoadString( GetResources(), 03 )
#define TXT_PAGENUM LoadString( GetResources(), 20 ) //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
static snCurPrev := 0
static 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 )
LOCAL oPrev
local hOldRes := GetResources()
local hDLL := LoadLibrary( "Riched20.dll" )
if WndMain() = NIL
lPrvModal := .t.
oDlg:Hide()
DEFINE WINDOW oMdiTmp FROM 0, 0 TO 20, 79 MDI TITLE "TxtPreview"
SET MESSAGE OF oMdiTmp TO "Preview" CENTERED NOINSET
ACTIVATE WINDOW oMdiTmp ICONIZED ;
ON INIT TxtPrevDlg( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint ) //RDC
oDlg:Show()
oDlg:SetFocus()
else
oPrev := TTxtPreview():New( cFileTxt,, lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint ) //RDC
oPrev:Activate()
endif
FreeLibrary( hDLL )
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
static function TxtPrevDlg( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint )
LOCAL oPrev
oPrev := TTxtPreview():New( cFileTxt, oMdiTmp , lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint )
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 oCursor
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 AS String
DATA cNegOn, cNegOff, cItaOn, cItaOff, cEmpOn, cEmpOff AS String
DATA c10Cpi, c12Cpi, cWidOn, cWidOff AS String
METHOD New( cFileTxt, oWndMain, lModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint ) CONSTRUCTOR // RDC
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 ) CLASS TTxtPreview
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
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("27,71")
::cNegOff := ::Command("27,72")
::c10cpi := ::Command("27,80")
::c12cpi := ::Command("27,77")
::cWidOn := ::Command("27,87,1")
::cWidOff := ::Command("27,87,0")
// se redefinio porque funcion hasta la fwh 10.8
// ::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 CURSOR ::oCursor RESOURCE "Lupa"
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 ) ;
ICON oIcon ;
MDICHILD OF oWndMain ;
PIXEL
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() ;
ICON oIcon
endif
::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 26, if( LargeFonts(), 30, 26 ) 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 "Previous" 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
@ ::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"
DEFINE BUTTON RESOURCE "Printer2" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION PrinterSetup() ;
TOOLTIP "Seleccionar Impresora" NOBORDER
DEFINE BUTTON RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" ) NOBORDER
// DEFINE BUTTON RESOURCE "acrobat" OF ::oBar GROUP ;
// MESSAGE "Generar Archico PDF" ;
// ACTION SavePDF( oDevice ) ;
// TOOLTIP "Generar Archivo PDF" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" ) NOBORDER
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 "Previous" 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 RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" )
// DEFINE BUTTON RESOURCE "acrobat" OF ::oBar GROUP ;
// MESSAGE "Generar Archico PDF" ;
// ACTION SavePDF( oDevice ) ;
// TOOLTIP "Generar Archivo PDF" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" )
endif
@ ::oBar:nTop + 7, ::oBar:nLeft + 390 SAY ::oPage ; //::oBar:nLeft + 330 // el ultimo ::oBar:nLeft + 380
PROMPT TXT_PAGENUM +" "+ LTrim( Str( ::nPage, 3 ) ) + ;
" / " + LTrim( Str( ::oDbf:RecCount() ) ) ;
SIZE 160, 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:oCursor := ::oCursor
::oFGet:blDblClick := {|| ::Zoom_in() }
::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
// NUEVO
do case
CASE nKey == VK_ESCAPE .OR. GetKeyState( VK_ESCAPE )
//QUIT
RETURN( .F. )
endcase
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 "Previous" ACTION ::PrevPage()
else
MENUITEM TXT_FIRST RESOURCE "Top" ACTION ::TopPage() DISABLED
MENUITEM TXT_PREVIOUS RESOURCE "Previous" 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 TXT_ZOOM RESOURCE "Zoom" ACTION ::Zoom_in()
MENUITEM TXT_PRINT RESOURCE "Printer" ACTION ::Print()
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
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
if ::oSize:nAt < len(::oSize:aItems )
::oSize:select(::oSize:nAt+1)
::oSize:change()
::zoom()
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Zoom")
::oZoom:Refresh()
else
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Unzoom")
::oZoom:Refresh()
Tone(500,1)
return nil
endif
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
return nil
//----------------------------------------------------------------------------//
METHOD Zoom_out() CLASS TTxtPreview
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
if ::oSize:nAt > 1
::oSize:select(::oSize:nAt-1)
::oSize:change()
::zoom()
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Zoom")
::oZoom:Refresh()
else
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Unzoom")
::oZoom:Refresh()
Tone(500,1)
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()
// NUEVO
CASE nKey == VK_ESCAPE .OR. GetKeyState( VK_ESCAPE )
//QUIT
RETURN( .F. )
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
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
// se for fw abaixo da 2.1
if .f. //At( "1.9", FWVERSION ) >0 .or. At( "2", FWVERSION ) >0
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
DEFINE DIALOG oDlg RESOURCE "PRINT" FONT ::oWnd:oFont
REDEFINE SAY PROMPT PrnGetName() ID 101 OF oDlg
REDEFINE SAY PROMPT PrnGetDrive() ID 102 OF oDlg
REDEFINE SAY PROMPT ::cPort ID 103 OF oDlg
REDEFINE RADIO oRad VAR nOption ID 110, 111, 112, 113, 114, 115 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 GET oPageIni VAR nFirst ID 120 ;
PICTURE "@K 99999" ;
VALID if( nFirst < 1 .or. nFirst > nLast, ( MessageBeep() , .F. ), .T. ) ;
OF oDlg
REDEFINE GET oPageFin VAR nLast ID 121 ;
PICTURE "@K 99999" ;
VALID if( nLast < nFirst .or. nLast > ::oDbf:Reccount(), ;
( MessageBeep(), .F. ), .T. ) ;
OF oDlg
REDEFINE GET oRange VAR cRange ID 122 ;
OF oDlg PICTURE "@S!"
REDEFINE GET nCopies ID 130 ;
OF oDlg ;
UPDATE SPINNER MIN 1 MAX 999 ;
VALID nCopies > 0 .and. nCopies <= 999 ;
PICTURE "999"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
REDEFINE BUTTON ID 201 OF oDlg ;
ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
REDEFINE BUTTON ID 202 OF oDlg ;
ACTION oDlg:End()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
else // se for fw 2.1 em diante ou Harbour
DEFINE DIALOG oDlg TITLE "Impresion" ;
FROM 129, 178 TO 459, 635 PIXEL FONT ::oWnd:oFont
@ 006, 008 GROUP OGRP TO 45, 220 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
@ 050, 008 GROUP OGRP TO 145, 115 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
@ 050, 120 GROUP OGRP TO 145, 220 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
// @ 06, 08 TO 45, 220 OF oDlg PIXEL PROMPT "Impresora:" // hasta fwh 11.09 funcionaba
// @ 50, 08 TO 145, 115 OF oDlg PIXEL PROMPT "Páginas a Imprimir:"
// @ 50, 120 TO 145, 220 OF oDlg PIXEL PROMPT "Copias:"
@ 15, 15 SAY "Nombre :" PIXEL OF oDlg SIZE 30, 8
@ 24, 15 SAY "Tipo :" PIXEL OF oDlg SIZE 30, 8
@ 33, 15 SAY "Puerto :" PIXEL OF oDlg SIZE 30, 8
@ 15, 50 SAY PrnGetName() PIXEL OF oDlg SIZE 150, 8
@ 24, 50 SAY PrnGetDrive() PIXEL OF oDlg SIZE 150, 8
* @ 33, 50 SAY PrnGetPort() PIXEL OF oDlg SIZE 150, 8
@ 33, 50 SAY ::cPort PIXEL OF oDlg SIZE 150, 8
@ 113, 65 GET oPageIni VAR nFirst SIZE 18, 11 PIXEL OF oDlg ;
PICTURE "@K 99999" ;
VALID if( nFirst < 1 .or. nFirst > nLast, ( MessageBeep() , .F. ), .T. )
@ 115, 85 SAY "a" PIXEL OF oDlg SIZE 5, 8
@ 113, 92 GET oPageFin VAR nLast SIZE 18, 11 PIXEL OF oDlg ;
PICTURE "@K 99999" ;
VALID if( nLast < nFirst .or. nLast > ::oDbf:Reccount(), ;
( MessageBeep(), .F. ), .T. )
@ 126, 55 GET oRange VAR cRange SIZE 55, 11 PIXEL OF oDlg PICTURE "@S!"
@ 60, 10 RADIO oRad VAR nOption PIXEL OF oDlg ;
ITEMS "&Todo", "&Pagina actual", "Paginas pa&res",;
"Paginas imp&ares", "&De pagina", "Pag&inas" ;
ON CHANGE ( if( nOption == 5, ;
( oPageIni:Enable(), oPageFin:Enable() ), ;
( oPageIni:Disable(), oPageFin:Disable() ) ), ;
if( nOption == 6, oRange:Enable(), oRange:Disable() ) ) ;
WHEN ::oDbf:Reccount() > 1
@ 60, 125 SAY "Numero de Copias :" PIXEL OF oDlg SIZE 50, 18
@ 59, 175 GET nCopies SIZE 20, 11 PIXEL OF oDlg UPDATE ;
SPINNER MIN 1 MAX 999 ;
VALID nCopies > 0 .and. nCopies <= 999 ;
PICTURE "999"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
@ 150, 115 BUTTON "&Ok" SIZE 50, 11 PIXEL OF oDlg ;
ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
@ 150, 170 BUTTON "&Cancelar" SIZE 50, 11 PIXEL OF oDlg ;
ACTION oDlg:End()
endif
ACTIVATE DIALOG oDlg CENTERED
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 := alltrim(PrnGetPort()) //AYA
//Default cPorta := Alltrim( PrnGetPort() ), lErase:= .t.
cPrinter := PrinterPortToName( oPrn:cPort ) //AYA
IF EMPTY( cPrinter )
cPrinter := PrinterPortToName( "USB002" )
IF EMPTY(cPrinter)
cPrinter := PrinterPortToName( "USB001" )
ENDIF
ENDIF
/*
IF .NOT. FILE( cFileTxt )
MsgInfo( OemToAnsi( "No existe el archivo modo texto para imprimir en matricial" ), ;
OemToAnsi( "No existe el archivo modo texto para imprimir en matricial" ) )
RETURN( .F. )
ENDIF
IF .NOT. EMPTY( cPrinter ) // TEM USB
// PrintFileRaw( cPrinter, TrueName( "CUPOM.TXT" ), "Impressão de Vendas" )
PrintFileRaw( cPrinter, TrueName( cFileTxt ), "Impressão de Vendas" )
ELSEIF LEN( cPorta ) <= 5 .and. Left( Upper(cPorta), 4 ) = "LPT1"
//--- Spool Local - Matricial em LPT1
cPorta:= "PRN"
WAITRUN("COMMAND.COM /C COPY /B " + cFileTxt + " " + cPorta, 0 )
ELSE
//--- Spool Remoto - Matricial em LPT1
WAITRUN("COMMAND.COM /C COPY /B " + cFileTxt + " " + cPorta, 0 )
ENDIF
IF lErase // Vem .T. da tela de vendas
FERASE( cFileTxt )
ENDIF */
for nCopy = 1 to nCopies
do case
//--- Todas
case nOption == 1
//PrintFileRaw( cPrinter, TrueName( ::cTxtFile ), "Impressão de Vendas" ) //AYA
::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
PrintFileRaw( cPrinter, TrueName( ::cTxtFile ), "Reporte de Impresion" ) //AYA //IMPRIME REMOTO
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 TXT_UNZOOM_THE_PREVIEW RESOURCE "Zoom -"
ENDMENU
ENDMENU
return nil
//----------------------------------------------------------------------------//
METHOD BuildDbfTmp() CLASS TTxtPreview
local oFile, nPag, cTxt, lFim, oDlg
local cLine, nStart, nEnd, cAlias
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 TITLE "Generando Previsualizacion..." ;
FROM 230, 217 TO 360, 575 PIXEL
@ 010, 008 GROUP OGRP TO 40, 172 OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
//@ 10, 08 TO 40, 172 OF oDlg PIXEL // hasta fwh 11.09 funcionaba
@ 1.4, 2 ICON NAME "PRINT" OF oDlg
@ 25, 55 SAY "Generando Previsualizacion..." PIXEL OF oDlg SIZE 80, 12 CENTER
@ 47, 60 BUTTON "Espere..." SIZE 60, 12 PIXEL OF oDlg ACTION .t.
ACTIVATE DIALOG oDlg CENTER NOWAIT
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
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
-
karinha - Posts: 7456
- Joined: Tue Dec 20, 2005 7:36 pm
- Location: São Paulo - Brasil
Re: cerrar ventana preview con teclado
by artu01 » Fri Jan 20, 2017 9:04 pm
Joao no funciona, no cierra la ventana con la Tecla Esc
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
- artu01
- Posts: 397
- Joined: Fri May 11, 2007 8:20 pm
- Location: Lima
Re: cerrar ventana preview con teclado
by karinha » Mon Jan 23, 2017 12:40 pm
Y con ALT+F4 ?
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
-
karinha - Posts: 7456
- Joined: Tue Dec 20, 2005 7:36 pm
- Location: São Paulo - Brasil
Re: cerrar ventana preview con teclado
by artu01 » Mon Jan 23, 2017 8:48 pm
Si Joao si se que se puede con ALT+F4, pero el usuario lo quiere con una sola tecla en este caso ESC
conoces el dicho que dice : "Donde manda Capitán no manda marinero"
conoces el dicho que dice : "Donde manda Capitán no manda marinero"
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
- artu01
- Posts: 397
- Joined: Fri May 11, 2007 8:20 pm
- Location: Lima
Re: cerrar ventana preview con teclado
by karinha » Tue Jan 24, 2017 2:57 pm
Intenta ahora:
- Code: Select all Expand view
*---------------------------------------------------------------------------
* TxtPreview - Ednaldo Rolim (edrol@uol.com.br)
* Modificado por Ralph del Castillo para la clase tRichEdit
* ==========================================================================
* 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(), 17 ) //16
#define TXT_FILE LoadString( GetResources(), 18 ) //17
#define TXT_PAGE LoadString( GetResources(), 19 ) //
#define TXT_PREVIEW LoadString( GetResources(), 03 )
#define TXT_PAGENUM LoadString( GetResources(), 20 ) //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
static snCurPrev := 0
static 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 )
LOCAL oPrev
local hOldRes := GetResources()
local hDLL := LoadLibrary( "Riched20.dll" )
if WndMain() = NIL
lPrvModal := .t.
oDlg:Hide()
DEFINE WINDOW oMdiTmp FROM 0, 0 TO 20, 79 MDI TITLE "TxtPreview"
SET MESSAGE OF oMdiTmp TO "Preview" CENTERED NOINSET
ACTIVATE WINDOW oMdiTmp ICONIZED ;
ON INIT TxtPrevDlg( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint ) //RDC
oDlg:Show()
oDlg:SetFocus()
else
oPrev := TTxtPreview():New( cFileTxt,, lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint ) //RDC
oPrev:Activate()
// NUEVO
do case
CASE nKey == VK_ESCAPE .OR. GetKeyState( VK_ESCAPE )
//QUIT
RETURN( .F. )
endcase
endif
FreeLibrary( hDLL )
SetResources( hOldRes )
return nil
//----------------------------------------------------------------------------//
static function TxtPrevDlg( cFileTxt, cTitle, lPrvModal, lSpool, cPort, oPrn, lKill, lGPrint )
LOCAL oPrev
oPrev := TTxtPreview():New( cFileTxt, oMdiTmp , lPrvModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint )
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 oCursor
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 AS String
DATA cNegOn, cNegOff, cItaOn, cItaOff, cEmpOn, cEmpOff AS String
DATA c10Cpi, c12Cpi, cWidOn, cWidOff AS String
METHOD New( cFileTxt, oWndMain, lModal, cTitle, lSpool, cPort, oPrn, lKill, lGPrint ) CONSTRUCTOR // RDC
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 ) CLASS TTxtPreview
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
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("27,71")
::cNegOff := ::Command("27,72")
::c10cpi := ::Command("27,80")
::c12cpi := ::Command("27,77")
::cWidOn := ::Command("27,87,1")
::cWidOff := ::Command("27,87,0")
// se redefinio porque funcion hasta la fwh 10.8
// ::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 CURSOR ::oCursor RESOURCE "Lupa"
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 ) ;
ICON oIcon ;
MDICHILD OF oWndMain ;
PIXEL
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() ;
ICON oIcon
endif
::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 26, if( LargeFonts(), 30, 26 ) 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 "Previous" 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
@ ::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"
DEFINE BUTTON RESOURCE "Printer2" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION PrinterSetup() ;
TOOLTIP "Seleccionar Impresora" NOBORDER
DEFINE BUTTON RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" ) NOBORDER
// DEFINE BUTTON RESOURCE "acrobat" OF ::oBar GROUP ;
// MESSAGE "Generar Archico PDF" ;
// ACTION SavePDF( oDevice ) ;
// TOOLTIP "Generar Archivo PDF" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" ) NOBORDER
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 "Previous" 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 RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" )
// DEFINE BUTTON RESOURCE "acrobat" OF ::oBar GROUP ;
// MESSAGE "Generar Archico PDF" ;
// ACTION SavePDF( oDevice ) ;
// TOOLTIP "Generar Archivo PDF" NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" )
endif
@ ::oBar:nTop + 7, ::oBar:nLeft + 390 SAY ::oPage ; //::oBar:nLeft + 330 // el ultimo ::oBar:nLeft + 380
PROMPT TXT_PAGENUM +" "+ LTrim( Str( ::nPage, 3 ) ) + ;
" / " + LTrim( Str( ::oDbf:RecCount() ) ) ;
SIZE 160, 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:oCursor := ::oCursor
::oFGet:blDblClick := {|| ::Zoom_in() }
::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
// NUEVO
do case
CASE nKey == VK_ESCAPE .OR. GetKeyState( VK_ESCAPE )
//QUIT
RETURN( .F. )
endcase
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 "Previous" ACTION ::PrevPage()
else
MENUITEM TXT_FIRST RESOURCE "Top" ACTION ::TopPage() DISABLED
MENUITEM TXT_PREVIOUS RESOURCE "Previous" 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 TXT_ZOOM RESOURCE "Zoom" ACTION ::Zoom_in()
MENUITEM TXT_PRINT RESOURCE "Printer" ACTION ::Print()
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
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
if ::oSize:nAt < len(::oSize:aItems )
::oSize:select(::oSize:nAt+1)
::oSize:change()
::zoom()
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Zoom")
::oZoom:Refresh()
else
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Unzoom")
::oZoom:Refresh()
Tone(500,1)
return nil
endif
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
return nil
//----------------------------------------------------------------------------//
METHOD Zoom_out() CLASS TTxtPreview
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
if ::oSize:nAt > 1
::oSize:select(::oSize:nAt-1)
::oSize:change()
::zoom()
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Zoom")
::oZoom:Refresh()
else
::oZoom:FreeBitmaps()
::oZoom:LoadBitmaps("Unzoom")
::oZoom:Refresh()
Tone(500,1)
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()
// NUEVO
CASE nKey == VK_ESCAPE .OR. GetKeyState( VK_ESCAPE )
//QUIT
RETURN( .F. )
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
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
// se for fw abaixo da 2.1
if .f. //At( "1.9", FWVERSION ) >0 .or. At( "2", FWVERSION ) >0
#ifdef _PREV_DLL
SET RESOURCES TO ::cResFile
#endif
DEFINE DIALOG oDlg RESOURCE "PRINT" FONT ::oWnd:oFont
REDEFINE SAY PROMPT PrnGetName() ID 101 OF oDlg
REDEFINE SAY PROMPT PrnGetDrive() ID 102 OF oDlg
REDEFINE SAY PROMPT ::cPort ID 103 OF oDlg
REDEFINE RADIO oRad VAR nOption ID 110, 111, 112, 113, 114, 115 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 GET oPageIni VAR nFirst ID 120 ;
PICTURE "@K 99999" ;
VALID if( nFirst < 1 .or. nFirst > nLast, ( MessageBeep() , .F. ), .T. ) ;
OF oDlg
REDEFINE GET oPageFin VAR nLast ID 121 ;
PICTURE "@K 99999" ;
VALID if( nLast < nFirst .or. nLast > ::oDbf:Reccount(), ;
( MessageBeep(), .F. ), .T. ) ;
OF oDlg
REDEFINE GET oRange VAR cRange ID 122 ;
OF oDlg PICTURE "@S!"
REDEFINE GET nCopies ID 130 ;
OF oDlg ;
UPDATE SPINNER MIN 1 MAX 999 ;
VALID nCopies > 0 .and. nCopies <= 999 ;
PICTURE "999"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
REDEFINE BUTTON ID 201 OF oDlg ;
ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
REDEFINE BUTTON ID 202 OF oDlg ;
ACTION oDlg:End()
#ifdef _PREV_DLL
SetResources( ::hOldRes )
#endif
else // se for fw 2.1 em diante ou Harbour
DEFINE DIALOG oDlg TITLE "Impresion" ;
FROM 129, 178 TO 459, 635 PIXEL FONT ::oWnd:oFont
@ 006, 008 GROUP OGRP TO 45, 220 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
@ 050, 008 GROUP OGRP TO 145, 115 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
@ 050, 120 GROUP OGRP TO 145, 220 LABEL "Impresora:" OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
// @ 06, 08 TO 45, 220 OF oDlg PIXEL PROMPT "Impresora:" // hasta fwh 11.09 funcionaba
// @ 50, 08 TO 145, 115 OF oDlg PIXEL PROMPT "Páginas a Imprimir:"
// @ 50, 120 TO 145, 220 OF oDlg PIXEL PROMPT "Copias:"
@ 15, 15 SAY "Nombre :" PIXEL OF oDlg SIZE 30, 8
@ 24, 15 SAY "Tipo :" PIXEL OF oDlg SIZE 30, 8
@ 33, 15 SAY "Puerto :" PIXEL OF oDlg SIZE 30, 8
@ 15, 50 SAY PrnGetName() PIXEL OF oDlg SIZE 150, 8
@ 24, 50 SAY PrnGetDrive() PIXEL OF oDlg SIZE 150, 8
* @ 33, 50 SAY PrnGetPort() PIXEL OF oDlg SIZE 150, 8
@ 33, 50 SAY ::cPort PIXEL OF oDlg SIZE 150, 8
@ 113, 65 GET oPageIni VAR nFirst SIZE 18, 11 PIXEL OF oDlg ;
PICTURE "@K 99999" ;
VALID if( nFirst < 1 .or. nFirst > nLast, ( MessageBeep() , .F. ), .T. )
@ 115, 85 SAY "a" PIXEL OF oDlg SIZE 5, 8
@ 113, 92 GET oPageFin VAR nLast SIZE 18, 11 PIXEL OF oDlg ;
PICTURE "@K 99999" ;
VALID if( nLast < nFirst .or. nLast > ::oDbf:Reccount(), ;
( MessageBeep(), .F. ), .T. )
@ 126, 55 GET oRange VAR cRange SIZE 55, 11 PIXEL OF oDlg PICTURE "@S!"
@ 60, 10 RADIO oRad VAR nOption PIXEL OF oDlg ;
ITEMS "&Todo", "&Pagina actual", "Paginas pa&res",;
"Paginas imp&ares", "&De pagina", "Pag&inas" ;
ON CHANGE ( if( nOption == 5, ;
( oPageIni:Enable(), oPageFin:Enable() ), ;
( oPageIni:Disable(), oPageFin:Disable() ) ), ;
if( nOption == 6, oRange:Enable(), oRange:Disable() ) ) ;
WHEN ::oDbf:Reccount() > 1
@ 60, 125 SAY "Numero de Copias :" PIXEL OF oDlg SIZE 50, 18
@ 59, 175 GET nCopies SIZE 20, 11 PIXEL OF oDlg UPDATE ;
SPINNER MIN 1 MAX 999 ;
VALID nCopies > 0 .and. nCopies <= 999 ;
PICTURE "999"
oPageIni:Disable()
oPageFin:Disable()
oRange:Disable()
@ 150, 115 BUTTON "&Ok" SIZE 50, 11 PIXEL OF oDlg ;
ACTION ::PrintPrv( oDlg, nOption, nFirst, nLast, cRange, nCopies )
@ 150, 170 BUTTON "&Cancelar" SIZE 50, 11 PIXEL OF oDlg ;
ACTION oDlg:End()
endif
ACTIVATE DIALOG oDlg CENTERED
// NUEVO
do case
CASE nKey == VK_ESCAPE .OR. GetKeyState( VK_ESCAPE )
//QUIT
RETURN( .F. )
endcase
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 := alltrim(PrnGetPort()) //AYA
//Default cPorta := Alltrim( PrnGetPort() ), lErase:= .t.
cPrinter := PrinterPortToName( oPrn:cPort ) //AYA
IF EMPTY( cPrinter )
cPrinter := PrinterPortToName( "USB002" )
IF EMPTY(cPrinter)
cPrinter := PrinterPortToName( "USB001" )
ENDIF
ENDIF
/*
IF .NOT. FILE( cFileTxt )
MsgInfo( OemToAnsi( "No existe el archivo modo texto para imprimir en matricial" ), ;
OemToAnsi( "No existe el archivo modo texto para imprimir en matricial" ) )
RETURN( .F. )
ENDIF
IF .NOT. EMPTY( cPrinter ) // TEM USB
// PrintFileRaw( cPrinter, TrueName( "CUPOM.TXT" ), "Impressão de Vendas" )
PrintFileRaw( cPrinter, TrueName( cFileTxt ), "Impressão de Vendas" )
ELSEIF LEN( cPorta ) <= 5 .and. Left( Upper(cPorta), 4 ) = "LPT1"
//--- Spool Local - Matricial em LPT1
cPorta:= "PRN"
WAITRUN("COMMAND.COM /C COPY /B " + cFileTxt + " " + cPorta, 0 )
ELSE
//--- Spool Remoto - Matricial em LPT1
WAITRUN("COMMAND.COM /C COPY /B " + cFileTxt + " " + cPorta, 0 )
ENDIF
IF lErase // Vem .T. da tela de vendas
FERASE( cFileTxt )
ENDIF */
for nCopy = 1 to nCopies
do case
//--- Todas
case nOption == 1
//PrintFileRaw( cPrinter, TrueName( ::cTxtFile ), "Impressão de Vendas" ) //AYA
::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
PrintFileRaw( cPrinter, TrueName( ::cTxtFile ), "Reporte de Impresion" ) //AYA //IMPRIME REMOTO
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 TXT_UNZOOM_THE_PREVIEW RESOURCE "Zoom -"
ENDMENU
ENDMENU
return nil
//----------------------------------------------------------------------------//
METHOD BuildDbfTmp() CLASS TTxtPreview
local oFile, nPag, cTxt, lFim, oDlg
local cLine, nStart, nEnd, cAlias
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 TITLE "Generando Previsualizacion..." ;
FROM 230, 217 TO 360, 575 PIXEL
@ 010, 008 GROUP OGRP TO 40, 172 OF oDLG pixel TRANSPARENT COLOR 0,RGB(227,232,234)
//@ 10, 08 TO 40, 172 OF oDlg PIXEL // hasta fwh 11.09 funcionaba
@ 1.4, 2 ICON NAME "PRINT" OF oDlg
@ 25, 55 SAY "Generando Previsualizacion..." PIXEL OF oDlg SIZE 80, 12 CENTER
@ 47, 60 BUTTON "Espere..." SIZE 60, 12 PIXEL OF oDlg ACTION .t.
ACTIVATE DIALOG oDlg CENTER NOWAIT
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
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
-
karinha - Posts: 7456
- Joined: Tue Dec 20, 2005 7:36 pm
- Location: São Paulo - Brasil
Re: cerrar ventana preview con teclado
by artu01 » Tue Jan 24, 2017 9:00 pm
Joao sigue sin funcionar 1>(
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
- artu01
- Posts: 397
- Joined: Fri May 11, 2007 8:20 pm
- Location: Lima
11 posts • Page 1 of 1
Return to FiveWin para Harbour/xHarbour
Who is online
Users browsing this forum: No registered users and 21 guests