PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 [2]

Author Topic: CWindow RC01 - Tab Control  (Read 6185 times)

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - IPAddress
« Reply #15 on: April 08, 2016, 04:02:23 PM »

IPAddress control example.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_IPAddress.fbtpl - Template
' Contents: Demonstrates the use of the IPAddress control.
' Remarks: An Internet Protocol (IP) address control allows the user to enter an IP address
' in an easily understood format. This control also allows the application to obtain the
' address in numeric form rather than in text form.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

USING Afx.CWindowClass

CONST IDC_IPADDRESS = 1001

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

   END WinMain(GetModuleHandleW(""), 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

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDC_IPADDRESS
               IF HIWORD(wParam) = EN_CHANGE THEN
                  ' *** Put your code here ***
'                  Sample code: Get the address in string form
'                  DIM wszText AS WSTRING * 260
'                  GetWindowTextW(GetDlgItem(hwnd, IDC_IPADDRESS), @wszText, 260)
'                  OutputDebugStringW wszText
               END IF
         END SELECT

      CASE WM_NOTIFY
         DIM ptnmhdr AS NMHDR PTR = CAST(NMHDR PTR, lParam)
         SELECT CASE ptnmhdr->idFrom
            CASE IDC_IPADDRESS
               IF ptnmhdr->code = IPN_FIELDCHANGED THEN
                  ' *** Put your code here ***
               END IF
         END SELECT

    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

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "IPAddress", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add an IPAddress control
   DIM hCtl AS HWND = pWindow.AddControl("IPAddress", pWindow.hWindow, IDC_IPADDRESS, "", 120, 50, 120, 23)
   SetFocus hCtl

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - TreeView example
« Reply #16 on: April 09, 2016, 07:35:06 PM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_TreeView.fbtpl
' Contents: Template - CWindow with a TreeView
' Compiler: Free Basic
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

#define IDC_TREEVIEW 1001

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(GetModuleHandleW(""), NULL, COMMAND(), SW_NORMAL)

' ========================================================================================
' Inserts a new item in a tree-view control.
' ========================================================================================
FUNCTION TreeView_AddItemW (BYVAL hwndTV AS HWND, BYVAL hParent AS HTREEITEM, BYVAL hInsertAfter AS HTREEITEM, BYVAL iImage AS LONG, BYVAL iSelectedImage AS LONG, BYREF wszText AS WSTRING) AS HTREEITEM
   DIM tvinsert AS TVINSERTSTRUCTW
   tvinsert.hParent             = hParent
   tvinsert.hInsertAfter        = hInsertAfter
   tvinsert.Item.iImage         = iImage
   tvinsert.Item.iSelectedImage = iSelectedImage
   tvinsert.Item.mask           = TVIF_TEXT OR TVIF_IMAGE OR TVIF_SELECTEDIMAGE
   tvinsert.Item.pszText        = @wszText
   tvinsert.Item.cchTextMax     = LEN(wszText)
   FUNCTION = CAST(HTREEITEM, SendMessageW(hwndTV, TVM_INSERTITEM, 0, CAST(LPARAM, @tvinsert)))
END FUNCTION
' ========================================================================================

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

   SELECT CASE uMsg

      CASE WM_CREATE
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_NOTIFY
         DIM ptnmhdr AS NMHDR PTR = CAST(NMHDR PTR, lParam)
         SELECT CASE ptnmhdr->idFrom
            CASE IDC_TREEVIEW
               IF ptnmhdr->code = CULNG(NM_DBLCLK) THEN
                  ' // Retrieve the handle of the TreeView
                  DIM hTreeView AS HWND = GetDlgItem(hwnd, IDC_TREEVIEW)
                  ' // Retrieve the selected item
                  DIM hItem AS HTREEITEM = CAST(HTREEITEM, SendMessageW(hTreeView, TVM_GETNEXTITEM, TVGN_CARET, CAST(LPARAM, NULL)))
                  ' // Retrieve the text of the selected item
                  DIM tvi AS TVITEMW
                  DIM wszText AS WSTRING * 260
                  tvi.hitem = hItem
                  tvi.mask = TVIF_TEXT
                  tvi.psztext = @wszText
                  tvi.cchtextmax = SIZEOF(wszText)
                  SendMessageW(hTreeView, TVM_GETITEMW, 0, CAST(LPARAM, @tvi))
                  MessageBox hwnd, wszText, "", MB_OK
                  EXIT FUNCTION
               END IF
         END SELECT

    CASE WM_DESTROY
          ' // End the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to DefWindowProc
   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 with a TreeView", @WndProc)
   pWindow.ClassStyle = CS_DBLCLKS   ' // Change the window style to avoid flicker
   pWindow.SetClientSize(320, 375)
   pWindow.Center

   ' // Add a TreeView
   DIM hTreeView AS HWND
   hTreeView = pWindow.AddControl("TreeView", pWindow.hWindow, IDC_TREEVIEW, "")
   pWindow.SetWindowPos hTreeView, NULL, 8, 8, 300, 320, SWP_NOZORDER

   ' // Add items to the TreeView
   DIM AS HTREEITEM hRoot, hNode, hItem, hSubNode
   ' // Create the root node
   hRoot = TreeView_AddItemW(hTreeView, 0, TVI_ROOT, 0, 0, "Root")
   ' // Create a node
   hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 1")
   ' // Insert items in the node
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 1")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 2")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 3")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 4")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 5")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 6")
   ' // Expand the node
   SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
   ' // Create another node
   hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 2")
   ' // Insert items in the node
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 1")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 2")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 3")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 4")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 5")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 6")
   ' // Expand the node
   SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
   ' // Expand the node
   SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
   ' // Create another node
   hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 3")
   ' // Insert items in the node
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 1")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 2")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 3")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 4")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 5")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 6")
   ' // Expand the node
   SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
   ' // Create another node
   hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 4")
   ' // Insert items in the node
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 1")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 2")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 3")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 4")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 5")
   hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 6")
   ' // Expand the node
   SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)

   ' // Expand the root node
   SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hRoot)

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

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Buffered animation
« Reply #17 on: April 10, 2016, 08:40:25 AM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_BufferedAnimation.fbtpl - Template
' Contents: Demonstrates the use of BeginBufferedAnimation.
' Note: Click the left mouse button of the mouse to start the animation.
' Remarks: Minimum operating systems: Windows Vista, Windows 7
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

