InputBox

[Petr]

@mpgcan

Hi. I use your input boxes in my program and all works perfectly.

Just one question to this. Is it possible to somehow enter the default value in the inputbox field by the program? (For example, invoke this dialog with a program to change the volume and want to offer in the field where the current value is written, for example 75 percent, not just an empty inputbox.) User then either only confirms or overwrites it and only then confirms it. Is it possible to do it somehow? The current functionality is excellent, I'm just wondering if this would be possible.

[mpgcan]

 It is possible enter a default value in the inputbox.
 I have added variable ipb.default_input_text = "some text"
 The value remembered between inputs hence set it to "" if not required.

input_box_example2.bas

Code: QB64: [Select]

1. Option _Explicit
2. $VersionInfo:Comments=This uses Subclassing Controls!
3.  
4. '$Include:'input_box2.BI'
5.  
6. '===Your program START ==========
7. Screen _NewImage(400, 300, 32) '             Set main screen size
8. Color _RGB(0, 0, 0), _RGB32(205, 238, 205) ' Set colors
9. Cls
10. _Title "Main Program" ' Set your main program title
11.  
12. 'Examples:
13.  
14. 'Accepts alpha-numeric characters
15. Print "=1a= " + InputBoxM("", "", "", "", "")
16. Print "=1b= " + InputBox
17.  
18.  
19. 'Allows alpha-numeric and extra valid characters.
20. ipb.default_input_text = "Test 123" 'Note set before displaying input box
21. Print "=2a= " + InputBoxM("Any character:", "All A+", "", "A+", "")
22.  
23. ipb.default_input_text = "" 'Note reset inital value when not required
24. Print "=2b= " + InputBoxA("Any character:", "All A+")
25.  
26. 'Only numeric characters allowed
27. 'Print "=3a= " + InputBoxM("Digits 0-9 only", "NUMERIC", "", "N", "")
28. 'Print "=3b= " + InputBoxN("Digits 0-9 only", "NUMERIC")
29.  
30. 'Password entry. Display asterisk
31. 'Print "=4a= " + InputBoxM("Asterisk mask:", "PASSWORD 1", "", "", "A")
32. 'Print "=4b= " + InputBoxP("Asterisk mask:", "PASSWORD 1")
33.  
34. 'Password entry. Display bullet
35. 'Print "=5a= " + InputBoxM("Bullet mask:", "PASSWORD 2", "", "", "B")
36. 'Print "=5b= " + InputBoxPB("Bullet mask:", "PASSWORD 2")
37.  
38.  
39. 'Print "=7= " + InputBoxM("Limit 4 characters:", "LIMIT", "4", "", "") '
40. 'Print "=8= " + InputBoxM("Digits 0-9 and associated characters", "NUMERIC+", "", "N+", "")
41.  
42. Print "End"
43. End
44. System
45. '===Your program END ============
46.  
47. '$Include:'input_box2.BM'
48.  

input_box2.BI

Code: QB64: [Select]

