PureBoard

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