how to i change the following vb.6 code to vb.net 2010

EDN Admin

EDN Admin

Well-known member
Joined
Aug 7, 2010
Messages
12,794
Location
In the Machine
Option Explicit<br/>
<br/>
Private Const NULLPTR = 0&<br/>
Constants for DEVMODE<br/>
Private Const CCHDEVICENAME = 32<br/>
Private Const CCHFORMNAME = 32<br/>
Constants for DocumentProperties<br/>
Private Const DM_MODIFY = 8<br/>
Private Const DM_COPY = 2<br/>
Private Const DM_IN_BUFFER = DM_MODIFY<br/>
Private Const DM_OUT_BUFFER = DM_COPY<br/>
Constants for dmOrientation<br/>
Private Const DMORIENT_PORTRAIT = 1<br/>
Private Const DMORIENT_LANDSCAPE = 2<br/>
Constants for dmPrintQuality<br/>
Private Const DMRES_DRAFT = (-1)<br/>
Private Const DMRES_HIGH = (-4)<br/>
Private Const DMRES_LOW = (-2)<br/>
Private Const DMRES_MEDIUM = (-3)<br/>
Constants for dmTTOption<br/>
Private Const DMTT_BITMAP = 1<br/>
Private Const DMTT_DOWNLOAD = 2<br/>
Private Const DMTT_DOWNLOAD_OUTLINE = 4<br/>
Private Const DMTT_SUBDEV = 3<br/>
Constants for dmColor<br/>
Private Const DMCOLOR_COLOR = 2<br/>
Private Const DMCOLOR_MONOCHROME = 1<br/>
Constants for dmCollate<br/>
Private Const DMCOLLATE_FALSE = 0<br/>
Private Const DMCOLLATE_TRUE = 1<br/>
Private Const DM_COLLATE As Long = &H8000<br/>
Constants for dmDuplex<br/>
Private Const DM_DUPLEX = &H1000&<br/>
Private Const DMDUP_HORIZONTAL = 3<br/>
Private Const DMDUP_SIMPLEX = 1<br/>
Private Const DMDUP_VERTICAL = 2<br/>
<br/>
Private Type DEVMODE<br/>
dmDeviceName(1 To CCHDEVICENAME) As Byte<br/>
dmSpecVersion As Integer<br/>
dmDriverVersion As Integer<br/>
dmSize As Integer<br/>
dmDriverExtra As Integer<br/>
dmFields As Long<br/>
dmOrientation As Integer<br/>
dmPaperSize As Integer<br/>
dmPaperLength As Integer<br/>
dmPaperWidth As Integer<br/>
dmScale As Integer<br/>
dmCopies As Integer<br/>
dmDefaultSource As Integer<br/>
dmPrintQuality As Integer<br/>
dmColor As Integer<br/>
dmDuplex As Integer<br/>
dmYResolution As Integer<br/>
dmTTOption As Integer<br/>
dmCollate As Integer<br/>
dmFormName(1 To CCHFORMNAME) As Byte<br/>
dmUnusedPadding As Integer<br/>
dmBitsPerPel As Integer<br/>
dmPelsWidth As Long<br/>
dmPelsHeight As Long<br/>
dmDisplayFlags As Long<br/>
dmDisplayFrequency As Long<br/>

