Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Messages - mpgcan

Pages: [1] 2

QB64 Discussion / Re: How to remove title Bar from graphics screen?

« on: November 01, 2021, 04:50:13 am »

I have looked at removing borders and I offer my solution on this problem the following works on Windows 8.1

Code: QB64: [Select]

Option _Explicit
Do: Loop Until _ScreenExists 'run before using _WindowHandle or _title
'####################################################
'# Name:     no_border_no_caption.bas
'# Author:   MPG
'# Purpose:  Remove border and caption. Remaing area
'#           is all client.
'#           Items commented out may be required.
'#           Do: Loop Until _ScreenExists required
'#           on Windows 8.1
'# Revision: November 1 2021 - initial version
'####################################################
 
Declare CustomType Library
    Function FindWindow& (ByVal ClassName As _Offset, WindowName$)
End Declare
 
Declare Dynamic Library "User32"
    Function GetWindowLongA& (ByVal hWnd As _Offset, Byval nIndex As Long)
    Function SetWindowLongA& (ByVal hWnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
    Function SetWindowPos& (ByVal hWnd As _Offset, Byval hWndInsertAfter As Long, Byval x As Long, Byval y As Long, Byval cx As Long, Byval cy As Long, Byval wFlags As Long)
    '    Function ShowScrollBar& (ByVal hWnd As _Offset, Byval wBar As Long, Byval bShow As Long)
End Declare
 
Const GWL_STYLE = -16
Const WS_BORDER = &H800000
Const WS_CAPTION = &H00C00000
Const WS_THICKFRAME = &H00040000
Const WS_MINIMIZEBOX = &H00020000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_SYSMENU = &H00080000
'Const SB_BOTH = 3
 
Dim hwnd As _Offset
Dim As Long winstyle, Style, a
 
hwnd = _WindowHandle
winstyle = GetWindowLongA(hwnd, GWL_STYLE)
Style = (WS_CAPTION Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SYSMENU)
a = SetWindowLongA&(hwnd, GWL_STYLE, winstyle And Not Style)
'a = ShowScrollBar(hwnd, SB_BOTH, false)
 
 
Screen _NewImage(640, 320, 32)
'Cls
Line (0, 0)-(639, 319), &HFF00FF00~&&
Line (300, 0)-(300, 320), &HFF00FF00~&&
Line (0, 150)-(640, 150), &HFF00FF00~&&
 
Line (639, 0)-(639, 100), &HFF00FF00~&&
Line (0, 0)-(0, 100), &HFF00FF00~&&
 
Line (400, 0)-(500, 0), &HFF00FF00~&&
Line (400, 319)-(500, 319), &HFF00FF00~&&
 
 
_PrintString (100, 100), "Press any key to end...": Sleep
Print "The end Note:Location"
 

With the do-loop enabled. Shows borders and caption removed .
[ You are not allowed to view this attachment ]

All the best.

QB64 Discussion / Re: InputBox

« on: October 31, 2021, 05:21:22 am »

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

Code: QB64: [Select]

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

Add the line as shown below:

Code: QB64: [Select]

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

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 ]

QB64 Discussion / Re: InputBox

« 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]

Option _Explicit 
$VersionInfo:Comments=This uses Subclassing Controls!
 
'$Include:'input_box2.BI'
 
'===Your program START ==========
Screen _NewImage(400, 300, 32) '             Set main screen size
Color _RGB(0, 0, 0), _RGB32(205, 238, 205) ' Set colors
Cls
_Title "Main Program" ' Set your main program title
 
'Examples:
 
'Accepts alpha-numeric characters
Print "=1a= " + InputBoxM("", "", "", "", "")
Print "=1b= " + InputBox
 
 
'Allows alpha-numeric and extra valid characters.
ipb.default_input_text = "Test 123" 'Note set before displaying input box
Print "=2a= " + InputBoxM("Any character:", "All A+", "", "A+", "")
 
ipb.default_input_text = "" 'Note reset inital value when not required
Print "=2b= " + InputBoxA("Any character:", "All A+")
 
'Only numeric characters allowed
'Print "=3a= " + InputBoxM("Digits 0-9 only", "NUMERIC", "", "N", "")
'Print "=3b= " + InputBoxN("Digits 0-9 only", "NUMERIC")
 
'Password entry. Display asterisk
'Print "=4a= " + InputBoxM("Asterisk mask:", "PASSWORD 1", "", "", "A")
'Print "=4b= " + InputBoxP("Asterisk mask:", "PASSWORD 1")
 
'Password entry. Display bullet
'Print "=5a= " + InputBoxM("Bullet mask:", "PASSWORD 2", "", "", "B")
'Print "=5b= " + InputBoxPB("Bullet mask:", "PASSWORD 2")
 
 
'Print "=7= " + InputBoxM("Limit 4 characters:", "LIMIT", "4", "", "") '
'Print "=8= " + InputBoxM("Digits 0-9 and associated characters", "NUMERIC+", "", "N+", "")
 
Print "End"
End
System
'===Your program END ============
 
'$Include:'input_box2.BM'
 

input_box2.BI

Code: QB64: [Select]

'###_start_BI_inputbox 
Do: Loop Until _ScreenExists 'run before using _WindowHandle or _title
$If 64BIT Then
    $If VERSION < 1.6 Then
        $ERROR Requires Windows QB64 version 1.6 or above
    $End If
$End If
 
$If 32BIT Then
    $If VERSION < 1.5 Then
        $ERROR Requires Windows QB64 version 1.5 or above
    $End If
$End If
 
'===================================================================
'Input box for QB64 32 & 64 bit.
'The QB64 InputBoxM function displays a pop-up dialog box,
'prompting the user for input. It has OK and Cancel buttons.
'Function returns a text string containing the user's input
'when OK button clicked. Returns an empty text string when
'Cancel button is clicked.
'
' mpg_input_box_1.bas
' MPG 9-10-2021
'====================================================================
'InputBoxM function:
'InputBoxM (prompt$,title$,length$,numeric$,pwMask$)
'
'prompt$  - text displayed above the edit control to prompt user e.g. "Please enter a number:".
'title$   - text displayed in the title bar of the InputBoxM.
'length$  - maximum number of characters a user allowed to enter.
'numeri$c - select numeric input. 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.
'pwMask$  - select a password mask' Options are:
'            ""  Default no mask
'            "A" Password mask Asterisk
'            "B" Password mask Bullet
'
' Note1: All variables are optional. Unused variables use a null string.
' Note2: Pressing cancel button returns a null string e.g ""
' Note3: You can change default values e.g valid characters, length etc
'        Defaults, located in "Sub inputbox_init" or "Function InputBoxM"
'----------------------------------------------------------------------
'Predefined functions:
'Based on the above, five predefined InputBox functions are
'included as follows:
'
'InputBox                    - Accepts alpha-numeric characters
'InputBoxA(prompt$, title$)  - Accepts any character input
'InputBoxN(prompt$, title$)  - Only numeric characters allowed
'InputBoxP(prompt$, title$)  - Password entry. Display asterisk
'InputBoxPB(prompt$, title$) - Password entry. Display bullet
'
' Note1: Variables are optional. Unused variables use a null string
'----------------------------------------------------------------------
' VB Inputbox has some limitations as does the edit control. This QB64
' input box addresses these limitation.
' 1) Default character length 0x7FFE to 0x7FFFFFFE os dependent.
'    Added option to limit number of characters.
' 2) Default password mask was an asterisk. Added option to select
'    asterisk or bullet.
' 3) Numeric characters limited to digits 0-9 added option to have
'    extra associated characters e.g calculator +-%= etc.
'
' Using subclassing added the following:
' 4) Disabled context menu (Mouse Right click) copy and paste .
' 5) Disabled copy and paste using  Ctrl+c Ctrl+v.
' 6) Disabled copy and paste using Ctrl+Shift+c Ctrl+Shift+v.
' 7) Disabled annoying beep when pressing enter key.
' 8) Character validation.
' 9) Invalid character user alert. Uses MessageBeep.
'
'----------------------------------------------------------------------
' Code based on ideas from the following references:
' 1) Windows buttons for 32 and 64 bit IDE
'    https://www.qb64.org/forum/index.php?topic=3217.msg124966#msg124966
' 2) Base64 Encoding/Decoding with Windows, Mac, and Linux
'    https://www.qb64.org/forum/index.php?topic=3214.msg124919#msg124919
' 3) Threading
'    https://www.qb64.org/forum/index.php?topic=3865.msg132124#msg132124
 
 
'=======================================================================
'
'-----------------------------------------------------------------------
'NOTE:
'Create a new file input_box_WIN.h with the following content (Remove the comments '):
'---Start of file contents:---
     
'ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
'LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetWindowProc() {
' return (void *) WindowProc;
'}
     
'ptrszint FUNC_SUBEDIT(ptrszint*_FUNC_SUBEDIT_OFFSET_HWND,uint32*_FUNC_SUBEDIT_ULONG_UMSG,uptrszint*_FUNC_SUBEDIT_UOFFSET_WPARAM,ptrszint*_FUNC_SUBEDIT_OFFSET_LPARAM);
'LRESULT CALLBACK SubEdit(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_SUBEDIT((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetSubEdit() {
' return (void *) SubEdit;
'}
     
'---End of file contents---
'Input box uses the input_box_WIN.h file to get the WindowProc and SubEdit . Note: Place above file in your working folder (The QB64 folder).
'----------------------------------------------------------------
     
'==Note: InputBox requires this section to be added to your program.==========
'Creates a global variable ipb. Its corresponding elements, are also global.
Dim Shared ipb As input_box_udt 'The input_box_udt user defined type
inputbox_init '                  Define ipb structure and initialize elements
     
'*****Subclassing
Dim Shared OldWindowProc As Long 'Global variable store old windows process
'*****End Subclassing
 
'###_end_BI_inputbox
 

input_box2.BM

Code: QB64: [Select]

'###_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, title As String)
    InputBoxA = InputBoxM(prompt, title, "", "A+", "")
End Function
 
'Predefined function 3: - Only numeric characters allowed.
Function InputBoxN$ (prompt As String, title As String)
    InputBoxN = InputBoxM(prompt, title, "", "N", "")
End Function
 
'Predefined function 4: - Password entry. Display asterisk.
Function InputBoxP$ (prompt As String, title As String)
    InputBoxP = InputBoxM(prompt, title, "", "", "A")
End Function
 
'Predefined function 5: - Password entry. Display bullet.
Function InputBoxPB$ (prompt As String, title As String)
    InputBoxPB = InputBoxM(prompt, title, "", "", "B")
End Function
 
 
 
'---Main input box
Function InputBoxM$ (prompt As String, title 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 title <> "" Then
        ipb.caption_text = title '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)
    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
 
    '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
    '*****End Subclassing
 
    'Display and Update window to ensure it has properly redrawn itself on the screen.
    dummyL = ShowWindow(ipb.hw, SW_SHOWDEFAULT)
    dummyL = UpdateWindow(ipb.hw)
 
    ' Force window to top and select with screen click
    Const HWND_TOPMOST = -1 '      window above all others no focus unless active
    Const SWP_NOSIZE = &H0001 '    ignores cx and cy size parameters
    Const SWP_NOACTIVATE = &H0010 'does not activate window
    dummyL = SetWindowPos(ipb.hw, HWND_TOPMOST, ipb.x, ipb.y, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) 'force to top
    _ScreenClick ipb.x + 160, ipb.y + 96 'Force focus and move cursor to left of ok button
 
    '-- Step 3: The Message Loop
    While GetMessageA(_Offset(msg), 0, 0, 0) > 0 ' gets a message from our application's message queue.
        dummyL = TranslateMessage(_Offset(msg)) '  performs some additional processing on keyboard events
        dummyO = DispatchMessageA(_Offset(msg)) '  sends the message out to the window that the message was sent to
    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)
    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
 

All the best.

QB64 Discussion / Re: How to remove title Bar from graphics screen?

« on: October 30, 2021, 03:30:19 am »

I had a delay problem similar to this, one of you guys provided a neat solution which seems to work on this. At the top of your script add the following line :

Code: QB64: [Select]

Do: Loop Until _ScreenExists 'before using _WindowHandle or _title

Worked on this:

Code: QB64: [Select]

Do: Loop Until _ScreenExists 'before using _WindowHandle or _title
 
Const HWND_TOPMOST%& = -1
Const SWP_NOSIZE%& = &H1
Const SWP_NOMOVE%& = &H2
Const SWP_SHOWWINDOW%& = &H40
 
Declare Dynamic Library "User32"
    Function GetWindowLongA& (ByVal hwnd As Long, Byval nIndex As Long)
    Function SetWindowPos& (ByVal hWnd As Long, 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 SetWindowLongA& (ByVal hwnd As Long, Byval nIndex As Long, Byval dwNewLong As Long)
    Function GetForegroundWindow&
    Function SetLayeredWindowAttributes& (ByVal hwnd As Long, Byval crKey As Long, Byval bAlpha As _Unsigned _Byte, Byval dwFlags As Long)
End Declare
Screen _NewImage(600, 480, 32)
GWL_STYLE = -16
ws_border = &H800000
WS_VISIBLE = &H10000000
_Title "Borderless Window"
Dim hwnd As Long
hwnd = _WindowHandle
_Delay .1
Level = 175
SetWindowOpacity hwnd, Level
 
winstyle2& = GetWindowLongA&(hwnd, GWL_STYLE)
winstyle& = -12582913
a& = SetWindowLongA&(hwnd, GWL_STYLE, winstyle& And WS_VISIBLE) ' AND NOT WS_VSCROLL) ' AND NOT ws_border)
a& = SetWindowPos&(hwnd, 0, 0, 0, 0, 0, 39)
msg$ = "Welcome to Translucent Windows Without Borders!"
i = 16
Color &HFFFFFFFF, &H0 ' white foreground, transparent background
Do
    _Limit 60
    FGwin& = GetForegroundWindow&
    If hwnd <> FGwin& Then ' QB64 no longer in focus.
        While _MouseInput: Wend
        a& = SetWindowPos&(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW)
        Do: _Limit 30: Loop Until hwnd = GetForegroundWindow&
    End If
    If InKey$ = Chr$(27) Then Exit Do
    For y = 480 To 0 Step -1
        For x = 640 To 0 Step -1
            PSet (x, 480 - y), _RGB(y / 2 Mod 256, 100, 200) ' (x MOD 512 XOR y) MOD 256, y MOD 256)
        Next
    Next
    _PrintString (92, 1), msg$
    _PrintString (1, 464), "Press Esc to quit."
    _PrintString (250, i), "Hi Chez-Pete!"
    _Display
    i = i + 1
    If i > 464 Then i = 16
Loop
System
 
Sub SetWindowOpacity (hwnd As Long, Level)
    Dim Msg As Long
    Const G = -20
    Const LWA_ALPHA = &H2
    Const WS_EX_LAYERED = &H80000
    Msg = GetWindowLongA&(hwnd, G)
    Msg = Msg Or WS_EX_LAYERED
    action = SetWindowLongA&(hwnd, G, Msg)
    action = SetLayeredWindowAttributes(hwnd, 0, Level, LWA_ALPHA)
End Sub
 

All the best.

Programs / Re: Windows buttons for 32 and 64 bit IDE - Take 2

« on: October 13, 2021, 06:03:12 am »

RichEdit versions 1.0, 2.0, 3.0 and 4.1 were included in Windows at various times. Not sure which one corresponds to what version of Windows. I used the latest version which may not be appropriate for your requirements. See this page https://docs.microsoft.com/en-us/windows/win32/controls/about-rich-edit-controls .

Quote

I am not sure why string need to use _OFFSET...is this string pointer or general purpose pointer which just read content from
variable address ..but ok ..

I think the following best explains why they are string pointers:

LPCTSTR lpClassName –pointer to a null-terminated string containing the predefined control-class names. The class name can either be one created with RegisterClass or one of the predefined classes used to create child controls. However although the lpClassName is declared to be an LPCTSTR it can be either a pointer to a string or a class atom returned by RegisterClass or RegisterClassEx.

LPCTSTR lpWindowName – pointer to a null-terminated string that specifies the window name.

Programs / Re: Windows buttons for 32 and 64 bit IDE - Take 2

« on: October 12, 2021, 10:35:33 am »

To get you up and running edit file window_controls_7.bas as follows:

Code: QB64: [Select]

 
'1)--Under Libaries add the following:
DECLARE DYNAMIC LIBRARY "Msftedit"
END DECLARE
 
'2)--under Variables add the following:
Dim Shared hwRe1 As _Offset 'Rich edit control
 
'3)---change this line as shown. Increases window size:
hw = CreateWindowExA(0, _Offset(className), _Offset(t1), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 432, 640, 0, 0, hi, 0): If 0 = hw Then System
 
'4)---A the end of Edit multiline control section
'---add the following section:
 