#define unicode
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/uxtheme.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

#define ANIMATION_DURATION 500
#define IDC_LABEL 1001

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

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

' ========================================================================================
' Paints the icon
' ========================================================================================
SUB PaintIt (BYVAL hwnd AS HWND, BYVAL hdc AS HDC, BYVAL nState AS LONG)

   DIM rc AS RECT
   GetClientRect(hwnd, @rc)
   FillRect(hdc, @rc, GetStockObject(WHITE_BRUSH))
   LoadIcon (NULL, IDI_APPLICATION)
   DIM hIcon AS HICON = LoadIcon(NULL, IIF(nState = 1, IDI_APPLICATION, IDI_ERROR))
   IF hIcon THEN
      DrawIcon(hdc, 10, 10, hIcon)
      DestroyIcon(hIcon)
   END IF

END SUB
' ========================================================================================

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

   DIM hdc AS HDC                              ' // Device context handle
   DIM ps AS PAINTSTRUCT                       ' // PAINTSTRUCT structure
   DIM animParams AS BP_ANIMATIONPARAMS        ' // Animation parameters
   DIM hbpAnimation AS HANIMATIONBUFFER        ' // Handle to the buffered paint animation
   DIM hdcFrom AS HDC                          ' // Handle of the DC where the application should paint the initial state of the animation
   DIM hdcTo AS HDC                            ' // Handle of the DC where the application should paint the final state of the animation
   DIM rc AS RECT                              ' // Coordinates of the window's client area
   STATIC fCurrentState AS LONG                ' // Boolean flag
   STATIC fNewState AS LONG                    ' // Boolean flag

   SELECT CASE uMsg

      CASE WM_CREATE
         fCurrentState = CTRUE
         fNewState = CTRUE

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_LBUTTONDOWN
         ' // Start animation
         fNewState = NOT fCurrentState
         InvalidateRect(hwnd, NULL, CTRUE)
         EXIT FUNCTION

      CASE WM_PAINT
         hdc = BeginPaint(hwnd, @ps)
         IF hdc THEN
            ' // See if this paint was generated by a soft-fade animation
            IF BufferedPaintRenderAnimation(hwnd, hdc) = 0 THEN
               animParams.cbSize = SIZEOF(BP_ANIMATIONPARAMS)
               animParams.style = BPAS_LINEAR
               ' // Check if animation is needed. If not set dwDuration to 0
               animParams.dwDuration = IIF(fCurrentState <> fNewState, ANIMATION_DURATION, 0)
               GetClientRect(hwnd, @rc)
               hbpAnimation = BeginBufferedAnimation(hwnd, hdc, @rc, _
                  BPBF_COMPATIBLEBITMAP, NULL, @animParams, @hdcFrom, @hdcTo)
               IF hbpAnimation THEN
                  IF hdcFrom THEN
                     PaintIt(hwnd, hdcFrom, fCurrentState)
                  END IF
                  IF hdcTo THEN
                     PaintIt(hwnd, hdcTo, fNewState)
                  END IF
                  fCurrentState = fNewState
                  EndBufferedAnimation(hbpAnimation, CTRUE)
               ELSE
                  PaintIt(hwnd, hdc, fCurrentState)
               END IF
            END IF
            EndPaint hwnd, @ps
         END IF
         EXIT FUNCTION

      CASE WM_CTLCOLORSTATIC
         ' // Return the handle of the brush used to paint background
         IF GetDlgCtrlID(CAST(HWND, lParam)) = IDC_LABEL THEN
            FUNCTION = CAST(LRESULT, GetStockObject(WHITE_BRUSH))
            EXIT FUNCTION
         END IF

      CASE WM_SIZE
         ' // Stops the buffered animation
         BufferedPaintStopAllAnimations hwnd
         EXIT FUNCTION

    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

   ' // Required: Initialize buffered painting for the current thread.
   IF FAILED(BufferedPaintInit) THEN EXIT FUNCTION

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "Buffered animation", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add a label
   pWindow.AddControl("Label", pWindow.hWindow, IDC_LABEL, "  Click the icon with the mouse left button", 70, 10, 235, 23)

   

   ' // Process events
   FUNCTION = pWindow.DoEvents(nCmdShow)

   ' // Required: Closes down buffered painting for the current thread.
   BufferedPaintUnInit

