Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 37. - Převod obrázku BMP na ikonu; Kreslení grafu funkce

Jan Šindelář - 10.4.2002

Převod obrázku BMP na ikonu

Nedílnou součástí každé aplikace je i její ikona. Jistě se nespokojíte s implicitní ikonou, kterou vaší aplikaci přiřadí Delphi, a budete si chtít vytvořit vlastní. K tomu můžete použít nějaký k tomu určený editor ikon. Pokud jej náhodou nemáte po ruce a nebo nejste natolik výtvarně schopní a raději použijete již hotový obrázek, možná se vám bude hodit následující funkce, která převede obrázek BMP na formát ikony. Ačkoliv se to může zdát jako velmi jednoduchá funkce, dokonce ani velmi oblíbený prohlížeč obrázků ACDsee ji – pokud vím – neobsahuje, a pokud jste již někdy potřebovali rychle vytvořit ikonu bez patřičného editoru, jistě mi dáte za pravdu, že to může být na první pohled celkem problém. Ten se také snaží částečně řešit naše funkce.

Samozřejmě jsou zde jistá omezení, a to především v rozlišení zdrojového obrázku. Ten si musíte předem pomocí grafického editoru upravit na rozlišení ikony (tj. 32x32, 64x64 bodů atd..). Poté na něj již jen aplikujete následující funkci a získáte soubor ICO.

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);
      Icon.SaveToFile(FileName);
    finally
      ImageList.Free;
    end;
  finally
    Bmp.Free;
    Icon.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  bmp2ico(Image1, `c:\ikonka.ico`);
end;

Všimněte si uvnitř procedury parametru TransparentColor. Ten, jak název napovídá, slouží k určení transparentní barvy ikonky, tedy barvy "pozadí", které nebude vidět. Zde je nastaven podle vstupního souboru, ale klidně můžete celou proceduru obohatit o tento parametr navíc a určovat tuto barvu přímo. Parametr je pochopitelně typu TColor.

Kreslení grafu funkce

Tento příklad sice patří mezi klasické, skoro až školní příklady z učebnice programování, ale přesto si jej ukážeme. Pokročilejším čtenářům se tedy omlouvám, ale vydržte to.

V naší ukázce budeme pro názornost kreslit graf funkce sinus. Co také jiného. Kdo ví proč se obvykle v příkladech používá tato funkce, takže nebudeme bourat tradice.

Vytvořte si tedy nový projekt a na formulář umístěte komponentu PaintBox, ve které bude graf kreslen. Vlastnost Align nastavte tak, aby komponenta vyplňovala celý formulář (tedy na hodnotu alClient). Využijeme toho k tomu, aby se nám graf automaticky přizpůsoboval velikosti okna.

Nejprve tedy zdrojový kód (jeho popis bude následovat):

.
.
.
const pInterval=1000;

private
    { Private declarations }
    FPoints: array [0..pInterval] of TPoint;

.
.
.

procedure VypocitatGraf;
var
  RozsahX, RozsahY: Integer;
  pocatek: TPoint;
  radian, interval: Double;
  i: Integer;
begin
RozsahX := (Form1.paintbox1.Width - 2) div 4;
RozsahY := (Form1.paintbox1.Height - 2) div 2;
pocatek := Point(Form1.paintbox1.Width div 2, Form1.paintbox1.Height div 2);
radian := -2.0 * Pi;
interval := 4.0 * Pi / pInterval;
for i := 0 to High(Form1.FPoints) do
begin
  Form1.FPoints[i].X := pocatek.x + Round(radian * RozsahX / Pi);
  Form1.FPoints[i].Y := pocatek.y - Round(sin(radian) * RozsahY);
  radian := radian + interval;
end;
end;

Konstanta pInterval udává "rozlišení" grafu (počet jeho bodů) na intervalu od -2Pi do 2Pi, na kterém budeme funkci vykreslovat. Čím vyšší číslo, tím více body bude graf tvořen a tím lépe bude vypadat. Tyto body budou poté propojeny výslednou křivkou (viz dále). Počátek souřadnicové soustavy grafu je umístěn na střed PaintBoxu, rozsah X-ových souřadnic je dán Pi, Y-ové souřadnice ohraničuje samozřejmě jednička. Y-ové souřadnice jsou zároveň "převráceny", jak už to u počítačů bývá. Tedy nerostou z levého dolního rohu směrem nahoru, ale z levého horního rohu směrem dolů. Že se počítá v radiánech a ne ve stupních, snad netřeba zdůrazňovat.

Takže máme tedy vypočítané body, nyní nám zbývá nakreslit samotný graf. Kreslení bude provedeno jako událost OnPaint komponenty PaintBox:

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  with PaintBox1.Canvas do
  begin
  Pen.Color := clBlue;
  Polyline(FPoints);
  end;
