VB5 OwnerDraw Buttons (34K)
VB6 OwnerDraw Buttons (32K)
27 Jan 1999
First Posted
Subclassing Without The Crashes
vbAccelerator - Contents of code file: frmODButtonCheck.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmODButtonCheck
Caption = "Owner Draw Button Class Sample"
ClientHeight = 3780
ClientLeft = 3120
ClientTop = 2385
ClientWidth = 5940
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmODButtonCheck.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3780
ScaleWidth = 5940
Begin VB.Frame fraDrawStyle
Caption = "&Draw Style"
ClipControls = 0 'False
Height = 1035
Left = 2340
TabIndex = 16
Top = 2400
Width = 3315
Begin VB.OptionButton optStyle
Caption = "&Thin Borders"
Height = 255
Index = 0
Left = 120
TabIndex = 19
Top = 240
Width = 2595
End
Begin VB.OptionButton optStyle
Caption = "&Owner Draw"
Height = 255
Index = 1
Left = 120
TabIndex = 18
Top = 480
Width = 2355
End
Begin VB.OptionButton optStyle
Caption = "&Standard"
Height = 255
Index = 2
Left = 120
TabIndex = 17
Top = 720
Value = -1 'True
Width = 2415
End
End
Begin VB.CommandButton cmdPrint
Caption = "&Print"
Height = 435
Left = 120
Style = 1 'Graphical
TabIndex = 13
Top = 840
Width = 1155
End
Begin VB.PictureBox picDemo
AutoRedraw = -1 'True
Height = 1935
Left = 3060
Picture = "frmODButtonCheck.frx":1272
ScaleHeight = 1875
ScaleWidth = 1875
TabIndex = 12
Top = 3000
Visible = 0 'False
Width = 1935
End
Begin VB.CommandButton cmdStandard
Height = 195
Index = 0
Left = 120
Style = 1 'Graphical
TabIndex = 11
Top = 3000
Width = 195
End
Begin VB.CheckBox chkTest
Caption = "Check1"
Height = 495
Index = 2
Left = 3900
Style = 1 'Graphical
TabIndex = 6
Top = 1500
Width = 1275
End
Begin VB.CheckBox chkTest
Caption = "Check1"
Height = 495
Index = 1
Left = 3900
Style = 1 'Graphical
TabIndex = 5
Top = 960
Width = 1275
End
Begin VB.CheckBox chkTest
Caption = "Check1"
Height = 495
Index = 0
Left = 3900
Style = 1 'Graphical
TabIndex = 4
Top = 420
Width = 1275
End
Begin VB.OptionButton optButton
Caption = "Option1"
Height = 495
Index = 2
Left = 2340
Style = 1 'Graphical
TabIndex = 3
Top = 1500
Width = 1155
End
Begin VB.OptionButton optButton
Caption = "Option1"
Height = 495
Index = 1
Left = 2340
Style = 1 'Graphical
TabIndex = 2
Top = 960
Width = 1155
End
Begin VB.OptionButton optButton
Caption = "Option1"
Height = 495
Index = 0
Left = 2340
Style = 1 'Graphical
TabIndex = 1
Top = 420
Width = 1155
End
Begin VB.CommandButton cmdNormal
Caption = "&Save"
Height = 435
Left = 120
Style = 1 'Graphical
TabIndex = 0
Top = 360
Width = 1155
End
Begin VB.Label lblCheckInfo
BackStyle = 0 'Transparent
Height = 255
Left = 3900
TabIndex = 15
Top = 2100
Width = 1515
End
Begin VB.Label lblOptionInfo
BackStyle = 0 'Transparent
Height = 255
Left = 2340
TabIndex = 14
Top = 2040
Width = 1515
End
Begin VB.Label lblStandard
Caption = "Simple Standard Buttons:"
Height = 255
Left = 120
TabIndex = 10
Top = 2700
Width = 1935
End
Begin ComctlLib.ImageList ilsIcons
Left = 2340
Top = 3060
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 5
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmODButtonCheck.frx":1ACE
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmODButtonCheck.frx":1DE8
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmODButtonCheck.frx":2102
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmODButtonCheck.frx":241C
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmODButtonCheck.frx":2736
Key = ""
EndProperty
EndProperty
End
Begin VB.Label lblCheckButtons
BackStyle = 0 'Transparent
Caption = "Check Buttons:"
Height = 195
Left = 3960
TabIndex = 9
Top = 120
Width = 1395
End
Begin VB.Label lblOptionButtons
BackStyle = 0 'Transparent
Caption = "Option Buttons:"
Height = 195
Left = 2340
TabIndex = 8
Top = 120
Width = 1395
End
Begin VB.Label lblCommand
BackStyle = 0 'Transparent
Caption = "Command Button:"
Height = 195
Left = 120
TabIndex = 7
Top = 120
Width = 1875
End
End
Attribute VB_Name = "frmODButtonCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Implements IOwnerDrawButton
Private m_cODBtn As cOwnerDrawButton
Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long
Private Sub chkTest_Click(Index As Integer)
Dim sMsg As String
Dim i As Long
For i = 0 To 2
If (chkTest(i).Value = Checked) Then
sMsg = sMsg & i & ","
End If
Next
If (sMsg <> "") Then
sMsg = left$(sMsg, Len(sMsg) - 1) & " selected"
Else
sMsg = "None selected"
End If
lblCheckInfo.Caption = sMsg
End Sub
Private Sub cmdNormal_Click()
MsgBox "Clicked Save.", vbInformation
End Sub
Private Sub cmdPrint_Click()
MsgBox "Clicked Print.", vbInformation
End Sub
Private Sub cmdStandard_Click(Index As Integer)
MsgBox "Clicked Simple Standard Button Index " & Index, vbInformation
End Sub
Private Sub Form_Load()
Dim i As Long
Set m_cODBtn = New cOwnerDrawButton
m_cODBtn.Attach Me
For i = eodClose To eodSizeBox
If (i > eodClose) Then
Load cmdStandard(i - 1)
cmdStandard(i - 1).left = cmdStandard(i - 2).left + cmdStandard(i -
2).Width + Screen.TwipsPerPixelX
cmdStandard(i - 1).Visible = True
End If
m_cODBtn.SetStandardButtonStyle cmdStandard(i - 1), i
Next i
Set Me.Picture = picDemo.Picture
ilsIcons.ListImages(1).Draw 0, 0, 0
optButton_Click 0
chkTest_Click 0
End Sub
Private Function FindControl(ByVal lhWnd As Long, ByRef ctl As Control) As
Boolean
Dim i As Long
For i = 0 To 2
If lhWnd = chkTest(i).hwnd Then
Set ctl = chkTest(i)
FindControl = True
Exit Function
ElseIf lhWnd = optButton(i).hwnd Then
Set ctl = optButton(i)
FindControl = True
Exit Function
End If
Next i
End Function
Private Property Get IOwnerDrawButton_ButtonContainerhWnd() As Long
IOwnerDrawButton_ButtonContainerhWnd = Me.hwnd
End Property
Private Property Get IOwnerDrawButton_DoOwnerDraw(ByVal lhWnd As Long) As
Boolean
IOwnerDrawButton_DoOwnerDraw = True
End Property
Private Sub IOwnerDrawButton_DrawItem(ByVal lhWnd As Long, ByVal lHDC As Long,
ByRef lLeft As Long, ByRef lTop As Long, ByRef lRight As Long, ByRef lBottom
As Long, ByVal bPushed As Boolean, ByVal bChecked As Boolean, ByVal bEnabled
As Boolean, ByVal bInFocus As Boolean, ByRef bDoDefault As Boolean)
Dim ctl As Control
If (lhWnd = cmdNormal.hwnd) Then
InitCustomDrawButton ilsIcons.hImageList, 3, picDemo.hdc,
cmdNormal.Caption
DrawButton lhWnd, lHDC, lLeft, lTop, lRight, lBottom, bPushed, bEnabled,
bInFocus
ElseIf (lhWnd = cmdPrint.hwnd) Then
InitCustomDrawButton ilsIcons.hImageList, 1, picDemo.hdc, cmdPrint.Caption
DrawButton lhWnd, lHDC, lLeft, lTop, lRight, lBottom, bPushed, bEnabled,
bInFocus
Else
If (optStyle(1).Value) Then
If FindControl(lhWnd, ctl) Then
InitCustomDrawButton ilsIcons.hImageList, 2, picDemo.hdc,
ctl.Caption
DrawButton lhWnd, lHDC, lLeft, lTop, lRight, lBottom, bPushed Or
bChecked, bEnabled, bInFocus
Else
bDoDefault = True
End If
Else
bDoDefault = True
End If
End If
End Sub
Private Sub optButton_Click(Index As Integer)
lblOptionInfo.Caption = Index & " selected."
End Sub
Private Sub optStyle_Click(Index As Integer)
Dim i As Long
Select Case Index
Case 0
For i = 0 To 2
m_cODBtn.SetBorderStyle optButton(i), eodBorderThin
m_cODBtn.RedrawButton optButton(i)
m_cODBtn.SetBorderStyle chkTest(i), eodBorderThin
m_cODBtn.RedrawButton chkTest(i)
Next
Case 1
For i = 0 To 2
m_cODBtn.RedrawButton optButton(i)
m_cODBtn.RedrawButton chkTest(i)
Next i
Case 2
For i = 0 To 2
m_cODBtn.SetBorderStyle optButton(i), eodBorderThick
m_cODBtn.RedrawButton optButton(i)
m_cODBtn.SetBorderStyle chkTest(i), eodBorderThick
m_cODBtn.RedrawButton chkTest(i)
Next
End Select
End Sub
