• Welcome to PlanetSquires Forums.
 

CWindow for FreeBasic (Beta)

Started by José Roca, August 24, 2015, 04:53:18 PM

Previous topic - Next topic

José Roca

Almost finished. I will add support for RichEdit controls and accelerator tables later.

Usage example:


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

USING Afx.CWindowClass

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
' ================================================================e========================
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_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.SetClientSize(500, 320)
   pWindow.Center

   ' // Add controls
   DIM hCtl AS HWND
   pWindow.AddControl("Label", pWindow.hWindow, 101, "This is a label", 150, 250, 150, 23)
   hCtl = pWindow.AddControl("Edit", pWindow.hWindow, 102, "This is a TextBox", 150, 200, 150, 23)
   pWindow.AddControl("CheckBox", pWindow.hWindow, 103, "This is a Checkbox", 150, 150, 150, 23)
   pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 350, 250, 75, 23)
   SetFocus hCtl

   FUNCTION = pWindow.DoEvents(nCmdShow)

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


Note: Not all the controls have been tested yet.

José Roca

#1
ListBox example:


#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "string.bi"
#define IDC_LISTBOX 1001

' ========================================================================================
' Adds a string to a list box. If the list box does not have the LBS_SORT style, the
' string is added to the end of the list. Otherwise, the string is inserted into the list
' and the list is sorted.
' ========================================================================================
FUNCTION ListBox_AddStringW (BYVAL hListBox AS HWND, BYREF wszText AS WSTRING) AS LONG
   FUNCTION = SendMessageW(hListBox, LB_ADDSTRING, 0, CAST(LPARAM, @wszText))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Selects a string and scroll it into view, if necessary. When the new string is selected,
' the list box removes the highlight from the previously selected string.
' ========================================================================================
FUNCTION ListBox_SetCurSel (BYVAL hListBox AS HWND, BYVAL Index AS LONG) AS LONG
   FUNCTION = SendMessageW(hListBox, IIF((GetWindowLongPtr(hListBox, GWL_STYLE) AND LBS_MULTIPLESEL), LB_SETSEL, LB_SETCURSEL), Index, 0)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Gets the index of the currently selected item, if any, in a list box.
' ========================================================================================
FUNCTION ListBox_GetCurSel (BYVAL hListBox AS HWND) AS LONG
   FUNCTION = SendMessageW(hListBox, IIF((GetWindowLongPtr(hListBox, GWL_STYLE) AND LBS_MULTIPLESEL), LB_GETCARETINDEX, LB_GETCURSEL), 0, 0)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Gets the length of a string in a list box.
' ========================================================================================
FUNCTION Listbox_GetTextLen (BYVAL hListBox AS HWND, BYVAL index AS LONG) AS LONG
   FUNCTION = SendMessageW(hListBox, LB_GETTEXTLEN, CAST(WPARAM, index), 0)
END FUNCTION
' ========================================================================================

USING Afx.CWindowClass

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

         CASE IDC_LISTBOX
            SELECT CASE HIWORD(wParam)
               CASE LBN_DBLCLK
                  ' // Get the handle of the Listbox
                  DIM hListBox AS HWND
                  hListBox = GetDlgItem(hwnd, IDC_LISTBOX)
                  ' // Get the current selection
                  DIM curSel AS LONG
                  curSel = ListBox_GetCurSel(hListBox)
                  DIM buffer AS WSTRING * 260
                  SendMessageW hListBox, LB_GETTEXT, CAST(WPARAM, curSel), CAST(LPARAM, @buffer)
                  MessageBoxW(hwnd, @buffer, "ListBox test", MB_OK)
                  EXIT FUNCTION
            END SELECT

         END SELECT

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.ClassStyle = CS_DBLCLKS   ' // Change the window style to avoid flicker
   pWindow.SetClientSize(320, 375)
   pWindow.Center

   ' // Adds a listbox
   DIM hListBox AS HWND
   hListBox = pWindow.AddControl("ListBox", pWindow.hWindow, IDC_LISTBOX, "")
   pWindow.SetWindowPos hListBox, NULL, 8, 8, 300, 320, SWP_NOZORDER

   ' // Fill the list box
   DIM i AS LONG = 1
   FOR i = 1 TO 50
      ListBox_AddStringW(hListBox, "Item " + FORMAT(i, "00"))
   NEXT
   ' // Select the first item
   ListBox_SetCurSel hListBox, 0

   ' // Add a cancel button
   pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Cancel", 233, 338, 75, 23)

   FUNCTION = pWindow.DoEvents(nCmdShow)

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


Paul Squires

Thanks Jose, I have download all of your new code so far and the ListBox example works perfectly.  :)

I am going to try to create a ListBox class just to see if it would work in the context of your code, or if it will too overly cumbersome/awkward. I will post it when it's ready so you can pass an opinion on it.
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

#3
Try to not call API "A" functions. Working hard in the BSTR class. I think that I'm going to rename it as CBSTR instead of AfxBSTR.

Paul Squires

I need to make an effort never to use "A" again. :)

Just thinking out loud, maybe even name your string class BSTRING and WBSTRING? That would make the class "fit" better with the standard FB string data types like String, ZString, WString.
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

#5
Changed the last parameter of CreateWindowEx to pass a pointer to the CWindow class.


   m_hwnd = CreateWindowExW(dwExStyle, CAST(LPCWSTR, CAST(ULONG_PTR, CAST(WORD, m_wAtom))), wszTitle, dwStyle, _
            IIF(x = CW_USEDEFAULT, CW_USEDEFAULT, x * m_rx), _
            IIF(y = CW_USEDEFAULT, CW_USEDEFAULT, y * m_ry), _
            IIF(nWidth = CW_USEDEFAULT, CW_USEDEFAULT, nWidth * m_rx), _
            IIF(nHeight = CW_USEDEFAULT, CW_USEDEFAULT, nHeight * m_ry), _
            hParent, NULL, m_hInstance,CAST(HANDLE, @this))


to allow its use in the WM_CREATE message (some Petzold followers like it).

Usage example:


CASE WM_CREATE
   DIM pCreateStruct AS CREATESTRUCT PTR = CAST(CREATESTRUCT PTR, lParam)
   DIM pWindow AS CWindow PTR = CAST(CWindow PTR, pCreateStruct->lpCreateParams)
   IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close", 350, 250, 75, 23)
   EXIT FUNCTION