home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH3 / SRC / DEVINFO.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-01-09  |  10.7 KB  |  266 lines
  1. VERSION 4.00
  2. Begin VB.Form DevInfoForm 
  3.    Caption         =   "DevInfo"
  4.    ClientHeight    =   3630
  5.    ClientLeft      =   1320
  6.    ClientTop       =   1320
  7.    ClientWidth     =   5055
  8.    Height          =   4320
  9.    Left            =   1260
  10.    LinkTopic       =   "PalInfo"
  11.    ScaleHeight     =   242
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   337
  14.    Top             =   690
  15.    Width           =   5175
  16.    Begin VB.TextBox InfoText 
  17.       Height          =   3615
  18.       Left            =   0
  19.       MultiLine       =   -1  'True
  20.       ScrollBars      =   2  'Vertical
  21.       TabIndex        =   0
  22.       Top             =   0
  23.       Width           =   5055
  24.    End
  25.    Begin VB.Menu mnuFile 
  26.       Caption         =   "&File"
  27.       Begin VB.Menu mnuFileExit 
  28.          Caption         =   "E&xit"
  29.       End
  30.    End
  31. Attribute VB_Name = "DevInfoForm"
  32. Attribute VB_Creatable = False
  33. Attribute VB_Exposed = False
  34. Option Explicit
  35. Private Sub Form_Load()
  36. Dim txt As String
  37. Dim sys_pal_size As Integer
  38. Dim num_static As Integer
  39. Dim clrres As Integer
  40. Dim rascaps As Integer
  41. Dim curves As Integer
  42. Dim lines As Integer
  43. Dim poly As Integer
  44. Dim text As Integer
  45.     ' Get the device type.
  46.     txt = "This device is a "
  47.     Select Case GetDeviceCaps(hDC, TECHNOLOGY)
  48.         Case DT_PLOTTER
  49.             txt = txt & "vector plotter"
  50.         Case DT_RASDISPLAY
  51.             txt = txt & "raster display"
  52.         Case DT_RASPRINTER
  53.             txt = txt & "raster printer"
  54.         Case DT_RASCAMERA
  55.             txt = txt & "raster camera"
  56.         Case DT_CHARSTREAM
  57.             txt = txt & "character-stream, PLP"
  58.         Case DT_METAFILE
  59.             txt = txt & "metafile, VDM"
  60.         Case DT_DISPFILE
  61.             txt = txt & "display-file"
  62.     End Select
  63.     txt = txt & "." & vbCrLf
  64.     ' Get the display size in millimeters.
  65.     txt = txt & "The display is" & _
  66.         Str$(GetDeviceCaps(hDC, HORZSIZE)) & "x" & _
  67.         Format$(GetDeviceCaps(hDC, VERTSIZE))
  68.     ' Get the display size in pixels.
  69.     txt = txt & " millimeters or" & _
  70.         Str$(GetDeviceCaps(hDC, HORZRES)) & "x" & _
  71.         Format$(GetDeviceCaps(hDC, VERTRES)) & _
  72.         " pixels." & vbCrLf
  73.     ' Get logical pixels per inch.
  74.     txt = txt & "Horizontal pixels per inch:" & _
  75.         Str$(GetDeviceCaps(hDC, LOGPIXELSX)) & _
  76.         vbCrLf
  77.     txt = txt & "Vertical pixels per inch:" & _
  78.         Str$(GetDeviceCaps(hDC, LOGPIXELSY)) & _
  79.         vbCrLf
  80.         
  81.     ' Get color and tool information.
  82.     txt = txt & "Bits per pixel:" & _
  83.         Str$(GetDeviceCaps(hDC, BITSPIXEL)) & _
  84.         "." & vbCrLf
  85.     txt = txt & "Color planes:" & _
  86.         Str$(GetDeviceCaps(hDC, PLANES)) & _
  87.         "." & vbCrLf
  88.     txt = txt & "Device brushes:" & _
  89.         Str$(GetDeviceCaps(hDC, NUMBRUSHES)) & _
  90.         "." & vbCrLf
  91.     txt = txt & "Device colors:" & _
  92.         Str$(GetDeviceCaps(hDC, NUMCOLORS)) & _
  93.         "." & vbCrLf
  94.     txt = txt & "Device fonts:" & _
  95.         Str$(GetDeviceCaps(hDC, NUMFONTS)) & _
  96.         "." & vbCrLf
  97.     txt = txt & "Device markers:" & _
  98.         Str$(GetDeviceCaps(hDC, NUMMARKERS)) & _
  99.         "." & vbCrLf
  100.     txt = txt & "Device pens:" & _
  101.         Str$(GetDeviceCaps(hDC, NUMPENS)) & _
  102.         "." & vbCrLf
  103.     ' See if the screen supports palettes.
  104.     rascaps = GetDeviceCaps(hDC, RASTERCAPS)
  105.     If rascaps And RC_PALETTE Then
  106.         txt = txt & "This device supports palettes." & vbCrLf
  107.         
  108.         ' See how big the system palette is.
  109.         sys_pal_size = GetDeviceCaps(hDC, SIZEPALETTE)
  110.         txt = txt & "The system palette holds" & _
  111.             Str$(sys_pal_size) & " entries." & _
  112.             vbCrLf
  113.         
  114.         ' See how many static colors there are.
  115.         num_static = GetDeviceCaps(hDC, NUMRESERVED)
  116.         txt = txt & "There are" & Str$(num_static) & _
  117.             " static colors." & vbCrLf
  118.         
  119.         ' Give the indexes of the static colors.
  120.         txt = txt & "The static colors are in system palette entries: 0-" & _
  121.             Format$(num_static \ 2 - 1) & " and " & _
  122.             Format$(sys_pal_size - num_static \ 2) & _
  123.             "-" & Format$(sys_pal_size - 1) & _
  124.             "." & vbCrLf
  125.         ' Get the color resolution.
  126.         clrres = GetDeviceCaps(hDC, COLORRES)
  127.         txt = txt & "The color resolution is" & _
  128.             Str$(clrres) & " bits per pixel (" & _
  129.             Format$(2 ^ clrres) & _
  130.             " possible values)." & vbCrLf
  131.         ' Get RASTERCAPS values.
  132.         txt = txt & "This device supports the following raster features:" & _
  133.             vbCrLf
  134.         If rascaps And RC_BANDING Then _
  135.             txt = txt & "    Banding." & vbCrLf
  136.         If rascaps And RC_BIGFONT Then _
  137.             txt = txt & "    Fonts bigger than 64K." & vbCrLf
  138.         If rascaps And RC_BITBLT Then _
  139.             txt = txt & "    Bitmap transfer." & vbCrLf
  140.         If rascaps And RC_BITMAP64 Then _
  141.             txt = txt & "    Bitmaps bigger than 64K." & vbCrLf
  142.         If rascaps And RC_DI_BITMAP Then _
  143.             txt = txt & "    The SetDIBits and GetDIBits functions." & vbCrLf
  144.         If rascaps And RC_DIBTODEV Then _
  145.             txt = txt & "    The SetDIBitsToDevice function." & vbCrLf
  146.         If rascaps And RC_FLOODFILL Then _
  147.             txt = txt & "    Flood fills." & vbCrLf
  148.         If rascaps And RC_GDI20_OUTPUT Then _
  149.             txt = txt & "    Windows 2.0 features." & vbCrLf
  150.         If rascaps And RC_PALETTE Then _
  151.             txt = txt & "    Palettes." & vbCrLf
  152.         If rascaps And RC_SCALING Then _
  153.             txt = txt & "    Scaling." & vbCrLf
  154.         If rascaps And RC_STRETCHBLT Then _
  155.             txt = txt & "    The StretchBlt function." & vbCrLf
  156.         If rascaps And RC_STRETCHDIB Then _
  157.             txt = txt & "    The StretchDIBits function." & vbCrLf
  158.             
  159.         ' Get CURVECAPS values.
  160.         curves = GetDeviceCaps(hDC, CURVECAPS)
  161.         txt = txt & "This device supports the following curve features:" & _
  162.             vbCrLf
  163.         If curves And CC_CHORD Then _
  164.             txt = txt & "    Chords." & vbCrLf
  165.         If curves And CC_CIRCLES Then _
  166.             txt = txt & "    Circles." & vbCrLf
  167.         If curves And CC_ELLIPSES Then _
  168.             txt = txt & "    Ellipses." & vbCrLf
  169.         If curves And CC_INTERIORS Then _
  170.             txt = txt & "    Interiors." & vbCrLf
  171.         If curves And CC_PIE Then _
  172.             txt = txt & "    Pie slices." & vbCrLf
  173.         If curves And CC_STYLED Then _
  174.             txt = txt & "    Line styles." & vbCrLf
  175.         If curves And CC_WIDE Then _
  176.             txt = txt & "    Wide lines." & vbCrLf
  177.         If curves And CC_WIDESTYLED Then _
  178.             txt = txt & "    Wide styled lines." & vbCrLf
  179.         ' Get LINECAPS values.
  180.         lines = GetDeviceCaps(hDC, LINECAPS)
  181.         txt = txt & "This device supports the following line features:" & _
  182.             vbCrLf
  183.         If lines And LC_INTERIORS Then _
  184.             txt = txt & "    Interiors." & vbCrLf
  185.         If lines And LC_MARKER Then _
  186.             txt = txt & "    Markers." & vbCrLf
  187.         If lines And LC_POLYLINE Then _
  188.             txt = txt & "    Polyline." & vbCrLf
  189.         If lines And LC_POLYMARKER Then _
  190.             txt = txt & "    Polymarkers." & vbCrLf
  191.         If lines And LC_STYLED Then _
  192.             txt = txt & "    Styled lines." & vbCrLf
  193.         If lines And LC_WIDE Then _
  194.             txt = txt & "    Wide lines." & vbCrLf
  195.         If lines And LC_WIDESTYLED Then _
  196.             txt = txt & "    Wide styled lines." & vbCrLf
  197.         ' Get POLYGONALCAPS values.
  198.         poly = GetDeviceCaps(hDC, POLYGONALCAPS)
  199.         txt = txt & "This device supports the following polygon features:" & _
  200.             vbCrLf
  201.         If lines And PC_INTERIORS Then _
  202.             txt = txt & "    Interiors." & vbCrLf
  203.         If lines And PC_POLYGON Then _
  204.             txt = txt & "    Alternate filled polygons." & vbCrLf
  205.         If lines And PC_RECTANGLE Then _
  206.             txt = txt & "    Rectangles." & vbCrLf
  207.         If lines And PC_SCANLINE Then _
  208.             txt = txt & "    Scan lines." & vbCrLf
  209.         If lines And PC_STYLED Then _
  210.             txt = txt & "    Styled borders." & vbCrLf
  211.         If lines And PC_WIDE Then _
  212.             txt = txt & "    Wide borders." & vbCrLf
  213.         If lines And PC_WIDESTYLED Then _
  214.             txt = txt & "    Wide styled borders." & vbCrLf
  215.         If lines And PC_WINDPOLYGON Then _
  216.             txt = txt & "    Winding number filled polygons." & vbCrLf
  217.         ' Get TEXTCAPS values.
  218.         text = GetDeviceCaps(hDC, TEXTCAPS)
  219.         txt = txt & "This device supports the following text features:" & _
  220.             vbCrLf
  221.         If lines And TC_CP_STROKE Then _
  222.             txt = txt & "    Stroke clip precision." & vbCrLf
  223.         If lines And TC_CR_90 Then _
  224.             txt = txt & "    Characters rotated 90 degrees." & vbCrLf
  225.         If lines And TC_CR_ANY Then _
  226.             txt = txt & "    Characters rotated through any angle." & vbCrLf
  227.         If lines And TC_EA_DOUBLE Then _
  228.             txt = txt & "    Double weight fonts (bold)." & vbCrLf
  229.         If lines And TC_IA_ABLE Then _
  230.             txt = txt & "    Italics." & vbCrLf
  231.         If lines And TC_OP_CHARACTER Then _
  232.             txt = txt & "    Character output precision." & vbCrLf
  233.         If lines And TC_OP_STROKE Then _
  234.             txt = txt & "    Stroke output precision." & vbCrLf
  235.         If lines And TC_RA_ABLE Then _
  236.             txt = txt & "    Raster fonts." & vbCrLf
  237.         If lines And TC_SA_CONTIN Then _
  238.             txt = txt & "    Fonts scaled by any factor." & vbCrLf
  239.         If lines And TC_SA_DOUBLE Then _
  240.             txt = txt & "    Font scaled by a factor of 2." & vbCrLf
  241.         If lines And TC_SA_INTEGER Then _
  242.             txt = txt & "    Fonts scaled by integer multiples." & vbCrLf
  243.         If lines And TC_SF_X_YINDEP Then _
  244.             txt = txt & "    Fonts scaled in the X and Y directions independently." & vbCrLf
  245.         If lines And TC_SO_ABLE Then _
  246.             txt = txt & "    Strikeout." & vbCrLf
  247.         If lines And TC_UA_ABLE Then _
  248.             txt = txt & "    Underline." & vbCrLf
  249.         If lines And TC_VA_ABLE Then _
  250.             txt = txt & "    Vector fonts." & vbCrLf
  251.     Else
  252.         txt = txt & "This device does not support palettes." & vbCrLf
  253.     End If
  254.     InfoText.text = txt
  255. End Sub
  256. ' ***********************************************
  257. ' Make the text box as large as possible.
  258. ' ***********************************************
  259. Private Sub Form_Resize()
  260.     If WindowState = vbMinimized Then Exit Sub
  261.     InfoText.Move 0, 0, ScaleWidth, ScaleHeight
  262. End Sub
  263. Private Sub mnuFileExit_Click()
  264.     Unload Me
  265. End Sub
  266.