Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#10

AW: TCoolTrayIcon Overlay-Icon

  Alt 26. Feb 2021, 20:45
Ich finde nicht das gewollte aber bei der Schatzsuche bin auf diesen Code gestolpert.

Viel Spaß beim testen.


Delphi-Quellcode:
// uses* Windows, Forms, Controls, Classes, Graphics, StdCtrls, ExtCtrls, CommCtrl;

function MergeIcons(var Icon: HICON; Overlay: HICON): Boolean;
var
  Source, Dest: HIMAGELIST;
  Width, Height: Integer;
begin
  Result := False;
  Width := GetSystemMetrics(SM_CXSMICON);
  Height := GetSystemMetrics(SM_CYSMICON);
  Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0);
  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; // hole original icon
  MergeIcons(Ico, Image1.Picture.Icon.Handle); // verschmelze es mit einem anderen icon
  TrayIcon1.Icon.Handle := Ico; // nutze das neue icon
end;
Ps: Icon Größe sollte identisch sein.

Pps: Das zweite Icon so gestalten das welche Ecke auch immer Deinen Wunsch entspricht.
Ich nutzte das um einen Roten oder Grünen Punkt raufzukleben.
Gruß vom KodeZwerg

Geändert von KodeZwerg (26. Feb 2021 um 20:49 Uhr)
  Mit Zitat antworten Zitat