Developing with Graphics/sk

From Free Pascal wiki
Jump to navigationJump to search

│ Deutsch (de) │ English (en) │ español (es) │ français (fr) │ italiano (it) │ 日本語 (ja) │ 한국어 (ko) │ Nederlands (nl) │ português (pt) │ русский (ru) │ slovenčina (sk) │ 中文（中国大陆）‎ (zh_CN) │ 中文（台灣）‎ (zh_TW) │

Táto stránky má byť počiatočný postup s ohľadom na manipuláciu s bitmapami a inou grafikou. Keďže nie som programátor grafiky, pozývam všetkých na zdieľanie ich skúseností! Jednoducho pridajte odkaz na ďalšiu sekciu, pridajte stránku a vytvorte svoj vlastný článok WiKi.

Na tejto stránke budú poskytnuté niektoré všeobecné informácie.

Ďalšie grafické články

  • GLScene (en) - Port vizuálnej OpenGL grafickej knižnice GLScene
  • TAChart (en) - Diagramový komponent pre Lazarus
  • PascalMagick (en) - jednoducho použiteľné API pre prepojenie s ImageMagick, viacplatformová slobodná sada programov pre vytváranie, úpravu a kompozíciu bitmapových obrázkov.
  • PlotPanel (en) - Zapisovací a kresliaci komponent pre animované grafy.
  • LazRGBGraphics (en) - Balíček pre pre rýchle spracovanie a manipuláciu s obrázkami v pamäti (ako scan line).
  • Perlin Noise (en) - Článok o používaní Perlin Noise v LCL aplikáciách.

Práca s TBitmap

Prvá vec, na ktrorú treba pamätať je, že Lazarus je zamýšľaný ako platformovo nezávislý, tak všetky metódy používajúce funkcie Windows API sú mimo. Takže metóda ako ScanLine nie je v Lazarus podporovaná, pretože je určená pre Device Independant Bitmap a používa funkcie z GDI32.dll.

Zapamätajte si, že ak nezadáte výšku a šírku svojho TBitmap, bude mať štandardnú veľkosť, ktorá je celkom malá.

Príklad miznutia

Predstavte si, že chcete vytvoriť miznúci obrázok. V Delphi môžete urobiť niečo také: <pascal> 

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;

procedure TForm1.FadeIn(aBitMap: TBitMap);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;  //  or pf24bit
    Bitmap.Assign(aBitMap);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      for step := 0 to 32 do begin
        for y := 0 to (Bitmap.Height - 1) do begin
          BaseRow := BaseBitmap.Scanline[y];
          Row := Bitmap.Scanline[y];
          for x := 0 to (Bitmap.Width - 1) do begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap);
        InvalidateRect(Form1.Handle, nil, False);
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

</pascal>

V Lazarus môže byť táto funkcia implementovaná takto: <pascal> uses LCLType, // HBitmap type 

    IntfGraphics, // TLazIntfImage type
    fpImage; // TFPColor type

... 

procedure TForm1.FadeIn(ABitMap: TBitMap);
var
  SrcIntfImg, TempIntfImg: TLazIntfImage;
  ImgHandle,ImgMaskHandle: HBitmap;
  FadeStep: Integer;
  px, py: Integer;
  CurColor: TFPColor;
  TempBitmap: TBitmap;
begin
  SrcIntfImg:=TLazIntfImage.Create(0,0);
  SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
  TempIntfImg:=TLazIntfImage.Create(0,0);
  TempIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
  TempBitmap:=TBitmap.Create;
  for FadeStep:=1 to 32 do begin
    for py:=0 to SrcIntfImg.Height-1 do begin
      for px:=0 to SrcIntfImg.Width-1 do begin
        CurColor:=SrcIntfImg.Colors[px,py];
        CurColor.Red:=(CurColor.Red*FadeStep) shr 5;
        CurColor.Green:=(CurColor.Green*FadeStep) shr 5;
        CurColor.Blue:=(CurColor.Blue*FadeStep) shr 5;
        TempIntfImg.Colors[px,py]:=CurColor;
      end;
    end;
    TempIntfImg.CreateBitmap(ImgHandle,ImgMaskHandle,false);
    TempBitmap.Handle:=ImgHandle;
    TempBitmap.MaskHandle:=ImgMaskHandle;
    Canvas.Draw(0,0,TempBitmap);
  end;
  SrcIntfImg.Free;
  TempIntfImg.Free;
  TempBitmap.Free;
end;

</pascal>

Lazarus kód na tejto stránke bol prevzatý z projektu $LazarusPath/examples/lazintfimage/fadein1.lpi, takže ak chcete letmý štart s grafickým programovaním pozrite sa na tento príklad.

Kreslenie bitmáp transparentnou farbou

Nová vlastnosť, implementovaná od Lazarus 0.9.11, sú farebne transparentné bitmapy. Bitmapové súbory (*.BMP) neuchovávajú žiadnu informáciu o priehľadnosti, ale môžu takto pracovať, ak im zvolíte farbu, ktorá bude reprezenzovať priesvitnú oblasť. To je bežný trik používaný v programoch Win32.

