windows api splitbutton example?

[nastasa eodor]

is there a example(s)?
can't i get correct constant for splitbutton style in windows 7 ...

[Pierre Bellisle]

Here is one Nastasa...

Code: Select all

'Be sure to have resource with a xml manifest
'that ask for Microsoft.Windows.Common-Controls 6.0.

#Define JumpCompiler "<D:\Free\64\fbc.exe>"
#Define JumpCompilerCmd "<-s gui -w pedantic "D:\Free\bas\~~Default.rc">"

#Print Control resize
#Print Coded on FreeBASIC 1.06.0
#Ifdef __FB_64BIT__
  #Print  64bit compiler used
#Else
  #Print  32bit compiler used
#EndIf
'_____________________________________________________________________________

#Define unicode
#define _WIN32_WINNT &h0602

#Include Once "windows.bi"
#Include Once "win\shellapi.bi" 'Extract icon
#Include Once "win\commctrl.bi"

#Define AppName "Split button"

Const BS_SPLITBUTTON = &hc

Const Static01    = 101
Const ButtonSplit = 201
Const Popup01     = 301
Const Popup02     = 302
Const Popup03     = 303
Const Popup04     = 304

Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(NULL)
'_____________________________________________________________________________

Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
 Static hImageList   AS HIMAGELIST
 Static hFont        As HFONT
 Static hStatic      As HWND
 Static hButtonSplit As HWND

 Select Case uMsg

   Case WM_CREATE
     Function = 0

     'Get Windows default font - - - - - - - - - - - - - - - - - - - - - - - -
     Dim As NONCLIENTMETRICS NotClientMetrics
     NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
     SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
     hFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)

     'Create a static control
     hStatic      = CreateWindowEx(WS_EX_CLIENTEDGE , "Static", "Split button", _
                                   WS_CHILD Or WS_VISIBLE Or SS_CENTER Or WS_TABSTOP Or _
                                   SS_NOTIFY Or BS_TEXT Or SS_CENTERIMAGE, _
                                   50, 25, 200, 30, _
                                   hWnd, Cast(HMENU, ButtonSplit), _
                                   hInstance, NULL)
     SendMessage(hStatic, WM_SETFONT, Cast(WPARAM, hFont), TRUE)

     'Create exit split button
     hButtonSplit  = CreateWindowEx(0, "Button", "E&xit", _
                                   WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
                                   BS_NOTIFY Or BS_TEXT Or BS_VCENTER Or BS_SPLITBUTTON, _
                                   110, 70, 80, 30, _
                                   hWnd, Cast(HMENU, ButtonSplit), _
                                   hInstance, NULL)
     SendMessage(hButtonSplit, WM_SETFONT, Cast(WPARAM, hFont), TRUE)

     'Add an icon to the split button
     Dim hIcon           AS HICON
     Dim ButtonImageList AS BUTTON_IMAGELIST
     hImageList = ImageList_Create(16, 16, ILC_MASK OR ILC_COLOR32, 1, 0)
     ImageList_SetBkColor(hImageList, CLR_NONE)
     hIcon = ExtractIcon(GETMODULEHANDLE(""), "%SystemRoot%\system32\PowrProf.dll", 1)
     ImageList_AddIcon(hImageList, hIcon)
     DestroyIcon(hIcon)
     ButtonImageList.himl          = hImageList
     ButtonImageList.uAlign        = BUTTON_IMAGELIST_ALIGN_LEFT
     ButtonImageList.margin.top    = 3
     ButtonImageList.margin.bottom = 3
     ButtonImageList.margin.left   = 3
     ButtonImageList.margin.right  = 3
     SendMessage(hButtonSplit, BCM_SETIMAGELIST, 0, Cast(WPARAM, VarPtr(ButtonImageList))) 'Button_SetImageList(hButton, ButtonImageList)

    Case WM_NOTIFY
     If LoWord(wParam) = ButtonSplit Then
       'Split button drop down was clicked
       Dim pNotifyMessageButtonCommanDropDown As NMBCDROPDOWN POINTER
       Dim hPopup                             As HMENU
       pNotifyMessageButtonCommanDropDown = Cast(NMBCDROPDOWN Pointer, lParam)
       IF pNotifyMessageButtonCommanDropDown->hdr.code = BCN_DROPDOWN Then
           MapWindowPoints(hButtonSplit, HWND_DESKTOP, Cast(LPPOINT, @pNotifyMessageButtonCommanDropDown->rcButton), 2) 'Map button position from desktop to button control
           hPopup = CreatePopupMenu 'Create a popup menu
           Dim MenuInf AS MENUINFO
           MenuInf.cbSize   = SIZEOF(MENUINFO)
           MenuInf.fMask    = MIM_STYLE OR MIM_BACKGROUND
           MenuInf.dwStyle  = MNS_NOCHECK 'Remove the checked pre space
           MenuInf.hbrBack  = GetSysColorBrush(COLOR_INFOBK)
           SetMenuInfo(hPopup, @MenuInf)
           InsertMenu(hPopup, -1, MF_BYPOSITION OR MF_STRING, Popup01, "Popup 1")
           InsertMenu(hPopup, -1, MF_BYPOSITION OR MF_STRING, Popup02, "Popup 2")
           InsertMenu(hPopup, -1, MF_BYPOSITION OR MF_STRING, Popup03, "Popup 3")
           InsertMenu(hPopup, -1, MF_BYPOSITION OR MF_STRING, Popup04, "Popup 4")
           TrackPopupMenu(hPopup, TPM_LEFTALIGN OR TPM_RIGHTBUTTON, _
                          pNotifyMessageButtonCommanDropDown->rcButton.Left, _
                          pNotifyMessageButtonCommanDropDown->rcButton.Bottom , _
                          0, hWnd, BYVAL 0)
       End If
     End If

    Case WM_COMMAND
     Select Case LoWord(wParam)

        Case ButtonSplit
          If HiWord(wParam) = BN_CLICKED Then
            PostMessage(hWnd, WM_CLOSE, 0, 0)
            Exit Function
          EndIf

        Case Popup01
          If HiWord(wParam) = BN_CLICKED Then
            MessageBox(hWnd, "Popup01", AppName, MB_TOPMOST Or MB_OK)
          EndIf

        Case Popup02
          If HiWord(wParam) = BN_CLICKED Then
            MessageBox(hWnd, "Popup02", AppName, MB_TOPMOST Or MB_OK)
          EndIf

        Case Popup03
          If HiWord(wParam) = BN_CLICKED Then
            MessageBox(hWnd, "Popup03", AppName, MB_TOPMOST Or MB_OK)
          EndIf

        Case Popup04
          If HiWord(wParam) = BN_CLICKED Then
            MessageBox(hWnd, "Popup04", AppName, MB_TOPMOST Or MB_OK)
          EndIf

     End Select

   Case WM_SIZE
     If wParam <> SIZE_MINIMIZED Then
       Dim As LONG SizeX = LOWORD(LPARAM)
       Dim As LONG SizeY = HIWORD(LPARAM)
       MoveWindow(hStatic, 50, 25, SizeX - 100, SizeY - 80, TRUE)
       MoveWindow(hButtonSplit, SizeX / 2 - 50, SizeY - 40, 110, 30, TRUE)
     End IF

   Case WM_DESTROY
     DeleteObject(hFont)
     ImageList_Destroy(hImageList)
     PostQuitMessage(0)
     Exit Function

 End Select

 Function = DefWindowProc(hWnd, uMsg, wParam, lParam)

