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/classlib/classact/btnplay.frm

Visual Basic Form | 1996-01-25 | 16.8 KB | 486 lines

VERSION 4.00
Begin VB.Form frmButtonPlay
   Caption         =   "Button Play"
   ClientHeight    =   5295
   ClientLeft      =   1065
   ClientTop       =   1545
   ClientWidth     =   5640
   Height          =   5700
   Icon            =   "btnplay.frx":0000
   Left            =   1005
   LinkTopic       =   "Form1"
   ScaleHeight     =   5295
   ScaleWidth      =   5640
   Top             =   1200
   Width           =   5760
   Begin VB.Frame zfGroup
      Caption         =   "Button Type:"
      Height          =   2475
      Index           =   2
      Left            =   60
      TabIndex        =   13
      Top             =   2700
      Width           =   4755
      Begin VB.OptionButton optType
         Caption         =   "Icon"
         Height          =   195
         Index           =   5
         Left            =   2040
         TabIndex        =   22
         Top             =   240
         Width           =   1575
      End
      Begin VB.OptionButton optType
         Caption         =   "Group Box"
         Height          =   195
         Index           =   4
         Left            =   120
         TabIndex        =   21
         Top             =   1200
         Width           =   1575
      End
      Begin VB.CheckBox chkTxtLeft
         Caption         =   "Text On Left"
         Height          =   255
         Left            =   120
         TabIndex        =   20
         Top             =   2100
         Width           =   1575
      End
      Begin VB.CheckBox chkPushLike
         Caption         =   "Push-Like"
         Height          =   255
         Left            =   120
         TabIndex        =   19
         Top             =   1800
         Width           =   1275
      End
      Begin VB.CheckBox chkSize
         Caption         =   "Small  Size  (Checkbox /Option Button)"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   1500
         Width           =   3075
      End
      Begin VB.OptionButton optType
         Caption         =   "3-State Button"
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   17
         Top             =   960
         Width           =   1575
      End
      Begin VB.OptionButton optType
         Caption         =   "CheckBox"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   16
         Top             =   720
         Width           =   1575
      End
      Begin VB.OptionButton optType
         Caption         =   "Option Button"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   15
         Top             =   480
         Width           =   1575
      End
      Begin VB.OptionButton optType
         Caption         =   "Command Button"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   14
         Top             =   240
         Value           =   -1  'True
         Width           =   1575
      End
      Begin VB.Line zSep
         BorderColor     =   &H00FFFFFF&
         Index           =   5
         X1              =   0
         X2              =   4740
         Y1              =   1455
         Y2              =   1455
      End
      Begin VB.Line zSep
         BorderColor     =   &H00808080&
         Index           =   4
         X1              =   0
         X2              =   4740
         Y1              =   1440
         Y2              =   1440
      End
   End
   Begin VB.Frame zfGroup
      Caption         =   "Text Value:"
      Height          =   795
      Index           =   1
      Left            =   60
      TabIndex        =   10
      Top             =   1860
      Width           =   2955
      Begin VB.CheckBox chkMline
         Caption         =   "Multi-Line Button"
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   480
         Value           =   1  'Checked
         Width           =   1815
      End
      Begin VB.CheckBox chkLong
         Caption         =   "Long Text"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   180
         Width           =   1815
      End
   End
   Begin VB.CommandButton cmdTest
      Caption         =   "Test Button"
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   400
         size            =   9.75
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   3900
      TabIndex        =   1
      Top             =   480
      Width           =   1575
   End
   Begin VB.Frame zfGroup
      Caption         =   "Text Alingment:"
      Height          =   1575
      Index           =   0
      Left            =   60
      TabIndex        =   0
      Top             =   180
      Width           =   2955
      Begin VB.PictureBox zGroup
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   615
         Index           =   0
         Left            =   60
         ScaleHeight     =   615
         ScaleWidth      =   2535
         TabIndex        =   5
         Top             =   900
         Width           =   2535
         Begin VB.OptionButton optTB
            Caption         =   "Center"
            Height          =   255
            Index           =   0
            Left            =   1020
            TabIndex        =   9
            Top             =   120
            Value           =   -1  'True
            Width           =   795
         End
         Begin VB.OptionButton optTB
            Caption         =   "Bottom"
            Height          =   255
            Index           =   2
            Left            =   0
            TabIndex        =   7
            Top             =   300
            Width           =   975
         End
         Begin VB.OptionButton optTB
            Caption         =   "Top"
            Height          =   255
            Index           =   1
            Left            =   0
            TabIndex        =   6
            Top             =   0
            Width           =   795
         End
      End
      Begin VB.PictureBox zGroup
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   555
         Index           =   1
         Left            =   60
         ScaleHeight     =   555
         ScaleWidth      =   2655
         TabIndex        =   2
         Top             =   240
         Width           =   2655
         Begin VB.OptionButton optLR
            Caption         =   "Center"
            Height          =   255
            Index           =   0
            Left            =   1020
            TabIndex        =   8
            Top             =   120
            Value           =   -1  'True
            Width           =   795
         End
         Begin VB.OptionButton optLR
            Caption         =   "Right"
            Height          =   255
            Index           =   2
            Left            =   0
            TabIndex        =   4
            Top             =   300
            Width           =   855
         End
         Begin VB.OptionButton optLR
            Caption         =   "Left"
            Height          =   255
            Index           =   1
            Left            =   0
            TabIndex        =   3
            Top             =   0
            Width           =   855
         End
      End
      Begin VB.Line zSep
         BorderColor     =   &H00FFFFFF&
         Index           =   3
         X1              =   0
         X2              =   2940
         Y1              =   855
         Y2              =   855
      End
      Begin VB.Line zSep
         BorderColor     =   &H00808080&
         Index           =   2
         X1              =   0
         X2              =   2940
         Y1              =   840
         Y2              =   840
      End
   End
