' revision 2/16/02
#Compile Exe
' Copyright 2001-2002 Barry Erick All Rights Reserved.
' Routines may be used but are not public domain.
#Include "win32api.inc"
#Include "comdlg32.inc"

Declare CallBack Function winProc()
Declare Function GetFile(hWnd As Long) As String
Declare Function OpenAPrinter (prhdc As Long) As Long
Declare Sub LPrint (textIn As String)
Declare Sub CloseAPrinter()
Declare Function ShortDialog(txt As Asciiz,cap As Asciiz) As Long
Declare Function MesgBox(mesg$, MesgStyle As Long, MesgTitle$) As Long

Global FontMetrix As Long
Global LineCtr As Long
Global PrinterOpen As Long
Global pHDC As Long
Global szText As Asciiz * 256
Global tm As textmetric
Global di As DOCINFO
Global hFontOld As Long
Global lf As LOGFONT
Global Message As String
Global hdlg As Long
Global UseDefaultPrinter As Long
Global PageCtr As Long
Global file As String
Global hWin&, hFont&, hBrush&, bkColor&
Global AbortPrint As Long
Global hapwnd As Long
Global dtFmt As String

%PointSize = 12
%LPP = 60
%CPL = 80
%btnPRINTFILE = 105
%btnDefaultPrinter = 104
%btnExit = 103
%lblShortMsg = 109
%lblPrintPage = 766
%lblPrintPageNum = 765

' This function gets around a bug in Windows 2000 and is compatible with all versions of PBDLL
Function MesgBox(Mesg$, MesgStyle&, MesgTitle$) As Long
  Static CtrlWrd As Dword
  MesgBox = MsgBox(Mesg$, MesgStyle&, MesgTitle$)
  CtrlWrd = &B0001001100111111
  Asm FLDCW CtrlWrd ; this guarantees extended precision
End Function

Function DefaultPrinter () As String
    Dim buffer As Asciiz * 128
    GetProfileString "WINDOWS", "DEVICE","", buffer,SizeOf (Buffer) ' looks in WinIni for default printer.
    Function = buffer
End Function

CallBack Function CancelPrint()
    AbortPrint = 1
End Function

Sub ShowPageCount()
    Control Set Text hapwnd, %lblPrintPageNum,Str$(PageCtr)
End Sub

Sub AbortPrintWindow (how As Long)
    If IsTrue How Then
        Dialog New hwin, "Printing",,,100,50 To hapwnd
        Control Add Label, hapwnd, %lblPrintPage,"Page ",20,5,40,14,%SS_CENTER
        Control Add Label, hapwnd, %lblPrintPageNum," ", 25,19,50,14,%SS_CENTER
        Control Add Button, hapwnd,111,"Cancel Print",25,35,50,14 Call CancelPrint
        Dialog Show Modeless hapwnd
    Else
        Dialog End hapwnd
    End If
End Sub

