Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/prset/prsetup.frm

Visual Basic Form | 1995-05-08 | 8.3 KB | 265 lines

VERSION 2.00
Begin Form PrintSetup
   BackColor       =   &H00FFFF00&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Printer Setup"
   ClientHeight    =   4200
   ClientLeft      =   3465
   ClientTop       =   2430
   ClientWidth     =   6495
   Height          =   4605
   Left            =   3405
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4200
   ScaleWidth      =   6495
   Top             =   2085
   Width           =   6615
   Begin CommandButton Command3
      Caption         =   "Setup ..."
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   495
      Left            =   4800
      TabIndex        =   3
      Top             =   3120
      Width           =   1575
   End
   Begin CommandButton Command2
      Caption         =   "Cancel"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   495
      Left            =   4800
      TabIndex        =   2
      Top             =   1440
      Width           =   1575
   End
   Begin CommandButton Command1
      Caption         =   "OK"
      Default         =   -1  'True
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   495
      Left            =   4800
      TabIndex        =   1
      Top             =   480
      Width           =   1575
   End
   Begin ListBox List1
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   3150
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   4455
   End
   Begin Label Label2
      BackColor       =   &H00FFFF00&
      Caption         =   "Copyright (c) 1991 Corey Schwartz, Programmer's Warehouse 602-443-0580, 73240,2734 All Rights Reserved"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   3720
      Width           =   6375
   End
   Begin Label Label1
      BackColor       =   &H00FFFF00&
      Caption         =   "&Printer"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1695
   End
Const DM_UPDATE = 1
Const DM_COPY = 2
Const DM_PROMPT = 4
Const DM_MODIFY = 8
Const SIZETEMPBUFF = 80
Const MAXKEYBUFFER = 300
Declare Function CallProc Lib "CallAddr.DLL" (ByVal fnc&, ByVal hWnd%, ByVal hDrv%, ByVal dmOut&, ByVal lpName$, ByVal lpPort$, ByVal dmIn&, ByVal lpPro As Any, ByVal wMode%) As Integer
Declare Function GetProcAddress Lib "Kernel" (ByVal hDrv%, ByVal Esc As String) As Long
Sub AccessPrinter (UpdatePrt As Integer)
    Dim lpName As String
    Dim lpPort As String
    Dim lpDriver As String
    Dim TempStr As String
    Dim hMem As Integer
    Dim lpfnMode As Long
    Dim hDriver As Integer
    Dim Flags As Integer
    If List1.ListIndex = -1 Then
    Exit Sub
    End If
    Screen.MousePointer = 11
    TempStr = List1.list(List1.ListIndex)
    x = lbParse(TempStr, lpName, lpPort, lpDriver)
    hDriver = LoadLibrary(lpDriver)
    If (hDriver >= 32) Then
    lpfnMode = GetProcAddress(hDriver, "EXTDEVICEMODE")
    If (lpfnMode <> 0) Then
       wSizeDM = CallProc(lpfnMode, 0&, hDriver, 0&, lpName, lpPort, 0&, 0&, 0)
       If (wSizeDM <> 0) Then
           hMem = GlobalAlloc(GHND, wSizeDM)
           If (hMem <> 0) Then
            pDM = GlobalLock(hMem)
            dummy = CallProc(lpfnMode, 0&, hDriver, pDM, lpName, lpPort, 0&, "WIN.INI", DM_COPY)
            wFlags = DM_UPDATE Or DM_MODIFY
            If UpdatePrt Then
               wFlags = wFlags Or DM_PROMPT
            End If
            dummy = CallProc(lpfnMode, 0&, hDriver, 0&, lpName, lpPort, pDM, "WIN.INI", wFlags)
            dummy = GlobalUnlock(hMem)
           End If
       End If
    End If
    FreeLibrary (hDriver)
    End If
    Screen.MousePointer = 0
End Sub
Sub Command1_Click ()
    If List1.ListIndex >= 0 Then
    AccessPrinter (False)
    End If
    Unload PrintSetup
End Sub
Sub Command1_KeyPress (KeyAscii As Integer)
    kbDaemon (KeyAscii)
End Sub
Sub Command2_Click ()
    Unload PrintSetup
End Sub
Sub Command2_KeyPress (KeyAscii As Integer)
    kbDaemon (KeyAscii)