'5)---Richedit control
t0 = "RICHEDIT50W" + Chr$(0) 'predefined class
t1 = "This is a" + CrLf + "Multiline Richedit control." + CrLf + "Click in me and type." + CrLf + "It should scroll automatically in both directions, but there aren't any scroll bars." + CrLf + "Close the window to see the text printed to the console." + Chr$(0)
 
hwRe1 = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD or WS_VSCROLL Or WS_HSCROLL Or ES_MULTILINE Or ES_WANTRETURN, 10, 460, 400, 120, hw, 0, hi, 0): If 0 = hwRe1 Then System
 

Quick test , after compiling, copy a image into the Richedit control as follows:
Navigate to qb64\source\ right click on file qb64.ico and select copy. Place mouse in Richedit control and press ctrl+v
Expected result image displayed in Rich edit control

Programs / Windows buttons for 32 and 64 bit IDE - Take 2

« on: October 11, 2021, 06:21:01 am »

With the release of QB64 v2.0 a seperate manifest nolonger required for Windows controls:
"Automatically embeds a manifest file when compiling an exe with $VersionInfo, so that Common Controls v6.0 gets linked at runtime."

Regarding windows controls, I found this page https://www.qb64.org/forum/index.php?topic=3217.msg124966#msg124966 informative and useful. Seems it was never completed which is a shame! However it is easy to comment and be critical of others, hence I wrote an upgrade to give something back.

Talking about comments, you will notice there are several lines that have comments, these are alternatives for doing the same thing. Comment an active line to disable it, un-comment an alternative line if available to see what it does.

Save the following files and place them in your QB64 folder:

window_controls_7.bas

Code: QB64: [Select]

Option _Explicit
DefStr A-Z
$VersionInfo:Comments=This uses Controls! 'Creates flat controls remove for 3D
Do: Loop Until _ScreenExists '             before using _WindowHandle or _title
' A Simple Window for QB64 32 & 64 bit
' window_controls_7.bas
' MPG 30-9-2021
'
'---------------------------------------------------------------
'NOTE:
'Create a new file WIN.h with the following content (Remove the comments '):
'---Start of file contents:---
'ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
 
'LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
 
'void * GetWindowProc() {
' return (void *) WindowProc;
'}
'---End of file contents---
'Your program uses the WIN.h file to get the WindowProc. Note: Place above file in your working folder (The QB64 folder).
'----------------------------------------------------------------
 
'--Constants
     
Const IDC_ARROW = &H7F00
Const COLOR_WINDOW = 5
 
Const WS_OVERLAPPED = 0
Const WS_EX_CLIENTEDGE = &H00000200
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_MINIMIZEBOX = &H00020000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_VSCROLL = &H00200000
Const WS_HSCROLL = &H00100000
'Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU
Const WS_TABSTOP = &H00010000
Const WS_VISIBLE = &H10000000
Const WS_CHILD = &H40000000
Const WS_GROUP = &H00020000
 
Const CW_USEDEFAULT = &H80000000
 
Const WM_CLOSE = &H0010
Const WM_CREATE = 1
Const WM_DESTROY = 2
Const WM_COMMAND = &H0111
Const WM_SETTEXT = &H000C
Const WM_GETTEXT = &H000D
 
Const SW_SHOWDEFAULT = &HA
 
Const BS_PUSHBUTTON = 0 '     Standard button
Const BS_AUTOCHECKBOX = 3 '   Multi-Checkbox button
Const BN_CLICKED = 0
Const BS_RADIOBUTTON = 4 '     Single Radio button
Const BS_AUTORADIOBUTTON = 9 ' Multi-radio buttons
Const BS_GROUPBOX = 7 '        Group box "eye candy"
 
Const BM_GETCHECK = &HF0
Const BST_CHECKED = &H1
Const BM_CLICK = &H00F5
Const BM_SETCHECK = &HF1
 
Const ES_LEFT = 0
Const EM_SETPASSWORDCHAR = &HCC
 
Const ES_NUMBER = &H2000
Const ES_PASSWORD = &H0020
 
Const ES_MULTILINE = 4
Const ES_AUTOVSCROLL = &H0040
Const ES_AUTOHSCROLL = &H0080
Const ES_WANTRETURN = &H1000
 
 
'--Types
Type POINT
    As Long x
    As Long y
End Type
 
Type MSG
    As _Offset hwnd
    As _Unsigned Long message
    As _Unsigned _Offset wParam 'unsigned pointer sized integer
    As _Offset lParam 'pointer sized integer
    As _Unsigned Long time
    As POINT pt
End Type
 
Type WNDCLASSA
    As _Unsigned Long style
    $If 64BIT Then
        As String * 4 padding
    $End If
 
    As _Offset lpfnWndProc
    As Long cbClsExtra, cbWndExtra
    As _Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName
End Type
 
'--Libaries
Declare Library "win"
    Function GetWindowProc%& ()
End Declare
 
Declare Dynamic Library "user32"
    Function SendMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
    Function DefWindowProcA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
    Sub PostQuitMessage (ByVal nExitCode As Long)
    Function LoadCursorW%& (ByVal hInstance As _Offset, Byval lpCursorName As _Offset)
    Function RegisterClassA~% (ByVal lpWndClass As _Offset)
    Function CreateWindowExA%& (ByVal dwExStyle As Long, Byval lpClassName As _Offset, Byval lpWindowName As _Offset, Byval dwStyle As Long, Byval X As Long, Byval Y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As _Offset, Byval hMenu As _Offset, Byval hInstance As _Offset, Byval lpParam As _Offset)
    Function ShowWindow& (ByVal hWnd As _Offset, Byval nCmdShow As Long)
    Function UpdateWindow& (ByVal hWnd As _Offset)
    Function GetMessageA% (ByVal lpMsg As _Offset, Byval hWnd As _Offset, Byval wMsgFilterMin As _Unsigned Long, Byval wMsgFilterMax As _Unsigned Long)
    Function TranslateMessage& (ByVal lpMsg As _Offset)
    Function DispatchMessageA%& (ByVal lpmsg As _Offset)
    Sub DestroyWindow (ByVal hWnd As _Offset)
    Function PostMessageA%& (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
    Function SetWindowTextA& (ByVal hWnd As _Offset, Byval lpString As _Offset)
    Function GetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long)
    Function SetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
End Declare
 
Declare Dynamic Library "kernel32"
    Function GetModuleHandleW%& (ByVal lpModuleName%&)
    Function GetLastError~& ()
End Declare
 
 
'--Variables
 
Dim Shared hi As _Offset '   Handle to application instance
Dim Shared wc As WNDCLASSA ' define wc as WNDCLASSEX structure
Dim msg As MSG
Dim Shared hw As _Offset '    Handle to window created
 
Dim Shared hwb0 As _Offset '  Handle to window button created
Dim Shared hwb1 As _Offset '  Handle to window button created
Dim Shared hwb2 As _Offset '  Handle to window button created
 
Dim Shared hwcb0 As _Offset ' Handle to window checkbox button created
Dim Shared hwcb1 As _Offset ' Handle to window checkbox button created
Dim Shared hwcb2 As _Offset ' Handle to window checkbox button created
 
Dim Shared hwgb1 As _Offset ' Handle to group box 1
Dim Shared hwr11 As _Offset ' Handle to window radio botton
Dim Shared hwr12 As _Offset
Dim Shared hwr13 As _Offset
 
Dim Shared hwgb2 As _Offset ' Handle to group box 2
Dim Shared hwr21 As _Offset ' Handle to window radio botton
Dim Shared hwr22 As _Offset
Dim Shared hwr23 As _Offset
 
Dim Shared hwLabel1 As _Offset
Dim Shared hwLabel2 As _Offset
 
Dim Shared hwe1 As _Offset 'Single line edit control
Dim Shared hwe2 As _Offset 'Multiline edit control
Dim Shared hwLB As _Offset 'Handle to list box
Dim Shared hwCB As _Offset 'Handle to combo drop-down list box
 
Dim Shared discardb As Long 'Dummy variable
Dim Shared discardp As _Offset 'Dummy variable
Dim Shared t0 As String 'Type of component
Dim Shared t1 As String 'Title or componets text
Dim Shared buf1 As String * 64 'Single line edit buffer
Dim Shared buf2 As String * 4096 'Multi line edit buffer
     
Dim Shared 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&line feed
 
 
Dim Shared As String className '       Variable className stores name of our window class
className = "myWindowClass" + Chr$(0) 'Used in wc. which in turn is used to register window class with the system.
 
hi = GetModuleHandleW(0) 'Handle to application instance
 
