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;

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;

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.

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;

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.

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;

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.

Jak vidíte, lze bez problému měnit všechny základní parametry textu. Pokud by vám snad nevyhovovalo, že je text transparentní, stačí příslušným způsobem změnit Brush.Style například na bsSolid a v tom případě bude pod textem pozadí.
A to je pro dnešek všechno. Příště si ještě ukážeme několik drobných funkcí s obrázky a začneme se opět věnovat jiným tématům.

Příklad opět předpokládá, že v komponentě Image máte již načtenu bitmapu, a samotné přidání textu bude opět voláno jako událost stisku tlačítka:
procedure TForm1.Button1Click(Sender: TObject);
begin
with Image1.Picture.Bitmap.Canvas do
begin
Font.Color := clRed;
Brush.Style := bsclear;
Font.Size := 13;
TextOut(10, 10, 'Dnes je 3.4. 2002');
end;
end;

Transparentní text v obrázku

Velmi užitečnou funkcí též může být umístění transparentního textu, tedy textu s průhledným pozadím, přímo do obrázku. Jaký může být způsob využití takové funkce? Namátkou mě napadá třeba situace, kdy potřebujete hromadně u desítek obrázků přidat do jejich rohu váš copyright nebo časový údaj pro budoucí prezentaci. V tom případě vám může tato funkce ušetřit řadu času.

Převod barev do odstínů šedi

Převod barev obrázku do odstínů šedi je další z obvyklých funkcí a řekl bych, že docela potřebnou, protože řada fotografií získá převodem na "černobílou" zcela jiný umělecký rozměr. Ale to teď nechme stranou, ukažme si rovnou samotnou funkci na převod. Podobně jako u předchozích funkcí lze i tuto provést řadou způsobů, z nichž jeden vám předkládám:
procedure Grayscale(const Bmp: TBitmap);
type
TRGBArray = array[0..32767] of TRGBTriple;
pRGBArray = ^TRGBArray;
var
x, y, Gray: Integer;
Row: pRGBArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.ScanLine[y];
for x := 0 to Bmp.Width - 1 do
begin
Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
Row[x].rgbtRed := Gray;
Row[x].rgbtGreen := Gray;
Row[x].rgbtBlue := Gray;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Image1.Picture <> nil then Grayscale(Image1.Picture.Bitmap);
Form1.Image1.Repaint;
end;
Opět, stejně jako u všech předchozích příkladů, je třeba mít na formuláři komponentu Image, do které například pomocí OpenPictureDialogu nejprve načteme bitmapu.

Funkce je opět volána jako událost tlačítka. Jak vidíte, parametry umožňují pracovat zvlášť se zdrojovým a cílovým obrázkem, takže pokud chcete vidět hezky vedle sebe původní a nový obrázek, stačí si přidat na formulář druhou komponentu Image a upravit parametry volané funkce. V tom případě také můžete smazat volání Repaint zdrojového obrázku, protože již nebude třeba.

Tónování barev obrázku

Dalo by se říci, že tato funkce patří již do kategorie efektů, i když je to jen velmi jednoduchý efekt. Jedná se – zjednodušeně řečeno – o to, že barvy obrázku budou tónovány uživatelem definovanou barvou, takže získají určitý barevný nádech. Je to stejné, jako bychom se na obrázek dívali přes průhlednou fólii dané barvy.
procedure Tonovani(aSource, aTarget: TBitmap; AColor: TColor);
var
i, j: integer;
s, t: pRGBTriple;
r, g, b: byte;
cl: Tcolor;
begin
cl := ColorToRGB(aColor);
r := GetRValue(cl);
g := GetGValue(cl);
b := GetBValue(cl);
ASource.PixelFormat := pf24bit;
ATarget.PixelFormat := pf24bit;
ATarget.Width := aSource.Width;
ATarget.Height := aSource.Height;
for i:= 0 to aSource.Height - 1 do
begin
s := aSource.ScanLine[i];
t := aTarget.ScanLine[i];
for j := 0 to aSource.Width - 1 do
begin
t^.rgbtRed := (r * s^.rgbtRed) div 255;
t^.rgbtGreen := (g * s^.rgbtGreen) div 255;
t^.rgbtBlue := (b * s^.rgbtBlue) div 255;
inc(s);
inc(t);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Image1.Picture <> nil then
if ColorDialog1.Execute then Tonovani(Image1.Picture.Bitmap, Image1.Picture.Bitmap, ColorDialog1.Color);
Image1.Repaint;
end;

