Windows 7 Support für Delphi [ALPHA 1]

[NickelM]

Hallo nochmal,

Mal ne frage...es ist doch möglich mit der Taskbar Unit, auch das für nonvcl zumachen oder?
Weil ich wollte das mit der Taskbarprogressbar in NonVCL verwenden.

EDIT:
Ich habe es soweit hinbekommen das er es mir anzeigt. Hingegen bekomm ich beim schliessen einen Zugriffsverletzung auf adresse 000000 (d.h. auf ein bereits freigegeben Pointer) Ich vermute es liegt am dem Form das früher freigegeben wird als die ProgressBar in der Taskleiste.
Nur wie gebe ich die davor frei bzw. wann? und wo?

Benutze Delphi2009/Delphi2010

Delphi-Quellcode:

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.