XProfan

Français
Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
ProgressBar (1)  - Fortschrittsbalken -
(C) 2006 Nico Madysa
------ TPROGRESSBAR.INC -----------------------------------------------------------------------------------------------
Def SysMetrics(1)   !USER32,GetSystemMetrics
Def CaptionX(1) %(1) + (SysMetrics(7) * 2            )
Def CaptionY(1) %(1) + (CaptionX(0)   + SysMetrics(4))
Def CenterX(1)  (%MaxX - CaptionX(%(1)) ) / 2
Def CenterY(1)  (%MaxY - CaptionY(%(1)) ) / 2
Eine ProgressBar
Class ProgressBar = -handle& , #MaxVal% , #ActVal% , GetHandle@, Destroy@,
ProgressBar@ , RaiseVal@ , SetVal@ , LowerVal@ , GetVal@
ProgressBar
Konstruktor einer Progressbar
pWnd&   : übergeordnetes Fenster
dir%    : 0 = horizontale Füllrichtung
1 = vertikale Füllrichtung
mode%   : 0 = Kästchen-Füllung
1 = fließend füllen
x%,y%   : Koordinaten der oberen, linken Ecke
dx%,dy% : Länge und Breite der ProgressBar
max%    : Füllschritte(bei z.B. 200 Dateien muss die Leiste
in 200 Schritten gefüllt werden)
Result  : Handle der ProgrssBar(eigentlich eher unwichtig)

proc ProgressBar.ProgressBar

    parameters pWnd& , dir% , mode% , x% , y% , dx% , dy% , Max%
    declare style&
    case (max% <= 0) : max% = 100
    style& = $50800000 + if(dir%,4,0) + if(mode%,1,0)
    .handle& = Control(msctls_progress32,$(3),style&,x%,y%,dx%,dy%,pWnd&,101,%hInstance)
    .MaxVal% = max%
    .ActVal% = 0
    Return .handle&

endproc

GetHandle
Liefert das Handle der ProgressBar(eigentlich eher unwichtig)
Result  : Handleder Progressbar

proc ProgressBar.GetHandle

    Return .handle&

endproc

RaiseVal
Füllt die ProgressBar
x%     : Wert, um den die Bar gefüllt wird(Die Bar zeigt an,
wie viele Prozente der aktulle Wert vom maximalen beträgt)
Result : momentaner Wert oder -1 bei Fehler

proc ProgressBar.RaiseVal

    parameters x%
    declare val% , res%
    .ActVal% = .ActVal% + x%

    if .ActVal% > .MaxVal%

        .ActVal% = .MaxVal%

    endif

    val% = (.ActVal% * 100) / .MaxVal%
    res% = Sendmessage(.handle&,$402,val%,0)
    case    res% : Return .ActVal%
    casenot res% : Return (-1)

endproc

LowerVal
Leert die ProgressBar
x%     : Wert, um den die Bar geleert wird(Die Bar zeigt an,
wie viele Prozente der aktulle Wert vom maximalen beträgt)
Result : momentaner Wert oder -1 bei Fehler

proc ProgressBar.LowerVal

    parameters x%
    declare val% , res%

    if .ActVal% > x%

        .ActVal% = .ActVal% - x%

    else

        .ActVal% = 0

    endif

    val% = (.ActVal% * 100) / .MaxVal%
    res% = Sendmessage(.handle&,$402,val%,0)
    case    res% : Return .ActVal%
    casenot res% : Return (-1)

endproc

RaiseVal
Setzt den Wert der ProgressBar
x%     : Wert, auf den .Actval% gesetzt wird(Die Bar zeigt an,
wie viele Prozente der aktulle Wert vom maximalen beträgt)
Result : momentaner Wert oder -1 bei Fehler

proc ProgressBar.SetVal

    parameters x%
    declare val% , res%
    .ActVal% = x%

    if .ActVal% < 0

        .Actval% = 0

    elseif .ActVal% > .MaxVal%

        .ActVal% = .MaxVal%

    endif

    val% = (.ActVal% * 100) / .MaxVal%
    res% = Sendmessage(.handle&,$402,val%,0)
    case    res% : Return .ActVal%
    casenot res% : Return (-1)

endproc

GetVal
Gibt den momentanen Wert der ProgressBar zurück.
Selber Effekt wie ProgressBar.RaiseVal(0)
Result : momentaner Wert

proc ProgressBar.GetVal

    Return .ActVal%

endproc

Destroy
Destruktor-Methode