Rotace obrázku

I následující funkce patří mezi skupinu těch, které patří mezi nejzákladnější při práci s obrázky. Ukážeme si, jak rotovat obrázek o 90 stupňů. V podstatě by se dalo funkce použít i na rotaci o 180 či 270 stupňů jejím opakovaným použitím, i když by to bylo poněkud těžkopádné řešení.
.
.
.
type
THelpRGB = packed record
rgb: TRGBTriple;
dummy: byte;
end;
TRGBArray = array[0..0] of TRGBTriple;
pRGBArray = ^TRGBArray;
.
.
.

procedure Rotace90(Bitmap: TBitmap);
var
aStream: TMemorystream;
header: TBITMAPINFO;
dc: hDC;
P: ^THelpRGB;
x, y, b, h: Integer;
RowOut: pRGBArray;
begin
aStream := TMemorystream.Create;
aStream.SetSize(Bitmap.Height * Bitmap.Width * 4);
with header.bmiHeader do
begin
biSize := SizeOf(TBITMAPINFOHEADER);
biWidth := Bitmap.Width;
biHeight := Bitmap.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := 0;
biSizeImage := aStream.Size;
biXPelsPerMeter := 1;
biYPelsPerMeter := 1;
biClrUsed := 0;
biClrImportant := 0;
end;
dc := GetDC(0);
P := aStream.Memory;
GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, Header, dib_RGB_Colors);
ReleaseDC(0, dc);
b := Bitmap.Height;
h := Bitmap.Width;
Bitmap.Width := b;
Bitmap.Height := h;
for y := 0 to (h-1) do
begin
rowOut := Bitmap.ScanLine[y];
P := aStream.Memory;
Inc(p, y);
for x := 0 to (b-1) do
begin
RowOut[x] := p^.rgb;
Inc(p,h);
end;
end;
aStream.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Image1.Picture <> nil then Rotace90(Image1.Picture.Bitmap);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Image1.Picture <> nil then MirrorHorizontal(Image1.Picture.Bitmap);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if Image1.Picture <> nil then MirrorVertical(Image1.Picture.Bitmap);
end;
Jak vidíte, veškeré operace probíhají "pouze" v paměti, v rámci komponenty Image, takže nedojde k přepsání původního souboru. Budete-li chtít však takto nově upravený obrázek uložit (vytvořit nový soubor či přepsat ten původní), není to sebemenší problém pomocí procedury Picture.SaveToFile komponenty Image. Toto bude ostatně platit i o všech dalších dnešních příkladech.

.
.
.
type
EBitmapError = Class(Exception);
TRGBArray = array[0..0] of TRGBTriple;
pRGBArray = ^TRGBArray;
.
.
.

procedure MirrorVertical(Bitmap: TBitmap);
var
i, j, w : integer;
RowIn : pRGBArray;
RowOut : pRGBArray;
begin
w := Bitmap.Width * SizeOf(TRGBTriple);
GetMem(RowIn, w);
for j := 0 to Bitmap.Height - 1 do
begin
Move(Bitmap.ScanLine[j]^, RowIn^, w);
RowOut := Bitmap.ScanLine[j];
for i := 0 to Bitmap.Width -1 do RowOut[i] := RowIn[Bitmap.Width -1 - i];
end;
Bitmap.Assign(Bitmap);
FreeMem(RowIn);
end;

procedure MirrorHorizontal(Bitmap: TBitmap);
var
j, w :integer;
Tmp :Tbitmap;
begin
Tmp := TBitmap.Create;
Tmp.Width := Bitmap.Width;
Tmp.Height := Bitmap.Height;
Tmp.PixelFormat := Bitmap.PixelFormat;
w := Bitmap.Width * SizeOf(TRGBTriple);
for j := 0 to Bitmap.Height - 1 do Move(Bitmap.ScanLine[j]^, Tmp.ScanLine[Bitmap.Height -1 -j]^, w);
Bitmap.Assign(Tmp);
Tmp.Free;
end;

Převrácení obrázku po vertikální nebo horizontální ose

