Button List

[Scott Slater]

I am trying to get a series of standard pushbuttons into a list box. I have been playing around with sub-classing, but it does not redraw the buttons properly sometimes, mainly when using the scrollbar.

I want to be able to scroll through a list of buttons, that are built on-the-fly.



This is sort of what I would want it to look like. Is sub-classing the right route for this? Does anyone have a similar control already done?

[Chris Boss]

There are two approachs:

(1) Use an ownerdraw Listbox control and subclass the listbox. You will need to subclass the control to process its mouse events to handle the button up and down drawing.

(2) Create your own contained window class. Simply create real button controls on the container control. Use the scrollbar styles to add a scrollbar to the container. Then handle your own scrolling of the buttons.

[Scott Slater]

Thanks Chris, I think the container would probably be the way for me to go since I just need regular buttons. I'll hunt around the forums and see what I can dig up.

[Scott Slater]

Ok, I got this working but by adding the buttons directly to the listbox client area, then hooking to intercept the messages. I created the listbox font to be the same height as the buttons being used, and then added each button, along with a listbox item. I then hooked the listbox callback and modified a few of the messages. Mainly the draw and vscroll (fixed the scrolling problem I was having earlier).

I did try actually doing owner drawn and drawing the buttons using DrawFrameControl API, but couldn't get anything to actually draw. So I ended up adding real buttons directly to the listbox control.

Here's the code I have so far. Is this an unorthodox practice? Will this cause problems elsewhere doing it this way?? It works as needed, but I know that doesn't make it safe..

#Compile Exe
#Dim All
 
#Include "win32api.inc"
 
Global gOldLBProc As Dword
 
Function BtnLBproc(ByVal hWnd As Long, ByVal wMsg As Long, _
                       ByVal wParam As Long, ByVal lParam As Long) As Long
  Local rc As RECT
 
  Select Case wMsg
 
      Case %WM_Command
         If wParam > 200 Then
            GetClientRect hWnd, rc
            MessageBox hWnd, "Button " & Format$(wParam - 200) & " clicked", "Button Click", 0
         End If
      Case %WM_SETFONT   ' Don't accept font messages for this control
         Exit Function
      Case %WM_DrawItem  ' Redraw entire listbox area
         GetClientRect hWnd, rc
         InvalidateRect hWnd, rc, 1
      Case %WM_VScroll   ' Redraw after scrolling
         SendMessage hWnd, %WM_DrawItem, wParam, lParam
 
  End Select
  Function = CallWindowProc(gOldLBProc, hWnd, wMsg, wParam, lParam) 'process other messages
 
End Function
 
CallBack Function MainDlgProc
 
   Select Case Cb.Msg
      Case %WM_Destroy
         SetWindowLong GetDlgItem(Cb.Hndl,100), %GWL_WNDPROC, gOldLBProc   ' unhook: restore original callback
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IdCancel
               Dialog End CbHndl
         End Select
   End Select
   
End Function
 
Function PBMain () As Long
 
   Local hDlg, hLst, hFnt, BtnID, YPos As Long
 
   Font New "Ariel", 20 To hFnt
 
   Dialog New 0, "Test Button List",,, 100, 140 To hDlg
 
   Control Add ListBox, hDlg, 100, , 10, 10, 75, 115, %WS_Child Or %LBS_NoSel Or _
      %WS_TabStop Or %LBS_DisableNoScroll Or %WS_VScroll, %WS_Ex_ClientEdge  ' use %LBS_NOSEL to prevent selecting "text area"
      
   Control Set Font hDlg, 100, hFnt                   ' set the font, so that the height is the will contain the added buttons; should use FontIndirect
   Control Handle hDlg, 100 To hLst                   ' listbox handle for hook
   gOldLBProc = GetWindowLong(hLst, %GWL_WNDPROC)     ' save original LB Callback
   SetWindowLong hLst, %GWL_WNDPROC, CodePtr(BtnLBproc) ' assign our Callback so we can intercept messages.
 
   ' add some buttons to the listbox area: parent dialog for buttons is hLst
   YPos = 2
   For BtnID = 201 To 225
      Control Add Button, hLst, BtnID, "Button " & Format$(BtnID-200), 5, YPos, 80, 28
      ListBox Add hDlg, 100, " "
      YPos += 32
   Next BtnID
 
   Control Add Button, hDlg, %IdCancel, "Close", 25, 117, 50, 20
 
   Dialog Show Modal hDlg Call MainDlgProc
 
   Font End hFnt
 
End Function

[Scott Slater]

I should probably use the LOGFONT type to set the font height properly, as well as the CreateWindow API to make the buttons, so that they are in pixels instead of DDT. Other than that is this a bad approach?