Function PrintFile() As Long
    Local hFile As Long
    Local Prntr As String
    Local ltxt As String
    Local msg As Asciiz * 128
    Local cap As String
    Local capz As Asciiz * 128
    Local flags As Long
    Local nCopies As Word
    Local nFromPage As Word
    Local nToPage As Word
    Local nMaxPage As Word
    Local nMinPage As Word
    Local mssg As String

    AbortPrint = 0
    LineCtr = 0
    cap = "PB Print demo: Cannot Print"
    dtFmt = Date$ & " " & Time$
    file = GetFile(hWin)
    If Len(file) = 0 Then
        MesgBox  "No File Specified!", %MB_ICONEXCLAMATION,Cap
        Exit Function
    Else
        lTxt = Dir$(file)
        If Len(lTxt) = 0 Then
            MesgBox  "File: " & $Dq & File & $Dq & " not found!", %MB_ICONEXCLAMATION, Cap
            Exit Function
        End If
    End If
    hFile = FreeFile
    Message = File
    flags = %PD_ReturnDC
    Local pi() As Printer_Info_2

    If IsFalse UseDefaultPrinter Then
        PrinterDialog hWin,flags,pHDC,nCopies,nFromPage,nToPage,nMinPage,nMaxPage
    End If
    If OpenAPrinter(phdc) Then
        Open File For Input As hFile
         'Enable Cancel printing window
         AbortPrintWindow 1
        If Len(File) >%CPL +15 Then
            mssg = "Printing File: ..." & Right$(File,%CPL-15)
        Else
            mssg = "Printing File: " & File
        End If
        PageCtr = 1
        ShowPageCount
        Lprint mssg ' show filename on first page.
        Lprint " "  'and add a blank line
        Do
            If Eof(hfile) Then Exit Loop
            Line Input# hFile, lTxt
            Dialog DoEvents
            If AbortPrint Then
                AbortPrint = 0
                Exit Loop
            End If
            Lprint ltxt
        Loop
        abortPrint = 0
        abortPrintWindow 0 'close it
        Close hFile
        EndPage phdc
        EndDoc phdc
        If UseDefaultPrinter Then
            CloseAPrinter
        End If
        Dialog DoEvents
        cap = "Done!"
        msg = "Job sent to printer!"
        'messagebox hdlg,msg, cap, %MB_ICONEXCLAMATION
        capz=cap
        shortdialog msg,capz
        PrinterOpen = %False
    Else
        MesgBox "can't open printer", %MB_ICONERROR, "Printer Error"
    End If
End Function

Sub ExitRoutine()
    Dialog End hdlg
End Sub

Function ShortDialog(txt As Asciiz,cap As Asciiz) As Long
    Local sdWin As Long
    Local t As Long, m As String
    Dialog New hWin, cap,,,80,60 To sdWin&
    m = txt
    Control Add Label, sdWin, %lblShortMsg,m,10,20,60,28' Call dumblabel
    Dialog Show Modeless sdwin
    t = Timer
    Control Set Focus sdwin,%lblShortMsg
    Do Until Timer-t =>5
        Dialog DoEvents
    Loop
    Dialog End sdwin
End Function

Function PbMain()As Long
    Dialog New 0,"Print Text File ",,,235,100,%WS_SYSMENU To hWin&
    hdlg = hwin
    ' center is 235/2
    ' left start is center - (55/5)
    Control Add Button, hWin&, %btnPrintFile, "&Print File", ((235/2)-(77/2)), 5, 55,14
    Control Add Button, hWin&, %btnDefaultPrinter, "Print File using" & $CrLf & "&Default Printer",((235/2)-(77/2)),25,55,28,%BS_MULTILINE
    Control Add Button, hWin&, %btnExit, "&Exit",185,65,40,14
    Dialog Show Modal hWin& Call winProc
End Function

CallBack Function winProc()
    Select Case CbMsg
        Case %WM_INITDIALOG
            bkColor=RGB(20,20,255) '(200,200,255)
        Case %WM_CTLCOLORDLG
            hBrush=CreateSolidBrush(bkColor)
            Function=hBrush
        Case %WM_COMMAND
            If CbCtlMsg=%BN_CLICKED Then
                If CbCtl=%btnExit Then ExitRoutine
                If CbCtl=%btnDefaultPrinter Then
                    UseDefaultPrinter = %True
                    PrintFile
                End If
                If CbCtl = %btnPrintFile Then
                    UseDefaultPrinter = %False
                    PrintFile
                End If
            End If
    End Select
End Function

