home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch19 / frmdraw.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  8.3 KB  |  227 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDraw 
  3.    Caption         =   "Graphic Benchmarks"
  4.    ClientHeight    =   3270
  5.    ClientLeft      =   1080
  6.    ClientTop       =   2190
  7.    ClientWidth     =   5160
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   3270
  11.    ScaleWidth      =   5160
  12.    Begin VB.CommandButton cmdExecute 
  13.       Caption         =   "Execute"
  14.       Height          =   375
  15.       Left            =   120
  16.       TabIndex        =   6
  17.       Top             =   1860
  18.       Width           =   1155
  19.    End
  20.    Begin VB.PictureBox Picture1 
  21.       Height          =   3135
  22.       Left            =   1500
  23.       ScaleHeight     =   207
  24.       ScaleMode       =   3  'Pixel
  25.       ScaleWidth      =   239
  26.       TabIndex        =   5
  27.       Top             =   60
  28.       Width           =   3615
  29.    End
  30.    Begin VB.CheckBox chkUseAPI 
  31.       Caption         =   "Use API"
  32.       Height          =   315
  33.       Left            =   180
  34.       TabIndex        =   4
  35.       Top             =   1500
  36.       Width           =   1095
  37.    End
  38.    Begin VB.OptionButton optSelect 
  39.       Caption         =   "Polygons"
  40.       Height          =   315
  41.       Index           =   3
  42.       Left            =   180
  43.       TabIndex        =   3
  44.       Top             =   1140
  45.       Width           =   1095
  46.    End
  47.    Begin VB.OptionButton optSelect 
  48.       Caption         =   "Circles"
  49.       Height          =   315
  50.       Index           =   2
  51.       Left            =   180
  52.       TabIndex        =   2
  53.       Top             =   780
  54.       Width           =   1095
  55.    End
  56.    Begin VB.OptionButton optSelect 
  57.       Caption         =   "Squares"
  58.       Height          =   315
  59.       Index           =   1
  60.       Left            =   180
  61.       TabIndex        =   1
  62.       Top             =   420
  63.       Width           =   1095
  64.    End
  65.    Begin VB.OptionButton optSelect 
  66.       Caption         =   "Lines"
  67.       Height          =   315
  68.       Index           =   0
  69.       Left            =   180
  70.       TabIndex        =   0
  71.       Top             =   60
  72.       Value           =   -1  'True
  73.       Width           =   1095
  74.    End
  75.    Begin VB.Label lblTicks 
  76.       Height          =   255
  77.       Left            =   120
  78.       TabIndex        =   9
  79.       Top             =   2880
  80.       Width           =   1275
  81.    End
  82.    Begin VB.Label lblKernel 
  83.       Height          =   255
  84.       Left            =   120
  85.       TabIndex        =   8
  86.       Top             =   2580
  87.       Width           =   1275
  88.    End
  89.    Begin VB.Label lblUser 
  90.       Height          =   255
  91.       Left            =   120
  92.       TabIndex        =   7
  93.       Top             =   2280
  94.       Width           =   1275
  95.    End
  96. Attribute VB_Name = "frmDraw"
  97. Attribute VB_GlobalNameSpace = False
  98. Attribute VB_Creatable = False
  99. Attribute VB_PredeclaredId = True
  100. Attribute VB_Exposed = False
  101. Option Explicit
  102. ' Copyright (c) 1995-1997 by Desaware.
  103. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
  104. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  105. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  106. Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  107. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  108. Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
  109. Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Long, ByVal nCount As Long) As Long
  110. Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  111. Private Const NULL_BRUSH = 5
  112. Private Type POINTAPI
  113.         x As Long
  114.         y As Long
  115. End Type
  116. Dim CurrentOption%
  117. Private Const LOOPS = 200
  118. Dim bench As New dwBenchMark
  119. Dim starpoints(12) As Long
  120. Private Sub cmdExecute_Click()
  121.     Dim rgt&
  122.     Dim btm&
  123.     Dim current&
  124.     Dim loopcounter&
  125.     Dim pt As POINTAPI
  126.     Dim usedc&
  127.     Dim oldbrush&
  128.     Dim x&
  129.     Picture1.Cls
  130.     usedc = Picture1.hdc
  131.     bench.SetReference
  132.     For loopcounter = 1 To LOOPS
  133.         Select Case CurrentOption
  134.             Case 0
  135.                 rgt = Picture1.ScaleWidth
  136.                 btm = Picture1.ScaleHeight
  137.                 If chkUseAPI Then
  138.                     For current = 0 To rgt
  139.                         ' You'll see good performance here, but if you
  140.                         ' used picture1.hdc as a parameter, it would be
  141.                         ' slower than the VB code!  See chapter text
  142.                         Call MoveToEx(usedc, current&, 0, pt)
  143.                         Call LineTo(usedc, current, btm)
  144.                     Next current
  145.                 Else
  146.                     For current = 0 To rgt
  147.                         Picture1.Line (current, 0)-(current, btm)
  148.                     Next current
  149.                 End If
  150.             Case 1
  151.                 rgt = Picture1.ScaleWidth
  152.                 btm = Picture1.ScaleHeight
  153.                 If chkUseAPI Then
  154.                     oldbrush = SelectObject(usedc, GetStockObject(NULL_BRUSH))
  155.                     For current = 0 To rgt
  156.                         Call Rectangle(usedc, 0, 0, current, current)
  157.                     Next current
  158.                     ' Restore the original brush
  159.                     Call SelectObject(usedc, oldbrush)
  160.                 Else
  161.                     For current = 0 To rgt
  162.                         Picture1.Line (0, 0)-(current, current), , B
  163.                     Next current
  164.                 End If
  165.             Case 2
  166.                 rgt = Picture1.ScaleWidth
  167.                 btm = Picture1.ScaleHeight
  168.                 If chkUseAPI Then
  169.                     oldbrush = SelectObject(usedc, GetStockObject(NULL_BRUSH))
  170.                     For current = 0 To rgt
  171.                         Call Ellipse(usedc, -current, -current, current, current)
  172.                         ' Can perform the same task:
  173.                         ' Call Arc(usedc, -current, -current, current, current, 0, current, current, 0)
  174.                     Next current
  175.                     ' Restore the original brush
  176.                     Call SelectObject(usedc, oldbrush)
  177.                 Else
  178.                     For current = 0 To rgt
  179.                         Picture1.Circle (0, 0), current
  180.                     Next current
  181.                 End If
  182.             Case 3
  183.                 rgt = Picture1.ScaleWidth
  184.                 btm = Picture1.ScaleHeight
  185.                 If chkUseAPI Then
  186.                     oldbrush = SelectObject(usedc, GetStockObject(NULL_BRUSH))
  187.                     For current = 1 To rgt \ 4
  188.                         SetStarArray current
  189.                         Call Polygon(usedc, starpoints(0), 6)
  190.                     Next current
  191.                     ' Restore the original brush
  192.                     Call SelectObject(usedc, oldbrush)
  193.                 Else
  194.                     For current = 1 To rgt \ 4
  195.                         SetStarArray current
  196.                         For x = 0 To 8 Step 2
  197.                             Picture1.Line (starpoints(x), starpoints(x + 1))-(starpoints(x + 2), starpoints(x + 3))
  198.                         Next x
  199.                     Next current
  200.                 End If
  201.         End Select
  202.         Picture1.Cls
  203.     Next loopcounter
  204.     bench.SetMark
  205.     lblUser.Caption = "User: " & bench.GetuserDifferenceMS()
  206.     lblKernel.Caption = "Krnl: " & bench.GetkernelDifferenceMS()
  207.     lblTicks.Caption = "Tot: " & bench.GetTickDifference()
  208. End Sub
  209. Private Sub optSelect_Click(Index As Integer)
  210.     CurrentOption = Index
  211. End Sub
  212. ' Load a scaled star into the starpoints array
  213. Public Sub SetStarArray(size As Long)
  214.     starpoints(0) = size * 2
  215.     starpoints(1) = 0
  216.     starpoints(2) = size
  217.     starpoints(3) = size * 4
  218.     starpoints(4) = size * 4
  219.     starpoints(5) = size
  220.     starpoints(6) = 0
  221.     starpoints(7) = size
  222.     starpoints(8) = size * 3
  223.     starpoints(9) = size * 4
  224.     starpoints(10) = starpoints(0)
  225.     starpoints(11) = starpoints(1)
  226. End Sub
  227.