GFSelectPrinter/GFSelectPrinter.frm
VERSION 5.00
Begin VB.Form GFSelectPrinterfrm
BorderStyle = 1 'Fest Einfach
Caption = "Select printer"
ClientHeight = 4215
ClientLeft = 45
ClientTop = 330
ClientWidth = 7155
Enabled = 0 'False
Icon = "GFSelectPrinter.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4215
ScaleWidth = 7155
StartUpPosition = 3 'Windows‑Standard
Visible = 0 'False
Begin VB.CommandButton GFSPPrintCommand
Caption = "[...]"
Height = 375
Left = 5580
TabIndex = 4
Top = 3180
Width = 1455
End
Begin VB.CommandButton GFSPCancelCommand
Caption = "Cancel"
Height = 375
Left = 5580
TabIndex = 5
Top = 3720
Width = 1455
End
Begin VB.Frame GFSPCopiesFrame
Caption = "Copies"
Height = 1755
Left = 3180
TabIndex = 15
Top = 2340
Width = 2235
Begin VB.TextBox GFSPCopiesText
Height = 315
Left = 180
MaxLength = 3
TabIndex = 3
Text = "1"
Top = 840
Width = 1875
End
Begin VB.Label GFSPCopiesLabel
Caption = "Number of copies:"
Height = 195
Left = 180
TabIndex = 12
Top = 540
Width = 1875
End
End
Begin VB.Frame GFSPPaperFrame
Caption = "Paper / Quality"
Height = 1755
Left = 120
TabIndex = 14
Top = 2340
Width = 2895
Begin VB.ComboBox GFSPPaperOrientationCombo
Height = 315
Left = 1020
Style = 2 'Dropdown‑Liste
TabIndex = 2
Top = 1140
Width = 1695
End
Begin VB.ComboBox GFSPPaperFormatCombo
Height = 315
Left = 180
Style = 2 'Dropdown‑Liste
TabIndex = 1
Top = 480
Width = 2535
End
Begin VB.Label GFSPLabel5
Caption = "Orientation:"
Height = 195
Left = 180
TabIndex = 9
Top = 1200
Width = 795
End
End
Begin VB.Frame GFSPPrinterFrame
Caption = "Printer"
Height = 2175
Left = 120
TabIndex = 13
Top = 60
Width = 6915
Begin VB.ComboBox GFSPPrinterNameCombo
Height = 315
Left = 1020
Style = 2 'Dropdown‑Liste
TabIndex = 0
Top = 480
Width = 4095
End
Begin VB.Label Label1
Caption = "Note that the system default printer will be changed."
Height = 195
Left = 1020
TabIndex = 16
Top = 1800
Width = 5775
End
Begin VB.Label GFSPPrinterDriverLabel
Caption = "[...]"
Height = 195
Left = 1020
TabIndex = 10
Top = 1080
Width = 4095
End
Begin VB.Label GFSPLabel2
Caption = "Driver:"
Height = 195
Left = 180
TabIndex = 7
Top = 1020
Width = 795
End
Begin VB.Label GFSPPrinterPortLabel
Caption = "[...]"
Height = 195
Left = 1020
TabIndex = 11
Top = 1440
Width = 4095
End
Begin VB.Label GFSPLabel3
Caption = "Location:"
Height = 195
Left = 180
TabIndex = 8
Top = 1440
Width = 795
End
Begin VB.Label GFSPLabel1
Caption = "Name:"
Height = 195
Left = 180
TabIndex = 6
Top = 540
Width = 795
End
End
End
Attribute VB_Name = "GFSelectPrinterfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis.
'
'This form allows the user to select a system printer and manipulate
'special printing options.
'
'THIS FORM IS PLUG‑IN CODE, DO NOT CHANGE!
'THIS FORM REQUIRES GFSetOSDefaultPrinterfrm TO BE AVAILABLE.
'
'NOTE: GFSP is the abbreviation for GFSelectPrinter.
'NOTE: when changing available properties verify the related strings
'(i.e. 'DIN A4') are update everywhere (!) in the code.
'NOTE: setting Printer.Copies failed, thus several copies must
'be printed manually using a loop.
'
'NOTE: call GFSP_SelectPrinter() to make user select a printer.
'The system will call one of the following subs (owned by GFSPEventTargetForm):
'
'Event sub prototypes:
'Public Sub GFSPEventCancel()
'Public Sub GFSPEventPrint(ByVal PrintCopyNumber As Integer, ByRef GFSPPrinterObject As Printer)
'
'GFWait
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const Version = "v1.0"
'other
Dim GFSPContinueFlag As Boolean
Dim GFSPCancelFlag As Boolean
Dim GFSP_SelectPrinterCalledFlag As Boolean
Dim GFSPPrinterObject As Printer
'GFSelectPrinterStruct
Private Type GFSelectPrinterStruct
PrintCopyNumberEnabledFlag As Boolean 'if user can selected several copies
PrintCopyNumber As Integer 'number of copies selected by user
End Type
Dim GFSelectPrinterStructVar As GFSelectPrinterStruct
Private Sub Form_Load()
'on error resume next
Call DefineStatus
Call DefinePrinter
End Sub
Private Sub DefineStatus()
'On Error Resume Next
'
'NOTE: this sub has the task to fill the combo boxes only,
'not to select a default item.
'
Dim TempPrinter As Printer
'printer
GFSPPrinterNameCombo.Clear
For Each TempPrinter In Printers
GFSPPrinterNameCombo.AddItem TempPrinter.DeviceName
Next TempPrinter
'paper
GFSPPaperOrientationCombo.Clear
GFSPPaperOrientationCombo.AddItem "Landscape"
GFSPPaperOrientationCombo.AddItem "Portrait"
GFSPPaperFormatCombo.Clear
GFSPPaperFormatCombo.AddItem "DIN A4"
'copies
If GFSelectPrinterStructVar.PrintCopyNumberEnabledFlag = True Then
GFSPCopiesLabel.Enabled = True
GFSPCopiesText.Enabled = True
GFSPCopiesText.Text = "1" 'default
Else
GFSPCopiesLabel.Enabled = False
GFSPCopiesText.Enabled = False
GFSPCopiesText.Text = "1" 'default
End If
End Sub
Private Sub DefinePrinter()
'on error resume next
Printer.TrackDefault = True 'important (see GFSetOSDefaultPrinterfrm)
End Sub
'************************************INTERFACE SUBS*************************************
Public Sub GFSP_SelectPrinter(ByRef GFSPEventTargetForm As Form, ByVal PrintCommandCaption As String, ByVal PrintCopyNumberEnabledFlag As Boolean)
'on error resume next 'makes user select a printer and calls one of the GFSPEvent subs (see annotations at begin of form)
'verify
If GFSP_SelectPrinterCalledFlag = False Then
GFSP_SelectPrinterCalledFlag = True
Else
Exit Sub
End If
If Not (GFSPPrinterNameCombo.ListCount = 0) Then 'verify
GFSPPrinterNameCombo.Text = GFSPPrinterNameCombo.List(0) 'default
Else
MsgBox "Error: no printer is installed on local machine." + Chr$(10) + "Please install a printer and try again.", vbOKOnly + vbExclamation
Exit Sub 'error
End If
'reset
GFSPCancelFlag = False 'reset
GFSPContinueFlag = False 'reset
'preset
GFSPPrintCommand.Caption = PrintCommandCaption
GFSelectPrinterStructVar.PrintCopyNumberEnabledFlag = PrintCopyNumberEnabledFlag
'display window
GFSelectPrinterfrm.Visible = True
GFSelectPrinterfrm.Enabled = True
GFSelectPrinterfrm.Refresh
'begin
Do
Call GFWait(10)
If GFSPCancelFlag = True Then
Call GFSPEventTargetForm.GFSPEventCancel
Exit Do
End If
If GFSPContinueFlag = True Then
Call GFSPEventTargetForm.GFSPEventPrint(GFSelectPrinterStructVar.PrintCopyNumber)
Exit Do
End If
Loop
'close window
GFSelectPrinterfrm.Visible = False
GFSelectPrinterfrm.Enabled = True
GFSelectPrinterfrm.Refresh
GFSP_SelectPrinterCalledFlag = False 'reset
End Sub
'*********************************END OF INTERFACE SUBS*********************************
'************************************CONTROL EVENTS*************************************
Private Sub GFSPPrintCommand_Click()
'on error resume next
If GFSPVerifyAndAssign() = True Then 'verify
GFSPContinueFlag = True
Else
MsgBox "Error setting printing options !", vbOKOnly + vbExclamation
End If
End Sub
Private Sub GFSPCancelCommand_Click()
'on error resume next
GFSPCancelFlag = True
End Sub
Private Sub GFSPPrinterNameCombo_Click()
'on error resume next 'user selected a printer, update all related displayed properties
Dim TempPrinter As Printer
For Each TempPrinter In Printers 'see VB help for 'Printer'
If TempPrinter.DeviceName = GFSPPrinterNameCombo.Text Then
'TempPrinter is the currently selected printer
GFSPPrinterPortLabel.Caption = TempPrinter.Port
GFSPPrinterDriverLabel.Caption = TempPrinter.DriverName
GFSPPaperFormatCombo.Text = GFSPPaperFormatCombo.List(0) 'default
GFSPPaperOrientationCombo.Text = GFSPPaperOrientationCombo.List(1) 'default
End If
Next TempPrinter
End Sub
Private Sub GFSPCopiesText_LostFocus()
'on error resume next 'verify entered number of copies
Select Case Val(GFSPCopiesText.Text)
Case Is < 1
GFSPCopiesText.Text = "1"
Case Is > 999
GFSPCopiesText.Text = "999"
End Select
GFSPCopiesText.Text = LTrim$(Str$(Val(GFSPCopiesText.Text))) 'cut letters at right text end
Exit Sub
End Sub
'*********************************END OF CONTROL EVENTS*********************************
'********************************ON PRINT COMMAND CLICK*********************************
Private Function GFSPVerifyAndAssign() As Boolean
On Error GoTo ErrorEx: 'important; returns True if the current printer settings were assigned to the Printer object, False if not
'
'NOTE: this function assignes the currently selected values to the printer object.
'If assigning failed for any reason, this function will create an error message and return False.
'
'printer name
If GFSetOSDefaultPrinterfrm.GFSetOSDefaultPrinter_SetOSDefaultPrinter( _
GFSPPrinterNameCombo.Text) = True Then
'ok (OS default printer set)
Else
GoTo Error: 'selected printer could have been uninstalled
End If
Jump:
'paper format
Select Case GFSPPaperFormatCombo.Text
Case "DIN A4"
Printer.PaperSize = vbPRPSA4
End Select
'paper orientation
Select Case GFSPPaperOrientationCombo.Text
Case "Landscape"
Printer.Orientation = vbPRORLandscape
Case "Portrait"
Printer.Orientation = vbPRORPortrait
End Select
'copies
Select Case Val(GFSPCopiesText.Text)
Case Is < 1
GoTo Error:
Case Is > 999
GoTo Error:
Case Else
GFSelectPrinterStructVar.PrintCopyNumber = Val(GFSPCopiesText.Text)
End Select
GFSPVerifyAndAssign = True 'ok
Exit Function
Error:
GFSPVerifyAndAssign = False 'error
Exit Function
ErrorEx: 'display VB error message
MsgBox "Error: " + Left$(Err.Description, 512) + " !", vbOKOnly + vbExclamation
GFSPVerifyAndAssign = False 'error
Exit Function
End Function
'*****************************END OF ON PRINT COMMAND CLICK*****************************
'***********************************GENERAL FUNCTIONS***********************************
Private Sub GFWait(ByVal WaitTime As Single)
'on error resume next 'stays in DoEvents‑loop for WaitTime seconds, even if midnight has passed or OS time was changed
Dim TimerUnchanged As Single
Dim TimerNew As Single
Dim TimerOld As Single
'preset
TimerUnchanged = Timer
ReDo:
'verify
If WaitTime < 0 Then WaitTime = 0
If WaitTime > (60! * 60! * 24!) Then WaitTime = (60! * 60! * 24!)
'begin
TimerOld = GFWait_Timer(TimerUnchanged) 'preset (important)
TimerNew = GFWait_Timer(TimerUnchanged) + WaitTime
Do
If Abs(GFWait_Timer(TimerUnchanged) ‑ TimerOld) > 1! Then 'use Abs() to get 'distance'
WaitTime = WaitTime ‑ (TimerOld ‑ TimerUnchanged)
GoTo ReDo: 'OS time changed by user
End If
If GFWait_Timer(TimerUnchanged) > TimerNew Then
Exit Do 'time to wait passed
End If
TimerOld = GFWait_Timer(TimerUnchanged)
Call Sleep(10) 'decrease CPU usage
DoEvents
Loop
End Sub
Private Function GFWait_Timer(ByVal TimerUnchanged As Single) As Single
'on error resume next 'to be used by GFWait() only
If Not (Timer < TimerUnchanged) Then 'Timer may be equal to TimerUnchanged
GFWait_Timer = Timer
Else
GFWait_Timer = Timer + (60! * 60! * 24!)
End If
End Function
Private Sub Form_Unload(Cancel As Integer)
'on error resume next
GFSelectPrinterfrm.Visible = False
GFSelectPrinterfrm.Enabled = True
GFSelectPrinterfrm.Refresh
End Sub
[END OF FILE]