@Paul,
Do you know how to pass an Atom to CreateWindowExW?
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.
Hi Jose,
The following should work. The trick is using the MAKEINTATOM macro that is defined in winbase.bi
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 )
Almost... They have forget to provide an Unicode version.
But this works:
CreateWindowExW(dwExStyle, CAST(LPCWSTR, CAST(ULONG_PTR, CAST(WORD, m_wAtom))) ....
This is a bit insane...
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:
#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
' ========================================================================================
It's nice to see you coding again! :) :) :)
Jose,
Great stuff!!
One suggestion: Use .bi instead of .inc so we get syntax coloring with FbEdit.
James
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.
' =====================================================================================
' 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:
' // 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.
Quote
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.
I don't think that the double CAST'ing is necessary(?)
CAST(HMENU, CAST(LONG_PTR, cID))
In all my code I have never gotten a compiler warning simply doing the one cast to HMENU.
CAST(HMENU, cID)
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.
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.
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.
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
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.
I was trying to figure how to pass a pointer to the CWindow class to a procedure.
This works
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)
This variation allows me to use the "." syntax:
SUB Foo2 (BYREF pWindow AS CWindow)
PRINT "Foo2: ", pWindow.DPI
END SUB
....
Foo2 pWindow
I have installed manually the 32-bit compiler (I had problems with the installer) and my tests work fine without changes.
Unless I'm missing something, there is no need for an ansi version of CWindow.
@Paul,
Another possibility is to create a class for each control.
For example:
' ########################################################################################
' Microsoft Windows
' File: CButton.inc
' Contents: Button Control Wrapper Class
' Copyright (c) 2015 Jose Roca
' Compiler: FreeBasic 64-bit, Unicode.
' All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#pragma once
#include once "windows.bi"
#include once "Afx/CWindow.inc"
#include once "win/commctrl.bi"
USING Afx.CWindowClass
NAMESPACE Afx.CButtonClass
' ========================================================================================
' CButton class
' ========================================================================================
TYPE CButton
Private:
m_pWindow AS CWindow PTR ' // CWindow pointer
m_hCtl AS HWND ' // Button handle
Public:
DECLARE CONSTRUCTOR (BYVAL pWindow AS CWindow PTR)
DECLARE DESTRUCTOR
DECLARE FUNCTION Create (BYVAL cID AS INTEGER, BYREF wszTitle AS WSTRING = "", _
BYVAL x AS LONG = 0, BYVAL y AS LONG = 0, BYVAL nWidth AS LONG = 0, BYVAL nHeight AS LONG = 0, _
BYVAL dwStyle AS DWORD = 0, BYVAL dwExStyle AS DWORD = 0, BYVAL lpParam AS LONG_PTR = 0, BYVAL pWndProc AS WNDPROC = NULL) AS HWND
DECLARE SUB Click ()
DECLARE FUNCTION Enable () AS LONG
DECLARE FUNCTION Disable () AS LONG
DECLARE FUNCTION GetCheck () AS LONG
END TYPE
' ========================================================================================
' ========================================================================================
' CWindow class constructor
' ========================================================================================
CONSTRUCTOR CButton (BYVAL pWindow AS CWindow PTR)
m_pWindow = pWindow
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' CButton class destructor
' ========================================================================================
DESTRUCTOR CButton
END DESTRUCTOR
' ========================================================================================
' =====================================================================================
' Adds a button to the window
' =====================================================================================
FUNCTION CButton.Create ( _
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
IF m_pWindow = NULL THEN EXIT FUNCTION
' // Button styles
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
' // Make sure that the control has the WS_CHILD style
dwStyle = dwStyle OR WS_CHILD
' // Create the control
m_hCtl = CreateWindowExW(dwExStyle, "Button", wszTitle, dwStyle, _
x * m_pWindow->rxRatio, y * m_pWindow->ryRatio, nWidth * m_pWindow->rxRatio, nHeight * m_pWindow->ryRatio, _
m_pWindow->hWindow, CAST(HMENU, CAST(LONG_PTR, cID)), m_pWindow->GetInstance, CAST(LPVOID, lpParam))
IF m_hCtl = NULL THEN EXIT FUNCTION
' // Set the font
IF m_pWindow->Font THEN SendMessageW m_hCtl, WM_SETFONT, CAST(WPARAM, m_pWindow->Font), TRUE
' // Subclass the control if pWndProc is not null
IF pWndProc <> NULL THEN SetPropW(m_hCtl, "OLDWNDPROC", CAST(HANDLE, SetWindowLongPtrW(m_hCtl, GWLP_WNDPROC, CAST(LONG_PTR, pWndProc))))
FUNCTION = m_hCtl
END FUNCTION
' =====================================================================================
' ========================================================================================
' Simulates the user clicking a button.
' ========================================================================================
SUB CButton.Click
SendMessageW m_hCtl, BM_CLICK, 0, 0
END SUB
' ========================================================================================
' ========================================================================================
' Enables a button.
' ========================================================================================
FUNCTION CButton.Enable () AS LONG
FUNCTION = .EnableWindow(m_hCtl, TRUE)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Disables a button.
' ========================================================================================
FUNCTION CButton.Disable () AS LONG
FUNCTION = .EnableWindow(m_hCtl, FALSE)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves the check state of a radio button or check box.
' ========================================================================================
FUNCTION CButton.GetCheck () AS LONG
FUNCTION = SendMessageW(m_hCtl, BM_GETCHECK, 0, 0)
END FUNCTION
' ========================================================================================
.....
More procedures
END NAMESPACE
Usage example:
DIM pButton AS CButton = @pWindow
pButton.Create(IDCANCEL, "&Close", 350, 250, 75, 23)
What do you think?
The only problem will be the bloat.
We can also use the class of each control to store all kind of data we find useful.
To access it, we can store the class pointer using SetPropW, retrieve it with GetPropW and cast it to a variable declared as CButton PTR.
There are plenty of possibilities.
I like the idea of having the controls in separate classes. You could create a base class with all the common properties and then use the EXTENDS keyword to inherit to your specific class. This is something that I had been playing with in FreeBASIC.
I like the idea of classes and objects because then I can modify Firefly to allow codetip popups/dropdowns whenever someone types a variable referencing a control.
eg.
Firefly would generate the shared variable for the control based on that control's name.
DIM Shared frmMain_cmdOK As clsButton
frmMain_cmdOK.Caption = "OK"
...or something like that.
There will be a little bit of bloat but the benefits would outweigh the size increases especially for users who are not API savvy.
The more that I use FB's OOP capabilities, the more that I love it. I am able to write incredibly easy to use code using the TYPE syntax. It is easy to write functions, subs, properties, public/private variables etc to extend the TYPE structures. Inheriting from base class and using constructors and destructors.
The best feature I have found so far is the extremely easy way to overload subs/functions (and constructors). I am just finishing writing a keylist/hash table/dictionary/associative array class and adding data of different types is as easy as the following:
Declare Function AddItem Overload ( ByRef sKey As String, ByRef sData As String) ByRef As clsListNode
Declare Function AddItem Overload ( ByRef sKey As String, ByRef nData As Integer) ByRef As clsListNode
Declare Function AddItem Overload ( ByRef sKey As String, ByRef nData As Double) ByRef As clsListNode
Declare Function AddItem Overload ( ByRef sKey As String, ByRef nAddr As Any Ptr, ByRef nSize As Integer) ByRef As clsListNode
Depending on what kind of data the programmer is adding, the compiler picks the appropriate function. I have used this in C++ before but now that I have it in FB it makes things sooooo much easier.
' Add a string
cList.AddItem( "12345", "Paul Squires" )
' Add an integer
cList.AddItem( "12345", 500 )
' Add a double
cList.AddItem( "12345", 3.14587 )
' Add a specific area of memory (e is a TYPE variable representing, say, an employee record)
cList.AddItem( "12345", @e, len(e) )