Here is a code for coloring XP skin progressbar with animation remaining intact.
We developed it last year in german forum. Idea by RSBasic and some help by Danilo.
Code: Select all
EnableExplicit
Define EventID
Procedure ColorRotation(x, y, Color, Color2)
;ProcedureReturn RGBA(Green(Color), Blue(Color), Red(Color), Alpha(Color));Rot
ProcedureReturn RGBA(Red(Color), Blue(Color), Green(Color), Alpha(Color));Blau
;ProcedureReturn RGBA(Blue(Color), Green(Color), Green(Color), Alpha(Color));Türkis
;ProcedureReturn RGBA(Blue(Color), Blue(Color), Blue(Color), Alpha(Color));Schwarz
;ProcedureReturn RGBA(Green(Color), Green(Color), Red(Color), Alpha(Color));Gelb
EndProcedure
Procedure CaptureGadget(Gadgetnummer)
Protected width, height
Protected hdc
width = GadgetWidth(Gadgetnummer)
height = GadgetHeight(Gadgetnummer)
CreateImage(0, width, height, 24)
hdc = StartDrawing(ImageOutput(0))
;PrintWindow_(GadgetID(Gadgetnummer), hdc, #Null)
SendMessage_(GadgetID(Gadgetnummer),#WM_PRINT,hDC,#PRF_CHILDREN|#PRF_CLIENT|#PRF_ERASEBKGND)
StopDrawing()
CreateImage(1, width, height, 24)
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@ColorRotation())
DrawImage(ImageID(0), 0, 0)
StopDrawing()
EndProcedure
Procedure Thread(z);Beispiel
Protected a
Repeat
a+1
If a <= 100
SetGadgetState(1,a)
EndIf
CaptureGadget(1)
SetGadgetState(2,ImageID(1))
Delay(30)
Until a = 200
EndProcedure
If OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ProgressBarGadget(1,10,10,WindowWidth(0)-20,20,0,100,0)
HideGadget(1,1)
ImageGadget(2,10,10,0,0,0,0)
CreateThread(@Thread(),0)
Repeat
EventID=WaitWindowEvent()
If EventID = #PB_Event_CloseWindow
End
EndIf
ForEver
EndIf
The XP skin animation moves slow and smooth, so we updated the progressbar
longer after setting SetGadgetState to the maximum value. It is done in the little thread.
While working on the above code we wrote also 2 alternatives, one with colors
and one by using images (but without the highlight animation).
With colors:
Code: Select all
EnableExplicit
Structure MyProgressBarData
oldCallback.i
color1.l
color2.l
color3.l
vertical.l
EndStructure
Procedure MyProgressBarCallback(hWnd,msg,wParam,lParam)
Protected *mem.MyProgressBarData
Protected w, h, state, range, minValue, p.f
Protected hDC, brush, ps.PAINTSTRUCT
Protected gadget = GetWindowLongPtr_(hWnd,#GWLP_ID)
*mem = GetGadgetData(gadget)
If Not *mem : ProcedureReturn DefWindowProc_(hWnd,msg,wParam,lParam) : EndIf
w = GadgetWidth(gadget)
h = GadgetHeight(gadget)
If msg = #WM_ERASEBKGND
hDC = wParam
If *mem\color3 <> -1
SelectObject_(hDC, GetStockObject_(#NULL_PEN))
brush = CreateSolidBrush_(*mem\color3)
SelectObject_(hDC, brush)
Rectangle_(hDC,0,0,w,h+1)
DeleteObject_(brush)
ProcedureReturn #True
EndIf
ElseIf msg = #WM_PAINT
hDC = BeginPaint_(hWnd,@ps)
state = GetGadgetState(gadget) - minValue
range = GetGadgetAttribute(gadget,#PB_ProgressBar_Maximum) - minValue
If range < 0 : range = -range : EndIf
p = (state / range)
w = Int(w * p)
SetBkMode_(hDC,#TRANSPARENT)
SelectObject_(hDC, GetStockObject_(#NULL_PEN))
brush = CreateSolidBrush_(*mem\color1)
SelectObject_(hDC, brush)
Rectangle_(hDC,0,0,w,h+1)
DeleteObject_(brush)
brush = CreateSolidBrush_(*mem\color2)
SelectObject_(hDC, brush)
Rectangle_(hDC,0,0,w,Int(h*0.4))
DeleteObject_(brush)
EndPaint_(hWnd,@ps)
ProcedureReturn 0
EndIf
If *mem\oldCallback
ProcedureReturn CallWindowProc_(*mem\oldCallback,hWnd,msg,wParam,lParam)
EndIf
EndProcedure
Procedure MyProgressBarGadget(gadget, x, y, Width, Height, Minimum, Maximum, Flags=0)
Protected *mem.MyProgressBarData
Protected g
g = ProgressBarGadget(gadget,x,y,Width,Height,Minimum,Maximum,Flags)
If gadget = #PB_Any
gadget = g
EndIf
*mem = AllocateMemory(SizeOf(MyProgressBarData))
If *mem
*mem\oldCallback = SetWindowLongPtr_(GadgetID(gadget),#GWLP_WNDPROC,@MyProgressBarCallback())
*mem\color1 = RGB($00,$FF,$00)
*mem\color2 = RGB($A0,$FF,$A0)
*mem\color3 = -1
*mem\vertical = Flags & #PB_ProgressBar_Vertical
SetGadgetData(gadget,*mem)
EndIf
ProcedureReturn g
EndProcedure
Procedure MyProgressBarColor(gadget,color1,color2,color3=-1)
Protected *mem.MyProgressBarData
If IsGadget(gadget) And GadgetType(gadget)=#PB_GadgetType_ProgressBar
*mem = GetGadgetData(gadget)
If *mem
*mem\color1 = color1
*mem\color2 = color2
*mem\color3 = color3
InvalidateRect_(GadgetID(gadget),0,1)
EndIf
EndIf
EndProcedure
Define EventID, state, bar3
If OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
MyProgressBarGadget(1,10,10,WindowWidth(0)-20,20,0,100)
MyProgressBarGadget(2,10,50,WindowWidth(0)-20,20,0,150)
MyProgressBarColor(2,RGB($FF,$00,$00),RGB($FF,$A0,$A0),RGB($00,$00,$00))
bar3 = MyProgressBarGadget(#PB_Any,10,90,WindowWidth(0)-20,20,0,200)
MyProgressBarColor(bar3,RGB($00,$00,$FF),RGB($80,$80,$FF),RGB($FF,$FF,$80))
AddWindowTimer(0,0,33)
Repeat
EventID=WaitWindowEvent()
If EventID = #PB_Event_CloseWindow
End
ElseIf EventID = #PB_Event_Timer
state + 1
SetGadgetState(1,state)
SetGadgetState(2,state)
SetGadgetState(bar3,state)
If state = 100
RemoveWindowTimer(0,0)
EndIf
EndIf
ForEver
EndIf
With images:
Code: Select all
EnableExplicit
Structure MyProgressBarData
oldCallback.i
imageID.i
backColor.l
vertical.l
EndStructure
Procedure MyProgressBarCallback(hWnd,msg,wParam,lParam)
Protected *mem.MyProgressBarData
Protected w, h, state, range, minValue, p.f
Protected hDC, brush, ps.PAINTSTRUCT
Protected gadget = GetWindowLongPtr_(hWnd,#GWLP_ID)
*mem = GetGadgetData(gadget)
If Not *mem : ProcedureReturn DefWindowProc_(hWnd,msg,wParam,lParam) : EndIf
w = GadgetWidth(gadget)
h = GadgetHeight(gadget)
If msg = #WM_ERASEBKGND
hDC = wParam
If *mem\backColor <> -1
SelectObject_(hDC, GetStockObject_(#NULL_PEN))
brush = CreateSolidBrush_(*mem\backColor)
SelectObject_(hDC, brush)
Rectangle_(hDC,0,0,w,h+1)
DeleteObject_(brush)
ProcedureReturn #True
EndIf
ElseIf msg = #WM_PAINT
hDC = BeginPaint_(hWnd,@ps)
state = GetGadgetState(gadget) - minValue
range = GetGadgetAttribute(gadget,#PB_ProgressBar_Maximum) - minValue
If range < 0 : range = -range : EndIf
p = (state / range)
w = Int(w * p)
If *mem\imageID
brush = CreatePatternBrush_(*mem\imageID)
SelectObject_(hDC, brush)
PatBlt_(hDC,0,0,w,h+1,#PATCOPY)
;Rectangle_(hDC,0,0,w,h)
DeleteObject_(brush)
EndIf
EndPaint_(hWnd,@ps)
ProcedureReturn 0
EndIf
If *mem\oldCallback
ProcedureReturn CallWindowProc_(*mem\oldCallback,hWnd,msg,wParam,lParam)
EndIf
EndProcedure
Procedure MyProgressBarGadget(gadget, x, y, Width, Height, Minimum, Maximum, Flags=0)
Protected *mem.MyProgressBarData
Protected g
g = ProgressBarGadget(gadget,x,y,Width,Height,Minimum,Maximum,Flags)
If gadget = #PB_Any
gadget = g
EndIf
*mem = AllocateMemory(SizeOf(MyProgressBarData))
If *mem
*mem\oldCallback = SetWindowLongPtr_(GadgetID(gadget),#GWLP_WNDPROC,@MyProgressBarCallback())
*mem\backColor = -1
*mem\vertical = Flags & #PB_ProgressBar_Vertical
SetGadgetData(gadget,*mem)
EndIf
ProcedureReturn g
EndProcedure
Procedure StyleMyProgressBar(gadget,imageID,backColor=-1)
Protected *mem.MyProgressBarData
If IsGadget(gadget) And GadgetType(gadget)=#PB_GadgetType_ProgressBar
*mem = GetGadgetData(gadget)
If *mem
*mem\backColor = backColor
*mem\imageID = imageID
InvalidateRect_(GadgetID(gadget),0,1)
EndIf
EndIf
EndProcedure
Define EventID, state, bar3
Define i
CreateImage(1,1,20)
If StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(RGB($FF,$FF,$FF))
FrontColor(RGB($00,$FF,$00))
GradientColor(0.2,RGB($A0,$FF,$A0))
LinearGradient(0, 0, 0, 20)
Box(0,0,1,20)
StopDrawing()
EndIf
CreateImage(2,1,20)
If StartDrawing(ImageOutput(2))
Box(0,0,1,20,RGB($00,$00,$FF))
For i = 2 To 20 Step 5
Plot(0,i,RGB($FF,$FF,$00))
Next
StopDrawing()
EndIf
CreateImage(3,10,20)
If StartDrawing(ImageOutput(3))
Box(0,0,10,20,RGB($FF,$00,$00))
LineXY(0,0,10,20,RGB($FF,$FF,$FF))
StopDrawing()
EndIf
If OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
MyProgressBarGadget(1,10,10,WindowWidth(0)-20,20,0,100)
StyleMyProgressBar(1,ImageID(1))
MyProgressBarGadget(2,10,50,WindowWidth(0)-20,20,0,150)
StyleMyProgressBar(2,ImageID(2),RGB($00,$00,$00))
bar3 = MyProgressBarGadget(#PB_Any,10,90,WindowWidth(0)-20,20,0,200)
StyleMyProgressBar(bar3,ImageID(3),RGB($FF,$FF,$80))
AddWindowTimer(0,0,33)
Repeat
EventID=WaitWindowEvent()
If EventID = #PB_Event_CloseWindow
End
ElseIf EventID = #PB_Event_Timer
state + 1
SetGadgetState(1,state)
SetGadgetState(2,state)
SetGadgetState(bar3,state)
If state = 100
RemoveWindowTimer(0,0)
EndIf
EndIf
ForEver
EndIf