'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