End Function
'_____________________________________________________________________________

Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
                 ByVal CmdLine As WString Ptr, ByVal CmdShow As Integer) As UINT
 Dim WinClass   As WNDCLASS
 Dim wMsg       As MSG
 Dim hWnd       As HWND
 Dim hIco       As HICON
 Dim WindowSize As SIZEL
 Dim wsAppName  As WString * 128

 wsAppName              = AppName & " - " & SizeOf(UInteger) * 8
 WindowSize.cx          = 300
 WindowSize.cy          = 150
 hIco                   = ExtractIcon(hInstance, "Shell32.dll", 80)
 WinClass.style         = CS_HREDRAW Or CS_VREDRAW
 WinClass.lpfnWndProc   = ProcPtr(WndProc)
 WinClass.cbClsExtra    = 0
 WinClass.cbWndExtra    = 0
 WinClass.hInstance     = hInstance
 WinClass.hIcon         = hIco
 WinClass.hCursor       = LoadCursor(NULL, IDC_ARROW)
 WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
 WinClass.lpszMenuName  = NULL
 WinClass.lpszClassName = @wsAppName

 If (RegisterClass(@WinClass)) Then
   hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
                         wsAppName, wsAppName, _
                         WS_OVERLAPPED OR WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or _
                         WS_VISIBLE Or WS_CAPTION Or WS_MINIMIZEBOX Or WS_SIZEBOX Or WS_SYSMENU , _
                         (GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosH
                         (GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosV
                         WindowSize.cx, WindowSize.cy, _ 'Width, height
                         NULL, NULL, hInstance, NULL)

   ShowWindow(hWnd, SW_SHOW)
   UpdateWindow(hWnd)

   While GetMessage(@wMsg, ByVal NULL, 0, 0) > 0
     If IsDialogMessage(hWnd, @wMsg) = 0 Then
       TranslateMessage(@wMsg)
       DispatchMessage(@wMsg)
     End If
   Wend

  End If
  DestroyIcon(hIco)
  Function = wMsg.message

End Function
'_____________________________________________________________________________

End WinMain(hInstance, NULL, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'

[jj2007]

Pierre, your code doesn't work.

[Pierre Bellisle]

Hi,

Depending on your IDE, be sure to have resource file
with a xml manifest file that ask for Microsoft.Windows.Common-Controls 6.0.
This is necessary for a split button.

Note that I updated the code to add ImageList_Destroy() in WM_DESTROY.

.rc resource and .xml manifest example

[jj2007]

OK, adding the manifest did the trick - thanks for your example!

[nastasa eodor]

thank you, i've noted the #%$@ trick