1. '###_start_BI_inputbox
2. Do: Loop Until _ScreenExists 'run before using _WindowHandle or _title
3. $If 64BIT Then
4.     $If VERSION < 1.6 Then
5.         $ERROR Requires Windows QB64 version 1.6 or above
6.     $End If
7. $End If
8.  
9. $If 32BIT Then
10.     $If VERSION < 1.5 Then
11.         $ERROR Requires Windows QB64 version 1.5 or above
12.     $End If
13. $End If
14.  
15. '===================================================================
16. 'Input box for QB64 32 & 64 bit.
17. 'The QB64 InputBoxM function displays a pop-up dialog box,
18. 'prompting the user for input. It has OK and Cancel buttons.
19. 'Function returns a text string containing the user's input
20. 'when OK button clicked. Returns an empty text string when
21. 'Cancel button is clicked.
22. '
23. ' mpg_input_box_1.bas
24. ' MPG 9-10-2021
25. '====================================================================
26. 'InputBoxM function:
27. 'InputBoxM (prompt$,title$,length$,numeric$,pwMask$)
28. '
29. 'prompt$  - text displayed above the edit control to prompt user e.g. "Please enter a number:".
30. 'title$   - text displayed in the title bar of the InputBoxM.
31. 'length$  - maximum number of characters a user allowed to enter.
32. 'numeri$c - select numeric input. Options are:
33. '            ""   Default, allows alpha-numeric characters.
34. '            "A+" Allows alpha-numeric and extra valid characters.
35. '            "N"   Numeric digits 0-9 only
36. '            "N+"  Numeric digits 0-9 and associated characters.
37. 'pwMask$  - select a password mask' Options are:
38. '            ""  Default no mask
39. '            "A" Password mask Asterisk
40. '            "B" Password mask Bullet
41. '
42. ' Note1: All variables are optional. Unused variables use a null string.
43. ' Note2: Pressing cancel button returns a null string e.g ""
44. ' Note3: You can change default values e.g valid characters, length etc
45. '        Defaults, located in "Sub inputbox_init" or "Function InputBoxM"
46. '----------------------------------------------------------------------
47. 'Predefined functions:
48. 'Based on the above, five predefined InputBox functions are
49. 'included as follows:
50. '
51. 'InputBox                    - Accepts alpha-numeric characters
52. 'InputBoxA(prompt$, title$)  - Accepts any character input
53. 'InputBoxN(prompt$, title$)  - Only numeric characters allowed
54. 'InputBoxP(prompt$, title$)  - Password entry. Display asterisk
55. 'InputBoxPB(prompt$, title$) - Password entry. Display bullet
56. '
57. ' Note1: Variables are optional. Unused variables use a null string
58. '----------------------------------------------------------------------
59. ' VB Inputbox has some limitations as does the edit control. This QB64
60. ' input box addresses these limitation.
61. ' 1) Default character length 0x7FFE to 0x7FFFFFFE os dependent.
62. '    Added option to limit number of characters.
63. ' 2) Default password mask was an asterisk. Added option to select
64. '    asterisk or bullet.
65. ' 3) Numeric characters limited to digits 0-9 added option to have
66. '    extra associated characters e.g calculator +-%= etc.
67. '
68. ' Using subclassing added the following:
69. ' 4) Disabled context menu (Mouse Right click) copy and paste .
70. ' 5) Disabled copy and paste using  Ctrl+c Ctrl+v.
71. ' 6) Disabled copy and paste using Ctrl+Shift+c Ctrl+Shift+v.
72. ' 7) Disabled annoying beep when pressing enter key.
73. ' 8) Character validation.
74. ' 9) Invalid character user alert. Uses MessageBeep.
75. '
76. '----------------------------------------------------------------------
77. ' Code based on ideas from the following references:
78. ' 1) Windows buttons for 32 and 64 bit IDE
79. '    https://www.qb64.org/forum/index.php?topic=3217.msg124966#msg124966
80. ' 2) Base64 Encoding/Decoding with Windows, Mac, and Linux
81. '    https://www.qb64.org/forum/index.php?topic=3214.msg124919#msg124919
82. ' 3) Threading
83. '    https://www.qb64.org/forum/index.php?topic=3865.msg132124#msg132124
84.  
85.  
86. '=======================================================================
87. '
88. '-----------------------------------------------------------------------
89. 'NOTE:
90. 'Create a new file input_box_WIN.h with the following content (Remove the comments '):
91. '---Start of file contents:---
92.      
93. 'ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
94. 'LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
95. ' return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
96. '}
97. 'void * GetWindowProc() {
98. ' return (void *) WindowProc;
99. '}
100.      
101. 'ptrszint FUNC_SUBEDIT(ptrszint*_FUNC_SUBEDIT_OFFSET_HWND,uint32*_FUNC_SUBEDIT_ULONG_UMSG,uptrszint*_FUNC_SUBEDIT_UOFFSET_WPARAM,ptrszint*_FUNC_SUBEDIT_OFFSET_LPARAM);
102. 'LRESULT CALLBACK SubEdit(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
103. ' return FUNC_SUBEDIT((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
104. '}
105. 'void * GetSubEdit() {
106. ' return (void *) SubEdit;
107. '}
108.      
109. '---End of file contents---
110. 'Input box uses the input_box_WIN.h file to get the WindowProc and SubEdit . Note: Place above file in your working folder (The QB64 folder).
111. '----------------------------------------------------------------
112.      
113. '==Note: InputBox requires this section to be added to your program.==========
114. 'Creates a global variable ipb. Its corresponding elements, are also global.
115. Dim Shared ipb As input_box_udt 'The input_box_udt user defined type
116. inputbox_init '                  Define ipb structure and initialize elements
117.      
118. '*****Subclassing
119. Dim Shared OldWindowProc As Long 'Global variable store old windows process
120. '*****End Subclassing
121.  
122. '###_end_BI_inputbox
123.  

