vbAccelerator - Contents of code file: frmTextureBrush.frm

VERSION 5.00
Begin VB.Form frmTextureBrush 
   BackColor       =   &H80000005&
   Caption         =   "Texture Brush Demonstration"
   ClientHeight    =   5340
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6555
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmTextureBrush.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5340
   ScaleWidth      =   6555
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox chkMoveOrigin 
      BackColor       =   &H80000005&
      Caption         =   "&Move Origin"
      Height          =   315
      Left            =   5040
      TabIndex        =   5
      Top             =   2040
      Width           =   1395
   End
   Begin VB.PictureBox picSample 
      AutoSize        =   -1  'True
      Height          =   2415
      Left            =   3300
      Picture         =   "frmTextureBrush.frx":1272
      ScaleHeight     =   2355
      ScaleWidth      =   4590
      TabIndex        =   4
      Top             =   3000
      Visible         =   0   'False
      Width           =   4650
   End
   Begin VB.CommandButton cmdLines 
      Caption         =   "&Lines"
      Height          =   375
      Left            =   5040
      TabIndex        =   3
      Top             =   60
      Width           =   1395
   End
   Begin VB.CommandButton cmdRectangles 
      Caption         =   "&Rectangles"
      Height          =   375
      Left            =   5040
      TabIndex        =   2
      Top             =   480
      Width           =   1395
   End
   Begin VB.CommandButton cmdFilled 
      Caption         =   "&Filled Rects"
      Height          =   375
      Left            =   5040
      TabIndex        =   1
      Top             =   900
      Width           =   1395
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "&Clear"
      Height          =   375
      Left            =   5040
      TabIndex        =   0
      Top             =   1560
      Width           =   1395
   End
End
Attribute VB_Name = "frmTextureBrush"
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 cTextureBrush

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)
      If (chkMoveOrigin.Value = Checked) Then
         m_cP.SetBrushOrigin Me.hdc, X1, Y1
      End If
      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 (chkMoveOrigin.Value = Checked) Then
         m_cP.SetBrushOrigin Me.hdc, X1, Y1
      End If
      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)
      If (chkMoveOrigin.Value = Checked) Then
         m_cP.SetBrushOrigin Me.hdc, X1, Y1
      End If
      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 cTextureBrush
   m_cP.CreateFromPicture picSample
   ' 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
   chkMoveOrigin.left = lL
End Sub