proc ProgressBar.Destroy

    parameters class#

    if Upper$(ClassOf(class#)) = PROGRESSBAR

        DestroyWindow(class#.GetHandle())
        dispose class#
        return 1

    elseif Upper$(ClassOf(class#)) = PROGRESSBARWINDOW

        DestroyWindow(.hDia&)
        dispose class#
        return 1

    else

        return 0

    endif

endproc

Eine Dialogbox mit ProgressBar
von ProgressBar abgeleitet
Class ProgressBarWindow = ProgressBar , -handle& , -hdia& , -ht& , -valincpt%,
ProgressBarWindow@ , SetCaption@ , GetCaption@ ,
SetWText@ , GetWText@ , GetHandle@ , RaiseVal@ ,
SetVal@ , LowerVal@ , ValToCaption@ , DelCaptionVal@ ,
ValInCaption@
ProgressBarWindow
Konstruktor-Methode
pWnd&    : übergeordnetes Fenster der Dialogbox
caption$ : Titel der Dialogbox
text$    : evtl. erläuternder Text
mode%    : 0 = Kästchen-Füllung
1 = fließendes Füllen
x% , y%  : obere linke Ecke der Dialogbox
max%     : maximaler Wert der ProgressBar (bei actval = maxval ist
die ProgressBar voll)
Result   : Handle der Dialogbox

proc ProgressBarWindow.ProgressBarWindow

    parameters pWnd& , caption$ , text$ , mode% , x% , y% , max%
    declare style& , dx% , dy%
    style& = $50800000 + if(mode%,1,0)
    .hdia&   = Create(Dialog,pWnd& ,caption$,%MaxX,%MaxY,225,90)
    .ht&     = Create(Text  ,.hdia&,text$   ,5    ,5    ,215,50)
    .handle& = Control(msctls_progress32,$(3),style&,5,60,215,25,.hdia&,101,%hInstance)
    .MaxVal% = max%
    .ActVal% = 0
    dx% = 450 -  width(.hdia&)
    dy% = 180 - height(.hdia&)
    SetWindowPos .hdia& = x% , y% - dx% , dy% ; 0
    Return .hdia&

endproc

SetCaption
Setzt den Titel der Dialogbox
caption$ : Neuer Titel

proc ProgressBarWindow.SetCaption

    parameters caption$
    declare ncap$ , val%
    ncap$ = caption$
    val% = (.Actval% * 100) / .MaxVal%

    if .valincpt%

        ncap$ = ncap$ +  -  + str$(val%) + %

    endif

    SetText .hdia& , ncap$

endproc

GetCaption
Liest den Titel der Dialogbox aus
Result : Titel

proc ProgressBarWindow.GetCaption

    declare hpbw& , cpt$
    hpbw& = .hdia&
    cpt$  = Gettext$(hpbw&)
    Return cpt$

endproc

SetWText
Setzt den erläuternden Text IN der Dialogbox
text$ : neuer Text

proc ProgressBarWindow.SetWText

    parameters text$
    SetText .ht& , text$

endproc

GetWText
Liest den erläuternden Text aus
Result : erläuternder Text

proc ProgressBarWindow.GetWText

    Return GetText$(.ht&)

endproc

GetHandle
Liefert das Handle der Dialogbox
Result : Handle der DialogBox

proc ProgressBarWindow.GetHandle

    Return .hdia&

endproc

ValToCaption
Der momentane Prozentsatz wird in der Titelzeile angezeigt

proc ProgressBarWindow.ValToCaption

    ifnot .valincpt%

        .SetCaption(.GetCaption()+ - +str$(.ActVal%)+%)
        .valincpt% = 1

    endif

endproc

DelCaptionVal
Der Prozentsatz wird wieder aus der Titelzeile entfernt

proc ProgressBarWindow.DelCaptionVal

    declare cpt$

    if .valincpt%

        cpt$ = .GetCaption()

        if .ActVal% >= 100  7(3) Stellen weg

            cpt$ = Left$(cpt$,len(cpt$)-7)

        elseif .ActVal% >= 10  6(2) Stellen weg

            cpt$ = Left$(cpt$,len(cpt$)-6)
            else  5(1) Stellen weg
            cpt$ = Left$(cpt$,len(cpt$)-5)

        endif

        .valincpt% = 0

    endif

endproc

ValInCaption
Fragt ab, ob der momentane Prozentsatz in der Titelzeile
angezeigt wird.
ValToCaption und DelCaptionVal beachtetn dies bereits!

proc ProgressBarWindow.ValInCaption

    return .valincpt%

endproc

RaiseVal
Füllt die ProgressBar
x%     : Wert, um den die Bar gefüllt wird(Die Bar zeigt an,
wie viele Prozente der aktulle Wert vom maximalen beträgt)
Result : momentaner Wert oder -1 bei Fehler

proc ProgressBarWindow.RaiseVal

    parameters x%
    declare val% , res% , exval% , c$
    exval% = (.ActVal% * 100) / .MaxVal%
    .ActVal% = .ActVal% + x%

    if .ActVal% > .MaxVal%

        .ActVal% = .MaxVal%

    endif

    val% = (.ActVal% * 100) / .MaxVal%
    res% = Sendmessage(.handle&,$402,val%,0)

    if .valincpt%

        c$ = .GetCaption()

        if exval% >= 100

            c$ = Left$(c$,len(c$) - 7)

        elseif exval% >= 10

            c$ = Left$(c$,len(c$) - 6)

        else

            c$ = Left$(c$,len(c$) - 5)

        endif

        .SetCaption(c$)

    endif

    case    res% : Return .ActVal%
    casenot res% : Return (-1)

endproc

LowerVal
Leert die ProgressBar
x%     : Wert, um den die Bar geleert wird(Die Bar zeigt an,
wie viele Prozente der aktulle Wert vom maximalen beträgt)
Result : momentaner Wert oder -1 bei Fehler

proc ProgressBarWindow.LowerVal

    parameters x%
    declare val% , res% , exval% , c$
    exval% = (.ActVal% * 100) / .MaxVal%
    .ActVal% = .ActVal% - x%

    if .ActVal% < 0

        .ActVal% = 0

    endif

    val% = (.ActVal% * 100) / .MaxVal%
    res% = Sendmessage(.handle&,$402,val%,0)

    if .valincpt%

        c$ = .GetCaption()

        if exval% >= 100

            c$ = Left$(c$,len(c$) - 7)

        elseif exval% >= 10

            c$ = Left$(c$,len(c$) - 6)

        else

            c$ = Left$(c$,len(c$) - 5)

        endif

        .SetCaption(c$)

    endif

    case    res% : Return .ActVal%
    casenot res% : Return (-1)

endproc

RaiseVal
Setzt den Wert der ProgressBar
x%     : Wert, auf den .Actval% gesetzt wird(Die Bar zeigt an,
wie viele Prozente der aktulle Wert vom maximalen beträgt)
Result : momentaner Wert oder -1 bei Fehler

proc ProgressBarWindow.SetVal

    parameters x%
    declare val% , res% , exval% , c$
    exval% = (.ActVal% * 100) / .MaxVal%
    .ActVal% = .ActVal% + x%

    if .ActVal% > .MaxVal%

        .ActVal% = .MaxVal%

    elseif .ActVal < 0

        .Actval% = 0

    endif

    val% = (.ActVal% * 100) / .MaxVal%
    res% = Sendmessage(.handle&,$402,val%,0)

    if .valincpt%

        c$ = .GetCaption()

        if exval% >= 100

            c$ = Left$(c$,len(c$) - 7)

        elseif exval% >= 10

            c$ = Left$(c$,len(c$) - 6)

        else

            c$ = Left$(c$,len(c$) - 5)

        endif

        .SetCaption(c$)

    endif

    case    res% : Return .ActVal%
    casenot res% : Return (-1)

endproc

Für Methoden von ProgressBarWindow, die nicht überladen wurden,
gilt dasselbe, wie für die gleichnamigen Methoden von ProgressBar
Ende der Include-Datei
------------------------------------------------------------------------------------------------------
declare se& , pb1# , pb2# , pb3# , pb4#
WindowStyle 30 + 512
WindowTitle Demo zur TProgressBar.inc von Timo Madysa
cls External(User32,GetSysColor,15)
se& = Create(SpinEdit,%hWnd,0;0;100,5,5,100,20)
SetStyle se& , GetStyle(se&) | $8000
pb1# = New(ProgressBar,%hWnd,0,0,5,30,200,20,100)
pb2# = New(ProgressBar,%hWnd,0,1,5,55,200,20,100)
pb3# = New(ProgressBar,%hWnd,1,0,210,5,20,200,100)
pb4# = New(ProgressBar,%hWnd,1,1,235,5,20,200,100)

whilenot IsKey(27) or (%Key = 2)

    waitinput
    pb1#.SetVal(val(GetText$(se&)))
    pb2#.SetVal(val(GetText$(se&)))
    pb3#.SetVal(val(GetText$(se&)))
    pb4#.SetVal(val(GetText$(se&)2>))

Wend

Dispose pb1#
Dispose pb2#
Dispose pb3#
Dispose pb4#
end