END FUNCTION
' ========================================================================================
« Last Edit: April 10, 2016, 04:51:39 PM by Jose Roca »
Logged

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Label Control
« Reply #18 on: April 10, 2016, 09:24:25 AM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_Label.fbtpl - Template
' Contents: Demonstrates the use of the Label control.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

USING Afx.CWindowClass

CONST IDC_LABEL = 1001

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

   END WinMain(GetModuleHandleW(""), 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

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_CTLCOLORSTATIC
         IF GetDlgCtrlID(CAST(HWND, lParam)) = IDC_LABEL THEN
            ' // Set the background and text colors
            SetBkColor CAST(HDC, wParam), &h00ED9564
            SetTextColor CAST(HDC, wParam), &h00FFFFFF
            ' // Return handle of brush used to paint background
            FUNCTION = CAST(LRESULT, GetPropW(CAST(HWND, lParam), "BRUSH"))
            EXIT FUNCTION
         END IF

    CASE WM_DESTROY
         ' // Destroy custom brush
         DeleteObject CAST(HGDIOBJ, RemovePropW(GetDlgItem(hwnd, IDC_LABEL), "BRUSH"))
         ' // End the application
         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

   ' // Create the main windows
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with a label control", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add a label control
   DIM hLabel AS HWND = pWindow.AddControl("Label", pWindow.hWindow, IDC_LABEL, "This is a label", 100, 50, 150, 23)
   ' // Create custom brush for the label
   DIM tlb AS LOGBRUSH
   tlb.lbStyle = BS_SOLID
   tlb.lbColor = &h00ED9564
   DIM hBrush AS HBRUSH = CreateBrushIndirect(@tlb)
   SetPropw hLabel, "BRUSH", hBrush

   

   ' // Process events
   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Menu
« Reply #19 on: April 10, 2016, 09:54:41 AM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_Menu.fbtpl
' Contents: CWindow with a menu
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

USING Afx.CWindowClass

' // Menu identifiers
#define IDM_NEW      1001   ' New file
#define IDM_OPEN     1002   ' Open file...
#define IDM_SAVE     1003   ' Save file
#define IDM_SAVEAS   1004   ' Save file as...
#define IDM_EXIT     1005   ' Exit

#define IDM_UNDO     2001   ' Undo
#define IDM_CUT      2002   ' Cut
#define IDM_COPY     2003   ' Copy
#define IDM_PASTE    2004   ' Paste

#define IDM_TILEH    3001   ' Tile hosizontal
#define IDM_TILEV    3002   ' Tile vertical
#define IDM_CASCADE  3003   ' Cascade
#define IDM_ARRANGE  3004   ' Arrange icons
#define IDM_CLOSE    3005   ' Close
#define IDM_CLOSEALL 3006   ' Close all

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

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

' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU

   DIM hMenu AS HMENU
   DIM hPopUpMenu AS HMENU

   hMenu = CreateMenu
   hPopUpMenu = CreatePopUpMenu
      AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_NEW, "&New" & CHR(9) & "Ctrl+N"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_OPEN, "&Open..." & CHR(9) & "Ctrl+O"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVEAS, "Save &As..."
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
   hPopUpMenu = CreatePopUpMenu
      AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&Edit"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+Z"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CUT, "Cu&t" & CHR(9) & "Ctrl+X"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_COPY, "&Copy" & CHR(9) & "Ctrl+C"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_PASTE, "&Paste" & CHR(9) & "Ctrl+V"
   hPopUpMenu = CreatePopUpMenu
      AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&Window"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_TILEH, "&Tile Horizontal"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_TILEV, "Tile &Vertical"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CASCADE, "Ca&scade"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_ARRANGE, "&Arrange &Icons"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CLOSE, "&Close" & CHR(9) & "Ctrl+F4"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CLOSEALL, "Close &All"
   FUNCTION = hMenu

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

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

   SELECT CASE uMsg

      CASE WM_CREATE
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDM_NEW   ' IDM_OPEN, IDM_SAVE, etc.
               MessageBox hwnd, "New option clicked", "Menu", MB_OK
               EXIT FUNCTION
         END SELECT

    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 with a menu", @WndProc)
   pWindow.SetClientSize(400, 250)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280,180, 75, 23)

   ' // Create the menu
   DIM hMenu AS HMENU = BuildMenu
   SetMenu pWindow.hWindow, hMenu

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Context menu
« Reply #20 on: April 10, 2016, 10:21:28 AM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_ContextMenu.fbtpl
' Contents: CWindow with a context menu
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

