Programming Tool Box/SIMS_2.iso/vb_code2/p_print/pprtrfrm.txt

Text File | 1994-07-07 | 16KB | 509 lines

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 error
    If i > 0 Then
       MsgBox Str$(i)
       Exit Sub
    End If
    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$)
    If i > 0 Then
       MsgBox "No Default Printer"
    End If

    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 i > 0 Then
       If i = 995 Then
          MsgBox "There is no default printer -- sample ended"
       Else
          MsgBox "An error occured communicating with the printer driver -- sample ended"
       End If
       End
    End If

    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