Print Page - Windows buttons for 32 and 64 bit IDE

Hi, yesterday Dav gave us an amazing code to run some button elements. Its version only worked in 32 bits. I wrote upgrade, so now it works for both 32 and 64 bit.

Code: QB64: [Select]

'DEFSTR A-Z
 
' public domain, michael calkins
' revision 2012 09 12
' very much experimental. I am a noob at GUI stuff, and might be doing multiple things wrong or in unideal ways.
' rough translation of:
' http://www.network54.com/Forum/613583/message/1347419042/
' with a few liberties taken.
 
' not only might I be doing things wrong, but I am also not doublechecking the function declarations, type definitions, and constant values. They could be wrong.
 
$CONSOLE
_DEST _CONSOLE
$SCREENHIDE
 
' get more constants from winuser.h as needed.
 
CONST IDC_ARROW = &H7F00
CONST COLOR_WINDOW = 5
 
CONST WS_OVERLAPPED = 0
CONST WS_CHILD = &H40000000
CONST WS_VISIBLE = &H10000000
CONST WS_MAXIMIZE = &H01000000
CONST WS_CAPTION = &H00C00000
CONST WS_VSCROLL = &H00200000
CONST WS_HSCROLL = &H00100000
CONST WS_SYSMENU = &H00080000
CONST WS_THICKFRAME = &H00040000
CONST WS_TABSTOP = &H00010000
CONST WS_MINIMIZEBOX = &H00020000
CONST WS_MAXIMIZEBOX = &H00010000
CONST WS_OVERLAPPEDWINDOW = WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU OR WS_THICKFRAME OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX
 
CONST CW_USEDEFAULT = &H80000000&
 
CONST BS_PUSHBUTTON = 0
CONST BS_AUTOCHECKBOX = 3
CONST BS_GROUPBOX = 7
CONST BS_AUTORADIOBUTTON = 9
CONST BS_TEXT = 0
 
CONST BN_CLICKED = 0
 
CONST BM_GETCHECK = &HF0
 
CONST ES_LEFT = 0
CONST ES_MULTILINE = 4
CONST ES_AUTOVSCROLL = &H0040
CONST ES_AUTOHSCROLL = &H0080
CONST ES_WANTRETURN = &H1000
 
CONST WM_DESTROY = 2
CONST WM_GETTEXT = &H000D
CONST WM_CLOSE = &H0010
CONST WM_COMMAND = &H0111
 
CONST SW_SHOWDEFAULT = &HA
 
DECLARE LIBRARY "win"
    FUNCTION GetWindowProc%& ()
END DECLARE
 
DECLARE DYNAMIC LIBRARY "user32"
    FUNCTION SendMessageA%& (BYVAL hWnd%&, BYVAL Msg~&, BYVAL wParam~%&, BYVAL lParam%&)
    FUNCTION DefWindowProcA%& (BYVAL hWnd%&, BYVAL Msg~&, BYVAL wParam~%&, BYVAL lParam%&)
    SUB PostQuitMessage (BYVAL nExitCode&)
    FUNCTION LoadCursorW%& (BYVAL hInstance%&, BYVAL lpCursorName%&)
    FUNCTION RegisterClassA~% (BYVAL lpWndClass%&)
    FUNCTION CreateWindowExA%& (BYVAL dwExStyle~&, BYVAL lpClassName%&, BYVAL lpWindowName%&, BYVAL dwStyle~&, BYVAL x&, BYVAL y&, BYVAL nWidth&, BYVAL nHeight&, BYVAL hWndParent%&, BYVAL hMenu%&, BYVAL hInstance%&, BYVAL lpParam%&)
    FUNCTION ShowWindow& (BYVAL hWnd%&, BYVAL nCmdShow&)
    FUNCTION UpdateWindow& (BYVAL hWnd%&)
    FUNCTION GetMessageA& (BYVAL lpMsg%&, BYVAL hWnd%&, BYVAL wMsgFilterMin~&, BYVAL wMsgFilterMax~&)
    FUNCTION TranslateMessage& (BYVAL lpMsg%&)
    FUNCTION DispatchMessageA%& (BYVAL lpmsg%&)
END DECLARE
 
DECLARE DYNAMIC LIBRARY "kernel32"
    FUNCTION GetModuleHandleW%& (BYVAL lpModuleName%&)
    FUNCTION GetLastError~& ()
END DECLARE
 
TYPE POINT
    x AS LONG
    y AS LONG
END TYPE
 
