vbAccelerator - Contents of code file: frmPatBrush.frmVERSION 5.00
Begin VB.Form frmPatBrush
BackColor = &H80000005&
Caption = "Pattern Brush Demonstration Project"
ClientHeight = 4320
ClientLeft = 3825
ClientTop = 2640
ClientWidth = 6795
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000F&
Icon = "frmPatBrush.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4320
ScaleWidth = 6795
Begin VB.CommandButton cmdClear
Caption = "&Clear"
Height = 375
Left = 5340
TabIndex = 3
Top = 1620
Width = 1395
End
Begin VB.CommandButton cmdFilled
Caption = "&Filled Rects"
Height = 375
Left = 5340
TabIndex = 2
Top = 960
Width = 1395
End
Begin VB.CommandButton cmdRectangles
Caption = "&Rectangles"
Height = 375
Left = 5340
TabIndex = 1
Top = 540
Width = 1395
End
Begin VB.CommandButton cmdLines
Caption = "&Lines"
Height = 375
Left = 5340
TabIndex = 0
Top = 120
Width = 1395
End
End
Attribute VB_Name = "frmPatBrush"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As
Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long)
As Long
Private m_cP As cDottedBrush
Private Sub cmdClear_Click()
Me.Cls
End Sub
Private Sub cmdFilled_Click()
Dim i As Long
Dim X1 As Long, Y1 As Long
Dim X2 As Long, Y2 As Long
Dim lT As Long, lElapse As Long
timeBeginPeriod 1
lT = timeGetTime
' Draw some filled rectss using cDottedBrush class
For i = 1 To 100
X1 = Rnd * Me.ScaleWidth \ Screen.TwipsPerPixelX
Y1 = Rnd * Me.ScaleHeight \ Screen.TwipsPerPixelY
X2 = Rnd * (X1 - Me.ScaleWidth \ Screen.TwipsPerPixelX)
Y2 = Rnd * (Y1 - Me.ScaleHeight \ Screen.TwipsPerPixelY)
m_cP.Rectangle Me.hdc, X1, Y1, X2, Y2, 1, , True
Next i
lElapse = timeGetTime - lT
timeEndPeriod 1
Debug.Print "Time:"; lElapse; "ms"
End Sub
Private Sub cmdLines_Click()
Dim i As Long
Dim X1 As Long
Dim Y1 As Long
Dim lT As Long, lElapse As Long
timeBeginPeriod 1
lT = timeGetTime
' Draw some lines using cDottedBrush class
For i = 1 To 100
X1 = Rnd * Me.ScaleWidth \ Screen.TwipsPerPixelX
Y1 = Rnd * Me.ScaleHeight \ Screen.TwipsPerPixelY
If (Rnd * 3) > 1 Then
' Horizontal
m_cP.DrawLine Me.hdc, X1, Y1, (Me.ScaleWidth \ Screen.TwipsPerPixelX -
X1) * Rnd, 1
Else
' Vertical
m_cP.DrawLine Me.hdc, X1, Y1, 1, (Me.ScaleHeight \
Screen.TwipsPerPixelY - Y1) * Rnd
End If
Next i
lElapse = timeGetTime - lT
timeEndPeriod 1
Debug.Print "Time:"; lElapse; "ms"
End Sub
Private Sub cmdRectangles_Click()
Dim i As Long
Dim X1 As Long, Y1 As Long
Dim X2 As Long, Y2 As Long
Dim lT As Long, lElapse As Long
timeBeginPeriod 1
lT = timeGetTime
' Draw some rectangles using cDottedBrush class
For i = 1 To 100
X1 = Rnd * Me.ScaleWidth \ Screen.TwipsPerPixelX
Y1 = Rnd * Me.ScaleHeight \ Screen.TwipsPerPixelY
X2 = Rnd * (X1 - Me.ScaleWidth \ Screen.TwipsPerPixelX)
Y2 = Rnd * (Y1 - Me.ScaleHeight \ Screen.TwipsPerPixelY)
m_cP.Rectangle Me.hdc, X1, Y1, X2, Y2, 1
Next i
lElapse = timeGetTime - lT
timeEndPeriod 1
Debug.Print "Time:"; lElapse; "ms"
End Sub
Private Sub Form_Load()
' Create the dotted brush object:
Set m_cP = New cDottedBrush
m_cP.Create
' Set the forecolour to the colour you want the
' brush to draw in:
Me.ForeColor = vbButtonShadow
End Sub
Private Sub Form_Resize()
Dim lL As Long
If Me.ScaleWidth > cmdLines.Width + 4 * Screen.TwipsPerPixelY Then
lL = Me.ScaleWidth - cmdLines.Width - 2 * Screen.TwipsPerPixelY
Else
lL = 2 * Screen.TwipsPerPixelY
End If
cmdClear.left = lL
cmdRectangles.left = lL
cmdLines.left = lL
cmdFilled.left = lL
End Sub
|
|