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.
    </code></pre></li>
    </ul>
    <p>Procedure MakeIcon(const IconBitmap:TBitmap;TransparentColor, InhertedColor:TColor;<br />
    var IconOut:Ticon;xHotspot:Cardinal=0;yHotspot:Cardinal=0 );<br />
    var<br />
    AndMask,XorMask:TBitmap;<br />
    H,V:Byte;<br />
    IconInfo : TIconInfo;<br />
    TempIsTransparent:boolean;<br />
    TempTransparentColor:TColor;</p>
    <p>begin<br />
    //--------- do przywrócenia "starych" ustawien bitmapki<br />
    TempIsTransparent:=IconBitmap.Transparent;<br />
    TempTransparentColor:=IconBitmap.TransparentColor;<br />
    //----------</p>
    <p>IconBitmap.TransparentColor :=clWhite;<br />
    IconBitmap.Transparent :=false;</p>
    <p>Andmask:=Tbitmap.Create;<br />
    Xormask:=Tbitmap.Create;</p>
    <p>IconOut.Width:=IconBitmap.Width;<br />
    IconOut.Height:=IconBitmap.Height;<br />
    IconInfo.fIcon := true;<br />
    IconInfo.xHotspot := xHotspot; {ustawienia gorącego punktu}<br />
    IconInfo.yHotspot := yHotspot;<br />
    // Tworzenie Masek<br />
    Andmask.Width:=IconBitmap.Width;<br />
    Andmask.Height:=IconBitmap.Height;<br />
    Andmask.Canvas.Draw(0,0,Iconbitmap);<br />
    XorMask.Width:=IconBitmap.Width;<br />
    XorMask.Height:=IconBitmap.Height;<br />
    XorMask.Monochrome:=true;</p>
    <p>for V:=0 to  IconBitmap.Height-1 do<br />
    for H:=0 to IconBitmap.Width-1 do<br />
    begin<br />
    if IconBitmap.Canvas.Pixels[H,V]=TransparentColor then</p>
    <pre><code> 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.) :)