'ProgressBar.inc - Copyright © 2011-2012 by Julian Schmidt
'Kontakt und Support über:
'http://julian-schmidt.xprofan.com/
Proc CreateProgressBar
'Parameter 1 : Handle des übergeordneten Fensters
'Parameter 2 : 0=Horizontal
' 1=Vertikal
'Parameter 3 : 0=kein Rahmen
' 1=Rahmen
'Parameter 4,5 : Linke obere Ecke der ProgressBar
'Parameter 6,7 : Größe der ProgressBar
'Parameter 8 : Wertebereiche im Format "Startwert;Untergrenze;Obergrenze"
Parameters hwnd&,Ausrichtung&,Rahmen&,x1%,y1%,x2%,y2%,Range$
var CLASSNAME$="msctls_progress32"
var hdl&=External("USER32","CreateWindowExA",0,@addr(CLASSNAME$),0,$40000000+$10000000+Rahmen&*$800000+Ausrichtung&*4,x1%,y1%,x2%,y2%,hwnd&,0,%Hinstance,0)
Sendmessage(hdl&,$0400+1,0,MakeLong(Val(SubStr$(Range$,2,";")),Val(SubStr$(Range$,3,";"))))
Sendmessage(hdl&,$0400+2,Val(SubStr$(Range$,1,";")),0)
Return hdl&
EndProc
Proc SetDesignProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : 0=Standard Design alla Windows
' : 1=Eigenes Design
'Parameter 3 : Farbe des Ausgefüllten Bereichs
'Parameter 4 : Farbe des Unausgefüllten Bereichs
Parameters hdl&,stil&,color&,backgroundcolor&
if stil&=0
External("uxtheme.dll", "SetWindowTheme",hdl&, 0,0)
else
Declare W#
Dim W#, 2
External("uxtheme.dll", "SetWindowTheme",hdl&, W#, W#)
Sendmessage(hdl&,$0400+9,0,color&)
Sendmessage(hdl&,$2000+1,0,backgroundcolor&)
Dispose W#
Endif
Return 1
EndProc
Proc SetRangeProgressbar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : WerteBereich im Format "Obergrenze;Untergrenze"
' : Wenn -1 bei einer Grenze angegeben ist wird diese nicht gesetzt
Parameters hdl&,WerteBereich$
Sendmessage(hdl&,$0400+1,0,MakeLong(If(SubStr$(WerteBereich$,1,";")="-1",GetRangeProgressbar(hdl&,1),Val(SubStr$(WerteBereich$,1,";"))),If(SubStr$(WerteBereich$,2,";")="-1",GetRangeProgressbar(hdl&,2),Val(SubStr$(WerteBereich$,2,";")))))
Return 1
EndProc
Proc GetRangeProgressbar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : 1=Untergrenze
' 2=OberGrenze
'Ergebnis : Wertebereich der Progressbar im Format "Untergrenze;Obergrenze"
Parameters hdl&, mod%
Return Val(SubStr$(Str$(HiWord(SendMessage(hdl&,$0400+7,0,0)))+";"+Str$(LoWord(SendMessage(hdl&,$0400+7,0,0))),mod%,";"))
EndProc
Proc SetPosProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : Position auf die die Progressbar gesetzt wird
Parameters hdl&,pos&
Sendmessage(hdl&,$0400+2,pos&,0)
Return 1
EndProc
Proc GetPosProgressBar
'Parameter 1 : Handle der Progressbar
'Ergebnis : Gesetze Position der Progressbar
Parameters hdl&
Return SendMessage(hdl&,$0400+8,0,0)
EndProc
Proc StepUpProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : Schrittweite (Wenn nicht angegeben: 1)
Parameters hdl&,step&
case step&<1 : step&=1
case step&>SendMessage(hdl&,$0400+7,0,0) : step&=1
Sendmessage(hdl&,$0400+2,SendMessage(hdl&,$0400+8,0,0)+step&,0)
Return 1
EndProc
Proc StepDownProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : Schrittweite (Wenn nicht angegeben: 1)
Parameters hdl&,step&
case step&<1 : step&=1
case step&>SendMessage(hdl&,$0400+7,0,0) : step&=1
Sendmessage(hdl&,$0400+2,SendMessage(hdl&,$0400+8,0,0)-step&,0)
Return 1
EndProc
Proc SetPercentProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : Prozentzahl auf die die Progressbar gesetzt wird
Parameters hdl&,percent&
Sendmessage(hdl&,$0400+2,Round(((GetRangeProgressbar(hdl&,2)-GetRangeProgressbar(hdl&,1))*percent&)/100,0),0)
Return 1
EndProc
Proc GetPercentProgressBar
'Parameter 1 : Handle der Progressbar
'Ergebnis : Gesetze Position in Prozent der Progressbar
Parameters hdl&
Return Round((SendMessage(hdl&,$0400+8,0,0)/(GetRangeProgressbar(hdl&,2)-GetRangeProgressbar(hdl&,1)))*100,1)
EndProc
Proc PercentUpProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : Schrittweite in Prozent(Wenn nicht angegeben: 1)
Parameters hdl&,step&
case step&<1 : step&=1
case step&>100 : step&=1
Sendmessage(hdl&,$0400+2,SendMessage(hdl&,$0400+8,0,0)+(GetRangeProgressbar(hdl&,2)-GetRangeProgressbar(hdl&,1))*(step&/100),0)
Return 1
EndProc
Proc PercentDownProgressBar
'Parameter 1 : Handle der Progressbar
'Parameter 2 : Schrittweite in Prozent(Wenn nicht angegeben: 1)
Parameters hdl&,step&
case step&<1 : step&=1
case step&>100 : step&=1
Sendmessage(hdl&,$0400+2,SendMessage(hdl&,$0400+8,0,0)-(GetRangeProgressbar(hdl&,2)-GetRangeProgressbar(hdl&,1))*(step&/100),0)
Return 1
EndProc
Proc SetPosMinProgressBar
'Parameter 1 : Handle der Progressbar
Parameters hdl&
Sendmessage(hdl&,$0400+2,GetRangeProgressbar(hdl&,1),0)
Return 1
EndProc
Proc SetPosMaxProgressBar
'Parameter 1 : Handle der Progressbar
Parameters hdl&
Sendmessage(hdl&,$0400+2,GetRangeProgressbar(hdl&,2),0)
Return 1
EndProc
Proc SetProgressbarByMouse
'Parameter 1 : Handle der Progressbar
Parameters hdl&
Declare mpos#, b#
Dim mpos#,8
Dim b#,16
External("USER32", "GetWindowRect",hdl&,b#)
External("USER32","GetCursorPos",mpos#)
if (((long(mpos#,0)>Long(b#,0)) and (long(mpos#,0)<Long(b#,8))) and ((long(mpos#,4)>Long(b#,4)) and (long(mpos#,4)<Long(b#,12)))) and (External("User32","GetAsyncKeyState",1)<>0)
UseCursor If(If(Right$(Str$(GetStyle(hdl&,0)),1)="4",1,0)=0,9,10)
External("USER32","ScreenToClient",hdl&,mpos#)
SetPercentProgressBar(hdl&,If(If(Right$(Str$(GetStyle(hdl&,0)),1)="4",1,0)=0,((long(mpos#,If(If(Right$(Str$(GetStyle(hdl&,0)),1)="4",1,0)=0,0,4))/If(If(Right$(Str$(GetStyle(hdl&,0)),1)="4",1,0)=0,width(hdl&),height(hdl&)))*100)*2,100)-((long(mpos#,If(If(Right$(Str$(GetStyle(hdl&,0)),1)="4",1,0)=0,0,4))/If(If(Right$(Str$(GetStyle(hdl&,0)),1)="4",1,0)=0,width(hdl&),height(hdl&)))*100))
Endif
Dispose mpos#
Dispose b#
Return 1
EndProc
Proc IsCompletelyFilledProgressBar
'Parameter 1 : Handle der Progressbar
Parameters hdl&
Return If(SendMessage(hdl&,$0400+8,0,0)=GetRangeProgressbar(hdl&,2),1,0)
EndProc
Proc IsCompletelyBlankProgressBar
'Parameter 1 : Handle der Progressbar
Parameters hdl&
Return If(SendMessage(hdl&,$0400+8,0,0)=GetRangeProgressbar(hdl&,1),1,0)
EndProc