home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Zodiac Super OZ
/
MEDIADEPOT.ISO
/
FILES
/
13
/
VBPRNT20.ZIP
/
VB4
/
VBPRNT32.FRM
(
.txt
)
< prev
Wrap
Visual Basic Form
|
1996-05-31
|
12KB
|
348 lines
VERSION 4.00
Begin VB.Form frmMain
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "VBPrint Functions"
ClientHeight = 4230
ClientLeft = 1665
ClientTop = 3090
ClientWidth = 6240
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 4665
Left = 1605
LinkTopic = "Form1"
ScaleHeight = 4230
ScaleWidth = 6240
Top = 2715
Width = 6360
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Printer Features"
ForeColor = &H80000008&
Height = 1695
Left = 0
TabIndex = 11
Top = 2460
Width = 6180
Begin VB.ListBox lstRes
Appearance = 0 'Flat
Height = 615
Left = 5025
TabIndex = 17
Top = 420
Width = 975
End
Begin VB.ListBox lstBins
Appearance = 0 'Flat
Height = 615
Left = 3135
TabIndex = 15
Top = 420
Width = 1785
End
Begin VB.ListBox lstPapers
Appearance = 0 'Flat
Height = 1200
Left = 135
TabIndex = 12
Top = 420
Width = 2940
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Resolutions"
ForeColor = &H80000008&
Height = 195
Index = 5
Left = 5025
TabIndex = 16
Top = 195
Width = 1005
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Paper bins"
ForeColor = &H80000008&
Height = 195
Index = 4
Left = 3120
TabIndex = 14
Top = 195
Width = 915
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Paper types"
ForeColor = &H80000008&
Height = 195
Index = 3
Left = 135
TabIndex = 13
Top = 195
Width = 1020
End
End
Begin VB.CheckBox chkDefault
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Use Windows defaults in dialog"
ForeColor = &H80000008&
Height = 195
Left = 75
TabIndex = 5
Top = 2175
Width = 3510
End
Begin VB.CheckBox chkPerm
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "Make changes permanent"
ForeColor = &H80000008&
Height = 195
Left = 75
TabIndex = 4
Top = 1920
Width = 2910
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 6015
Top = 9670
End
Begin VB.CommandButton cmdBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "E&xit"
Height = 330
Index = 2
Left = 4710
TabIndex = 3
Top = 1560
Width = 1365
End
Begin VB.CommandButton cmdBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Show &Dialog"
Height = 330
Index = 1
Left = 4710
TabIndex = 2
Top = 1170
Width = 1365
End
Begin VB.CommandButton cmdBtn
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "&Set Default"
Height = 330
Index = 0
Left = 4710
TabIndex = 1
Top = 780
Width = 1365
End
Begin VB.ListBox lstPrinters
Appearance = 0 'Flat
Height = 1590
Left = 60
TabIndex = 0
Top = 255
Width = 3270
End
Begin VB.Label lblDefDriver
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
ForeColor = &H00FFFFFF&
Height = 195
Left = 4050
TabIndex = 10
Top = 510
Width = 1410
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Driver:"
ForeColor = &H80000008&
Height = 195
Index = 2
Left = 3420
TabIndex = 9
Top = 525
Width = 585
End
Begin VB.Label lblDefault
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
ForeColor = &H00FFFFFF&
Height = 195
Left = 3420
TabIndex = 8
Top = 270
Width = 2610
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Current default printer:"
ForeColor = &H80000008&
Height = 195
Index = 1
Left = 3420
TabIndex = 7
Top = 30
Width = 1935
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Installed printers"
ForeColor = &H80000008&
Height = 195
Index = 0
Left = 60
TabIndex = 6
Top = 30
Width = 1425
End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
DefInt I
DefLng L
DefStr S
Option Explicit
Dim Shared DeviceData() As DEVMODE_TYPE
Private Sub cmdBtn_Click(Index As Integer)
Dim iRet As Integer
Dim inMode As DEVMODE_TYPE
Dim outMode As DEVMODE_TYPE
Dim sTemp As String
Dim iMode As Integer
Dim sTemp2 As String
Select Case Index
Case 0
If lstPrinters.ListIndex = True Then Exit Sub
sTemp = lstPrinters.List(lstPrinters.ListIndex)
iRet = VBSetDefPrinter(sTemp)
If iRet <> True Then MsgBox "Error setting default printer", 48, "Error"
Timer1_Timer
Case 1
If lstPrinters.ListIndex = True Then Exit Sub
sTemp = lstPrinters.List(lstPrinters.ListIndex)
iMode = DM_OUT_BUFFER Or DM_IN_PROMPT
If chkPerm.Value <> 0 Then iMode = iMode Or DM_OUT_DEFAULT
If chkDefault.Value = 0 Then iMode = iMode Or DM_IN_BUFFER
sTemp2 = VBDevModeToStr(DeviceData(lstPrinters.ListIndex))
iRet = VBExtDeviceMode(0, sTemp, DeviceData(lstPrinters.ListIndex), outMode, iMode)
If iRet = 1 Then iRet = VBStrToDevMode(VBDevModeToStr(outMode), DeviceData(lstPrinters.ListIndex))
Case 2
End
End Select
End Sub
Private Sub Form_Load()
Dim sTemp As String
Dim inMode As DEVMODE_TYPE
Dim iRet As Integer
Me.Left = Screen.Width / 2 - Me.Width / 2
Me.Top = Screen.Height / 2 - Me.Height / 2
sTemp = VBGetPrinters()
While sTemp <> ""
ReDim Preserve DeviceData(lstPrinters.ListCount)
iRet = VBExtDeviceMode(0, sTemp, inMode, DeviceData(lstPrinters.ListCount), DM_OUT_BUFFER)
If iRet = 1 Then lstPrinters.AddItem sTemp
If iRet <> 1 Then MsgBox Str$(iRet), 32, "Rats"
sTemp = VBGetPrinters()
Wend
lstPrinters.ListIndex = 0
lstPrinters_Click
Timer1_Timer
End Sub
Private Sub lstPrinters_Click()
ShowOptions lstPrinters.List(lstPrinters.ListIndex) + ""
End Sub
Private Sub ShowOptions(sPrinter As String)
Dim resList() As ENUMRESOLUTIONS_TYPE
Dim binNameList() As BINNAMES_TYPE
Dim binNumList() As Integer
Dim papNameList() As PAPERNAMES_TYPE
Dim papSizeList() As PAPERSIZE_TYPE
Dim lRet As Long
Dim inDev As DEVMODE_TYPE
Dim iCounter As Integer
' Step 1, find out how many paper sizes/names there are
lRet = VBDeviceCapabilities(sPrinter, DC_PAPERSIZE, ByVal 0&, inDev)
If lRet = 0 Then Exit Sub
' Size our arrays accordingly
ReDim papSizeList(lRet - 1) As PAPERSIZE_TYPE
ReDim papNameList(lRet - 1) As PAPERNAMES_TYPE
papNameList(0).sName = "Test1"
papNameList(1).sName = "Test2"
' Get the actual names of the available papers and their sizes
lRet = VBDeviceCapArray(sPrinter, DC_PAPERNAMES, papNameList(), inDev)
lRet = VBDeviceCapArray(sPrinter, DC_PAPERSIZE, papSizeList(), inDev)
' Display the available paper types in a list
' Note the papSizeList() is just for demonstration
' purposes, I don't use it here but you may want to use
' it for reference purposes.
lstPapers.Clear
For iCounter = 0 To lRet - 1
lstPapers.AddItem Trim$(papNameList(iCounter).sName)
Next
' Same procedure for the available printer bins
lRet = VBDeviceCapabilities(sPrinter, DC_BINNAMES, ByVal 0&, inDev)
If lRet = 0 Then Exit Sub
ReDim binNameList(lRet - 1) As BINNAMES_TYPE
ReDim binNumList(lRet - 1) As Integer
lRet = VBDeviceCapArray(sPrinter, DC_BINS, binNumList(), inDev)
lRet = VBDeviceCapArray(sPrinter, DC_BINNAMES, binNameList(), inDev)
lstBins.Clear
For iCounter = 0 To lRet - 1
lstBins.AddItem Trim$(binNameList(iCounter).sName)
Next
lRet = VBDeviceCapabilities(sPrinter, DC_ENUMRESOLUTIONS, ByVal 0&, inDev)
If lRet = 0 Then Exit Sub
ReDim resList(lRet - 1) As ENUMRESOLUTIONS_TYPE
lRet = VBDeviceCapArray(sPrinter, DC_ENUMRESOLUTIONS, resList(), inDev)
lstRes.Clear
For iCounter = 0 To lRet - 1
lstRes.AddItem Format$(resList(iCounter).xdpi, "#") + " x " + Format$(resList(iCounter).ydpi, "#")
Next
End Sub
Private Sub Timer1_Timer()
Dim sTemp As String
sTemp = VBGetDefPrinter()
lblDefault.Caption = sTemp
lblDefDriver = VBGetDriverFromName(sTemp)
End Sub