program metroupdate;
uses SysUtils,messages, windows, classes, CommCtrl, xpman, ComObj;
type
ULONGLONG = UInt64;
TTipString =
array[0..259]
of WideChar;
PTipString = ^TTipString;
tagTHUMBBUTTON =
packed record
dwMask
: DWORD;
iId
, iBitmap
: UINT;
hIcon
: HICON;
szTip
: TTipString;
dwFlags
: DWORD;
end;
THUMBBUTTON = tagTHUMBBUTTON;
THUMBBUTTONLIST = ^THUMBBUTTON;
ITaskbarList =
interface
['
{56FDF342-FD6D-11D0-958A-006097C9A090}']
procedure HrInit;
safecall;
procedure AddTab(hwnd: Cardinal);
safecall;
procedure DeleteTab(hwnd: Cardinal);
safecall;
procedure ActivateTab(hwnd: Cardinal);
safecall;
procedure SetActiveAlt(hwnd: Cardinal);
safecall;
end;
ITaskbarList2 =
interface(ITaskbarList)
['
{602D4995-B13A-429B-A66E-1935E44F4317}']
procedure MarkFullscreenWindow(hwnd: Cardinal; fFullscreen: Bool);
safecall;
end;
ITaskbarList3 =
interface(ITaskbarList2)
['
{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}']
procedure SetProgressValue(hwnd: Cardinal; ullCompleted, ullTotal: ULONGLONG);
safecall;
procedure SetProgressState(hwnd: Cardinal; tbpFlags: DWORD);
safecall;
procedure RegisterTab(hwndTab: Cardinal; hwndMDI: Cardinal);
safecall;
procedure UnregisterTab(hwndTab: Cardinal);
safecall;
procedure SetTabOrder(hwndTab: Cardinal; hwndInsertBefore: Cardinal);
safecall;
procedure SetTabActive(hwndTab: Cardinal; hwndMDI: Cardinal; tbatFlags: DWORD);
safecall;
procedure ThumbBarAddButtons(hwnd: Cardinal; cButtons: UINT; Button: THUMBBUTTONLIST);
safecall;
procedure ThumbBarUpdateButtons(hwnd: Cardinal; cButtons: UINT; pButton: THUMBBUTTONLIST);
safecall;
procedure ThumbBarSetImageList(hwnd: Cardinal; himl: Cardinal);
safecall;
procedure SetOverlayIcon(hwnd: Cardinal; hIcon: HICON; pszDescription: LPCWSTR);
safecall;
procedure SetThumbnailTooltip(hwnd: Cardinal; pszTip: LPCWSTR);
safecall;
procedure SetThumbnailClip(hwnd: Cardinal; prcClip: PRect);
safecall;
end;
var hwndProgress : DWord;
hWndFont : HFONT;
FTaskbarList : ITaskbarList;
FTaskbarList2 : ITaskbarList2;
FTaskbarList3 : ITaskbarList3;
FensterH : HWND;
function InitCommonControl(
CC: Integer): Boolean;
var
ICC: TInitCommonControlsEx;
begin
ICC.dwSize := SizeOf(TInitCommonControlsEx);
ICC.dwICC :=
CC;
Result := InitCommonControlsEx(ICC);
if not Result
then InitCommonControls;
end;
function CompareMD5(A, B : TMD5Digest) : Boolean;
var I : Integer;
begin
Result := True;
for I := 0
to 16 - 1
do
if A[I] <> A[I]
then
begin
Result := False;
Exit;
end;
end;
const
CLSID_TaskbarList: TGUID = '
{56FDF344-FD6D-11D0-958A-006097C9A090}';
CLSID_TaskbarList2: TGUID = '
{602D4995-B13A-429B-A66E-1935E44F4317}';
CLSID_TaskbarList3: TGUID = '
{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}';
//Warum das eigentlich?
ICC_PROGRESS_CLASS = $00000020;
//Brauch nur normal und keine xD
TBPF_NOPROGRESS = $00;
TBPF_NORMAL = $02;
ClassName = '
TTest';
Window1Name = '
Test';
WindowWidth = 270;
WindowHeight = 15;
function WndProc(hWnd: HWND; uMsg: UINT; wParam: wParam; lParam: LParam):
lresult;
stdcall;
var
x, y,FormHeight,FormWidth : integer;
begin
Result := 0;
case uMsg
of
WM_CREATE:
begin
x := GetSystemMetrics(SM_CXSCREEN);
y := GetSystemMetrics(SM_CYSCREEN);
FormHeight := 10 + WindowHeight + (GetSystemMetrics(SM_CYCAPTION)) + (2 * GetSystemMetrics(SM_CYDLGFRAME)) + 10;
FormWidth := 10 + WindowWidth + (2 * GetSystemMetrics(SM_CXDLGFRAME)) + 10;
MoveWindow(hWnd, (x
div 2) - (FormWidth
div 2),
(y
div 2) - ((FormHeight)
div 2),
FormWidth, FormHeight, true);
hwndProgress := CreateWindowEx(0,PROGRESS_CLASS,
nil,
WS_CHILD
or WS_VISIBLE
or PBS_SMOOTH,10,10,270,15,hwnd,
0,hInstance,
nil);
//Brauch ich, da ich es im Fenster und in der Taskleiste haben will;
end;
WM_DESTROY:
begin
if CheckWin32Version(6, 1)
and (FTaskbarList3 <>
nil)
then
FTaskbarList3.SetProgressState(FensterH, TBPF_NOPROGRESS);
//Sollte doch das Freigeben sein oder? Funkt aber net hier auch nicht bei WM_CLOSE
PostQuitMessage(0);
end;
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
wc: TWndClassEx = (
cbSize : SizeOf(TWndClassEx);
Style : CS_HREDRAW
or CS_VREDRAW;
lpfnWndProc : @WndProc;
//Fensterfunktion für Fenster 1
cbClsExtra : 0;
cbWndExtra : 0;
lpszMenuName :
nil;
lpszClassName : ClassName;
//Klassenname für Fenster 1
hIconSm : 0;
);
msg: TMsg;
var
Obj
: IInterface;
begin
wc.hInstance := hInstance;
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hbrBackground := GetSysColorBrush(COLOR_BTNHIGHLIGHT);
RegisterClassEx(wc);
FensterH := CreateWindowEx(0, ClassName, Window1Name, WS_VISIBLE
or WS_SYSMENU,
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), WindowWidth, WindowHeight, 0, 0, hInstance,
nil);
InitCommonControl(ICC_PROGRESS_CLASS);
//Ist ja sowieso alles größer alls 32Bit xD Brauch ich das überhaupt?
if CheckWin32Version(6, 1)
then
begin
Obj := CreateComObject(CLSID_TaskbarList);
if Obj =
nil then
FTaskbarList :=
nil
else
begin
FTaskbarList := ITaskbarList(Obj);
FTaskbarList.HrInit;
FTaskbarList.QueryInterface(CLSID_TaskbarList2, FTaskbarList2);
FTaskbarList.QueryInterface(CLSID_TaskbarList3, FTaskbarList3);
end;
end;
if CheckWin32Version(6, 1)
and (FTaskbarList3 <>
nil)
then
begin
FTaskbarList3.SetProgressState(FensterH, TBPF_NORMAL);
FTaskbarList3.SetProgressValue(FensterH, 50, 100);
//Testweise
end;
while GetMessage(msg,0,0,0)
do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
ExitCode := msg.wParam;
end.