Attribute VB_Name = "frmButtonPlay"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim dl&
Dim fAlignment&
'**********************************
'**  Constant Definitions:
#If Win32 Then
Private Const BS_NULL& = 1
Private Const BS_BOTTOM& = &H800&
Private Const BS_BITMAP& = &H80&
Private Const BS_AUTORADIOBUTTON& = &H9&
Private Const BS_AUTOCHECKBOX& = &H3&
Private Const BS_AUTO3STATE& = &H6&
Private Const BS_3STATE& = &H5&
Private Const BS_CENTER& = &H300&
Private Const BS_CHECKBOX& = &H2&
Private Const BS_DEFPUSHBUTTON& = &H1&
Private Const BS_DIBPATTERN& = 5
Private Const BS_DIBPATTERN8X8& = 8
Private Const BS_DIBPATTERNPT& = 6
Private Const BS_FLAT& = &H8000&
Private Const BS_ICON& = &H40&
Private Const BS_HOLLOW& = BS_NULL
Private Const BS_HATCHED& = 2
Private Const BS_GROUPBOX& = &H7&
Private Const BS_INDEXED& = 4
Private Const BS_LEFT& = &H100&
Private Const BS_LEFTTEXT& = &H20&
Private Const BS_MULTILINE& = &H2000&
Private Const BS_NOTIFY& = &H4000&
Private Const BS_OWNERDRAW& = &HB&
Private Const BS_PATTERN& = 3
Private Const BS_PATTERN8X8& = 7
Private Const BS_PUSHBUTTON& = &H0&
Private Const BS_PUSHLIKE& = &H1000&
Private Const BS_RADIOBUTTON& = &H4&
Private Const BS_RIGHT& = &H200&
Private Const BS_RIGHTBUTTON& = &H20&
Private Const BS_SOLID& = 0
Private Const BS_TEXT& = 0&
Private Const BS_TOP& = &H400&
Private Const BS_USERBUTTON& = &H8&
Private Const BS_VCENTER& = &HC00&
Private Const GWL_EXSTYLE& = (-20)
Private Const GWL_HINSTANCE& = (-6)
Private Const GWL_HWNDPARENT& = (-8)
Private Const GWL_ID& = (-12)
Private Const GWL_STYLE& = (-16)
Private Const GWL_USERDATA& = (-21)
Private Const GWL_WNDPROC& = (-4)
#End If 'WIN32
'**********************************
'**  Function Declarations:
#If Win32 Then
'Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long)
'Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
#End If 'WIN32
'**********************************
'**  Constant Definitions:
#If Win32 Then
Private Const BM_GETCHECK& = &HF0
Private Const BM_SETCHECK& = &HF1
Private Const BM_GETSTATE& = &HF2
Private Const BM_SETSTATE& = &HF3
Private Const BM_SETSTYLE& = &HF4
Private Const BM_GETIMAGE& = &HF6
Private Const BM_SETIMAGE& = &HF7
#End If 'WIN32
'**********************************
'**  Function Declarations:
#If Win32 Then
'Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
#End If 'WIN32
Private m_wndButton As foWindow
Private Sub chkLong_Click()
    If chkLong = 1 Then 'Checked
        cmdTest.Caption = "This is a test button"
    Else
        cmdTest.Caption = "Test Button"
    End If
    cmdTest.Refresh
End Sub
Private Sub chkMline_Click()
    If chkMline = 1 Then
        'Add the bit
        ' dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, GetWindowLong&(cmdTest.hWnd, _
        '    GWL_STYLE) Or BS_MULTILINE)
        m_wndButton.Style = (m_wndButton.Style Or BS_MULTILINE)
    Else
        'Remove the bit
        ' dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, GetWindowLong&(cmdTest.hWnd, _
        '    GWL_STYLE) And Not BS_MULTILINE)
        m_wndButton.Style = (m_wndButton.Style And Not BS_MULTILINE)
    End If
    'Repaint the control
    cmdTest.Refresh

