На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Отобразить текст в трее
    Song
    Сообщ. #1 ,
      Unregistered
      Данный код сперва конвертирует Ваш текст в DIB, а затем DIB в иконку и далее в ресурс. После этого изображение иконки отображается в System Tray.
      Совместимость: Все версии Delphi
      Пример:
      Вызов просходит следующим образом....

      StringToIcon('This Is Made By Ruslan K. Abu Zant');

      N.B>> Не забудьте удалить объект HIcon, после вызова функции...

      ExpandedWrap disabled
        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.


      Автор: Ruslan Abu Zant (delphi@neo.net.ua)
      Источник: http://www.sources.ru/delphi/

      Взято с http://www.delphimaster.ru/cgi-bin/faq.pl?...=988620752&n=15

      Тема - элемент ЧАВО. Подготовлена by © Song
      Сообщение отредактировано: s-mike -
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0159 ]   [ 16 queries used ]   [ Generated: 27.04.24, 19:15 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.