XProfan

'(C) Andreas Miethe

If $Winver <> "6.1"

    Messagebox("Erst ab Windows7","Sorry...",0)
    End

Endif

Var Ole& = Importdll("ole32.dll","")
'##############################
'Interface ITaskbarList3
DEF &QueryInterface 0
DEF &AddRef 4
DEF &Release 8
DEF &HrInit 12
DEF &AddTab 16
DEF &DeleteTab 20
DEF &ActivateTab 24
DEF &SetActiveAlt 28
DEF &MarkFullscreenWindow 32
DEF &SetProgressValue 36'(Fensterhandle,ULONGLONG(Completed),ULONGLONG(Total))
DEF &SetProgressState 40'(Fensterhandle,Flags)
DEF &RegisterTab 44
DEF &UnregisterTab 48
DEF &SetTabOrder 52
DEF &SetTabActive 56
DEF &ThumbBarAddButtons 60
DEF &ThumbBarUpdateButtons 64
DEF &ThumbBarSetImageList 68
DEF &SetOverlayIcon 72
DEF &SetThumbnailTooltip 76
DEF &SetThumbnailClip 80
'##############################
DEF &TBPF_NoProgress $00
DEF &TBPF_Indeterminate $01
DEF &TBPF_Normal $02
DEF &TBPF_Error $04
DEF &TBPF_Paused $08
DEF &CLSCTX_INPROC_SERVER 1
DEF &CLSCTX_LOCAL_SERVER  4
DEF &CLSCTX_SERVER 5
Declare CLSID_TASKBARLIST#,IID_ITASKBARLIST#
DIM CLSID_TASKBARLIST#,16
'{56FDF344-FD6D-11D0-958A-006097C9A090}
Long CLSID_TASKBARLIST#,0  = $56FDF344
Word CLSID_TASKBARLIST#,4  = $FD6D, $11D0, $8A95
Byte CLSID_TASKBARLIST#,10 = $00, $60, $97, $C9, $A0, $90
DIM IID_ITASKBARLIST#,16
'{56FDF342-FD6D-11D0-958A-006097C9A090}
Long IID_ITASKBARLIST#,0  = $56FDF342
Word IID_ITASKBARLIST#,4  = $FD6D, $11D0, $8A95
Byte IID_ITASKBARLIST#,10 = $00, $60, $97, $C9, $A0, $90
Windowtitle "Fortschritt"
CLS
Var Ende& = 0
Var RunButton& = Create("Button",%hwnd,"Run",10,10,80,24)
Var EndButton& = Create("Button",%hwnd,"Ende",10,40,80,24)
Var TaskbarVTable& = 0
CoInitialize(0)
Var Retval& = CoCreateInstance(CLSID_TaskbarList#, 0, &CLSCTX_SERVER, IID_ITaskbarList#,Addr(TaskbarVTable&))

If Retval& = 0

    CallInterface(TaskbarVTable&,&HrInit)
    CallInterface(TaskbarVTable&,&SetProgressState,%hwnd,&TBPF_Normal)

Endif

Whilenot Ende&

    Waitinput

    If Clicked(RunButton&)

        Progress()

    ElseIf Clicked(EndButton&)

        CallInterface(TaskbarVTable&,&Release)
        CoUninitialize()
        FreeDll Ole&
        Ende& = 1

    Endif

Endwhile

Proc Progress

    Var Count& = 0
    Var Complete& = 1000
    Var Title$ = ""

    Repeat

        Inc Count&
        Title$ = Str$(Int(Count&/10))+" %"
        CallInterface(TaskbarVTable&,&SetProgressValue,%hwnd,Count&,0,Complete&,0)
        External("User32.dll","SetWindowTextA",%hwnd,Addr(Title$))
        Sleep 1

    Until Count& = 1000

    CallInterface(TaskbarVTable&,&SetProgressValue,%hwnd,0,0,1000,0)
    Windowtitle "Fortschritt"

Endproc

Proc CallInterFace

    Parameters VTable&,Funktion&
    Case %pCount = 2 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&)
    Case %pCount = 3 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&,&(3))
    Case %pCount = 4 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&,&(3),&(4))
    Case %pCount = 5 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&,&(3),&(4),&(5))
    Case %pCount = 6 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&,&(3),&(4),&(5),&(6))
    Case %pCount = 7 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&,&(3),&(4),&(5),&(6),&(7))
    Case %pCount = 8 : Return Call(Long(Long(VTable&,0),Funktion&),VTable&,&(3),&(4),&(5),&(6),&(7),&(8))

EndProc

'abschalten per CallInterface(TaskbarVTable&,&SetProgressState,%hwnd,&TBPF_NoProgress)