FiveTech Software tech support forums

Code: Select all | Expand

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

Code: Select all | Expand

/*
┌─ 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

Code: Select all | Expand

#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)

Code: Select all | Expand

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