XProfan

 $H Windows.ph
Var ole& = ImportDll("ole32.dll","")
Var oleaut& = ImportDll("oleaut32.dll","")
Declare bString1$

Proc Ansi2Uni

    Parameters s$
    Var Unicode$ = Space$((Len(S$)*2)+1)
    ~MultiByteToWideChar(0,0,Addr(S$),-1,Addr(Unicode$),Len(Unicode$))
    SysFreeString(bString1$)
    SysFreeString(bString1$)
    bString1$ = SysAllocString(addr(Unicode$))
    Return bString1$

EndProc

DEF &CLSCTX_INPROC_SERVER 1
DEF &PROGDLG_NORMAL 0
DEF &PROGDLG_AUTOTIME 2
DEF &PROGDLG_MODAL 1
DEF &PDTIMER_RESET 1
DEF &IDA_COPY_ANIMATION  160
Interface IProgressDialog
DEF &QueryInterface 0
DEF &AddRef 4
DEF &Release 8
DEF &StartProgressDialog 12
DEF &StopProgressDialog 16
DEF &SetTitle 20
DEF &SetAnimation 24
DEF &HasUserCancelled 28
DEF &SetProgress 32
DEF &SetProgress64 36
DEF &SetLine 40
DEF &SetCancelMsg 44
DEF &Timer 48
Var ProgressLimit& = 5000
Declare CLSID_ProgressDialog#,IID_IProgressDialog#
Dim CLSID_ProgressDialog#,16
Dim IID_IProgressDialog#,16
LONG CLSID_ProgressDialog#,0 = $f8383852
WORD CLSID_ProgressDialog#,4 = $fcd3, $11d1
BYTE CLSID_ProgressDialog#,8 = $a6, $b9, 0, $60, $97, $df, $5b, $d4
LONG IID_IProgressDialog#,0 = $ebbc7c04
WORD IID_IProgressDialog#,4 = $315e, $11d2
BYTE IID_IProgressDialog#,8 = $b6, $2f, 0, $60, $97, $df, $5b, $d4
Var X& = 0
Var dwCompleted& = 0
Var ppv& = 0
cls
CoInitialize(0)
Var hr& = CoCreateInstance(CLSID_ProgressDialog#, 0, &CLSCTX_INPROC_SERVER, IID_IProgressDialog#,Addr(ppv&))

If hr& = ~S_OK

    Var Command& = LONG(ppv&,0)
    Call(Long(Command&,&SetTitle),ppv&,Ansi2Uni("System Fotschritt-Dialogbox"))
    Var hShell& = UseDll("shell32.dll")

    If hShell&

        Call(Long(Command&,&SetAnimation),ppv&,hShell&,&IDA_COPY_ANIMATION)

    EndIf

    Call(Long(Command&,&Timer),ppv&,&PDTIMER_RESET,0)
    Call(Long(Command&,&SetCancelMsg),ppv&,Ansi2Uni("Cancel"), 0)
    Call(Long(Command&,&SetLine),ppv&,1, Ansi2Uni("System Fortschritt-Dialog Test mit XProfan"), 1,0)
    Call(Long(Command&,&StartProgressDialog),ppv&,%hwnd, 0, &PROGDLG_NORMAL | &PROGDLG_AUTOTIME | &PROGDLG_MODAL, 0)

    Repeat

        If Call(Long(Command&,&HasUserCancelled),ppv&)

            Call(Long(Command&,&StopProgressDialog),ppv&)
            MessageBox("Fortschritt abgebrochen","Meldung",0)
            Break

        Else

            Call(Long(Command&,&SetProgress),ppv&, dwCompleted&, ProgressLimit&)

            If dwCompleted& >= ProgressLimit&

                Call(Long(Command&,&StopProgressDialog),ppv&)
                MessageBox("Fortschritt komplett","Meldung",0)
                Break

            Else

                Call(Long(Command&,&SetLine),ppv&,2, Ansi2Uni("Wir sind jetzt hier : "+Str$(dwCompleted&)+" von "+str$(ProgressLimit&)), 1, 0)
                an dieser Stelle könnte man eine Kopierfunktion
                oder irgenwelche Berechnungen einbauen, statt nur einen Zähler laufen zu lassen.
                Inc dwCompleted&

            EndIf

        EndIf

        Sleep 10  je kleiner die Pause, umso schneller der Fortschritt

    Until X& =1

    Call(Long(Command&,&Release),ppv&)
    Dispose CLSID_ProgressDialog#,IID_IProgressDialog#
    SysFreeString(bString1$)

EndIf

CoUninitialize()
FreeDll Ole&
Freedll oleaut&
waitinput
end