Systray clock

Det kan du ikke. Der kan normalt kun sættes 16x16 ikoner ned i systray.

hmm
har da set programmer der gør det
fjerner det gamle ur og smider et nyt der ned :)

MB

Ja, det er rigtigt. Uret kører dog i sit eget vindue. Du kan så erstatte uret, med din egen tekst, men du kan ikke sætte text i selve tray\'en. 

Det er også det jeg vil :)

MB

fra megabyte_ >> skal det kun stå hvor uret står eller skal det være i hele systray\'en, altså hen over de iconer der allerede er????

/ZIRON

Ziron

Well jeg regnet med at det bare skulle skifte uret ud men det ville ikke gører noget hvis man også kunne skifte den adre ikoner ud.

MB

okay prøver lige at skrive noget :-)

/ZIRON

Ziron tnx :)

fuck alt gik koldt undtagen IE, FEDT... JUBII SKAL GENSTARTE... JEG HADER MICROSOFT :-)

/ZIRON

lol det er godt når det sker

sådan, prøv dette:

Indsæt 2 Tbutton\'s og en TStaticText på din form og så prøv:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    StaticText1: TStaticText;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FindClock;
    procedure FindSystray;
    procedure InsetTextInSystray;
    procedure Button2Click(Sender: TObject);
    procedure InsetTextInClock;
  private
    { Private declarations }
  public
    { Public declarations }
    SystrayRect, ClockRect            : TRect; // We need this for calc\'ing the size of the System Tray Window
    TaskbarHwnd, TrayHwnd, ClockHWND  : HWND; // Skal bruges til at finde handle med.
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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

procedure TForm1.FindClock;
begin

