FreeBasic question

[José Roca]

@Paul,

Do you know how to pass an Atom to CreateWindowExW?

Code Select Expand


declare function CreateWindowExW(byval dwExStyle as DWORD, byval lpClassName as LPCWSTR, byval lpWindowName as LPCWSTR, byval dwStyle as DWORD, byval X as long, byval Y as long, byval nWidth as long, byval nHeight as long, byval hWndParent as HWND, byval hMenu as HMENU, byval hInstance as HINSTANCE, byval lpParam as LPVOID) as HWND


The parameter is declared as byval lpClassName as LPCWSTR and, other than using a different declare, I don't find a way of bypass the datatype checking of the compiler.

[Paul Squires]

Hi Jose,

The following should work. The trick is using the MAKEINTATOM macro that is defined in winbase.bi

Code Select Expand


    Dim a As ATOM
   
    a = RegisterClassEx( @wcls )
    If( a = False ) Then
       MessageBox( Null, "Failed to register", "Error", MB_ICONERROR )
       Exit Function
    End If
   
    HWnd = CreateWindowEx( 0, _
                           MAKEINTATOM(a), _   
                           "Hope this works!", _
                           WS_OVERLAPPEDWINDOW, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           CW_USEDEFAULT, _
                           Null, _
                           Null, _
                           hInstance, _
                           Null )


[José Roca]

Almost... They have forget to provide an Unicode version.

But this works:

Code Select Expand


