PC World 2002 October/PCWorld_2002-10_cd.bin/Software/Topware/fprint/fpdk400.exe/samples/vb6/FPdemo.frm

Visual Basic Form | 2000-07-18 | 11.2 KB | 328 lines

VERSION 5.00
Begin VB.Form FPdemo
   Caption         =   "FinePrint API Sample Application"
   ClientHeight    =   3090
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   5865
   Icon            =   "FPdemo.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   5865
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton btnExit
      Cancel          =   -1  'True
      Caption         =   "Exit"
      Height          =   400
      Left            =   3600
      TabIndex        =   6
      Top             =   2520
      Width           =   2052
   End
   Begin VB.CommandButton Command1
      Caption         =   "Set as default"
      Height          =   400
      Left            =   480
      TabIndex        =   4
      Top             =   2520
      Width           =   2052
   End
   Begin VB.ListBox List1
      Height          =   2010
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   3
      Top             =   360
      Width           =   3255
   End
   Begin VB.CommandButton btnPrint
      Caption         =   "Print FPDK.DOC"
      Height          =   400
      Left            =   3600
      TabIndex        =   2
      Top             =   1320
      Width           =   2052
   End
   Begin VB.CommandButton btnAttr
      Caption         =   "Show FP layout attributes"
      Height          =   400
      Left            =   3600
      TabIndex        =   1
      Top             =   840
      Width           =   2052
   End
   Begin VB.CommandButton btnOpenDialog
      Caption         =   "Show FP dialog"
      Height          =   400
      Left            =   3600
      TabIndex        =   0
      Top             =   360
      Width           =   2052
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Printers:"
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   570
   End
Attribute VB_Name = "FPdemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim StartupPrinter As String

      Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As _
          String, PrinterPort As String)
          Dim iDriver As Integer
          Dim iPort As Integer
          DriverName = ""
          PrinterPort = ""
          'The driver name is first in the string terminated by a comma
          iDriver = InStr(Buffer, ",")
          If iDriver > 0 Then
              'Strip out the driver name
              DriverName = Left(Buffer, iDriver - 1)
              'The port name is the second entry after the driver name
              'separated by commas.
              iPort = InStr(iDriver + 1, Buffer, ",")
              If iPort > 0 Then
                  'Strip out the port name
                  PrinterPort = Mid(Buffer, iDriver + 1, _
                  iPort - iDriver - 1)
              End If
          End If
      End Sub

      Private Sub ParseList(lstCtl As Control, ByVal Buffer As String)
          Dim i As Integer
          Dim s As String
          Do
              i = InStr(Buffer, Chr(0))
              If i > 0 Then
                  s = Left(Buffer, i - 1)
                  If Len(Trim(s)) Then lstCtl.AddItem s
                  Buffer = Mid(Buffer, i + 1)
                  If Trim(s) = Printer.DeviceName Then lstCtl.Text = Trim(s)
              Else
                  If Len(Trim(Buffer)) Then lstCtl.AddItem Buffer
                  Buffer = ""
              End If
          Loop While i > 0
      End Sub
      Private Sub SetDefaultPrinter()

          Dim Buffer As String
          Dim DeviceName As String
          Dim DriverName As String
          Dim PrinterPort As String
          Dim PrinterName As String
          Dim DeviceLine As String
          Dim r As Long

          If List1.ListIndex > -1 Then
              'Get the printer information for the currently selected
              'printer in the list. The information is taken from the
              'WIN.INI file.
              Buffer = Space(1024)
              PrinterName = List1.Text
              r = GetProfileString("PrinterPorts", PrinterName, "", _
                  Buffer, Len(Buffer))
              'Parse the driver name and port name out of the buffer
              GetDriverAndPort Buffer, DriverName, PrinterPort
              If DriverName <> "" And PrinterPort <> "" Then
                DeviceLine = List1.Text & "," & DriverName & "," & PrinterPort

                ' Store the new printer information in the [WINDOWS] section of
                ' the WIN.INI file for the DEVICE= item
                r = WriteProfileString("windows", "Device", DeviceLine)

                ' Cause all applications to reload the INI file:
                r = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")
              End If
          End If
      End Sub

Private Sub btnExit_Click()
    Unload Me
    End
End Sub
Private Sub Command1_Click()
    Call SetDefaultPrinter
End Sub
Private Sub Form_Load()

    Dim r As Long
    Dim Buffer As String
    'Get the list of available printers from WIN.INI
    Buffer = Space(8192)
    r = GetProfileString("PrinterPorts", vbNullString, "", _
       Buffer, Len(Buffer))
    'Display the list of printer in the list box List1
    ParseList List1, Buffer
    StartupPrinter = List1.Text
End Sub
Private Sub btnAttr_Click()
    FPattributes.Show 1, Me
