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/vbpg32/samples5/ch05/btnplay.frm

Visual Basic Form | 1997-02-16 | 15.6 KB | 467 lines

VERSION 5.00
Begin VB.Form frmButtonPlay
   Caption         =   "Button Play"
   ClientHeight    =   5295
   ClientLeft      =   1065
   ClientTop       =   1545
   ClientWidth     =   5640
   Icon            =   "btnplay.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5295
   ScaleWidth      =   5640
   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"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         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_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Copyright
 1997 Desaware Inc. All Rights Reserved
Option Explicit
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 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)
    Else
        'Remove the bit
        dl& = SetWindowLong&(cmdTest.hwnd, GWL_STYLE, GetWindowLong&(cmdTest.hwnd, _
            GWL_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)
    Else
        dl& = SetWindowLong&(cmdTest.hwnd, GWL_STYLE, GetWindowLong&(cmdTest.hwnd, _
            GWL_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)
    Else
        dl& = SetWindowLong&(cmdTest.hwnd, GWL_STYLE, GetWindowLong&(cmdTest.hwnd, _
            GWL_STYLE) And Not BS_LEFTTEXT)
    End If
    cmdTest.Refresh
End Sub
Private Sub Form_Load()
    fAlignment& = BS_CENTER
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)
    Case 1: ' Left
        fAlignment& = BS_LEFT
        tmpValue& = GetWindowLong&(cmdTest.hwnd, GWL_STYLE) And Not BS_RIGHT
    Case 2: 'Right
        fAlignment& = BS_RIGHT
        tmpValue& = GetWindowLong&(cmdTest.hwnd, GWL_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&)
    '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)
    Case 1: ' Top
        fAlignment& = BS_TOP
        tmpValue& = GetWindowLong&(cmdTest.hwnd, GWL_STYLE) And Not BS_BOTTOM
    Case 2: 'Bottom
        fAlignment& = BS_BOTTOM
        tmpValue& = GetWindowLong&(cmdTest.hwnd, GWL_STYLE) And Not BS_TOP
    End Select
    dl& = SetWindowLong&(cmdTest.hwnd, GWL_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)
    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&)
    cmdTest.Refresh
End Sub