home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form frmDraw Caption = "Graphic Benchmarks" ClientHeight = 3270 ClientLeft = 1080 ClientTop = 2190 ClientWidth = 5160 Height = 3675 Left = 1020 LinkTopic = "Form1" ScaleHeight = 3270 ScaleWidth = 5160 Top = 1845 Width = 5280 Begin VB.CommandButton cmdExecute Caption = "Execute" Height = 375 Left = 120 TabIndex = 6 Top = 1860 Width = 1155 End Begin VB.PictureBox Picture1 Height = 3135 Left = 1500 ScaleHeight = 207 ScaleMode = 3 'Pixel ScaleWidth = 239 TabIndex = 5 Top = 60 Width = 3615 End Begin VB.CheckBox chkUseAPI Caption = "Use API" Height = 315 Left = 180 TabIndex = 4 Top = 1500 Width = 1095 End Begin VB.OptionButton optSelect Caption = "Polygons" Height = 315 Index = 3 Left = 180 TabIndex = 3 Top = 1140 Width = 1095 End Begin VB.OptionButton optSelect Caption = "Circles" Height = 315 Index = 2 Left = 180 TabIndex = 2 Top = 780 Width = 1095 End Begin VB.OptionButton optSelect Caption = "Squares" Height = 315 Index = 1 Left = 180 TabIndex = 1 Top = 420 Width = 1095 End Begin VB.OptionButton optSelect Caption = "Lines" Height = 315 Index = 0 Left = 180 TabIndex = 0 Top = 60 Value = -1 'True Width = 1095 End Begin VB.Label lblTicks Height = 255 Left = 120 TabIndex = 9 Top = 2880 Width = 1275 End Begin VB.Label lblKernel Height = 255 Left = 120 TabIndex = 8 Top = 2580 Width = 1275 End Begin VB.Label lblUser Height = 255 Left = 120 TabIndex = 7 Top = 2280 Width = 1275 End Attribute VB_Name = "frmDraw" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit ' copyright 1997 by Desaware Inc. All Rights Reserved Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long 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 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 Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Long, ByVal nCount As Long) As Long 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 Private Const NULL_BRUSH = 5 Private Type POINTAPI x As Long y As Long End Type Dim CurrentOption% Private Const LOOPS = 200 Dim bench As New dwBenchMark Dim starpoints(12) As Long Private Sub cmdExecute_Click() Dim rgt& Dim btm& Dim current& Dim loopcounter& Dim pt As POINTAPI Dim usedc& Dim oldbrush& Dim x& Picture1.Cls usedc = Picture1.hdc bench.SetReference For loopcounter = 1 To LOOPS Select Case CurrentOption Case 0 rgt = Picture1.ScaleWidth btm = Picture1.ScaleHeight If chkUseAPI Then For current = 0 To rgt ' You'll see good performance here, but if you ' used picture1.hdc as a parameter, it would be ' slower than the VB code! See chapter text Call MoveToEx(usedc, current&, 0, pt) Call LineTo(usedc, current, btm) Next current Else For current = 0 To rgt Picture1.Line (current, 0)-(current, btm) Next current End If Case 1 rgt = Picture1.ScaleWidth btm = Picture1.ScaleHeight If chkUseAPI Then oldbrush = SelectObject(usedc, GetStockObject(NULL_BRUSH)) For current = 0 To rgt Call Rectangle(usedc, 0, 0, current, current) Next current ' Restore the original brush Call SelectObject(usedc, oldbrush) Else For current = 0 To rgt Picture1.Line (0, 0)-(current, current), , B Next current End If Case 2 rgt = Picture1.ScaleWidth btm = Picture1.ScaleHeight If chkUseAPI Then oldbrush = SelectObject(usedc, GetStockObject(NULL_BRUSH)) For current = 0 To rgt Call Ellipse(usedc, -current, -current, current, current) ' Can perform the same task: ' Call Arc(usedc, -current, -current, current, current, 0, current, current, 0) Next current ' Restore the original brush Call SelectObject(usedc, oldbrush) Else For current = 0 To rgt Picture1.Circle (0, 0), current Next current End If Case 3 rgt = Picture1.ScaleWidth btm = Picture1.ScaleHeight If chkUseAPI Then oldbrush = SelectObject(usedc, GetStockObject(NULL_BRUSH)) For current = 1 To rgt \ 4 SetStarArray current Call Polygon(usedc, starpoints(0), 6) Next current ' Restore the original brush Call SelectObject(usedc, oldbrush) Else For current = 1 To rgt \ 4 SetStarArray current For x = 0 To 8 Step 2 Picture1.Line (starpoints(x), starpoints(x + 1))-(starpoints(x + 2), starpoints(x + 3)) Next x Next current End If End Select Picture1.Cls Next loopcounter bench.SetMark lblUser.Caption = "User: " & bench.GetuserDifferenceMS() lblKernel.Caption = "Krnl: " & bench.GetkernelDifferenceMS() lblTicks.Caption = "Tot: " & bench.GetTickDifference() End Sub Private Sub Form_Load() End Sub Private Sub optSelect_Click(Index As Integer) CurrentOption = Index End Sub ' Load a scaled star into the starpoints array Public Sub SetStarArray(size As Long) starpoints(0) = size * 2 starpoints(1) = 0 starpoints(2) = size starpoints(3) = size * 4 starpoints(4) = size * 4 starpoints(5) = size starpoints(6) = 0 starpoints(7) = size starpoints(8) = size * 3 starpoints(9) = size * 4 starpoints(10) = starpoints(0) starpoints(11) = starpoints(1) End Sub 
(.txt)