Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Query to function _InputBox$
#1
I understand how it works, I get the numerical value using VAL, but what I don't know is how to set the coordinates at which the inputbox dialog will appear. Imagine a resolution of 1920x1080, you want to enter a value and the inputbox pops up on the top left. Of course, I have the InputBox libraries saved as they came out on the forum a few years ago, but is there any option for this built-in functionality?


Reply
#2
(03-30-2023, 09:44 AM)Petr Wrote: I understand how it works, I get the numerical value using VAL, but what I don't know is how to set the coordinates at which the inputbox dialog will appear. Imagine a resolution of 1920x1080, you want to enter a value and the inputbox pops up on the top left. Of course, I have the InputBox libraries saved as they came out on the forum a few years ago, but is there any option for this built-in functionality?

I think it centers on your screen and you can drag it around if in the way.
b = b + ...
Reply
#3
So - first I call MessageBox with some information. That's in the middle. The subsequent display of the input box at the top left is simply inappropriate.

I am attaching the old InputBox library here. It has a better look than the integrated one, BUT it doesn't work under PE. Works under QB64 2.0. I've spent several hours now trying to get it running in QB64PE as well. Without success. I was only able to get the inputbox window to appear with the buttons, but after clicking in the field and pressing anything on the keyboard, the program always crashed. The error is somewhere in the input_box2.bm file, SUB ipb_userinput, around line 378. I am attaching the original, unmodified version that works in QB64 2.0. I tried removing multiple functions in a row from some commands, splitting it up, it almost looked like it would work, but it didn't.

If someone can move it, I'll be glad. Everyone will benefit if it succeeds.


Attached Files
.zip   OldInputBox.zip (Size: 663.54 KB / Downloads: 28)


Reply
#4
Petr
it compiles and runs ok IF you use the 32-bit version of QB64pe-3.6.0
which makes me think that input_box_WIN.h is using the wrong type
Code: (Select All)
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;
}
my guess is that somewhere a wrong type is used
Reply
#5
Thank you for the advice. I did not look into the C code, this program is not my work. However, I tried to change the type in the C code as you describe, and a compilation error occurred even in the 32-bit version. I haven't tried it in the 32-bit version before, but even the information that it works in the 32-bit version (I had no idea before) pushes me further. Then is need to look for the bug to the definition of the libraries (and that they are there), somewhere there the Long type will be used instead of the Offset type. Well, I'll look at it again tomorrow if I have time. Then the behavior of the program makes sense. Thank you.  Rolleyes


Reply
#6
What's wrong with new Dialog boxes?
Code: (Select All)
_Title "Test boxes" 'b+ 2023-03-30

' default screen
_MessageBox "Box tests", "This is the _MessageBox test, coming up next is _InputBox test."
ans$ = _InputBox$("Box Tests", "Hi, how do you like the tests so far?", "Great!")
Print "So you think these tests were "; ans$
b = b + ...
Reply
#7
You know, programming is all about coordinates. 

Code: (Select All)
_Title "Test boxes" 'b+ modified by Petr 2023-03-30

' default screen
Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)
_FullScreen
_MessageBox "Box tests", "This is the _MessageBox test, and is in middle."
ans$ = _InputBox$("Box Tests", "Hi, i am not in middle. Is it great?", "No!")
Print "So think i need other inputboxes than build-in. "

Simply, when you write something, you need to determine the coordinates where it will appear. For the messagebox, that's cool, the middle is good. But about the inputbox... hey, I don't want to criticize here when I haven't added anything, so I'm looking for my own solution if the existing one doesn't suit me. That's all.


Reply
#8
This can not be true. As always, I had it in my sights the whole time. The problem was in the BM file, exactly on line 248 I had to enable the SetWindowLongA& function in the declaration and then in the next code make adjustments to (remove SetWindowLongPtr and replace it with SetWindowLongA& on line 368, the same on line 498). And finally. SetWindowPos (line 381). This is what I will be modifying each time I call. That's exactly what I want. Have it where I want it. And this is the way.

Here it is clearly described.
https://learn.microsoft.com/en-us/window...twindowpos

Repaired BM file - now works fine (with mouse) under both - QB64PE 32bit and also under QB64PE 64bit. 

Code: (Select All)
'###_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.

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

        pw_mask As Integer '   Enable password mask flag
        pw_bullet As Integer ' Password mask bullet flag
        max_length As Integer 'Maximum allowed characters

        caption_text As String 'Window title
        prompt_text As String ' Instructions to user
        valid_str As String '   All allowed characters

        button0_text As String ' Left button
        button1_text As String ' Right button

        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
    End Type

    '---Set default values
    ipb.button0_text = "OK"
    ipb.button1_text = "Cancel"

    '---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

    ipb.default_input_text = "" 'Set initial value