[Paul Squires]

Just to echo Chris' advice, I'd probably use ownerdraw for this situation. Borje has posted code (several times I think) for ownerdraw listboxes. His virtual listbox is ownerdraw.

I used, and most likely the other visual designer creators also used, an ownerdraw listbox for the Property List in the visual designer. You have full control over the color, font, text and embedding of controls into each line.

[Chris Boss]

Scott,

If you are using DDT, likely you could could even use DDT forms for the container controls and a child form on it.

Here is an example:

' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************
#COMPILE EXE
#REGISTER NONE
#DIM ALL          '  This is helpful to prevent errors in coding
#INCLUDE "win32api.inc"   ' Must come first before other include files !
' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
'
GLOBAL hForm1&    ' Dialog handle
GLOBAL hContainer&
'
' *************************************************************
'                    Application Entrance
' *************************************************************
'
FUNCTION PBMAIN
    LOCAL Count&
    ShowDialog_Form1 0
    DO
        DIALOG DOEVENTS TO Count&
    LOOP UNTIL Count&=0
END FUNCTION
'
' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************
'
SUB ShowDialog_Form1(BYVAL hParent&)
    LOCAL Style&, ExStyle&
    LOCAL N&
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
    ExStyle& = 0
    DIALOG NEW hParent&, "Your Dialog", 0, 0,  400,  280, Style&, ExStyle& TO hForm1&
    hContainer& = CreateScrollContainer(hForm1&,10,10,50,200, 300)
    DIALOG SET COLOR hContainer&, %BLACK, %WHITE
    FOR N&=1 TO 20
          CONTROL ADD BUTTON, hContainer&,  100+N&,  "Button"+STR$(N&), 2, ((N&-1)*15)+2, 46, 13 CALL CBF_FORM1_BUTTON
    NEXT N&
    DIALOG SHOW MODELESS hContainer& , CALL ChildForm_DLGPROC
    DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
END SUB
' *************************************************************
'              Dialog Callback Procedures
' *************************************************************
'
CALLBACK FUNCTION ChildForm_DLGPROC
    SELECT CASE CBMSG
        CASE ELSE
    END SELECT
END FUNCTION
'
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTON
    IF CBCTLMSG=%BN_CLICKED THEN
          MSGBOX "Button "+STR$(CBCTL-100)+" pressed"
    END IF
END FUNCTION
' ------------------------------------------------
'
CALLBACK FUNCTION Form1_DLGPROC
    SELECT CASE CBMSG
        CASE ELSE
    END SELECT
END FUNCTION
' ------------------------------------------------
'
' *************************************************************
'                    Scrollable Container
' *************************************************************
'
FUNCTION CreateScrollContainer(BYVAL hParent&, BYVAL X&, BYVAL Y&, BYVAL W&, BYVAL H&, BYVAL MaxH&) AS LONG
    LOCAL OffsetW&, OffsetH&, hCDlg&, hRealCDlg&
    OffsetW&=(2*GetSystemMetrics(%SM_CXEDGE))+GetSystemMetrics(%SM_CXVSCROLL)
    OffsetH&=(2*GetSystemMetrics(%SM_CXEDGE))
    DIALOG PIXELS hParent&, OffsetW&, OffsetH& TO UNITS OffsetW&, OffsetH&
    DIALOG NEW hParent&, "", X&, Y&,  W&+OffsetW&,  H&+OffsetH&, %WS_CHILD OR %WS_VSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_CONTROLPARENT TO hCDlg&
    LOCAL S AS SCROLLINFO
    S.cbSize=(SIZEOF(S))
    S.fMask=%SIF_ALL
    S.nPos=0
    S.nPage=8  ' set page skip value here
    S.nMin=0
    S.nMax=MaxH&-H&
    SetScrollInfo(hCDlg&,%SB_VERT,S, %TRUE)
    DIALOG NEW hCDlg&, "", 0,0,  W&,  MaxH&, %WS_CHILD, %WS_EX_CONTROLPARENT TO hRealCDlg&
    DIALOG SET COLOR hRealCDlg&, %BLACK, %WHITE
    ' do dialog show in calling code
    DIALOG SHOW MODELESS hCDlg& , CALL Container_DLGPROC
    DIALOG SET USER hCDlg&, 1, hRealCDlg&    ' store child handle
    FUNCTION=hRealCDlg&
