GUI app and winAPI calls - Printable Version

Code: (Select All)
'test 1 GUI win32 api in QB64pe v3.2.1 by Aurel

 $SCREENHIDE

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_VISIBLE OR WS_OVERLAPPED OR WS_CAPTION OR WS_SYSMENU OR WS_THICKFRAME OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX

     

    CONST CW_USEDEFAULT = &H80000000



    CONST CS_DBLCLKS      = &H8

    CONST CS_OWNDC        = 32

    CONST IDI_APPLICATION = 32512

     

    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

    CONST SW_SHOW        = 5

'------------------------------------------------

  TYPE POINT

       x AS LONG

       y AS LONG

  END TYPE



 ' for 64 bit 

     TYPE MSG

        hwnd     AS _OFFSET

        message  AS _OFFSET

        wParam   AS _UNSIGNED _OFFSET  'unsigned pointer sized integer

        lParam   AS _OFFSET            'pointer sized integer

        time     AS _INTEGER64

        pt       AS POINT

    END TYPE



'should be before Library Declarations

 TYPE WNDCLASSEX

       cbSize         As _INTEGER64

       Style          As 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

       hIconSm        As _OFFSET

   END TYPE



     

    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 LoadIcon%& (ByVal hinstance As Long, ByVal lpIconName As long) 

        'FUNCTION RegisterClassA~% (BYVAL lpWndClass%&)

        'FUNCTION RegisterClassEx~% (byval pcWndClassEx%&)



 'FUNCTION CreateWindowEx%& (ByVal dwExStyle As Long, byval lpClassName%&, byval  lpWindowName%&, Byval dwStyle As Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Long, Byval hMenu As Long, Byval hInstance As _OFFSET, Byval lpParam As Long )

'FUNCTION CreateWindowEx%& (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 customType Library 

 Function CreateWindowEx%& (ByVal dwExStyle~&, Byval lpClassName As _Offset, Byval lpWindowName As _Offset, Byval dwStyle~&, 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)

End Declare



Declare customType Library 

 FUNCTION RegisterClassEx~% (byval pcWndClassEx%&)

End Declare

     

    DECLARE DYNAMIC LIBRARY "kernel32"

        FUNCTION GetModuleHandleA%& (BYVAL lpModuleName%&)

        'FUNCTION GetLastError~& ()

    END DECLARE

    

    '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       



    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 wcx AS WNDCLASSEX

    DIM SHARED wmsg AS MSG

    DIM SHARED reg AS _UNSIGNED INTEGER

     

    DIM SHARED buf AS STRING * 4096

     

    DIM SHARED sw AS LONG

    DIM SHARED uw AS _OFFSET

    DIM SHARED t0 AS STRING

    DIM SHARED t1 AS STRING

     

    DIM SHARED ClassName AS STRING 

    ClassName = "QB64pe" 

    'DIM SHARED crlf AS STRING * 2

    'crlf = MKI$(&HA0D)

     

    hi = GetModuleHandleA(0)

    wcx.cbsize = 76 

    wcx.style = CS_DBLCLKS OR CS_OWNDC 

    wcx.lpfnWndProc = GetWindowProc

    wcx.cbClsExtra = 0

    wcx.cbWndExtra = 0

    wcx.hInstance = hi

    wcx.hIcon = 0

    wcx.hCursor = LoadCursorW(0, IDC_ARROW)

    wcx.hbrBackground = COLOR_WINDOW + 1

    wcx.lpszMenuName = 0

    wcx.lpszClassName = _OFFSET(ClassName)

    wcx.hIconSm       = LoadIcon(0,IDI_APPLICATION )

'-----------------------------------------------------------    

    reg = RegisterClassEx(_OFFSET(wcx)):  IF 0 = reg THEN SYSTEM

'-------------------------------------------------------------

'create main window

 t1 = "QB64pe_GUI_App2" 

 hw = CreateWindowEx(0, _OFFSET(ClassName), _OFFSET(t1), WS_OVERLAPPEDWINDOW , 200, 200, 800, 600, 0, 0, hi, 0)

 IF 0 = hw THEN SYSTEM



 sw = ShowWindow(hw, SW_SHOW)

 sw = UpdateWindow(hw)



'win message loop..................................

 DO

   bRet = GetMessageA(_OFFSET(wmsg), 0, 0, 0)

         SELECT CASE bRet

            CASE 0, -1: EXIT DO

         END SELECT   

        sw = TranslateMessage(_OFFSET(wmsg))

        uw = DispatchMessageA(_OFFSET(wmsg))

 'wend 

LOOP 

'..................................................



FUNCTION WindowProc%& (hWnd AS _OFFSET, uMsg AS _UNSIGNED LONG, wParam AS _UNSIGNED _OFFSET, lParam AS _OFFSET)

     

        SELECT CASE uMsg                                

     

            CASE WM_DESTROY     

                PostQuitMessage(0)

               ' WindowProc=0 : EXIT FUNCTION

          

            CASE ELSE

     

                WindowProc = DefWindowProcA(hWnd, uMsg, wParam, lParam)

        END SELECT

       'WindowProc =  DefWindowProcA(hWnd, uMsg, wParam, lParam)

     

END FUNCTION