Editing Icons

I would like to be able to edit an Icon during Run-time. I would need, that to show extra Data on my programs icon in the System Tray area. I do not want to create an extra Icon for every possible state. I would have to create about 20-30 Icons and I don't want to do that.
MarkHallAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

kretzschmarCommented:
hi markhall,

well just not what you want, but i guess it shows how could it be done.

a sample from my paq
shows the mouse-cursor pos in the tray by usage of three Icons, which are created and updated on the fly

unit tray_ico_u;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, shellapi;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const MyIconIDs : array[0..2] of Integer = (1000,1001,1002);

var
  IconInfo : TIconInfo;
  MyIcons : array[0..2] of TIcon;
  NotifyIconData : TNotifyIconData;

procedure TForm1.FormCreate(Sender: TObject);
var i : Integer;
begin
  for i := 0 to 2 do  //Push three Icons in the Tray
  begin
    MyIcons[i] := TIcon.Create;
    NotifyIconData.cbSize := SizeOf(NotifyIconData);
    NotifyIconData.hIcon := MyIcons[i].Handle;
    NotifyIconData.szTip := 'Shows the Mouseposition';
    NotifyIconData.uCallbackMessage := 0;
    NotifyIconData.uFlags := NIF_ICON or NIF_TIP;
    NotifyIconData.uID := MyIconIDs[i];
    NotifyIconData.Wnd := Application.Handle;
    if Shell_NotifyIcon(NIM_ADD, @NotifyIconData) then;
  end;
  Timer1.Interval := 100;  //Enable Timer
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i : Integer;
begin
  for i := 0 to 2 do   //Remove the Icons from the Tray
  begin
    NotifyIconData.cbSize := SizeOf(NotifyIconData);
    NotifyIconData.hIcon := MyIcons[i].Handle;
    NotifyIconData.szTip := 'Shows the Mouseposition';
    NotifyIconData.uCallbackMessage := 0;
    NotifyIconData.uFlags := NIF_ICON or NIF_TIP;
    NotifyIconData.uID := MyIconIDs[i];
    NotifyIconData.Wnd := Application.Handle;
    if Shell_NotifyIcon(NIM_DELETE, @NotifyIconData) then
      MyIcons[i].Free;
  end;
end;


//The timer event
procedure TForm1.Timer1Timer(Sender: TObject);
var
  MyBmp : TBitMap;
  P : TPoint;
  i,x,y : Integer;
  s : String;
  MB : Array[0..2] of TBitmap;
begin
  Timer1.enabled := False;  //prevent that the event comes twice
  MyBmp := TBitMap.Create;  //Prepare Source Bitmap
  MyBmp.Height := MyIcons[1].Height;
  MyBmp.Width := MyIcons[1].Width * 3;
  MyBmp.Canvas.Brush.Color := clBlue;  //comes black on yellow in the tray
  MyBmp.Canvas.FillRect(Rect(0,0,MyBmp.width,MyBmp.Height));
  MyBmp.Canvas.Font.Size := 20;
  for i := 0 to 2 do  //prepare secondary Bitmaps
  begin
    MB[I] := TBitMap.Create;
    MB[I].Width := MyIcons[i].Width;
    MB[i].Height := MyIcons[i].height;
  end;
  GetCursorPos(P);  //Get current Mousepos
  s := Inttostr(p.x)+':'+Inttostr(P.y); //prepare String
  y := (MyBmp.Height div 2) - (MyBmp.Canvas.TextHeight(S) div 2);
  x := (MyBmp.Width div 2) - (MyBmp.Canvas.TextWidth(S) div 2);
  MyBmp.Canvas.TextOut(x,y,s);
    Image1.Picture.Bitmap.Assign(MyBmp);  //Controlling on the form, can deleted
  for i := 0 to 2 do  //Create Icons
  begin
    MB[I].Canvas.CopyRect(Rect(0,0,MB[I].Width,MB[I].Height),
                          MyBmp.Canvas,
                          Rect(MB[i].Width * i,0,MB[i].Width * (i+1),MB[I].Height));
    MyIcons[i].ReleaseHandle; //Free Resource
    IconInfo.fIcon := True;
    IconInfo.xHotspot := 0;
    IconInfo.yHotspot := 0;
    IconInfo.hbmColor := MB[i].Handle;
    IconInfo.hbmMask := MB[i].MaskHandle;  //Doesn't work yet
    MyIcons[I].Handle := CreateIconIndirect(IconInfo);

    //changes to the tray
    NotifyIconData.cbSize := SizeOf(NotifyIconData);
    NotifyIconData.hIcon := MyIcons[i].Handle;
    NotifyIconData.szTip := 'Shows the Mouseposition';
    NotifyIconData.uCallbackMessage := 0;
    NotifyIconData.uFlags := NIF_ICON or NIF_TIP;
    NotifyIconData.uID := MyIconIDs[i];
    NotifyIconData.Wnd := Application.Handle;

    Shell_NotifyIcon(NIM_Modify, @NotifyIconData);

    MB[i].Free
  end;
  MyBmp.Free;
  Timer1.enabled := True;  //prepare for next event
end;

end.

meikl ;-)
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
rwilson032697Commented:
Listening
0
simonetCommented:
Following...®
0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

RBertoraCommented:
Very interresting code Meikl :-)
0
intheCommented:
Assimilating..
0
kretzschmarCommented:
uuh, a borg ...
0
kretzschmarCommented:
Hello MarkHall, are you alive ?
0
intheCommented:
accept kretzschmars comment as answer


       'Resistance is futile'
0
intheCommented:
or change the icons hint or something
0
MarkHallAuthor Commented:
Sorry, I've been offline due to technical problems.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.