I am trying to create an InputBox for QB64 similar to that used in VB. I have a working prototype see file (mpg_input_box_1.bas) . I would like to trap characters entered into the edit control before they are displayed for example (enter key, valid characters etc) To intercept these characters and perform pre-processing it seems I require subclassing!
It all looked relatively easy however soon got stuck in the quick sand of coding. I added subclassing code to the above file, resulting file (mpg_input_box_1b.bas). This almost works, OK it fails.
If you comment lines 359,360 and 361 subclassing is disabled and the code works as mpg_input_box_1.bas, with the lines un-commented subclassing is enabled. The new SubEdit function gets called however with a return value of (SubEdit = 0) the edit control is not drawn. Comment (SubEdit = 0) and uncomment ( SubEdit = CallWindowProc(PreviousWinProc.......) fails with program stopped working.
If anyone can point me in the right direction to get subclassing working it would be most appreciated.
WIN.h
ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
}
void * GetWindowProc() {
return (void *) WindowProc;
}
mpg_input_box_1.bas
Option _Explicit
' A Simple Input box for QB64 32 & 64 bit
' mpg_input_box_1.bas
' MPG 12-8-2021
'===================================================================
' Displays an inputbox popup window. Gets a line of text from user.
'
'There are three InputBox function:
'InputBox("prompt, title) - Accepts any character input
'InputBoxN("prompt, title) - Only numeric characters allowed
'InputBoxP("prompt, title) - Password entry. Display asterisk
' for each character entered
'
'prompt - text displayed by the InputBox e.g. "Please enter a number:".
'title - text displayed in the title bar of the InputBox.
'
'Note: Cancel button returns a null string ("")
'
'----------------------------------------------------------------------
' Code based on ideas from the following references:
' 1) Windows buttons for 32 and 64 bit IDE
' https://www.qb64.org/forum/index.php?topic=3217.msg124966#msg124966
' 2) Base64 Encoding/Decoding with Windows, Mac, and Linux
' https://www.qb64.org/forum/index.php?topic=3214.msg124919#msg124919
' 3) Threading
' https://www.qb64.org/forum/index.php?topic=3865.msg132124#msg132124
'=======================================================================
'
'---------------------------------------------------------------
'NOTE:
'Create a new file WIN.h with the following content (Remove the comments '):
'---Start of file contents:---
'ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
'LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetWindowProc() {
' return (void *) WindowProc;
'}
'---End of file contents---
'Input box uses the WIN.h file to get the WindowProc. Note: Place above file in your working folder (The QB64 folder).
'----------------------------------------------------------------
'==Note: InputBox requires this section to be added to your program.=========
' Creates global variable ipb. Its corresponding elements are global.
Dim Shared ipb As input_box_udt ' InputBox user defined type
inputbox_init ' Define ipb structure and initialize elements
'=============================================================================
'===Your program START ==========
Screen _NewImage(400, 300, 32) 'Set main screen size
Color _RGB(0, 0, 0), _RGB32(205, 238, 205) ' Set colors
Cls
_Title "Main Program" ' Set your main program title
'Examples:
Print "===" + InputBox("Please enter some text:", "InputBox") + "==="
Print "===" + InputBoxN("Please enter port number:", "Port Number") + "==="
Print "===" + InputBoxP("Please enter password:", "Password Required") + "==="
Print "End"
End
System
'===Your program END ============
'######--INPUT BOX FUNCTIONS and SUBS--######################################
Function InputBox$ (prompt As String, title As String)
Const FALSE = 0
Const TRUE = Not FALSE
ipb.number = FALSE ' Disable numeric input
ipb.password = FALSE ' Disable password input
ipb.caption_text = title 'Pop-up window title
ipb.prompt_text = prompt 'Label text user instrutions
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBox = ipb_get_string 'Extract data from ipb.buf return string
End Function
Function InputBoxN$ (prompt As String, title As String)
Const FALSE = 0
Const TRUE = Not FALSE
ipb.number = TRUE ' Enable numeric input
ipb.password = FALSE ' Disable password input
ipb.caption_text = title ' Pop-up window title
ipb.prompt_text = prompt ' Label text user instrutions
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBoxN = ipb_get_string 'Extract data from ipb.buf return string
End Function
Function InputBoxP$ (prompt As String, title As String)
Const FALSE = 0
Const TRUE = Not FALSE
ipb.number = FALSE ' Disable numeric input
ipb.password = TRUE ' Enable password input
ipb.caption_text = title ' Pop-up window title
ipb.prompt_text = prompt ' Label text user instrutions
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBoxP = ipb_get_string 'Extract data from ipb.buf return string
End Function
'-- inputbox_init: Creates a user defined type and sets initial values.
Sub inputbox_init
Const FALSE = 0
Const TRUE = Not FALSE
Type input_box_udt
buf As String * 64 ' Buffer to store entered characters
hw As _Offset ' Pointer to inputbox window
hwLabel As _Offset ' Pointer to label
hwb0 As _Offset ' Pointer button 0 - OK
hwb1 As _Offset ' Pointer button 1 - Cancel
hwe As _Offset ' Pointer to single line edit control
number As Integer ' Edit control numbers only
password As Integer ' asterisk displayed
caption_text As String ' Window title
prompt_text As String ' Instruction to user
button0_text As String ' Left button
button1_text As String ' Right button
x As Long 'Position of input box
y As Long 'Position of input box
End Type
'Set default values
ipb.caption_text = "InputBox"
ipb.prompt_text = "Enter some text:"
ipb.button0_text = "OK"
ipb.button1_text = "Cancel"
ipb.number = FALSE
ipb.password = FALSE
'Center InputBox window
Dim As Long userwidth, userheight
userwidth = _DesktopWidth: userheight = _DesktopHeight 'get current screen resolution
ipb.x = (userwidth \ 2 - 358 \ 2) - 3
ipb.y = (userheight \ 2 - 136 \ 2) - 29
End Sub
Function ipb_get_string$ ()
Dim As String a
'Extract string from buf
a = _Trim$(ipb.buf) ' Remove spaces
a = Left$(a, InStr(a, Chr$(0)) - 1) ' Buffer contains a null terminated string. Find position of null,
ipb.buf = "" ' extract characters upto this null character. Clear buffer
ipb_get_string = a 'Return clean string
End Function
'===Main Sub ===========================
Sub ipb_UserInput
'--Constants
Const FALSE = 0
Const TRUE = Not FALSE
Const IDC_ARROW = &H7F00
Const COLOR_WINDOW = 5
Const WS_OVERLAPPED = 0
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_VISIBLE = &H10000000
Const WS_CHILD = &H40000000
Const WS_TABSTOP = &H00010000
Const WS_EX_CLIENTEDGE = &H00000200
Const BS_PUSHBUTTON = 0
Const CW_USEDEFAULT = &H80000000
Const SW_SHOWDEFAULT = &HA
Const ES_LEFT = 0
Const ES_NUMBER = &H2000
Const ES_PASSWORD = &H0020
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION
'Select style before control is created.
'No need to dynamically change. Controls are built every time they are used
Dim ipb_style As Long
ipb_style = 0
If ipb.password Then
ipb_style = ES_PASSWORD
End If
If ipb.number Then
ipb_style = ES_NUMBER
End If
'--Types
Type POINT
As Long x
As Long y
End Type
Type MSG
As _Offset hwnd
As _Unsigned Long message
As _Unsigned _Offset wParam 'unsigned pointer sized integer
As _Offset lParam ' pointer sized integer
As _Unsigned Long time
As POINT pt
End Type
Type WNDCLASSA
As _Unsigned Long style
$If 64BIT Then
As String * 4 padding
$End If
As _Offset lpfnWndProc
As Long cbClsExtra, cbWndExtra
As _Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName
End Type
'--Libaries
Declare Library "WIN"
Function GetWindowProc%& () 'Windows procedure
End Declare
Declare Dynamic Library "user32"
Function SendMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Function DefWindowProcA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Sub PostQuitMessage (ByVal nExitCode As Long)
Function LoadCursorW%& (ByVal hInstance As _Offset, Byval lpCursorName As _Offset)
Function RegisterClassA~% (ByVal lpWndClass As _Offset)
Function CreateWindowExA%& (ByVal dwExStyle As Long, Byval lpClassName As _Offset, Byval lpWindowName As _Offset, Byval dwStyle As Long, Byval X As Long, Byval Y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As _Offset, Byval hMenu As _Offset, Byval hInstance As _Offset, Byval lpParam As _Offset)
Function ShowWindow& (ByVal hWnd As _Offset, Byval nCmdShow As Long)
Function UpdateWindow& (ByVal hWnd As _Offset)
Function GetMessageA% (ByVal lpMsg As _Offset, Byval hWnd As _Offset, Byval wMsgFilterMin As _Unsigned Long, Byval wMsgFilterMax As _Unsigned Long)
Function TranslateMessage& (ByVal lpMsg As _Offset)
Function DispatchMessageA%& (ByVal lpmsg As _Offset)
Sub DestroyWindow (ByVal hWnd As _Offset)
Function PostMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Function SetFocus& (ByVal hWnd As _Offset)
End Declare
Declare Dynamic Library "kernel32"
Function GetModuleHandleW%& (ByVal lpModuleName%&)
Function GetLastError~& ()
End Declare
'--End Libaries
'--Variables
Static registered As Integer 'Variables initialized to 0 (false) hence not registered. Value retained between functtion calls
Dim hi As _Offset ' Handle to application instance
Dim wc As WNDCLASSA ' define wc as WNDCLASSEX structure
Dim msg As MSG
Dim discardb As Long ' Dummy variable
Dim discardp As _Offset 'Dummy variable
Dim t0 As String ' Type of control
Dim t1 As String ' Title or controls text
Dim MainClassName As String * 5
MainClassName = "main" + Chr$(0)
Dim CrLf As String * 2 ' define as 2 byte STRING
CrLf = Chr$(13) + Chr$(10) ' carriage return and line feed
Dim As String className ' Variable className stores name of our window class
className = "myWindowClass" + Chr$(0) ' Used in wc. which in turn is used to register window class with the system.
hi = GetModuleHandleW(0) 'Handle to application instance
'---Step 1: Registering the Window Class
'Fill out the members of WNDCLASSEX structure (wc) and call RegisterClassA
wc.style = 0 ' Class Styles (CS_*), not Window Styles (WS_*) This is usually be set to 0.
wc.lpfnWndProc = GetWindowProc ' Pointer to the window procedure for this window class. (see WIN.h)
wc.cbClsExtra = 0 ' Amount of extra data allocated for this class in memory. Usually 0.
wc.cbWndExtra = 0 ' Amount of extra data allocated in memory per window of this type. Usually 0.
wc.hInstance = hi ' Handle to application instance .
wc.hIcon = 0 ' Large (usually 32x32) icon shown when the user presses Alt+Tab. Set to 0
wc.hCursor = LoadCursorW(0, IDC_ARROW) ' Cursor that will be displayed over our window.
wc.hbrBackground = COLOR_WINDOW 'was +1 Background Brush to set the color of our window. '
wc.lpszMenuName = 0 ' Name of a menu resource to use for the windows with this class.
wc.lpszClassName = _Offset(className) ' Name to identify the class with.
If Not registered Then ' First time in funcion OK to register
If RegisterClassA(_Offset(wc)) = 0 Then
Print "RegisterClassA failed:"; GetLastError
End
End If
registered = TRUE ' Class was registered
End If
'--Step 2: Creating the Windows
'After registering the class, create a window with it using CreateWindowExA.
'Note: A visible un-owned window gets a taskbar button. To hide the inputbox window taskbar button
'make the inputbox owned by our main applicationusing using _WindowHandle instead of 0'
t1 = ipb.caption_text + Chr$(0) 'Window title
ipb.hw = CreateWindowExA(0, _Offset(className), _Offset(t1), WS_OVERLAPPEDWINDOW, ipb.x, ipb.y, 358, 130, _WindowHandle, 0, hi, 0): If 0 = ipb.hw Then System
'Controls are just child windows. They have a procedure, a class etc... that is registered by the system.
'Label
t0 = "STATIC" + Chr$(0) ' Window control is STATIC predefined class
t1 = ipb.prompt_text + Chr$(0) ' Label text
ipb.hwLabel = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD, 9, 5, 372, 16, ipb.hw, 0, hi, 0): If 0 = ipb.hwLabel Then System
'OK Button 0
t0 = "BUTTON" + Chr$(0) ' Window control is BUTTON predefined class
t1 = ipb.button0_text + Chr$(0)
ipb.hwb0 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 175, 65, 80, 23, ipb.hw, 0, hi, 0): If 0 = ipb.hwb0 Then System
'Cancel button 1
t1 = ipb.button1_text + Chr$(0)
ipb.hwb1 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 262, 65, 80, 23, ipb.hw, 0, hi, 0): If 0 = ipb.hwb1 Then System
'Edit control
t0 = "EDIT" + Chr$(0)
' t1 = "This is a edit control." + Chr$(0)
t1 = "" + Chr$(0)
ipb.hwe = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or ES_LEFT Or ipb_style, 12, 30, 330, 26, ipb.hw, 0, hi, 0): If 0 = ipb.hwe Then System
'Display and Update window to ensure it has properly redrawn itself on the screen.
discardb = SetFocus(ipb.hwe) ' and start typing
discardb = ShowWindow(ipb.hw, SW_SHOWDEFAULT)
discardb = UpdateWindow(ipb.hw)
'-- Step 3: The Message Loop
While GetMessageA(_Offset(msg), 0, 0, 0) > 0 ' gets a message from your application's message queue.
discardb = TranslateMessage(_Offset(msg)) ' performs some additional processing on keyboard events
discardp = DispatchMessageA(_Offset(msg)) ' sends the message out to the window that the message was sent to
Wend
End Sub
'===End main function ===========================
'-- Step 4: the Window Procedure
Function WindowProc%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
Const WM_CREATE = &H0001
Const WM_CLOSE = &H0010
Const WM_DESTROY = 2
Const WM_COMMAND = &H0111
Const BN_CLICKED = 0
Const WM_GETTEXT = &H000D
Const WM_SETFOCUS = &H0007
Dim discardp As _Offset 'Dummy variable
Dim discardb As Long ' Dummy variable
Select Case uMsg
' Case WM_CREATE
' WindowProc = 0
Case WM_CLOSE
DestroyWindow (hWnd) 'Destroy window and child windows
WindowProc = 0
Case WM_DESTROY
PostQuitMessage 0 ' Want to exit the program
WindowProc = 0
Case WM_SETFOCUS
discardb = SetFocus(ipb.hwe) 'Set Edit control focus
WindowProc = 0
Case WM_COMMAND
'==============
If wParam = BN_CLICKED Then
Select Case lParam
'A button was clicked test each one
'---Sandard buttons---
Case ipb.hwb0 'OK button
'Print "Button 0 pressed OK"
'Get input text and copy to buffer (buf)
discardp = SendMessageA(ipb.hwe, WM_GETTEXT, Len(ipb.buf), _Offset(ipb.buf))
'Print Len(buf)
discardp = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
WindowProc = 0
Case ipb.hwb1 'Cancel button
'Print "Button 1 pressed Cancel"
ipb.buf = "" 'reset zero-length string ("").
discardp = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
WindowProc = 0
'---End standard buttons---
End Select
Else
'Not our message send back to system for processing
WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
End If
'=================
WindowProc = 0
Case Else
'Not our message send back to system for processing
WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
End Select
End Function
'######--END INPUT BOX FUNCTIONS and SUBS--##################################
WIN2.h
ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
}
void * GetWindowProc() {
return (void *) WindowProc;
}
ptrszint FUNC_SUBEDIT(ptrszint*_FUNC_SUBEDIT_OFFSET_HWND,uint32*_FUNC_SUBEDIT_ULONG_UMSG,uptrszint*_FUNC_SUBEDIT_UOFFSET_WPARAM,ptrszint*_FUNC_SUBEDIT_OFFSET_LPARAM);
LRESULT CALLBACK SubEdit(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
return FUNC_SUBEDIT((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
}
void * GetSubEdit() {
return (void *) SubEdit;
}
mpg_input_box_1b.bas
Option _Explicit
' A Simple Input box for QB64 32 & 64 bit
' mpg_input_box_1b.bas
' MPG 12-8-2021
'===================================================================
' Displays an inputbox popup window. Gets a line of text from user.
'
'There are three InputBox function:
'InputBox("prompt, title) - Accepts any character input
'InputBoxN("prompt, title) - Only numeric characters allowed
'InputBoxP("prompt, title) - Password entry. Display asterisk
' for each character entered
'
'prompt - text displayed by the InputBox e.g. "Please enter a number:".
'title - text displayed in the title bar of the InputBox.
'
'Note: Cancel button returns a null string ("")
'
'----------------------------------------------------------------------
' Code based on ideas from the following references:
' 1) Windows buttons for 32 and 64 bit IDE
' https://www.qb64.org/forum/index.php?topic=3217.msg124966#msg124966
' 2) Base64 Encoding/Decoding with Windows, Mac, and Linux
' https://www.qb64.org/forum/index.php?topic=3214.msg124919#msg124919
' 3) Threading
' https://www.qb64.org/forum/index.php?topic=3865.msg132124#msg132124
'=======================================================================
'
'---------------------------------------------------------------
'NOTE:
'Create a new file WIN2.h with the following content (Remove the comments '):
'---Start of file contents:---
'ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
'LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetWindowProc() {
' return (void *) WindowProc;
'}
'ptrszint FUNC_SUBEDIT(ptrszint*_FUNC_SUBEDIT_OFFSET_HWND,uint32*_FUNC_SUBEDIT_ULONG_UMSG,uptrszint*_FUNC_SUBEDIT_UOFFSET_WPARAM,ptrszint*_FUNC_SUBEDIT_OFFSET_LPARAM);
'LRESULT CALLBACK SubEdit(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_SUBEDIT((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetSubEdit() {
' return (void *) SubEdit;
'}
'---End of file contents---
'Input box uses the WIN2.h file to get the WindowProc and SubEdit . Note: Place above file in your working folder (The QB64 folder).
'----------------------------------------------------------------
'==Note: InputBox requires this section to be added to your program.=========
' Creates global variable ipb. Its corresponding elements are global.
Dim Shared ipb As input_box_udt ' InputBox user defined type
inputbox_init ' Define ipb structure and initialize elements
'=============================================================================
'===Subclassing
Dim Shared PreviousWinProc As Long
'===End Subclassing
'===Your program START ==========
Screen _NewImage(400, 300, 32) 'Set main screen size
Color _RGB(0, 0, 0), _RGB32(205, 238, 205) ' Set colors
Cls
_Title "Main Program" ' Set your main program title
'Examples:
Print "===" + InputBox("Please enter some text:", "InputBox") + "==="
Print "===" + InputBoxN("Please enter port number:", "Port Number") + "==="
Print "===" + InputBoxP("Please enter password:", "Password Required") + "==="
Print "End"
End
System
'===Your program END ============
'######--INPUT BOX FUNCTIONS and SUBS--######################################
Function InputBox$ (prompt As String, title As String)
Const FALSE = 0
Const TRUE = Not FALSE
ipb.number = FALSE ' Disable numeric input
ipb.password = FALSE ' Disable password input
ipb.caption_text = title 'Pop-up window title
ipb.prompt_text = prompt 'Label text user instrutions
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBox = ipb_get_string 'Extract data from ipb.buf return string
End Function
Function InputBoxN$ (prompt As String, title As String)
Const FALSE = 0
Const TRUE = Not FALSE
ipb.number = TRUE ' Enable numeric input
ipb.password = FALSE ' Disable password input
ipb.caption_text = title ' Pop-up window title
ipb.prompt_text = prompt ' Label text user instrutions
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBoxN = ipb_get_string 'Extract data from ipb.buf return string
End Function
Function InputBoxP$ (prompt As String, title As String)
Const FALSE = 0
Const TRUE = Not FALSE
ipb.number = FALSE ' Disable numeric input
ipb.password = TRUE ' Enable password input
ipb.caption_text = title ' Pop-up window title
ipb.prompt_text = prompt ' Label text user instrutions
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBoxP = ipb_get_string 'Extract data from ipb.buf return string
End Function
'-- inputbox_init: Creates a user defined type and sets initial values.
Sub inputbox_init
Const FALSE = 0
Const TRUE = Not FALSE
Type input_box_udt
buf As String * 64 ' Buffer to store entered characters
hw As _Offset ' Pointer to inputbox window
hwLabel As _Offset ' Pointer to label
hwb0 As _Offset ' Pointer button 0 - OK
hwb1 As _Offset ' Pointer button 1 - Cancel
hwe As _Offset ' Pointer to single line edit control
number As Integer ' Edit control numbers only
password As Integer ' asterisk displayed
caption_text As String ' Window title
prompt_text As String ' Instruction to user
button0_text As String ' Left button
button1_text As String ' Right button
x As Long 'Position of input box
y As Long 'Position of input box
End Type
'Set default values
ipb.caption_text = "InputBox"
ipb.prompt_text = "Enter some text:"
ipb.button0_text = "OK"
ipb.button1_text = "Cancel"
ipb.number = FALSE
ipb.password = FALSE
'Center InputBox window
Dim As Long userwidth, userheight
userwidth = _DesktopWidth: userheight = _DesktopHeight 'get current screen resolution
ipb.x = (userwidth \ 2 - 358 \ 2) - 3
ipb.y = (userheight \ 2 - 136 \ 2) - 29
End Sub
Function ipb_get_string$ ()
Dim As String a
'Extract string from buf
a = _Trim$(ipb.buf) ' Remove spaces
a = Left$(a, InStr(a, Chr$(0)) - 1) ' Buffer contains a null terminated string. Find position of null,
ipb.buf = "" ' extract characters upto this null character. Clear buffer
ipb_get_string = a 'Return clean string
End Function
'===Main Sub ===========================
Sub ipb_UserInput
'--Constants
Const FALSE = 0
Const TRUE = Not FALSE
Const IDC_ARROW = &H7F00
Const COLOR_WINDOW = 5
Const WS_OVERLAPPED = 0
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_VISIBLE = &H10000000
Const WS_CHILD = &H40000000
Const WS_TABSTOP = &H00010000
Const WS_EX_CLIENTEDGE = &H00000200
Const BS_PUSHBUTTON = 0
Const CW_USEDEFAULT = &H80000000
Const SW_SHOWDEFAULT = &HA
Const ES_LEFT = 0
Const ES_NUMBER = &H2000
Const ES_PASSWORD = &H0020
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION
'Select style before control is created.
'No need to dynamically change. Controls are built every time they are used
Dim ipb_style As Long
ipb_style = 0
If ipb.password Then
ipb_style = ES_PASSWORD
End If
If ipb.number Then
ipb_style = ES_NUMBER
End If
'--Types
Type POINT
As Long x
As Long y
End Type
Type MSG
As _Offset hwnd
As _Unsigned Long message
As _Unsigned _Offset wParam 'unsigned pointer sized integer
As _Offset lParam ' pointer sized integer
As _Unsigned Long time
As POINT pt
End Type
Type WNDCLASSA
As _Unsigned Long style
$If 64BIT Then
As String * 4 padding
$End If
As _Offset lpfnWndProc
As Long cbClsExtra, cbWndExtra
As _Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName
End Type
'--Libaries
'===Subclassing
Declare Library "WIN2"
Function GetWindowProc%& () 'Windows procedure
Function GetSubEdit%& () 'Edit procedure
End Declare
Declare CustomType Library
Function SetWindowLongPtr& Alias "SetWindowLongPtrA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
Function GetWindowLongPtr& (ByVal hwnd As _Offset, Byval nIndex As Long)
Function CallWindowProc& Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, Byval hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
End Declare
'===END Subclassing
Declare Dynamic Library "user32"
Function SendMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Function DefWindowProcA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Sub PostQuitMessage (ByVal nExitCode As Long)
Function LoadCursorW%& (ByVal hInstance As _Offset, Byval lpCursorName As _Offset)
Function RegisterClassA~% (ByVal lpWndClass As _Offset)
Function CreateWindowExA%& (ByVal dwExStyle As Long, Byval lpClassName As _Offset, Byval lpWindowName As _Offset, Byval dwStyle As Long, Byval X As Long, Byval Y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As _Offset, Byval hMenu As _Offset, Byval hInstance As _Offset, Byval lpParam As _Offset)
Function ShowWindow& (ByVal hWnd As _Offset, Byval nCmdShow As Long)
Function UpdateWindow& (ByVal hWnd As _Offset)
Function GetMessageA% (ByVal lpMsg As _Offset, Byval hWnd As _Offset, Byval wMsgFilterMin As _Unsigned Long, Byval wMsgFilterMax As _Unsigned Long)
Function TranslateMessage& (ByVal lpMsg As _Offset)
Function DispatchMessageA%& (ByVal lpmsg As _Offset)
Sub DestroyWindow (ByVal hWnd As _Offset)
Function PostMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Function SetFocus& (ByVal hWnd As _Offset)
Function GetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long)
Function SetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
End Declare
Declare Dynamic Library "kernel32"
Function GetModuleHandleW%& (ByVal lpModuleName%&)
Function GetLastError~& ()
End Declare
'--End Libaries
'--Variables
Static registered As Integer 'Variables initialized to 0 (false) hence not registered. Value retained between functtion calls
Dim hi As _Offset ' Handle to application instance
Dim wc As WNDCLASSA ' define wc as WNDCLASSEX structure
Dim msg As MSG
Dim discardb As Long ' Dummy variable
Dim discardp As _Offset 'Dummy variable
Dim t0 As String ' Type of control
Dim t1 As String ' Title or controls text
Dim MainClassName As String * 5
MainClassName = "main" + Chr$(0)
Dim CrLf As String * 2 ' define as 2 byte STRING
CrLf = Chr$(13) + Chr$(10) ' carriage return and line feed
Dim As String className ' Variable className stores name of our window class
className = "myWindowClass" + Chr$(0) ' Used in wc. which in turn is used to register window class with the system.
hi = GetModuleHandleW(0) 'Handle to application instance
'---Step 1: Registering the Window Class
'Fill out the members of WNDCLASSEX structure (wc) and call RegisterClassA
wc.style = 0 ' Class Styles (CS_*), not Window Styles (WS_*) This is usually be set to 0.
wc.lpfnWndProc = GetWindowProc ' Pointer to the window procedure for this window class. (see WIN.h)
wc.cbClsExtra = 0 ' Amount of extra data allocated for this class in memory. Usually 0.
wc.cbWndExtra = 0 ' Amount of extra data allocated in memory per window of this type. Usually 0.
wc.hInstance = hi ' Handle to application instance .
wc.hIcon = 0 ' Large (usually 32x32) icon shown when the user presses Alt+Tab. Set to 0
wc.hCursor = LoadCursorW(0, IDC_ARROW) ' Cursor that will be displayed over our window.
wc.hbrBackground = COLOR_WINDOW 'was +1 Background Brush to set the color of our window. '
wc.lpszMenuName = 0 ' Name of a menu resource to use for the windows with this class.
wc.lpszClassName = _Offset(className) ' Name to identify the class with.
If Not registered Then ' First time in funcion OK to register
If RegisterClassA(_Offset(wc)) = 0 Then
Print "RegisterClassA failed:"; GetLastError
End
End If
registered = TRUE ' Class was registered
End If
'--Step 2: Creating the Windows
'After registering the class, create a window with it using CreateWindowExA.
'Note: A visible un-owned window gets a taskbar button. To hide the inputbox window taskbar button
'make the inputbox owned by our main applicationusing using _WindowHandle instead of 0'
t1 = ipb.caption_text + Chr$(0) 'Window title
ipb.hw = CreateWindowExA(0, _Offset(className), _Offset(t1), WS_OVERLAPPEDWINDOW, ipb.x, ipb.y, 358, 130, _WindowHandle, 0, hi, 0): If 0 = ipb.hw Then System
'Controls are just child windows. They have a procedure, a class etc... that is registered by the system.
'Label
t0 = "STATIC" + Chr$(0) ' Window control is STATIC predefined class
t1 = ipb.prompt_text + Chr$(0) ' Label text
ipb.hwLabel = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD, 9, 5, 372, 16, ipb.hw, 0, hi, 0): If 0 = ipb.hwLabel Then System
'OK Button 0
t0 = "BUTTON" + Chr$(0) ' Window control is BUTTON predefined class
t1 = ipb.button0_text + Chr$(0)
ipb.hwb0 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 175, 65, 80, 23, ipb.hw, 0, hi, 0): If 0 = ipb.hwb0 Then System
'Cancel button 1
t1 = ipb.button1_text + Chr$(0)
ipb.hwb1 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 262, 65, 80, 23, ipb.hw, 0, hi, 0): If 0 = ipb.hwb1 Then System
'Edit control
t0 = "EDIT" + Chr$(0)
' t1 = "This is a edit control." + Chr$(0)
t1 = "" + Chr$(0)
ipb.hwe = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or ES_LEFT Or ipb_style, 12, 30, 330, 26, ipb.hw, 0, hi, 0): If 0 = ipb.hwe Then System
'====Subclassing
Const GWLP_WNDPROC = -4 ' Sets a new address for the window procedure
PreviousWinProc = GetWindowLongPtr(ipb.hwe, GWLP_WNDPROC) ' get the default procedure
discardb = SetWindowLongPtr(ipb.hwe, GWLP_WNDPROC, ConvertOffset(GetSubEdit)) ' set your custom procedure
discardb = SetFocus(ipb.hwe) ' and start typing
'===End Subclassing
'Display and Update window to ensure it has properly redrawn itself on the screen.
discardb = SetFocus(ipb.hwe) ' and start typing
discardb = ShowWindow(ipb.hw, SW_SHOWDEFAULT)
discardb = UpdateWindow(ipb.hw)
'-- Step 3: The Message Loop
While GetMessageA(_Offset(msg), 0, 0, 0) > 0 ' gets a message from your application's message queue.
discardb = TranslateMessage(_Offset(msg)) ' performs some additional processing on keyboard events
discardp = DispatchMessageA(_Offset(msg)) ' sends the message out to the window that the message was sent to
Wend
End Sub
'===End main function ===========================
'-- Step 4: the Window Procedure
Function WindowProc%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
Const WM_CREATE = &H0001
Const WM_CLOSE = &H0010
Const WM_DESTROY = 2
Const WM_COMMAND = &H0111
Const BN_CLICKED = 0
Const WM_GETTEXT = &H000D
Const WM_SETFOCUS = &H0007
Dim discardp As _Offset 'Dummy variable
Dim discardb As Long ' Dummy variable
Select Case uMsg
' Case WM_CREATE
' WindowProc = 0
Case WM_CLOSE
DestroyWindow (hWnd) 'Destroy window and child windows
WindowProc = 0
Case WM_DESTROY
PostQuitMessage 0 ' Want to exit the program
WindowProc = 0
Case WM_SETFOCUS
discardb = SetFocus(ipb.hwe) 'Set Edit control focus
WindowProc = 0
Case WM_COMMAND
'==============
If wParam = BN_CLICKED Then
Select Case lParam
'A button was clicked test each one
'---Sandard buttons---
Case ipb.hwb0 'OK button
'Print "Button 0 pressed OK"
'Get input text and copy to buffer (buf)
discardp = SendMessageA(ipb.hwe, WM_GETTEXT, Len(ipb.buf), _Offset(ipb.buf))
'Print Len(buf)
discardp = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
WindowProc = 0
Case ipb.hwb1 'Cancel button
'Print "Button 1 pressed Cancel"
ipb.buf = "" 'reset zero-length string ("").
discardp = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
WindowProc = 0
'---End standard buttons---
End Select
Else
'Not our message send back to system for processing
WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
End If
'=================
WindowProc = 0
Case Else
'Not our message send back to system for processing
WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
End Select
End Function
'######--END INPUT BOX FUNCTIONS and SUBS--##################################
Function ConvertOffset&& (value As _Offset)
Dim temp As Long
$Checking:Off
Dim m As _MEM 'Define a memblock
m = _Mem(value) 'Point it to use value
$If 64BIT Then
'On 64 bit OSes, an OFFSET is 8 bytes in size. We can put it directly into an Integer64
_MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
$Else
'However, on 32 bit OSes, an OFFSET is only 4 bytes. We need to put it into a LONG variable first
_MemGet m, m.OFFSET, temp 'Like this
ConvertOffset&& = temp 'And then assign that long value to ConvertOffset&&
$End If
_MemFree m 'Free the memblock
$Checking:On
End Function
Function SubEdit%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
Const WM_CHAR = 258
Print "xxxxxx"
Select Case uMsg
Case WM_CHAR ' only interested in the WM_CHAR message
If wParam > 57 Then
Print "Test >57"
' SubEdit = 0 ' Return 0 character processed
Else
Print "Not >57"
End If
End Select
' No matter what happened, use the old window procedure to finish processing the message.
'SubEdit = CallWindowProc(PreviousWinProc, hWnd, uMsg, wParam, lParam) ' perform default processing
SubEdit = 0
End Function