End Sub
'-- END inputbox_init:

'Predefined function 1: - Allow numeric and alpha characters
Function InputBox$ ()
    InputBox = InputBoxM("", "", "", "", "")
End Function

'Predefined function 2: - Allows alpha-numeric and extra valid characters.
Function InputBoxA$ (prompt As String, ttitle As String)
    InputBoxA = InputBoxM(prompt, ttitle, "", "A+", "")
End Function

'Predefined function 3: - Only numeric characters allowed.
Function InputBoxN$ (prompt As String, ttitle As String)
    InputBoxN = InputBoxM(prompt, ttitle, "", "N", "")
End Function

'Predefined function 4: - Password entry. Display asterisk.
Function InputBoxP$ (prompt As String, ttitle As String)
    InputBoxP = InputBoxM(prompt, ttitle, "", "", "A")
End Function

'Predefined function 5: - Password entry. Display bullet.
Function InputBoxPB$ (prompt As String, ttitle As String)
    InputBoxPB = InputBoxM(prompt, ttitle, "", "", "B")
End Function



'---Main input box
Function InputBoxM$ (prompt As String, ttitle As String, maxLength As String, numeric As String, pwMask As String)
    Const FALSE = 0
    Const TRUE = Not FALSE
    Dim As String str1, str2, str3, str4

    '---Set prompt text
    ipb.prompt_text = "Enter some text:" 'Default value
    If prompt <> "" Then
        ipb.prompt_text = prompt 'Label text. User instrutions
    End If

    '---Set pop-up window title (caption) text
    ipb.caption_text = "InputBox" 'Default value
    If ttitle <> "" Then
        ipb.caption_text = ttitle 'User pop-up window title
    End If

    '--Set maximum number of characters allowed
    ipb.max_length = 40 'Default allowed characters 40
    If maxLength <> "" Then
        ipb.max_length = Val(maxLength) 'Required length
    End If

    '---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
    End If
    If numeric = "A+" Then '                Set allowed alpha numeric and extra characters
        ipb.valid_str = str1 + str2 + str3 'Valid alpha/numeric and extra characters
    End If
    If numeric = "N" Then '    Set allowed numeric characters
        ipb.valid_str = str2 ' Valid characters 0-9
    End If
    If numeric = "N+" Then '          Set numeric and associated characters.
        ipb.valid_str = str2 + str4 ' Valid numeric and associated characters
    End If

    '---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
        End If
    End If

    '---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
End Function

'---Function Extract data from ipb.buf return input string
Function ipb_get_string$ ()
    Dim As String a

    '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
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 WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION

    '--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 "input_box_WIN"
        Function GetWindowProc%& () 'Windows procedure address
        '***Subclassing
        Function GetSubEdit%& () '   Edit procedure address
        '***End Subclassing
    End Declare

    '***Subclassing
    Declare CustomType Library
        Function SetWindowLongPtr& Alias "SetWindowLongPtrA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
    End Declare
    '***End Subclassing

    '  Declare CustomType Library
    Declare Dynamic Library "user32"
        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)
        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 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)
        Function SendMessageW%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
             Function SetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
        Sub MessageBeep (ByVal alert As _Unsigned Long)
        Function MessageBoxA& (ByVal hwnd As Long, Message As String, Title As String, Byval MBType As _Unsigned Long)   
