TTrayIcon mit overlay nummer bereits verfügbar?

[KodeZwerg]

Hab was gebastelt was den Anschein hat zu funktionieren.
Das ganze basiert auf einer Projekt JEDI Methode.
Damit ist auch das 15 Bilder Overlay Limit gesprengt.

Im Anhang kleines Binary plus kompl. Source.

Zur Veranschaulichung hier der Haupt-Quelltext.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Forms, Controls, Classes, Graphics, StdCtrls, ExtCtrls, CommCtrl;
//  JclShell;

type
  TForm1 = class(TForm)
    TrayIcon1: TTrayIcon;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Image3: TImage;
    procedure FormShow(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
  Image1.Picture.Icon := TrayIcon1.Icon;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  TrayIcon1.Visible := (Sender as TCheckBox).Checked;
end;

function OverlayIcon(var Icon: HICON; Overlay: HICON; Large: Boolean): Boolean;
// source aus JclShell.pas datei!!!
var
  Source, Dest: HIMAGELIST;
  Width, Height: Integer;
begin
  Result := False;
  if Large then
  begin
    Width := GetSystemMetrics(SM_CXICON);
    Height := GetSystemMetrics(SM_CYICON);
    Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0);
  end
  else
  begin
    Width := GetSystemMetrics(SM_CXSMICON);
    Height := GetSystemMetrics(SM_CYSMICON);
    Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0);
  end;
  if Source <> 0 then
  begin
    if (ImageList_AddIcon(Source, Icon) <> -1) and
      (ImageList_AddIcon(Source, Overlay) <> -1) then
    begin
      Dest := HIMAGELIST(ImageList_Merge(Source, 0, Source, 1, 0, 0));
      if Dest <> 0 then
      begin
        DestroyIcon(Icon);
        Icon := ImageList_ExtractIcon(0, Dest, 0);
        ImageList_Destroy(Dest);
        Result := True;
      end;
    end;
    ImageList_Destroy(Source);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Ico: HICON;
begin
  Ico := TrayIcon1.Icon.Handle;
  OverlayIcon(Ico, Image2.Picture.Icon.Handle, False);
  Image3.Picture.Icon.Handle := Ico;
  TrayIcon1.Icon.Handle := Ico;
  TrayIcon1.SetDefaultIcon;
end;

end.