END FUNCTION
'
CALLBACK FUNCTION Container_DLGPROC
     SELECT CASE CBMSG
          CASE %WM_VSCROLL
               LOCAL S AS SCROLLINFO, OldPos&, NewPos&, hChildDlg&
               S.cbSize=(SIZEOF(S))
               S.fMask=%SIF_ALL
               OldPos&=GetScrollInfo(CBHNDL,%SB_VERT,S)
               OldPos&=S.nPos
               SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINEDOWN
                         S.nPos=S.nPos+1
                    CASE %SB_LINEUP
                         S.nPos=S.nPos-1
                    CASE %SB_PAGEDOWN
                         S.nPos=S.nPos+S.nPage
                    CASE %SB_PAGEUP
                         S.nPos=S.nPos-S.nPage
                    CASE %SB_THUMBPOSITION
                         S.nPos=S.nTrackPos
                    CASE %SB_THUMBTRACK
                         S.nPos=S.nTrackPos
                    CASE ELSE
               END SELECT
               IF S.nPos<S.nMin THEN S.nPos=S.nMin
               IF S.nPos>S.nMax THEN S.nPos=S.nMax
               IF S.nPos<>OldPos& THEN
                    S.cbSize=(SIZEOF(S))
                    S.fMask=%SIF_POS
                    S.nPos=S.nPos
                    NewPos&=SetScrollInfo(CBHNDL,%SB_VERT,S, %TRUE)
                    NewPos&=-NewPos&
                    DIALOG GET USER CBHNDL, 1 TO hChildDlg&
                    DIALOG SET LOC hChildDlg&, 0, NewPos&
               END IF
        CASE ELSE
    END SELECT
END FUNCTION

[Scott Slater]

The parent form will be a DDT form, so I'll give your code a try Chris. Thanks for the help!

[Gösta H. Lovgren-2]

Really neat idea Scott. JFF I added "Living Color" (thx to LJ - see note in code). Here it is in color with Chris's code:

'http://www.powerbasic.com/support/pbforums/showthread.php?t=40672
'Chris Boss
' ***************************************************************
'   This code can be used Royalty Free and Freely Distributed !
' ***************************************************************
#Compile Exe
#Register None
#Dim All          '  This is helpful to prevent errors in coding
#Debug Display On '<<<<<<<<<<<<<<< Remember to turn off for production code
#Include "win32api.inc"   ' Must come first before other include files !
 
'
' *******************************************************
'
 'these next included files needed for button colors can be found here: 
 'http://www.powerbasic.com/support/pbforums/showthread.php?t=38904
#Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
'
Function  Btn_Set_Face_Color(ddlg As Dword, Id As Long, Btn_Color As Long) As Long
  ButtonPlus  ddlg, Id, %BP_FACE_BLEND, 255 'true color
   ButtonPlus dDlg, Id, %BP_FACE_COLOR, Btn_Color ' &H008FDF8F 
End Function 
'
Function  Btn_Set_Text_Color(ddlg As Dword, Id As Long, Btn_Color As Long) As Long
   ButtonPlus dDlg, Id, %BP_Text_COLOR, Btn_Color ' &H008FDF8F 
End Function 
'
' *******************************************************
'


' *************************************************************
'               Application Globals Variables (#2)
' *************************************************************
'
Global hForm1&    ' Dialog handle
Global hContainer&
 
'
' *************************************************************
'                    Application Entrance
' *************************************************************
'
Function PBMain
    Local Count&
    ShowDialog_Form1 0
    Do
        Dialog DoEvents To Count&
    Loop Until Count&=0
End Function
'
' *************************************************************
'                    Application Dialogs (#3)
' *************************************************************
'
Sub ShowDialog_Form1(ByVal hParent&)
    Local Style&, ExStyle&
    Local N&
    Local n2, Btn_Face_Color, Btn_Text_Color As Long
    Style& = %WS_POPUP Or %DS_MODALFRAME Or %WS_CAPTION Or %WS_MINIMIZEBOX Or %WS_SYSMENU Or %DS_CENTER
    ExStyle& = 0
    Dialog New hParent&, "Your Dialog", 0, 0,  400,  280, Style&, ExStyle& To hForm1&
    hContainer& = CreateScrollContainer(hForm1&,10,10,50,200, 300)
    Dialog Set Color hContainer&, %Black, %White
    For N&=1 To 20
          Control Add Button, hContainer&,  100+N&,  "Button"+Str$(N&), 2, ((N&-1)*15)+2, 46, 13 Call CBF_FORM1_BUTTON
'
' *******************************************************
'
      Incr n2
      If n2 > 3 Then n2 = 1
      Select Case n2      
        Case 1
          Btn_Face_Color = %Red
          Btn_Text_Color = %White
        Case 2
          Btn_Face_Color = %White
          Btn_Text_Color = %Blue
        Case 3
          Btn_Face_Color = %Blue
          Btn_Text_Color = %White
      End Select  