$IF 32BIT THEN
    TYPE MSG
        hwnd AS _OFFSET
        message AS _UNSIGNED LONG
        wParam AS _UNSIGNED _OFFSET 'unsigned pointer sized integer
        lParam AS _OFFSET 'pointer sized integer
        time AS _UNSIGNED LONG
        pt AS POINT
    END TYPE
 
    TYPE WNDCLASSA
        style AS _UNSIGNED LONG
        lpfnWndProc AS _OFFSET
        cbClsExtra AS LONG
        cbWndExtra AS LONG
        hInstance AS _OFFSET
        hIcon AS _OFFSET
        hCursor AS _OFFSET
        hbrBackground AS _OFFSET
        lpszMenuName AS _OFFSET
        lpszClassName AS _OFFSET
    END TYPE
$ELSE
    TYPE MSG
    hwnd AS _OFFSET
    message AS _OFFSET
    wParam AS _OFFSET 'unsigned pointer sized integer
    lParam AS _OFFSET 'pointer sized integer
    time AS _INTEGER64
    pt AS POINT
    END TYPE
 
    TYPE WNDCLASSA
    style AS _INTEGER64
    lpfnWndProc AS _OFFSET
    cbClsExtra AS LONG
    cbWndExtra AS LONG
    hInstance AS _OFFSET
    hIcon AS _OFFSET
    hCursor AS _OFFSET
    hbrBackground AS _OFFSET
    lpszMenuName AS _OFFSET
    lpszClassName AS _OFFSET
    END TYPE
$END IF
 
 
 
DIM SHARED hi AS _OFFSET
DIM SHARED bRet AS LONG
DIM SHARED hw AS _OFFSET
DIM SHARED hwb0 AS _OFFSET
DIM SHARED hwb1 AS _OFFSET
DIM SHARED hwcb AS _OFFSET
DIM SHARED hwgb AS _OFFSET
DIM SHARED hwr0 AS _OFFSET
DIM SHARED hwr1 AS _OFFSET
DIM SHARED hwe AS _OFFSET
DIM SHARED wc AS WNDCLASSA
DIM SHARED msg AS MSG
DIM SHARED at AS _UNSIGNED INTEGER
 
DIM SHARED buf AS STRING * 4096
 
DIM SHARED discardb AS LONG
DIM SHARED discardp AS _OFFSET
DIM SHARED t0 AS STRING
DIM SHARED t1 AS STRING
 
DIM SHARED MainClassName AS STRING * 5
MainClassName = "main" + CHR$(0)
DIM SHARED crlf AS STRING * 2
crlf = MKI$(&HA0D)
 
hi = GetModuleHandleW(0)
 
wc.style = 0
wc.lpfnWndProc = GetWindowProc
wc.cbClsExtra = 0
wc.cbWndExtra = 0
wc.hInstance = hi
wc.hIcon = 0
wc.hCursor = LoadCursorW(0, IDC_ARROW)
wc.hbrBackground = COLOR_WINDOW + 1
wc.lpszMenuName = 0
wc.lpszClassName = _OFFSET(MainClassName)
 
at = RegisterClassA(_OFFSET(wc)): IF 0 = at THEN SYSTEM
 
t1 = "title" + CHR$(0)
hw = CreateWindowExA(0, at AND &HFFFF~&, _OFFSET(t1), WS_HSCROLL OR WS_OVERLAPPEDWINDOW OR WS_VSCROLL, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hi, 0): IF 0 = hw THEN SYSTEM
t0 = "BUTTON" + CHR$(0)
t1 = "Button 0" + CHR$(0)
hwb0 = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_TABSTOP OR WS_VISIBLE OR WS_CHILD OR BS_PUSHBUTTON OR BS_TEXT, 10, 10, 150, 40, hw, 0, hi, 0): IF 0 = hw THEN SYSTEM
t1 = "Button 1" + CHR$(0)
hwb1 = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_TABSTOP OR WS_VISIBLE OR WS_CHILD OR BS_PUSHBUTTON OR BS_TEXT, 10, 60, 150, 40, hw, 0, hi, 0): IF 0 = hwb0 THEN SYSTEM
t1 = "Chk box" + CHR$(0)
hwcb = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_TABSTOP OR WS_VISIBLE OR WS_CHILD OR BS_AUTOCHECKBOX OR BS_TEXT, 10, 110, 150, 40, hw, 0, hi, 0): IF 0 = hwb1 THEN SYSTEM
t1 = "Group box" + CHR$(0)
hwgb = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_VISIBLE OR WS_CHILD OR BS_GROUPBOX OR BS_TEXT, 10, 160, 400, 80, hw, 0, hi, 0): IF 0 = hwgb THEN SYSTEM
t1 = "Radio 0" + CHR$(0)
hwr0 = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_TABSTOP OR WS_VISIBLE OR WS_CHILD OR BS_AUTORADIOBUTTON OR BS_TEXT, 10, 30, 150, 30, hwgb, 0, hi, 0): IF 0 = hwr0 THEN SYSTEM
t1 = "Radio 1" + CHR$(0)
hwr1 = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_TABSTOP OR WS_VISIBLE OR WS_CHILD OR BS_AUTORADIOBUTTON OR BS_TEXT, 210, 30, 150, 30, hwgb, 0, hi, 0): IF 0 = hwr1 THEN SYSTEM
t0 = "EDIT" + CHR$(0)
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)
hwe = CreateWindowExA(0, _OFFSET(t0), _OFFSET(t1), WS_TABSTOP OR WS_VISIBLE OR WS_CHILD OR ES_AUTOHSCROLL OR ES_AUTOVSCROLL OR ES_LEFT OR ES_MULTILINE OR ES_WANTRETURN, 10, 300, 400, 200, hw, 0, hi, 0): IF 0 = hwe THEN SYSTEM
 