'---Step 1: Registering the Window Class
'Fill out the members of WNDCLASSEX structure (wc) and call RegisterClassA
 
wc.style = 0 '                            Class Styles (CS_*), not Window Styles (WS_*) This is usually be set to 0.
wc.lpfnWndProc = GetWindowProc '          Pointer to the window procedure for this window class. (see WIN.h)
wc.cbClsExtra = 0 '                       Amount of extra data allocated for this class in memory. Usually 0.
wc.cbWndExtra = 0 '                       Amount of extra data allocated in memory per window of this type. Usually 0.
wc.hInstance = hi '                       Handle to application instance .
wc.hIcon = 0 '                            Large (usually 32x32) icon shown when the user presses Alt+Tab. Set to 0
wc.hCursor = LoadCursorW(0, IDC_ARROW) '  Cursor that will be displayed over our window.
wc.hbrBackground = COLOR_WINDOW 'was +1   Background Brush to set the color of our window. '
wc.lpszMenuName = 0 '                     Name of a menu resource to use for the windows with this class.
wc.lpszClassName = _Offset(className) '   Name to identify the class with.
 
If RegisterClassA(_Offset(wc)) = 0 Then
    Print "RegisterClassA failed:"; GetLastError
    End
    'Else Print "OK"
End If
 
'--Step 2: Creating the Windows
 
'--Main window
'After registering the class, create a window with it using CreateWindowExA.
 
'HWND CreateWindowExA(
'  DWORD     dwExStyle,     0                     Extended windows style. Not used set to 0
'  LPCSTR    lpClassName,  _Offset(className)     Tells the system what kind of window to create.
'  LPCSTR    lpWindowName, _Offset(t1)            Text displayed in the Caption or Title Bar.
'  DWORD     dwStyle,      WS_OVERLAPPEDWINDOW... Window Style parameters see constants
'  int       X,            CW_USEDEFAULT          Top left corner of your window. Let windows choose
'  int       Y,            CW_USEDEFAULT          Top left corner of your window. Let windows choose
'  int       nWidth,       432                    Width and
'  int       nHeight,      400                    height of the window
'  HWND      hWndParent,     0                    No parent window set handle to 0
'  HMENU     hMenu,          0                    Not menu set to 0
'  HINSTANCE hInstance,     hi                    Module instance handle associated with the window.
' LPVOID    lpParam         0                    Used with MDI child window not used set to 0
')
 
t1 = "Window Ref 1" + Chr$(0)
'hw = CreateWindowExA(0, _Offset(className), _Offset(t1), WS_HSCROLL Or WS_OVERLAPPEDWINDOW Or WS_VSCROLL, CW_USEDEFAULT, CW_USEDEFAULT, 432, 400, 0, 0, hi, 0): If 0 = hw Then System
hw = CreateWindowExA(0, _Offset(className), _Offset(t1), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 432, 520, 0, 0, hi, 0): If 0 = hw Then System
 
'--Standard Controls: Button, Edit, List Box etc
'Controls are just child windows. They have a procedure, a class etc... that is registered by the system.
'Anything you can do with a normal window you can do with a control.
 
'-Standard Buttons require style BS_PUSHBUTTON
 
t0 = "BUTTON" + Chr$(0) '  Set: Window control is BUTTON predefined class
t1 = "Button 0" + Chr$(0) 'Set: Button display text
hwb0 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 10, 10, 75, 23, hw, 0, hi, 0): If 0 = hwb0 Then System
 
t0 = "BUTTON" + Chr$(0) '  Set: Window control is BUTTON predefined class
t1 = "Button 1" + Chr$(0) 'Set: Button display text
hwb1 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 10, 37, 75, 23, hw, 0, hi, 0): If 0 = hwb1 Then System
 
t0 = "BUTTON" + Chr$(0) '  Set: Window control is BUTTON
t1 = "Button 2" + Chr$(0) 'Set: Button display text
hwb2 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 10, 64, 75, 23, hw, 0, hi, 0): If 0 = hwb2 Then System
 
'-Checkbox Buttons require style BS_AUTOCHECKBOX
t0 = "BUTTON" + Chr$(0) '  Set: Window control is BUTTON
t1 = "ChkBox0" + Chr$(0) 'Check box label display text
hwcb0 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_AUTOCHECKBOX, 10, 91, 90, 23, hw, 0, hi, 0): If 0 = hwcb0 Then System
 
t0 = "BUTTON" + Chr$(0) '  Set: Window control is BUTTON
t1 = "ChkBox1" + Chr$(0) 'Check box label display text
hwcb1 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_AUTOCHECKBOX, 10, 118, 90, 23, hw, 0, hi, 0): If 0 = hwcb1 Then System
 
t0 = "BUTTON" + Chr$(0) '  Set: Window control is BUTTON
t1 = "ChkBox2" + Chr$(0) 'Check box label display text
hwcb2 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or BS_AUTOCHECKBOX, 10, 145, 90, 23, hw, 0, hi, 0): If 0 = hwcb2 Then System
 
 
'Standard Radio Buttons require style BS_RADIOBUTTON (single) or BS_AUTORADIOBUTTON (group)
'First button of a group must have following styles WS_TABSTOP WS_GROUP
'The first control after last group must have style WS_GROUP to terminate last group
'Note: A BS_GROUPBOX is "eye candy" and does not contribute to a radio box group.
' The crucial parameter to control radio or check box grouping is the style WS_GROUP
 
'--Bank 1: Group box1
t0 = "BUTTON" + Chr$(0) 'predefined class
t1 = "Group box1" + Chr$(0)
hwgb1 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_GROUPBOX, 100, 10, 300, 50, hw, 0, hi, 0): If 0 = hwgb1 Then System
t1 = "Radio 11" + Chr$(0)
hwr11 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_AUTORADIOBUTTON Or WS_TABSTOP Or WS_GROUP, 105, 30, 90, 23, hw, 0, hi, 0): If 0 = hwr11 Then System
t1 = "Radio 12" + Chr$(0)
hwr12 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_AUTORADIOBUTTON, 200, 30, 90, 23, hw, 0, hi, 0): If 0 = hwr12 Then System
t1 = "Radio 12" + Chr$(0)
hwr13 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_AUTORADIOBUTTON, 300, 30, 90, 23, hw, 0, hi, 0): If 0 = hwr13 Then System
 
'--Bank 2: Group box2
t0 = "BUTTON" + Chr$(0) 'predefined class
t1 = "Group box2" + Chr$(0)
hwgb2 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_GROUPBOX, 100, 70, 300, 50, hw, 0, hi, 0): If 0 = hwgb2 Then System
t1 = "Radio 21" + Chr$(0)
hwr21 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_AUTORADIOBUTTON Or WS_TABSTOP Or WS_GROUP, 105, 90, 90, 23, hw, 0, hi, 0): If 0 = hwr21 Then System
t1 = "Radio 22" + Chr$(0)
hwr22 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_AUTORADIOBUTTON, 200, 90, 90, 23, hw, 0, hi, 0): If 0 = hwr22 Then System
t1 = "Radio 23" + Chr$(0)
hwr23 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD Or BS_AUTORADIOBUTTON, 300, 90, 90, 23, hw, 0, hi, 0): If 0 = hwr23 Then System
 
'--Label1
t0 = "STATIC" + Chr$(0) 'predefined class
t1 = "Label1 Enter your score:" + Chr$(0)
hwLabel1 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD, 100, 125, 372, 16, hw, 0, hi, 0): If 0 = hwLabel1 Then System
 
'--Label2
t0 = "STATIC" + Chr$(0) 'predefined class
t1 = "Label2 Enter your name:" + Chr$(0)
hwLabel2 = CreateWindowExA(0, _Offset(t0), _Offset(t1), WS_VISIBLE Or WS_CHILD, 100, 142, 372, 16, hw, 0, hi, 0): If 0 = hwLabel2 Then System
 
'--Edit single line
 
t0 = "EDIT" + Chr$(0) 'predefined class
t1 = "This is a edit control." + Chr$(0)
hwe1 = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), _Offset(t1), WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or ES_LEFT, 12, 175, 372, 26, hw, 0, hi, 0): If 0 = hwe1 Then System
 
'---Edit  multiline control
 
t0 = "EDIT" + Chr$(0) 'predefined class
t1 = "This is a" + CrLf + "multiline edit control." + CrLf + "Click in me and type." + CrLf + "It should scroll automatically in both directions, but there aren't any scroll bars." + CrLf + "Close the window to see the text printed to the console." + Chr$(0)
hwe2 = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), _Offset(t1), WS_VSCROLL Or WS_HSCROLL Or WS_TABSTOP Or WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_LEFT Or ES_MULTILINE Or ES_WANTRETURN, 10, 210, 400, 120, hw, 0, hi, 0): If 0 = hwe2 Then System
 