<br/>
End Type<br/>
<br/>
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _<br/>
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _<br/>
ByVal pDefault As Long) As Long<br/>
<br/>
Private Declare Function DocumentProperties Lib "winspool.drv" _
<br/>
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
<br/>
ByVal hPrinter As Long, ByVal pDeviceName As String, _
<br/>
pDevModeOutput As Any, ByVal pDevModeInput As Long, _ ByVal fMode As Long)<br/>
As Long <br/>
<br/>
Private Declare Function ClosePrinter Lib "winspool.drv" _<br/>
(ByVal hPrinter As Long) As Long<br/>
<br/>
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _<br/>
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)<br/>
<br/>
Function StripNulls(OriginalStr As String) As String<br/>
If (InStr(OriginalStr, Chr(0)) > 0) Then<br/>
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)<br/>
End If<br/>
StripNulls = Trim(OriginalStr)<br/>
End Function<br/>
<br/>
Function ByteToString(ByteArray() As Byte) As String<br/>
Dim TempStr As String<br/>
Dim I As Integer<br/>
<br/>
For I = 1 To CCHDEVICENAME<br/>
TempStr = TempStr & Chr(ByteArray(I))<br/>
Next I<br/>
ByteToString = StripNulls(TempStr)<br/>
End Function<br/>
<br/>
Function GetPrinterSettings(szPrinterName As String, hdc As Long) _<br/>
As Boolean<br/>
Dim hPrinter As Long<br/>
Dim nSize As Long<br/>
Dim pDevMode As DEVMODE<br/>
Dim aDevMode() As Byte<br/>
Dim TempStr As String<br/>
<br/>
If OpenPrinter(szPrinterName, hPrinter, NULLPTR) <> 0 Then<br/>
nSize = DocumentProperties(NULLPTR, hPrinter, szPrinterName, _<br/>
NULLPTR, NULLPTR, 0)<br/>
If nSize < 1 Then<br/>
GetPrinterSettings = False<br/>
Exit Function<br/>
End If<br/>
ReDim aDevMode(1 To nSize)<br/>
nSize = DocumentProperties(NULLPTR, hPrinter, szPrinterName, _<br/>
aDevMode(1), NULLPTR, DM_OUT_BUFFER)<br/>
If nSize < 0 Then<br/>
GetPrinterSettings = False<br/>
Exit Function<br/>
End If<br/>
Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))<br/>
<br/>
<br/>
List1.Clear empty the ListBox<br/>
List1.AddItem "Printer Name: " & _<br/>
ByteToString(pDevMode.dmDeviceName)<br/>
<br/>
If pDevMode.dmOrientation = DMORIENT_PORTRAIT Then<br/>
TempStr = "PORTRAIT"<br/>
ElseIf pDevMode.dmOrientation = DMORIENT_LANDSCAPE Then<br/>
TempStr = "LANDSCAPE"<br/>
Else<br/>
TempStr = "UNDEFINED"<br/>
End If<br/>
List1.AddItem "Orientation: " & TempStr<br/>
<br/>
Select Case pDevMode.dmPrintQuality<br/>
Case DMRES_DRAFT<br/>
TempStr = "DRAFT"<br/>
Case DMRES_HIGH<br/>
TempStr = "HIGH"<br/>
Case DMRES_LOW<br/>
TempStr = "LOW"<br/>
Case DMRES_MEDIUM<br/>
TempStr = "MEDIUM"<br/>
Case Else positive value<br/>
TempStr = CStr(pDevMode.dmPrintQuality) & " dpi"<br/>
End Select<br/>
List1.AddItem "Print Quality: " & TempStr<br/>
<br/>
Select Case pDevMode.dmTTOption<br/>
Case DMTT_BITMAP default for dot-matrix printers<br/>
TempStr = "TrueType fonts as graphics"<br/>
Case DMTT_DOWNLOAD default for HP printers that use PCL<br/>
TempStr = "Downloads TrueType fonts as soft fonts"<br/>
Case DMTT_SUBDEV default for PostScript printers<br/>
TempStr = "Substitute device fonts for TrueType fonts"<br/>
Case Else<br/>
TempStr = "UNDEFINED"<br/>
End Select<br/>
List1.AddItem "TrueType Option: " & TempStr<br/>
<br/>
Windows NT drivers often return COLOR from Monochrome printers<br/>
If pDevMode.dmColor = DMCOLOR_MONOCHROME Then<br/>
TempStr = "MONOCHROME"<br/>
ElseIf pDevMode.dmColor = DMCOLOR_COLOR Then<br/>
TempStr = "COLOR"<br/>
Else<br/>
TempStr = "UNDEFINED"<br/>
End If<br/>
List1.AddItem "Color or Monochrome: " & TempStr<br/>
<br/>
If pDevMode.dmScale = 0 Then<br/>
TempStr = "NONE"<br/>
Else<br/>
TempStr = CStr(pDevMode.dmScale)<br/>
End If<br/>
List1.AddItem "Scale Factor: " & TempStr<br/>
<br/>
If pDevMode.dmFields And DM_COLLATE Then<br/>
If pDevMode.dmCollate = DMCOLLATE_FALSE Then<br/>
TempStr = "Collating is supported, but turned off"<br/>
ElseIf pDevMode.dmCollate = DMCOLLATE_TRUE Then<br/>
TempStr = "Collating is supported and turned on"<br/>
End If<br/>
Else<br/>
TempStr = "Collating is unsupported"<br/>
End If<br/>
List1.AddItem TempStr
<br/>
If pDevMode.dmFields And DM_DUPLEX Then<br/>
If pDevMode.dmDuplex = DMDUP_SIMPLEX Then<br/>
TempStr = "Duplex is supported, but turned off (1)"<br/>
ElseIf pDevMode.dmDuplex = DMDUP_VERTICAL Then<br/>
TempStr = "Duplex is set to VERTICAL (2)"<br/>
ElseIf pDevMode.dmDuplex = DMDUP_HORIZONTAL Then<br/>
TempStr = "Duplex is set to HORIZONTAL (3)"<br/>
Else<br/>
TempStr = "Duplex is set to undefined value of " & _<br/>
pDevMode.dmDuplex<br/>
End If<br/>
Else<br/>
TempStr = "Duplex is unsupported"<br/>
End If<br/>
List1.AddItem TempStr<br/>
<br/>
List1.AddItem "Y Resolution: " & pDevMode.dmYResolution & " dpi"<br/>
List1.AddItem "Copies: " & CStr(pDevMode.dmCopies)<br/>
Add any other items of interest ...<br/>
<br/>
Call ClosePrinter(hPrinter)<br/>
GetPrinterSettings = True<br/>
Else<br/>
GetPrinterSettings = False<br/>
End If<br/>
End Function<br/>
<br/>
Private Sub Command1_Click()<br/>
If GetPrinterSettings(Printer.DeviceName, Printer.hdc) = False Then<br/>
List1.AddItem "No Settings Retrieved!"<br/>
MsgBox "Unable to retrieve Printer settings.", , "Failure"<br/>
End If<br/>
End Sub<br/>
<br/>

View the full article
 
Back
Top