anser
has you tried to print on printer with USB PORT? because im not able to make it
i only able to preview and press the button of printer, but it make nothing only it generate files (ex. 2053323) without extension and
empty files USB002
Also it doesnt work on PRINTERS over networking environment
It Only works with printers LPT1
i dont understand what im doing wrong?
please help me
TdosPrn con Preview e impresoras laser
Re: TdosPrn con Preview e impresoras laser
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
Re: TdosPrn con Preview e impresoras laser
i forgot to tell you that the problem is only with MATRICIAL PRINTERS connected to the USB port.
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
Re: TdosPrn con Preview e impresoras laser
Sorry, as of now I don't have a Dot matrix printer connected to a USB port. I shall try to get one and test. Shall let you know the result.artu01 wrote:i forgot to tell you that the problem is only with MATRICIAL PRINTERS connected to the USB port.
Regards
Anser
Re: TdosPrn con Preview e impresoras laser
Ok anser
i hope your good news as soon as posible
Thanks
i hope your good news as soon as posible
Thanks
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
Re: TdosPrn con Preview e impresoras laser
Dear Artu01,
I confirm that there is a problem if the printer is DotMatrix and connected to a USB port. I have made few modifications and it is working fine here. Please provide your email id here and I shall send it to you for testing.
Regards
Anser
I confirm that there is a problem if the printer is DotMatrix and connected to a USB port. I have made few modifications and it is working fine here. Please provide your email id here and I shall send it to you for testing.
Regards
Anser
Re: TdosPrn con Preview e impresoras laser
Anser, can send to me too? norbertolf@msn.com. thanks
Re: TdosPrn con Preview e impresoras laser
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql
-
Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TdosPrn con Preview e impresoras laser
Anser,
Please post the modifications here so others can use it too, thanks!
Please post the modifications here so others can use it too, thanks!
Re: TdosPrn con Preview e impresoras laser
The zip file contains the modified
TxtView.Prg
TDosPrn.Prg
Test.Prg
Cutomer.Dbf
Test.exe
along with the required make file (Harbour) Test.mak
https://rapidshare.com/files/3763036424 ... ed_Ver.zip
Regards
Anser
TxtView.Prg
TDosPrn.Prg
Test.Prg
Cutomer.Dbf
Test.exe
along with the required make file (Harbour) Test.mak
https://rapidshare.com/files/3763036424 ... ed_Ver.zip
Regards
Anser
-
Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TdosPrn con Preview e impresoras laser
txtview.prg
Code: Select all
*---------------------------------------------------------------------------
* 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"
static oMdiTmp, nOldArea
static snCurPrev := 0
static saMPrevOpts := { .t., 10, 1, .f., .f. }
#ifndef COLOR_BTNFACE
#include "WColors.ch"
#endif
#include "RichEdit.ch"
#ifdef __XPP__
#define New _New
#endif
#define TXT_FIRST LoadString( GetResources(), 07 )
#define TXT_PREVIOUS LoadString( GetResources(), 08 )
#define TXT_NEXT LoadString( GetResources(), 09 )
#define TXT_LAST LoadString( GetResources(), 10 )
#define TXT_ZOOM LoadString( GetResources(), 11 )
#define TXT_UNZOOM LoadString( GetResources(), 12 )
#define TXT_TWOPAGES LoadString( GetResources(), 13 )
#define TXT_ONEPAGE LoadString( GetResources(), 14 )
#define TXT_PRINT LoadString( GetResources(), 15 )
#define TXT_EXIT LoadString( GetResources(), 16 )
#define TXT_FILE LoadString( GetResources(), 17 )
#define TXT_PAGE LoadString( GetResources(), 18 )
#define TXT_PREVIEW LoadString( GetResources(), 03 )
#define TXT_PAGENUM LoadString( GetResources(), 19 )
#define TXT_A_WINDOW_PREVIEW_IS_ALLREADY_RUNNING ;
LoadString( GetResources(), 20 )
#define TXT_GOTO_FIRST_PAGE ;
LoadString( GetResources(), 21 )
#define TXT_GOTO_PREVIOUS_PAGE ;
LoadString( GetResources(), 22 )
#define TXT_GOTO_NEXT_PAGE ;
LoadString( GetResources(), 23 )
#define TXT_GOTO_LAST_PAGE ;
LoadString( GetResources(), 24 )
#define TXT_ZOOM_THE_PREVIEW ;
LoadString( GetResources(), 25 )
#define TXT_UNZOOM_THE_PREVIEW ;
LoadString( GetResources(), 26 )
#define TXT_PREVIEW_ON_TWO_PAGES ;
LoadString( GetResources(), 27 )
#define TXT_PREVIEW_ON_ONE_PAGE ;
LoadString( GetResources(), 28 )
#define TXT_PRINT_CURRENT_PAGE ;
LoadString( GetResources(), 29 )
#define TXT_EXIT_PREVIEW ;
LoadString( GetResources(), 30 )
#define TXT_ZOOM_FACTOR ;
"Set the zoom factor"
#define TXT_ERROR_FWERROR ;
"Printing Error "
#define TXT_ERROR_NOTFOUND ;
"Not Found. Unable to continue."
#define TXT_ERROR_TOOMANY_WINDOWS ;
"Unable to open more windows preview."
#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
DATA cNegOn, cNegOff, cItaOn, cItaOff, cEmpOn, cEmpOff
DATA c10Cpi, c12Cpi, cWidOn, cWidOff
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:= "Preview",;
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( 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 := "Zoom Level"
/*
DEFINE BUTTON RESOURCE "Printer2" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION PrinterSetup() ;
TOOLTIP "Select Printer" NOBORDER
*/
DEFINE BUTTON RESOURCE "Printer" OF ::oBar GROUP ;
MESSAGE TXT_PRINT_CURRENT_PAGE ;
ACTION ::Print() ;
TOOLTIP StrTran( TXT_PRINT, "&", "" ) NOBORDER
DEFINE BUTTON RESOURCE "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" ) NOBORDER
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 "Exit" OF ::oBar GROUP ;
MESSAGE TXT_EXIT_PREVIEW ;
ACTION ::oWnd:End() ;
TOOLTIP StrTran( TXT_EXIT, "&", "" )
endif
@ ::oBar:nTop + 7, ::oBar:nLeft + 330 SAY ::oPage ;
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() // is best viewed well
::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 for graphic
aFonts[ 1 ] := TFont():New( "Lucida console", 0, -9*nfactor, ,;
, , , , , , , , , , , )
::oFGet:SetFont(aFonts[ 1 ])
else
// font for text
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 Empty( ::cPort )
::cPort := Alltrim( PrnGetPort() )
endif
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 "Printer" ;
FROM 129, 178 TO 459, 635 PIXEL FONT ::oWnd:oFont
/*
@ 06, 08 TO 45, 220 OF oDlg PIXEL PROMPT "Printer :"
@ 50, 08 TO 145, 115 OF oDlg PIXEL PROMPT "Pages to Print:"
@ 50, 120 TO 145, 220 OF oDlg PIXEL PROMPT "Copies:"
*/
@ 15, 15 SAY "Name :" PIXEL OF oDlg SIZE 30, 8
@ 24, 15 SAY "Type :" PIXEL OF oDlg SIZE 30, 8
@ 33, 15 SAY "Port :" 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 ::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, 84 SAY "to" 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 "&All", "&Current Page", "Even Pages",;
"&Odd pages", "&From Page", "Pages" ;
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 "Number of Copies :" 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 "&Cancel" 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
// Modified by Anser, The parameter .F. is passed so that no user config Dialog
oPrn:= TDosPrn():New(.F.)
oPrn:cPort := PrnGetPort()
// This function is added by Anser
// This function will return the string \\PcName\PrintShareName if the user selected
// a Dot Matrix Network printer
if ISNetWorkPrn( PrnGetName() ) .and. left(oPrn:cPort,3) == "LPT"
oPrn:cPort:=PrnPortUrl( PrnGetName() )
Endif
for nCopy = 1 to nCopies
do case
//--- All Pages
case nOption == 1
::oDbf:GoTop()
do while !( ::oDbf:Eof() )
::PrintPage( oPrn, ::oDbf:Text )
::oDbf:Skip(1)
enddo
//--- Current Page
case nOption == 2
::PrintPage( oPrn, ::oDbf:Text )
//--- Even Pages
case nOption == 3
::oDbf:GoTo(2) // Vaí para a pag 2 (reg 2)
do while !( ::oDbf:Eof() )
::PrintPage( oPrn, ::oDbf:Text )
::oDbf:Skip(2) // Skip 2 records
enddo
//--- ODD Pages
case nOption == 4
::oDbf:GoTop() // Vaí para a pag 1 (reg 1)
do while !( ::oDbf:Eof() )
::PrintPage( oPrn, ::oDbf:Text )
::oDbf:Skip(2) // Skip 2 records
enddo
//--- Seleccion
case nOption == 5
::oDbf:GoTop()
::oDbf:Goto( nPageIni )
do while !( ::oDbf:Eof() )
if ::oDbf:Pagina >= nPageIni .and. ::oDbf:Pagina <= nPageEnd
::PrintPage( oPrn, ::oDbf:Text )
endif
if ::oDbf:Pagina > nPageEnd
exit
endif
::oDbf:Skip(1)
enddo
//--- Range
case nOption == 6
aPages := Str2Arr2( cRange, ",", "-" )
for nFor := 1 to Len( aPages )
if ValType( aPages[ nFor ] ) == "A"
aRange := { Val( aPages[ nFor ][1] ), Val( aPages[ nFor ][2] ) }
if aRange[ 1 ] > 0 .and. aRange[ 2 ] > 0 .and. aRange[ 2 ] >= aRange[ 1 ]
for i := aRange[ 1 ] to aRange[ 2 ]
::oDbf:Goto( i )
::PrintPage( oPrn, ::oDbf:Text )
next
endif
else
::oDbf:Goto( Val( aPages[ nFor ] ) )
::PrintPage( oPrn, ::oDbf:Text )
endif
next
endcase
next nCopy
oPrn:End(,.f.)
CursorArrow()
if oDlg != nil
oDlg:End()
endif
else
PRINT oPrn NAME "Test"
for nCopy = 1 to nCopies
do case
//--- Todas
case nOption == 1
::oDbf:GoTop()
do while !( ::oDbf:Eof() )
::GPrint(oPrn,::oDbf:Text)
::oDbf:Skip(1)
enddo
//--- Actual
case nOption == 2
::GPrint(oPrn,::oDbf:Text)
//--- Pares
case nOption == 3
::oDbf:GoTo(2) // Vaí para a pag 2 (reg 2)
do while !( ::oDbf:Eof() )
::GPrint(oPrn,::oDbf:Text)
::oDbf:Skip(2) // Pula 2 registros
enddo
//--- Impares
case nOption == 4
::oDbf:GoTop() // Vaí para a pag 1 (reg 1)
do while !( ::oDbf:Eof() )
::GPrint(oPrn,::oDbf:Text)
::oDbf:Skip(2) // Pula 2 registros
enddo
//--- Seleccion
case nOption == 5
::oDbf:GoTop()
::oDbf:Goto( nPageIni )
do while !( ::oDbf:Eof() )
if ::oDbf:Pagina >= nPageIni .and. ::oDbf:Pagina <= nPageEnd
::GPrint(oPrn,::oDbf:Text)
endif
if ::oDbf:Pagina > nPageEnd
exit
endif
::oDbf:Skip(1)
enddo
//--- Range
case nOption == 6
aPages := Str2Arr2( cRange, ",", "-" )
for nFor := 1 to Len( aPages )
if ValType( aPages[ nFor ] ) == "A"
aRange := { Val( aPages[ nFor ][1] ), Val( aPages[ nFor ][2] ) }
if aRange[ 1 ] > 0 .and. aRange[ 2 ] > 0 .and. aRange[ 2 ] >= aRange[ 1 ]
for i := aRange[ 1 ] to aRange[ 2 ]
::oDbf:Goto( i )
::GPrint(oPrn,::oDbf:Text)
next
endif
else
::oDbf:Goto( Val( aPages[ nFor ] ) )
::GPrint(oPrn,::oDbf:Text)
endif
next
endcase
next nCopy
::oDbf:goto(nCPage) //RDC
::nPage := ::oDbf:Recno()
::cTextFmt:= ::TxtToRTF( ::oDbf:Text )
::oPage:SetText( TXT_PAGENUM + LTrim( Str( ::nPage, 4, 0 ) ) + ;
" / " + LTrim( Str( ::oDbf:RecCount() ) ) )
::oFGet:Refresh()
CursorArrow()
oPrn:End()
if oDlg != nil
oDlg:End()
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD PrintPage( oPrn, cTxt ) CLASS TTxtPreview
LOCAL nLines, nLin, cLine, cTmp, cTxt2, cTxtTmp, cPort
cPort:= oPrn:cPort // Changed by Anser Original was cPorta:= ::cPort
if Empt( cPort )
cPort:= Alltrim( PrnGetPort() )
else
cPort:= Alltrim( cPort )
endif
/*
if ! ( left(upper(cPort),3) = 'LPT' )
// disable the spool if they are not direct ports
// because it does not work on 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 left(cPort,3) == "USB" .and. !::lModoGraf // USB and DotBatrix Printer
PrintFileRaw(prngetname(),cTxtTmp, "Raw File Printing by TDosPrn")
Else
if file('dosprint.bat')
WAITRUN("DOSPRINT.BAT " + cTxtTmp + " " + cPort, 0 )
* Winexec( "start command.com /min notepad /P "+cTxtTmp)
else
* cPort:= "PRN"
* winexec( "start c:\command.com /c copy /b "+ cTxtTmp + " " + cPort)
// Comment by Anser, WinExec is not working. Don't know the reason
// Dosprint.Bat is required to print. Check this later
winexec( "start command.com /c copy /b "+ cTxtTmp + " " + cPort)
* winexec( "start c:\Windows\system32\cmd.exe /c copy /b "+ cTxtTmp + " " + cPort)
endif
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( "File " + ::cTxtFile + ", cannot be opened." )
return nil
endif
DEFINE DIALOG oDlg TITLE "Generating Preview..." ;
FROM 230, 217 TO 360, 575 PIXEL
* @ 10, 08 TO 40, 172 OF oDlg PIXEL
@ 1.4, 2 ICON NAME "PRINT" OF oDlg
@ 25, 55 SAY "Generating Preview..." PIXEL OF oDlg SIZE 80, 12 CENTER
@ 47, 60 BUTTON "Wait..." 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
// remove some Printer Control characters
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)
//--- If you find this page jump
IF ::cFormFeed $ cLine .or. oFile:lEof()
nPag ++ // increases Page no
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
// This routine failure to convert improved fonts RTF format
// in RTF format
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
// we create an array to store fonts suitable for laser printer
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
// define scales equivalent to the traditional mode DOS fonts
// 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
// choose the appropriate font for the length of the text
// The maximum size of all the lines determines the font to use
// and the font is used to calculate the line feeds
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 ]
// We see if it is necessary to adjust the font size by a factor for
// that the text in between the blade horizontally
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("Adjusting text to the width of page "+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 // increased by 15% for better readability
//--------------
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
// remove some characters Printer Control
// because we are going to be printed in flat format
// Assuming no change in font on the same line
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
*MsgList(aLines)
return aLines
-
Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TdosPrn con Preview e impresoras laser
tdosprn.prg
Code: Select all
/*
┌─ Programa ───────────────────────────────────────────────────────────────┐
│ Aplication: Class TDosPrint │
│ File: TDOSPRN.PRG │
│ Date: 09/13/96 │
│ Time: 20:20:07 │
└──────────────────────────────────────────────────────────────────────────┘
NOTES:
The following code will let you print directly to the printer from inside
any Fivewin program, like OLD DOS days. Those users that need DOS printing
speed can use this class instead of the TPrinter class.
This is a little sample of how to use the new class:
LOCAL oPrn
oPrn := TDosPrn():New("lpt1")
oPrn:StartPage() // optional
oPrn:Say(10,20, "This goes in line 10, column 20")
oPrn:EndPage() // optional
oPrn:End()
A little description of all the members of this class:
DATA:
cPort: Printing port, by default "LPT1"
cCompress: String for compressed mode, by default "15"
cNormal: String for normal mode, by default "18"
cFormFeed: String for EJECT, by default "12"
hDC: Printing file Handle (Internal use)
nRow: Current printing row
nCol: Current pringing column
nLeftMargin: Left margin, by default 0
nTopMargin: Top margin, by default 0
lAnsiToOem: If .T. a Ansi to Oem translation is done automatically
whe printing, by default is .T.
lScreen
METHODS:
New(cPort) Constructor, no comment
End() Destructor, no comment
StartPage() Begining of a page, this method is optional
EndPage() End of page, this method is optional if there is only on page
Command(c) Let you send any command to the printer without changing the
current row and col. The string to pass as a parameter should
content the ascii values of the command separated with commas,
for example, the command to reset Epson printers should
be: "27,69"
SetCoors(r,c) Let you change the current row and col is the equivalent of
SetPrc() of Ca-Clipper
NewLine() Increments the current row
Write(cText) Prints the string cText in the current row and column
Say(nRow ,; Prints the string cText in nRow, nCol
nCol ,; lAtoO indicates if the string should be transformed to Oem,
cText ,; by default is ::lAnsiToOem
lAtoO )
SayCmp() The same as the method Say but prints in compressed mode and
the row is updated accordly.
NOTE:
If you try to print on a row before the current one a EJECT will be
done automatically.
In the same way if you try to print on the same row as the current, but
in a previous column from the current one a EJECT will be done automatically
At the end of this class is a little function call WorkSheet that will make
the job of DOS printing a lot easier.
Enjoy it!
*/
#include "fivewin.ch"
#include "fileio.ch"
#translate nTrim(<n>) => AllTrim(Str(<n>,10,0))
#define PF_BUFLEN 2048
//----------------------------------------------------------------------------//
CLASS TDosPrn
DATA LastError
DATA cPort, cCompress, cNormal, cFormFeed, cBuffer, cOrgPort
DATA cInitPrn //RDC
DATA cNegOn //RDC
DATA cNegOff //RDC
DATA cItaOn //RDC
DATA cItaOff //RDC
DATA cEmpOn //RDC
DATA cEmpOff //RDC
DATA c10Cpi //RDC
DATA c12Cpi //RDC
DATA cWidOn //RDC
DATA cWidOff //RDC
DATA hDC, nRow, nCol, nLeftMargin, nTopMargin AS NUMERIC
DATA lAnsiToOem AS LOGICAL
DATA oWnd, oPagina // Ednaldo
DATA nPage AS NUMERIC // Ednaldo
DATA cDevice // Ralph
DATA nMaxLine, nLength, nLastError AS NUMERIC // Ralph
DATA lCancel, lPreview, lModograf, lIsLaser AS LOGICAL // Ralph
DATA lUserConfig AS LOGICAL INIT .F. // Anser
METHOD New(lUserConfig) CONSTRUCTOR // Mdified by Anser to pass the parameter lUserConfig
METHOD End()
METHOD StartPage() INLINE ::ShowProc() // Ednaldo
METHOD EndPage()
METHOD Command(xPar1, xPar2, xPar3, xPar4, xPar5)
METHOD SetCoors(nRow, nCol)
METHOD NewLine() INLINE (::cBuffer += CRLF ,;
::nRow++ ,;
::nCol := 0 )
METHOD Write(cText, lAToO) ;
INLINE (iif(lAtoO == NIL, lAtoO := .T.,),;
::cBuffer += iif(lAtoO, AnsitoOem(cText), cText) ,;
::nCol += len(cText) )
METHOD Say(nRow, nCol, cText, lAToO)
METHOD SayCmp(nRow, nCol, cText)
METHOD PrintFile(cFile)
METHOD ShowProc() // Ednaldo
METHOD PrintSetup() // Ralph
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New(lUserConfig) CLASS TDosPrn
::cCompress := "15"
::cNormal := "18"
::cFormFeed := "12"
::cInitPrn := "18,27,80"
::cNegOn := "27,71"
::cNegOff := "27,72"
::c10cpi := "27,80"
::c12cpi := "27,77"
::cWidOn := "27,87,1"
::cWidOff := "27,87,0"
::cBuffer := ""
::nLeftMargin := 0
::nTopMargin := 0
::nRow := 0
::nCol := 0
::lAnsiToOem := .T.
::cPort := StrTran( PrnGetPort(), ":", "" )
::nLastError := fError()
::lUserConfig :=lUserConfig
if ::nLastError <> 0
MsgInfo('There is no printer available')
endif
::cDevice := ::cPort+iif(!"."$::cPort,".PRN","")
::hDC := fCreate(::cPort)
::lPreview := .t.
::lCancel := .f.
::nMaxLine := 66
::nLength := 66
::lModoGraf := .f.
::lIsLaser := .f.
::nPage := 1 // Ednaldo
::PrintSetup() //Ralph
RETURN Self
//----------------------------------------------------------------------------//
METHOD End() CLASS TDosPrn
IF !empty(::nRow+::nCol)
::EndPage()
ENDIF
::LastError := 0
IF !fClose(::hDC)
::LastError := fError()
ENDIF
CursorArrow()
if ::oWnd != Nil // Ednaldo
::oWnd:End() // Ednaldo
endif // Ednaldo
RETURN NIL
//----------------------------------------------------------------------------//
METHOD EndPage() CLASS TDosPrn
LOCAL nFor, nLen, nSec
LOCAL lError
::Command(::cFormFeed)
::LastError := 0
IF fWrite(::hDC, ::cBuffer) < len(::cBuffer)
::LastError := fError()
ENDIF
::cBuffer := ""
::nRow := 0
::nCol := 0
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Command(xPar1, xPar2, xPar3, xPar4, xPar5) CLASS TDosPrn
LOCAL cCommand, cToken, cString
LOCAL nToken
cString := cValToChar(xPar1)
IF xPar2 != NIL
cString += ","+cValToChar(xPar2)
ENDIF
IF xPar3 != NIL
cString += ","+cValToChar(xPar3)
ENDIF
IF xPar4 != NIL
cString += ","+cValToChar(xPar4)
ENDIF
IF xPar5 != NIL
cString += ","+cValToChar(xPar5)
ENDIF
cCommand := ""
nToken := 1
DO WHILE !Empty(cToken := StrToken(cString, nToken++, ","))
cCommand += Chr(Val(cToken))
ENDDO
::cBuffer += cCommand
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetCoors(nRow, nCol) CLASS TDosPrn
nRow += ::nTopMargin
nCol += ::nLeftMargin
IF ::nRow > nRow
::EndPage()
::nPage++ // Ednaldo
::StartPage()
ENDIF
IF nRow == ::nRow .AND. nCol < ::nCol
::EndPage()
::nPage++ // Ednaldo
::StartPage()
ENDIF
DO WHILE ::nRow < nRow
::NewLine()
ENDDO
IF nCol > ::nCol
::Write(Space(nCol-::nCol))
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD Say(nRow, nCol, cText, lAToO) CLASS TDosPrn
DEFAULT lAToO := ::lAnsiToOem
IF VALTYPE( cText ) = "D"
cText := DTOC( cText )
ENDIF
IF VALTYPE( cText ) = "N"
cText := STR( cText )
ENDIF
::SetCoors(nRow, nCol)
::Write(cText, lAToO)
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SayCmp(nRow, nCol, cText, lAToO) CLASS TDosPrn
DEFAULT lAToO := ::lAnsiToOem
::SetCoors(nRow, nCol)
::Command(::cCompress)
::cBuffer += iif(lAToO, AnsitoOem(cText), cText)
::nCol += Int(len(cText)/1.7+.5)
::Command(::cNormal)
RETURN NIL
//----------------------------------------------------------------------------//
METHOD PrintFile(cFile) CLASS TDosPrn
LOCAL hFile
LOCAL nRead
LOCAL cBuffer
hFile := FOpen(cFile, FO_READ)
IF hFile < 0
RETURN .F.
ENDIF
cBuffer := Space(PF_BUFLEN)
DO
nRead := fRead(hFile, @cBuffer, PF_BUFLEN)
IF fWrite(::hDC, Left(cBuffer, nRead)) < nRead
::LastError := fError()
fClose(hFile)
RETURN .F.
ENDIF
UNTIL nRead == PF_BUFLEN
fClose(hFile)
RETURN .T.
//----------------------------------------------------------------------------//
// Print Process status display // Ednaldo
//----------------------------------------------------------------------------//
METHOD ShowProc() CLASS TDosPrn
IF ::oWnd = Nil
DEFINE DIALOG ::oWnd TITLE "Printing..." ;
FROM 230, 217 TO 360, 575 PIXEL
* @ 10, 08 TO 40, 172 OF ::oWnd PIXEL
@ 1.4, 2 ICON NAME "PRINT.ICO" OF ::oWnd
@ 25, 45 SAY "Printing Page:" PIXEL OF ::oWnd SIZE 65, 12 RIGHT
@ 25, 115 SAY ::oPagina VAR ::nPage PIXEL OF ::oWnd UPDATE SIZE 20, 12 RIGHT
@ 47, 60 BUTTON "Wait..." SIZE 60, 12 PIXEL OF ::oWnd ACTION .t.
::oWnd:bPainted := {|| iif(::nPage>0, ::oPagina:Refresh(), )}
ACTIVATE DIALOG ::oWnd CENTER NOWAIT
CursorWait()
SysRefresh()
ELSE
::oWnd:BeginPaint()
::oWnd:Paint()
::oWnd:EndPaint()
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
FUNCTION WorkSheet(cPort)
LOCAL oPrn
LOCAL cLine
LOCAL nFor
cLine := ""
FOR nFor := 0 TO 7
cLine += Str(nFor,1)+Replicate(".",9)
NEXT
cLine := Substr(cLine,3)
oPrn := TDosPrn():New(cPort)
oPrn:StartPage()
FOR nFor := 0 TO 65
oPrn:Say(nFor,0,StrZero(nFor,2)+cLine)
NEXT
oPrn:EndPage()
oPrn:End()
RETURN NIL
//----------------------------------------------------------------------------//
// Parameters for Printer by the user // Ralph
METHOD PrintSetup() CLASS TDosPrn
//----------------------------------------------------------------------------//
local oDlg, oRad, oChk, oSay := array(4)
local nModo := 1
local nLinP := ::nLength, lPreview := .f.
local nTipo, oP := self
local oBtnOk, oBtnCn, oBtnSetup, oBtnAtrib, cModoImp
::lCancel := .t.
// we closed the port to be opened to the top
if (::hDC # -1) .and. ! fClose(::hDC)
::nLastError := fError()
endif
cOutPort := ::cPort
cPrnName := PrnGetName()
lPreview := ::lPreview
nModo := iif (::lModoGraf, 2, 1)
nLinP := ::nLength
// Added by Anser
// ActivePrnType() will return .T. if the selected printer is DOT MAtrix, else .F.
// Now the class itself decides whether Graphics or Text and the user is not given the choice
// By doinf this we can avoid error caused when a user selects text and print to a Laser or Inkjet
// Because if user select Text the we use the DosPrint.Bat to copy the file to the port
nModo:=if( ActivePrnType(), 1, 2)
// Added by Anser, the dialog is displayed only when the users Passes .T. while creating the TDosPrn Object
// This will avoid the second time display of the dialog when the user clicks on the Print button from the
// Print Preview Window
if ::lUserConfig
DEFINE DIALOG oDlg TITLE "Printer" ;
FROM 129, 178 TO 333, 670 PIXEL OF ::oWnd
* @ 06, 08 TO 84, 240 OF oDlg PIXEL PROMPT "Printer:"
@ 15, 15 SAY "Name :" PIXEL OF oDlg SIZE 30, 8
@ 24, 15 SAY "Type :" PIXEL OF oDlg SIZE 30, 8
@ 33, 15 SAY "Port :" PIXEL OF oDlg SIZE 30, 8
// Added by Anser just to display to user the port going to be used
@ 42, 15 SAY "Print to :" PIXEL OF oDlg SIZE 30, 8
@ 52, 15 SAY "Lines per page :" PIXEL OF oDlg SIZE 50, 8
@ 62, 15 SAY "Print Mode " PIXEL OF oDlg SIZE 40, 8
@ 14.8,205 BUTTON "Printer" SIZE 30,10 PIXEL OF oDlg ;
ACTION (PrinterSetup(),;
oSay[1]:Settext(PrnGetName()), ;
oSay[2]:Settext(PrnGetDrive()),;
cOutPort := PrnGetPort() ,;
oSay[3]:Settext(cOutPort),;
oSay[4]:Settext( TDosPrnPort(cOutPort) ),;
oSay[1]:refresh(),oSay[2]:refresh(),;
oSay[3]:refresh(),oSay[4]:refresh(), sysrefresh(),;
nModo:=if( ActivePrnType(), 1, 2), oRad:Refresh() ) // ActivePrnType is used
@ 15, 55 SAY oSay[1] PROMPT PrnGetName() PIXEL OF oDlg SIZE 150, 8
@ 24, 55 SAY oSay[2] PROMPT PrnGetDrive() PIXEL OF oDlg SIZE 150, 8
@ 33, 55 SAY oSay[3] PROMPT cOutPort PIXEL OF oDlg SIZE 150, 8
@ 42, 55 SAY oSay[4] PROMPT TDosPrnPort(cOutPort) PIXEL OF oDlg SIZE 150, 8
@ 51.4,55 GET nLinP SIZE 20, 11 PIXEL OF oDlg UPDATE ;
VALID nLinP > 0 .and. nLinP <= 140 PICTURE "999"
// Modified by Anser so that the radio is read only, I have used WHEN .F.
@ 62, 55 RADIO oRad VAR nModo ;
ITEMS "&Text (Dot matrix)", "&Graphics (InkJet/Laser)" ;
When .F. SIZE 63, 10 PIXEL OF oDlg
@ 61,150 CHECKBOX oChk VAR lPreview PROMPT "Preview" SIZE 40, 10 PIXEL OF oDlg
@ 89,125 BUTTON "&OK" SIZE 50,11 PIXEL OF oDlg ;
ACTION ( ::lCancel := .f., oDlg:End() )
@ 89, 180 BUTTON "&Cancel" SIZE 50,11 PIXEL OF oDlg ;
ACTION ( ::lCancel := .t., oDlg:End() ) CANCEL
ACTIVATE DIALOG oDlg CENTERED
Endif
if ! ::lCancel
::lModoGraf := ( nModo = 2 )
::lPreview := lPreview
::nLength := nLinP
::nMaxLine := ::nLength
if ::lIsLaser
::cCompress := "27,40,115,49,56,72"
::cNormal := "27,40,115,49,50,72"
if ::nWidth > 132
::cCompress := "27,40,115,50,50,72"
endif
else
::cCompress := "15"
::cNormal := "18"
endif
// Added by Anser
// This function will return the string \\PcName\PrintShareName if the user selected
// a Dot Matrix Network printer
if ISNetWorkPrn( PrnGetName() ) .and. left(cOutPort,3) == "LPT"
cOutPort:=PrnPortUrl( PrnGetName() )
Endif
if ::lPreview
::cPort := cOutPort
::cDevice :=".\"+ Upper( cTempFile() ) // ".\" added by Anser
else
::cPort := StrTran( cOutPort, ":", "" )
::cDevice := trim(::cPort)
endif
if ( ::hDC := fCreate(::cDevice) ) < 0
::lCancel := .t.
::nLastError := fError()
MsgInfo( "Error [" + str(::nLastError) + "] : Print Canceled "+;
"Unable to create "+ ::cDevice, "Error" )
endif
endif
Return NIL
*------------------------------------------*
Static Function TDosPrnPort(cOutPort)
*------------------------------------------*
// This fuction is added by Anser
// This function will return the string \\PcName\PrintShareName if the user selected
// a Dot Matrix Network printer
Local cPrintToPort:=""
if ISNetWorkPrn( PrnGetName() ) .and. left(cOutPort,3) == "LPT"
cPrintToPort:=PrnPortUrl( PrnGetName() )
else
cPrintToPort:=cOutPort
Endif
Return cPrintToPort
-
Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: TdosPrn con Preview e impresoras laser
test.prg
Code: Select all
#include "FiveWin.ch"
#include "report.ch"
#define HKEY_LOCAL_MACHINE 2147483650
Function Atest()
Local oDlg,oBtn2
DEFINE DIALOG oDlg
@ 2, 12 BUTTON oBtn2 PROMPT "Text" OF oDlg SIZE 40,12 ;
ACTION TestRep( .t., oDlg)
ACTIVATE DIALOG oDlg CENTERED
RETURN NIL
//--------------------------------------------------------------------------
static function TestRep( lModal, oDlg)
local oPrn, cTitulo
local nLin, nLinMax, nPag, cTmp, nItens
SET _3DLOOK ON
SetMTxtPreview( .f., 5, 2, .f., .t. )
cTitulo:= "Testing TxtPreview Class"
USE Customer
GO TOP
nLin := 1
nPag := 0
nItens := nTotal := 0
oPrn:= TDosPrn():New(.t.) // .T. bota error de variable no existe HKEY_LOCAL_MACHINE
if ! oPrn:lCancel
begin sequence
oPrn:StartPage()
do while !Eof()
//--- Cabecalho
//
if nLin = 1
nPag++
oPrn:Command( oPrn:cNormal )
oPrn:Say( nLin, 00, PadC( cTitulo, 79 ) )
oPrn:Command( oPrn:cCompress )
++nLin
oPrn:Say( ++nLin, 01, "LISTA DE FUNCIONARIOS" )
oPrn:Say( nLin, 124, "Pag.: " + StrZero( nPag,3 ) ) // Pagina
//oPrn:Say( ++nLin, 001, Repl("-", 160) )
oPrn:Say( ++nLin, 001, Repl("-", 130) )
oPrn:Say( ++nLin, 001, "NOMBRE DIRECCION CIUDAD ESTADO CEP SALARIO" )
oPrn:Say( ++nLin, 001, Repl("-", 130) )
endif
//--- Corpo do relatorio
//
nlin+=1
oPrn:Say( nLin, 001, Alltrim( first ) + " " + Alltrim( last ) )
oPrn:Say( nLin, 043, street )
oPrn:Say( nLin, 075, left( city, 20) )
oPrn:Say( nLin, 098, state )
oPrn:Say( nLin, 107, zip )
oPrn:Say( nLin, 119, Transform( salary, "@R 999,999,999.99" ) )
**oPrn:Say( nLin, 135, notes )
skip
nItens++
nTotal+= salary
if nLin+1 > oPrn:nMaxLine // se passou a linha max
oPrn:Say( ++nLin, 001, Repl("-", 160) )
nLin:= 1 // volta contador para 1
endif // nova pagina
enddo
oPrn:Say( ++nLin, 001, Repl("-", 160) )
oPrn:Say( ++nLin, 001, "Total de Funcionarios : " + Alltrim( Tran( nItens,"999,999" ) ) )
oPrn:Say( nLin, 119, Transform( nTotal, "@R 999,999,999.99" ) )
oPrn:EndPage() // salta pagina
oPrn:End()
end sequence
close Customer
//--- Passar a Dialog como ultimo parametro.
//
if oPrn:lPreview
TxtPreview( oPrn:cDevice, cTitulo, lModal,,, oPrn, oDlg, , oPrn:lModoGraf )
endif
endif
return nil
*------------------------------------------*
Function ActivePrnType()
*------------------------------------------*
// Function created by Anser
// This function will check whether the current/active/selected printer is
// Dot Matrix or InkJet/Laser
// Return Value .T. = Dot MAtrix
// Return Value .F. = Inkjet or Laser
Local oPrn
PRINT oPrn NAME "Test"
if Empty( oPrn:hDC )
MsgStop("No printers Installed")
Return .F. // Printer is not installed or ready
endif
IF oPrn:nLogPixelX() <= 350 // Dot Matrix Printer ie Text Printer
ENDPRINT
Return .T.
else // Injet or Laser ie Grpahics Printer
ENDPRINT
Return .F.
Endif
ENDPRINT
Return .F.
*----------------------------------------*
FUNCTION IsNetworkPrn(cPrnName)
*----------------------------------------*
* Function created by Anser
* This function will determine whether the Printer is a Network Printer(DOT Matrix)
* cPrnName is the Name of the Printer For Eg.PrnGetName()-> \\Abhi\Epson LQ-2080 ESC/2 P
Local cPrnPcName:=""
Local aPrnSrvrs:={},nPos:=0
aPrnSrvrs:=oWinGetSerP() // Gives NetBios name of PrintServers availabe to the user
cPrnName:=Ltrim(Rtrim(cPrnName))
if left(cPrnName,2) == "\\"
cPrnName:=Right(cPrnName,len(cPrnName)-2) // Remove the \\ from the Printer name found at the begining of the Prn name
cPrnPcName:=LEFT(cPrnName, AT("\",cPrnName) -1) // Pick only the PCName ie Abhi from the string "Abhi\Epson LQ-2080"
else
Return .F.
Endif
nPos:=aScan(aPrnSrvrs,cPrnPcName)
if nPos > 0
Return .T.
Else
Return .F.
Endif
*----------------------------------------------*
FUNCTION PrnPortUrl(cPrnName)
*----------------------------------------------*
* Fuction created by Anser
* Returns a string \\NetBiosName_Of_The_Pc_Where_The_Printer_IsPhysically_Installed\Printer_ShareName
* Expected value in Parameter cPrnName is the Printer Name For Eg.PrnGetName()-> "\\Abhi\Epson LQ-2080 ESC/2 P"
* Uses Registry to find out the values
LOCAL cRealPrnName:="", cPcName :="" , cPrnShareName:="" , cRegPath:=""
LOCAL oReg
if empty(cPrnName)
MsgStop("Printer Name is empty. Unable to proceed further")
Return ""
Endif
cPrnName:=Ltrim(Rtrim(cPrnName))
if left(cPrnName,2) == "\\" // Network Dot Matrix Printer name will have \\ in the beginning of the Printer Name
cPrnName:=Right(cPrnName,len(cPrnName)-2) // Remove the \\ from the Printer name found at the begining of the Prn name
cPcName:=LEFT(cPrnName, AT("\",cPrnName) -1) // Pick the PCName ie Abhi from the string "Abhi\Epson LQ-2080"
cRealPrnName:=RIGHT(cPrnName, Len(cPrnName)-AT("\",cPrnName) ) // Picking the Printer name after avoiding the "\\Abhi\" from the string
Endif
// Path in the registry for Windows 2000 and above
cRegPath:="SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers\"+cPcName+"\Printers\"+cRealPrnName+"\DsSpooler"
oReg := TReg32():New(HKEY_LOCAL_MACHINE,cRegPath )
IF oReg:nError = 0
cPcName := oReg:Get("shortServerName", "")
cPrnShareName := oReg:Get("printShareName", "")
else
MsgInfo("Unable to locate NetBiosName of the PC where the Printer is physically installed"+CRLF+;
"Unable to locate the Printer's ShareName")
Return ""
ENDIF
oReg:Close()
oReg := NIL
RETURN "\\"+cPcName+"\"+cPrnShareName
*******************
FUNCTION oWinGetSerP()
*******************
* Returns the names of print servers available for the current post
* Author Badara Thiam
LOCAL nHandle
LOCAL cValue
LOCAL n1
LOCAL n2
LOCAL cSubkeys
LOCAL aHKey := HKEY_LOCAL_MACHINE
LOCAL TSERVEURS := {}
cSubKeys := "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Print\Providers\LanMan Print Services\Servers"
IF RegOpenKey( aHKey, cSubKeys, @nHandle ) == 0
* Recherche des serveurs accessibles
n1 := 0
TSERVEURS := {}
DO WHILE .T.
cValue := ""
n2 := RegEnumKey( nHandle, n1, @cvalue )
SysRefresh()
IF n2 = 0
AADD(TSERVEURS, cValue)
ELSE
EXIT
ENDIF
n1 ++
ENDDO
RegCloseKey( nHandle )
ENDIF
RETURN ACLONE(TSERVEURS)
Re: TdosPrn con Preview e impresoras laser
master ANSER:
your code is working fine, im grateful for your help
i only comment this line into txtview.prg because it produces me double line jump, but i already can printer on usb matricial printers.
Now i' need to test it on remote printers
thanks all
TXTVIEW.PRG
your code is working fine, im grateful for your help
i only comment this line into txtview.prg because it produces me double line jump, but i already can printer on usb matricial printers.
Now i' need to test it on remote printers
thanks all
TXTVIEW.PRG
Code: Select all
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( "File " + ::cTxtFile + ", cannot be opened." )
return nil
endif
DEFINE DIALOG oDlg TITLE "Generating Preview..." ;
FROM 230, 217 TO 360, 575 PIXEL
* @ 10, 08 TO 40, 172 OF oDlg PIXEL
@ 1.4, 2 ICON NAME "PRINT" OF oDlg
@ 25, 55 SAY "Generating Preview..." PIXEL OF oDlg SIZE 80, 12 CENTER
@ 47, 60 BUTTON "Wait..." 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
// remove some Printer Control characters
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 [color=#FF0040]// ----> commented by artu01 //+ Space(1) + CRLF[/color]
oFile:Skip(1)
//--- If you find this page jump
IF ::cFormFeed $ cLine .or. oFile:lEof()
nPag ++ // increases Page no
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
fwh 17.12, harbour 3.2.0, pelles C, bcc7, Ms-Sql