'---List box control
Const LBS_NOTIFY = 1
t0 = "LISTBOX" + Chr$(0) 'predefined class
hwLB = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), 0, WS_CHILD Or WS_VISIBLE Or LBS_NOTIFY Or WS_VSCROLL Or ES_AUTOVSCROLL, 10, 340, 150, 120, hw, 0, hi, 0): If 0 = hwLB Then System
 
'---Combo drop-down List control
Const CBS_READONLY = &H1000 'Remove to edit selection
Const CBS_NOTIFY = &H0008
Const CBS_DROPDOWN = 2
Const CBS_DROPDOWNLIST = 3
t0 = "COMBOBOX" + Chr$(0) 'predefined class
hwCB = CreateWindowExA(WS_EX_CLIENTEDGE, _Offset(t0), 0, WS_CHILD Or WS_VISIBLE Or CBS_DROPDOWNLIST Or CBS_READONLY, 170, 340, 150, 110, hw, 0, hi, 0): If 0 = hwCB Then System
 
'--hwCB Add items to combo box
Const CB_ADDSTRING = 323
Dim j As Long
For j = 1 To 10
    t0 = "Combo box Item" + Str$(j) + Chr$(0)
    discardp = SendMessageA(hwCB, CB_ADDSTRING, 0, _Offset(t0)) ' Add text
Next
'--End hwCB Add items to combo box
 
'--hwCB Initialize combo control default selection. Note -1 no selection
Dim Shared CB_selected_item As Long 'Ref selection
CB_selected_item = 7 'set initial selection value
 
'Zero index. Note index 2 selects the third element
Const CB_SETCURSEL = 334 'Set selection
discardp = SendMessageA(hwCB, CB_SETCURSEL, CB_selected_item, 0)
'discardp = SendMessageA(hwCB, CB_SETCURSEL, -1, 0) 'No selection
'---End combo control
 
 
'--hwLB Add items to list box
Const LB_ADDSTRING = &H180
Dim i As Long
For i = 1 To 10
    t0 = "List Box Item" + Str$(i) + Chr$(0)
    discardp = SendMessageA(hwLB, LB_ADDSTRING, 0, _Offset(t0)) ' Add text
Next
'--End hwLB Add items to list box
 
'--hwLB Initialize list control default selection. Note -1 no selection
'Zero index. Note index 2 selects the third element
Const LB_SETCURSEL = &H186 'Set selection
Dim Shared LB_selected_item As Long 'Ref selection
LB_selected_item = 8 'set initial selection value
discardp = SendMessageA(hwLB, LB_SETCURSEL, LB_selected_item, 0)
'discardp = SendMessageA(hwLB, LB_SETCURSEL, -1, 0) 'No selection
'---End list control
 
'--Initialize set initial conditions
discardp = SendMessageA(hwcb1, BM_SETCHECK, BST_CHECKED, 0) 'Set check box
discardp = SendMessageA(hwr13, BM_SETCHECK, BST_CHECKED, 0) 'Set radio button
discardp = SendMessageA(hwr23, BM_SETCHECK, BST_CHECKED, 0) 'Set radio button
 
t0 = "CLOSE" + Chr$(0) '  Text to send to buttton Button2
'discardp = SetWindowTextA&(hwb2, _Offset(t0)) '             Method 1 Change button text from Button2 to Close
discardp = SendMessageA(hwb2, WM_SETTEXT, 0, _Offset(t0)) '  Method 2 Alternative
 
t0 = "Label2 text changed ?" + Chr$(0) '    Text to send to Label2
'discardp = SetWindowTextA&(hwLabel2, _Offset(t0)) '             Method 1
discardp = SendMessageA(hwLabel2, WM_SETTEXT, 0, _Offset(t0)) ' Method 2 Alternative
 
t0 = "Edit control:" + Chr$(0) '             Text to send to Edit control
'discardp = SetWindowTextA&(hwe1, _Offset(t0)) '            Method 1
discardp = SendMessageA(hwe1, WM_SETTEXT, 0, _Offset(t0)) ' Method 2 Alternative
 
'discardp = SendMessageA(hwe1, EM_SETPASSWORDCHAR, 0, 0) '        Edit control Remove password character
'discardp = SendMessageA(hwe1, EM_SETPASSWORDCHAR, Asc("*"), 0) ' Edit control Set password character
 
'Dim Shared winstyle As Long 'current window style variable
Const GWL_STYLE = -16 'Window style command
 
'winstyle = GetWindowLongA(hwe1, GWL_STYLE)
'discardp = SetWindowLongA(hwe1, GWL_STYLE, winstyle Or ES_NUMBER) '     Add number style
 
'winstyle = GetWindowLongA(hwe1, GWL_STYLE)
'discardp = SetWindowLongA(hwe1, GWL_STYLE, winstyle And Not ES_NUMBER) 'Remove number style
 
'--End Initialize set initial conditions
 
'----How to set top/bottom margins of a Win32 Edit control "hwe2"
Declare CustomType Library
    Function GetWindowRect& (ByVal hWnd As _Offset, Byval lpRect As _Offset)
    Function GetClientRect& (ByVal hWnd As _Offset, Byval lpRect As _Offset)
    Function InflateRect& (ByVal lpRect As _Offset, Byval x As Long, Byval y As Long)
End Declare
Type RECT
    As Long left, top, right, bottom
End Type
Dim As RECT rect
Const EM_SETRECT = &H00B3
If GetClientRect(hwe2, _Offset(rect)) Then
    Print rect.left, rect.top, rect.right, rect.bottom
 
    If InflateRect(_Offset(rect), -5, -5) Then
        Print rect.left, rect.top, rect.right, rect.bottom
        ' Edit control set margin
        If SendMessageA(hwe2, EM_SETRECT, 0, _Offset(rect)) Then ' Edit control set margin
            Print "margin set hwe2"
        End If
    End If
End If
 
 
'Display and Update window to ensure it has properly redrawn itself on the screen.
discardb = ShowWindow(hw, SW_SHOWDEFAULT)
discardb = UpdateWindow(hw)
 
'-- Step 3: The Message Loop
While GetMessageA(_Offset(msg), 0, 0, 0) > 0 '   gets a message from your application's message queue.
    discardb = TranslateMessage(_Offset(msg)) '  performs some additional processing on keyboard events
    discardp = DispatchMessageA(_Offset(msg)) '  sends the message out to the window that the message was sent to
Wend
 
 
Print "End"
End
System
'####== End program ==###
 
