Отображаем текст в System Tray

StringToIcon('Delphi World Is Cool !!!'); 
// Не забудьте удалить объект HIcon, после вызова функции... 

unit MainForm; 

interface 

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

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Image1: TImage; 
    Timer1: TTimer; 
    procedure Button1Click(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
  private 
    function StringToIcon (const st : string) : HIcon; 
  public 
    { Public declarations } 
end; 

var 
  Form1: TForm1; 

implementation 
{$R *.DFM} 

type 
  ICONIMAGE = record 
    Width, Height, Colors : DWORD; // Ширина, Высота и кол-во цветов 
    lpBits : PChar; // указатель на DIB биты 
    dwNumBytes : DWORD; // Сколько байт? 
    lpbi : PBitmapInfoHeader; // указатель на заголовок 
    lpXOR : PChar; // указатель на XOR биты изображения 
    lpAND : PChar; // указатель на AND биты изображения 
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; 
  // Располагаем и заполняем структуру BITMAPINFO для нового DIB 
  // Обеспечиваем достаточно места для 256-цветной таблицы 
  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; 
    // Заполняем в таблице цветов 
    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 
                  // Устанавливаем таблицу цветов для 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)// Заголовок 
      + PaletteSize (lpNewDIB^.bmiHeader)// Палитра
      + lpii.Height * BytesPerLine (lpNewDIB^.bmiHeader)// XOR маска 
      + lpii.Height * WIDTHBYTES (lpii.Width);// AND маска 
      // Если здесь уже картинка, то освобождаем её 
    if lpii.lpBits <> nil then 
      FreeMem (lpii.lpBits); 
    GetMem (lpii.lpBits, lpii.dwNumBytes); 
    Move (lpNewDib^, lpii.lpBits^, sizeof (BITMAPINFOHEADER) + PaletteSize (lpNewDIB^.bmiHeader)); 
    // Выравниваем внутренние указатели/переменные для новой картинки 
    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.Handle := StringToIcon ('0'); 
  Timer1.Enabled := True; 
  Button1.Enabled := False; 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
const 
  i : Integer = 0; 
begin 
  Inc (i); 
  if i = 100 then 
    i := 1; 
  Application.Icon.Handle := StringToIcon (IntToStr (i)); 
end; 

end.

This is a Delphi programming code that converts a string to an icon image and sets it as the application's icon. The code defines several functions:

1. ConvertDIBFormat: Converts a DIB (Device-Independent Bitmap) format to a new format.
2. DIBToIconImage: Converts a DIB image to an IconImage structure.
3. StringToIcon: Converts a string to an icon image and sets it as the application's icon.

The code also defines two procedures:

1. Button1Click: Handles the click event of a button, which disables the button and enables a timer.
2. Timer1Timer: Handles the timer event, which increments a counter and updates the application's icon with the new value.

Here is a brief description of what each part of the code does:

• The ConvertDIBFormat function takes a DIB image as input and returns a new DIB image in a different format. It uses the BITMAPINFOHEADER structure to describe the image.
• The DIBToIconImage function converts a DIB image to an IconImage structure, which is used to represent an icon image.
• The StringToIcon function takes a string as input and converts it to an icon image using the ConvertDIBFormat and DIBToIconImage functions. It then sets the application's icon with the new value.
• The Button1Click procedure handles the click event of a button, which disables the button and enables a timer.
• The Timer1Timer procedure handles the timer event, which increments a counter and updates the application's icon with the new value.

The code is written in Delphi, a programming language that is used to develop Windows applications. It uses the VCL (Visual Component Library) framework to create graphical user interfaces and interacts with the operating system using Win32 APIs.