discardb = ShowWindow(hw, SW_SHOWDEFAULT)
discardb = UpdateWindow(hw)
DO
    bRet = GetMessageA(_OFFSET(msg), 0, 0, 0)
    SELECT CASE bRet
        CASE 0, -1: EXIT DO
    END SELECT
    discardb = TranslateMessage(_OFFSET(msg))
    discardp = DispatchMessageA(_OFFSET(msg))
LOOP
 
_DELAY .5
' Hopefully the user is running this console program from the command prompt.
' If not, the half second delay should remind them.
' I think that Sleep is okay here, because I assume we shouldn't be getting any more messages.
' We're out of the message loop anyway...
 
 
SLEEP
SYSTEM
 
FUNCTION WindowProc%& (hWnd AS _OFFSET, uMsg AS _UNSIGNED LONG, wParam AS _UNSIGNED _OFFSET, lParam AS _OFFSET)
 
    SELECT CASE uMsg
 
        CASE WM_CLOSE
 
            discardp = SendMessageA(hwe, WM_GETTEXT, LEN(buf), _OFFSET(buf))
            PRINT: PRINT "First part of the edit control text:": PRINT
            PRINT buf: PRINT
            PRINT "Radio 0: 0x"; HEX$(SendMessageA(hwr0, BM_GETCHECK, 0, 0))
            PRINT "Radio 1: 0x"; HEX$(SendMessageA(hwr1, BM_GETCHECK, 0, 0))
 
            WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam): EXIT FUNCTION
 
        CASE WM_DESTROY
 
            PostQuitMessage 0
            WindowProc = 0: EXIT FUNCTION
 
        CASE WM_COMMAND
 
            IF wParam \ &H10000 = BN_CLICKED THEN
                SELECT CASE lParam
                    CASE hwb0: PRINT "Button 0 pressed"
                    CASE hwb1: PRINT "Button 1 pressed"
                    CASE hwcb: PRINT "Check box pressed"
 
                        ' The following two lines are useless, because the Group Box is getting the message, not us.
                    CASE hwr0: PRINT "Radio 0 pressed"
                    CASE hwr1: PRINT "Radio 1 pressed"
                END SELECT
                WindowProc = 0: EXIT FUNCTION
            ELSE
                WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam): EXIT FUNCTION
            END IF
 
        CASE ELSE
 
            WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam): EXIT FUNCTION
    END SELECT
 
END FUNCTION
 

WIN.H file:

Code: [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;
}

Thanks for the update, Petr!

Good, Petr!

It's working here - I'm using Win7-32bit. I don't have a 64-bit OS to test on.

- Dav

In XP, if you have a file with the same name as your .exe + .manifest (like untitled.exe.manifest) with the contents below, controls will use XP's visual styles. Might work in 7.

The code above works in Win10 64bit, but the .manifest trick doesn't.

Code: [Select]

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity
    version="1.2.3.4"
    processorArchitecture="*"
    name="Company.Product.Program"
    type="win32"
  />
  <description>Program Description Here</description>
  <dependency> 
    <dependentAssembly>
      <assemblyIdentity
        type="win32" 
        name="Microsoft.Windows.Common-Controls"
        version="6.0.0.0"
        publicKeyToken="6595b64144ccf1df"
        language="*"
        processorArchitecture="*"
      />
    </dependentAssembly>
  </dependency>
</assembly>

Before the .manifest:

After the .manifest:

Hi, Fellippe. I don't have Windows 10 for test. Look in the SpriggsySprigs thread on Base64, below we started talking about this. Dav there gave a link to the old forum where the C source is upgraded. Try it with that. If that doesn't work, try shuffling the data types in the $ IF block. All you have to think about is the byte sum of the fields. If you replace _INTEGER64 with _OFFSET, the field length is the same (both take 8 bytes in a 64-bit system), if you replace LONG with _INTEGER64, you have an array 4 bytes longer, so you have to take 4 bytes again somewhere ( make it 4 bytes lower), otherwise it won't work.

QB64.org Forum

Active Forums => Programs => Topic started by: Petr on November 06, 2020, 01:57:09 pm