Nasledujúci príklad načíta bitmapu zo zdroja Windows, vyberie farbu pre priehľadnosť (clFuchsia) a potom ho nakreslí na plátno.

<pascal> procedure MyForm.MyButtonOnClick(Sender: TObject); var 

 buffer: THandle;
 bmp: TBitmap;
 memstream: TMemoryStream;

begin 

 bmp := TBitmap.Create;

 buffer := Windows.LoadBitmap(hInstance, MAKEINTRESOURCE(ResourceID));

 if (buffer = 0) then exit; // Error loading the bitmap

 bmp.Handle := buffer;
 memstream := TMemoryStream.create;
 try
   bmp.SaveToStream(memstream);
   memstream.position := 0;
   bmp.LoadFromStream(memstream);
 finally
   memstream.free;
 end;

 bmp.Transparent := True;
 bmp.TransparentColor := clFuchsia;

 MyCanvas.Draw(0, 0, bmp);

 bmp.Free; // Release allocated resource

end; </pascal>

Všimnite si pamäťové operácie robené pomocou TMemoryStream, ktoré sú potrebné na zaistenie správne načítania obrázku.

Zachytenie snímky obrazovky

Od Lazarus 0.9.16 môžete použiť LCL pre zachytenie snímku obrazovky platformovo nezávislým spôsobom. Nasledujúci príklad kódu to robí (pracuej na gtk2 a win32, ale nie na gtk1):

<pascal> 

 uses LCLIntf, LCLType;

 ...

var 

 MyBitmap: TBitmap;
 ScreenDC: HDC;

begin 

 MyBitmap := TBitmap.Create;
 ScreenDC := GetDC(0);
 MyBitmap.LoadFromDevice(ScreenDC);
 ReleaseDC(ScreenDC);

 ...

</pascal>

Pohyblivá grafika - Ako sa vyhnúť blikaniu

Mnoho programov kreslí svoj výstup do GUI ako 2D obrázky. Ak sa majú tieto obrázky rýchlo zmeniť, stretnete sa s problémom: rýchla zmena obrázkov často na obrazovke bliká. Tak sa stáva, že používatelia niekedy vidia celé obrázky a niekedy len ich čiastočné vykreslenie. To nastávapretože proces vykreslenia vyžaduje čas.

Ale ako predísť blikaniu a získať vyššiu rýchlosť kreslenia? Sasmozrejme môžete pracovať s hardvérovou akceleráciou pomocou OpenGL, ale tento prístup je úplne ťažký pre malé programy alebo staré počítače. Tu sa zameriame na kreslenie do TCanvas. Ak potebujetepomôcť s OpenGL, pozrite si príklad, ktorý je v Lazarus. Môžete tiež použiť A.J. Ventersov gamepack, ktorý poskytuje dvojito buferované kresliace plátno a malý komponent.

Teraz môžme preskúmať voľby, ktroé máme pre kreslenie do Canvas:

Kreslenie do TImage

TImage pozostáva z dvoch častí: TGraphic, zvyčajne TBitmap, uchováva trvalý obrázok a viditeľnú oblasť, ktorá je prekreslená pri každom OnPaint. Zmena veľkosti TImage nemení veľkosť bitmapy.

Obrázok (alebo bitmapa) je dostupná cez Image1.Picture.Graphic (alebo Image1.Picture.Bitmap). Plátno je Image1.Picture.Bitmap.Canvas. Plátno viditeľnej oblasti TImage je prístupné len počas Image1.OnPaint cez Image1.Canvas.

Dôležité: Nikdy nepoužívajte udalosť OnPaint prvku Image1 pre kreslenie grafiky/bitmapy TImage. Obrázok z TImage je buferovaný, takže potrebujete len nakresliť ho z hcikade a zmena je tam navždy. Avšak, ak ho trvalo prekresľujete, obrázok bude blikať. V tomto prípade treba skúsiť iné vlastnosti. Kreslenie do TImage je považované za pomalšie ako iné prístupy.

Zmena veľkosti bitmapy z TImage

Poznámka: Nepoužívajte to počas OnPaint.

<pascal> 

 with Image1.Picture.Bitmap do begin
   Width:=100;
   Height:=120;
 end;</pascal>

Kreslenie na bitmapu z TImage

Poznámka: Nepoužívajte to počas OnPaint.

<pascal> 

 with Image1.Picture.Bitmap.Canvas do begin
   // fill the entire bitmap with red
   Brush.Color:=clRed;
   FillRect(0,0,Width,Height);
 end;</pascal>

Poznámka: Vo vnútri Image1.OnPaint ukazuje Image1.Canvas na nestálu viditeľnú oblasť. Na rozdiel od Image1.OnPaint, prvok Image1.Canvas ukazuje na Image1.Picture.Bitmap.Canvas.

Iný príklad:

