Kurze Beschreibung: Erstellt waagerechte und senkrechte ein- oder mehrzeilige Buttonleisten. Kern sind Container mit Imagegadgets. Jeder Button kann, muß aber nicht, zwei Icons und zwei Texte haben. Hintergrundbilder gibt es aber nur zwei für alle Buttons einer Buttonleiste. Ansonsten siehe Demo.
Das Beispiel unten zeigt die verschiedenen Möglichkeiten.
Die Größe des Codes sollte keinen abschrecken. Von den vielen Zeilen sind fast tausend nur für die Demo.
Fragen, Vorschläge und besonders Verbesserungen sind erwünscht.
Wer weiß zum Beispiel wie man einen Brush in Kombination mit FILLRECT_ nur mit PB löst ?
Oder ResizeImage liefert eine ID zurück, ich bräuchte aber eine PB-Nr. die mit den PB Befehlen nutzbar ist. Irgendwie habe ich da ein Brett vorm Kopf. Habe darum Api benutzt.
PS: ob mit oder ohne XP-Skin sollte egal sein.
Code: Alles auswählen
;Buttonleiste von hjbremer - Jan.2008
;PB 4.1 Windows XP
;auf diese 4 Proceduren kommt es an, der Rest ist Demo
Declare myButtonBar(pbnr,sp,ze,br,hh,*myMb,flag=0)
Declare myButtonBarInfo(nr,pbnr,*myMb,ea,ico1=0,ico2=0,txt1$="",txt2$="")
Declare myButtonBarState(*myMb,welcherButton=0)
Declare FarbverlaufImage(width,height,color1,color2,type)
;fürs Drumherum
Declare FarbenHexerIni(sp,ze)
Declare FarbenHexerState(wB)
Declare FarbenHexerSetPos(f)
Declare PrintWindow(nr,sp,ze,br,hh,farbe=0)
Declare PrintW(container,txt$,farbe=-1,font=0)
Declare TextbreiteApi(fontid,txt$,handle,*s)
Declare Valx(x$)
WindowBreite = 830
WindowHoehe = 500
fontid = FontID(LoadFont(#PB_Any, "Arial", 11))
fontid2= FontID(LoadFont(#PB_Any, "Arial", 7))
fontid3= FontID(LoadFont(#PB_Any, "Times", 10,#PB_Font_Bold))
pfad1$=#PB_Compiler_Home+"Examples\Sources\Data\"
pfad2$=#PB_Compiler_Home+"Examples\Sources - Advanced\MoviePlayer\Icons\"
pfad3$="C:\WINDOWS\Web\Wallpaper\"
icoID1 = ImageID(LoadImage(#PB_Any,pfad2$+"Play.ico"))
icoID2 = ImageID(LoadImage(#PB_Any,pfad2$+"Pause.ico"))
icoID3 = ImageID(LoadImage(#PB_Any,pfad2$+"Stop.ico"))
icoID4 = ImageID(LoadImage(#PB_Any,pfad2$+"movieplayer.ico"))
UseJPEGImageDecoder()
bmpID1 = ImageID(LoadImage(#PB_Any,pfad1$+"clouds.jpg"))
bmpID2 = ImageID(LoadImage(#PB_Any,pfad1$+"terrain_detail.jpg"))
;Bilder sollten auf einem XP Windows vorhanden sein ! sonst Pfad+Image ändern
bmpID3 = ImageID(LoadImage(#PB_Any,pfad3$+"Stonehenge.jpg"))
bmpID4 = ImageID(LoadImage(#PB_Any,pfad3$+"Düne.jpg"))
;myButtonBar's
Enumeration
#mytbar1
#mytbar2
#mytbar3
#mytbar4
#mytbar5
#mytbar6
#mytbar7
#mytbar8
#menuid1
#menuid2
#menuid3
#menuid4
#menuid5
#menuid6
#buttid1
#buttid2
#buttid3
#buttid4
#buttid5
#buttid6
#buttid7
#buttid8
#buttid9
#binfid1
#binfid2
#binfid3
#binfid4
#binfid5
#binfid6
#binfid7
#binfid8
#binfid9
#knopfid1
#knopfid2
#knopfid3
#knopfid4
#knopfid5
#knopfid6
#knopfid7
#knopfid8
#farbid1
#farbid2
#farbid3
#farbid4
#farbid5
#farbid6
#infoid1
#infoid2
#infoid3
#saveid
#editfeld
#windowG
#windowK
#pw1
EndEnumeration
;Farbenhexer
Enumeration #PB_Compiler_EnumerationValue
#txt1
#txt2
#txt3
#track1
#track2
#track3
#string1
#string2
#string3
#string4
#string5
#string6
#string7
#imgnr1
#imgnr2
#imggad1
#imggad2
EndEnumeration
#mybutmax=10 ;= Anzahl Buttons in der größten Buttonleiste + 1
;z.B. 3 Buttonleisten a 3,6,9 Buttons
;dann muß hier mindestens eine 10 stehen
;sonst Fehler: Structure array index out of bounds
Structure myButtonBar
;i.V.= interne Variable
butanz.l ;Buttonanzahl
senkrecht.l ;Senkrechte Buttonleiste
toggle.l ;keine Gruppe sondern Einzelschalter
nobutton.l
contflag.l ;Containerflag z.B. #PB_Container_Single
contnr.l ;i.V.= PB Container Nr.
fontid.l ;für Text
txtcenter.l ;wenn 0, Text direkt neben Icon, wenn 1 text mittig, kein Icon text mittig
txtcolor1.l ;Farben für Text
txtcolor2.l ;
butcolor1a.l ;Farbverlauf von
butcolor1b.l ;Farbverlauf bis
butcolor2a.l ;
butcolor2b.l ;
extcolor.l ;wenn 1, dann müssen Farben extern festgelegt werden
bmp1.l ;ID vom Hintergrundbild
bmp2.l ;
brush1.l ;i.V.= Brush erstellt aus Hintergrundbild
brush2.l ;i.V.=
bitmap1.l ;i.V.= Image erstellt aus Hintergrundbild
bitmap2.l ;i.V.=
ico1.l [#mybutmax] ;Icons im Button
ico2.l [#mybutmax] ;
text.s [#mybutmax] ;Text im Button
txt2.s [#mybutmax] ;Text im Button
pbnr.l [#mybutmax] ;i.V.= PB Button Nummer
activ.l[#mybutmax] ;i.V.= merkt sich zuletzt gedrückten Button
sp.l[#mybutmax] ;i.V.= spalte des buttons im container
ze.l[#mybutmax] ;i.V.=
br.l[#mybutmax] ;i.V.= Buttonbreite
hh.l[#mybutmax] ;i.V.= Buttonhöhe
EndStructure
hwnd=OpenWindow(0, 0,0, WindowBreite, WindowHoehe, "",#PB_Window_SystemMenu | 1) ;1=zentriert
CreateGadgetList(hwnd)
;9 Buttons 3*3 angeordnet
br = 99 ;Gesamtbreite
hh = 92 ;Gesamthöhe
sp = 415
ze = 20
myTb.myButtonBar
myTb\contflag=#PB_Container_Double
myTb\butanz=9 ;9 Buttons
myTb\senkrecht=3 ;3 Reihen
myTb\toggle=1 ;einzeln schaltbar
myTb\bmp1=bmpID1 ;Bitmaps für Brush
myTb\bmp2=bmpID2
myButtonBar(#mytbar2,sp, ze, br, hh, myTb,0) ;0 steht für Brush
myButtonBarInfo(1,#buttid1,myTb,1,0,0,"1") ;aktiv
myButtonBarInfo(2,#buttid2,myTb,0,0,0,"2")
myButtonBarInfo(3,#buttid3,myTb,1,0,0,"3") ;aktiv
myButtonBarInfo(4,#buttid4,myTb,0,0,0,"4")
myButtonBarInfo(5,#buttid5,myTb,0,0,0,"5")
myButtonBarInfo(6,#buttid6,myTb,0,0,0,"6")
myButtonBarInfo(7,#buttid7,myTb,0,0,0,"7")
myButtonBarInfo(8,#buttid8,myTb,1,0,0,"8") ;aktiv
myButtonBarInfo(9,#buttid9,myTb,0,0,0,"9")
;===================================================
;Buttonleiste als Info für 3*3 Buttons
br = 120
sp = 540
ze = 20
hh = 160
myIb.myButtonBar
myIb\contflag=#PB_Container_Double
myIb\butanz=9
myIb\senkrecht=1 ;Button untereinander
myIb\nobutton=1 ;reagiert nicht auf Mausklicks
myIb\fontid=fontid
myIb\extcolor = 1 ;Farben extern festlegen
myIb\txtcolor1 = #Yellow
myIb\txtcolor2 = #Yellow
myIb\butcolor1a= #Gray
myIb\butcolor1b= #Gray
myIb\butcolor2a= #Gray
myIb\butcolor2b= #Gray
myButtonBar(#mytbar7,sp, ze, br, hh, myIb,0)
myButtonBarInfo(1,#binfid1,myIb,0,0,0,"")
myButtonBarInfo(2,#binfid2,myIb,0,0,0,"")
myButtonBarInfo(3,#binfid3,myIb,0,0,0,"")
myButtonBarInfo(4,#binfid4,myIb,0,0,0,"")
myButtonBarInfo(5,#binfid5,myIb,0,0,0,"")
myButtonBarInfo(6,#binfid6,myIb,0,0,0,"")
myButtonBarInfo(7,#binfid7,myIb,0,0,0,"")
myButtonBarInfo(8,#binfid8,myIb,0,0,0,"")
myButtonBarInfo(9,#binfid9,myIb,0,0,0,"")
;===================================================
;macht das gleiche wie Buttonleiste als Info für 3*3
PrintWindow(#pw1,680,20,120,160,#Yellow)
Dim pw1(9)
pw1(1) = PrintW(#pw1,"Dies",#Blue,fontid2)
pw1(2) = PrintW(#pw1,"ist")
pw1(3) = PrintW(#pw1,"ein",#Red)
pw1(4) = PrintW(#pw1,"Test")
pw1(5) = PrintW(#pw1,"um",#Black)
pw1(6) = PrintW(#pw1,"den")
pw1(7) = PrintW(#pw1,"Status",#Magenta)
pw1(8) = PrintW(#pw1,"der 3x3")
pw1(9) = PrintW(#pw1,"Buttons anzuzeigen")
;===================================================
;kleine Buttonleiste als Demo ohne Rahmen und eigene Farben
br = 280
sp = 42
ze = 350
hh = 45
myXb.myButtonBar
myXb\butanz=8
myXb\senkrecht=4
myXb\fontid=fontid2
myXb\extcolor = 1 ;Farben extern festlegen
myXb\txtcolor1 = #Red ;Farbe Text normal
myXb\txtcolor2 = #Yellow ;Farbe Text Highlight
myXb\butcolor1a= #White ;normal
myXb\butcolor1b= #Gray ;
myXb\butcolor2a= #Blue ;gedrückt
myXb\butcolor2b= #Magenta
myButtonBar(#mytbar3,sp, ze, br, hh, myXb,2)
;laufende Nr angeben 1-8
myButtonBarInfo(1,#knopfid1,myXb,1,icoID4,icoID1,"Otto","Werner")
myButtonBarInfo(2,#knopfid2,myXb,0,icoID4,icoID2,"tut","weiß")
myButtonBarInfo(3,#knopfid3,myXb,0,icoID4,icoID3,"nichts","alles")
myButtonBarInfo(4,#knopfid4,myXb,0,icoID4,icoID1,"wenn")
myButtonBarInfo(5,#knopfid5,myXb,0,icoID4,icoID2,"man")
myButtonBarInfo(6,#knopfid6,myXb,0,icoID4,icoID3,"auf diesen")
myButtonBarInfo(7,#knopfid7,myXb,0,icoID4,icoID3,"Button")
myButtonBarInfo(8,#knopfid8,myXb,0,icoID4,icoID3,"drückt")
;===================================================
;Buttonleiste als Info, ob mit oder ohne XP-SKIN, sieht aus wie ein Image sind aber 3 Buttons
br = 365
sp = 42
ze = 200
hh = 50
myI1.myButtonBar
myI1\butanz =3
myI1\nobutton=1
myI1\fontid =fontid3
myButtonBar(#mytbar5,sp, ze, br, hh, myI1,0)
myButtonBarInfo(1,#infoid1,myI1,0,0,0,"Farben ändern"+#LF$+"von - bis")
myButtonBarInfo(2,#infoid2,myI1,0,0,0,"von - bis")
myButtonBarInfo(3,#infoid3,myI1,0,0,0,"Textfarbe normal"+#LF$+"Textfarbe gedrückt")
;===================================================
;Buttonleiste ganz unten, immer nur ein Button aktiv, Farben ändern sich
;gosub wegen Window breiter/kleiner machen, denn dann müssen die Buttons neu gezeichnet werden
;da diese ja auch breiter/kleiner werden. Etwas primitiv, aber was anderes fällt mir nicht ein.
myMb.myButtonBar
Gosub Buttonleiste_myMb
;===================================================
;6 Buttons zeigen die Hexwerte, stellen den Farbenhexer und übernehmen die Farben
;und zeigen diese in der unteren Buttonleiste sofort an
br = 365
sp = 42
ze = 250
hh = 79
myFb.myButtonBar
myFb\butanz=6
myFb\senkrecht=3
myButtonBar(#mytbar4,sp, ze, br, hh, myFb,0)
myButtonBarInfo(1,#farbid1,myFb,1,0,0,Hex(myMb\butcolor1a))
myButtonBarInfo(4,#farbid4,myFb,0,0,0,Hex(myMb\butcolor1b))
myButtonBarInfo(2,#farbid2,myFb,0,0,0,Hex(myMb\butcolor2a))
myButtonBarInfo(5,#farbid5,myFb,0,0,0,Hex(myMb\butcolor2b))
myButtonBarInfo(3,#farbid3,myFb,0,0,0,Hex(myMb\txtcolor1))
myButtonBarInfo(6,#farbid6,myFb,0,0,0,Hex(myMb\txtcolor2))
;===================================================
;Buttonleiste mit nur 1 Button
br = 100
sp = 660
ze = 360
hh = 60
mySb.myButtonBar
mySb\butanz=1
myButtonBar(#mytbar6,sp, ze, br, hh, mySb,0)
myButtonBarInfo(1,#saveid,mySb,0,0,0,"Editfeld ins"+#LF$+"Clipboard")
;===============================================================
;Buttonleiste mit 2 Buttons untereinander, die Textfarbe+Image ändert sich nicht
;da in der Repeat Eventschleife bei #windowG+#windowK auf myButtonBarState() verzichtet wird
;mehr als 2 Bilder geht in dieser Version nicht. Ist eh nur Spielkram.
br = 100
sp = 660
ze = 250
hh = 100
myWb.myButtonBar
myWb\butanz=2
myWb\senkrecht=1
myWb\fontid=fontid3
myWb\bmp1=bmpID3 ;bmp1+2 müssen belegt werden sonst wird Farbverlauf benutzt
myWb\bmp2=bmpID4 ;und zwei Bilder werden angezeigt da der Status vom 2.Button 1 ist
myWb\extcolor = 1 ;Farben extern festlegen
myWb\txtcolor1 = #Yellow ;Farbe Text normal
myWb\txtcolor2 = #Green ;Farbe Text normal
myButtonBar(#mytbar8,sp, ze, br, hh, myWb,0)
myButtonBarInfo(1,#windowG,myWb,0,0,0,"Window breiter")
myButtonBarInfo(2,#windowK,myWb,1,0,0,"Window kleiner")
;===============================================================
FarbenHexerIni(40,30)
EditorGadget(#editfeld,450,270,200,150)
AddGadgetItem(#editfeld, -1, ";Farbe Text normal+gedrückt")
AddGadgetItem(#editfeld, -1, "*myMb\txtcolor1 = $"+Hex(myMb\txtcolor1))
AddGadgetItem(#editfeld, -1, "*myMb\txtcolor2 = $"+Hex(myMb\txtcolor2))
AddGadgetItem(#editfeld, -1, ";normal: Farbe von - bis")
AddGadgetItem(#editfeld, -1, "*myMb\butcolor1a= $"+Hex(myMb\butcolor1a))
AddGadgetItem(#editfeld, -1, "*myMb\butcolor1b= $"+Hex(myMb\butcolor1b))
AddGadgetItem(#editfeld, -1, ";gedrückt: Farbe von - bis")
AddGadgetItem(#editfeld, -1, "*myMb\butcolor2a= $"+Hex(myMb\butcolor2a))
AddGadgetItem(#editfeld, -1, "*myMb\butcolor2b= $"+Hex(myMb\butcolor2b))
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_Gadget Or EventID = #PB_Event_Menu
welcherButton=EventGadget()
Select welcherButton
Case #track1,#track2,#track3
xxx = FarbenHexerState(welcherButton)
lastButton=#True
Case #menuid1 To #menuid6
;myButtonBarState() ändert den gedrückten Button
;und übersetzt die Gadgetnr in den Wert press = 1 bis 6
press = myButtonBarState(myMb,welcherButton)
Case #buttid1 To #buttid9
;benutzt die übergebenen Konstanten zur Auswertung des 3*3 Feldes
myButtonBarState(myTb,welcherButton)
Select welcherButton
Case #buttid1: myIb\text[1]="Button 1= "+Str(GetGadgetData(#buttid1))
myButtonBarState(myIb,#binfid1)
Case #buttid2: myIb\text[2]="Button 2= "+Str(GetGadgetData(#buttid2))
myButtonBarState(myIb,#binfid2)
Case #buttid3: myIb\text[3]="Button 3= "+Str(GetGadgetData(#buttid3))
myButtonBarState(myIb,#binfid3)
Case #buttid4: myIb\text[4]="Button 4= "+Str(GetGadgetData(#buttid4))
myButtonBarState(myIb,#binfid4)
Case #buttid5: myIb\text[5]="Button 5= "+Str(GetGadgetData(#buttid5))
myButtonBarState(myIb,#binfid5)
Case #buttid6: myIb\text[6]="Button 6= "+Str(GetGadgetData(#buttid6))
myButtonBarState(myIb,#binfid6)
Case #buttid7: myIb\text[7]="Button 7= "+Str(GetGadgetData(#buttid7))
myButtonBarState(myIb,#binfid7)
Case #buttid8: myIb\text[8]="Button 8= "+Str(GetGadgetData(#buttid8))
myButtonBarState(myIb,#binfid8)
Case #buttid9: myIb\text[9]="Button 9= "+Str(GetGadgetData(#buttid9))
myButtonBarState(myIb,#binfid9)
EndSelect
;zeigt Änderung im PrintWindowKasten
k=1
For j=#buttid1 To #buttid9
state=GetGadgetData(j)
SetGadgetText(pw1(k),"Button "+Str(k)+" = "+Str(state))
SetGadgetColor(pw1(k),#PB_Gadget_FrontColor,#Black)
If state: SetGadgetColor(pw1(k),#PB_Gadget_FrontColor,#Red):EndIf
k+1
Next
Case #knopfid1 To #knopfid8
press = myButtonBarState(myXb,welcherButton)
Case #saveid
;man beachte: kein myButtonBarState()
editanz = CountGadgetItems(#editfeld) -1
edittxt$=""
For j=0 To editanz
edittxt$+GetGadgetItemText(#editfeld,j)+#CRLF$
Next
SetClipboardText(edittxt$)
Case #windowG
WindowBreite=WindowWidth(0)+10
ResizeWindow(0, #PB_Ignore , #PB_Ignore , WindowBreite, #PB_Ignore)
Gosub Buttonleiste_myMb
Case #windowK
WindowBreite=WindowWidth(0)-10
ResizeWindow(0, #PB_Ignore , #PB_Ignore , WindowBreite, #PB_Ignore)
Gosub Buttonleiste_myMb
Case #farbid1 To #farbid6
press = myButtonBarState(myFb,welcherButton)
Select press
Case 1: If lastButton
myMb\butcolor1a=xxx
myMb\bitmap1=FarbverlaufImage(myMb\br[1],myMb\hh[1],myMb\butcolor1a,myMb\butcolor1b,1)
myFb\text[1]=Hex(myMb\butcolor1a)
myButtonBarState(myFb,#farbid1)
For j=#menuid1 To #menuid6
myButtonBarState(myMb,j)
Next
SetGadgetItemText(#editfeld, 4, "*myMb\butcolor1a= $"+Hex(myMb\butcolor1a))
Else
FarbenHexerSetPos(myMb\butcolor1a)
EndIf
Case 4: If lastButton
myMb\butcolor1b=xxx
myMb\bitmap1=FarbverlaufImage(myMb\br[1],myMb\hh[1],myMb\butcolor1a,myMb\butcolor1b,1)
myFb\text[4]=Hex(myMb\butcolor1b)
myButtonBarState(myFb,#farbid4)
For j=#menuid1 To #menuid6
myButtonBarState(myMb,j)
Next
SetGadgetItemText(#editfeld, 5, "*myMb\butcolor1b= $"+Hex(myMb\butcolor1b))
Else
FarbenHexerSetPos(myMb\butcolor1b)
EndIf
;_______________________________
Case 2: If lastButton
myMb\butcolor2a=xxx
myMb\bitmap2=FarbverlaufImage(myMb\br[1],myMb\hh[1],myMb\butcolor2a,myMb\butcolor2b,1)
myFb\text[2]=Hex(myMb\butcolor2a)
myButtonBarState(myFb,#farbid2)
For j=#menuid1 To #menuid6
myButtonBarState(myMb,j)
Next
SetGadgetItemText(#editfeld, 7, "*myMb\butcolor2a= $"+Hex(myMb\butcolor2a))
Else
FarbenHexerSetPos(myMb\butcolor2a)
EndIf
Case 5: If lastButton
myMb\butcolor2b=xxx
myMb\bitmap2=FarbverlaufImage(myMb\br[1],myMb\hh[1],myMb\butcolor2a,myMb\butcolor2b,1)
myFb\text[5]=Hex(myMb\butcolor2b)
myButtonBarState(myFb,#farbid5)
For j=#menuid1 To #menuid6
myButtonBarState(myMb,j)
Next
SetGadgetItemText(#editfeld, 8, "*myMb\butcolor2b= $"+Hex(myMb\butcolor2b))
Else
FarbenHexerSetPos(myMb\butcolor2b)
EndIf
;_______________________________
Case 3: If lastButton
myMb\txtcolor1=xxx
For j=#menuid1 To #menuid6
myButtonBarState(myMb,j)
Next
myFb\text[3]=Hex(xxx)
myButtonBarState(myFb,#farbid3)
SetGadgetItemText(#editfeld, 1, "*myMb\txtcolor1 = $"+Hex(myMb\txtcolor1))
Else
FarbenHexerSetPos(myMb\txtcolor1)
EndIf
Case 6: If lastButton
myMb\txtcolor2=xxx
For j=#menuid1 To #menuid6
myButtonBarState(myMb,j)
Next
myFb\text[6]=Hex(xxx)
myButtonBarState(myFb,#farbid6)
SetGadgetItemText(#editfeld, 2, "*myMb\txtcolor2 = $"+Hex(myMb\txtcolor2))
Else
FarbenHexerSetPos(myMb\txtcolor2)
EndIf
EndSelect
lastButton=0
EndSelect
EndIf
Until EventID = #PB_Event_CloseWindow
End
Buttonleiste_myMb:
sp = 10 ;Spalte
hh = 32 ;Höhe der ButtonLeiste
br = WindowBreite-sp-sp ;Gesamtbreite der Leiste
ze = WindowHoehe-hh-10 ;Zeile
myMb\butanz=6 ;enthält 6 Buttons
myMb\fontid=fontid ;Schrift mit diesem Font
myMb\txtcenter=1 ;da Icons, soll Text in die Mitte
myButtonBar(#mytbar1,sp, ze, br, hh, myMb,2) ;die 2 steht für Farbverlauf
myButtonBarInfo(1,#menuid1,myMb,0,icoID3,icoID4,"Hauptliste")
myButtonBarInfo(2,#menuid2,myMb,0,icoID1,icoID2,"Hitliste")
myButtonBarInfo(3,#menuid3,myMb,1,icoID1,icoID2,"Monatsliste") ;dieser Buttonaktiv
myButtonBarInfo(4,#menuid4,myMb,0,icoID1,icoID2,"Verkaufsliste")
myButtonBarInfo(5,#menuid5,myMb,0,icoID1,icoID2,"Nebenliste","Unterliste")
myButtonBarInfo(6,#menuid6,myMb,0,icoID1,icoID2,"keine Ahnung","ich weiß nix")
Return
Procedure myButtonBar(pbnr,sp,ze,br,hh,*myMb.myButtonBar,flag=0)
;bitmap darf kein ICO sein !!!
;flag = 0 = Image als Hintergrundbild
;flag = 1 = Image als Brush
;flag = 2 = Farbverlauf
;oder
;flag = 0 + ein bitmap = 0 = Farbverlauf
senkrecht=*myMb\senkrecht
If senkrecht ;1 oder mehrere senkrechte Spalten
spx=0
zex=0
brx=(br - 2) / senkrecht
xyz=*myMb\butanz / senkrecht
mod=*myMb\butanz % senkrecht
If mod: xyz+1: EndIf
hhx=hh / xyz
For j = 1 To *myMb\butanz
*myMb\sp[j]=spx
*myMb\ze[j]=zex
*myMb\br[j]=brx
*myMb\hh[j]=hhx
If j % senkrecht
spx+brx
Else
spx=0
zex+hhx
EndIf
Next
Else ;Waagerechte Buttonleiste
spx=0
zex=0
brx=br / *myMb\butanz
hhx=hh - 2
For j = 1 To *myMb\butanz
*myMb\sp[j]=spx
*myMb\ze[j]=zex
*myMb\br[j]=brx
*myMb\hh[j]=hhx
spx+brx
Next
EndIf
If *myMb\extcolor = 0 ;Farben intern festlegen
;Farbe Text normal+gedrückt
*myMb\txtcolor1 = $0
*myMb\txtcolor2 = $FE6400
;normal: Farbe von - bis
*myMb\butcolor1a= $FFFFFF
*myMb\butcolor1b= $DB826E
;gedrückt: Farbe von - bis
*myMb\butcolor2a= $E0FBFF
*myMb\butcolor2b= $4562FF
EndIf
bitmap1=*myMb\bmp1
bitmap2=*myMb\bmp2
;make a brush, manchmal besser als das Bild
If bitmap1 And bitmap2 And flag=1
;wenn Original nicht mehr gebraucht wird,
;#LR_COPYDELETEORG anstatt der null am Ende.
ID = CopyImage_(bitmap1, #IMAGE_BITMAP, brx/4, hhx, 0)
*myMb\brush1 = CreatePatternBrush_(ID)
DeleteObject_(ID)
ID = CopyImage_(bitmap2, #IMAGE_BITMAP, brx/4, hhx, 0)
*myMb\brush2 = CreatePatternBrush_(ID)
DeleteObject_(ID)
;Resize bitmap
ElseIf bitmap1 And bitmap2 And flag=0
;erspart br+hh Angabe in myButtonBarInfo() DrawImage
;#LR_COPYDELETEORG anstatt der null eventuell am Ende.
*myMb\bitmap1 = CopyImage_(bitmap1, #IMAGE_BITMAP, brx, hhx, 0)
*myMb\bitmap2 = CopyImage_(bitmap2, #IMAGE_BITMAP, brx, hhx, 0)
;Image mit Farbverlauf erstellen, flag > 1 oder ein Bitmap = 0
Else
*myMb\bitmap1 = FarbverlaufImage(brx,hhx,*myMb\butcolor1a,*myMb\butcolor1b,1) ; 1=horizontal
*myMb\bitmap2 = FarbverlaufImage(brx,hhx,*myMb\butcolor2a,*myMb\butcolor2b,1) ; 1=horizontal
EndIf
*myMb\contnr = pbnr ;Container pbnr für OpenGadgetList()
hh+2
If *myMb\nobutton: hh-4:EndIf
hdl=ContainerGadget(pbnr,sp,ze,br+1,hh,*myMb\contflag)
CloseGadgetList()
ProcedureReturn hdl
EndProcedure
Procedure myButtonBarInfo(nr,pbnr,*myMb.myButtonBar,ea,ico1=0,ico2=0,txt1$="",txt2$="")
;ico1 + ico2 muß ein ICON sein !!! oder man Tauscht #IMAGE_ICON gegen #IMAGE_BITMAP
If *myMb\butanz < nr Or nr = 0: MessageRequester("","falsche laufende Nr.: " + Str(nr)): End: EndIf
sp=*myMb\sp[nr]
ze=*myMb\ze[nr]
br=*myMb\br[nr]
hh=*myMb\hh[nr]
;diese Zeilen wichtig für myButtonBarState()
If txt1$="": txt1$=*mymb\text[nr]: Else: *mymb\text[nr]=txt1$: EndIf
If txt2$="": txt2$=*mymb\txt2[nr]: Else: *mymb\txt2[nr]=txt2$: EndIf
If ico1=0: ico1=*mymb\ico1[nr]: Else: *mymb\ico1[nr]=ico1: EndIf
If ico2=0: ico2=*mymb\ico2[nr]: Else: *mymb\ico2[nr]=ico2: EndIf
*myMb\activ[nr]=ea ;welcher Button soll aktiv sein
*myMb\pbnr [nr]=pbnr ;
txt$=txt1$
ico=ico1
bmp=*myMb\bitmap1
brush=*myMb\brush1
farbe=*myMb\txtcolor1
If ea
If txt2$<>"":txt$=txt2$:EndIf
ico=ico2
bmp=*myMb\bitmap2
brush=*myMb\brush2
farbe=*myMb\txtcolor2
EndIf
;Image neu zeichnen
image = CreateImage(pbnr,br,hh) ;hier wird pbnr 2x benutzt, für Button + Image
dc = StartDrawing(ImageOutput(pbnr)) ;das muß so sein und geht auch nicht anders
;denn #PB_Any + CreateImage vertragen sich nicht immer
;Hintergrund malen ;irgendwann kommt es zur Meldung GadgetNr. to high...
If brush
r.rect
r\right=br
r\bottom=hh
FillRect_(dc,r,brush)
ElseIf bmp
DrawImage(bmp, 0, 0)
Else ;falls bmp null ist, zur Sicherheit
Box(0, 0, br, hh, GetSysColor_(#COLOR_3DLIGHT))
EndIf
If *myMb\fontid
DrawingFont(*myMb\fontid)
EndIf
;Ico malen
If ico
icohh=16:txtabsp=20
If hh < 24
icohh=12:txtabsp=16
EndIf
ID = CopyImage_(ico, #IMAGE_ICON, icohh, icohh, 0)
icoze=(hh-icohh)/2
DrawImage(ID,5,icoze)
EndIf
;ist ein #LF$ im Text ?
p=FindString(txt$,#LF$,1)
If p ;ja
txt1$=Left(txt$,p-1)
txt2$= Mid(txt$,p+1,99)
;Text sp+ze berechnen
If ico
txtbr=br-txtabsp ;txtabsp für Icobreite berücksichtigen, siehe Ico malen
txtsp1=txtabsp+3
txtsp2=txtsp1
If txtbr > TextWidth(txt1$)
If *myMb\txtcenter=1: txtsp1=txtabsp+((txtbr-TextWidth(txt1$))/2)-3: EndIf
EndIf
If txtbr > TextWidth(txt2$)
If *myMb\txtcenter=1: txtsp2=txtabsp+((txtbr-TextWidth(txt2$))/2)-3: EndIf
EndIf
Else
txtbr=br
txtsp1=(txtbr-TextWidth(txt1$))/2 ;kein ico, text immer in die mitte
txtsp2=(txtbr-TextWidth(txt2$))/2 ;kein ico, text immer in die mitte
EndIf
txtze1=(hh-(2*TextHeight(txt$)))/3
txtze2=txtze1+TextHeight(txt$)+3
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(txtsp1,txtze1+2,txt1$,farbe)
DrawText(txtsp2,txtze2+2,txt2$,farbe)
Else ;nein
;Text sp+ze berechnen
If ico
txtbr=br-txtabsp
txtsp=txtabsp+3
If txtbr > TextWidth(txt$)
If *myMb\txtcenter=1: txtsp=txtabsp+((txtbr-TextWidth(txt$))/2)-3: EndIf
EndIf
Else
txtbr=br
txtsp=(txtbr-TextWidth(txt$))/2 ;kein ico, text immer in die mitte
EndIf
txtze=(hh-TextHeight(txt$))/2
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(txtsp,txtze,txt$,farbe)
EndIf
StopDrawing()
OpenGadgetList(*myMb\contnr)
If *myMb\nobutton
ImageGadget(pbnr,sp,ze,br,hh,image)
Else
ButtonImageGadget(pbnr,sp,ze,br,hh,image)
SetGadgetData(pbnr,ea)
EndIf
CloseGadgetList()
EndProcedure
Procedure myButtonBarState(*myMb.myButtonBar,welcherButton=0)
If *myMb\toggle
;Farbe umschalten
For nr = 1 To *myMb\butanz
;gedrückter Button
If *myMb\pbnr[nr] = welcherButton
lfdnr=nr
pbnr=*myMb\pbnr[nr]
status=GetGadgetData(pbnr)
status = status Not status
myButtonBarInfo(nr,pbnr,*myMb,status)
SetGadgetData(pbnr,status)
EndIf
Next
Else
;Farbe umschalten
For nr = 1 To *myMb\butanz
;aktiver Button wird normal
If *myMb\activ[nr]
pbnr=*myMb\pbnr[nr]
myButtonBarInfo(nr,pbnr,*myMb,0)
SetGadgetData(pbnr,0)
EndIf
;gedrückter Button wird Highlight
If *myMb\pbnr[nr] = welcherButton
lfdnr=nr
pbnr=*myMb\pbnr[nr]
myButtonBarInfo(nr,pbnr,*myMb,1)
SetGadgetData(pbnr,1)
EndIf
Next
EndIf
ProcedureReturn lfdnr
EndProcedure
Procedure FarbverlaufImage(width,height,color1,color2,type)
; von Danilo aus dem Codearchiv,
; angepasst von hjbremer
;type =
vertikal = 0
horizontal = 1
Img = CreateImage(#PB_Any,width,height)
If Img
If type=vertikal : i = width : Else : i = height : EndIf
sRed.f = Red(color1) : r.f = (Red (color1) - Red (color2))/i
sGreen.f = Green(color1) : g.f = (Green(color1) - Green(color2))/i
sBlue.f = Blue(color1) : b.f = (Blue (color1) - Blue (color2))/i
StartDrawing(ImageOutput(img))
For a = 0 To i-1
x.f = sRed - a*r
y.f = sGreen - a*g
z.f = sBlue - a*b
If type=horizontal
Line(0,a,width,0,RGB(x,y,z))
Else
Line(a,0,0,height,RGB(x,y,z))
EndIf
Next a
StopDrawing()
EndIf
ProcedureReturn ImageID(Img)
EndProcedure
Procedure FarbenHexerIni(sp,ze)
; von Danilo aus dem Codearchiv,
; angepasst von hjbremer
ContainerGadget(#PB_Any,sp,ze,350,145,#PB_Container_Double)
TrackBarGadget(#track1, 45, 5, 265, 20, 0, 255)
TrackBarGadget(#track2, 45, 30, 265, 20, 0, 255)
TrackBarGadget(#track3, 45, 55, 265, 20, 0, 255)
TextGadget(#txt1, 5, 5, 20, 20, "00",#WS_DLGFRAME)
x=TextGadget(#PB_Any, 25, 5, 15, 20, "R" ,#WS_DLGFRAME)
SetGadgetColor(x,#PB_Gadget_FrontColor,#Red)
TextGadget(#txt2, 5, 30, 20, 20, "00",#WS_DLGFRAME)
x=TextGadget(#PB_Any, 25, 30, 15, 20, "G" ,#WS_DLGFRAME)
SetGadgetColor(x,#PB_Gadget_FrontColor,#Green)
TextGadget(#txt3, 5, 55, 20, 20, "00",#WS_DLGFRAME)
x=TextGadget(#PB_Any, 25, 55, 15, 20, "B" ,#WS_DLGFRAME)
SetGadgetColor(x,#PB_Gadget_FrontColor,#Blue)
TextGadget(#string1,315, 5, 26, 20,"000",#WS_DLGFRAME)
TextGadget(#string2,315, 30, 26, 20,"000",#WS_DLGFRAME)
TextGadget(#string3,315, 55, 26, 20,"000",#WS_DLGFRAME)
TextGadget(#string4, 5, 90, 55, 20, "$000000",#WS_DLGFRAME)
TextGadget(#string5, 286, 90, 55, 20, "0" ,#WS_DLGFRAME)
TextGadget(#string6, 5, 115, 55, 20, "$000000",#WS_DLGFRAME)
TextGadget(#string7, 286, 115, 55, 20, "0" ,#WS_DLGFRAME)
CreateImage(#imgnr1, 205, 20)
CreateImage(#imgnr2, 205, 20)
ImageGadget(#imggad1,70, 90,205,20,ImageID(#imgnr1))
ImageGadget(#imggad2,70,115,205,20,ImageID(#imgnr2))
CloseGadgetList()
EndProcedure
Procedure FarbenHexerState(wB)
Static rot,gruen,blau
Select wB
Case #track1
rot = GetGadgetState(#track1)
SetGadgetText(#txt1, Hex(rot))
SetGadgetText(#string1, Str(rot))
SetGadgetText(#string6, "$0000"+RSet(Hex(rot),2,"0"))
wert2=rot
txt$="R"
Case #track2
gruen = GetGadgetState(#track2)
SetGadgetText(#txt2, Hex(gruen))
SetGadgetText(#string2, Str(gruen))
SetGadgetText(#string6, "$00"+RSet(Hex(gruen),2,"0")+"00")
wert2=gruen << 8
txt$="G"
Case #track3
blau = GetGadgetState(#track3)
SetGadgetText(#txt3, Hex(blau))
SetGadgetText(#string3, Str(blau))
SetGadgetText(#string6, "$"+RSet(Hex(blau),2,"0")+"0000")
wert2=blau << 16
txt$="B"
EndSelect
Wert = (blau << 16) | (gruen << 8) | (rot)
SetGadgetText(#string4, "$"+RSet(Hex(blau),2,"0")+RSet(Hex(gruen),2,"0")+RSet(Hex(rot),2,"0"))
SetGadgetText(#string5, StrU(Wert,2))
SetGadgetText(#string7, StrU(Wert2,2))
StartDrawing(ImageOutput(#imgnr1))
Box(0, 0, 260, 20, RGB(rot, gruen, blau))
DrawingMode(#PB_2DDrawing_Transparent)
FrontColor(#Yellow)
DrawText(0,0,"RGB")
StopDrawing()
SetGadgetState(#imggad1,ImageID(#imgnr1))
StartDrawing(ImageOutput(#imgnr2))
Box(0, 0, 260, 20, Wert2)
DrawingMode(#PB_2DDrawing_Transparent)
FrontColor(#Yellow)
DrawText(0,0,txt$)
StopDrawing()
SetGadgetState(#imggad2,ImageID(#imgnr2))
ProcedureReturn Wert
EndProcedure
Procedure FarbenHexerSetPos(farbe)
r=Red(farbe): SetGadgetState(#track1,r): FarbenHexerState(#track1)
b=Blue(farbe): SetGadgetState(#track3,b): FarbenHexerState(#track3)
g=Green(farbe): SetGadgetState(#track2,g): FarbenHexerState(#track2)
EndProcedure
Procedure Valx(a$)
;aus dem Codearchiv
a$=Trim(UCase(a$))
If Asc(a$)='$'
a$=Trim(Mid(a$,2,Len(a$)-1))
EndIf
result=0
*adr.byte=@a$
For i=1 To Len(a$)
result<<4
Select *adr\B
Case '0'
Case '1':result+1
Case '2':result+2
Case '3':result+3
Case '4':result+4
Case '5':result+5
Case '6':result+6
Case '7':result+7
Case '8':result+8
Case '9':result+9
Case 'A':result+10
Case 'B':result+11
Case 'C':result+12
Case 'D':result+13
Case 'E':result+14
Case 'F':result+15
Default:i=Len(a$)
EndSelect
*adr+1
Next
ProcedureReturn result
EndProcedure
Procedure PrintWindow(pbnr,sp,ze,br,hh,farbe=0)
hdl = ContainerGadget(pbnr,sp,ze,br,hh,#PB_Container_Single)
SetGadgetData(pbnr,0) ;Startzeile
If farbe
SetGadgetColor(pbnr,#PB_Gadget_BackColor,farbe)
EndIf
CloseGadgetList()
ProcedureReturn hdl
EndProcedure
Procedure PrintW(container,txt$,farbe=-1,fontid=0)
Static font
Static color
If farbe > -1: color=farbe: EndIf
If fontid: font=fontid: EndIf
If font=0
font = GetGadgetFont(#PB_Default)
EndIf
backcolor = GetGadgetColor(container,#PB_Gadget_BackColor)
sp = 10
ze = GetGadgetData(container)
br = GadgetWidth(container)-sp
TextbreiteApi(font,txt$,GadgetID(container),s.size) ;es wird nur die Höhe benötigt
OpenGadgetList(container)
pbnr = TextGadget(#PB_Any,sp,ze,br,s\cy,txt$)
SetGadgetColor(pbnr,#PB_Gadget_FrontColor,color)
If backcolor > -1
SetGadgetColor(pbnr,#PB_Gadget_BackColor,backcolor)
EndIf
If font
SetGadgetFont(pbnr,font)
EndIf
SetGadgetData(container,ze+s\cy)
CloseGadgetList()
ProcedureReturn pbnr
EndProcedure
Procedure TextbreiteApi(fontid,txt$,handle,*s.size)
dc=GetDC_(handle)
SelectObject_(dc,fontid)
GetTextExtentPoint32_(dc,@txt$,Len(txt$),*s.size)
ReleaseDC_(handle,dc)
EndProcedure