'          Btn_Face_Color = %Red
'          Btn_Text_Color = %White
         Btn_Set_Face_Color(hContainer&,  100+N&, Btn_Face_Color)
         Btn_Set_Text_Color(hContainer&,  100+N&, Btn_Text_Color)
'
' *******************************************************
'
          
    Next N&
    Dialog Show Modeless hContainer& , Call ChildForm_DLGPROC
    Dialog Show Modeless hForm1& , Call Form1_DLGPROC
End Sub
' *************************************************************
'              Dialog Callback Procedures
' *************************************************************
'
CallBack Function ChildForm_DLGPROC
    Select Case CbMsg
        Case Else
    End Select
End Function
'
' ------------------------------------------------
CallBack Function CBF_FORM1_BUTTON
    If CbCtlMsg=%BN_CLICKED Then
'          MsgBox "Button "+Str$(CbCtl-100)+" pressed"
      Btn_Set_Face_Color(CB.Hndl,  CB.Ctl, %Black + 1)
      Btn_Set_Text_Color(CB.Hndl,  CB.Ctl, %Yellow)
      Control ReDraw CB.Hndl,  CB.Ctl
    End If
End Function
' ------------------------------------------------
'
CallBack Function Form1_DLGPROC
    Select Case CbMsg
        Case Else
    End Select
End Function
' ------------------------------------------------
'
' *************************************************************
'                    Scrollable Container
' *************************************************************
'
Function CreateScrollContainer(ByVal hParent&, ByVal X&, ByVal Y&, ByVal W&, ByVal H&, ByVal MaxH&) As Long
    Local OffsetW&, OffsetH&, hCDlg&, hRealCDlg&
    OffsetW&=(2*GetSystemMetrics(%SM_CXEDGE))+GetSystemMetrics(%SM_CXVSCROLL)
    OffsetH&=(2*GetSystemMetrics(%SM_CXEDGE))
    Dialog Pixels hParent&, OffsetW&, OffsetH& To Units OffsetW&, OffsetH&
    Dialog New hParent&, "", X&, Y&,  W&+OffsetW&,  H&+OffsetH&, %WS_CHILD Or %WS_VSCROLL, %WS_EX_CLIENTEDGE Or %WS_EX_CONTROLPARENT To hCDlg&
    Local S As SCROLLINFO
    S.cbSize=(SizeOf(S))
    S.fMask=%SIF_ALL
    S.nPos=0
    S.nPage=8  ' set page skip value here
    S.nMin=0
    S.nMax=MaxH&-H&
    SetScrollInfo(hCDlg&,%SB_VERT,S, %TRUE)
    Dialog New hCDlg&, "", 0,0,  W&,  MaxH&, %WS_CHILD, %WS_EX_CONTROLPARENT To hRealCDlg&
    Dialog Set Color hRealCDlg&, %Black, %White
    ' do dialog show in calling code
    Dialog Show Modeless hCDlg& , Call Container_DLGPROC
    Dialog Set User hCDlg&, 1, hRealCDlg&    ' store child handle
    Function=hRealCDlg&
End Function
'
CallBack Function Container_DLGPROC
     Select Case CbMsg
          Case %WM_VSCROLL
               Local S As SCROLLINFO, OldPos&, NewPos&, hChildDlg&
               S.cbSize=(SizeOf(S))
               S.fMask=%SIF_ALL
               OldPos&=GetScrollInfo(CbHndl,%SB_VERT,S)
               OldPos&=S.nPos
               Select Case LoWrd(CbWParam)
                    Case %SB_LINEDOWN
                         S.nPos=S.nPos+1
                    Case %SB_LINEUP
                         S.nPos=S.nPos-1
                    Case %SB_PAGEDOWN
                         S.nPos=S.nPos+S.nPage
                    Case %SB_PAGEUP
                         S.nPos=S.nPos-S.nPage
                    Case %SB_THUMBPOSITION
                         S.nPos=S.nTrackPos
                    Case %SB_THUMBTRACK
                         S.nPos=S.nTrackPos
                    Case Else
               End Select
               If S.nPos<S.nMin Then S.nPos=S.nMin
               If S.nPos>S.nMax Then S.nPos=S.nMax
               If S.nPos<>OldPos& Then
                    S.cbSize=(SizeOf(S))
                    S.fMask=%SIF_POS
                    S.nPos=S.nPos
                    NewPos&=SetScrollInfo(CbHndl,%SB_VERT,S, %TRUE)
                    NewPos&=-NewPos&
                    Dialog Get User CbHndl, 1 To hChildDlg&
                    Dialog Set Loc hChildDlg&, 0, NewPos&
               End If
        Case Else
    End Select
End Function

===========================
Applause waits on success.
Ben Franklin
===========================