::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2004-08-11 21:13:51, Hit : 5136, Vote : 1231
 http://www.howto.pe.kr
 Task bar 에 나타나는 프로그램 아이콘 바꾸기

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, 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);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    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;
    dwNumBytes : DWORD;
    lpbi : PBitmapInfoHeader;
    lpXOR : PChar;
    lpAND : PChar;                
  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;
  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
                 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)
                     + lpii.Height * WIDTHBYTES (lpii.Width);
   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(IntToStr(Timer1.Tag));
  Timer1.Enabled := True;
  Button1.Enabled := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i : Integer;
begin
  Timer1.Tag := Timer1.Tag + 1;
  if Timer1.Tag = 100 then
    Timer1.Tag := 1;

  Application.Icon.Handle := StringToIcon (IntToStr (Timer1.Tag));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := False;
end;

end.





571   [네트웍/인터넷] 네트워크의 컴퓨터 이름,작업 그룹,컴퓨터 설명  김영대 2003/03/06 5248 1188
570   [일반/컴포넌트] 컴포넌트에 동적으로 이벤트 할당하기  김영대 2004/10/08 5244 1199
569   [일반/컴포넌트] 임시파일명 자동으로 생성하기  김영대 2003/03/07 5235 1669
568   [일반/컴포넌트] TObject의 프로퍼티를 문자열로 참조하기  김영대 2003/03/06 5235 1595
567   [일반/컴포넌트] 9가지 파일정보  김영대 2003/03/05 5235 1315
566   [시스템] NTFS 파일 시스템 사용 여부  김영대 2004/08/25 5234 1373
565   [시스템] 윈도우즈의 "국가별 설정" 읽어오기  김영대 2003/03/06 5234 1568
564   [윈도우즈 API] 콤포넌트의 Hint 에 그림(Bitmap) 넣기  김영대 2003/04/11 5230 1360
563   [데이터베이스] DB에서 자음(ㄱ,ㄴ,ㄷ....)으로 SELECT 하기  김영대 2003/03/12 5229 1234
562   [윈도우즈 API] 바탕화면 아이콘의 글자색 바꾸기2  김영대 2003/03/07 5229 1474
561   [윈도우즈 API] 네트워크 환경의 "컴퓨터 찾아보기" 화면 띄우기  김영대 2003/04/01 5223 1205
560   [시스템] 디스크의 남은 용량 등등...  김영대 2003/03/05 5223 1425
559   [시스템] DOS 명령어 실행하고 결과 받아오기  김영대 2003/03/27 5220 1280
558   [일반/컴포넌트] INF 파일 설치하기  김영대 2003/03/26 5217 1295
557   [일반/컴포넌트] ListBox에 Edit 올려 항목 편집하기  김영대 2006/02/28 5214 1323
556   [시스템] Shutdown/Reboot/Logoff Windows 9x/NT/Me/2000 ?  김영대 2003/03/07 5211 1386
555   [시스템] 파일복사 6가지 방법  김영대 2003/03/05 5211 1249
554   [알고리즘] 구분자(delimiter)를 사용한 문자열 파싱(parsing)  김영대 2003/11/13 5209 1149
553   [윈도우즈 API] bitmap을 JPEG로 변환  김영대 2003/03/04 5201 1398
552   [윈도우즈 API] 세로 타이틀바 만들기  김영대 2004/08/04 5200 1404
551   [윈도우즈 API] CTRL+ALT+DEL 에 나타나지 않는 프로그램  김영대 2003/03/07 5198 1300
550   [윈도우즈 API] 바탕화면, 시작메뉴 icon 숨기기  김영대 2003/03/07 5184 1257
549   [데이터베이스] Stored Procedure 작성을 어떻게 하나  김영대 2003/03/04 5182 1344
548   [윈도우즈 API] 폼의 최대/최소화 막기  김영대 2003/03/06 5181 1392
547   [윈도우즈 API] 바탕화면 아이콘의 글자색 바꾸기  김영대 2003/03/07 5179 1304
546   [윈도우즈 API] Task bar 에 나타나지 않는 프로그램 만들기  김영대 2003/03/07 5179 1513
545   [시스템] 어떤 어플리케이션이 시작 되는지 hook으로 알아내기  김영대 2003/03/07 5175 1543
544   [일반/컴포넌트] MS-OutLook 으로 메시지 보내기  김영대 2003/03/07 5172 1181
543   [일반/컴포넌트] 주어진 달의 주수  김영대 2003/03/05 5159 1671
542   [일반/컴포넌트] 절대경로와 상대경로 결합  김영대 2004/08/25 5158 1445
541   [윈도우즈 API] 전체 화면(Full Screen) 만들기  김영대 2003/03/29 5156 1330
540   [시스템] 내 프로그램의 실행 우선순의 바꾸기  김영대 2004/07/24 5155 1399
539   [윈도우즈 API] 날짜변형에 대해서...  김영대 2003/03/04 5152 1280
538   [일반/컴포넌트] 텍스트 파일 합치기(Merging)  김영대 2003/03/07 5151 1148
537   [일반/컴포넌트] 객체의 valid검사 Assigned() 대체  김영대 2005/07/29 5144 1346
536   [일반/컴포넌트] 문자열의 끝에서부터 검색하는 Pos() 함수  김영대 2003/03/07 5141 1180
535   [네트웍/인터넷] 스팸(spam) IP 인지 검사하기  김영대 2004/08/17 5139 1268
  [일반/컴포넌트] Task bar 에 나타나는 프로그램 아이콘 바꾸기  김영대 2004/08/11 5136 1231
533   [일반/컴포넌트] 디렉토리 검색하여 파일 찾기  김영대 2003/03/05 5136 1492
532   [윈도우즈 API] 마우스의 모양 바꾸고 이동범위 제한하기  김영대 2003/03/05 5134 1267

[이전 10개] [1].. 11 [12][13][14][15][16][17][18][19][20]..[25] [다음 10개]
 

Copyright 1999-2022 Zeroboard / skin by zero