Jedna z nejběžnějších funkcí grafických prohlížečů nebo editorů. Zadaný obrázek (v našem případě bitmapa) se dle volby uživatele překlopí podél pomyslné vertikální či horizontální osy. Způsobů, jak toho docílit, existuje více a my si jeden z nich ukážeme.
Na formulář si připravte OpenPictureDialog a taktéž komponentu Image, do které bude obrázek načten a v níž bude také převracen. Funkce překlopení (zrcadlení) po vertikální a horizontální ose jsou jako obvykle definovány jako události dvou tlačítek.

Pro úplnost

si však uvedeme alespoň variantu, kdy uživatel zadá rozměr X a chce znát příslušné Y:
"Výsledný Rozměr Y" := ("Uživatelem požadovaný rozměr X" / "Původní rozměr X") * "Původní rozměr Y"
Trošku krkolomně zapsáno, to uznávám, ale snad je to dost ilustrativní.
A to je pro dnešek všechno. Příště budeme v tématu pokračovat a ukážeme si další příklady související s prací s grafickými soubory.

Jak docílit změny pomocí procent

(faktoru zvětšení/zmenšení)? Velice snadno: pouze změníme příslušné řádky, které upravují výsledné koeficienty u jednotlivých rozměrů. Úprava může vypadat například takto:
ScaleX := 0.25;
ScaleY := 0.25;
Zde se jedná o zmenšení obrázku na 25 % původní velikosti, a jelikož jsou pro oba rozměry koeficienty stejné, dojde též k zachování poměru stran. Pokud byste chtěli obě metody zkombinovat, tedy například uživatel určí jeden z rozměrů a vaše aplikace dopočítá rozměr druhý při zachování poměru stran, je výpočet velmi snadný a pravděpodobně jste jej již nyní odvodili sami.

základ

Všechny příklady mají stejný Všechny příklady mají stejný základ, liší se pouze ve výpočtu výsledných souřadnic. Zde je tedy základní kód:
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp : TBitmap;
Jpg : TJpegImage;
ScaleX, ScaleY : Double;
begin
if Form1.OpenPictureDialog1.Execute then
begin
Jpg:=TJpegImage.Create;
try
Jpg.LoadFromFile(Form1.OpenPictureDialog1.FileName);
ScaleX := 320 / Jpg.Width;
ScaleY := 200 / Jpg.Height;
Bmp := TBitmap.Create;
try
Bmp.Width := Round(Jpg.Width * ScaleX);
Bmp.Height := Round(Jpg.Height * ScaleY);
Bmp.Canvas.StretchDraw(Bmp.Canvas.Cliprect, Jpg);
Jpg.Assign(Bmp);
Jpg.SaveToFile('resize.jpg');
finally
Bmp.Free;
end;
finally
Jpg.Free;
end;
end;
end;
V tomto případě dojde ke změně rozlišení na 320x200 pixelů (soubor je opět uložen pod pevně zvoleným názvem).
, liší se pouze ve výpočtu výsledných souřadnic. Zde je tedy základní kód:
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp : TBitmap;
Jpg : TJpegImage;
ScaleX, ScaleY : Double;
begin
if Form1.OpenPictureDialog1.Execute then
begin
Jpg:=TJpegImage.Create;
try
Jpg.LoadFromFile(Form1.OpenPictureDialog1.FileName);
ScaleX := 320 / Jpg.Width;
ScaleY := 200 / Jpg.Height;
Bmp := TBitmap.Create;
try
Bmp.Width := Round(Jpg.Width * ScaleX);
Bmp.Height := Round(Jpg.Height * ScaleY);
Bmp.Canvas.StretchDraw(Bmp.Canvas.Cliprect, Jpg);
Jpg.Assign(Bmp);
Jpg.SaveToFile('resize.jpg');
finally
Bmp.Free;
end;
finally
Jpg.Free;
end;
end;
end;
V tomto případě dojde ke změně rozlišení na 320x200 pixelů (soubor je opět uložen pod pevně zvoleným názvem).

Změna rozlišení obrázku

I toto je běžná funkce grafických programů či prohlížečů. V našem příkladu si ukážeme konkrétně změnu rozlišení obrázku JPEG, ale postup je samozřejmě obdobný i pro jiné formáty (stejně jako všechny ostatní dnešní příklady). Při změně rozlišení má uživatel obvykle dvě možnosti, jak dosáhnout požadované velikosti. První spočívá v tom, že uživatel přímo zadá rozměry výsledného obrázku v pixelech, kdežto druhou možností je zadat faktor zmenšení/zvětšení například v procentech. Buď pro každý rozměr zvlášť, nebo za současného zachování poměru stran.