// Hiermit kann man mittels eines Timers ein animiertes Icon in der Traybar
// anzeigen lassen. Ich lasse dabei die Icons aus einem Bitmap-Strip erzeugen.
// Hier ein Beispiel mit Maske und 8 Bildphasen: 
// Dieses Bitmap sollte nur die 16 Standardfarben haben. Die Größe der
// Einzelbilder ist 16 x 16 Pixel. Beim Klick auf Button1 wird das Ganze
// gestartet, beim Klick auf das Icon wieder beendet. Gleichzeitig zum bewegten
// Icon wird im Tooltip das Datum und die Uhrzeit aktualisiert.
// Querverweis:
die Anwendung bei Deaktivierung in die Traybar stellen

// Getestet mit D4 unter Win98

unit tray;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

const
WM_TRAYEVENT = WM_USER+100;

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure
TrayEvent(var Msg: TMessage); Message WM_TRAYEVENT;
procedure rein;
procedure raus;
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses shellapi;

var
NotifyIconData: TNotifyIconData;
il:TImagelist;
ic:TIcon;

const
stelle:integer=0;
bilderanzahl=9;
// Maske + 8 Einzelbilder

procedure TForm1.rein;
begin
strpcopy(NotifyIconData.szTip,formatdatetime('dddd, d. mmmm yyyy, hh:nn',now));
il.geticon(stelle,ic);
NotifyIconData.hIcon:=ic.handle;
Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
hide;
timer1.interval:=125;
end;

procedure
TForm1.raus;
begin
timer1.interval:=0;
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
show;
end;

procedure
TForm1.TrayEvent(var Msg: TMessage);
begin
if
msg.lparam = WM_LButtonDown then raus;
end;

procedure
TForm1.FormCreate(Sender: TObject);
var
x:integer;
strip,einzelbild,maske:TBitmap;
begin
timer1.interval:=0;
ic:=TIcon.create;
strip:=TBitmap.create;
maske:=TBitmap.create;
maske.width:=16;
maske.height:=16;
einzelbild:=TBitmap.create;
einzelbild.width:=16;
einzelbild.height:=16;
strip.loadfromfile('d:\bilder\strip16x16.bmp');
il:=Timagelist.create(nil);
il.masked:=true;
maske.canvas.copyrect(rect(0,0,16,16),strip.canvas,rect(0,0,16,16));
for x:=1 to bilderanzahl-1 do begin
einzelbild.canvas.copyrect(rect(0,0,16,16),strip.canvas,rect(x*16,0,x*16+16,16));
il.add(einzelbild,maske);
end;
maske.free;
strip.free;
einzelbild.free;
NotifyIconData.cbSize:=Sizeof(NotifyIconData);
NotifyIconData.Wnd:=Handle;
NotifyIconData.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
NotifyIconData.uCallbackMessage:=WM_TRAYEVENT;
end;

procedure
TForm1.FormDestroy(Sender: TObject);
begin
il.free;
ic.free;
end;

procedure
TForm1.Timer1Timer(Sender: TObject);
begin
il.geticon(stelle,ic);
inc(stelle);
if stelle > bilderanzahl-2 then stelle:=0;
strpcopy(NotifyIconData.szTip,formatdatetime('dddd, d. mmmm yyyy, hh:nn',now));
NotifyIconData.hIcon:=ic.handle;
Shell_NotifyIcon(NIM_MODIFY, @NotifyIconData);
end;

procedure
TForm1.Button1Click(Sender: TObject);
begin
rein;
end;

end.


Zugriffe seit 6.9.2001 auf Delphi-Ecke