Toolbar mit #TBSTYLE_CHECKGROUP wie Optiongadget m.Icon+Text
Verfasst: 15.01.2008 22:56
Edit: siehe Hinweis unten
Diese Toolbar verhält sich wie mehrere Optiongadgets. Es bleibt immer ein Button eingerastet. Man kann Gruppen bilden mit dem ToolBarSeparator(). Mit/ohne Text. Mit/ohne Icon. Auch BMP Images können benutzt werden, wenn der Hintergrund einfarbig ist. Die Position kann gewählt werden. usw.
Die gewählten Images sind zumindest bei mir Teil der PB Examples. Wer 2 verschiedene Toolbars haben will muß logischerweise die Prozedur ToolBar_1 duplizieren/anpassen ebenso die MenuIDs und ImageIDs
Hinweis: Dies ist kein fertiger Code zum einfachen übernehmen sondern ein Beispiel !!! Darum auch kein Protected und ähnlichen Krams.
Das Verschieben des Gadgets habe ich aus einem Beispielcode von Hroudtwolf, muß man erst mal darauf kommen.
Nur noch eine Frage: Kann man das Feld img.imagedaten(5) als Parameter an die Prozedur übergeben. Ich habs wieder mal nicht geschafft. Allmählich glaube ich es geht nicht. ODER ?
Das ganze kann man natürlich auch optimieren und auf die Prozeduren teilweise verzichten. Aber so ist es übersichtlicher.
Hab vergessen zu erwähnen, dies funktioniert nur mit XP-Skin 100 %,
ohne XP-Skin funktioniert der Wert -2 nicht, siehe letzten ToolbarButton, es muß eine ImageID angegeben werden
und die Breite für mit Image aber ohne Text muß vergrößert werden, siehe 5. Button.(addbreite = ... + 4)
Diese Toolbar verhält sich wie mehrere Optiongadgets. Es bleibt immer ein Button eingerastet. Man kann Gruppen bilden mit dem ToolBarSeparator(). Mit/ohne Text. Mit/ohne Icon. Auch BMP Images können benutzt werden, wenn der Hintergrund einfarbig ist. Die Position kann gewählt werden. usw.
Die gewählten Images sind zumindest bei mir Teil der PB Examples. Wer 2 verschiedene Toolbars haben will muß logischerweise die Prozedur ToolBar_1 duplizieren/anpassen ebenso die MenuIDs und ImageIDs
Hinweis: Dies ist kein fertiger Code zum einfachen übernehmen sondern ein Beispiel !!! Darum auch kein Protected und ähnlichen Krams.
Das Verschieben des Gadgets habe ich aus einem Beispielcode von Hroudtwolf, muß man erst mal darauf kommen.
Nur noch eine Frage: Kann man das Feld img.imagedaten(5) als Parameter an die Prozedur übergeben. Ich habs wieder mal nicht geschafft. Allmählich glaube ich es geht nicht. ODER ?
Code: Alles auswählen
Declare Toolbar_1(hwnd,sp,ze,font=0)
Declare ToolBar_SetButtonInfo(tbid,menuid,font,iconid,txt$)
Declare ToolBar_SetPosition(tbid,sp,ze)
Declare makeImageID(*img,datname$)
Declare.l TextBreite(font,txt$)
Dim font_id(4)
font_id(1) = FontID(LoadFont(#PB_Any, "arial", 10))
font_id(2) = FontID(LoadFont(#PB_Any, "arial", 12))
font_id(3) = FontID(LoadFont(#PB_Any, "arial", 14))
font_id(4) = FontID(LoadFont(#PB_Any, "arial", 18))
WindowBreite = 700
WindowHoehe = 500
#conflag= #PB_Container_Single
#LR_sp = 10
conP_hh = 32
conP_ze = WindowHoehe-conP_hh-10
cont_br = WindowBreite-#LR_sp-#LR_sp
#tbimgbr=16:#tbimghh=16
Enumeration
#conP_nr
#toolbar
#menuid1=10
#menuid2
#menuid3
#menuid4
#menuid5
#menuid6
#menuid7
#menuid8
#menuid9
EndEnumeration
;Bilder laden
pfad1$=#PB_Compiler_Home+"Examples\Sources\Data\"
pfad2$=#PB_Compiler_Home+"Examples\Sources - Advanced\MoviePlayer\Icons\"
Structure imagedaten
imgID.l
newID.l
farbe.l
EndStructure
Dim img.imagedaten(5)
;hier wird eine bmpGrafik geladen, die transparent in der toolbar ist
;funktioniert aber nur bei einfarbigen Hintergrund, siehe Unterschied Button Toolbar
MakeImageID(@img(0),pfad1$+"drive2.bmp")
MakeImageID(@img(1),pfad1$+"CdPlayer.ico")
MakeImageID(@img(2),pfad1$+"file.bmp")
MakeImageID(@img(3),pfad2$+"Pause.ico")
MakeImageID(@img(4),pfad2$+"Play.ico")
MakeImageID(@img(5),pfad2$+"MoviePlayer.ico")
;==============================================
If OpenWindow(0, 0,0, WindowBreite, WindowHoehe, "",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
;nur zum Vergleich
ButtonImageGadget(#PB_Any,0,0,32,32,img(0)\imgID)
ButtonImageGadget(#PB_Any,40,0,32,32,img(1)\imgID)
ButtonImageGadget(#PB_Any,80,0,32,32,img(2)\imgID)
ButtonImageGadget(#PB_Any,120,0,32,32,img(3)\imgID)
ButtonImageGadget(#PB_Any,160,0,32,32,img(4)\imgID)
ButtonImageGadget(#PB_Any,200,0,32,32,img(5)\imgID)
sp=-1:ze=200 ;sp=0 links, sp=-1 mittig, sp=-2 rechts
Toolbar_1(WindowID(0), sp,ze, font_id(2))
;Progcontainer
conP_id=ContainerGadget(#conP_nr,#LR_sp, conP_ze, cont_br, conP_hh,#conflag)
;oder gehört zum Container
;sp=-1:ze=2 ;sp=0 links, sp=-1 mittig, sp=-2 rechts
;Toolbar_1(conP_ID, sp,ze, font_id(2))
CloseGadgetList()
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_Gadget Or EventID = #PB_Event_Menu
welcherButton=EventGadget()
Select welcherButton
Case #menuid1 To #menuid6
For j=#menuid1 To #menuid6
If GetToolBarButtonState(1, j)
;Debug "Button "+Str(j)
EndIf
Next
;Debug "---"
EndSelect
ElseIf EventID = #WM_LBUTTONDOWN
If EventWindow()=#conP_nr
SendMessage_(conP_id,#WM_NCLBUTTONDOWN, #HTCAPTION,0) ;zum verschieben des Containers!
EndIf
EndIf
Until EventID = #PB_Event_CloseWindow
EndIf
End
Procedure Toolbar_1(hwnd,sp,ze,font=0)
Shared img()
tbid = CreateToolBar(#toolbar, hwnd)
;ToolBarSeparator()
ToolBarStandardButton(#menuid1, 0)
ToolBarStandardButton(#menuid2, 0)
ToolBarStandardButton(#menuid3, 0)
ToolBarSeparator() ;teilt CheckGroup
ToolBarStandardButton(#menuid4, 0)
ToolBarStandardButton(#menuid5, 0)
ToolBarStandardButton(#menuid6, 0)
;normale Buttons dazu wer es mag
;ToolBarSeparator()
;ToolBarStandardButton(#menuid7,-1)
;ToolBarStandardButton(#menuid8, 0)
;ToolBarStandardButton(#menuid9, 1)
;font wird gebraucht für Buttonbreite
If font = 0
font=GetGadgetFont(#PB_Default )
EndIf
SendMessage_(tbid, #WM_SETFONT, font,#True)
;Imagelist erstellen für normal und Hotspot
flag = #ILC_MASK | #ILC_COLOR24 ;COLOR24 muß sein
list1 = ImageList_Create_(#tbimgbr,#tbimghh,flag,0,0)
ImageList_AddMasked_(list1,img(0)\newID,img(0)\farbe)
ImageList_AddMasked_(list1,img(1)\newID,img(1)\farbe)
ImageList_AddMasked_(list1,img(2)\newID,img(2)\farbe)
ImageList_AddMasked_(list1,img(3)\newID,img(3)\farbe)
ImageList_AddMasked_(list1,img(4)\newID,img(4)\farbe)
list2 = ImageList_Create_(#tbimgbr,#tbimghh,flag,0,0)
ImageList_AddMasked_(list2,img(5)\newID,img(5)\farbe)
ImageList_AddMasked_(list2,img(5)\newID,img(5)\farbe)
ImageList_AddMasked_(list2,img(5)\newID,img(5)\farbe)
ImageList_AddMasked_(list2,img(5)\newID,img(5)\farbe)
ImageList_AddMasked_(list2,img(5)\newID,img(5)\farbe)
SendMessage_(tbid,#TB_SETIMAGELIST,0,list1)
SendMessage_(tbid,#TB_SETHOTIMAGELIST,0,list2)
ToolBar_SetButtonInfo(tbid,#menuid1,font,0 ,"Hauptliste") ;image 0
ToolBar_SetButtonInfo(tbid,#menuid2,font,1 ,"Hitliste") ;image 1
ToolBar_SetButtonInfo(tbid,#menuid3,font,2 ,"Monatsliste") ;
ToolBar_SetButtonInfo(tbid,#menuid4,font,3 ,"Angebote")
ToolBar_SetButtonInfo(tbid,#menuid5,font,4 ,"")
ToolBar_SetButtonInfo(tbid,#menuid6,font,-2,"Explorer") ;-2=kein Image
;Position
ToolBar_SetPosition(tbid,sp,ze)
EndProcedure
Procedure ToolBar_SetButtonInfo(tbid,menuid,fontid,iconid,txt$)
;Flag für Text rechts + kein Trennbalken oben
flag = #TBSTYLE_LIST | #TB_AUTOSIZE | #CCS_NODIVIDER
SetWindowLong_(tbid, #GWL_STYLE,GetWindowLong_(tbid, #GWL_STYLE)|flag)
;ist ein Image definiert
If iconid <> -2
;Breite eines Image holen
ilist = SendMessage_(tbid,#TB_GETIMAGELIST, 0,0)
ImageList_GetImageInfo_(ilist,0,image.IMAGEINFO)
If Len(txt$)
addbreite = image\rcImage\right - image\rcImage\left + 11
Else
addbreite = image\rcImage\right - image\rcImage\left + 4
EndIf
Else
addbreite = 7 ;addbreite zum Ausgleich
txt$=" "+txt$ ;damit Text mehr in der Mitte ist
EndIf
;Struktur füllen
Button.TBBUTTONINFO
Button\cbSize = SizeOf(TBBUTTONINFO)
Button\dwMask = #TBIF_COMMAND |#TBIF_SIZE | #TBIF_TEXT | #TBIF_IMAGE | #TBIF_STATE | #TBIF_STYLE
Button\idCommand = menuid
Button\iImage = iconid ;#I_IMAGENONE = -2
Button\fsState = #TBSTATE_ENABLED
Button\fsStyle = #TBSTYLE_CHECKGROUP
Button\cx = Textbreite(fontid,txt$) + addbreite
Button\pszText = @txt$
Button\cchText = Len(txt$)
;ButtonInfo an Toolbar senden
SendMessage_(tbid, #TB_SETBUTTONINFO, menuid, Button.TBBUTTONINFO)
EndProcedure
Procedure ToolBar_SetPosition(tbid,sp,ze)
buttonanz = SendMessage_(tbid, #TB_BUTTONCOUNT, 0, 0) ;Separator zählt auch mit
For j = 0 To buttonanz-1
;zum ermitteln der Breite des aktuellen Buttons
SendMessage_(tbid, #TB_GETITEMRECT, j, r.RECT)
tbBreite=tbBreite+(r\right-r\left)
Next
;könnte man auch als Parameter übergeben, aber wozu
hd=GetParent_(tbid)
GetWindowRect_(hd,r.RECT)
parent_br = r\right-r\left
Select sp
Case 0: sp=10 ;links, die 10 steht jeweils der Schönheit wegen da
Case -1: sp=(parent_br-tbBreite)/2 ;mitte
Case -2: sp=parent_br-tbBreite-10 ;rechts
EndSelect
SetWindowPos_(tbid, 0, sp, ze, 0, 0, #SWP_NOSIZE | #SWP_NOZORDER)
EndProcedure
Procedure MakeImageID(*img.imagedaten, datname$)
*img\imgID = ImageID(LoadImage(#PB_Any,datname$))
image = CreateImage(#PB_Any,#tbimgbr,#tbimghh)
StartDrawing(ImageOutput(image))
DrawImage(*img\imgID,0,0,#tbimgbr,#tbimghh)
;dies ist die Farbe, die später entfernt wird
*img\farbe = Point(0, 0)
;zu sehen wenn so
;*img\farbe = #Red
StopDrawing()
*img\newID = ImageID(Image)
EndProcedure
Procedure.l TextBreite(font,txt$)
;hdc = GetDC_(toolbar)
;GetTextExtentPoint32_(hdc, Text, Len(Text), @Size)
;liefert leider bei eigenen Fonts falsche Werte
StartDrawing(WindowOutput(0))
If font
DrawingFont(font)
EndIf
br = TextWidth(txt$)
StopDrawing()
ProcedureReturn br
EndProcedure
;nachträglich andere Höhe
;SendMessage_(tbid,#TB_SETBUTTONSIZE,0,32 + (32 << 16) ); Buttons grösser machen.32x32
Hab vergessen zu erwähnen, dies funktioniert nur mit XP-Skin 100 %,
ohne XP-Skin funktioniert der Wert -2 nicht, siehe letzten ToolbarButton, es muß eine ImageID angegeben werden
und die Breite für mit Image aber ohne Text muß vergrößert werden, siehe 5. Button.(addbreite = ... + 4)