'-- Step 4: the Window Procedure
Function WindowProc%& (hWnd As _Offset, uMsg As _Unsigned Long, wParam As _Unsigned _Offset, lParam As _Offset)
    Dim As String a, srch, replace
 
    Select Case uMsg
 
        ' Case WM_CREATE
        '     WindowProc = 0
 
        Case WM_CLOSE
            discardp = SendMessageA(hwe2, WM_GETTEXT, Len(buf2), _Offset(buf2)) 'Get text
            Print: Print "First part of the edit control text:": Print
 
            a$ = _Trim$(buf2) '                      Remove spaces
            a$ = Left$(a$, InStr(a$, Chr$(0)) - 1) ' Buffer contains a null terminated string. Find position of null.
            buf2 = "" '                              Extract characters upto this null character. Clear buffer
 
            '----Remove unwanted CRLF---
            srch$ = Chr$(13) + Chr$(10)
            replace$ = Chr$(10)
            Do While InStr(a$, srch$)
                a$ = Mid$(a$, 1, InStr(a$, srch$) - 1) + replace$ + Mid$(a$, InStr(a$, srch$) + Len(srch$))
            Loop
            '-----END remove-------------
 
 
            Print a$
 
            Print "Radio 11: 0x"; Hex$(SendMessageA(hwr11, BM_GETCHECK, 0, 0))
            Print "Radio 12: 0x"; Hex$(SendMessageA(hwr12, BM_GETCHECK, 0, 0))
            If SendMessageA(hwcb1, BM_GETCHECK, 0, 0) = BST_CHECKED Then
                Print: Print "Check box is checked:": Print
            End If
 
 
            DestroyWindow (hWnd) 'Destroy window and child windows
            WindowProc = 0
 
        Case WM_DESTROY
            PostQuitMessage 0 'Want to exit the program
            WindowProc = 0
 
        Case WM_COMMAND
            '===============
 
            '---Respond to Listbox selection
            Const LBN_SELCHANGE = 1
            Const LB_GETCURSEL = &H188 ' get index of currently selected item in listbox
            Const LB_GETTEXT = &H189 '   get selected item text
 
            Dim LBwParm As Long
            Dim selectedIndexLB As _Offset 'item selected returned as offset
            Dim tempLB As Long '            temp variable
            Dim textBuffLB As String * 32 ' Buffer to store selected string
 
            LBwParm = ConvertOffset&&(wParam) ' Convert to long
 
            'listbox hwLB selection changed
            If (HIWORD(LBwParm) = LBN_SELCHANGE) And (lParam = hwLB) Then
                selectedIndexLB = SendMessageA(hwLB, LB_GETCURSEL, 0, 0) 'Get current selection
                tempLB = ConvertOffset&&(selectedIndexLB) '               convert to long
                '--Get item text store in buffer
                discardp = SendMessageA(hwLB, LB_GETTEXT, tempLB, _Offset(textBuffLB))
 
                Print "LBzzzzzzz", LBwParm, HIWORD(LBwParm)
                Print "List box selection = "; tempLB
                Print textBuffLB
                WindowProc = 0
            End If
            '---End Respond to Listbox selection
 
 
            '---Respond to Combo Listbox selection
            Const CBN_SELCHANGE = 1
            Const CB_GETCURSEL = 327 ' get index of currently selected item in combo listbox
            Const CB_GETLBTEXT = 328 ' get selected item text
 
            Dim CBwParm As Long
            Dim selectedIndexCB As _Offset 'item selected returned as offset
            Dim tempCB As Long '            temp variable
            Dim textBuffCB As String * 32 ' Buffer to store selected string
 
            CBwParm = ConvertOffset&&(wParam) 'Convert to long
 
            'Combo listbox hwCB selection changed
            If (HIWORD(CBwParm) = CBN_SELCHANGE) And (lParam = hwCB) Then
                selectedIndexCB = SendMessageA(hwCB, CB_GETCURSEL, 0, 0) 'Get current selection
                tempCB = ConvertOffset&&(selectedIndexCB) '               convert to long
                '--Get item text store in buffer
                discardp = SendMessageA(hwCB, CB_GETLBTEXT, tempCB, _Offset(textBuffCB))
 
                Print "CBxxxxxx", LBwParm, HIWORD(LBwParm)
                Print "Combo box selection = "; tempCB
                Print textBuffCB
                WindowProc = 0
            End If
            '---End Respond to Combo Listbox selection
 
 
            '=====================
            If wParam = BN_CLICKED Then
                Select Case lParam
                    'A button was clicked test each one
 
                    '---Three standard buttons---
                    Case hwb0
                        Print "Button 0 pressed"
                        WindowProc = 0
                    Case hwb1
                        'Get input text and copy to buffer (1)
 
                        discardp = SendMessageA(hwe1, WM_GETTEXT, Len(buf1), _Offset(buf1)) 'Read text from Edit control into buf1
                        Print "Button 1 pressed"
                        a$ = Left$(buf1, InStr(buf1, Chr$(0)) - 1) 'Buffer contains a null terminated string. Find position of null.
                        Print "Button 1 pressed. Text read from edit control: ### " + a$ + " ###" '                  Extract characters upto this null character.
                        buf1 = "" '                                 Clear buffer
 
                        WindowProc = 0
                    Case hwb2
                        Print "Button 2 pressed Also used as close button"
                        discardp = PostMessageA(hWnd, WM_CLOSE, 0, 0) 'Use a button close Close
                        WindowProc = 0
                        '---End standard buttons---
 
                        '---Three checkbox standard buttons---
                    Case hwcb0
                        Print "Check box 0 click"
                        If SendMessageA(hwcb0, BM_GETCHECK, 0, 0) = BST_CHECKED Then
                            Print "Check box 0 is checked:"
                        Else
                            Print "Check box 0 is un-checked:"
                        End If
                        WindowProc = 0
                    Case hwcb1
                        Print "Check box 1 click"
                        WindowProc = 0
                    Case hwcb2
                        Print "Check box 2 click"
                        WindowProc = 0
                        '---End checkbox standard buttons---
 
                        '---Bank 1 - Radio buttons---
                    Case hwr11
                        Print "Radio 11 clicked"
                        WindowProc = 0
                    Case hwr12
                        Print "Radio 12 clicked"
                        WindowProc = 0
                    Case hwr13
                        Print "Radio 13 clicked"
                        WindowProc = 0
                        '---End Bank 1 - Radio buttons---
 
                        '---Bank 2 - Radio buttons---
                    Case hwr21
                        Print "Radio 21 clicked"
                        If SendMessageA(hwr21, BM_GETCHECK, 0, 0) = BST_CHECKED Then
                            Print: Print "Button Radio 21 is checked:": Print
                        End If
                        WindowProc = 0
                    Case hwr22
                        Print "Radio 22 clicked"
                        WindowProc = 0
                    Case hwr23
                        Print "Radio 23 clicked"
 
                        '---End Bank 2 - Radio buttons---
 
                End Select
            Else
                'Not our message send back to system for processing
                WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
            End If
 
            WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
        Case Else
            'Not our message send back to system for processing
            WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)
    End Select
End Function
 
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
 
Function HIWORD% (dw As Long)
    If dw And &H80000000 Then
        HIWORD = (dw \ 65535) - 1
    Else
        HIWORD = dw \ 65535
    End If
End Function
 
Function LOWORD% (dw As Long)
    If dw And &H8000& Then
        LOWORD = &H8000 Or (dw And &H7FFF&)
    Else
        LOWORD = dw And &HFFFF&
    End If
End Function
 

WIN.h

Code: QB64: [Select]

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;
}
 

Result shown below:

Note: For an example of subclassing a control see the edit control on the following page: https://www.qb64.org/forum/index.php?topic=4111.msg136749#msg136749

QB64 Discussion / Re: InputBox

« on: October 11, 2021, 04:49:46 am »

With the release of QB64 v2.0 I have updated the input box code.
I finally managed to get subclassing to compile on both 32 and 64 bit versions of QB64. Solution in part was to update appropriate functions. However real solution came with the beta releases of QB64 v2.0 allowing the 64bit input box version to compile.

The following provides a quick overview of subclassing:
"Subclassing is a technique that allows an application to intercept and process messages sent or posted to a particular window before the window has a chance to process them. By subclassing a window, an application can augment, modify, or monitor the behavior of the window."

"An application subclasses a window by replacing the address of the window's original window procedure with the address of a new window procedure, called the subclass procedure. Thereafter, the subclass procedure receives any messages sent or posted to the window."

Save the following files and place them in your QB64 folder:

input_box_example.bas

Code: QB64: [Select]

Option _Explicit 
$VersionInfo:Comments=This uses Subclassing Controls!
 
'$Include:'input_box.BI'
 
'===Your program START ==========
Screen _NewImage(400, 300, 32) '             Set main screen size
Color _RGB(0, 0, 0), _RGB32(205, 238, 205) ' Set colors
Cls
_Title "Main Program" ' Set your main program title
 
'Examples:
 
'Accepts alpha-numeric characters
Print "=1a= " + InputBoxM("", "", "", "", "")
Print "=1b= " + InputBox
 
 
'Allows alpha-numeric and extra valid characters.
Print "=2a= " + InputBoxM("Any character:", "All A+", "", "A+", "")
Print "=2b= " + InputBoxA("Any character:", "All A+")
 
'Only numeric characters allowed
Print "=3a= " + InputBoxM("Digits 0-9 only", "NUMERIC", "", "N", "")
Print "=3b= " + InputBoxN("Digits 0-9 only", "NUMERIC")
 
'Password entry. Display asterisk
Print "=4a= " + InputBoxM("Asterisk mask:", "PASSWORD 1", "", "", "A")
Print "=4b= " + InputBoxP("Asterisk mask:", "PASSWORD 1")
 
'Password entry. Display bullet
Print "=5a= " + InputBoxM("Bullet mask:", "PASSWORD 2", "", "", "B")
Print "=5b= " + InputBoxPB("Bullet mask:", "PASSWORD 2")
 
 
Print "=7= " + InputBoxM("Limit 4 characters:", "LIMIT", "4", "", "") '
Print "=8= " + InputBoxM("Digits 0-9 and associated characters", "NUMERIC+", "", "N+", "")
 
Print "End"
End
System
'===Your program END ============
 
'$Include:'input_box.BM'
 

input_box.BI

Code: QB64: [Select]

'###_start_BI_inputbox 
Do: Loop Until _ScreenExists 'run before using _WindowHandle or _title
$If 64BIT Then
    $If VERSION < 1.6 Then
        $ERROR Requires Windows QB64 version 1.6 or above
    $End If
$End If
 
$If 32BIT Then
    $If VERSION < 1.5 Then
        $ERROR Requires Windows QB64 version 1.5 or above
    $End If
$End If
 
'===================================================================
'Input box for QB64 32 & 64 bit.
'The QB64 InputBoxM function displays a pop-up dialog box,
'prompting the user for input. It has OK and Cancel buttons.
'Function returns a text string containing the user's input
'when OK button clicked. Returns an empty text string when
'Cancel button is clicked.
'
' mpg_input_box_1.bas
' MPG 9-10-2021
'====================================================================
'InputBoxM function:
'InputBoxM (prompt$,title$,length$,numeric$,pwMask$)
'
'prompt$  - text displayed above the edit control to prompt user e.g. "Please enter a number:".
'title$   - text displayed in the title bar of the InputBoxM.
'length$  - maximum number of characters a user allowed to enter.
'numeri$c - select numeric input. 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.
'pwMask$  - select a password mask' Options are:
'            ""  Default no mask
'            "A" Password mask Asterisk
'            "B" Password mask Bullet
'
' Note1: All variables are optional. Unused variables use a null string.
' Note2: Pressing cancel button returns a null string e.g ""
' Note3: You can change default values e.g valid characters, length etc
'        Defaults, located in "Sub inputbox_init" or "Function InputBoxM"
'----------------------------------------------------------------------
'Predefined functions:
'Based on the above, five predefined InputBox functions are
'included as follows:
'
'InputBox                    - Accepts alpha-numeric characters
'InputBoxA(prompt$, title$)  - Accepts any character input
'InputBoxN(prompt$, title$)  - Only numeric characters allowed
'InputBoxP(prompt$, title$)  - Password entry. Display asterisk
'InputBoxPB(prompt$, title$) - Password entry. Display bullet
'
' Note1: Variables are optional. Unused variables use a null string
'----------------------------------------------------------------------
' VB Inputbox has some limitations as does the edit control. This QB64
' input box addresses these limitation.
' 1) Default character length 0x7FFE to 0x7FFFFFFE os dependent.
'    Added option to limit number of characters.
' 2) Default password mask was an asterisk. Added option to select
'    asterisk or bullet.
' 3) Numeric characters limited to digits 0-9 added option to have
'    extra associated characters e.g calculator +-%= etc.
'
' Using subclassing added the following:
' 4) Disabled context menu (Mouse Right click) copy and paste .
' 5) Disabled copy and paste using  Ctrl+c Ctrl+v.
' 6) Disabled copy and paste using Ctrl+Shift+c Ctrl+Shift+v.
' 7) Disabled annoying beep when pressing enter key.
' 8) Character validation.
' 9) Invalid character user alert. Uses MessageBeep.
'
'----------------------------------------------------------------------
' Code based on ideas from the following references:
' 1) Windows buttons for 32 and 64 bit IDE
'    https://www.qb64.org/forum/index.php?topic=3217.msg124966#msg124966
' 2) Base64 Encoding/Decoding with Windows, Mac, and Linux
'    https://www.qb64.org/forum/index.php?topic=3214.msg124919#msg124919
' 3) Threading
'    https://www.qb64.org/forum/index.php?topic=3865.msg132124#msg132124
'=======================================================================
'
'-----------------------------------------------------------------------
'NOTE:
'Create a new file input_box_WIN.h with the following content (Remove the comments '):
'---Start of file contents:---
     
'ptrszint FUNC_WINDOWPROC(ptrszint*_FUNC_WINDOWPROC_OFFSET_HWND,uint32*_FUNC_WINDOWPROC_ULONG_UMSG,uptrszint*_FUNC_WINDOWPROC_UOFFSET_WPARAM,ptrszint*_FUNC_WINDOWPROC_OFFSET_LPARAM);
'LRESULT CALLBACK WindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_WINDOWPROC((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetWindowProc() {
' return (void *) WindowProc;
'}
     
'ptrszint FUNC_SUBEDIT(ptrszint*_FUNC_SUBEDIT_OFFSET_HWND,uint32*_FUNC_SUBEDIT_ULONG_UMSG,uptrszint*_FUNC_SUBEDIT_UOFFSET_WPARAM,ptrszint*_FUNC_SUBEDIT_OFFSET_LPARAM);
'LRESULT CALLBACK SubEdit(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) {
' return FUNC_SUBEDIT((ptrszint *) (& hwnd), & uMsg, & wParam, (ptrszint *) (& lParam));
'}
'void * GetSubEdit() {
' return (void *) SubEdit;
'}
     
'---End of file contents---
'Input box uses the input_box_WIN.h file to get the WindowProc and SubEdit . Note: Place above file in your working folder (The QB64 folder).
'----------------------------------------------------------------
     
'==Note: InputBox requires this section to be added to your program.==========
'Creates a global variable ipb. Its corresponding elements, are also global.
Dim Shared ipb As input_box_udt 'The input_box_udt user defined type
inputbox_init '                  Define ipb structure and initialize elements
     
'*****Subclassing
Dim Shared OldWindowProc As Long 'Global variable store old windows process
'*****End Subclassing
 
'###_end_BI_inputbox
 

input_box.BM

Code: QB64: [Select]

'###_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
    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
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, title As String)
    InputBoxA = InputBoxM(prompt, title, "", "A+", "")
End Function
 
'Predefined function 3: - Only numeric characters allowed.
Function InputBoxN$ (prompt As String, title As String)
    InputBoxN = InputBoxM(prompt, title, "", "N", "")
End Function
 
'Predefined function 4: - Password entry. Display asterisk.
Function InputBoxP$ (prompt As String, title As String)
    InputBoxP = InputBoxM(prompt, title, "", "", "A")
End Function
 
'Predefined function 5: - Password entry. Display bullet.
Function InputBoxPB$ (prompt As String, title As String)
    InputBoxPB = InputBoxM(prompt, title, "", "", "B")
End Function
 
 
 
'---Main input box
Function InputBoxM$ (prompt As String, title 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 title <> "" Then
        ipb.caption_text = title '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)
    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
 
    '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
 
    '---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
    '*****End Subclassing
 
    'Display and Update window to ensure it has properly redrawn itself on the screen.
    dummyL = ShowWindow(ipb.hw, SW_SHOWDEFAULT)
    dummyL = UpdateWindow(ipb.hw)
 
    ' Force window to top and select with screen click
    Const HWND_TOPMOST = -1 '      window above all others no focus unless active
    Const SWP_NOSIZE = &H0001 '    ignores cx and cy size parameters
    Const SWP_NOACTIVATE = &H0010 'does not activate window
    dummyL = SetWindowPos(ipb.hw, HWND_TOPMOST, ipb.x, ipb.y, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) 'force to top
    _ScreenClick ipb.x + 160, ipb.y + 96 'Force focus and move cursor to left of ok button
 
    '-- Step 3: The Message Loop
    While GetMessageA(_Offset(msg), 0, 0, 0) > 0 ' gets a message from our application's message queue.
        dummyL = TranslateMessage(_Offset(msg)) '  performs some additional processing on keyboard events
        dummyO = DispatchMessageA(_Offset(msg)) '  sends the message out to the window that the message was sent to
    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)
    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
 

input_box_WIN.h

Code: QB64: [Select]

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;
}
 

Compile input_box_example.bas

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

« on: September 28, 2021, 09:31:05 am »

Hi Fellippe and Dav
Wait for the screen to exists is the solution.
It explains why some programs worked and other failed.

DO: LOOP UNTIL _SCREENEXISTS

Many thanks to you both.

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

« on: September 28, 2021, 06:39:11 am »

The following code fails on the new development builds:

Code: QB64: [Select]

Print "hwnd = "; _WindowHandle

_WindowHandle returns a 0 and not a handle as expected.

The following code fails on the dev builds however works fine on stable builds (1.5 x32 x64 3043116) note added a test line:

Ref: https://www.qb64.org/wiki/Windows_Libraries#Borderless_Window

Code: QB64: [Select]

'============
'NOBORDER.BAS
'============
 
DECLARE CUSTOMTYPE LIBRARY
    FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$)
END DECLARE
 