<pascal> 

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  x, y: Integer;
begin
  // Draws the backgroung
  MyImage.Canvas.Pen.Color := clWhite;
  MyImage.Canvas.Rectangle(0, 0, Image.Width, Image.Height);
  
  // Draws squares
  MyImage.Canvas.Pen.Color := clBlack;
  for x := 1 to 8 do
   for y := 1 to 8 do
    MyImage.Canvas.Rectangle(Round((x - 1) * Image.Width / 8), Round((y - 1) * Image.Height / 8),
       Round(x * Image.Width / 8), Round(y * Image.Height / 8));
end;

</pascal>

Kreslenie na premenlivú vizuálnu oblasť TImage

Do tejto oblasti možno kresli len počas OnPaint. OnPaint je volaná automaticky z LCL, keď sa oblasť stane neplatnou. Manuálne môžete zneplatniť oblasť pomocou Image1.Invalidate, ale toto nezavolá OnPaint okamžite a môžete ho volať koľkokrát chcete. <pascal> 

 procedure TForm.Image1Paint(Sender: TObject);
 begin
   with Image1.Canvas do begin
     // paint a line
     Pen.Color:=clRed;
     Line(0,0,Width,Height);
   end;
 end;</pascal>

Kreslenie počas udalosti OnPaint

V tomto prípade bude celé kreslenie urobené počas udalosti OnPaint formulára. Nezostáva v buferi, ako pri TImage.

Tvorba vlastného prvku, ktorý kreslí sám seba

Vytvorenie vlastného ovládacieho prvku má výhodu v štruktúrovaní svojho kódu a v opakvanom použití prvku. Toto riešenie je veľmi rýchle, ale stále môže generovať blikanie, ak nenakreslíte najprv do TBitmap a až potom nevykreslíte do plátna. v tomto prípade nie je potrebné použitie udalosti OnPaint prvku.

Príklad vlastného prvku: <pascal> 

uses
 Classes, SysUtils, Controls, Graphics, LCLType;

type
  TMyDrawingControl = class(TCustomControl)
  public
    procedure EraseBackground(DC: HDC); override;
    procedure Paint; override;
  end;

implementation

procedure TMyDrawingControl.EraseBackground(DC: HDC);
begin
  // Uncomment this to enable default background erasing
  //inherited EraseBackground(DC);
end; 

procedure TMyDrawingControl.Paint;
var
  x, y: Integer;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    // Initializes the Bitmap Size
    Bitmap.Height := Height;
    Bitmap.Width := Width;
 
    // Draws the background
    Bitmap.Canvas.Pen.Color := clWhite;
    Bitmap.Canvas.Rectangle(0, 0, Width, Height);

    // Draws squares
    Bitmap.Canvas.Pen.Color := clBlack;
    for x := 1 to 8 do
     for y := 1 to 8 do
      Bitmap.Canvas.Rectangle(Round((x - 1) * Width / 8), Round((y - 1) * Height / 8),
       Round(x * Width / 8), Round(y * Height / 8));
      
    Canvas.Draw(0, 0, Bitmap);
  finally
    Bitmap.Free;
  end;

  inherited Paint;
end;

</pascal>

a ako ho vytvoríme na formulári: <pascal> 

procedure TMyForm.FormCreate(Sender: TObject);
begin
  MyDrawingControl:= TMyDrawingControl.Create(Self);
  MyDrawingControl.Height := 400;
  MyDrawingControl.Width := 500;
  MyDrawingControl.Top := 0;
  MyDrawingControl.Left := 0;
  MyDrawingControl.Parent := Self;
  MyDrawingControl.DoubleBuffered := True;
end;</pascal>

len ho nezabudnite zničiť: <pascal> 

procedure TMyForm.FormDestroy(Sender: TObject);
begin
  MyDrawingControl.Free;
end;

</pascal>

nastvenie vlastností Top a Left na nulu nie je potrebné, pretože to je štandardná pozícia, ale je urobené aby zdôraznenie umiestneniaprvku.

"MyDrawingControl.Parent := Self;" je veľmi dôležité a neuvidíte svoj prvok ak to nenastavíte.

"MyDrawingControl.DoubleBuffered := True;" je vyžadované na predídenie blikania vo Windows. V gtk nemá vplyv.

Použitie A.J.Venterovho gamepack

Prístup v gamepack je kreslenie všetkého do dvojito buferovaného plátna, ktoré len berie aktualizácie viditeľného plátna, keď sme pripravení. To zaberá kúsok kódu, ale má to výhodu v schopnosti veľkej rýchlosti zmien scien s viacnásobnými škriatkami na ňom. Ak chcete použiť toto riešenie, asi Vás bude zaujímať A.J. Venterov gamepack, skupina komponentov pre vývoj hier v Lazarus, ktoré poskytujú dvojito buferovanú zobrazovaciu oblasť komponentu ako aj vnorené komponenty, navrhnuté pre dobré integrovanie s inými. gamepack môžete získať pomocou SVN: 

svn co svn://silentcoder.co.za/lazarus/gamepack

Spolupracovníci a zmeny

  • Preložil --Komunista 22:01, 26 December 2007 (CET)
Retrieved from "http://wiki.freepascal.org/index.php?title=Developing_with_Graphics/sk&oldid=25851"