USING Afx.CWindowClass

#define IDC_LABEL 1001

' // Menu identifiers
#define IDM_NEW      1001   ' New file
#define IDM_OPEN     1002   ' Open file...
#define IDM_SAVE     1003   ' Save file
#define IDM_SAVEAS   1004   ' Save file as...
#define IDM_EXIT     1005   ' Exit

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

   END WinMain(GetModuleHandleW(""), 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

   SELECT CASE uMsg

      CASE WM_CREATE
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application sending an WM_CLOSE message
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDM_NEW   ' IDM_OPEN, IDM_SAVE, etc.
               MessageBox hwnd, "New option clicked", "Menu", MB_OK
               EXIT FUNCTION
         END SELECT

      CASE WM_CONTEXTMENU
         ' // Build the context menu
         DIM hPopUpMenu AS HMENU = CreatePopUpMenu
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_NEW, "&New" & CHR(9) & "Ctrl+N"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_OPEN, "&Open..." & CHR(9) & "Ctrl+O"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVEAS, "Save &As..."
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
         DIM pt AS POINT
         GetCursorPos @pt
         TrackPopupMenu hPopupMenu, 0, pt.x, pt.y, 0, hwnd, NULL
         DestroyMenu hPopupMenu
         EXIT FUNCTION

    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 with a context menu", @WndProc)
   pWindow.SetClientSize(400, 230)
   pWindow.Center

   ' // Add a label
   pWindow.AddControl("Label", pWindow.hWindow, IDC_LABEL, " Click the mouse right button", 110, 20, 175, 23)
   ' // Add a button
   pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280,180, 75, 23)

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #21 on: April 10, 2016, 04:54:24 PM »

After installing the latest version of the compiler, the BufferedPaint example stopped working.

It happens that they have changed the value of True from 1 to -1.

Now we have to use CTrue.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Duplicate equates
« Reply #22 on: April 11, 2016, 07:53:12 AM »

The following equates are duplicated and must be remmed.

WinNT.bi