Function OpenAPrinter(phdc As Long) As Long
     Local zPrinter As Asciiz * 256
     Local sztexzt As Asciiz * 256
     Local Printer As String
     If PrinterOpen Then Exit Function
     If UseDefaultPrinter Then
         ' get default printer
         Printer = DefaultPrinter
         If Printer = "" Then
             MesgBox "No default printer", %MB_ICONERROR, "Printer Error"
             Function = 0
             Exit Function
         End If
         #Debug Print printer
         phdc = InStr(Printer,",")     ' phdc is not used right now and is simply a temp variable
         Printer = Left$(printer,phdc-1)
         zPrinter = Trim$(Printer, Any Chr$(0,32)& ",")
         #Debug Print zPrinter
         phdc = CreateDC("", zPrinter, "", ByVal %Null)  'phdc now counts and has a real value
     End If
     If IsFalse phDC Then Exit Function
     di.cbsize = SizeOf(di)
     szText = "Print File - " & message
     di.lpszDocName = VarPtr(sztext)
     StartDoc phDC,di
     StartPage phdc
     SettextAlign phdc, %TA_BASELINE Or %TA_NOUPDATECP Or %TA_LEFT
     SetBkMode pHDC, %TRANSPARENT
     lf.lfHeight = %POINTSIZE * GetDeviceCaps(pHDC, %LOGPIXELSY) /72
     lf.lfFaceName= "Courier New"
     hFont = CreateFontIndirect(lf)
     hFontOld= SelectObject(phdc, hfont)
     getTextMetrics pHDC, tm
     fontmetrix = lf.lfheight
     PrinterOpen = 1
     Function = -1
End Function

Sub CloseAPrinter()
    If IsFalse PrinterOpen Then
        Exit Sub
    Else
        SelectObject pHDC, hFontOld
        DeleteObject hFont
        ' Endpage pHdc
        DeleteDC pHDC
        PrinterOpen = %False
    End If
End Sub

Function GetFile(hWnd As Long) As String
    Local SaveFile As String
    Local Filter As String
    SaveFile = "*.bas"
    Filter = "BASIC Files (*.bas)"   & Chr$(0) & "*.bas" & Chr$(0) & _
                "Text Files (*.txt)"   & Chr$(0) & "*.txt" & Chr$(0) & _
                "C/C++ Files (*.c;*.cpp)" & Chr$(0) & "*.c; *.cpp" & Chr$(0) & _
                "PASCAL Fles (*.pas)"   & Chr$(0) & "*.pas" & Chr$(0) & _
                "Header Files (*.h)"    & Chr$(0) & "*.h" & Chr$(0) & _
                "Include Files (*.inc)" & Chr$(0) & "*.inc" & Chr$(0) & _
                "Resource Files (*.rc)" & Chr$(0) & "*.rc" & Chr$(0) & _
                "All Files (*.*)"        & Chr$(0) & "*.*" & Chr$(0) & Chr$(0)

    OpenFileDialog hWnd, _
         "Select File for Printing", _
         SaveFile, _
         "", _
         Filter, _
         "asc", _
         %OFN_EXPLORER + %OFN_LONGNAMES + _
         %OFN_NOREADONLYRETURN + %OFN_PATHMUSTEXIST + _
         %OFN_HIDEREADONLY
    If Trim$(SaveFile) = "" Then
        Function = ""
        Exit Function
    ElseIf Left$(Trim$(SaveFile),1) = "*" Then
        Function = ""
        Exit Function
    End If
    Function = Trim$(saveFile)
End Function

Sub LPrint(TextIn As String)
    Local sTemp As String
    Local sppos As Long
    sTemp = TextIn
    Do
        If Len(sTemp) > %CPL Then
            szText = Left$(sTemp, %CPL)' should look for last space in line........
            ' look for last space, hyphen, comma, dash, tab
            sppos = InStr(-1,szText,Any " " & "~" & "-" & "," & "_" & Chr$(9))
            szText = Left$(sTemp,sppos)
            'if no delimenator is found, do something
            If sppos <0 Or sppos>1024 Then sppos = %CPL
            sTemp = Space$(9) & Mid$(sTemp, sppos+1)
        Else
            szText = sTemp
            stemp = ""
        End If
        LineCtr = lineCtr + 1
        textOut phdc, 20, FontMetrix * lineCtr, szText, Len(szText)
        If LineCtr >= %LPP Then
            endPage phdc
            linectr = 0
            StartPage pHdc
            Incr PageCtr
            showPageCount
            If Len(file)>20 Then
                lprint "..." & Right$(file,20) & " Page:" & Str$(pageCtr) & " Printed on " & dtfmt
            Else
                Lprint Right$(file,20) & " Page:" & Str$(PageCtr)
            End If
            Incr LineCtr
            Lprint " "
            Incr LineCtr
        End If
        If sTemp = "" Then Exit Loop
    Loop
End Sub