Declare Function PPrtr Lib "PPRTR.DLL" (ByVal hWnd As Integer, ByVal ppSelection As Integer, ByVal PPNewValue As Integer, ByVal ppAction As Integer) As Integer Declare Function DefPrtr Lib "PPRTR.DLL" (ByVal newone As String, ByVal oldone As String) As Integer Declare Function Prtrs Lib "PPRTR.DLL" (ByVal plist As String) As Integer Declare Function PrtrCap Lib "PPRTR.DLL" (ndc As DEVCAP) As Integer Declare Function GetPrtr Lib "PPRTR.DLL" (ByVal DefPrtr As String) As Integer Declare Function GetPort Lib "PPRTR.DLL" (ByVal ptrport As String) As Integer Sub CLIPCAPS () If dc.CLIPCAPS = CP_NONE Then list2.AddItem "CLIPCAPS: None " Exit Sub Else list2.AddItem "CLIPCAPS" End If If dc.CLIPCAPS And CP_RECTANGLE Then list2.AddItem " Output clipped to rectangles: Yes" Else list2.AddItem " Output clipped to rectangles: No" End If If dc.CLIPCAPS And LC_REGION Then list2.AddItem " Output clipped to regions: Yes" Else list2.AddItem " Output clipped to regions: No" End If End Sub Sub Command1_Click () MsgBox "Pagesize is: " + Str$(PPrtr(hWnd, DM_PAPERSIZE, PP_UNNEEDED, PP_GIMME)), 0, "PaperSize" End Sub Sub Command10_Click () MsgBox "Quality is: " + Str$(PPrtr(hWnd, DM_PRINTQUALITY, PP_UNNEEDED, PP_GIMME)), 0, "PrintQuality" End Sub Sub Command11_Click () plist$ = String$(255, 0) i = Prtrs(plist$) ' MsgBox Str$(i), 0, "size of returned string" ' MsgBox plist$, 0, "returned string" While i <> 0 j = InStr(plist$, ";") If j = 0 Then j = i + 1 ' no equiv of max() ?? End If list1.AddItem Mid(plist$, 1, j - 1) plist$ = Mid(plist$, j + 1) i = Len(plist$) Wend End Sub ' Sub Command12_Click () i = PrtrCap(dc) ' check for 996 (no driver) 'msgbox str$(i) list2.Clear list2.AddItem "DRIVERVERSION: " + Str$(dc.DRIVERVERSION) list2.AddItem "TECHNOLOGY: " + tech(dc.technology) ' bits" list2.AddItem "HORZSIZE: " + Str$(dc.HORZSIZE) list2.AddItem "VERTSIZE: " + Str$(dc.VERTSIZE) list2.AddItem "HORZRES: " + Str$(dc.HORZRES) list2.AddItem "VERTRES: " + Str$(dc.VERTRES) list2.AddItem "BITSPIXEL: " + Str$(dc.BITSPIXEL) list2.AddItem "PLANES: " + Str$(dc.PLANES) list2.AddItem "NUMBRUSHES: " + Str$(dc.NUMBRUSHES) list2.AddItem "NUMPENS: " + Str$(dc.NUMPENS) list2.AddItem "NUMMARKERS: " + Str$(dc.NUMMARKERS) list2.AddItem "NUMFONTS: " + Str$(dc.NUMFONTS) list2.AddItem "NUMCOLORS: " + Str$(dc.NUMCOLORS) list2.AddItem "PDEVICESIZE: " + Str$(dc.PDEVICESIZE) curve LINECAPS POLYGONAL txt CLIPCAPS raster list2.AddItem "ASPECTX: " + Str$(dc.ASPECTX) list2.AddItem "ASPECTY: " + Str$(dc.ASPECTY) list2.AddItem "ASPECTXY: " + Str$(dc.ASPECTXY) list2.AddItem "LOGPIXELSX: " + Str$(dc.LOGPIXELSX) list2.AddItem "LOGPIXELSY: " + Str$(dc.LOGPIXELSY) list2.AddItem "SIZEPALETTE: " + Str$(dc.SIZEPALETTE) list2.AddItem "NUMRESERVED: " + Str$(dc.NUMRESERVED) list2.AddItem "COLORRES: " + Str$(dc.COLORRES) End Sub Sub Command13_Click () MsgBox "Orientation was: " + Str$(PPrtr(hWnd, DM_ORIENTATION, DMORIENT_LANDSCAPE, PP_CHANGE_IT)), 0, "Orientation" End Sub Sub Command2_Click () MsgBox "Orientation was: " + Str$(PPrtr(hWnd, DM_ORIENTATION, DMORIENT_PORTRAIT, PP_CHANGE_IT)), 0, "Orientation" End Sub Sub Command3_Click () MsgBox "Papersize was: " + Str$(PPrtr(hWnd, DM_PAPERSIZE, DMPAPER_LEGAL, PP_CHANGE_IT)), 0, "PaperSize" End Sub Sub Command4_Click () MsgBox "Orientation is: " + Str$(PPrtr(hWnd, DM_ORIENTATION, PP_UNNEEDED, PP_GIMME)), 0, "Orientation" End Sub Sub Command5_Click () oldprinter$ = String$(255, 0) i = DefPrtr("Epson LX-800 on LPT1:", oldprinter$) getdefault MsgBox "return code = " + Str$(i) MsgBox "old printer = " + oldprinter$ End Sub Sub Command6_Click () oldprinter$ = String$(255, 0) i = DefPrtr("HP LaserJet Series II on LPT1:", oldprinter$) getdefault MsgBox "return code = " + Str$(i) MsgBox "old printer = " + oldprinter$ End Sub Sub Command7_Click () ptrport$ = String$(255, 0) i = GetPort(ptrport$) label9.Caption = ptrport$ End Sub Sub Command8_Click () MsgBox "Quality was: " + Str$(PPrtr(hWnd, DM_PRINTQUALITY, DMRES_DRAFT, PP_CHANGE_IT)), 0, "PrintQuality" End Sub Sub Command9_Click () MsgBox "Quality was: " + Str$(PPrtr(hWnd, DM_PRINTQUALITY, DMRES_HIGH, PP_CHANGE_IT)), 0, "PrintQuality" End Sub Sub curve () If dc.curvecaps = CC_NONE Then list2.AddItem "CURVECAPS: None " Exit Sub Else list2.AddItem "CURVECAPS" End If If dc.curvecaps And CC_CIRCLES Then list2.AddItem " Circles: Yes" Else list2.AddItem " Circles: No" End If If dc.curvecaps And CC_PIE Then list2.AddItem " Pie: Yes" Else list2.AddItem " Pie: No" End If If dc.curvecaps And CC_CHORD Then list2.AddItem " Chord: Yes" Else list2.AddItem " Chord: No" End If If dc.curvecaps And CC_ELLIPSES Then list2.AddItem " Ellipses: Yes" Else list2.AddItem " Ellipses: No" End If If dc.curvecaps And CC_WIDE Then list2.AddItem " Wide: Yes" Else list2.AddItem " Wide: No" End If If dc.curvecaps And CC_STYLED Then list2.AddItem " Styled: Yes" Else list2.AddItem " Styled: No" End If If dc.curvecaps And CC_WIDESTYLED Then list2.AddItem " Widestyled: Yes" Else list2.AddItem " Widestyled: No" End If If dc.curvecaps And CC_INTERIORS Then list2.AddItem " Interiors: Yes" Else list2.AddItem " Interiors: No" End If If dc.curvecaps And CC_ROUNDRECT Then list2.AddItem " RoundRect: Yes" Else list2.AddItem " RoundRect: No" End If End Sub Sub Form_Load () getdefault End Sub Sub getdefault () defprinter$ = String$(255, 0) i = GetPrtr(defprinter$) If label8.Caption <> defprinter$ Then label8.Caption = defprinter$ list2.Clear End If End Sub Sub LINECAPS () If dc.LINECAPS = PC_NONE Then list2.AddItem "LINECAPS: None " Exit Sub Else list2.AddItem "LINECAPS" End If If dc.LINECAPS And LC_POLYLINE Then list2.AddItem " Polylines: Yes" Else list2.AddItem " Polylines: No" End If If dc.LINECAPS And LC_MARKER Then list2.AddItem " Markers: Yes" Else list2.AddItem " Markers: No" End If If dc.LINECAPS And LC_POLYMARKER Then list2.AddItem " PolyMarkers: Yes" Else list2.AddItem " PolyMarkers: No" End If If dc.LINECAPS And LC_WIDE Then list2.AddItem " Wide lines: Yes" Else list2.AddItem " Wide lines: No" End If If dc.LINECAPS And LC_STYLED Then list2.AddItem " Styled lines: Yes" Else list2.AddItem " Styled lines: No" End If If dc.LINECAPS And LC_WIDESTYLED Then list2.AddItem " Wide and styled lines: Yes" Else list2.AddItem " Wide and styled lines: No" End If If dc.LINECAPS And LC_INTERIORS Then list2.AddItem " Interiors: Yes" Else list2.AddItem " Interiors: No" End If End Sub Sub POLYGONAL () If dc.POLYGONALCAPS = PC_NONE Then list2.AddItem "POLYGONALCAPS: None " Exit Sub Else list2.AddItem "POLYGONALCAPS" End If If dc.POLYGONALCAPS And PC_POLYGON Then list2.AddItem " Alternate fill polygons: Yes" Else list2.AddItem " Alternate fill polygons: No" End If If dc.POLYGONALCAPS And PC_RECTANGLE Then list2.AddItem " Rectangle: Yes" Else list2.AddItem " Rectangle: No" End If If dc.POLYGONALCAPS And PC_WINDPOLYGON Then list2.AddItem " Winding number fill polygon: Yes" Else list2.AddItem " Winding number fill polygon: No" End If If dc.POLYGONALCAPS And PC_SCANLINE Then list2.AddItem " Scanlines: Yes" Else list2.AddItem " Scanlines: No" End If If dc.POLYGONALCAPS And PC_WIDE Then list2.AddItem " Wide borders: Yes" Else list2.AddItem " Wide borders: No" End If If dc.POLYGONALCAPS And PC_STYLED Then list2.AddItem " Styled borders: Yes" Else list2.AddItem " Styled borders: No" End If If dc.POLYGONALCAPS And PC_WIDESTYLED Then list2.AddItem " Wide and styled borders: Yes" Else list2.AddItem " Wide and styled borders: No" End If If dc.POLYGONALCAPS And PC_INTERIORS Then list2.AddItem " Interiors: Yes" Else list2.AddItem " Interiors: No" End If End Sub Sub raster () If dc.RASTERCAPS = RC_NONE Then list2.AddItem "RASTERCAPS: None " Exit Sub Else list2.AddItem "RASTERCAPS" End If If dc.RASTERCAPS And RC_BITBLT Then list2.AddItem " Capable of simple BitBlt: Yes" Else list2.AddItem " Capable of simple BitBlt: No" End If If dc.RASTERCAPS And RC_BANDING Then list2.AddItem " Requires banding support: Yes" Else list2.AddItem " Requires banding support: No" End If If dc.RASTERCAPS And RC_SCALING Then list2.AddItem " Requires scaling support: Yes" Else list2.AddItem " Requires scaling support: No" End If If dc.RASTERCAPS And RC_BITMAP64 Then list2.AddItem " Supports bitmaps >64K: Yes" Else list2.AddItem " Supports bitmaps >64K: No" End If If dc.RASTERCAPS And RC_GDI20_OUTPUT Then list2.AddItem " Has 2.0 output calls: Yes" Else list2.AddItem " Has Win 2.0 output calls: No" End If If dc.RASTERCAPS And RC_GDI20_STATE Then list2.AddItem " Includes state block in DC: Yes" Else list2.AddItem " Includes state block in DC: No" End If If dc.RASTERCAPS And RC_SAVEBITMAP Then list2.AddItem " Saves bitmaps locally: Yes" Else list2.AddItem " Saves bitmaps locally: No" End If If dc.RASTERCAPS And RC_DI_BITMAP Then list2.AddItem " Supports DIB to memory: Yes" Else list2.AddItem " Supports DIB to memory: No" End If If dc.RASTERCAPS And RC_PALETTE Then list2.AddItem " Supports a palette: Yes" Else list2.AddItem " Supports a palette: No" End If If dc.RASTERCAPS And RC_DIBTODEV Then list2.AddItem " Supports bitmap conversion: Yes" Else list2.AddItem " Supports bitmap conversion: No" End If If dc.RASTERCAPS And RC_BIGFONT Then list2.AddItem " Supports fonts >64K: Yes" Else list2.AddItem " Supports fonts >64K: No" End If If dc.RASTERCAPS And RC_STRETCHBLT Then list2.AddItem " Supports StretchBlt: Yes" Else list2.AddItem " Supports StretchBlt: No" End If If dc.RASTERCAPS And RC_FLOODFILL Then list2.AddItem " Supports FloodFill: Yes" Else list2.AddItem " Supports FloodFill: No" End If If dc.RASTERCAPS And RC_STRETCHDIB Then list2.AddItem " Supports StretchDIBits: Yes" Else list2.AddItem " Supports StretchDIBits: No" End If If dc.RASTERCAPS And RC_OP_DX_OUTPUT Then list2.AddItem " Supports opaque and DX array: Yes" Else list2.AddItem " Supports opaque and DX array: No" End If If dc.RASTERCAPS And RC_DEVBITS Then list2.AddItem " Supports device bitmaps: Yes" Else list2.AddItem " Supports device bitmaps: No" End If End Sub Function tech (i) Select Case i Case DT_PLOTTER tech = "Vector Plotter" Case DT_RASDISPLAY tech = "Raster Display" Case DT_RASPRINTER tech = "Raster printer" Case DT_RASCAMERA tech = "Raster Camera" Case DT_CHARSTREAM tech = "Character-stream PLP" Case DT_METAFILE tech = "Metafile, VDM" Case DT_DISPFILE tech = "Display-file" Case Else tech = "Unknown" End Select End Function Sub txt () If dc.TEXTCAPS = TC_NONE Then list2.AddItem "TEXTCAPS: None " Exit Sub Else list2.AddItem "TEXTCAPS" End If If dc.TEXTCAPS And TC_OP_CHARACTER Then list2.AddItem " Character output precision: Yes" Else list2.AddItem " Character output precision: No" End If If dc.TEXTCAPS And TC_OP_STROKE Then list2.AddItem " Stroke output precision: Yes" Else list2.AddItem " Stroke output precision: No" End If If dc.TEXTCAPS And TC_CP_STROKE Then list2.AddItem " Stroke clip precision: Yes" Else list2.AddItem " Stroke clip precision: No" End If If dc.TEXTCAPS And TC_CR_90 Then list2.AddItem " 90 degree character rotation: Yes" Else list2.AddItem " 90 degree character rotation: No" End If If dc.TEXTCAPS And TC_CR_ANY Then list2.AddItem " Any character rotation: Yes" Else list2.AddItem " Any character rotation: No" End If If dc.TEXTCAPS And TC_SF_X_YINDEP Then list2.AddItem " Scaling independent of x and y: Yes" Else list2.AddItem " Scaling independent of x and y: No" End If If dc.TEXTCAPS And TC_SA_DOUBLE Then list2.AddItem " Doubled character for scaling: Yes" Else list2.AddItem " Doubled character for scaling: No" End If If dc.TEXTCAPS And TC_SA_INTEGER Then list2.AddItem " Integer multiples for scaling: Yes" Else list2.AddItem " Integer multiples for scaling: No" End If If dc.TEXTCAPS And TC_IA_ABLE Then list2.AddItem " Italicizing: Yes" Else list2.AddItem " Italicizing: No" End If If dc.TEXTCAPS And TC_SA_CONTIN Then list2.AddItem " Any multiples for exact scaling: Yes" Else list2.AddItem " Any multiples for exact scaling: No" End If If dc.TEXTCAPS And TC_EA_DOUBLE Then list2.AddItem " Double-weight characters: Yes" Else list2.AddItem " Double-weight characters: No" End If If dc.TEXTCAPS And TC_UA_ABLE Then list2.AddItem " Underlining: Yes" Else list2.AddItem " Underlining: No" End If If dc.TEXTCAPS And TC_SO_ABLE Then list2.AddItem " Strikeouts: Yes" Else list2.AddItem " Strikeouts: No" End If If dc.TEXTCAPS And TC_RA_ABLE Then list2.AddItem " Raster fonts: Yes" Else list2.AddItem " Raster fonts: No" End If If dc.TEXTCAPS And TC_VA_ABLE Then list2.AddItem " Vertor fonts: Yes" Else list2.AddItem " Vertor fonts: No" End If End Sub