input_box2.BM

Code: QB64: [Select]

1. '###_start_BM_inputbox
2. '######--INPUT BOX FUNCTIONS and SUBS--######################################
3.  
4. '--inputbox_init:  Creates a user defined type. This type is used to create
5. '                  global variable ipb. Its corresponding elements are
6. '                  global. Some variables are initialised in this function.
7.  
8. Sub inputbox_init
9.     Const FALSE = 0
10.     Const TRUE = Not FALSE
11.  
12.     Type input_box_udt
13.         buf As String * 64 '  Buffer to store entered characters
14.         hw As _Offset '       Pointer to inputbox window
15.         hwLabel As _Offset '  Pointer to label
16.         hwb0 As _Offset '     Pointer button 0 - OK
17.         hwb1 As _Offset '     Pointer button 1 - Cancel
18.         hwe As _Offset '      Pointer to single line edit control
19.  
20.         pw_mask As Integer '   Enable password mask flag
21.         pw_bullet As Integer ' Password mask bullet flag
22.         max_length As Integer 'Maximum allowed characters
23.  
24.         caption_text As String 'Window title
25.         prompt_text As String ' Instructions to user
26.         valid_str As String '   All allowed characters
27.  
28.         button0_text As String ' Left button
29.         button1_text As String ' Right button
30.  
31.         x As Long 'Position of inputbox
32.         y As Long 'Position of inputbox
33.         max_char_allowed As Long ' Maximum number of input characters allowed
34.  
35.         default_input_text As String ' Display to user initial value
36.     End Type
37.  
38.     '---Set default values
39.     ipb.button0_text = "OK"
40.     ipb.button1_text = "Cancel"
41.  
42.     '---Center InputBox window
43.     Dim As Long userwidth, userheight
44.     userwidth = _DesktopWidth: userheight = _DesktopHeight 'get current screen resolution
45.  
46.     ipb.x = (userwidth \ 2 - 358 \ 2) - 3
47.     ipb.y = (userheight \ 2 - 136 \ 2) - 29
48.  
49.     ipb.default_input_text = "" 'Set initial value
50. End Sub
51. '-- END inputbox_init:
52.  
53. 'Predefined function 1: - Allow numeric and alpha characters
54. Function InputBox$ ()
55.     InputBox = InputBoxM("", "", "", "", "")
56. End Function
57.  
58. 'Predefined function 2: - Allows alpha-numeric and extra valid characters.
59. Function InputBoxA$ (prompt As String, title As String)
60.     InputBoxA = InputBoxM(prompt, title, "", "A+", "")
61. End Function
62.  
63. 'Predefined function 3: - Only numeric characters allowed.
64. Function InputBoxN$ (prompt As String, title As String)
65.     InputBoxN = InputBoxM(prompt, title, "", "N", "")
66. End Function
67.  
68. 'Predefined function 4: - Password entry. Display asterisk.
69. Function InputBoxP$ (prompt As String, title As String)
70.     InputBoxP = InputBoxM(prompt, title, "", "", "A")
71. End Function
72.  
73. 'Predefined function 5: - Password entry. Display bullet.
74. Function InputBoxPB$ (prompt As String, title As String)
75.     InputBoxPB = InputBoxM(prompt, title, "", "", "B")
76. End Function
77.  
78.  
79.  
80. '---Main input box
81. Function InputBoxM$ (prompt As String, title As String, maxLength As String, numeric As String, pwMask As String)
82.     Const FALSE = 0
83.     Const TRUE = Not FALSE
84.     Dim As String str1, str2, str3, str4
85.  
86.     '---Set prompt text
87.     ipb.prompt_text = "Enter some text:" 'Default value
88.     If prompt <> "" Then
89.         ipb.prompt_text = prompt 'Label text. User instrutions
90.     End If
91.  
92.     '---Set pop-up window title (caption) text
93.     ipb.caption_text = "InputBox" 'Default value
94.     If title <> "" Then
95.         ipb.caption_text = title 'User pop-up window title
96.     End If
97.  
98.     '--Set maximum number of characters allowed
99.     ipb.max_length = 40 'Default allowed characters 40
100.     If maxLength <> "" Then
101.         ipb.max_length = Val(maxLength) 'Required length
102.     End If
103.  
104.     '---Set allowed characters.
105.     'numeric: Options are
106.     '  ""    Default, allows alpha-numeric characters.
107.     '  "A+"  Allows alpha-numeric and extra valid characters.
108.     '  "N"   Numeric digits 0-9 only
109.     '  "N+"  Numeric digits 0-9 and associated characters.
110.  
111.     str1 = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" 'Alpha
112.     str2 = "0123456789 " ' numeric
113.     str3 = Chr$(34) + "!$%^&()+{}[]:@#<>?" ' Extra associated alpha/numeric characters
114.     str4 = "%^.+-*/=" '      Associated numeric characters e.g basic calculator
115.  
116.     ipb.valid_str = ""
117.  
118.     If numeric = "" Then '                  Set default alpha numeric characters
119.         ipb.valid_str = str1 + str2 '       Valid alpha/numeric characters
120.     End If
121.     If numeric = "A+" Then '                Set allowed alpha numeric and extra characters
122.         ipb.valid_str = str1 + str2 + str3 'Valid alpha/numeric and extra characters
123.     End If
124.     If numeric = "N" Then '    Set allowed numeric characters
125.         ipb.valid_str = str2 ' Valid characters 0-9
126.     End If
127.     If numeric = "N+" Then '          Set numeric and associated characters.
128.         ipb.valid_str = str2 + str4 ' Valid numeric and associated characters
129.     End If
130.  
131.     '---Set mask option
132.     ' ""  Default no mask
133.     ' "A" Password mask asterisk
134.     ' "B" Password mask Bullet
135.     ipb.pw_mask = FALSE '                  Reset flag, disable password mask
136.     ipb.pw_bullet = FALSE '                Reset bullet flag
137.  
138.     If pwMask = "A" Or pwMask = "B" Then ' Mask required
139.         ipb.pw_mask = TRUE '               Set flag, mask required
140.         If pwMask = "B" Then '             Bullet required
141.             ipb.pw_bullet = TRUE '         Set bullet flag
142.         End If
143.     End If
144.  
145.     '---Get user input string
146.     ipb_UserInput '              Run UserInput, data entered saved in buffer ipb.buf
147.     InputBoxM = ipb_get_string ' Extract data from ipb.buf return string
148. End Function
149.  
150. '---Function Extract data from ipb.buf return input string
151. Function ipb_get_string$ ()
152.     Dim As String a
153.  
154.     'Extract string from buf
155.     a = _Trim$(ipb.buf) '                  Remove spaces. Buffer contains a null terminated
156.     a = Left$(a, InStr(a, Chr$(0)) - 1) '  string. Find position of null and extract
157.     ipb.buf = "" '                         characters upto this null character. Clear buffer
158.  
159.     ipb_get_string = a 'Return clean string
160. End Function
161.      
162. '===Main Sub ===========================
163. Sub ipb_UserInput
164.     '--Constants
165.     Const FALSE = 0
166.     Const TRUE = Not FALSE
167.  
168.     Const IDC_ARROW = &H7F00
169.     Const COLOR_WINDOW = 5
170.      
171.     Const WS_OVERLAPPED = 0
172.     Const WS_CAPTION = &H00C00000
173.     Const WS_SYSMENU = &H00080000
174.     Const WS_VISIBLE = &H10000000
175.     Const WS_CHILD = &H40000000
176.     Const WS_TABSTOP = &H00010000
177.     Const WS_EX_CLIENTEDGE = &H00000200
178.     Const BS_PUSHBUTTON = 0
179.     Const CW_USEDEFAULT = &H80000000
180.     Const SW_SHOWDEFAULT = &HA
181.  
182.     Const ES_LEFT = 0
183.     Const ES_NUMBER = &H2000
184.  
185.     Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION
186.  
187.     '--Types
188.     Type POINT
189.         As Long x
190.         As Long y
191.     End Type
192.  
193.     Type MSG
194.         As _Offset hwnd
195.         As _Unsigned Long message
196.         As _Unsigned _Offset wParam 'unsigned pointer sized integer
197.         As _Offset lParam '          pointer sized integer
198.         As _Unsigned Long time
199.         As POINT pt
200.     End Type
201.  
202.     Type WNDCLASSA
203.         As _Unsigned Long style
204.         $If 64BIT Then
205.             As String * 4 padding
206.         $End If
207.         As _Offset lpfnWndProc
208.         As Long cbClsExtra, cbWndExtra
209.         As _Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName
210.     End Type
211.  
212.     '--Libaries
213.  
214.    
215.     Declare Library "input_box_WIN"
216.         Function GetWindowProc%& () 'Windows procedure address
217.         '***Subclassing
218.         Function GetSubEdit%& () '   Edit procedure address
219.         '***End Subclassing
220.     End Declare
221.  
222.     '***Subclassing
223.     Declare CustomType Library
224.         Function SetWindowLongPtr& Alias "SetWindowLongPtrA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
225.     End Declare
226.     '***End Subclassing
227.  
228.     '  Declare CustomType Library
229.     Declare Dynamic Library "user32"
230.         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)
231.         Function SendMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
232.         Function DefWindowProcA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
233.         Sub PostQuitMessage (ByVal nExitCode As Long)
234.         Function LoadCursorW%& (ByVal hInstance As _Offset, Byval lpCursorName As _Offset)
235.         Function RegisterClassA~% (ByVal lpWndClass As _Offset)
236.         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)
237.         Function ShowWindow& (ByVal hWnd As _Offset, Byval nCmdShow As Long)
238.         Function UpdateWindow& (ByVal hWnd As _Offset)
239.         Function GetMessageA% (ByVal lpMsg As _Offset, Byval hWnd As _Offset, Byval wMsgFilterMin As _Unsigned Long, Byval wMsgFilterMax As _Unsigned Long)
240.         Function TranslateMessage& (ByVal lpMsg As _Offset)
241.         Function DispatchMessageA%& (ByVal lpmsg As _Offset)
242.         Sub DestroyWindow (ByVal hWnd As _Offset)
243.         Function PostMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
244.         Function SetFocus& (ByVal hWnd As _Offset)
245.         Function GetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long)
246.         Function SetWindowPos& (ByVal hWnd As _Offset, Byval hWndInsertAfter As _Offset, Byval X As Integer, Byval Y As Integer, Byval cx As Integer, Byval cy As Integer, Byval uFlags As _Offset)
247.         Function SendMessageW%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
248.         '     Function SetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
249.         Sub MessageBeep (ByVal alert As _Unsigned Long)
250.     End Declare
251.  
252.     Declare Dynamic Library "kernel32"
253.         Function GetModuleHandleA%& (ByVal lpModuleName%&)
254.         Function GetLastError~& ()
255.     End Declare
256.     '--End Libaries
257.  
258.  
259.     '--Variables
260.     Static registered As Integer 'Variables initialized to 0 (false) hence not registered. Value retained between functtion calls
261.  
262.     Dim hi As _Offset '   Handle to application instance
263.     Dim wc As WNDCLASSA ' define wc as WNDCLASSEX structure
264.     Dim msg As MSG
265.  
266.     Dim dummyL As Long '   Dummy variable
267.     Dim dummyO As _Offset 'Dummy variable
268.     Dim t0 As String '       Type of control
269.     Dim t1 As String '       Title or controls text
270.  
271.     Dim MainClassName As String * 5
272.     MainClassName = "main" + Chr$(0)
273.  
274.     Dim CrLf As String * 2 '     define as 2 byte STRING
275.     CrLf = Chr$(13) + Chr$(10) ' carriage return and line feed
276.  
277.     Dim As String className '               Variable className stores name of our window class
278.     className = "myWindowClass" + Chr$(0) ' Used in wc. which in turn is used to register window class with the system.
279.  
280.     hi = GetModuleHandleA(0) 'Handle to application instance
281.  
282.     '---Step 1: Registering the Window Class
283.     'Fill out the members of WNDCLASSEX structure (wc) and call RegisterClassA
284.  
285.     wc.style = 0 '                            Class Styles (CS_*), not Window Styles (WS_*) This is usually be set to 0.
286.     wc.lpfnWndProc = GetWindowProc '          Pointer to the window procedure for this window class. (see WIN.h)
287.     wc.cbClsExtra = 0 '                       Amount of extra data allocated for this class in memory. Usually 0.
288.     wc.cbWndExtra = 0 '                       Amount of extra data allocated in memory per window of this type. Usually 0.
289.     wc.hInstance = hi '                       Handle to application instance .
290.     wc.hIcon = 0 '                            Large (usually 32x32) icon shown when the user presses Alt+Tab. Set to 0
291.     wc.hCursor = LoadCursorW(0, IDC_ARROW) '  Cursor that will be displayed over our window.
292.     wc.hbrBackground = COLOR_WINDOW 'was +1   Background Brush to set the color of our window. '
293.     wc.lpszMenuName = 0 '                     Name of a menu resource to use for the windows with this class.
294.     wc.lpszClassName = _Offset(className) '   Name to identify the class with.
295.  
296.     If Not registered Then '   First time in funcion OK to register.
297.         If RegisterClassA(_Offset(wc)) = 0 Then
298.             Print "RegisterClassA failed:"; GetLastError
299.             End
300.         End If
301.         registered = TRUE ' Class was registered
302.     End If
303.  
304.     '--Step 2: Creating the Windows
305.     'After registering the class, create a window with it using CreateWindowExA.
306.  
307.     'Note: A visible un-owned window gets a taskbar button. To hide the inputbox window taskbar button
308.     'make the inputbox owned by our main applicationusing using  _WindowHandle instead of 0'
309.     t1 = ipb.caption_text + Chr$(0) 'Window title
310.     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
311.  
312.     'Controls are just child windows. They have a procedure, a class etc... that is registered by the system.
313.  
314.     'Label
315.     t0 = "STATIC" + Chr$(0) '        Window control is STATIC predefined class
316.     t1 = ipb.prompt_text + Chr$(0) ' Label text
317.     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
318.  
319.  
320.     'OK Button 0
321.     t0 = "BUTTON" + Chr$(0) '   Window control is BUTTON predefined class
322.     t1 = ipb.button0_text + Chr$(0)
323.     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
324.  
325.     'Cancel button 1
326.     t1 = ipb.button1_text + Chr$(0)
327.     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
328.  
329.     'Edit control
330.     t0 = "EDIT" + Chr$(0)
331.     '    t1 = "This is a edit control." + Chr$(0)
332.     t1 = "" + Chr$(0)
333.     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
334.  
335.     '===Write default text to edit control and set cursor pos
336.     Const WM_SETTEXT = &H000C
337.     Const EM_SETSEL = &HB1
338.     Dim ipbLen As Integer
339.     If ipb.default_input_text <> "" Then 'Empty skip this
340.         t0 = ipb.default_input_text + Chr$(0) 'Text to send to Edit control
341.         dummyO = SendMessageA(ipb.hwe, WM_SETTEXT, 0, _Offset(t0)) 'Set control text
342.         ipbLen = Len(ipb.default_input_text) '                      Length of string
343.         dummyO = SendMessageA(ipb.hwe, EM_SETSEL, ipbLen, ipbLen) ' Set cursor to end of text
344.     End If
345.  
346.  
347.     '---Set character length
348.     Const EM_LIMITTEXT = &H00C5
349.     dummyO = SendMessageA(ipb.hwe, EM_LIMITTEXT, ipb.max_length, 0) 'Send message maxcharacters 8
350.  
351.     '----Enable and configure password mask.
352.     'Note: The bullet is Unicode (9679 or 0x25CF ) use  SendMessageW. Use SendMessageA for old Asterisk (42)
353.     Const EM_SETPASSWORDCHAR = &HCC
354.     If ipb.pw_mask Then 'Input Mask required
355.         If ipb.pw_bullet Then 'Set bullet
356.             dummyO = SendMessageW(ipb.hwe, EM_SETPASSWORDCHAR, 9679, 0) 'Set bullet password mask
357.         Else 'Standard *
358.             dummyO = SendMessageA(ipb.hwe, EM_SETPASSWORDCHAR, 42, 0) 'Set Asterisk default mask
359.         End If
360.     Else 'Mask not required
361.         dummyO = SendMessageA(ipb.hwe, EM_SETPASSWORDCHAR, 0, 0) '  Turn password mask off
362.         ' dummyO = SendMessageW(ipb.hwe, EM_SETPASSWORDCHAR, 0, 0) '   Turn password mask off
363.     End If
364.  
365.     '*****Subclassing
366.     Const GWLP_WNDPROC = -4 ' Sets a new address for the window procedure
367.     OldWindowProc = SetWindowLongPtr(ipb.hwe, GWLP_WNDPROC, ConvertOffset(GetSubEdit)) ' set your custom procedure
368.     '*****End Subclassing
369.  
370.     'Display and Update window to ensure it has properly redrawn itself on the screen.
371.     dummyL = ShowWindow(ipb.hw, SW_SHOWDEFAULT)
372.     dummyL = UpdateWindow(ipb.hw)
373.  
374.     ' Force window to top and select with screen click
375.     Const HWND_TOPMOST = -1 '      window above all others no focus unless active
376.     Const SWP_NOSIZE = &H0001 '    ignores cx and cy size parameters
377.     Const SWP_NOACTIVATE = &H0010 'does not activate window
378.     dummyL = SetWindowPos(ipb.hw, HWND_TOPMOST, ipb.x, ipb.y, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) 'force to top
379.     _ScreenClick ipb.x + 160, ipb.y + 96 'Force focus and move cursor to left of ok button
380.  
381.     '-- Step 3: The Message Loop
382.     While GetMessageA(_Offset(msg), 0, 0, 0) > 0 ' gets a message from our application's message queue.
383.         dummyL = TranslateMessage(_Offset(msg)) '  performs some additional processing on keyboard events
384.         dummyO = DispatchMessageA(_Offset(msg)) '  sends the message out to the window that the message was sent to
385.     Wend
386. End Sub
387. '===End main function ===========================
388.      
389.      
390. '-- Step 4: the Window Procedure
391. Function WindowProc%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
392.     Const WM_CREATE = &H0001
393.     Const WM_CLOSE = &H0010
394.     Const WM_DESTROY = 2
395.     Const WM_COMMAND = &H0111
396.     Const BN_CLICKED = 0
397.     Const WM_GETTEXT = &H000D
398.     Const WM_SETFOCUS = &H0007
399.     Dim dummyO As _Offset 'Dummy variable
400.     Dim dummyL As Long '   Dummy variable
401.  
402.     Select Case uMsg
403.  
404.         Case WM_CLOSE
405.             DestroyWindow (hWnd) 'Destroy window and child windows
406.             WindowProc = 0
407.  
408.         Case WM_DESTROY
409.             PostQuitMessage 0 ' Want to exit the program
410.             WindowProc = 0
411.  
412.         Case WM_SETFOCUS
413.             dummyL = SetFocus(ipb.hwe) 'Set Edit control focus
414.             WindowProc = 0
415.  
416.         Case WM_COMMAND
417.             '==============
418.             If wParam = BN_CLICKED Then
419.                 Select Case lParam
420.                     'A button was clicked test each one
421.                     '---Sandard buttons---
422.                     Case ipb.hwb0 'OK button
423.                         'Print "Button 0 pressed OK"
424.                         'Get input text and copy to buffer (buf)
425.                         dummyO = SendMessageA(ipb.hwe, WM_GETTEXT, Len(ipb.buf), _Offset(ipb.buf))
426.                         'Print Len(buf)
427.                         dummyO = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
428.                         WindowProc = 0
429.  
430.                     Case ipb.hwb1 'Cancel button
431.                         'Print "Button 1 pressed Cancel"
432.                         ipb.buf = "" 'reset zero-length string ("").
433.                         dummyO = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Close
434.                         WindowProc = 0
435.                         '---End standard buttons---
436.                 End Select
437.             Else
438.                 'Not our message send back to system for processing
439.                 WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
440.             End If
441.             '=================
442.             WindowProc = 0
443.  
444.         Case Else
445.             'Not our message send back to system for processing
446.             WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
447.     End Select
448. End Function
449. '######--END INPUT BOX FUNCTIONS and SUBS--##################################
450.      
451. 'Ref https://www.qb64.org/forum/index.php?topic=1553.msg108409#msg108409
452. 'Ref https://www.qb64.org/forum/index.php?topic=2905.msg121660#msg121660
453.  
454. Function ConvertOffset&& (value As _Offset)
455.     Dim m As _MEM 'Define a memblock
456.     m = _Mem(value) 'Point it to use value
457.     $If 64BIT Then
458.         Dim temp As _Integer64
459.         'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
460.         _MemGet m, m.OFFSET, temp
461.         ConvertOffset = temp
462.     $Else
463.         Dim temp As Long
464.         'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
465.         _MemGet m, m.OFFSET, temp 'Like this
466.         ConvertOffset = temp 'And then assign that long value to ConvertOffset&&
467.     $End If
468.     _MemFree m 'Free the memblock
469. End Function
470.  
471. '*****Subclass function
472. Function SubEdit%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
473.     Const FALSE = 0
474.     Const TRUE = Not FALSE
475.     Const WM_NCDESTROY = &H82
476.     Const GWLP_WNDPROC = -4 ' Sets a new address for the window procedure
477.     Const WM_CONTEXTMENU = 123
478.     Const WM_CHAR = 258
479.     Const VK_RETURN = &H000D
480.     Const BM_CLICK = 245
481.     Const MB_ICONWARNING = &H30
482.  
483.     Dim processed As Integer 'Key valid and processed
484.     Dim dummyL As Long '      Dummy variable
485.     Dim dummyO As _Offset '   Dummy variable
486.     Dim ChrValid As Integer ' Character is valid
487.     Dim i As Integer
488.  
489.     'Set initial condition
490.     processed = FALSE 'Set initial value. No key processed
491.  
492.     'If we're being destroyed, restore the original WindowProc.
493.     '*****Subclassing
494.     If uMsg = WM_NCDESTROY Then
495.         dummyL = SetWindowLongPtr(hWnd, GWLP_WNDPROC, OldWindowProc)
496.     End If
497.     '*****End Subclassing
498.  
499.     'Disable context menu popup. Prevents a paste operation
500.     If uMsg = WM_CONTEXTMENU Then
501.         processed = TRUE '   Key processed nothing elese to do
502.     End If
503.  
504.     'Disable Ctrl+V   Prevents a paste operation
505.     If uMsg = WM_CHAR And wParam = 22 Then
506.         processed = TRUE '   Key processed nothing elese to do
507.     End If
508.  
509.     'Disable Enter key. Prevents anoying beep. Force enter to produce OK button click
510.     'Pressing the enter key with Edit Control  in focus.
511.     'Default behavior is to produce an annoying beep this is
512.     'because enter is an invalid key for this control.
513.  
514.     If uMsg = WM_CHAR And wParam = VK_RETURN Then 'Enter key pressed
515.         dummyO = SendMessageA(ipb.hwb0, BM_CLICK, 0, 0) ' Send message (button click) to OK button
516.         processed = TRUE '   Key processed nothing elese to do
517.     End If
518.  
519.     'Valid character section all others invalid
520.     If uMsg = WM_CHAR Then 'There is a character to process
521.         'Print wParam
522.  
523.         ChrValid = FALSE '                Set initial value
524.         For i = 1 To Len(ipb.valid_str) ' Scan valid characters and backspace=8
525.             If wParam = Asc(Mid$(ipb.valid_str, i, 1)) Or wParam = 8 Then
526.                 ChrValid = TRUE ' Key in valid range. Allow default processing
527.             End If
528.         Next
529.  
530.         If Not ChrValid Then ' Invalid character remove by setting processed
531.             processed = TRUE ' true flag. Forceses return 0 for invalid keys'
532.             'Alert user.
533.             If Not (wParam = VK_RETURN) Then ' Note: Return key is valid.
534.                 MessageBeep MB_ICONWARNING '   For invalid characters
535.             End If '                           create a "ding" to alert user.
536.         End If
537.     End If
538.     'End valid character
539.  
540.     'Set return value
541.     If processed Then 'A key was processed
542.         SubEdit = 0 '  Return 0 no further processing required
543.     Else '             No key processed pass onto default  processing
544.         '*****Subclassing
545.         SubEdit = CallWindowProc(OldWindowProc, hWnd, uMsg, wParam, lParam)
546.         '*****End Subclassing
547.     End If
548.  
549. End Function
550. '*****End Subclass functionn
551. '###_start_BM_inputbox
552.  

