PB4 : rebar gadget

eddy · Post by **eddy** » Tue Nov 25, 2008 2:12 am

This is how could be a rebar gadget .

- PB commands supported (90%)
- UNICODE
- x64 (I hope...)

CustomGadget Include File : http://www.purebasic.fr/english/viewtop ... 174#268174

XIncludeFile "CreateCustomGadget.pb"

; ********************
; EXAMPLE @ eddy
; ********************

Enumeration ;Rebar Flags
   #Rebar_Vertical=$80
   #Rebar_VerticalGrip=#Rebar_Vertical | #RBS_VERTICALGRIPPER
   #Rebar_VariableThickness=#RBS_VARHEIGHT
   #Rebar_FixedOrder=#RBS_FIXEDORDER
   #Rebar_Separators=#RBS_BANDBORDERS
EndEnumeration
Structure REBARGADGET_PARAMS Extends GADGET_PARAMS
   clrBack.i
   clrFore.i
EndStructure
Procedure RebarGadget_RemoveGadgetItem(*gadget.GADGET, Position)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
      ProcedureReturn SendMessage_(*gadget\hwnd, #RB_DELETEBAND, 0, index)
   EndIf
EndProcedure
Procedure RebarGadget_ClearGadgetItemList(*gadget.GADGET)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
      While CountGadgetItems(*params\ID)
         RemoveGadgetItem(*params\ID, 0)
      Wend
   EndIf
EndProcedure
Procedure RebarGadget_CountGadgetItems(*gadget.GADGET)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
      ProcedureReturn SendMessage_(*gadget\hwnd, #RB_GETBANDCOUNT, 0, 0)
   EndIf
EndProcedure
Procedure RebarGadget_SetGadgetColor(*gadget.GADGET, ColorType, Color)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
      Select ColorType
         Case #PB_Gadget_FrontColor
            *params\clrFore=Color
            SendMessage_(*gadget\hwnd, #RB_SETTEXTCOLOR, 0, Color)
         Case #PB_Gadget_BackColor
            *params\clrBack=Color
            SendMessage_(*gadget\hwnd, #RB_SETBKCOLOR, 0, Color)
      EndSelect
   EndIf
EndProcedure
Procedure RebarGadget_GetGadgetColor(*gadget.GADGET, ColorType)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
      Select ColorType
         Case #PB_Gadget_FrontColor
            *params\clrFore=SendMessage_(*gadget\hwnd, #RB_GETTEXTCOLOR, 0, 0)
            ProcedureReturn *params\clrFore
         Case #PB_Gadget_BackColor
            *params\clrBack=SendMessage_(*gadget\hwnd, #RB_GETBKCOLOR, 0, 0)
            ProcedureReturn *params\clrBack
      EndSelect
   EndIf
EndProcedure
Procedure RebarGadget_AddGadgetItem(*gadget.GADGET, Position, Text$, ImageID=0, Flags=0)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
      Protected BarWidth=Flags
      Protected BarContainerID=ContainerGadget(#PB_Any, 0, 0, 0, 0)
      
      Protected rbBand.REBARBANDINFO
      rbBand\cbSize=SizeOf(REBARBANDINFO)
      rbBand\fMask | #RBBIM_STYLE | #RBBIM_CHILD | #RBBIM_CHILDSIZE | #RBBIM_HEADERSIZE
      rbBand\fMask | #RBBIM_TEXT | #RBBIM_COLORS | #RBBIM_IMAGE
      rbBand\fStyle=#RBBS_CHILDEDGE
      rbBand\lpText=@Text$
      rbBand\hwndChild=GadgetID(BarContainerID)
      
      ;size band
      rbBand\cyMinChild=BarWidth
      rbBand\cx=BarWidth
      rbBand\cxHeader=30
      
      ;color band
      rbBand\clrBack=*params\clrBack
      rbBand\clrFore=*params\clrFore
      SetGadgetColor(BarContainerID, #PB_Gadget_BackColor, *params\clrBack)
      
      ;add new band
      SendMessage_(*gadget\hwnd, #RB_INSERTBAND, Position, @rbBand)
      
      ProcedureReturn BarContainerID
   EndIf
EndProcedure
Procedure RebarGadget_OpenGadgetList(*gadget.GADGET, GadgetItem)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If GadgetItem=-2 : ProcedureReturn #False : EndIf
   
   If *params
      Protected BarContainerID=GadgetItem
      Protected hwndChild=GadgetID(BarContainerID)
      
      Protected rbBand.REBARBANDINFO
      rbBand\cbSize=SizeOf(REBARBANDINFO)
      rbBand\fMask | #RBBIM_STYLE | #RBBIM_CHILD | #RBBIM_CHILDSIZE | #RBBIM_HEADERSIZE
      rbBand\fMask | #RBBIM_TEXT | #RBBIM_COLORS | #RBBIM_IMAGE
      
      Protected rbIndex
      Protected rbLast=CountGadgetItems(*params\ID)-1
      For rbIndex=0 To rbLast
         SendMessage_(*gadget\hwnd, #RB_GETBANDINFO, rbIndex, @rbBand)
         If rbBand\hwndChild=hwndChild
            ProcedureReturn OpenGadgetList(BarContainerID)
            Break
         EndIf
      Next
   EndIf
EndProcedure
Procedure RebarGadget_FreeGadget(*gadget.GADGET)
   GetGadgetParams(*params, REBARGADGET_PARAMS, *gadget\hwnd)
   
   If *params
   EndIf
EndProcedure
Procedure RebarGadget_Callback(hwnd, message, wparam, lparam)
   GetGadgetParams(*params, REBARGADGET_PARAMS, hwnd)
   
   With *params
      Select message
         Case #WM_LBUTTONDOWN
            ;PB_Gadget_SendGadgetCommand(hwnd, 10000)
      EndSelect
      
      ProcedureReturn CallWindowProc_(\OldCallback, hwnd, message, wparam, lparam)
   EndWith
EndProcedure
Procedure RebarGadget(ID, x, y, Width, Height, Flags=0, BackColor=#PB_Ignore, ForeColor=#PB_Ignore)
   NewGadgetParams(*params, REBARGADGET_PARAMS)
   
   ; ********************
   ; Gadget Paramters
   ; ********************
   With *params
      ;for window creation
      \Window_Style=#WS_CHILD | #WS_VISIBLE | #WS_CLIPSIBLINGS | #RBS_VARHEIGHT | Flags
      \Window_ExStyle=#WS_EX_TOOLWINDOW
      \Window_ClassName="ReBarWindow32"
      \Window_Text=""
      
      ;for gadget customization
      \NewType=#PB_GadgetType_Unknown
      \NewCallback=@RebarGadget_Callback()
      
      ;here .... all your custom parameters
      \clrBack=GetSysColor_(#COLOR_BTNFACE)
      \clrFore=GetSysColor_(#COLOR_BTNTEXT)
      If BackColor<>#PB_Ignore : \clrBack=BackColor : EndIf
      If ForeColor<>#PB_Ignore : \clrFore=ForeColor : EndIf
   EndWith
   
   ; ********************
   ; Gadget Commands
   ; ********************
   With *params\cmds
      
      ;use custom command
      ; *GadgetCallback
      \FreeGadget=@RebarGadget_FreeGadget()
      ; *GetGadgetState
      ; *SetGadgetState
      ; *GetGadgetText
      ; *SetGadgetText
      \AddGadgetItem2=@RebarGadget_AddGadgetItem()
      \AddGadgetItem3=@RebarGadget_AddGadgetItem()
      \RemoveGadgetItem=@RebarGadget_RemoveGadgetItem()
      \ClearGadgetItemList=@RebarGadget_ClearGadgetItemList()
      \ResizeGadget=0
      \CountGadgetItems=@RebarGadget_CountGadgetItems()
      ; *GetGadgetItemState
      ; *SetGadgetItemState
      ; *GetGadgetItemText
      ; *SetGadgetItemText
      \OpenGadgetList2=@RebarGadget_OpenGadgetList()
      \GadgetX=0
      \GadgetY=0
      \GadgetWidth=0
      \GadgetHeight=0
      \HideGadget=0
      ;NOTUSED; *AddGadgetColumn
      ;NOTUSED; *RemoveGadgetColumn
      ; *GetGadgetAttribute
      ; *SetGadgetAttribute
      ; *GetGadgetItemAttribute2
      ; *SetGadgetItemAttribute2
      \SetGadgetColor=@RebarGadget_SetGadgetColor()
      \GetGadgetColor=@RebarGadget_GetGadgetColor()
      ; *SetGadgetItemColor2
      ; *GetGadgetItemColor2
      ; *SetGadgetItemData
      ; *GetGadgetItemData
   EndWith
   
   ;check requirements
   Protected icex.INITCOMMONCONTROLSEX
   icex\dwSize=SizeOf(INITCOMMONCONTROLSEX);
   icex\dwICC=#ICC_COOL_CLASSES | #ICC_BAR_CLASSES
   If Not InitCommonControlsEx_(@icex) : ProcedureReturn #False : EndIf
   
   ;create gadget
   Protected result=CreateGadget(ID, x, y, Width, Height, *params)
   If Not result : ProcedureReturn #False : EndIf
   
   ;remove theme skin if possible
   Protected UxTheme=OpenLibrary(#PB_Any, "UxTheme.dll")
   Protected *SetWindowTheme
   If UxTheme
      *SetWindowTheme=GetFunction(UxTheme, "SetWindowTheme")
      CallFunctionFast(*SetWindowTheme, GadgetID(*params\ID), "", "")
      CloseLibrary(UxTheme)
   EndIf
   
   ProcedureReturn result
EndProcedure

OpenWindow(1, 0, 0, 500, 500, "Custom RebarGadget")

Global rebarFlags
rebarFlags | #Rebar_Vertical | #Rebar_VerticalGrip
rebarFlags | #Rebar_FixedOrder | #Rebar_Separators
rebarFlags | #Rebar_VariableThickness

SetGadgetFont(#PB_Default, LoadFont(1, "verdana", 8, #PB_Font_Bold))
If RebarGadget(2, 5, 5, 0, 0, rebarFlags)
   rebarItemID1=AddGadgetItem(2, -1, "Bar1", 0, 200)
   
   rebarItemID2=AddGadgetItem(2, -1, "Bar2", 0, 185)
   ExplorerTreeGadget(20, 5, 5, 180, 200, "C:\*.txt;*.pb")
   ButtonGadget(21, 5, 210, 180, 20, "Back")
   
   rebarItemID3=AddGadgetItem(2, -1, "Bar3∞", 0, 185)
   CalendarGadget(30, 5, 5, 180, 200)
   ButtonGadget(31, 5, 210, 180, 20, "Cleanup")
   CloseGadgetList()
   
   OpenGadgetList(2, rebarItemID1)
   ButtonGadget(10, 45, 10, 100, 25, "Button")
   ListIconGadget(11, 5, 40, 180, 350, "Listview", 125)
   ComboBoxGadget(12, 5, 410, 180, 200)
   CloseGadgetList()
   
   Debug "CountGadgetItems="+Str(CountGadgetItems(2))
   Debug "GadgetWidth="+Str(GadgetWidth(2))
   Debug "GadgetHeight="+Str(GadgetHeight(2))
   Debug "IsGadget(rebarItemID3)="+Str(IsGadget(rebarItemID3))
EndIf

Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow

Mistrel · Post by **Mistrel** » Tue Nov 25, 2008 2:17 am

Line 12: A 'Structure' or 'Interface' is expected after 'Extends'.

Can you be specific about what include file is missing?

eddy · Post by **eddy** » Tue Nov 25, 2008 2:21 am

Can you be specific about what include file is missing?

link for include file (above)

Mistrel · Post by **Mistrel** » Tue Nov 25, 2008 3:17 am

Very cool. I love how the windows slide when clicked.

Fangbeast · Post by **Fangbeast** » Tue Nov 25, 2008 3:25 am

Eddie, what version of PB is this for please? I get the following error in CreateCustomGAdget.

Protected *params.GADGET_PARAMS=GetProp_(*gadget\hwnd, "GadgetInfo")

"Line 126: Structure field not found: hwnd"

dige · Post by **dige** » Tue Nov 25, 2008 9:50 am

There's no CreateGadgetList() inside, so I guess its for PB4.30 ...
And YES! its very cool!

srod · Post by **srod** » Tue Nov 25, 2008 11:26 am

Aye, very nice!!!

You'll ned to change SetWindowLong_() to SetWindowLongPtr_() for this to run properly on x64.

Fangbeast · Post by **Fangbeast** » Tue Nov 25, 2008 1:03 pm

dige wrote:There's no CreateGadgetList() inside, so I guess its for PB4.30 ...
And YES! its very cool!

Thanks Dige, I haven't touched the pb4.3 betas at all.

eddy · Post by **eddy** » Tue Nov 25, 2008 1:56 pm

Fangbeast wrote:Eddie, what version of PB is this for please? I get the following error in CreateCustomGAdget.

Protected *params.GADGET_PARAMS=GetProp_(*gadget\hwnd, "GadgetInfo")

"Line 126: Structure field not found: hwnd"

Many libraries contain already a definition of PB_GADGET structure.
But I don't know if they are updated for x64 platform.

Perhaps I have to rename this structure.