PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

DropdownButtonGadget - canvas button with popup menu

https://www.purebasic.fr/english/viewtopic.php?t=60564

Page 1 of 1

DropdownButtonGadget - canvas button with popup menu

Posted: Fri Sep 19, 2014 1:48 am
by kenmo
Here's another custom gadget built on the CanvasGadget. Free to use, improve, expand.

It's a simple one, I call it a "DropdownButton" because I don't have a better name!

The DropdownButtonGadget consists of a main clickable text area (which posts a #PB_Event_Menu) and also a built-in popup menu for additional Menu actions.

The look and behavior are currently based on Internet Explorer on Windows 7... for example, in the View Downloads list.

The includefile (with a runnable demo) is below. It is only tested on Windows + PB 5.30 so far!

<image>

Code: Select all

; +----------------------+-------+
; | DropdownButtonGadget | kenmo |
; +----------------------+-------+
; | 2014.09.18 . Creation (PureBasic 5.30)
; | 2015.05.10 . Use DrawText API on Windows for better text (PB 5.42)

;-
;- Compatibility - PRIVATE

CompilerIf (#PB_Compiler_IsMainFile)
  EnableExplicit
CompilerEndIf

CompilerIf (#PB_Compiler_Version < 530)
  Macro ClipOutput(x, y, Width, Height)
    ;
  EndMacro
  Macro UnclipOutput()
    ;
  EndMacro
CompilerEndIf

;-
;- Constants - PRIVATE

#_DropdownButton_None = 0
#_DropdownButton_Item = 1
#_DropdownButton_Drop = 2

#_DropdownButton_Dropping = $010000

;-
;- Structures - PRIVATE

Structure _DROPDOWNBUTTONITEM
  Text.s
  MenuID.i
  ImageID.i
EndStructure

Structure _DROPDOWNBUTTON
  Canvas.i
  Flags.i
  Window.i
  Popup.i
  ;
  ArrowImg.i
  ;
  Width.i
  Height.i
  DropWidthReal.i
  DropWidth.i
  ;
  FontID.i
  ColorFont.i
  ;
  ColorIdleBorder.i
  ColorIdleTop.i
  ColorIdleBottom.i
  ;
  ColorHoverBorder.i
  ColorHoverTop.i
  ColorHoverBottom.i
  ;
  ColorPressBorder.i
  ColorPressTop.i
  ColorPressBottom.i
  ;
  HoverItem.i
  PressItem.i
  ;
  List Item._DROPDOWNBUTTONITEM()
EndStructure

;-
;- Globals - PRIVATE

Global _DropdownButtonLastPopup.i = #Null

;-
;- Macros - PUBLIC

Macro AddDropdownButtonGadgetBar(DBG)
  AddDropdownButtonGadgetItem((DBG), "-")
EndMacro

;-
;- Procedures - PRIVATE

Procedure.i _DropdownButtonArrowImage(Color.i)
  Protected Size.i = 5
  Protected Img.i = CreateImage(#PB_Any, Size*2-1, Size, 32, Color)
  If (StartDrawing(ImageOutput(Img)))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Color & $00FFFFFF
    Box(0, 0, OutputWidth(), OutputHeight(), Color)
    Protected i.i
    For i = 0 To Size - 1
      Plot(Size - 1 - i, Size - i - 1, Color | $4D000000)
      Plot(Size - 1 + i, Size - i - 1, Color | $4D000000)
      If (i < Size - 1)
        Box(Size - 1 - i, 0, 1, Size - 1 - i, Color | $FF000000)
        Box(Size - 1 + i, 0, 1, Size - 1 - i, Color | $FF000000)
      EndIf
    Next i
    StopDrawing()
  EndIf
  ProcedureReturn (Img)
EndProcedure

Procedure _DropdownButtonGadgetRedraw(*DBG._DROPDOWNBUTTON)
  If (*DBG And *DBG\Canvas And IsGadget(*DBG\Canvas))
    With *DBG
      If (Not (*DBG\Flags & #_DropdownButton_Dropping))
        Protected DrawingID.i = StartDrawing(CanvasOutput(\Canvas))
        If (DrawingID)
          Protected TopColor.i, BottomColor.i, BorderColor.i
          ;
          If ((\PressItem = \HoverItem) And (\PressItem = #_DropdownButton_Item))
            TopColor    = \ColorPressTop
            BottomColor = \ColorPressBottom
            BorderColor = \ColorPressBorder
          ElseIf (\HoverItem)
            TopColor    = \ColorHoverTop
            BottomColor = \ColorHoverBottom
            BorderColor = \ColorHoverBorder
          Else
            TopColor    = \ColorIdleTop
            BottomColor = \ColorIdleBottom
            BorderColor = \ColorIdleBorder
          EndIf
          DrawingMode(#PB_2DDrawing_Gradient)
          BackColor(TopColor)
          FrontColor(BottomColor)
          LinearGradient(0, 0, 0, \Height)
          Box(0, 0, \Width - \DropWidthReal, \Height)
          DrawingMode(#PB_2DDrawing_Default)
          Box(0, 0, 1, \Height, BorderColor)
          Box(0, 0, \Width - \DropWidthReal, 1, BorderColor)
          Box(0, \Height - 1, \Width - \DropWidthReal, 1, BorderColor)
          ;
          If ((\PressItem = \HoverItem) And (\PressItem))
            TopColor    = \ColorPressTop
            BottomColor = \ColorPressBottom
            BorderColor = \ColorPressBorder
          ElseIf (\HoverItem)
            TopColor    = \ColorHoverTop
            BottomColor = \ColorHoverBottom
            BorderColor = \ColorHoverBorder
          Else
            TopColor    = \ColorIdleTop
            BottomColor = \ColorIdleBottom
            BorderColor = \ColorIdleBorder
          EndIf
          DrawingMode(#PB_2DDrawing_Gradient)
          BackColor(TopColor)
          FrontColor(BottomColor)
          LinearGradient(0, 0, 0, \Height)
          Box(\Width - \DropWidthReal, 0, \DropWidthReal, \Height)
          DrawingMode(#PB_2DDrawing_Default)
          Box(\Width - 1, 0, 1, \Height, BorderColor)
          Box(\Width - \DropWidthReal - 1, 0, 1, \Height, BorderColor)
          Box(\Width - \DropWidthReal - 1, 0, \DropWidthReal, 1, BorderColor)
          Box(\Width - \DropWidthReal - 1, \Height - 1, \DropWidthReal, 1, BorderColor)
          ;
          If (ListSize(\Item()))
            FirstElement(\Item())
            DrawingFont(\FontID)
            DrawingMode(#PB_2DDrawing_Transparent)
            ClipOutput(1, 1, \Width - \DropWidthReal - 2, \Height - 2)
            CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#True))
              SelectObject_(DrawingID, \FontID)
              SetTextColor_(DrawingID, \ColorFont)
              SetBkMode_(DrawingID, #TRANSPARENT)
              Protected Rect.RECT
              Rect\left   = 1
              Rect\top    = 1
              Rect\right  = \Width - \DropWidthReal - 1
              Rect\bottom = \Height - 1
              DrawText_(DrawingID, @\Item()\Text, -1, @Rect,
                  #DT_SINGLELINE | #DT_NOPREFIX | #DT_CENTER | #DT_VCENTER)
            CompilerElse
              DrawText((\Width - \DropWidthReal)/2 + 1 - TextWidth(\Item()\Text)/2, \Height/2 - TextHeight(\Item()\Text)/2, \Item()\Text, \ColorFont)
            CompilerEndIf
            UnclipOutput()
            ;
            If (ListSize(\Item()) >= 2)
              DrawingMode(#PB_2DDrawing_AlphaBlend)
              DrawImage(ImageID(\ArrowImg), \Width - \DropWidthReal/2 - ImageWidth(\ArrowImg)/2 - 1, \Height/2 - ImageHeight(\ArrowImg)/2)
            EndIf
          EndIf
          ;
          StopDrawing()
        EndIf
      EndIf
    EndWith
  EndIf
EndProcedure

Procedure _DropdownButtonGadgetUpdate(*DBG._DROPDOWNBUTTON, Redraw.i = #False)
  If (*DBG And *DBG\Canvas And IsGadget(*DBG\Canvas))
    With *DBG
      \Width  = GadgetWidth(\Canvas)
      \Height = GadgetHeight(\Canvas)
      If (ListSize(\Item()) >= 2)
        \DropWidthReal = \DropWidth
      Else
        \DropWidthReal = 0
      EndIf
      If (Redraw)
        _DropdownButtonGadgetRedraw(*DBG)
      EndIf
    EndWith
  EndIf
EndProcedure

Procedure _DropdownButtonCallback()
  Protected *DBG._DROPDOWNBUTTON
  *DBG = GetGadgetData(EventGadget())
  If (*DBG And *DBG\Canvas And IsGadget(*DBG\Canvas))
    With *DBG
      Protected PreHover.i = \HoverItem
      Protected PrePress.i = \PressItem
      
      Select (EventType())
      
        Case #PB_EventType_MouseEnter, #PB_EventType_MouseMove, #PB_EventType_LeftButtonDown
          Protected x.i = GetGadgetAttribute(\Canvas, #PB_Canvas_MouseX)
          Protected y.i = GetGadgetAttribute(\Canvas, #PB_Canvas_MouseY)
          If ((x >= 0) And (x < \Width) And (y >= 0) And (y < \Height))
            If (x < \Width - \DropWidthReal)
              \HoverItem = #_DropdownButton_Item
            Else
              \HoverItem = #_DropdownButton_Drop
            EndIf
          Else
            \HoverItem = #_DropdownButton_None
          EndIf
          If (EventType() = #PB_EventType_LeftButtonDown)
            ;If (ListSize(\Item()))
              \PressItem = \HoverItem
            ;EndIf
          EndIf
        Case #PB_EventType_MouseLeave
          \HoverItem = #_DropdownButton_None
        
        Case #PB_EventType_LeftButtonUp
          If (\PressItem = \HoverItem)
            Select (\PressItem)
              Case #_DropdownButton_Item
                If (ListSize(\Item()))
                  _DropdownButtonLastPopup = *DBG
                  FirstElement(\Item())
                  PostEvent(#PB_Event_Menu, \Window, \Item()\MenuID)
                EndIf
                \PressItem = #_DropdownButton_None
              Case #_DropdownButton_Drop
                If (ListSize(\Item()))
                  If (Not \Popup)
                    \Popup = CreatePopupMenu(#PB_Any)
                    If (\Popup)
                      ForEach (\Item())
                        If (\Item()\Text = "-")
                          MenuBar()
                        Else
                          MenuItem(\Item()\MenuID, \Item()\Text, \Item()\ImageID)
                        EndIf
                      Next
                    EndIf
                  EndIf
                  If (\Popup)
                    \PressItem = #_DropdownButton_None
                    _DropdownButtonGadgetRedraw(*DBG)
                    *DBG\Flags | #_DropdownButton_Dropping
                    ;Debug "Pre-Drop"
                    _DropdownButtonLastPopup = *DBG
                    DisplayPopupMenu(\Popup, WindowID(\Window), GadgetX(\Canvas, #PB_Gadget_ScreenCoordinate), GadgetY(\Canvas, #PB_Gadget_ScreenCoordinate) + \Height)
                    ;Debug "Post-Drop"
                    *DBG\Flags & ~#_DropdownButton_Dropping
                  Else
                    _DropdownButtonLastPopup = #Null
                  EndIf
                EndIf
            EndSelect
          Else
            \PressItem = #_DropdownButton_None
          EndIf
          
          
      EndSelect
      If ((\HoverItem <> PreHover) Or (\PressItem <> PrePress))
        _DropdownButtonGadgetRedraw(*DBG)
      EndIf
    EndWith
  EndIf
EndProcedure

;-
;- Procedures - PUBLIC

Procedure.i EventDropdownButton()
  ProcedureReturn (_DropdownButtonLastPopup)
EndProcedure

Procedure.i FreeDropdownButtonGadget(*DBG._DROPDOWNBUTTON)
  If (*DBG)
    If (*DBG\Canvas And IsGadget(*DBG\Canvas))
      SetGadgetData(*DBG\Canvas, #Null)
      UnbindGadgetEvent(*DBG\Canvas, @_DropdownButtonCallback())
      FreeGadget(*DBG\Canvas)
    EndIf
    If (*DBG\Popup)
      FreeMenu(*DBG\Popup)
    EndIf
    ClearList(*DBG\Item())
    ClearStructure(*DBG, _DROPDOWNBUTTON)
    FreeMemory(*DBG)
  EndIf
  ProcedureReturn (#Null)
EndProcedure

Procedure.i DropdownButtonGadget(x.i, y.i, Width.i = 85, Height.i = 25, Window.i = 0)
  Protected *DBG._DROPDOWNBUTTON = #Null
  If (IsWindow(Window))
    Protected Canvas.i = CanvasGadget(#PB_Any, x, y, Width, Height)
    If (Canvas)
      *DBG = AllocateMemory(SizeOf(_DROPDOWNBUTTON))
      If (*DBG)
        InitializeStructure(*DBG, _DROPDOWNBUTTON)
        With *DBG
          \Canvas    = Canvas
          \ColorFont = RGB(0, 0, 0)
          \DropWidth = 18
          \Window    = Window
          ;
          CompilerSelect (#PB_Compiler_OS)
            CompilerCase (#PB_OS_Windows)
              \FontID = GetGadgetFont(#PB_Default)
            CompilerCase (#PB_OS_MacOS)
              Protected Temp.i = TextGadget(#PB_Any, 0, 0, 25, 25, " ")
              If (Temp)
                \FontID = GetGadgetFont(Temp)
                FreeGadget(Temp)
              EndIf
            CompilerDefault
              CompilerError "Not tested on this OS yet"
          CompilerEndSelect
          ;
          ; Default colors (based on Windows 7, Internet Explorer)
          \ColorIdleBorder  = RGB(172, 172, 172)
          \ColorIdleTop     = RGB(240, 240, 240)
          \ColorIdleBottom  = RGB(229, 229, 229)
          \ColorHoverBorder = RGB(126, 180, 234)
          \ColorHoverTop    = RGB(236, 244, 252)
          \ColorHoverBottom = RGB(220, 236, 252)
          \ColorPressBorder = RGB(86, 157, 229)
          \ColorPressTop    = RGB(218, 236, 252)
          \ColorPressBottom = RGB(196, 224, 252)
          ;
          \ArrowImg = _DropdownButtonArrowImage(\ColorFont)
        EndWith
        ;
        SetGadgetData(Canvas, *DBG)
        _DropdownButtonGadgetUpdate(*DBG, #True)
        BindGadgetEvent(Canvas, @_DropdownButtonCallback())
      Else
        FreeGadget(Canvas)
      EndIf
    EndIf
  EndIf
  ProcedureReturn (*DBG)
EndProcedure

Procedure.i AddDropdownButtonGadgetItem(*DBG._DROPDOWNBUTTON, Text.s, ID.i = 0, ImageID.i = #Null)
  Protected Result.i = -1
  If (*DBG And *DBG\Canvas And IsGadget(*DBG\Canvas))
    With *DBG
      LastElement(\Item())
      AddElement(\Item())
      \Item()\MenuID  = ID
      \Item()\Text    = Text
      \Item()\ImageID = ImageID
      _DropdownButtonGadgetUpdate(*DBG, #True)
      Result = ListSize(\Item()) - 1
    EndWith
  EndIf
  ProcedureReturn (Result)
EndProcedure

Procedure.i ClearDropdownButtonGadgetItems(*DBG._DROPDOWNBUTTON)
  Protected Result.i = -1
  If (*DBG And *DBG\Canvas And IsGadget(*DBG\Canvas))
    With *DBG
      ClearList(\Item())
      _DropdownButtonGadgetUpdate(*DBG, #True)
      Result = 0
    EndWith
  EndIf
  ProcedureReturn (Result)
EndProcedure

;-
;- Demo Program - PUBLIC

CompilerIf (#PB_Compiler_IsMainFile)

DisableExplicit
OpenWindow(0, 0, 0, 325, 65, "DropdownButtonGadget Demo", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
SetWindowColor(0, $FFFFFF)

Dim DBG.i(2)
*DBG = DropdownButtonGadget(20, 20)
  AddDropdownButtonGadgetItem(*DBG, "Open", 1)
  DBG(0) = *DBG
*DBG = DropdownButtonGadget(120, 20)
  AddDropdownButtonGadgetItem(*DBG, "Open", 1)
  AddDropdownButtonGadgetItem(*DBG, "Save", 2)
  AddDropdownButtonGadgetBar(*DBG)
  AddDropdownButtonGadgetItem(*DBG, "Clear Gadget", 5)
  DBG(1) = *DBG
*DBG = DropdownButtonGadget(220, 20)
  AddDropdownButtonGadgetItem(*DBG, "Open", 1)
  AddDropdownButtonGadgetItem(*DBG, "Save", 2)
  AddDropdownButtonGadgetItem(*DBG, "Save as", 3)
  AddDropdownButtonGadgetBar(*DBG)
  AddDropdownButtonGadgetItem(*DBG, "Quit Demo", 4)
  DBG(2) = *DBG
  ;FreeDropdownButtonGadget(*DBG)

Repeat
  Event = WaitWindowEvent()
  If (Event = #PB_Event_Menu)
    Select (EventMenu())
      Case 1
        OpenFileRequester("Open", GetCurrentDirectory(), "All Files|*.*", 0)
      Case 2
        MessageRequester("Saved", "You clicked Save." + #LF$ + #LF$ + "DBG: $" + Hex(EventDropdownButton(), #PB_Long))
      Case 3
        SaveFileRequester("Save As", GetCurrentDirectory(), "All Files|*.*", 0)
      Case 4
        Event = #PB_Event_CloseWindow
      Case 5
        ClearDropdownButtonGadgetItems(EventDropdownButton())
    EndSelect
  EndIf
Until Event = #PB_Event_CloseWindow

FreeDropdownButtonGadget(DBG(0))
FreeDropdownButtonGadget(DBG(1))
FreeDropdownButtonGadget(DBG(2))

CompilerEndIf

;-
[/size]

Re: DropdownButtonGadget - canvas button with popup menu

Posted: Fri Sep 19, 2014 6:47 am
by davido
Looks great!

Thank you for sharing. :D

Re: DropdownButtonGadget - canvas button with popup menu

Posted: Fri Sep 19, 2014 9:00 am
by davido
@kenmo,
Looks good on a MacBook Pro.

Also tried it on Linux Mint 16 with PureBasic 5.30, using the Default font.
Looks fine, too. The Header text is larger and centred. The text on the canvas is a mite smaller.

The differences are only obvious when viewed side-by-side, something that would be unlikely to occur in the wild.

They all look great. Thank you.

Re: DropdownButtonGadget - canvas button with popup menu

Posted: Sat Sep 20, 2014 1:37 am
by kenmo
Glad to hear it works on Mac + Linux too. I would like to test it thoroughly on those.

On Windows, I haven't figured out how to make the fonts match exactly. DrawText() seems blurrier / more tightly kerned than the system GUI font... I'm open to ideas!

<image>

Re: DropdownButtonGadget - canvas button with popup menu

Posted: Sat Sep 20, 2014 5:12 am
by idle
Looks good thanks for sharing

Re: DropdownButtonGadget - canvas button with popup menu

Posted: Sun Sep 21, 2014 10:54 pm
by Andre
Nice :D

Runs well on MacOS 10.5.8

Re: DropdownButtonGadget - canvas button with popup menu

Posted: Wed Sep 24, 2014 1:11 pm
by Tenaja
Yes, nice; thanks for sharing.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited