-
Jul 12th, 2020, 02:00 AM
#1
Thread Starter
Frenzied Member
Programmatically adding and using buttons on a VB form.
Put this code in Form1, and make sure to set the form's AutoRedraw property to True (you won't want printed text disappearing permanently if it's below the form and you just need to resize it).
Code:
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_CHILD As Long = &H40000000
Public IsRunning As Boolean
Private Sub Form_Load()
'set the BUTTON window class function
hButton = CreateWindowEx(0, "BUTTON", "", 0, 0, 0, 0, 0, 0, 0, 0, ByVal 0&)
OldWndProc = SetClassLong(hButton, GCL_WNDPROC, AddressOf WndProc)
DestroyWindow hButton
'create buttons
hButton = CreateWindowEx(0, "BUTTON", "Test Button 1", WS_VISIBLE Or WS_CHILD, 50, 20, 120, 30, hWnd, 0, 0, ByVal 0&)
hButton2 = CreateWindowEx(0, "BUTTON", "Test Button 2", WS_VISIBLE Or WS_CHILD, 50, 20 + 30, 120, 30, hWnd, 0, 0, ByVal 0&)
'make sure the button class function knows the program is running
IsRunning = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'make sure the button class function knows the program is not running
IsRunning = False
'restore original BUTTON window class function
SetClassLong hButton, GCL_WNDPROC, OldWndProc
'remove buttons
DestroyWindow hButton
DestroyWindow hButton2
End Sub
Put this code in Module1.
Code:
Public Declare Function SetClassLong Lib "user32.dll" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GCL_WNDPROC As Long = -24
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONDBLCLK As Long = &H203
Public Const WM_LBUTTONUP As Long = &H202
Public OldWndProc As Long
Public hButton As Long
Public hButton2 As Long
'function to handle all button messages
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Form1.IsRunning Then
'If (uMsg = WM_LBUTTONDOWN) Or (uMsg = WM_LBUTTONDBLCLK) Then ButtonClick hWnd
If uMsg = WM_LBUTTONUP Then ButtonClick hWnd
End If
WndProc = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)
End Function
'function to handle all button clicks
Private Sub ButtonClick(ByVal hWnd As Long)
Select Case hWnd
Case hButton
Button1Clicked
Case hButton2
Button2Clicked
End Select
End Sub
'click handler for button 1
Private Sub Button1Clicked()
Form1.Print "123"
End Sub
'click handler for button 2
Private Sub Button2Clicked()
Form1.Print "ABC"
End Sub
When the program is run, two buttons will appear on the form. If you click the one called Test Button 1, it will print "123" on Form1. If you click the button called Test Button 2, it will print "ABC" on Form1.
Each button will respond after releasing it from a click. If you want it to respond at the instant it's clicked, instead of waiting to be released, comment out the line of code:
Code:
If uMsg = WM_LBUTTONUP Then ButtonClick hWnd
and uncomment out the line of code:
Code:
'If (uMsg = WM_LBUTTONDOWN) Or (uMsg = WM_LBUTTONDBLCLK) Then ButtonClick hWnd
-
Aug 21st, 2020, 05:15 AM
#2
Junior Member
Re: Programmatically adding and using buttons on a VB form.
Good example. But i modify it.
If you press the mouse button on a button, and then drag the pointer outside the button, then your code will also work, and this is not correct.
This code is more correct:
Code:
Option Explicit
Public Declare Function SetClassLong Lib "user32.dll" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GCL_WNDPROC As Long = -24
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONDBLCLK As Long = &H203
Public Const WM_LBUTTONUP As Long = &H202
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public OldWndProc As Long
Public hButton As Long
Public hButton2 As Long
Private RetVal As Long
Private bRECT As RECT
Private mPoint As POINTAPI
'function to handle all button messages
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Form1.IsRunning Then
'If (uMsg = WM_LBUTTONDOWN) Or (uMsg = WM_LBUTTONDBLCLK) Then ButtonClick hWnd
If uMsg = WM_LBUTTONUP Then
RetVal = GetCursorPos(mPoint)
RetVal = GetWindowRect(hWnd, bRECT)
If RectContainsPoint(bRECT, mPoint) = True Then ButtonClick hWnd
End If
End If
WndProc = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, lParam)
End Function
'function to handle all button clicks
Private Sub ButtonClick(ByVal hWnd As Long)
Select Case hWnd
Case hButton
Button1Clicked
Case hButton2
Button2Clicked
End Select
End Sub
'click handler for button 1
Private Sub Button1Clicked()
Form1.Print "123"
End Sub
'click handler for button 2
Private Sub Button2Clicked()
Form1.Print "ABC"
End Sub
Private Function RectContainsPoint(ByRef RectStruct As RECT, ByRef PointStruct As POINTAPI) As Boolean
With RectStruct
RectContainsPoint = IIf(PointStruct.X < .Left Or _
PointStruct.X > .Right Or _
PointStruct.Y < .Top Or _
PointStruct.Y > .Bottom, False, True)
End With
End Function
-
Aug 21st, 2020, 05:23 AM
#3
Junior Member
Re: Programmatically adding and using buttons on a VB form.
You can also add a keyboard handler (by the space bar). For example, I like to press the button in focus, with the space bar.
-
Aug 21st, 2020, 02:14 PM
#4
Re: Programmatically adding and using buttons on a VB form.
Ummm, why not:
Code:
Dim WithEvents Button As VB.CommandButton
...
Set Button = Me.Controls.Add("VB.CommandButton", "Command1")
With Button
.Visible = True: Enabled = True
.Caption = "Ok"
... modify other properties and position/size
End With
no subclassing, you get all the properties of VB buttons, like Cancel, Default, TabIndex, TabStop, events and more. For example:
Code:
Private Sub Button_Click()
MsgBox "Clicked"
End Sub
-
Aug 21st, 2020, 02:42 PM
#5
Re: Programmatically adding and using buttons on a VB form.
Beside LaVolpe's good point the SetClassLong API is certainly not good for subclassing due it effects other buttons that are created "between" your Form_Load and Form_Unload. Consider using SetWindowLong (GWL_WNDPROC).
-
Aug 22nd, 2020, 11:25 AM
#6
Re: Programmatically adding and using buttons on a VB form.
Originally Posted by LaVolpe
Ummm, why not:
Code:
Dim WithEvents Button As VB.CommandButton
...
Set Button = Me.Controls.Add("VB.CommandButton", "Command1")
With Button
.Visible = True: Enabled = True
.Caption = "Ok"
... modify other properties and position/size
End With
no subclassing, you get all the properties of VB buttons, like Cancel, Default, TabIndex, TabStop, events and more. For example:
Code:
Private Sub Button_Click()
MsgBox "Clicked"
End Sub
I thought about suggesting that too, but didn't have the heart.
It'd sure be nice if the Me.Controls.Add method had a way to start control arrays, but there are other work-arounds for that.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|