Ikonka z bitmapy

Piotrekdp

To jest kod który konwertuje bitmapę do ikony -
ikona tylko 16 kolorowa

Objaśnienia :

*IconBitmap-bitmapka z której robimy ikonkę.

  • InhertedColor - Kolor Odwrócony , kolor Ten na pulpicie jest przeźroczysty a np.w folderze jest kolorem odwróconym (negatywem) podanego jeśli klikniemy w ikonkę staje się on preźroczysty.

  • xHotspot,yHotspot - Ustawienia gorącego punktu ikonki / kursora.

Procedure MakeIcon(const IconBitmap:TBitmap;TransparentColor, InhertedColor:TColor;
var IconOut:Ticon;xHotspot:Cardinal=0;yHotspot:Cardinal=0 );
var
AndMask,XorMask:TBitmap;
H,V:Byte;
IconInfo : TIconInfo;
TempIsTransparent:boolean;
TempTransparentColor:TColor;

begin
//--------- do przywrócenia "starych" ustawien bitmapki
TempIsTransparent:=IconBitmap.Transparent;
TempTransparentColor:=IconBitmap.TransparentColor;
//----------

IconBitmap.TransparentColor :=clWhite;
IconBitmap.Transparent :=false;

Andmask:=Tbitmap.Create;
Xormask:=Tbitmap.Create;

IconOut.Width:=IconBitmap.Width;
IconOut.Height:=IconBitmap.Height;
IconInfo.fIcon := true;
IconInfo.xHotspot := xHotspot; {ustawienia gorącego punktu}
IconInfo.yHotspot := yHotspot;
// Tworzenie Masek
Andmask.Width:=IconBitmap.Width;
Andmask.Height:=IconBitmap.Height;
Andmask.Canvas.Draw(0,0,Iconbitmap);
XorMask.Width:=IconBitmap.Width;
XorMask.Height:=IconBitmap.Height;
XorMask.Monochrome:=true;

for V:=0 to IconBitmap.Height-1 do
for H:=0 to IconBitmap.Width-1 do
begin
if IconBitmap.Canvas.Pixels[H,V]=TransparentColor then

 begin
  AndMask.Canvas.Pixels[H,V]:=$000000;
  XorMask.Canvas.Pixels[H,V]:=$ffffff;
  end else
  if IconBitmap.Canvas.Pixels[H,V]=InhertedColor then
  XorMask.Canvas.Pixels[H,V]:=$ffffff;

end;

//koniec tworzenia masek - tworzenie ikonki
IconInfo.hbmMask := xorMask.Handle;
IconInfo.hbmColor := andMask.Handle;
IconOut.Handle := CreateIconIndirect(IconInfo);
Andmask.Free;
Xormask.Free;
//przywracanie "starych ustawień"
IconBitmap.Transparent:=TempIsTransparent;
IconBitmap.TransparentColor:=TempTransparentColor;
end;


<b>Użycie:</b>
```delphi
 var
 Ikona:TIcon;
 Bitmap:TBitmap;

Ikona:=TIcon.Create; // Tworzymy zmienną
Bitmap:=TBitmap.Create; //tworzymyBitmapkę
Bitmap.Canvas.Brush.Color:= clred;
Bitmap.Width :=32;
Bitmap.Height :=32;
Bitmap.Canvas.Font.Color:=clgreen;
Bitmap.Canvas.TextOut(5,5,'Test');
MakeIcon(Bitmap,clRed,clGreen,Ikona); // tworymy ikonkę 

W przykładzie jako przeźroczysty wybrałem Czerwony a jako odwróny zielony w efekcie uzyskam ikonkę przeźroczystą z różowym napisem test widocznym w np. folderze (różowym bo to negatyw zielonego) znikającym przy kliknięciu .
Ikonka ta po przeniesieniu na pulpit będzie zupełnie niewidoczna bo kolor czerwony jest przeźroczysty
a napis "Test" zrobiony kolorem Inherted kóry również znika.
Gdybym jako inhertedColor nie ustawił zielonego napis pozostałby zielony.
Podobnie TransparentColor mógłbym ustawić na inny i uzyskałbym czerwoną ikonkę z zielonym napisem
Powyższa procedura Zmienne xHotspot,yHotspot ustawia domyślnie na 0 więc nie musiałem pisać

MakeIcon(Bitmap,clRed,clGreen,Ikona,0,0);

(jak ktoś chce inne wartości to zwyczajnie dopisuje je po przecinku).

5 komentarzy

Jest jeszcze inny sposób - znalazłem na torry.net

procedure bmp2ico(Image: TImage; FileName: TFilename);
var
  Bmp: TBitmap;
  Icon: TIcon;
  ImageList: TImageList;
begin
  Bmp  := TBitmap.Create;
  Icon := TIcon.Create;
  try
    Bmp.Assign(Image.Picture);
    ImageList := TImageList.CreateSize(Bmp.Width, Bmp.Height);
    try
      ImageList.AddMasked(Bmp, Bmp.TransparentColor);
      ImageList.GetIcon(0, Icon);
      // zapisywanie do pliku
      Icon.SaveToFile(FileName);
    finally
      ImageList.Free;
    end;
  finally
    Bmp.Free;
    Icon.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    bmp2ico(Image1, \'test.ico\');
end;

znalazłem jeszcze inną metode
http://www.swissdelphicenter.ch/torry/showcode.php?id=426
(ale nie kopiuje bo po co )
ps ta pierwsza metoda "długa" metoda jest lepsza gdy robimy własną maske
wtedy można zrobić dowolne warianty ikonki :)

Ładnie wygląda ale nie wiem jak zadziała w praktyce. No ale w końcu znalazłem taki bajer bo od dawna czegoś takiego szukałem

nie testowalem - ale wyglada ladnie :)
// tylko IMO to bardziej FAQ/Gotowiec nie art

o, super! :) Tylko, ze tutaj \" FICO.SaveToFile(\'ikona.ico\')\" zapomniales srednika na koncu linii ;) Poza tym mozna zamiast tego \'ikona.ico\' wrzucic zmienna (dodac parametr do procedury np.) :)