DECLARE DYNAMIC LIBRARY "User32"
    FUNCTION GetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG)
    FUNCTION SetWindowLongA& (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG)
    FUNCTION SetWindowPos& (BYVAL hwnd AS LONG, BYVAL hWndInsertAfter AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL cx AS LONG, BYVAL cy AS LONG, BYVAL wFlags AS LONG)
END DECLARE
 
GWL_STYLE = -16
WS_BORDER = &H800000
 
_TITLE "No Border"
hwnd& = _WINDOWHANDLE 'FindWindow(0, "No Border" + CHR$(0))
Print "hwnd = "; _WindowHandle '<<<<<<< Test line
 
PRINT "Press any key for no border...": A$ = INPUT$(1)
 
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& AND NOT WS_BORDER)
a& = SetWindowPos&(hwnd&, 0, 0, 0, 0, 0, 39)
 
PRINT "Press any key to get back border...": SLEEP
 
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& OR WS_BORDER)
a& = SetWindowPos&(hwnd&, 0, 0, 0, 0, 0, 39)
 
PRINT "The end" 
 

QB64 Development Builds:
QB64x32 2.0 049499c
QB64x64 2.0 049499c

PC spec as follows: Windows 8.1, Processor Intel(R) Core(TM) i3-3217U CPU 1.8 GHz, RAM 4GB, 64-bit

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

« on: September 25, 2021, 05:05:27 am »

The following function fails on dev build QB64x64 edb4d40
Error message: Incorrect number of arguments passed to function on line 14
Note: Worked fine on previous builds

Ref: https://www.qb64.org/forum/index.php?topic=1015.msg102131#msg102131

Code: QB64: [Select]

Dim x As Integer
Dim m As _MEM
m = _Mem(x)
Print m.OFFSET
Print ConvertOffset(m.OFFSET)
 
 
Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
    _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
 
$ELSE
    'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
    _MEMGET m, m.OFFSET, temp& 'Like this
    ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
$END IF
_MEMFREE m 'Free the memblock
$CHECKING:ON
END FUNCTION
 

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

« on: September 19, 2021, 10:47:23 am »

Previous code that failed to compile now compiles with the new dev builds, that really is excellent, thank you Spriggsy and Fellippe.

For testing I used a program that is difficult to debug, it has a new window process and uses subclassing.
I had a few teething problems with the debugger mainly setting inappropriate break points and incorrect use of menu options.
That said I was surprised how stable QB64 debug is. It really is turning into an indispensable tool keep up the great work.

QB64 Development Builds:
QB64x32 1.6 d651f37
QB64x64 1.6 d651f37

PC spec as follows: Windows 8.1, Processor Intel(R) Core(TM) i3-3217U CPU 1.8 GHz, RAM 4GB, 64-bit

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

« on: September 16, 2021, 04:05:59 am »

Hi Spriggsy and Fellippe thank you both for the feedback. Spriggsy I do understand it is preferential to use Declare CustomType Library instead of Declare Dynamic Library.
That said your solution if successful will only add to the flexibility of QB64. I cant wait to test the proposed solution.

"Let me know if you need any help or come across any further compilation errors when using external functions." offer most appreciated I am sure at a latter date will be required thank you.

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

« on: September 15, 2021, 09:22:08 am »

The following code compiles and runs on both 32 and 64 dev versions (Note no $Debug meta command).

Code: QB64: [Select]

'Desktop Size
'Returns the Left, Top, Right and Bottom coordinates of the current desktop area.
'https://www.qb64.org/wiki/Windows_Libraries
 
Declare Dynamic Library "user32"
    Function SystemParametersInfoW& (ByVal uiAction~&, Byval uiParam~&, Byval pvParam%&, Byval fWinlni~&)
End Declare
 
Const SPI_GETWORKAREA = &H30
 
Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Dim Rec As RECT
 
If 0 = SystemParametersInfoW(SPI_GETWORKAREA, 0, _Offset(Rec), 0) Then
    'function failed. You may call kernel32's GetLastError for more info.
    Print "failed."
End If
 
Print Rec.left
Print Rec.top
Print Rec.right
Print Rec.bottom
Print
scr& = _ScreenImage
Print _Width(scr&)
Print _Height(scr&)
_FreeImage scr&
End
 

After adding the $Debug meta command both dev versions fail to compile above code. Error message from compilelog.txt

Code: QB64: [Select]

In file included from qbx.cpp:1099:
..\\temp\\regsf.txt:5:11: error: redefinition of 'HINSTANCE__* DLL_user32'
 HINSTANCE DLL_user32=NULL;
           ^~~~~~~~~~
compilation terminated due to -Wfatal-errors.
 

Simple solution replace Declare Dynamic Library "user32" with Declare CustomType Library
However that's not a real solution it just masks the problem.

QB64 Development Builds:
QB64x32 1.6 75939af
QB64x64 1.6 75939af

PC spec as follows:
Windows 8.1
Processor Intel(R) Core(TM) i3-3217U CPU 1.8 GHz
Installed memory RAM 4GB
System type: 64-bit Operating System, x64-based processor

QB64 Discussion / Re: InputBox

« on: September 11, 2021, 05:12:13 am »

Hi Spriggsy thank you for a quick reply. I ran your modified code in both QB64 32 and 64 bit
With the following interesting results:

1a) QB64x32 Version 1.5 Stable Release From git 3043116
After compiling there is a flicker (attempts to run and closes) .

1b) QB64x32 Version 1.6 Development Build From git ca32adf
After compiling there is a flicker (attempts to run and closes) .

2a) QB64x64 Version 1.5 Stable Release From git 3043116
The program compiles and runs however the subclass function "SubEdit" does not get called.

2b) QB64x64 Version 1.6 Development Build From git ca32adf
The program compiles and runs however the subclass function "SubEdit" does not get called.

In the pass I have seen issues when declaring libraries in QB64x32. With my PC it seems some libraries need a specific declaration.
I regressed library definitions as follows:

Code: QB64: [Select]

 Declare Library "WIN2"
        Function GetWindowProc%& () 'Windows procedure
        Function GetSubEdit%& () 'Edit procedure
    End Declare
 
    '   Declare CustomType Library
    '       Function SetWindowLongPtr& Alias "SetWindowLongPtrA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
    '       Function GetWindowLongPtr& (ByVal hwnd As _Offset, Byval nIndex As Long)
    '     Function CallWindowProc& Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, Byval hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
    '   End Declare
 
    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 SetWindowLongA& (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)
    End Declare
 
    Declare Dynamic Library "kernel32"
        Function GetModuleHandleA%& (ByVal lpModuleName%&)
        Function GetLastError~& ()
    End Declare
 

Ran the new code with the following results:

1an) QB64x32 Version 1.5 Stable Release From git 3043116
Works as expected.
Test: At the first input popup enter 123qwer
Result: 123 displayed

1bn) QB64x32 Version 1.6 Development Build From git ca32adf
Works as expected.

2an) QB64x64 Version 1.5 Stable Release From git 3043116
The program compiles and runs however the subclass function "SubEdit" does not get called.
Test: At the first input popup enter 123qwer
Result: 123qwer displayed - function "SubEdit" not called.

2bn) QB64x64 Version 1.6 Development Build From git ca32adf
The program compiles and runs however the subclass function "SubEdit" does not get called.

I just found this https://www.qb64.org/wiki/DECLARE_DYNAMIC_LIBRARY
"Note: SUB procedures using CUSTOMTYPE LIBRARY API procedures inside may error. Try DYNAMIC with "KERNEL32"."
May explain what I observed with the above QB64x32

Back to the original problem how to run the subclass function "SubEdit" on QB64x64

Note: My PC spec as follows:
Windows 8.1
Processor Intel(R) Core(TM) i3-3217U CPU 1.8 GHz
Installed memory RAM 4GB
System type: 64-bit Operating System, x64-based processor

P.S. I liked the bonus, $VERSIONINFO comment. Works fine in the dev builds.

Pages: [1] 2

News:

Show Posts

Messages - mpgcan

QB64 Discussion / Re: How to remove title Bar from graphics screen?

QB64 Discussion / Re: InputBox

QB64 Discussion / Re: InputBox

QB64 Discussion / Re: How to remove title Bar from graphics screen?

Programs / Re: Windows buttons for 32 and 64 bit IDE - Take 2

Programs / Re: Windows buttons for 32 and 64 bit IDE - Take 2

Programs / Windows buttons for 32 and 64 bit IDE - Take 2

QB64 Discussion / Re: InputBox

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

QB64 Discussion / Re: [dev build] $DEBUG mode ✨ Step through your code, watch variables! 🤩

QB64 Discussion / Re: InputBox