end;

Dále je třeba zajistit překreslování v daném měřítku při změně velikosti formuláře. Proto musíme ještě doplnit události OnCreate a OnResize formuláře:

procedure TForm1.FormResize(Sender: TObject);
begin
VypocitatGraf;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
VypocitatGraf;
end;

A tím je vlastně základ hotov. Funkce je již vykreslena. Příklad by však nebyl úplný bez nakreslení a popsání souřadnicových os. Přidáme si proto opět do události OnPaint několik dalších řádků; celá procedura tedy bude vypadat takto:

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  pocatek: TPoint;
  RozsahX, RozsahY: Integer;
begin
  with PaintBox1.Canvas do 
  begin
    {bílé pozadí grafu}
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    Fillrect(paintbox1.BoundsRect);

    {souřadnicový kříž}
    pocatek    := Point(paintbox1.Width div 2, paintbox1.Height div 2);
    Pen.Color := clBlack;
    Pen.Style := psSolid;
    Pen.Width := 1;
    MoveTo(1, pocatek.Y);
    LineTo(paintbox1.Width - 1, pocatek.y);
    MoveTo(pocatek.x, 1);
    LineTo(pocatek.x, paintbox1.Height - 1);

    Font.Name    := `Symbol`;
    Font.Size    := 8;
    Font.Color  := clBlack;
    RozsahX := (paintbox1.Width - 2) div 4;
    RozsahY := (paintbox1.Height - 2) div 2;

    {ukazatele a popis osy X}
    MoveTo(pocatek.x - 2 * RozsahX, pocatek.y - 4);
    LineTo(pocatek.x - 2 * RozsahX, pocatek.y + 4);
    TextOut(pocatek.x - 2 * RozsahX + 2, pocatek.y + 2, `-2p`);
    MoveTo(pocatek.x - RozsahX, pocatek.y - 4);
    LineTo(pocatek.x - RozsahX, pocatek.y + 4);
    TextOut(pocatek.x - RozsahX + 2, pocatek.y + 2, `-p`);
    MoveTo(pocatek.x + RozsahX, pocatek.y - 4);
    LineTo(pocatek.x + RozsahX, pocatek.y + 4);
    TextOut(pocatek.x + RozsahX - 2 - TextWidth(`p`), pocatek.y + 2, `p`);
    MoveTo(pocatek.x + 2 * RozsahX, pocatek.y - 4);
    LineTo(pocatek.x + 2 * RozsahX, pocatek.y + 4);
    TextOut(pocatek.x + 2 * RozsahX - 2 - TextWidth(`2p`), pocatek.y + 2, `2p`);

    {ukazatele a popis osy Y}
    MoveTo(pocatek.x - 4, pocatek.y - RozsahY);
    LineTo(pocatek.x + 4, pocatek.y - RozsahY);
    TextOut(pocatek.x + 4, pocatek.y - RozsahY, `1.0`);
    MoveTo(pocatek.x - 4, pocatek.y - RozsahY div 2);
    LineTo(pocatek.x + 4, pocatek.y - RozsahY div 2);
    TextOut(pocatek.x + 4, pocatek.y - (RozsahY + TextHeight(`1`)) div 2, `0.5`);
    MoveTo(pocatek.x - 2, pocatek.y + RozsahY div 2);
    LineTo(pocatek.x + 2, pocatek.y + RozsahY div 2);
    TextOut(pocatek.x + 3, pocatek.y + (RozsahY - TextHeight(`1`)) div 2, `-0.5`);
    MoveTo(pocatek.x - 2, pocatek.y + RozsahY);
    LineTo(pocatek.x + 2, pocatek.y + RozsahY);
    TextOut(pocatek.x + 3, pocatek.y + RozsahY - TextHeight(`1`), `-1.0`);

    {nakreslení samotné funkce}
    Pen.Color := clBlue;
    Polyline(FPoints);
  end;
end;

Popis jednotlivých částí najdete v podobě komentářů ve zdrojovém kódu. Samotný princip je snad dostatečně jasný, jsou to vlastně jen jednoduché čáry s textovým popisem, umístěné na příslušných místech, které se vypočítají z rozměrů formuláře (grafu).

Ještě jedno malé upozornění. Jelikož je pro vykreslení grafu, tedy propojení vypočítaných bodů křivkou, použita procedura Polyline, která všechny jednotlivé po sobě jdoucí body spojí bez ohledu na matematiku, je tento konkrétní postup použitelný na spojité funkce. Ostatní funkce by bylo vhodné vykreslovat buď bod po bodu (tedy bez jejich vzájemného propojení, a proto je třeba kvůli dobré vizuální podobě grafu použít větší přesnost – vypočítat více bodů) a nebo jiným způsobem.