End Sub
Sub Command3_Click ()
    AccessPrinter (True)
End Sub
Sub Command3_KeyPress (KeyAscii As Integer)
    kbDaemon (KeyAscii)
End Sub
Sub Form_KeyPress (KeyAscii As Integer)
    kbDaemon (KeyAscii)
End Sub
Sub Form_Load ()
    lbsetup List1
End Sub
Sub kbDaemon (KeyAscii As Integer)
    If KeyAscii = Asc("P") Or KeyAscii = Asc("p") Then
    List1.GotFocus = True
    End If
End Sub
Function lbLookup (c As Control, Key As String)
    x% = c.ListCount - 1
    For i% = 0 To x%
    If (c.list(i%) = Key) Then
        lbLookup = i%
        Exit Function
    End If
    Next
    lbLookup = -1
End Function
Function lbParse (SrcString As String, lpPrinter As String, lpPort As String, lpDriver As String) As Integer
    'We assume that the input string is
    'in the form: <Printer> on <Port>
    Dim cBuff1 As String * SIZETEMPBUFF
    Dim fstru As OFSTRUCT
    i = Len(SrcString)
    strlen = i
    While (i > 0 And Mid$(SrcString, i, 1) <> " ")
    i = i - 1
    Wend
    lpPort = Trim(Mid$(SrcString, i + 1, strlen - i))
    lpPrinter = Trim$(Mid$(SrcString, 1, i - 3))
    x = GetProfileString("devices", ByVal lpPrinter, ByVal 0&, cBuff1, SIZETEMPBUFF)
    lpDriver = Trim(Mid$(cBuff1, 1, InStr(cBuff1, ",") - 1))
    x = InStr(lpDriver, ".")
    If x = 0 Then
    lpDriver = lpDriver + ".Drv"
    End If
    x = OpenFile(lpDriver, fstru, OF_EXIST Or OF_READ)
    If (x = -1) Then
    lbParse = -1
    Exit Function
    End If
    lbParse = 1
End Function
Sub lbsetup (lb As Control)
Dim cBuff1 As String * SIZETEMPBUFF
Dim lpKeyList As String * MAXKEYBUFFER
Dim Str1 As String
Dim i As Integer
Dim j As Integer
Dim lpKeyName As String
Dim DeviceName As String
    StrIndex = 1
    j = GetProfileString("Devices", ByVal 0&, "No Devices Available", lpKeyList, MAXKEYBUFFER)
    While (StrIndex <= j)
    NullPos = InStr(StrIndex, lpKeyList, Chr$(0))
    lpKeyName = Mid$(lpKeyList, StrIndex, NullPos - StrIndex)
    cBuff1 = String$(SIZETEMPBUFF, Chr$(0))
    i = GetProfileString("Devices", ByVal lpKeyName, ByVal 0&, cBuff1, SIZETEMPBUFF)
    'The string Returned should be in the form:
    '   PCL / HP LaserJet,HPPCL,LPT1:,LPT2:
    'Get the device Name
    x = InStr(1, cBuff1, ",") + 1
    'Loop Through the devices adding a string to the listbox Control
    Done = 0
    While (Not Done)
        NextComma = InStr(x, cBuff1, ",")
        If NextComma = 0 Then
        NextComma = i + 1
        Done = -1
        End If
        Str1 = lpKeyName + " on " + Mid$(cBuff1, x, NextComma - x)
        lb.AddItem Str1
        x = NextComma + 1
    Wend
    StrIndex = NullPos + 1
    Wend
    '-------------------
    'Get Default Printer
    cBuff1 = String$(SIZETEMPBUFF, Chr$(0))
    i = GetProfileString("Windows", "Device", ByVal 0&, cBuff1, SIZETEMPBUFF)
    x = InStr(1, cBuff1, ",") + 1
    NextComma = InStr(x, cBuff1, ",")
    If NextComma = 0 Then
       NextComma = i + 1
    End If
    Str1 = lpKeyName + " on " + Mid$(cBuff1, x, NextComma - x)
    lb.ListIndex = lbLookup(lb, Str1)
End Sub
Sub List1_DblClick ()
    AccessPrinter (False)
    Unload PrintSetup
End Sub
Function Trim (Str1 As String) As String
    Trim = LTrim$(RTrim$(Str1))
End Function