End Sub
Private Sub btnOpenDialog_Click()
    Dim result As Long
    Dim szFinePrinter As String
    Dim hfp As Long
    Dim dwDlg As Long
    szFinePrinter = "FinePrint Driver"
    result = fpOpen(szFinePrinter, hfp)
    If result <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(result)
        Exit Sub
    End If
    result = fpDisplayDialog(hfp, dwDlg)
    Select Case dwDlg
        Case IDOK
            MsgBox "User pressed 'OK'"
        Case IDCANCEL
            MsgBox "User pressed 'Cancel'"
        Case IDDEFER
            MsgBox "User pressed 'Defer'"
        Case IDDEFERALL
            MsgBox "User pressed 'Defer all'"
        Case Else
            MsgBox "User pressed button value " & dwDlg
    End Select
    result = FpClose(hfp, False)
End Sub
Private Sub btnPrint_Click()
    Dim result As Long
    Dim fpe As Long
    Dim szFinePrinter As String
    Dim hfp As Long
    Dim dwDlg As Long
    Dim intAttr As Integer
    Dim lngAttr As Long
    Dim bAttr As Boolean
    Dim strAttr As String
    Dim lenAttr As Long
    Dim szStat As String
    Dim phStat As Long
    Dim szWatermark As String
    Dim pLogFont As LOGFONT
    Dim oldPrinter As Printer
    Dim P As Printer
    Dim jcOrig As FpJobCount
    Dim lpShellExecuteInfo As SHELLEXECUTEINFO
    Dim hwnd As Long
    Dim lpOperation As String
    Dim lpFile As String
    Dim lpParameters As String
    Dim lpDirectory As String
    Dim nShowCmd As Long
    Dim hProcess As Long
    Dim cSecTimeoutStart As Long
    Dim cSecTimeoutPrint As Long
    Dim pjs As FpJobStatus
    szFinePrinter = vbNullString
    fpe = fpOpen(szFinePrinter, hfp)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        Exit Sub
    End If
    'select the N-up, borders, and margins settings
    lngAttr = eLayout4
    fpe = fpSetLayoutAttr(hfp, eliLayout, ByVal lngAttr)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    lngAttr = eBordersOn
    fpe = fpSetLayoutAttr(hfp, eliBorders, ByVal lngAttr)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    lngAttr = eMarginMedium
    fpe = fpSetLayoutAttr(hfp, eliMargins, ByVal lngAttr)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    szStat = "VB6 stationery"
    fpe = fpCreateStationery(hfp, szStat, phStat)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    szWatermark = "VB6 watermark"
    fpe = fpSetStationeryAttr(hfp, phStat, esiWatermark, esiaText, ByVal szWatermark)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    lenAttr = Len(pLogFont)
    fpe = fpGetStationeryAttr(hfp, phStat, esiWatermark, esiaFont, pLogFont, lenAttr)
    'szFontname = Left(StrConv(pLogFont.lfFaceName, vbFromUnicode), InStr(StrConv(pLogFont.lfFaceName, vbFromUnicode), Chr$(0)) - 1)
    'pLogFont.lfFaceName = StrConv("Times New Roman", vbUnicode) & Chr$(0)
    pLogFont.lfFaceName = "Times New Roman" & Chr$(0)
    If fpe <> 0 Then
        fpe = fpSetStationeryAttr(hfp, phStat, esiWatermark, esiaFont, pLogFont)
        If fpe <> 0 Then
            MsgBox "FinePrint Error: " & ErrorText(fpe)
            GoTo FpClose
        End If
    End If
    lngAttr = RGB(0, 0, 255)
    fpe = fpSetStationeryAttr(hfp, phStat, esiWatermark, esiaColor, ByVal lngAttr)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    fpe = fpCloseStationery(hfp, phStat)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    fpe = fpSetLayoutAttr(hfp, eliStationery, ByVal szStat)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    fpe = fpGetJobCount(hfp, jcOrig)
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
    lpShellExecuteInfo.cbSize = Len(lpShellExecuteInfo)
    lpShellExecuteInfo.hwnd = Me.hwnd
    lpShellExecuteInfo.lpVerb = "print"
    lpShellExecuteInfo.lpFile = "c:\fpdk4\doc\fpdk.doc"
    lpShellExecuteInfo.nShow = SW_SHOWNORMAL
    lpShellExecuteInfo.fMask = SEE_MASK_NOCLOSEPROCESS
    result = ShellExecuteEx(lpShellExecuteInfo)
    cSecTimeoutStart = 60
    cSecTimeoutPrint = 600
    fpe = fpWaitForJob(hfp, jcOrig, lpShellExecuteInfo.hProcess, cSecTimeoutStart, cSecTimeoutPrint, pjs)
    If lpShellExecuteInfo.hProcess <> 0 Then
        result = CloseHandle(lpShellExecuteInfo.hProcess)
    End If
    If fpe <> 0 Then
        MsgBox "FinePrint Error: " & ErrorText(fpe)
        GoTo FpClose
    End If
'    fpe = fpDisplayDialog(hfp, dwDlg)
'    If dwDlg <> IDCANCEL Then
'        fpe = fpPrintAllJobs(hfp, vbNullString, True, True)
'    End If
    MsgBox "All tests completed successfully!"
FpClose:
    fpe = FpClose(hfp, True)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If List1.Text <> StartupPrinter Then
        List1.Text = StartupPrinter
        Call SetDefaultPrinter
    End If
End Sub