CreateWindowExW(dwExStyle, CAST(LPCWSTR, CAST(ULONG_PTR, CAST(WORD, m_wAtom)))  ....


This is a bit insane...

[José Roca]

This is the beginning of a CWindow class for FreeBasic.

Unzip the attached folder in the inc folder of your FreeBasic 64 bit include files.

Works only with 64 bit and Unicode.

I haven't yet added code to create controls.

Test example:

Code Select Expand


#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxWin.inc"

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG


   END WinMain(GetModuleHandle(""), NULL, COMMAND(), SW_NORMAL)

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   FUNCTION = 0

   SELECT CASE AS CONST uMsg

      CASE WM_CREATE
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

       CASE WM_PAINT
    DIM rc AS RECT, ps AS PAINTSTRUCT, hDC AS HANDLE
         hDC = BeginPaint(hWnd, @ps)
         GetClientRect(hWnd, @rc)
         DrawTextW(hDC, "Hello, World!", -1, @rc, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
         EndPaint(hWnd, @ps)
         EXIT FUNCTION

CASE WM_KEYDOWN
IF (LOWORD(wParam) = 27) THEN PostMessageW(hWnd, WM_CLOSE, 0, 0)

    CASE WM_DESTROY
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow Test", @WndProc)
   pWindow.Brush = GetStockObject(WHITE_BRUSH)
   pWindow.SetClientSize(400, 300)
   pWindow.CenterWindow

   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================


[Paul Squires]

It's nice to see you coding again!         

[James Fuller]

Jose,
  Great stuff!!
One suggestion: Use .bi instead of .inc so we get syntax coloring with FbEdit.

James

[José Roca]

Working in the creation of controls. I will use only a function, but allow default styles, and aliases for the class names, for easier use.

Sample code. More to follow.

Code Select Expand


' =====================================================================================
' Adds a control to the window
' =====================================================================================
FUNCTION CWindow.AddControl ( _
   BYREF wszClassName AS WSTRING, _                       ' // Class name
   BYVAL hParent AS HWND, _                               ' // Parent window handle
   BYVAL cID AS INTEGER, _                                ' // Control identifier
   BYREF wszTitle AS WSTRING = "", _                      ' // Control caption
   BYVAL x AS LONG = 0, _                                 ' // Horizontal position
   BYVAL y AS LONG = 0, _                                 ' // Vertical position
   BYVAL nWidth AS LONG = 0, _                            ' // Control width
   BYVAL nHeight AS LONG = 0, _                           ' // Control height
   BYVAL dwStyle AS DWORD = 0, _                          ' // Control style
   BYVAL dwExStyle AS DWORD = 0, _                        ' // Extended style
   BYVAL lpParam AS LONG_PTR = 0, _                       ' // Pointer to custom data
   BYVAL pWndProc AS WNDPROC = NULL _                     ' // Address of the window callback procedure
   ) AS HWND                                              ' // Control handle

   DIM hCtl AS HWND
   IF LEN(wszClassName) = 0 THEN EXIT FUNCTION
   IF hParent = NULL THEN hParent = m_hwnd
   ' // Window styles
   DIM wsClassName AS WSTRING * 260
   wsClassName = wszClassName
   SELECT CASE UCASE(wsClassName)
      CASE "BUTTON"
         ' Adds a button to the window
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON OR BS_CENTER OR BS_VCENTER
         IF dwStyle = BS_FLAT THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON OR BS_CENTER OR BS_VCENTER OR BS_FLAT
         IF dwStyle = BS_DEFPUSHBUTTON THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR BS_VCENTER OR BS_DEFPUSHBUTTON
         #if _WIN32_WINNT = &h0602
         IF dwStyle = BS_SPLITBUTTON THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR BS_VCENTER OR BS_SPLITBUTTON
         IF dwStyle = BS_DEFSPLITBUTTON THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR BS_VCENTER OR BS_DEFSPLITBUTTON
         #endif
      CASE "RADIOBUTTON"
         ' Adds a radio button to the window.
         wsClassName = "Button"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER
         IF dwStyle = WS_GROUP THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER OR WS_GROUP
      CASE "CHECKBOX"
         ' Adds a checkbox to the window.
         wsClassName = "Button"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_AUTOCHECKBOX OR BS_LEFT OR BS_VCENTER
      CASE "LABEL"
         ' Adds a label to the window.
         wsClassName = "Static"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR SS_LEFT OR WS_GROUP OR SS_NOTIFY
      CASE "FRAME", "FRAMEWINDOW"
         ' Adds a frame to the window.
         ' Note: This is not the same that PowerBASIC DDT's Frame control, that in fact is a Group Box.
         wsClassName = "Static"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_CLIPSIBLINGS OR WS_GROUP OR SS_BLACKFRAME
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_TRANSPARENT
      CASE "LINE"
         ' Adds an horizontal line to the window
         wsClassName = "Static"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR SS_ETCHEDFRAME
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_TRANSPARENT
      CASE "EDIT", "TEXTBOX"
         ' Adds an edit control to the window.
         wsClassName = "Edit"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR ES_LEFT OR ES_AUTOHSCROLL
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "COMBOBOX"
         ' Adds a combo box to the window.
         IF dwStyle = 0 THEN dwStyle = WS_CHILD OR WS_VISIBLE OR WS_VSCROLL OR WS_BORDER OR WS_TABSTOP OR CBS_DROPDOWN OR CBS_HASSTRINGS OR CBS_SORT
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "COMBOBOXEX", "COMBOBOXEX32"
         ' Adds a combo box ex to the window.
         wsClassName = "ComboBoxEx32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_BORDER OR WS_TABSTOP OR CBS_DROPDOWNLIST
      CASE "LISTBOX"
         ' Adds a list box to the window.
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_HSCROLL OR WS_VSCROLL OR WS_BORDER OR WS_TABSTOP OR LBS_STANDARD OR LBS_HASSTRINGS OR LBS_SORT OR LBS_NOTIFY
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
'         SendMessageW hCtl, WM_SETFONT, m_hFont, TRUE
         ' // Adjust the height of the control so that the integral height
         ' // is based on the new font rather than the default SYSTEM_FONT
         SetWindowPos hCtl, NULL, x * m_rx, y * m_ry, nWidth * m_rx, nHeight * m_rx, SWP_NOZORDER
      CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
         ' Adds a progress bar to the window.
         wsClassName = "msctls_progress32"
         ' Set the default range
         SendMessageW hCtl, PBM_SETRANGE32, 0, 100
         ' Set the default initial value
         SendMessageW hCtl, PBM_SETPOS, 0, 0
      CASE "HEADER", "SYSHEADER32"
         ' Adds an header control to the window.
         wsClassName = "SysHeader32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR CCS_TOP OR HDS_HORZ OR HDS_BUTTONS
      CASE "TREEVIEW", "SYSTREEVIEW32"
         ' Adds a tree view control to the window.
         wsClassName = "SysTreeView32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_BORDER OR WS_TABSTOP OR TVS_HASBUTTONS OR TVS_HASLINES OR TVS_LINESATROOT OR TVS_SHOWSELALWAYS
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "LISTVIEW", "SYSLISTVIEW32"
         ' Adds a list view control to the window.
         wsClassName = "SysListView32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_CLIPCHILDREN OR WS_TABSTOP OR LVS_REPORT OR LVS_SHOWSELALWAYS OR LVS_SHAREIMAGELISTS OR LVS_AUTOARRANGE OR LVS_EDITLABELS OR LVS_ALIGNTOP
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "REBAR", "REBARWINDOW32"
         ' Adds a rebar control to the window.
         wsClassName = "ReBarWindow32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_BORDER OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS OR CCS_NOPARENTALIGN OR CCS_NODIVIDER OR RBS_BANDBORDERS
      CASE "DATETIMEPICKER", "SYSDATETIMEPICK32"
         ' Adds a date time picker control to the window.
         wsClassName = "SysDateTimePick32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR DTS_SHORTDATEFORMAT
      CASE "MONTHCALENDAR", "MONTHCAL", "SYSMONTHCAL32"
         ' Adds a month calendar control to the window.
         wsClassName = "SysMonthCal32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "IPADDRESS", "SYSIPADDRESS32"
         ' Adds an IPAddress control to the window.
         wsClassName = "SysIPAddress32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "HOTKEY", "msctls_hotkey32"
         ' Adds an hotkey control to the window.
         wsClassName = "msctls_hotkey32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP
         IF dwExStyle = 0 THEN dwExStyle = WS_EX_CLIENTEDGE
      CASE "ANIMATE", "ANIMATION", "SYSANIMATE32"
         ' Adds an animation control to the window.
         wsClassName = "SysAnimate32"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR ACS_TRANSPARENT
      CASE "SYSLINK"
         ' Adds a SysLink control to the window.
         ' Note: The SysLink control is defined in the ComCtl32.dll version 6 and requires a manifest
         ' or directive that specifies that version 6 of the DLL should be used if it is available.
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP
      CASE "PAGER", "SYSPAGER"
         ' Adds a Pager control to the window.
         wsClassName = "SysPager"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP
   END SELECT
   ' // Make sure that the control has the WS_CHILD style
   dwStyle = dwStyle OR WS_CHILD
   ' // Create the control
   hCtl = CreateWindowExW(dwExStyle, wsClassName, wszTitle, dwStyle, x * m_rx, y * m_ry, nWidth * m_rx, nHeight * m_ry, _
         hParent, CAST(HMENU, CAST(LONG_PTR, cID)), m_hInstance, CAST(LPVOID, lpParam))
   IF hCtl = NULL THEN EXIT FUNCTION
   ' // Subclass the control if pWndProc is not null
   IF pWndProc <> NULL THEN SetPropW(hCtl, "OLDWNDPROC", CAST(HANDLE, SetWindowLongPtrW(hCtl, GWLP_WNDPROC, CAST(LONG_PTR, pWndProc))))
   FUNCTION = hCtl
END FUNCTION
' =====================================================================================


Usage:

Code Select Expand


   ' // Add controls
   pWindow.AddControl("Button", pWindow.hwindow, IDCANCEL, "&Close", 350, 250, 75, 23)
   pWindow.AddControl("Label", pWindow.hwindow, 101, "This is a label", 150, 250, 150, 23)
   pWindow.AddControl("Edit", pWindow.hwindow, 102, "This is a TextBox", 150, 200, 150, 23)
   pWindow.AddControl("CheckBox", pWindow.hwindow, 102, "This is a Checkbox", 150, 150, 150, 23)
   FUNCTION = pWindow.DoEvents(nCmdShow)


Maybe it will work with the 32 bit compiler. I think that I haven't used anything exclusive of 64 bit.

[José Roca]

One suggestion: Use .bi instead of .inc so we get syntax coloring with FbEdit.

I think that it is the author of FbEdit who should add support for .inc files, that is an extension that all non VB programmers have been using for decades. I'm using a modified version of CSED.

[Paul Squires]

I don't think that the double CAST'ing is necessary(?)

Code Select Expand


CAST(HMENU, CAST(LONG_PTR, cID))


In all my code I have never gotten a compiler warning simply doing the one cast to HMENU.

Code Select Expand


CAST(HMENU, cID)


[José Roca]

I was using a LONG when I wrote it and got a warning. The double casting is not needed if I use an Integer, because that data type is 64 bit in the 64 bit compiler.

[José Roca]

For SDk programmers like you and me, this language is easy to learn, but I'm afraid that DDTers will we lost. Too heavy use of pointers and casting because of translated headers that are BASIC-unfriendly.

Another problem is that since there is not dead code removal, I can't to add as much functionality as I would like to the CWindow class because of bloat.

For the wrapper functions, I will need to learn how to make libraries.

[Paul Squires]

This is a copy of a batch file I was using to compile all my wrapper source code files, create a static library, and finally copy them to the correct INC and LIB locations. Maybe it will be of use later. I know that I stole the batch file idea from somewhere.

Code Select Expand



set FBLIBDIR=win32
set FBCPATH=E:\FB\FreeBASIC-1.03.0-win32

:: compile source files (main jellygui objects and wrappers subfolder)
@for /R %%s in (*.bas) do %FBCPATH%\fbc.exe -nodeflibs -c "%%s"
@if ErrorLevel 1 goto compileerror

:: link object files
%FBCPATH%\fbc.exe -w pedantic -lib -x libJellyGUI.a "*.o" ".\wrappers\*.o"
@if ErrorLevel 1 goto linkerror

:: delete the temporary object files
del /Q "*.o"
del /Q ".\wrappers\*.o"

@echo SUCCESS!! Static Library JellyGUI (libJellyGUI.a) built.

:: copy the static library to the FB lib folder
copy libjellygui.a %FBCPATH%\lib\%FBLIBDIR%\libjellygui.a

:: copy the include files to the jellygui inc folder
md %FBCPATH%\inc\jellygui
copy *.bi %FBCPATH%\inc\jellygui\

goto exit


:linkerror
@echo *ERR: LINK ERROR
@goto exit

:compileerror
@echo *ERR: COMPILE ERROR
@goto exit


:exit

@pause



[José Roca]

Thanks very much.

This is the current version of CWindow.inc. I have added functions to create logical fonts, etc., and reworked the AddControl function. I will add support for more controls later.

It already can be used to build simple GUI's easily. Adding more stuff is just a matter of time.

However, without native support for variants and dynamic OLE strings, COM programming is going to be a real pain.

[José Roca]

I was trying to figure how to pass a pointer to the CWindow class to a procedure.

This works

Code Select Expand


SUB Foo (BYVAL pWindow AS CWindow PTR)
   PRINT "Foo: ", pWindow->DPI
END SUB

...

Foo @pWindow


But in the Foo procedure I have to use -> (pWindow->DPI) instead of "." (pWindow.DPI)

[José Roca]

This variation allows me to use the "." syntax:

Code Select Expand


SUB Foo2 (BYREF pWindow AS CWindow)
   PRINT "Foo2: ", pWindow.DPI
END SUB

....
Foo2 pWindow