All the best.

[Pete]

Hmm, I can't seem to try as: ipb As input_box_udt is reported as an undefined type.

I copied the BI and BM to Notepad, and saved them in the QB64 directory. Is there another include file or library I'm missing?

Pete

[Petr]

@mpgcan

Thank you very much for so fast reply! Now its absolutly perfect!

@Pete

You need also .H file, this is above in this thread, or you can extract it from BI file.

[mpgcan]

One small refinement. In file input_box2.BM locate this section:

Code: QB64: [Select]

1.     '---Get user input string
2.     ipb_UserInput '              Run UserInput, data entered saved in buffer ipb.buf
3.     InputBoxM = ipb_get_string ' Extract data from ipb.buf return string
4. End Function
5.  

Add the line as shown below:

Code: QB64: [Select]

1.     '---Get user input string
2.     ipb_UserInput '              Run UserInput, data entered saved in buffer ipb.buf
3.     ipb.default_input_text = "" 'Reset inital value after user input
4.     InputBoxM = ipb_get_string ' Extract data from ipb.buf return string
5. End Function
6.  

Set the initial value as required automatically resets after user input.
I have included all the files in input_box2.7z

All the best
  [ You are not allowed to view this attachment ]  

[Pete]

Thanks for including the zip file, got it working. Nice Win API Input box routine!

Pete

[Dav]

Good work on this!  Works great here.

- Dav