'#############################################
'# Farbige Buttons                           #
'#                                           #
'# Andreas Miethe * Bielefeld * Februar 2000 #
'#############################################
'
DEF @IntersectClipRect(5) ! "GDI32","IntersectClipRect"
DEF @LoadImage(6) ! "USER32","LoadImageA"
DECLARE ST#

'###########################################################
'Speicher-Bitmap anlegen :
'Parameter      : 1 = Anzahl der einzelnen Bilder
'               : 2 = Breite des einzelnen Bildes
'               : 3 = Hoehe der Bilder 
Proc CreateBitmap
Parameters Anzahl%,Breite%,Hoehe%
MCLS MUL(Anzahl%,Breite%),Hoehe%
Declare a%,bb%
decimals 0
Startpaint -1
Whilenot @EQU(a%,Anzahl%)
        IntersectClipRect(%hdc,bb%,0,MUL(Anzahl%,Breite%),Hoehe%)
        cls ButtonColor&[a%]
        Usefont "MS Sans Serif",8,0,0,0,0
        TextColor XOR(ButtonColor&[a%],@RGB(255,255,255)),-1
        Drawtext add(bb%,3),3,ADD$("Button ",str$(add(a%,1)))
let bb% = add(bb%,Breite%)
inc a%
EndWhile
EndPaint
EndProc
'###########################################################

'###########################################################
'Speicher-Bitmap in temporaeren Dateien speichern.
'(jedes Bild wird einzeln gespeichert )
'Parameter      : 1 = Anzahl der Bilder
'               : 2 = Breite des einzelnen Bildes
'               : 3 = Hoehe der Bilder
'               : 4 = Name der temporaeren Datei ( wird immer mit "~~" und Zahl gefuellt )
'                     ( Beispiel : Name = TEMP - dann Name = ~~Temp0.bmp )
Proc SaveCreatedBitmaps
Parameters Anzahl%,Breite%,Hoehe%,Tempname$
Declare Name$,c%,cc%
Whilenot @EQU(c%,Anzahl%)
startpaint -1
        Let name$=ADD$(ADD$("~~",Tempname$),str$(c%));".BMP"
        SaveBmp Name$,cc%,0-Breite%,Hoehe%
endpaint
inc c%
Let cc%=add(cc%,Breite%)
Endwhile
endproc
'###########################################################

'###########################################################
'Die temporaeren Bilder laden und einem Button zuweisen
'Parameter      : 1 = Anzahl der Bilder
'               : 2 = Name der temporaeren Dateien s.o.
'               : 3 = Buttonhandle ( kann auch ein Array sein )  
Proc LoadCreatedBitmaps
Parameters Anzahl%,Tempname$
Declare name$,c%,Extbmp&
Dim ST#,30
Whilenot @EQU(c%,Anzahl%)
Let name$=ADD$(ADD$("~~",Tempname$),str$(c%));".BMP"
String ST#,0 = Name$
Let Extbmp& = @LoadImage(%HInstance,ST#,0,0,0,$0050)
Sendmessage(CButton&[c%],$00F7,0,Extbmp&)
inc c%
Endwhile
Dispose ST#
EndProc
'###########################################################

'###########################################################
'Die Temporaerdateien loeschen
'Parameter      : 1 = Anzahl der Dateien
'               : 2 = Name der Dateien s.o.
Proc DestroyCreatedBitmaps
Parameters Anzahl%,Tempname$
Declare name$,c%
Whilenot @EQU(c%,Anzahl%)
Let name$=ADD$(ADD$("~~",Tempname$),str$(c%));".BMP"
ASSIGN #1,name$
ERASE #1
inc c%
Endwhile
EndProc
'###########################################################

'###########################################################
SetTrueColor 1
Declare ButtonColor&[10],CButton&[11]
Declare ende%
'Buttonfarben
ButtonColor&[0] = $0f0000
ButtonColor&[1] = $FFeF4e
ButtonColor&[2] = $CeCee0
ButtonColor&[3] = $A1A0b9
ButtonColor&[4] = $00FFFF
ButtonColor&[5] = $808000
ButtonColor&[6] = $FF0000
ButtonColor&[7] = $0FF000
ButtonColor&[8] = $442288
ButtonColor&[9] = $651243

Proc MakeButtons
        Parameters Anzahl%,Breite%,Hoehe%
        Let Breite% = ADD(Breite%,6)
        Let Hoehe% = ADD(Hoehe%,6)
	Declare I%
	I% = 0
	While I% < Anzahl%
          	CButton&[I%] = Control("BUTTON","",$50000080,10,(50+(Hoehe%*I%)),Breite%,Hoehe%,%hwnd,add(1000,i%),%hinstance)
		Inc I%
	Wend
EndProc

'Hauptprogramm
'#############
Window add(%maxx,1),0-640,480
CLS RGB(192,192,192)
Makebuttons 10,74,24
CreateBitmap 10,74,24
SaveCreatedBitmaps 10,74,24,"Test"
LoadCreatedBitmaps 10,"Test"
DestroyCreatedBitmaps 10,"Test"
Let CButton&[10] = Control("BUTTON","ENDE",$50000000,140,50,80,30,%hwnd,1011,%hinstance)
setwindowpos %hwnd = 0,0-640,480

whilenot ende%
waitinput
If getfocus(CButton&[10])  
        Let ende% = 1
Endif
wend
End