const JOB_OBJECT_LIMIT_RESERVED3 = &h00008000
const JOB_OBJECT_LIMIT_RESERVED4 = &h00010000
const JOB_OBJECT_LIMIT_RESERVED5 = &h00020000
const JOB_OBJECT_LIMIT_RESERVED6 = &h00040000

WinGdi.bi
const DM_UPDATE = 1
const DM_COPY = 2
const DM_PROMPT = 4
const DM_MODIFY = 8
#define DM_IN_BUFFER DM_MODIFY
#define DM_IN_PROMPT DM_PROMPT
#define DM_OUT_BUFFER DM_COPY
#define DM_OUT_DEFAULT DM_UPDATE
const DC_FIELDS = 1
const DC_PAPERS = 2
const DC_PAPERSIZE = 3
const DC_MINEXTENT = 4
const DC_MAXEXTENT = 5
const DC_BINS = 6
const DC_DUPLEX = 7
const DC_SIZE = 8
const DC_EXTRA = 9
const DC_VERSION = 10
const DC_DRIVER = 11
const DC_BINNAMES = 12
const DC_ENUMRESOLUTIONS = 13
const DC_FILEDEPENDENCIES = 14
const DC_TRUETYPE = 15
const DC_PAPERNAMES = 16
const DC_ORIENTATION = 17
const DC_COPIES = 18

WinUser.bi
const MF_END = &h00000080

imm.bi
const MOD_ALT = &h0001
const MOD_CONTROL = &h0002
const MOD_SHIFT = &h0004

commctrl.bi
const TBNRF_HIDEHELP = &h1
const TBNRF_ENDCUSTOMIZE = &h2

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Ownerdraw button with just an image
« Reply #23 on: April 11, 2016, 05:03:01 PM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_ButtonOwnerdraw2.fbtpl - Template
' Contents: Ownerdraw button with just an image.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

USING Afx.CWindowClass

