Author Topic: InputBox  (Read 8126 times)

0 Members and 1 Guest are viewing this topic.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: InputBox
« Reply #15 on: October 30, 2021, 07:46:08 am »
@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.


Offline mpgcan

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

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

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

All the best.




Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: InputBox
« Reply #17 on: October 30, 2021, 02:30:32 pm »
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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: InputBox
« Reply #18 on: October 30, 2021, 03:25:28 pm »
@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.

Offline mpgcan

  • Newbie
  • Posts: 26
    • View Profile
Re: InputBox
« Reply #19 on: October 31, 2021, 05:21:22 am »
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.  
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.  
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 ]  

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: InputBox
« Reply #20 on: October 31, 2021, 10:00:48 am »
Thanks for including the zip file, got it working. Nice Win API Input box routine!

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: InputBox
« Reply #21 on: October 31, 2021, 06:56:37 pm »
Good work on this!  Works great here.

- Dav