// Her finder vi Taskbaren.
TaskbarHwnd := FindWindow(\'Shell_TrayWnd\',nil);

// Her finder vi Tray\'en.
TrayHwnd := FindWindowEx(TaskbarHwnd,0,\'TrayNotifyWnd\',nil);

// Her finder vi uret.
ClockHWND := FindWindowEx(TrayHwnd,0,\'TrayClockWClass\',nil);

end;

procedure TForm1.FindSystray;
begin

// Her finder vi Taskbaren.
TaskbarHwnd := FindWindow(\'Shell_TrayWnd\',nil);

// Her finder vi Tray\'en.
TrayHwnd := FindWindowEx(TaskbarHwnd,0,\'TrayNotifyWnd\',nil)

end;

procedure TForm1.InsetTextInSystray;
begin

// Kør først FindSystray for at få dens Handle.
FindSystray;

// Nu skal Størrelsen af Trayen findes.
GetWindowRect(TrayHwnd,SystrayRect);

// Du kan prøve at sætte borderstyle på bare for at se om texten nu ligger rigtig, og så fjerne den bagefter.
StaticText1.BorderStyle := sbsSingle;

// Leg lidt har og find ud af hvor du vil have din text til at stå, lige nu er den helt til venstre.
StaticText1.Left := (SystrayRect.Right - SystrayRect.Left) - StaticText1.Width;

{Du skal sætte top til noget mellem minus et eller andet og 19 (19 kan også være med)
ellers vil det ikke blive vist, da texten så er under traye\'en.}
StaticText1.Top := 2;

// Her kan man så ellers lege lidt, fx med skrifttypen.
StaticText1.Font.Name := \'Tahoma\';

// Gør dette ellers vil din text flytte sig rundt når du ændre text.
StaticText1.AutoSize := FALSE;

// Her kommer så det hvor vi flytter din text (TStaticText) ned i tray\'en.
Windows.SetParent(StaticText1.Handle,TrayHwnd);

end;

procedure TForm1.InsetTextInClock;
begin

// Kør først FindSystray for at få dens Handle.
FindClock;

// Nu skal Størrelsen af Trayen findes.
GetWindowRect(ClockHwnd,ClockRect);

// Du kan prøve at sætte borderstyle på bare for at se om texten nu ligger rigtig, og så fjerne den bagefter.
StaticText1.BorderStyle := sbsSingle;

// Leg lidt har og find ud af hvor du vil have din text til at stå, lige nu er den helt til venstre.
StaticText1.Left := (ClockRect.Right - ClockRect.Left) - StaticText1.Width;

{Du skal sætte top til noget mellem minus et eller andet og 19 (19 kan også være med)
ellers vil det ikke blive vist, da texten så er under traye\'en.}
StaticText1.Top := 2;

// Her kan man så ellers lege lidt, fx med skrifttypen.
StaticText1.Font.Name := \'Tahoma\';

// Gør dette ellers vil din text flytte sig rundt når du ændre text.
StaticText1.AutoSize := FALSE;

// Her kommer så det hvor vi flytter din text (TStaticText) ned i tray\'en.
Windows.SetParent(StaticText1.Handle,ClockHWND);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
InsetTextInClock;
end;

end.

når du bruger InsetTextInClock er der dog en ulempe, når uret opdatere kommer din text i baggrunden :-( så jeg vil forslå at du bruger InsetTextInSystray
og så bare tilpasser den så den ligger over på uret...

/ZIRON

Kanont mange tak lige hvad jeg havde brug for :)
det kan værer at du måsk eogså kan fikse et eksempel på det samme bare med et af den andre ikoner så man måske kunne lave en men status bar der nede :)
du får de 100 p for den her hvis du kan finde ud af det andet laver jeg lige et nyt spm men skal vi sige 100 p oxo :)

MB

det lyder fint, men forklar lige lidt bedre, jeg fattede ikke noget af det sidst, jeg tror jeg er dum...

/ZIRON

hehe okey
jeg er ved at lave et program som viser en masse informationer om ens computer fx ram forbrug osv
så det jeg gerne vil have var et stykke kode der kan næsten det samme som det med uret du lige har lavet.
det skal barer værer som et nyt ikon der kommer frem :)

MB

vil du ligge dit program ned i systart\'en???

/ZIRON

Ikke helt det har jeg et komponent til :)
jeg vil have en for for ikon men som inde holder tekst og ikke et ikon men fx \'256 MB\'

MB

altså lave plads i systrayen til fx en tekst hvor der står \'256 mb\'???

har aldrig set, så ved ikke om det kan lade sig gøre, men prøver da lige, bare for sjov :-)

/ZIRON

jepz lige det tnx :)

MB

Hmm har fundet en lille bug i din kode :( ved ikke helt hvordan jeg skal rette den måske du kan hjælpe har sat en timer til at opdater mit nyeur men den blinker somme tider selv om jeg bruger InsetTextInSystray :(
håber du har et forslag :)

MB
ellers er det en kanon fed kode du har lavet mangler bare lige at man kan skifte farve på det for StaticText1.font.Color := clRed; virker ikke :(

kigger lige på de 2 ting...

/ZIRON

tnx :)

den blinker ikke hos mig, må jeg lige se din kode???

og jeg ved faktisk ikke om man kan tegne med fx rød når teksten er hoppet der ned :-(

/ZIRON

Her er den så
der er nok lidt rod iden da jeg prøver mig lidt frem :)
unit Unit1;

interface

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

type
  TMain = class(TForm)
    StaticText1: TStaticText;
    Timer1: TTimer;
    FontDialog1: TFontDialog;
    Button1: TButton;
    procedure FindClock;
    procedure FindSystray;
    procedure InsetTextInSystray;
    procedure InsetTextInClock;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    SystrayRect, ClockRect            : TRect; // We need this for calc\'ing the size of the System Tray Window
    TaskbarHwnd, TrayHwnd, ClockHWND  : HWND; // Skal bruges til at finde handle med.
    procedure ShowClock(bvalue : boolean);
  end;

var
  Main: TMain;

implementation

{$R *.DFM}

procedure Tmain.ShowClock(bvalue : boolean);
var
  TrayWnd, TrayNWnd, ClockWnd : Hwnd;
begin
  TrayWnd  := FindWindow(\'Shell_TrayWnd\', nil);
  TrayNWnd := FindWindowEx(TrayWnd,0,\'TrayNotifyWnd\', nil);
  ClockWnd := FindWindowEx(TrayNWnd,0,\'TrayClockWClass\', nil);
  if bvalue = true then
    ShowWindow(ClockWnd,sw_show)
  else
    ShowWindow(ClockWnd,sw_hide)
end;

procedure TMain.FindClock;
begin

// Her finder vi Taskbaren.
TaskbarHwnd := FindWindow(\'Shell_TrayWnd\',nil);

// Her finder vi Tray\'en.
TrayHwnd := FindWindowEx(TaskbarHwnd,0,\'TrayNotifyWnd\',nil);

// Her finder vi uret.
ClockHWND := FindWindowEx(TrayHwnd,0,\'TrayClockWClass\',nil);

end;

procedure TMain.FindSystray;
begin

// Her finder vi Taskbaren.
TaskbarHwnd := FindWindow(\'Shell_TrayWnd\',nil);

// Her finder vi Tray\'en.
TrayHwnd := FindWindowEx(TaskbarHwnd,0,\'TrayNotifyWnd\',nil)

end;

procedure TMain.InsetTextInSystray;
begin

// Kør først FindSystray for at få dens Handle.
FindSystray;

// Nu skal Størrelsen af Trayen findes.
GetWindowRect(TrayHwnd,SystrayRect);

// Du kan prøve at sætte borderstyle på bare for at se om texten nu ligger rigtig, og så fjerne den bagefter.
StaticText1.BorderStyle := sbsNone;

// Leg lidt har og find ud af hvor du vil have din text til at stå, lige nu er den helt til venstre.
StaticText1.Left := (SystrayRect.Right - SystrayRect.Left) - StaticText1.Width -5;

{Du skal sætte top til noget mellem minus et eller andet og 19 (19 kan også være med)
ellers vil det ikke blive vist, da texten så er under traye\'en.}
StaticText1.Top := 3;

// Her kan man så ellers lege lidt, fx med skrifttypen.
//StaticText1.Font.Name := \'Verdana\';
//StaticText1.Font.Size := 8;
//StaticText1.Font.Color := clRed;
StaticText1.Font := FontDialog1.Font;

// Gør dette ellers vil din text flytte sig rundt når du ændre text.
StaticText1.AutoSize := FALSE;

// Her kommer så det hvor vi flytter din text (TStaticText) ned i tray\'en.
Windows.SetParent(StaticText1.Handle,TrayHwnd);

end;

procedure TMain.InsetTextInClock;
begin

// Kør først FindSystray for at få dens Handle.
FindClock;

// Nu skal Størrelsen af Trayen findes.
GetWindowRect(ClockHwnd,ClockRect);

// Du kan prøve at sætte borderstyle på bare for at se om texten nu ligger rigtig, og så fjerne den bagefter.
StaticText1.BorderStyle := sbsSingle;

// Leg lidt har og find ud af hvor du vil have din text til at stå, lige nu er den helt til venstre.
StaticText1.Left := (ClockRect.Right - ClockRect.Left) - StaticText1.Width;

{Du skal sætte top til noget mellem minus et eller andet og 19 (19 kan også være med)
ellers vil det ikke blive vist, da texten så er under traye\'en.}
StaticText1.Top := 2;

// Her kan man så ellers lege lidt, fx med skrifttypen.
StaticText1.Font.Name := \'verdana\';

// Gør dette ellers vil din text flytte sig rundt når du ændre text.
StaticText1.AutoSize := FALSE;

// Her kommer så det hvor vi flytter din text (TStaticText) ned i tray\'en.
Windows.SetParent(StaticText1.Handle,ClockHWND);
end;

procedure TMain.Timer1Timer(Sender: TObject);
begin
StaticText1.Caption := TimeToStr(Now);
InsetTextInSystray;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
Timer1.OnTimer(self);
end;

procedure TMain.Button1Click(Sender: TObject);
begin
if FontDialog1.Execute then
end;

end.

Hvad med det andet med at få lavet tekst i systray :)
btw kan jeg ikke lige få din mail så  jeg kan smide dig i about for du har vidst hjulpet en del :)

MB

med dit kommer der ikke nogen blink hos mig, men prøv dette:

procedure TMain.Timer1Timer(Sender: TObject);
begin
StaticText1.Caption := TimeToStr(Now);
end;

og så InsetTextInSystray; ind under formcreate...

med tekst i systrayen så kan man vel nok godt men bare hvordan kigger stadig...

mail : ziron@wanadoo.dk;

/ZIRON

Hehe lige hvad jeg ville have sagt
well håber du finder ud af noget for jeg har ikke fundet noget :)

MB

Ja så er jeg her igen har lige et spm til :)
hvis jeg smider en popupmenu til op StaticText virker det godt nok så lidt den tager den normale fra mit normale ur først og så min bagefter kan man ikke lave noget fuxk der :)

MB

endnu en bug :)
jeg har mit irc til at ligge lige ved siden af mit nye ur :) men kan ikke klikke på mit irc ikoen højreklick virker med ikke det andet :(

MB

du skriver lidt for hurtigt...

hvad er det du skrive med popup??? og med irc???

/ZIRON

Hey igen

well jeg har icq og så mit mIRC ikon i min systray lige ved siden af mit ur jeg kan ikke dobletklikke på den :(
og hvis jeg smider en popupmenu på min tekst i systray(det nye ur) virker den ikke helt den tager den fra det gamle ur først og så min popupmenu bagefter :(

MB

ingen af de ting fejler noget hos mig...

kan du ikke prøve at sende dit project til mig, så kan jeg lige kigge???

/ZIRON

pak i zip....

/ZIRON

jeg har leget lidt med det i systray\'en med har kun kunne finde på dette... du kan indtaste en streng på 2-3 (forskelligt kommer ad på størrelsen af bokstaverne) og så bliver der lavet et icon i systray\'en... prøv at kør dette:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
  Image1: TImage;
  PopupMenu1: TPopupMenu;
    Button1: TButton;
  procedure Button1Click(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure FormDestroy(Sender: TObject);
private
  function StringToIcon (const st : string) : HIcon;
public
  { Public declarations }
  IconNotifyData : TNotifyIconData;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
ICONIMAGE = record
  Width, Height, Colors : DWORD; // Width, Height and bpp
  lpBits : PChar;                // ptr to DIB bits
  dwNumBytes : DWORD;            // how many bytes?
  lpbi : PBitmapInfoHeader;      // ptr to header
  lpXOR : PChar;                // ptr to XOR image bits
  lpAND : PChar;                // ptr to AND image bits
end;

function CopyColorTable (var lpTarget : BITMAPINFO; const lpSource :
BITMAPINFO) : boolean;
var
dc : HDC;
hPal : HPALETTE;
pe : array [0..255] of PALETTEENTRY;
i : Integer;
begin
result := False;
case (lpTarget.bmiHeader.biBitCount) of
  8 :
    if lpSource.bmiHeader.biBitCount = 8 then
    begin
      Move (lpSource.bmiColors, lpTarget.bmiColors, 256 * sizeof
(RGBQUAD));
      result := True
    end
    else
    begin
      dc := GetDC (0);
      if dc <> 0 then
      try
        hPal := CreateHalftonePalette (dc);
        if hPal <> 0 then
        try
          if GetPaletteEntries (hPal, 0, 256, pe) <> 0 then
          begin
            for i := 0 to 255 do
            begin
              lpTarget.bmiColors [i].rgbRed := pe [i].peRed;
              lpTarget.bmiColors [i].rgbGreen := pe [i].peGreen;
              lpTarget.bmiColors [i].rgbBlue := pe [i].peBlue;
              lpTarget.bmiColors [i].rgbReserved := pe [i].peFlags
            end;
            result := True
          end
        finally
          DeleteObject (hPal)
        end
      finally
        ReleaseDC (0, dc)
      end
    end;

  4 :
    if lpSource.bmiHeader.biBitCount = 4 then
    begin
      Move (lpSource.bmiColors, lpTarget.bmiColors, 16 * sizeof
(RGBQUAD));
      result := True
    end
    else
    begin
      hPal := GetStockObject (DEFAULT_PALETTE);
      if (hPal <> 0) and (GetPaletteEntries (hPal, 0, 16, pe) <> 0) then
      begin
        for i := 0 to 15 do
        begin
          lpTarget.bmiColors [i].rgbRed := pe [i].peRed;
          lpTarget.bmiColors [i].rgbGreen := pe [i].peGreen;
          lpTarget.bmiColors [i].rgbBlue := pe [i].peBlue;
          lpTarget.bmiColors [i].rgbReserved := pe [i].peFlags
        end;
        result := True
      end
    end;
  1:
    begin
      i := 0;
      lpTarget.bmiColors[i].rgbRed := 0;
      lpTarget.bmiColors[i].rgbGreen := 0;
      lpTarget.bmiColors[i].rgbBlue := 0;
      lpTarget.bmiColors[i].rgbReserved := 0;
      i := 1;
      lpTarget.bmiColors[i].rgbRed := 255;
      lpTarget.bmiColors[i].rgbGreen := 255;
      lpTarget.bmiColors[i].rgbBlue := 255;
      lpTarget.bmiColors[i].rgbReserved := 0;
      result := True
      end;
  else
    result := True
end
end;

function WidthBytes (bits : DWORD) : DWORD;
begin
result := ((bits + 31) shr 5) shl 2
end;

function BytesPerLine (const bmih : BITMAPINFOHEADER) : DWORD;
begin
result := WidthBytes (bmih.biWidth * bmih.biPlanes * bmih.biBitCount)
end;

function DIBNumColors (const lpbi : BitmapInfoHeader) : word;
var
dwClrUsed : DWORD;
begin
dwClrUsed := lpbi.biClrUsed;
if dwClrUsed <> 0 then
  result := Word (dwClrUsed)
else
  case lpbi.biBitCount of
    1 : result := 2;
    4 : result := 16;
    8 : result := 256
    else
      result := 0
  end
end;

function PaletteSize (const lpbi : BitmapInfoHeader) : word;
begin
result := DIBNumColors (lpbi) * sizeof (RGBQUAD)
end;

function FindDIBBits (const lpbi : BitmapInfo) : PChar;
begin
result := @lpbi;
result := result + lpbi.bmiHeader.biSize + PaletteSize (lpbi.bmiHeader)
end;

function ConvertDIBFormat (var lpSrcDIB : BITMAPINFO; nWidth, nHeight, nbpp
: DWORD; bStretch : boolean) :
PBitmapInfo;
var
lpbmi : PBITMAPINFO;
lpSourceBits, lpTargetBits : Pointer;
DC, hSourceDC, hTargetDC : HDC;
hSourceBitmap, hTargetBitmap, hOldTargetBitmap, hOldSourceBitmap :
HBITMAP;
dwSourceBitsSize, dwTargetBitsSize, dwTargetHeaderSize : DWORD;
begin
result := Nil;
  // Allocate and fill out a BITMAPINFO struct for the new DIB
  // Allow enough room for a 256-entry color table, just in case
dwTargetHeaderSize := sizeof ( BITMAPINFO ) + ( 256 * sizeof( RGBQUAD ) );
GetMem (lpbmi, dwTargetHeaderSize);
try
  lpbmi^.bmiHeader.biSize := sizeof (BITMAPINFOHEADER);
  lpbmi^.bmiHeader.biWidth := nWidth;
  lpbmi^.bmiHeader.biHeight := nHeight;
  lpbmi^.bmiHeader.biPlanes := 1;
  lpbmi^.bmiHeader.biBitCount := nbpp;
  lpbmi^.bmiHeader.biCompression := BI_RGB;
  lpbmi^.bmiHeader.biSizeImage := 0;
  lpbmi^.bmiHeader.biXPelsPerMeter := 0;
  lpbmi^.bmiHeader.biYPelsPerMeter := 0;
  lpbmi^.bmiHeader.biClrUsed := 0;
  lpbmi^.bmiHeader.biClrImportant := 0;    // Fill in the color table
  if CopyColorTable (lpbmi^, lpSrcDIB) then
  begin
    DC := GetDC (0);
    hTargetBitmap := CreateDIBSection (DC, lpbmi^, DIB_RGB_COLORS,
lpTargetBits, 0, 0 );
    hSourceBitmap := CreateDIBSection (DC, lpSrcDIB, DIB_RGB_COLORS,
lpSourceBits, 0, 0 );

    try
      if (dc <> 0) and (hTargetBitmap <> 0) and (hSourceBitmap <> 0) then
      begin
        hSourceDC := CreateCompatibleDC (DC);
        hTargetDC := CreateCompatibleDC (DC);
        try
          if (hSourceDC <> 0) and (hTargetDC <> 0) then
          begin
            // Flip the bits on the source DIBSection to match the source DIB
            dwSourceBitsSize := DWORD (lpSrcDIB.bmiHeader.biHeight) *
BytesPerLine(lpSrcDIB.bmiHeader);
            dwTargetBitsSize := DWORD (lpbmi^.bmiHeader.biHeight) *
BytesPerLine(lpbmi^.bmiHeader);
            Move (FindDIBBits (lpSrcDIB)^, lpSourceBits^,
dwSourceBitsSize );

            // Select DIBSections into DCs
            hOldSourceBitmap := SelectObject( hSourceDC, hSourceBitmap );
            hOldTargetBitmap := SelectObject( hTargetDC, hTargetBitmap );

            try
              if (hOldSourceBitmap <> 0) and (hOldTargetBitmap <> 0) then
              begin
          // Set the color tables for the DIBSections
                if lpSrcDIB.bmiHeader.biBitCount <= 8 then
                    SetDIBColorTable (hSourceDC, 0, 1 shl
lpSrcDIB.bmiHeader.biBitCount, lpSrcDIB.bmiColors
);

                if lpbmi^.bmiHeader.biBitCount <= 8  then
                    SetDIBColorTable (hTargetDC, 0, 1 shl
lpbmi^.bmiHeader.biBitCount, lpbmi^.bmiColors );

                  // If we are asking for a straight copy, do it
                if (lpSrcDIB.bmiHeader.biWidth = lpbmi^.bmiHeader.biWidth)
and (lpSrcDIB.bmiHeader.biHeight =
lpbmi^.bmiHeader.biHeight) then
                  BitBlt (hTargetDC, 0, 0, lpbmi^.bmiHeader.biWidth,
lpbmi^.bmiHeader.biHeight, hSourceDC, 0,
0, SRCCOPY)
                else
                  if bStretch then
                  begin
                    SetStretchBltMode (hTargetDC, COLORONCOLOR);
                    StretchBlt (hTargetDC, 0, 0, lpbmi^.bmiHeader.biWidth,
lpbmi^.bmiHeader.biHeight,
hSourceDC, 0, 0, lpSrcDIB.bmiHeader.biWidth, lpSrcDIB.bmiHeader.biHeight,
SRCCOPY )
                  end
                  else
                    BitBlt (hTargetDC, 0, 0, lpbmi^.bmiHeader.biWidth,
lpbmi^.bmiHeader.biHeight, hSourceDC,
0, 0, SRCCOPY );

                GDIFlush;
                GetMem (result, Integer (dwTargetHeaderSize +
dwTargetBitsSize));

                Move (lpbmi^, result^, dwTargetHeaderSize);
                Move (lpTargetBits^, FindDIBBits (result^)^,
dwTargetBitsSize)
              end
            finally
              if hOldSourceBitmap <> 0 then SelectObject (hSourceDC,
hOldSourceBitmap);
              if hOldTargetBitmap <> 0 then SelectObject (hTargetDC,
hOldTargetBitmap);
            end
          end
        finally
          if hSourceDC <> 0 then DeleteDC (hSourceDC);
          if hTargetDC <> 0 then DeleteDC (hTargetDC)
        end
      end;
    finally
      if hTargetBitmap <> 0 then DeleteObject (hTargetBitmap);
      if hSourceBitmap <> 0 then DeleteObject (hSourceBitmap);
      if dc <> 0 then ReleaseDC (0, dc)
    end
  end
finally
  FreeMem (lpbmi)
end;

end;

function DIBToIconImage (var lpii : ICONIMAGE; var lpDIB : BitmapInfo;
bStretch : boolean) : boolean;
var
lpNewDIB : PBitmapInfo;
begin
result := False;
lpNewDIB := ConvertDIBFormat (lpDIB, lpii.Width, lpii.Height, lpii.Colors,
bStretch );
if Assigned (lpNewDIB) then
try

  lpii.dwNumBytes := sizeof (BITMAPINFOHEADER)                    // Header
                    + PaletteSize (lpNewDIB^.bmiHeader)
// Palette
                    + lpii.Height * BytesPerLine (lpNewDIB^.bmiHeader)// XOR mask
                    + lpii.Height * WIDTHBYTES (lpii.Width);        // AND mask
      // If there was already an image here, free it
  if lpii.lpBits <> Nil then
    FreeMem (lpii.lpBits);

  GetMem (lpii.lpBits,  lpii.dwNumBytes);
  Move (lpNewDib^, lpii.lpBits^, sizeof (BITMAPINFOHEADER) + PaletteSize
(lpNewDIB^.bmiHeader));
    // Adjust internal pointers/variables for new image
  lpii.lpbi := PBITMAPINFOHEADER (lpii.lpBits);
  lpii.lpbi^.biHeight := lpii.lpbi^.biHeight * 2;

  lpii.lpXOR := FindDIBBits (PBitmapInfo (lpii.lpbi)^);
  Move (FindDIBBits (lpNewDIB^)^, lpii.lpXOR^, lpii.Height * BytesPerLine
(lpNewDIB^.bmiHeader));

  lpii.lpAND := lpii.lpXOR + lpii.Height * BytesPerLine
(lpNewDIB^.bmiHeader);
  Fillchar (lpii.lpAnd^, lpii.Height * WIDTHBYTES (lpii.Width), $00);

  result := True
finally
  FreeMem (lpNewDIB)
end;
end;

function TForm1.StringToIcon (const st : string) : HIcon;
var
memDC : HDC;
bmp : HBITMAP;
oldObj : HGDIOBJ;
rect : TRect;
size : TSize;
infoHeaderSize : DWORD;
imageSize : DWORD;
infoHeader : PBitmapInfo;
icon : IconImage;
oldFont : HFONT;

begin
result := 0;
memDC := CreateCompatibleDC (0);
if memDC <> 0 then
try
  bmp := CreateCompatibleBitmap (Canvas.Handle, 16, 16);
  if bmp <> 0 then
  try
    oldObj := SelectObject (memDC, bmp);
    if oldObj <> 0 then
    try
      rect.Left := 0;
      rect.top := 0;
      rect.Right := 16;
      rect.Bottom := 16;
      SetTextColor (memDC, RGB (255, 0, 0));
      SetBkColor (memDC, RGB (128, 128, 128));
      oldFont := SelectObject (memDC, font.Handle);
      GetTextExtentPoint32 (memDC, PChar (st), Length (st), size);
      ExtTextOut (memDC, (rect.Right - size.cx) div 2, (rect.Bottom -
size.cy) div 2, ETO_OPAQUE, @rect,
PChar (st), Length (st), Nil);
      SelectObject (memDC, oldFont);
      GDIFlush;

      GetDibSizes (bmp, infoHeaderSize, imageSize);
      GetMem (infoHeader, infoHeaderSize + ImageSize);
      try
        GetDib (bmp, SystemPalette16, infoHeader^, PChar (DWORD
(infoHeader) + infoHeaderSize)^);

        icon.Colors := 4;
        icon.Width := 32;
        icon.Height := 32;
        icon.lpBits := Nil;
        if DibToIconImage (icon, infoHeader^, True) then
        try
          result := CreateIconFromResource (PByte (icon.lpBits),
icon.dwNumBytes, True, $00030000);
        Finally
          FreeMem (icon.lpBits)
        end
      finally
        FreeMem (infoHeader)
      end

    finally
      SelectObject (memDC, oldOBJ)
    end
  finally
    DeleteObject (bmp)
  end
finally
  DeleteDC (memDC)
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

Application.Icon.SaveToFile(\'c:\\icon.bin\');

Application.Icon.Handle := StringToIcon (\'256\');

//Now set up the IconNotifyData structure so that it receives//the window messages sent to the application and displays
  //the application\'s tips
  with IconNotifyData do begin
    hIcon := Application.Icon.Handle;
    uCallbackMessage := WM_USER + 1;
    cbSize := sizeof(IconNotifyData);
    Wnd := Handle;
    uID := 100;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  end;



  //Add the Icon to the system tray and use the
  //the structure and its values
  Shell_NotifyIcon(NIM_ADD, @IconNotifyData);

  // Hide MainForm at startup.
  //(Remove if application is to be shown at startup)
  Application.ShowMainForm := False;

  // Toolwindows dont have a TaskIcon.
  //(Remove if TaskIcon is to be show when form is visible)
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

  Application.Icon.LoadFromFile(\'c:\\icon.bin\');

  DeleteFile(\'c:\\icon.bin\');
end;




procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
end;

end.

jeg tror ikke det er muligt at sætte en string sådan direkte der ned...

/ZIRON