'###_start_BM_inputbox
'######--INPUT BOX FUNCTIONS and SUBS--######################################
'--inputbox_init: Creates a user defined type. This type is used to create
' global variable ipb. Its corresponding elements are
' global. Some variables are initialised in this function.
buf
As String * 64 ' Buffer to store entered characters hwe
As _Offset ' Pointer to single line edit control
pw_mask
As Integer ' Enable password mask flag pw_bullet
As Integer ' Password mask bullet flag max_length
As Integer 'Maximum allowed characters
prompt_text
As String ' Instructions to user valid_str
As String ' All allowed characters
x
As Long 'Position of inputbox y
As Long 'Position of inputbox max_char_allowed
As Long ' Maximum number of input characters allowed
default_input_text
As String ' Display to user initial value
'---Set default values
ipb.button0_text = "OK"
ipb.button1_text = "Cancel"
'---Center InputBox window
ipb.x = (userwidth \ 2 - 358 \ 2) - 3
ipb.y = (userheight \ 2 - 136 \ 2) - 29
ipb.default_input_text = "" 'Set initial value
'-- END inputbox_init:
'Predefined function 1: - Allow numeric and alpha characters
InputBox = InputBoxM("", "", "", "", "")
'Predefined function 2: - Allows alpha-numeric and extra valid characters.
InputBoxA = InputBoxM(prompt, title, "", "A+", "")
'Predefined function 3: - Only numeric characters allowed.
InputBoxN = InputBoxM(prompt, title, "", "N", "")
'Predefined function 4: - Password entry. Display asterisk.
InputBoxP = InputBoxM(prompt, title, "", "", "A")
'Predefined function 5: - Password entry. Display bullet.
InputBoxPB = InputBoxM(prompt, title, "", "", "B")
'---Main input box
'---Set prompt text
ipb.prompt_text = "Enter some text:" 'Default value
ipb.prompt_text = prompt 'Label text. User instrutions
'---Set pop-up window title (caption) text
ipb.caption_text = "InputBox" 'Default value
ipb.caption_text = title 'User pop-up window title
'--Set maximum number of characters allowed
ipb.max_length = 40 'Default allowed characters 40
ipb.max_length
= Val(maxLength
) 'Required length
'---Set allowed characters.
'numeric: Options are
' "" Default, allows alpha-numeric characters.
' "A+" Allows alpha-numeric and extra valid characters.
' "N" Numeric digits 0-9 only
' "N+" Numeric digits 0-9 and associated characters.
str1 = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" 'Alpha
str2 = "0123456789 " ' numeric
str3
= Chr$(34) + "!$%^&()+{}[]:@#<>?" ' Extra associated alpha/numeric characters str4 = "%^.+-*/=" ' Associated numeric characters e.g basic calculator
ipb.valid_str = ""
If numeric
= "" Then ' Set default alpha numeric characters ipb.valid_str = str1 + str2 ' Valid alpha/numeric characters
If numeric
= "A+" Then ' Set allowed alpha numeric and extra characters ipb.valid_str = str1 + str2 + str3 'Valid alpha/numeric and extra characters
If numeric
= "N" Then ' Set allowed numeric characters ipb.valid_str = str2 ' Valid characters 0-9
If numeric
= "N+" Then ' Set numeric and associated characters. ipb.valid_str = str2 + str4 ' Valid numeric and associated characters
'---Set mask option
' "" Default no mask
' "A" Password mask asterisk
' "B" Password mask Bullet
ipb.pw_mask = FALSE ' Reset flag, disable password mask
ipb.pw_bullet = FALSE ' Reset bullet flag
If pwMask
= "A" Or pwMask
= "B" Then ' Mask required ipb.pw_mask = TRUE ' Set flag, mask required
If pwMask
= "B" Then ' Bullet required ipb.pw_bullet = TRUE ' Set bullet flag
'---Get user input string
ipb_UserInput ' Run UserInput, data entered saved in buffer ipb.buf
InputBoxM = ipb_get_string ' Extract data from ipb.buf return string
'---Function Extract data from ipb.buf return input string
'Extract string from buf
a
= _Trim$(ipb.buf
) ' Remove spaces. Buffer contains a null terminated a
= Left$(a
, InStr(a
, Chr$(0)) - 1) ' string. Find position of null and extract ipb.buf = "" ' characters upto this null character. Clear buffer
ipb_get_string = a 'Return clean string
'===Main Sub ===========================
'--Constants
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 CW_USEDEFAULT
= &H80000000 Const SW_SHOWDEFAULT
= &HA
Const WS_OVERLAPPEDWINDOW
= WS_OVERLAPPED
Or WS_CAPTION
'--Types
As Long cbClsExtra
, cbWndExtra
As _Offset hInstance
, hIcon
, hCursor
, hbrBackground
, lpszMenuName
, lpszClassName
'--Libaries
Function GetWindowProc%&
() 'Windows procedure address '***Subclassing
Function GetSubEdit%&
() ' Edit procedure address '***End Subclassing
'***Subclassing
'***End Subclassing
' Declare CustomType Library
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 SetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
'--End Libaries
'--Variables
Static registered
As Integer 'Variables initialized to 0 (false) hence not registered. Value retained between functtion calls
Dim wc
As WNDCLASSA
' define wc as WNDCLASSEX structure
MainClassName
= "main" + Chr$(0)
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 = GetModuleHandleA(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. Print "RegisterClassA failed:"; GetLastError
registered = TRUE ' Class was registered
'--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
' t1 = "This is a edit control." + Chr$(0)
ipb.hwe
= CreateWindowExA
(WS_EX_CLIENTEDGE
, _Offset(t0
), _Offset(t1
), WS_VISIBLE
Or WS_CHILD
Or ES_LEFT
, 12, 30, 330, 26, ipb.hw
, 0, hi
, 0):
If 0 = ipb.hwe
Then System
'===Write default text to edit control and set cursor pos
Const WM_SETTEXT
= &H000C If ipb.default_input_text
<> "" Then 'Empty skip this t0
= ipb.default_input_text
+ Chr$(0) 'Text to send to Edit control dummyO
= SendMessageA
(ipb.hwe
, WM_SETTEXT
, 0, _Offset(t0
)) 'Set control text ipbLen
= Len(ipb.default_input_text
) ' Length of string dummyO = SendMessageA(ipb.hwe, EM_SETSEL, ipbLen, ipbLen) ' Set cursor to end of text
'---Set character length
Const EM_LIMITTEXT
= &H00C5 dummyO = SendMessageA(ipb.hwe, EM_LIMITTEXT, ipb.max_length, 0) 'Send message maxcharacters 8
'----Enable and configure password mask.
'Note: The bullet is Unicode (9679 or 0x25CF ) use SendMessageW. Use SendMessageA for old Asterisk (42)
Const EM_SETPASSWORDCHAR
= &HCC If ipb.pw_mask
Then 'Input Mask required If ipb.pw_bullet
Then 'Set bullet dummyO = SendMessageW(ipb.hwe, EM_SETPASSWORDCHAR, 9679, 0) 'Set bullet password mask
dummyO = SendMessageA(ipb.hwe, EM_SETPASSWORDCHAR, 42, 0) 'Set Asterisk default mask
dummyO = SendMessageA(ipb.hwe, EM_SETPASSWORDCHAR, 0, 0) ' Turn password mask off
' dummyO = SendMessageW(ipb.hwe, EM_SETPASSWORDCHAR, 0, 0) ' Turn password mask off
'*****Subclassing
Const GWLP_WNDPROC
= -4 ' Sets a new address for the window procedure OldWindowProc = SetWindowLongPtr(ipb.hwe, GWLP_WNDPROC, ConvertOffset(GetSubEdit)) ' set your custom procedure
'*****End Subclassing
'Display and Update window to ensure it has properly redrawn itself on the screen.
dummyL = ShowWindow(ipb.hw, SW_SHOWDEFAULT)
dummyL = UpdateWindow(ipb.hw)
' Force window to top and select with screen click
Const HWND_TOPMOST
= -1 ' window above all others no focus unless active Const SWP_NOSIZE
= &H0001 ' ignores cx and cy size parameters Const SWP_NOACTIVATE
= &H0010 'does not activate window dummyL
= SetWindowPos
(ipb.hw
, HWND_TOPMOST
, ipb.x
, ipb.y
, 0, 0, SWP_NOSIZE
Or SWP_NOACTIVATE
) 'force to top _ScreenClick ipb.x
+ 160, ipb.y
+ 96 'Force focus and move cursor to left of ok button
'-- Step 3: The Message Loop
While GetMessageA
(_Offset(msg
), 0, 0, 0) > 0 ' gets a message from our application's message queue. dummyL
= TranslateMessage
(_Offset(msg
)) ' performs some additional processing on keyboard events dummyO
= DispatchMessageA
(_Offset(msg
)) ' sends the message out to the window that the message was sent to'===End main function ===========================
'-- Step 4: the Window Procedure
Const WM_COMMAND
= &H0111 Const WM_GETTEXT
= &H000D Const WM_SETFOCUS
= &H0007
DestroyWindow (hWnd) 'Destroy window and child windows
WindowProc = 0
PostQuitMessage 0 ' Want to exit the program
WindowProc = 0
dummyL = SetFocus(ipb.hwe) 'Set Edit control focus
WindowProc = 0
'==============
'A button was clicked test each one
'---Sandard buttons---
'Print "Button 0 pressed OK"
'Get input text and copy to buffer (buf)
dummyO
= SendMessageA
(ipb.hwe
, WM_GETTEXT
, Len(ipb.buf
), _Offset(ipb.buf
)) 'Print Len(buf)
dummyO = 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 ("").
dummyO = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
WindowProc = 0
'---End standard buttons---
'Not our message send back to system for processing
WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
'=================
WindowProc = 0
'Not our message send back to system for processing
WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
'######--END INPUT BOX FUNCTIONS and SUBS--##################################
'Ref https://www.qb64.org/forum/index.php?topic=1553.msg108409#msg108409
'Ref https://www.qb64.org/forum/index.php?topic=2905.msg121660#msg121660
m
= _Mem(value
) 'Point it to use value 'On 64 bit OSes, an OFFSET is 8 bytes in size. We can put it directly into an Integer64
ConvertOffset = temp
'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&&
'*****Subclass function
Const WM_NCDESTROY
= &H82 Const GWLP_WNDPROC
= -4 ' Sets a new address for the window procedure Const WM_CONTEXTMENU
= 123 Const MB_ICONWARNING
= &H30
'Set initial condition
processed = FALSE 'Set initial value. No key processed
'If we're being destroyed, restore the original WindowProc.
'*****Subclassing
dummyL = SetWindowLongPtr(hWnd, GWLP_WNDPROC, OldWindowProc)
'*****End Subclassing
'Disable context menu popup. Prevents a paste operation
processed = TRUE ' Key processed nothing elese to do
'Disable Ctrl+V Prevents a paste operation
processed = TRUE ' Key processed nothing elese to do
'Disable Enter key. Prevents anoying beep. Force enter to produce OK button click
'Pressing the enter key with Edit Control in focus.
'Default behavior is to produce an annoying beep this is
'because enter is an invalid key for this control.
If uMsg
= WM_CHAR
And wParam
= VK_RETURN
Then 'Enter key pressed dummyO = SendMessageA(ipb.hwb0, BM_CLICK, 0, 0) ' Send message (button click) to OK button
processed = TRUE ' Key processed nothing elese to do
'Valid character section all others invalid
If uMsg
= WM_CHAR
Then 'There is a character to process 'Print wParam
ChrValid = FALSE ' Set initial value
For i
= 1 To Len(ipb.valid_str
) ' Scan valid characters and backspace=8 ChrValid = TRUE ' Key in valid range. Allow default processing
If Not ChrValid
Then ' Invalid character remove by setting processed processed = TRUE ' true flag. Forceses return 0 for invalid keys'
'Alert user.
If Not (wParam
= VK_RETURN
) Then ' Note: Return key is valid. MessageBeep MB_ICONWARNING ' For invalid characters
End If ' create a "ding" to alert user. 'End valid character
'Set return value
If processed
Then 'A key was processed SubEdit = 0 ' Return 0 no further processing required
Else ' No key processed pass onto default processing '*****Subclassing
SubEdit = CallWindowProc(OldWindowProc, hWnd, uMsg, wParam, lParam)
'*****End Subclassing
'*****End Subclass functionn
'###_start_BM_inputbox