End Sub
Private Sub chkPushLike_Click()
    If chkPushLike = 1 Then
        'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, GetWindowLong&(cmdTest.hWnd, _
        '    GWL_STYLE) Or BS_PUSHLIKE)
        m_wndButton.Style = (m_wndButton.Style Or BS_PUSHLIKE)
    Else
        'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, GetWindowLong&(cmdTest.hWnd, _
        '    GWL_STYLE) And Not BS_PUSHLIKE)
        m_wndButton.Style = (m_wndButton.Style And Not BS_PUSHLIKE)
    End If
    cmdTest.Refresh
End Sub
Private Sub chkSize_Click()
    If chkSize = 1 Then
        cmdTest.Height = 315  'Small button size (only one line of text high)
    Else
        cmdTest.Height = 615 ' Regular button size
    End If
End Sub
Private Sub chkTxtLeft_Click()
    If chkTxtLeft = 1 Then
        'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, GetWindowLong&(cmdTest.hWnd, _
        '    GWL_STYLE) Or BS_LEFTTEXT)
        m_wndButton.Style = (m_wndButton.Style Or BS_LEFTTEXT)
    Else
        'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, GetWindowLong&(cmdTest.hWnd, _
        '    GWL_STYLE) And Not BS_LEFTTEXT)
        m_wndButton.Style = (m_wndButton.Style And Not BS_LEFTTEXT)
    End If
    cmdTest.Refresh
End Sub
Private Sub Form_Load()
    fAlignment& = BS_CENTER
    Set m_wndButton = New foWindow
    m_wndButton.Attach cmdTest.hWnd
End Sub
Private Sub optLR_Click(Index As Integer)
    Dim tmpValue&
    Select Case Index
    Case 0: ' Center
        fAlignment& = BS_CENTER ' Set the flag

        'Get the current style and remove the LEFT and RIGHT bits from it
        'tmpValue& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not (BS_LEFT Or BS_RIGHT)
        tmpValue& = (m_wndButton.Style And Not (BS_LEFT Or BS_RIGHT))
    Case 1: ' Left
        fAlignment& = BS_LEFT
        'tmpValue& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not BS_RIGHT
        tmpValue& = (m_wndButton.Style And Not BS_RIGHT)
    Case 2: 'Right
        fAlignment& = BS_RIGHT
        'tmpValue& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not BS_LEFT
        tmpValue& = (m_wndButton.Style And Not BS_LEFT)
    End Select
    'Set the style and Add the fAlignment& bit in
    'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, tmpValue& Or fAlignment&)
    m_wndButton.Style = (tmpValue& Or fAlignment&)
    'Repaint the control
    cmdTest.Refresh
End Sub
' See the comments for optLR for explanation of this procedure
Private Sub optTB_Click(Index As Integer)
   Dim tmpValue&
    Select Case Index
    Case 0: ' Center
        fAlignment& = BS_CENTER
        'tmpValue& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not (BS_TOP Or BS_BOTTOM)
        tmpValue& = (m_wndButton.Style And Not (BS_TOP Or BS_BOTTOM))
    Case 1: ' Top
        fAlignment& = BS_TOP
        'tmpValue& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not BS_BOTTOM
        tmpValue& = (m_wndButton.Style And Not BS_BOTTOM)
    Case 2: 'Bottom
        fAlignment& = BS_BOTTOM
        'tmpValue& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not BS_TOP
        tmpValue& = (m_wndButton.Style And Not BS_TOP)
    End Select
    'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, tmpValue& Or fAlignment&)
    m_wndButton.Style = (tmpValue& Or fAlignment&)
    cmdTest.Refresh
End Sub
Private Sub optType_Click(Index As Integer)
    Dim tmpValue&, mskNoStyle&
    'Remove all the style bits from the button
    'mskNoStyle& = GetWindowLong&(cmdTest.hWnd, GWL_STYLE) And Not (BS_AUTOCHECKBOX Or _
    '                    BS_RADIOBUTTON Or BS_3STATE _
    '                    Or BS_GROUPBOX Or BS_ICON Or BS_PUSHBUTTON)
    mskNoStyle& = m_wndButton.Style And Not (BS_AUTOCHECKBOX Or _
                        BS_RADIOBUTTON Or BS_3STATE _
                        Or BS_GROUPBOX Or BS_ICON Or BS_PUSHBUTTON)
    Select Case Index
        Case 0: ' Pushbutton
            tmpValue& = BS_PUSHBUTTON

        Case 1: ' Option Button
            tmpValue& = BS_RADIOBUTTON

        Case 2: 'CheckBox
            tmpValue& = BS_AUTOCHECKBOX

        Case 3: '3-State
            tmpValue& = BS_3STATE

        Case 4: 'Groupbox
            tmpValue& = BS_GROUPBOX

        Case 5: 'ICON
            tmpValue& = BS_ICON

    End Select
    'Add the correct style bit to the button
    'dl& = SetWindowLong&(cmdTest.hWnd, GWL_STYLE, mskNoStyle& Or tmpValue&)
    m_wndButton.Style = (mskNoStyle& Or tmpValue&)
    cmdTest.Refresh
End Sub