apophysis7x/Windows7/dwTaskbarThumbnails.pas

unit dwTaskbarThumbnails;

interface

uses
  Classes, Messages, ImgList, AppEvnts, Windows,
  dwTaskbarComponents, dwTaskbarList;

type
  TdwTaskbarThumbnails = class;
  TdwTaskbarThumbnailList = class;
  TdwTaskbarThumbnailItem = class;

  TOnThumbnailClick = procedure(Sender: TdwTaskbarThumbnailItem) of object;

  TdwTaskbarThumbnailItem = class(TCollectionItem)
  private
    FImageIndex: Integer;
    FHint: WideString;
    FEnabled: Boolean;
    FShowBorder: Boolean;
    FDismissOnClick: Boolean;
    FVisible: Boolean;
    FTag: Integer;
    procedure SetImageIndex(const Value: Integer);
    procedure SetHint(const Value: WideString);
    procedure SetEnabled(const Value: Boolean);
    procedure SetShowBorder(const Value: Boolean);
    procedure SetDismissOnClick(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);
  protected
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    property Hint: WideString read FHint write SetHint;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property ShowBorder: Boolean read FShowBorder write SetShowBorder default True;
    property DismissOnClick: Boolean read FDismissOnClick write SetDismissOnClick default False;
    property Visible: Boolean read FVisible write SetVisible default True;
    property Tag: Integer read FTag write FTag default 0;
  end;

  TdwTaskbarThumbnailList = class(TCollection)
  private
    FTaskbarThumbnails: TdwTaskbarThumbnails;
    function GetItem(Index: Integer): TdwTaskbarThumbnailItem;
    procedure SetItem(Index: Integer; Value: TdwTaskbarThumbnailItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(TaskbarThumbnails: TdwTaskbarThumbnails);
    function Add: TdwTaskbarThumbnailItem;
    function AddItem(Item: TdwTaskbarThumbnailItem; Index: Integer): TdwTaskbarThumbnailItem;
    function Insert(Index: Integer): TdwTaskbarThumbnailItem;
    property Items[Index: Integer]: TdwTaskbarThumbnailItem read GetItem write SetItem; default;
  end;

  TdwTaskbarThumbnails = class(TdwTaskbarComponent)
  private
    FAppEvents: TApplicationEvents;

    FImages: TCustomImageList;
    FThumbnails: TdwTaskbarThumbnailList;
    FOnThumbnailClick: TOnThumbnailClick;
    procedure SetImages(const Value: TCustomImageList);
    procedure UpdateThumbnail(Index: Integer);
    procedure UpdateThumbnails;
    procedure SetThumbnails(const Value: TdwTaskbarThumbnailList);
    function GetThumbButtons: TThumbButtonList;
    procedure DoAppMessage(var Msg: TMsg; var Handled: Boolean);
  protected
    function DoInitialize: Boolean; override;
    procedure DoUpdate; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ShowThumbnails;
    function ClipThumbnail(window:Cardinal; left:integer; right:integer; top:integer; bottom:integer):cardinal;
  published
    property AutoInitialize;
    property Images: TCustomImageList read FImages write SetImages;
    property Thumbnails: TdwTaskbarThumbnailList read FThumbnails write SetThumbnails;
    property OnThumbnailClick: TOnThumbnailClick read FOnThumbnailClick write FOnThumbnailClick;
  end;

implementation

uses
  SysUtils, Graphics;

{ TdwTaskbarThumbnailItem }

procedure TdwTaskbarThumbnailItem.Assign(Source: TPersistent);
begin
  if Source is TdwTaskbarThumbnailItem then
  begin
    Self.FImageIndex := (Source as TdwTaskbarThumbnailItem).FImageIndex;
    Self.FHint := (Source as TdwTaskbarThumbnailItem).FHint;
    Self.FEnabled := (Source as TdwTaskbarThumbnailItem).FEnabled;
    Self.FShowBorder := (Source as TdwTaskbarThumbnailItem).FShowBorder;
    Self.FDismissOnClick := (Source as TdwTaskbarThumbnailItem).FDismissOnClick;
    Self.FVisible := (Source as TdwTaskbarThumbnailItem).FVisible;
    Self.FTag := (Source as TdwTaskbarThumbnailItem).FTag;
  end
  else
  begin
    inherited Assign(Source);
  end;
end;

constructor TdwTaskbarThumbnailItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  FImageIndex := Index;
  FHint := '';
  FEnabled := True;
  FShowBorder := True;
  FDismissOnClick := False;
  FVisible := True;
  FTag := 0;
end;

procedure TdwTaskbarThumbnailItem.SetDismissOnClick(const Value: Boolean);
begin
  if FDismissOnClick <> Value then
  begin
    FDismissOnClick := Value;
    Changed(False);
  end;
end;

procedure TdwTaskbarThumbnailItem.SetEnabled(const Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Changed(False);
  end;
end;

procedure TdwTaskbarThumbnailItem.SetHint(const Value: WideString);
begin
  if FHint <> Value then
  begin
    FHint := Value;
    Changed(False);
  end;
end;

procedure TdwTaskbarThumbnailItem.SetImageIndex(const Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Changed(False);
  end;
end;

procedure TdwTaskbarThumbnailItem.SetShowBorder(const Value: Boolean);
begin
  if FShowBorder <> Value then
  begin
    FShowBorder := Value;
    Changed(False);
  end;
end;

procedure TdwTaskbarThumbnailItem.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Changed(False);
  end;
end;

{ TdwTaskbarThumbnailList }

function TdwTaskbarThumbnailList.Add: TdwTaskbarThumbnailItem;
begin
  FTaskbarThumbnails.CheckInitalization;
  
  Result := AddItem(nil, -1);
end;

function TdwTaskbarThumbnailList.AddItem(Item: TdwTaskbarThumbnailItem; Index: Integer): TdwTaskbarThumbnailItem;
begin
  FTaskbarThumbnails.CheckInitalization;
  
  if Item = nil then
  begin
    Result := TdwTaskbarThumbnailItem.Create(Self);
  end
  else
  begin
    Result := Item;
    if Assigned(Item) then
    begin
      Result.Collection := Self;
      if Index < Count then
        Index := Count - 1;
      Result.Index := Index;
    end;
  end;
end;

constructor TdwTaskbarThumbnailList.Create(TaskbarThumbnails: TdwTaskbarThumbnails);
begin
  inherited Create(TdwTaskbarThumbnailItem);
  FTaskbarThumbnails := TaskbarThumbnails;
end;

function TdwTaskbarThumbnailList.GetItem(Index: Integer): TdwTaskbarThumbnailItem;
begin
  Result := TdwTaskbarThumbnailItem(inherited GetItem(Index));
end;

function TdwTaskbarThumbnailList.GetOwner: TPersistent;
begin
  Result := FTaskbarThumbnails;
end;

function TdwTaskbarThumbnailList.Insert(Index: Integer): TdwTaskbarThumbnailItem;
begin
  FTaskbarThumbnails.CheckInitalization;
  
  Result := AddItem(nil, Index);
end;

procedure TdwTaskbarThumbnailList.SetItem(Index: Integer; Value: TdwTaskbarThumbnailItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TdwTaskbarThumbnailList.Update(Item: TCollectionItem);
begin
  if Item <> nil then
    FTaskbarThumbnails.UpdateThumbnail(Item.Index)
  else
    FTaskbarThumbnails.UpdateThumbnails;
end;

{ TdwTaskbarThumbnails }

constructor TdwTaskbarThumbnails.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FThumbnails := TdwTaskbarThumbnailList.Create(Self);

  FAppEvents := TApplicationEvents.Create(Self);
  FAppEvents.OnMessage := DoAppMessage;
end;

destructor TdwTaskbarThumbnails.Destroy;
begin
  FThumbnails.Free;
  FAppEvents.Free;
  
  inherited;
end;

procedure TdwTaskbarThumbnails.DoAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.hwnd = TaskBarEntryHandle then
    if Msg.message = WM_COMMAND then
      if HiWord(Msg.wParam) = THBN_CLICKED then
      begin
        Handled := True;
        if Assigned(FOnThumbnailClick) then
          FOnThumbnailClick(FThumbnails[LoWord(Msg.wParam)]);
      end;
end;

function TdwTaskbarThumbnails.ClipThumbnail(window:Cardinal; left:integer; right:integer; top:integer; bottom:integer):cardinal;
var
  rect:TRect;
  rectp:PRect;
begin
  //rect:=TRect.Create;
  rect.Left := left;
  rect.Top := top;
  rect.Right := right;
  rect.Bottom := bottom;
  rectp:=@rect;
  if (TaskbarList3<>nil) then
    Result := TaskbarList3.SetThumbnailClip(window, rectp)
  else
    Result := 16777216;
end;

function TdwTaskbarThumbnails.DoInitialize: Boolean;
var
  Buttons: TThumbButtonList;
begin
  SetLength(Buttons, 0);
  if CheckWin32Version(6, 1) and (TaskbarList3 <> nil) then
  begin
    Buttons := GetThumbButtons;
    if TaskbarList3 <> nil then
    begin
      TaskbarList3.ThumbBarSetImageList(TaskBarEntryHandle, FImages.Handle);
      TaskbarList3.ThumbBarAddButtons(TaskBarEntryHandle, Length(Buttons), @Buttons[0]);
      Result := True;
    end
    else
    begin
      Result := False;
    end;
  end
  else
  begin
    Result := False;
  end;
end;

procedure TdwTaskbarThumbnails.DoUpdate;
var
  Buttons: TThumbButtonList;
begin
  SetLength(Buttons, 0);
  if not IsInitialized then
    Exit;

  Buttons := GetThumbButtons;
  TaskbarList3.ThumbBarSetImageList(TaskBarEntryHandle, FImages.Handle);
  TaskbarList3.ThumbBarUpdateButtons(TaskBarEntryHandle, Length(Buttons), @Buttons[0]);
end;

function TdwTaskbarThumbnails.GetThumbButtons: TThumbButtonList;
var
  I: Integer;
  Thumb: TdwTaskbarThumbnailItem;
begin
  if (FThumbnails.Count < 1) or (FThumbnails.Count > 7) then
    raise Exception.Create('The thumbnail count must be at least 1 and can be up to 7.');

  SetLength(Result, FThumbnails.Count);
  for I := 0 to FThumbnails.Count - 1 do
  begin
    Thumb := FThumbnails[I];

    Result[I].dwMask := THB_FLAGS;

    Result[I].iId := Thumb.Index;

    if FImages <> nil then
      if (Thumb.ImageIndex >= 0) and (Thumb.ImageIndex < FImages.Count) then
      begin
        Result[I].dwMask := Result[I].dwMask or THB_BITMAP;
        Result[I].iBitmap := Thumb.ImageIndex;
      end;

    if Thumb.FHint <> '' then
    begin
      Result[I].dwMask := Result[I].dwMask or THB_TOOLTIP;
      StringToWideChar(Thumb.Hint, Result[I].szTip, Length(Result[I].szTip));
    end;

    Result[I].dwFlags := 0;
    if Thumb.FEnabled then
      Result[I].dwFlags := Result[I].dwFlags or THBF_ENABLED
    else
      Result[I].dwFlags := Result[I].dwFlags or THBF_DISABLED;

    if not Thumb.FShowBorder then
      Result[I].dwFlags := Result[I].dwFlags or THBF_NOBACKGROUND;

    if Thumb.DismissOnClick then
      Result[I].dwFlags := Result[I].dwFlags or THBF_DISMISSONCLICK;

    if not Thumb.Visible then
      Result[I].dwFlags := Result[I].dwFlags or THBF_HIDDEN;
  end;
end;

procedure TdwTaskbarThumbnails.SetImages(const Value: TCustomImageList);
begin
  FImages := Value;
  SendUpdateMessage;
end;

procedure TdwTaskbarThumbnails.SetThumbnails(const Value: TdwTaskbarThumbnailList);
begin
  FThumbnails.Assign(Value);
  SendUpdateMessage;
end;

procedure TdwTaskbarThumbnails.ShowThumbnails;
begin
  CheckInitalization;
  DoInitialize;
end;

procedure TdwTaskbarThumbnails.UpdateThumbnail(Index: Integer);
begin
  SendUpdateMessage;
end;

procedure TdwTaskbarThumbnails.UpdateThumbnails;
begin
  SendUpdateMessage;
end;

end.