CONST IDC_BUTTON = 1001

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

   END WinMain(GetModuleHandleW(""), 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

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDC_BUTTON
               IF HIWORD(wParam) = BN_CLICKED THEN
                  MessageBoxW hwnd, "Button clicked", "", MB_OK
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_DRAWITEM
         SCOPE
            DIM pWindow AS CWindow PTR = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
            DIM pDis AS DRAWITEMSTRUCT PTR = CAST(DRAWITEMSTRUCT PTR, lParam)
            IF pDis->CtlId <> IDC_BUTTON THEN EXIT FUNCTION
            ' Icon identifiers in User32.dll. Hacked with ResourceHacker.
            ' IDI_APPLICATION = 100, IDI_WARNING = 101, IDI_QUESTION = 102, IDI_ERROR = 103
            ' IDI_INFORMATION = 104, IDI_WINLOGO = 105, IDI_SHIELD = 106
            ' Used here to make the example simpler.
            ' Normally, you will load an icon or bitmap from a file or resource.
            DIM hIcon AS HICON = LoadImageW(GetModuleHandle("User32"), MAKEINTRESOURCEW(103), IMAGE_ICON, _
               pWindow->ScaleX(50), pWindow->ScaleY(50), LR_DEFAULTCOLOR)
            IF hIcon THEN
               DrawStateW pDis->hDC, NULL, NULL, CAST(LPARAM, hIcon), 0, 0, 0, 0, 0, DST_ICON
               DestroyIcon hIcon
            END IF
         END SCOPE
         FUNCTION = CTRUE
         EXIT FUNCTION

    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 with ownerdraw button", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   DIM hButton AS HWND = pWindow.AddControl("CUSTOMBUTTON", pWindow.hWindow, IDC_BUTTON, "&Ownerdraw button", 150, 50, 50, 50)
'  Alternate way:
'   DIM hButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDC_BUTTON, "&Ownerdraw button", 150, 50, 50, 50, BS_OWNERDRAW)
   SetFocus hButton

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Ownerdraw button with "normal" and "hot" images
« Reply #24 on: April 11, 2016, 07:47:10 PM »

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_ButtonOwnerdraw3.fbtpl - Template
' Contents: Ownerdraw button with "normal" and "hot" images.
' When the mouse enters the button, the image changes to "hot",
' and when it leaves the normal image is restored.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' 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.
' ########################################################################################

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

USING Afx.CWindowClass

CONST IDC_BUTTON = 1001

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

   END WinMain(GetModuleHandleW(""), 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

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_DRAWITEM
         SCOPE
            DIM pWindow AS CWindow PTR = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
            DIM pDis AS DRAWITEMSTRUCT PTR = CAST(DRAWITEMSTRUCT PTR, lParam)
            IF pDis->CtlId <> IDC_BUTTON THEN EXIT FUNCTION
            ' Icon identifiers in User32.dll. Hacked with ResourceHacker.
            ' IDI_APPLICATION = 100, IDI_WARNING = 101, IDI_QUESTION = 102, IDI_ERROR = 103
            ' IDI_INFORMATION = 104, IDI_WINLOGO = 105, IDI_SHIELD = 106
            ' Used here to make the example simpler.
            ' Normally, you will load an icon or bitmap from a file or resource.
            DIM hIcon AS HICON
            IF GetPropW(GetDlgItem(hwnd, IDC_BUTTON), "HOT") = 0 THEN
               hIcon = LoadImageW(GetModuleHandle("User32"), MAKEINTRESOURCEW(102), IMAGE_ICON, _
                  pWindow->ScaleX(50), pWindow->ScaleY(50), LR_DEFAULTCOLOR)
            ELSE
               hIcon = LoadImageW(GetModuleHandle("User32"), MAKEINTRESOURCEW(103), IMAGE_ICON, _
                  pWindow->ScaleX(50), pWindow->ScaleY(50), LR_DEFAULTCOLOR)
            END IF
            IF hIcon THEN
               DrawStateW pDis->hDC, NULL, NULL, CAST(LPARAM, hIcon), 0, 0, 0, 0, 0, DST_ICON
               DestroyIcon hIcon
            END IF
         END SCOPE
         FUNCTION = CTRUE
         EXIT FUNCTION

    CASE WM_DESTROY
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION Button_SubclassProc ( _
   BYVAL hwnd   AS HWND, _                 ' // Control window handle
   BYVAL uMsg   AS UINT, _                 ' // Type of message
   BYVAL wParam AS WPARAM, _               ' // First message parameter
   BYVAL lParam AS LPARAM _                ' // Second message parameter
   ) AS LRESULT

   SELECT CASE uMsg

      CASE WM_GETDLGCODE
         ' // All keyboard input
         FUNCTION = DLGC_WANTALLKEYS
         EXIT FUNCTION

      CASE WM_LBUTTONDOWN
         MessageBoxW(GetParent(hwnd), "Click", "FreeBasic", MB_OK)
         EXIT FUNCTION

      CASE WM_KEYDOWN
         SELECT CASE LOWORD(wParam)
            CASE VK_ESCAPE
               SendMessageW(GetParent(hwnd), WM_CLOSE, 0, 0)
               EXIT FUNCTION
         END SELECT

      CASE WM_MOUSEMOVE
         ' // Tracks the mouse movement and stores the hot state
         DIM trackMouse AS TRACKMOUSEEVENT
         IF GetPropW(hwnd, "HOT") = 0 THEN
            trackMouse.cbSize = SIZEOF(trackMouse)
            trackMouse.dwFlags = TME_LEAVE
            trackMouse.hwndTrack = hwnd
            trackMouse.dwHoverTime = 1
            TrackMouseEvent(@trackMouse)
            SetPropW hwnd, "HOT", CAST(HANDLE, CTRUE)
            InvalidateRect hwnd, NULL, 0
            UpdateWindow hwnd
         END IF
         EXIT FUNCTION

      CASE WM_MOUSELEAVE
         ' // Removes the hot state and redraws the button
         RemovePropW hwnd, "HOT"
         InvalidateRect hwnd, NULL, 0
         UpdateWindow hwnd
         EXIT FUNCTION

      CASE WM_DESTROY
         ' // REQUIRED: Remove control subclassing
         SetWindowLongPtrW hwnd, GWLP_WNDPROC, CAST(LONG_PTR, RemovePropW(hwnd, "OLDWNDPROC"))

   END SELECT

   FUNCTION = CallWindowProcW(GetPropW(hwnd, "OLDWNDPROC"), 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

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with ownerdraw button", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add a subclassed ownerdraw button
   DIM hButton AS HWND = pWindow.AddControl("CustomButton", pWindow.hWindow, IDC_BUTTON, "", 150, 50, 50, 50, 0, 0, 0, CAST(WNDPROC, @Button_SubclassProc))
   SetFocus hButton

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================
Pages: 1 [2]