Habe mich immer darüber geärgert, das die Buttons mit XP-Skin immer anders aussehen als ohne XP-Skin.
Außerdem ein Beispiel wie man mit SetColorAdjustment_ und StretchBlt_ einen Farbverlauf realisiert.
Nicht zu vergessen DrawText_ in Verbindung mit #DT_CALCRECT zum Berechnen der Position von Text im Image.
Warum kann PB das nicht ???!!!
Ach ja, falls jemand Lust hat mir zu sagen wie man einfach eine Strukturvariable löscht, so wie unten myib, der möge dies bitte tun.
Code: Alles auswählen
;von HJBREMER 21.02.2008
;WINDOWS XP - PB 4.1
;ImageGadgets als ButtonErsatz, Aussehen ist mit oder ohne XP-Skin gleich, zumindest bei mir !
Declare myButton_callback(hWnd, Msg, wParam, lParam)
Declare myImageGadget(pbnr,sp,ze,br,hh,txt$,*ib)
Declare myImageGadgetChg(button)
Enumeration
#cont1
#iconr1
#iconr2
#image1
#image2
#image3
#butimg1
#butimg2
#butimg3
#butimg4
#butimg5
#butimg6
#butimg7
#butimgEnd ;nur für Abfragen, erleichtert Buttons hinzufügen
#buttonA
#buttonT
EndEnumeration
Structure ImageGadgetDaten
icon_ID.l
color_base.l
color_text.l
fontid_text.l
brightness_base.l
brightness_step.l
brightness_flag.l
drawrahmen_flag.l
drawrahmen_stil.l
drawrahmen_dblx.l
background_imgID.l
EndStructure
UseJPEGImageDecoder()
icoID1 = CatchImage(#iconr1, ?Icon1)
icoID2 = CatchImage(#iconr2, ?Icon2)
imageID1 = CatchImage(#image1, ?Bild2)
;#PB_Window_Invisible = nicht sichtbar = schnellerer Bildaufbau
windowstyles = #PB_Window_SystemMenu|1|#PB_Window_Invisible ;die 1 = zentriert
hwnd=OpenWindow(0, 0, 0, 480,400, "",windowstyles)
CreateGadgetList(hwnd)
ContainerGadget(#cont1,5,5,470,390,#PB_Container_Double)
myib.ImageGadgetDaten
myib\color_base = #Blue
myib\brightness_base = 50
myib\drawrahmen_dblx=2
myib\icon_ID=icoID1
myImageGadget(#butimg1,10,10,100,50,"Hallo",myib)
myImageGadget(#butimg2,110,10,100,50,"Test",myib)
myib\icon_ID=icoID2
myImageGadget(#butimg3,210,10,100,50,"Hallo dies ist ein Test",myib)
myib\color_text=#Yellow
myib\background_imgID=imageID1
myImageGadget(#butimg4,310,10,100,50,"Hallo dies ist ein Hintergrundbild",myib)
myxx.ImageGadgetDaten ;myxx weil keine Lust myib zu löschen
myImageGadget(#butimg5,410,10,50,50,"Ooops normal",myxx)
myImageGadget(#butimg6,410,70,50,50,"normal",myxx)
myImageGadget(#butimg7,410,130,50,50,"ganz viel normal",myxx)
ButtonGadget(#buttonA,10,60,100,50,"Testbutton")
TextGadget (#buttonT,210,90,200,50,"")
CloseGadgetList()
;#PB_Window_Invisible rückgängig machen, Fenster anzeigen
SetWindowState(0, #PB_Window_Normal)
SetWindowCallback(@myButton_Callback())
;----------------------------------------------------------------
Repeat
event=WaitWindowEvent()
If Event = #PB_Event_Gadget Or EventID = #PB_Event_Menu
welcherButton=EventGadget()
Select welcherButton
Case #butimg1 To #butimgEnd
buttonnotchg_nr=welcherButton
myImageGadgetChg(welcherButton)
Select welcherButton
Case #butimg1:SetGadgetText(#buttonT,"1. gedrückt")
Case #butimg2:SetGadgetText(#buttonT,"2. gedrückt")
Case #butimg3:SetGadgetText(#buttonT,"3. gedrückt")
Case #butimg4:SetGadgetText(#buttonT,"4. gedrückt")
Case #butimg5:SetGadgetText(#buttonT,"5. gedrückt")
Case #butimg6:SetGadgetText(#buttonT,"6. gedrückt")
Case #butimg7:SetGadgetText(#buttonT,"7. gedrückt")
EndSelect
Case #buttonA:buttonnotchg_nr=0:myImageGadgetChg(0)
SetGadgetText(#buttonT,"kein ImageGadget gedrückt")
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
End
Procedure myButton_callback(hWnd, Msg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Static imgflag
Select msg
Case #WM_SETCURSOR
button = GetDlgCtrlID_(wParam)
Select button
;setzt voraus das Konstanten bei Enumeration hintereinander liegen
;sonst halt einzeln aufführen
Case #butimg1 To #butimgEnd
;Maus berührt Image
If imgflag <> button
imgflag=button
myImageGadgetChg(button)
EndIf
Default
;Maus hat Image verlassen
If imgflag
imgflag=0
myImageGadgetChg(0)
EndIf
EndSelect ;von button Abfrage
EndSelect ;von msg
ProcedureReturn result
EndProcedure
Procedure myImageGadget(pbnr,sp,ze,br,hh,txt$,*ib.ImageGadgetDaten)
;Basiswerte festlegen
color_base = #Gray
color_text = #Black
fontid_text = GetStockObject_(#ANSI_VAR_FONT)
bright_base = 20
bright_step = 2
bright_flag = 2 ;=#CA_LOG_FILTER
rahmen_flag = #EDGE_BUMP ;#EDGE_ETCHED #EDGE_RAISED #EDGE_SUNKEN
rahmen_stil = #BF_RECT ;#BF_FLAT #BF_MONO #BF_SOFT
rahmen_dblx = 0
If *ib\color_base : color_base = *ib\color_base: EndIf
If *ib\color_text : color_text = *ib\color_text: EndIf
If *ib\fontid_text : fontid_text = *ib\fontid_text: EndIf
If *ib\brightness_base: bright_base = *ib\brightness_base: EndIf
If *ib\brightness_step: bright_step = *ib\brightness_step: EndIf
If *ib\brightness_flag: bright_flag = *ib\brightness_flag: EndIf
If *ib\drawrahmen_flag: rahmen_flag = *ib\drawrahmen_flag: EndIf
If *ib\drawrahmen_dblx: rahmen_dblx = *ib\drawrahmen_dblx: EndIf
If *ib\drawrahmen_stil: rahmen_stil = rahmen_stil | *ib\drawrahmen_stil: EndIf
imageID = CreateImage(pbnr,br,hh)
dc = StartDrawing(ImageOutput(pbnr))
;Hintergrund
If *ib\background_imgID
DrawImage(*ib\background_imgID,0,0,br,hh)
Else
;Grundfarbe
Box(0,0,br,hh,color_base)
;Icon angegeben ?
If *ib\icon_ID
GetIconInfo_(*ib\icon_ID,i.ICONINFO)
ibr=i\xHotspot*2
ihh=i\yHotspot*2
isp=7
ize=(hh-ihh)/2
DrawImage(*ib\icon_ID,isp,ize)
iconbreite=7+ibr+5
EndIf
;Helligkeit verändern
SetStretchBltMode_(dc,#HALFTONE)
ca.COLORADJUSTMENT
GetColorAdjustment_(dc,ca.COLORADJUSTMENT)
ca\caFlags=bright_flag
;GrundBrightness
ca\caBrightness=bright_base
SetColorAdjustment_(dc,ca.COLORADJUSTMENT)
StretchBlt_(dc, 0,0,br,hh,dc, 0,0,br,hh, #SRCCOPY)
;StufenBrightness = Farbverlauf
hhstreifen=bright_step
hhanzahl=hh/hhstreifen
brightnessabstand=200/hhanzahl
For j=1 To hhanzahl
ca\caBrightness=-100+(j*brightnessabstand)
SetColorAdjustment_(dc,ca.COLORADJUSTMENT)
zebright=hh-(j*hhstreifen)
StretchBlt_(dc,0,zebright,br,hhstreifen, dc,0,zebright,br,hhstreifen,#SRCCOPY)
Next
EndIf
;Textfont
SelectObject_(dc,fontid_text) ;oder DrawingFont(fontid)
;Text
SetBkMode_(dc,#TRANSPARENT)
SetTextColor_(dc,color_text)
SetTextAlign_(dc,#TA_TOP) ;ohne geht es nicht
SetRect_(r.RECT,0,0,br-iconbreite-2,hh) ;Basiswerte für rect; left,top,right,bottom
;berechne via Api die Größe von r.rect für den Text !!!
DrawText_(dc,txt$,-1,r,#DT_CALCRECT|#DT_WORDBREAK)
rsp=(br-r\right)/2 ;sp+ze um rect in die Mitte zu setzen
rze=(hh-r\bottom)/2
If iconbreite ;wenn Icon, direkt danach
rsp=iconbreite
EndIf
OffsetRect_(r,rsp,rze) ;setze r.rect an die richtige Position
DrawText_(dc,txt$,-1,r,#DT_CENTER|#DT_WORDBREAK)
;Rahmen
SetRect_(r.RECT,0,0,br,hh) ;left,top,right,bottom
DrawEdge_(dc,r,rahmen_flag,rahmen_stil)
If rahmen_dblx
x=rahmen_dblx
SetRect_(r.RECT,x,x,br-x,hh-x)
DrawEdge_(dc,r,rahmen_flag,rahmen_stil)
EndIf
StopDrawing()
ImageGadget(pbnr,sp,ze,br,hh,imageID)
EndProcedure
Procedure myImageGadgetChg(button)
Static Dim but(0)
Static buttonmax
Shared buttonnotchg_nr
;Feld anpassen
If button > buttonmax
buttonmax=button
ReDim but(button)
EndIf
;letztes Image wiederherstellen
For j=0 To buttonmax
If but(j)
If buttonnotchg_nr<>j
SetGadgetState(j,but(j))
but(j)=0
EndIf
EndIf
Next
If button=0 Or button=buttonnotchg_nr: ProcedureReturn: EndIf ;Maus hat Image verlassen
;Image merken
imgnr = GetGadgetState(button)
but(button)=imgnr
;Imagebutton ändern
If imgnr
br = GadgetWidth(button)
hh = GadgetHeight(button)
dc = GetDC_(GadgetID(button))
;Helligkeit verändern
SetStretchBltMode_(dc,#HALFTONE)
ca.COLORADJUSTMENT
GetColorAdjustment_(dc,ca.COLORADJUSTMENT)
ca\caFlags=#CA_LOG_FILTER
;ca\caRedGreenTint+50
SetColorAdjustment_(dc,ca.COLORADJUSTMENT)
StretchBlt_(dc, 0,0,br,hh,dc, 0,0,br,hh, #SRCCOPY) ; oder #NOTSRCCOPY = Image Invertieren
SetRect_(r.RECT,0,0,br,hh)
DrawEdge_(dc,r,#EDGE_SUNKEN,#BF_RECT)
ReleaseDC_(GadgetID(button),dc)
EndIf
EndProcedure
DataSection
Icon1: IncludeBinary #PB_Compiler_Home+"Examples\Sources - Advanced\MoviePlayer\Icons\Play.ico"
Icon2: IncludeBinary #PB_Compiler_Home+"Examples\Sources - Advanced\MoviePlayer\Icons\Pause.ico"
Bild1: IncludeBinary "C:\WINDOWS\Web\Wallpaper\Stonehenge.jpg"
Bild2: IncludeBinary "C:\WINDOWS\Web\Wallpaper\Karibiktraum.jpg"
Bild3: IncludeBinary "C:\WINDOWS\Web\Wallpaper\Fischkarawane.jpg"
EndDataSection