End Declare

    Declare Dynamic Library "kernel32"
        Function GetModuleHandleA%& (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 dummyL As Long '   Dummy variable
    Dim dummyO 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 = 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.
        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
  ipb.hw = CreateWindowExA(0, _Offset(className), _Offset(t1), WS_OVERLAPPEDWINDOW, 10, 10, 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, 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
    Const EM_SETSEL = &HB1
    Dim ipbLen As Integer
    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
    End If


    '---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
        Else 'Standard *
            dummyO = SendMessageA(ipb.hwe, EM_SETPASSWORDCHAR, 42, 0) 'Set Asterisk default mask
        End If
    Else 'Mask not required
        dummyO = SendMessageA(ipb.hwe, EM_SETPASSWORDCHAR, 0, 0) '  Turn password mask off
        ' dummyO = SendMessageW(ipb.hwe, EM_SETPASSWORDCHAR, 0, 0) '   Turn password mask off
    End If

    '*****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
      OldWindowProc = SetWindowLongA(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
   dummyL = SetWindowPos(ipb.hw, HWND_TOPMOST, 200, 300, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) 'force to top             '200, 300 <----modify for position on the screen (for 1 run)
   _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
    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 dummyO As _Offset 'Dummy variable
    Dim dummyL As Long '   Dummy variable

    Select Case uMsg

        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
            dummyL = 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)
                        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---
                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--##################################
     
'Ref https://www.qb64.org/forum/index.php?topic=1553.msg108409#msg108409
'Ref https://www.qb64.org/forum/index.php?topic=2905.msg121660#msg121660

Function ConvertOffset&& (value As _Offset)
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
        Dim temp As _Integer64
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
        _MemGet m, m.OFFSET, temp
        ConvertOffset = temp
    $Else
        Dim temp As Long
        '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
End Function

'*****Subclass function
Function SubEdit%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
    Const FALSE = 0
    Const TRUE = Not FALSE
    Const WM_NCDESTROY = &H82
    Const GWLP_WNDPROC = -4 ' Sets a new address for the window procedure
    Const WM_CONTEXTMENU = 123
    Const WM_CHAR = 258
    Const VK_RETURN = &H000D
    Const BM_CLICK = 245
    Const MB_ICONWARNING = &H30

    Dim processed As Integer 'Key valid and processed
    Dim dummyL As Long '      Dummy variable
    Dim dummyO As _Offset '   Dummy variable
    Dim ChrValid As Integer ' Character is valid
    Dim i As Integer

    'Set initial condition
    processed = FALSE 'Set initial value. No key processed

    'If we're being destroyed, restore the original WindowProc.
    '*****Subclassing
    If uMsg = WM_NCDESTROY Then
'        dummyL = SetWindowLongPtr(hWnd, GWLP_WNDPROC, OldWindowProc)
  dummyL = SetWindowLonga(hWnd, GWLP_WNDPROC, OldWindowProc)
    End If
    '*****End Subclassing

    'Disable context menu popup. Prevents a paste operation
    If uMsg = WM_CONTEXTMENU Then
        processed = TRUE '   Key processed nothing elese to do
    End If

    'Disable Ctrl+V   Prevents a paste operation
    If uMsg = WM_CHAR And wParam = 22 Then
        processed = TRUE '   Key processed nothing elese to do
    End If

    '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
    End If

    '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
            If wParam = Asc(Mid$(ipb.valid_str, i, 1)) Or wParam = 8 Then
                ChrValid = TRUE ' Key in valid range. Allow default processing
            End If
        Next

        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 If
    End If
    '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 If

End Function
'*****End Subclass functionn
'###_start_BM_inputbox

I still have to find out why in the 32 bit version the dialog can be confirmed with the enter key and in the 64 bit version only with the mouse, some conditions for this are at the end in the BM file.

Everything else remains the same, so when you overwrite the original BM file, you can try it. I will also in my version add the option of coordinates so that I can continue with the program in which I want to use it. Thank you for your cooperation.


Reply
#9
I worked around as best I could, unfortunately I don't know C. If you look in the BM file, SubEdit is called from the H file as GetSubEdit and - probably - that's the reason why Enter doesn't work in the 64-bit version. Also, the type filtering text in window was destroyed by the addition of X and Y parameters for the window position (which I don't mind at all, unlike the non-functional enter, which really annoys me).

However. In 32 bit IDE it works with enter key too, in BM file different libraries are defined for 32 bit IDE and another for 64 bit IDE (and then look for the problem) to get it up and running as best as possible. The original intention - to determine the position of the input box SUCCEEDED, in Czech - it's sarcasm - the operation was successful, the patient died.

So, when using in 32 bits (so one doesn't have to get mad at enter) the position can be set. If a person wants to click ok with the mouse because enter is not allowed in 64bit for some reason - I looked for a reason, I didn't find it - and be able to set the position of the window,, he can use a 64-bit IDE.

I am attaching my version, I just can't get it running any better.


To make it possible for more experienced programmers to play around with it better, I am also attaching the default original version, which did not work at all in the 64-bit IDE.


Attached Files
.zip   InputBox32-3.zip (Size: 10.13 KB / Downloads: 23)
.zip   Input Box - original source.zip (Size: 9.93 KB / Downloads: 24)


Reply
#10
(03-30-2023, 08:12 PM)Petr Wrote: You know, programming is all about coordinates. 

Code: (Select All)
_Title "Test boxes" 'b+ modified by Petr 2023-03-30

' default screen
Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)
_FullScreen
_MessageBox "Box tests", "This is the _MessageBox test, and is in middle."
ans$ = _InputBox$("Box Tests", "Hi, i am not in middle. Is it great?", "No!")
Print "So think i need other inputboxes than build-in. "

Simply, when you write something, you need to determine the coordinates where it will appear. For the messagebox, that's cool, the middle is good. But about the inputbox... hey, I don't want to criticize here when I haven't added anything, so I'm looking for my own solution if the existing one doesn't suit me. That's all.

What for? you can drag the InputBox anywhere you want if you need to see something on the screen.
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)