Difference between revisions of "Developing with Graphics/zh TW"

From Lazarus wiki
Jump to navigationJump to search
m (Text replace - "Delphi>" to "syntaxhighlight>")
m (Fixed syntax highlighting; deleted category already in page template)
 
Line 30: Line 30:
 
接下來的範例會從 Windows 的資源裡載入一張點陣圖,把其中一個顏色指定為透明 (clFuchsia),然後在畫面上繪圖。
 
接下來的範例會從 Windows 的資源裡載入一張點陣圖,把其中一個顏色指定為透明 (clFuchsia),然後在畫面上繪圖。
  
<syntaxhighlight>procedure MyForm.MyButtonOnClick(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure MyForm.MyButtonOnClick(Sender: TObject);
 
var
 
var
 
   buffer: THandle;
 
   buffer: THandle;
Line 66: Line 67:
 
從 Lazarus 0.9.16 開始之後你可以使用跨平台的 LCL 功能來擷取畫面,下面的範例可以達成此作業。(使用 gtk2 和 win32,但不是 gtk1):
 
從 Lazarus 0.9.16 開始之後你可以使用跨平台的 LCL 功能來擷取畫面,下面的範例可以達成此作業。(使用 gtk2 和 win32,但不是 gtk1):
  
<syntaxhighlight>uses Graphics, LCLIntf, LCLType;
+
<syntaxhighlight lang=pascal>
 +
uses Graphics, LCLIntf, LCLType;
  
 
   ...
 
   ...
Line 87: Line 89:
 
使用 TLazIntfImage 做出淡出效果的範例
 
使用 TLazIntfImage 做出淡出效果的範例
  
<syntaxhighlight>{ 這段程式碼可以在這個專案 $LazarusPath/examples/lazintfimage/fadein1.lpi 裡看到。 }
+
<syntaxhighlight lang=pascal>
 +
{ 這段程式碼可以在這個專案 $LazarusPath/examples/lazintfimage/fadein1.lpi 裡看到。 }
 
uses LCLType, // HBitmap 類型
 
uses LCLType, // HBitmap 類型
 
     IntfGraphics, // TLazIntfImage 類型
 
     IntfGraphics, // TLazIntfImage 類型
Line 131: Line 134:
 
如果你知道 TBitmap 的藍色使用 8bit,綠色 8bit,紅色 8bit,你可以直接對位元存取,這樣比較快:
 
如果你知道 TBitmap 的藍色使用 8bit,綠色 8bit,紅色 8bit,你可以直接對位元存取,這樣比較快:
  
<syntaxhighlight>uses LCLType, // HBitmap 類型
+
<syntaxhighlight lang=pascal>
 +
uses LCLType, // HBitmap 類型
 
     IntfGraphics, // TLazIntfImage 類型
 
     IntfGraphics, // TLazIntfImage 類型
 
     fpImage; // TFPColor 類型
 
     fpImage; // TFPColor 類型
Line 185: Line 189:
 
這裡的範例就是從 TBitmap 建立一個 TLazIntfImage,修改後,再轉回到 TBitmap。
 
這裡的範例就是從 TBitmap 建立一個 TLazIntfImage,修改後,再轉回到 TBitmap。
  
<syntaxhighlight>uses
+
<syntaxhighlight lang=pascal>
 +
uses
 
   ...GraphType, IntfGraphics, LCLType, LCLProc,  LCLIntf ...
 
   ...GraphType, IntfGraphics, LCLType, LCLProc,  LCLIntf ...
  
Line 232: Line 237:
 
註:請勿於 OnPaint 事件時使用。
 
註:請勿於 OnPaint 事件時使用。
  
<syntaxhighlight>with Image1.Picture.Bitmap do begin
+
<syntaxhighlight lang=pascal>
 +
with Image1.Picture.Bitmap do begin
 
   Width:=100;
 
   Width:=100;
 
   Height:=120;
 
   Height:=120;
Line 241: Line 247:
 
註:請勿於 OnPaint 事件時使用。
 
註:請勿於 OnPaint 事件時使用。
  
<syntaxhighlight>with Image1.Picture.Bitmap.Canvas do begin
+
<syntaxhighlight lang=pascal>
 +
with Image1.Picture.Bitmap.Canvas do begin
 
   // 將目前的區域填滿紅色
 
   // 將目前的區域填滿紅色
 
   Brush.Color := clRed;
 
   Brush.Color := clRed;
Line 251: Line 258:
 
另一個範例:
 
另一個範例:
  
<syntaxhighlight>procedure TForm1.BitBtn1Click(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TForm1.BitBtn1Click(Sender: TObject);
 
var
 
var
 
   x, y: Integer;
 
   x, y: Integer;
Line 271: Line 279:
 
在 OnPaint 裡你只能在固定區域裡作畫。當區域無法繪製時 OnPaint 最後會自動被 LCL 呼叫,你可以用 Image1.Invalidate 來自訂無效的區域,這不會立即呼叫 OnPaint,而且你可以多次地做無效的指定。
 
在 OnPaint 裡你只能在固定區域裡作畫。當區域無法繪製時 OnPaint 最後會自動被 LCL 呼叫,你可以用 Image1.Invalidate 來自訂無效的區域,這不會立即呼叫 OnPaint,而且你可以多次地做無效的指定。
  
<syntaxhighlight>procedure TForm.Image1Paint(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TForm.Image1Paint(Sender: TObject);
 
begin
 
begin
 
   // 畫一條線
 
   // 畫一條線
Line 282: Line 291:
 
這裡的範例裡所有的繪圖作業都在表單的 OnPaint 事件發生時完成,或是某個另外的控制項。這無需像 TImage 的需要緩衝,它需要在事件處理器被呼叫的時候把所有工作一次做完。
 
這裡的範例裡所有的繪圖作業都在表單的 OnPaint 事件發生時完成,或是某個另外的控制項。這無需像 TImage 的需要緩衝,它需要在事件處理器被呼叫的時候把所有工作一次做完。
  
<syntaxhighlight>procedure TForm.Form1Paint(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TForm.Form1Paint(Sender: TObject);
 
begin
 
begin
 
   // 繪出一條線
 
   // 繪出一條線
Line 294: Line 304:
 
以下即為自訂控制項的範例:
 
以下即為自訂控制項的範例:
  
<syntaxhighlight>uses
+
<syntaxhighlight lang=pascal>
 +
uses
 
   Classes, SysUtils, Controls, Graphics, LCLType;
 
   Classes, SysUtils, Controls, Graphics, LCLType;
 
   
 
   
Line 343: Line 354:
  
 
然後我們在表單上建立它:
 
然後我們在表單上建立它:
<syntaxhighlight>procedure TMyForm.FormCreate(Sender: TObject);
+
<syntaxhighlight lang=pascal>
 +
procedure TMyForm.FormCreate(Sender: TObject);
 
begin
 
begin
 
   MyDrawingControl := TMyDrawingControl.Create(Self);
 
   MyDrawingControl := TMyDrawingControl.Create(Self);
Line 407: Line 419:
 
轉換點陣圖檔到 PNG 格式然後再儲存它:
 
轉換點陣圖檔到 PNG 格式然後再儲存它:
  
<syntaxhighlight>procedure SaveToPng(const bmp: TBitmap; PngFileName: String);
+
<syntaxhighlight lang=pascal>
 +
procedure SaveToPng(const bmp: TBitmap; PngFileName: String);
 
var
 
var
 
   png : TPortableNetworkGraphic;  
 
   png : TPortableNetworkGraphic;  
Line 428: Line 441:
 
要將各別的 RGB 頻道轉換到 TColor 時使用:
 
要將各別的 RGB 頻道轉換到 TColor 時使用:
  
<syntaxhighlight>RGBToColor(RedVal, GreenVal, BlueVal);</syntaxhighlight>
+
<syntaxhighlight lang=pascal>RGBToColor(RedVal, GreenVal, BlueVal);</syntaxhighlight>
  
 
分別使用 Red,Green,Blue 函式取得此三個頻道的 TColor 變數值。
 
分別使用 Red,Green,Blue 函式取得此三個頻道的 TColor 變數值。
  
<syntaxhighlight>RedVal := Red(MyColor);
+
<syntaxhighlight lang=pascal>
 +
RedVal := Red(MyColor);
 
GreenVal := Green(MyColor);
 
GreenVal := Green(MyColor);
 
BlueVal := Blue(MyColor);</syntaxhighlight>
 
BlueVal := Blue(MyColor);</syntaxhighlight>
Line 446: Line 460:
 
以下簡單的程式碼就可以達成:
 
以下簡單的程式碼就可以達成:
  
<syntaxhighlight>SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));</syntaxhighlight>
+
<syntaxhighlight lang=pascal>SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));</syntaxhighlight>
  
 
===在固定寬度內繪製文字===
 
===在固定寬度內繪製文字===
Line 452: Line 466:
 
使用 DrawText,先加入 DT_CALCRECT 然後再排除它。
 
使用 DrawText,先加入 DT_CALCRECT 然後再排除它。
  
<syntaxhighlight>// 首先要計算文字的尺寸才再進行繪製
+
<syntaxhighlight lang=pascal>
 +
// 首先要計算文字的尺寸才再進行繪製
 
TextBox := Rect(0, currentPos.Y, Width, High(Integer));
 
TextBox := Rect(0, currentPos.Y, Width, High(Integer));
 
DrawText(ACanvas.Handle, PChar(Text), Length(Text),
 
DrawText(ACanvas.Handle, PChar(Text), Length(Text),
Line 464: Line 479:
 
某些工具可以達到這個效果
 
某些工具可以達到這個效果
  
<syntaxhighlight>Canvas.Font.Quality := fqNonAntialiased;</syntaxhighlight>
+
<syntaxhighlight lang=pascal>Canvas.Font.Quality := fqNonAntialiased;</syntaxhighlight>
  
 
有些工具,像是 gtk2 並不支援此效果,他繪製出來的永遠都有反鋸齒補償。這裡有一個簡單的方讓你使用 gtk2 畫出這種銳角。這並不代表所有的情況,只是其中一種概念:
 
有些工具,像是 gtk2 並不支援此效果,他繪製出來的永遠都有反鋸齒補償。這裡有一個簡單的方讓你使用 gtk2 畫出這種銳角。這並不代表所有的情況,只是其中一種概念:
  
<syntaxhighlight>procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
+
<syntaxhighlight lang=pascal>
 +
procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
 
var
 
var
 
   w,h: integer;
 
   w,h: integer;
Line 521: Line 537:
  
 
需要更多資訊,請閱讀 [[fcl-image]] 文章。
 
需要更多資訊,請閱讀 [[fcl-image]] 文章。
 
[[Category:Tutorials/zh_TW]]
 

Latest revision as of 07:07, 13 February 2020

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)

本頁敘述在 Lazarus 下繪圖時所使用到的基本類別與技巧。更多特定的主題將另文說明。

其他繪圖文章

  • BGRABitmap - 繪製各種圖案,點陣圖加透明效果,直接存取圖像圖素等。
  • GLScene - 視覺化 OpenGL 圖形函式庫交流站 GLScene
  • TAChart - Lazarus 的圖表元件
  • PascalMagick - 使用 ImageMagick 應用程式介面的簡單範例,建立一個跨平台,可編輯點陣圖檔的自由軟體。
  • PlotPanel - 製作動態的圖表繪製
  • LazRGBGraphics - 該套件提供對記憶體影像的處理與圖像圖素的操作 (例如掃瞄線)。
  • Perlin Noise - 一篇於 LCL 使用 Perlin Noise 實作的應用程式。

使用 TBitmap 工作

在某些作業系統,點陣圖資料並非儲存在記憶體裡,所以無法直接存取,當 Lazarus 想要做為一個可以跨平台獨立作業的應用軟體時,TBitmap 類別就無法提供像是掃瞄線這樣的內容。這裡還有個 GetDataLineStart 函式,相等於掃瞄線 (Scanline ) 的功能,但僅能利用於記憶體裡的影像,或像使用內建的 TrawImage TLazIntfImage。

總結說來,你只能透過記憶體裡的影像去間接去修改點陣圖,然後再轉換成可繪製的點陣圖。這當然會比較慢。不然使用 Lazarus 內建的 TLazIntfImage 或是使用外部的函式庫,像是BGRABitmapLazRGBGraphicsGraphics32 可以用來直接存取點陣圖。

註:當你建立一個點陣圖時,你必須指定他寬和高,不然你所繪製的東西都會歸零。

直接存取圖像圖素

在 Delphi 裡,或用 TBitmap.Scanline 來存取圖像圖素。因為內容是無法再傳遞給別人的。Lazarus 有其他的辦法。可以參考 TLazIntfImage 而不是 TBitmap.Pixels,這非常慢。

在點陣圖裡繪製透明色

Lazarus 0.9.11 的特點之一,就是可以在點陣圖裡繪製透明色,點陣圖檔案 (*.BMP) 無法儲存透明的資訊,但若你的圖裡有透明色的設定,在 Win32 裡大多的應用程式都可以辨別的出來。

接下來的範例會從 Windows 的資源裡載入一張點陣圖,把其中一個顏色指定為透明 (clFuchsia),然後在畫面上繪圖。

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; // 載入點陣圖檔出錯

  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; // 釋放資料分派的空間
end;

注意到記憶體的操作用到 TMemoryStream。它在載入影像到記憶體裡的時候必須用到。

擷取螢幕畫面

從 Lazarus 0.9.16 開始之後你可以使用跨平台的 LCL 功能來擷取畫面,下面的範例可以達成此作業。(使用 gtk2 和 win32,但不是 gtk1):

uses Graphics, LCLIntf, LCLType;

  ...

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

  ...

使用 TLazIntfImage 作業

淡出的範例

使用 TLazIntfImage 做出淡出效果的範例

{ 這段程式碼可以在這個專案 $LazarusPath/examples/lazintfimage/fadein1.lpi 裡看到。 }
uses LCLType, // HBitmap 類型
     IntfGraphics, // TLazIntfImage 類型
     fpImage; // TFPColor 類型
...
 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.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
     TempBitmap.Handle:=ImgHandle;
     TempBitmap.MaskHandle:=ImgMaskHandle;
     Canvas.Draw(0,0,TempBitmap);
   end;
   SrcIntfImg.Free;
   TempIntfImg.Free;
   TempBitmap.Free;
 end;


影像檔格式特定範例

如果你知道 TBitmap 的藍色使用 8bit,綠色 8bit,紅色 8bit,你可以直接對位元存取,這樣比較快:

uses LCLType, // HBitmap 類型
     IntfGraphics, // TLazIntfImage 類型
     fpImage; // TFPColor 類型
...
type
  TRGBTripleArray = array[0..32767] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;

procedure TForm1.FadeIn2(aBitMap: TBitMap);
 var
   IntfImg1, IntfImg2: TLazIntfImage;
   ImgHandle,ImgMaskHandle: HBitmap;
   FadeStep: Integer;
   px, py: Integer;
   CurColor: TFPColor;
   TempBitmap: TBitmap;
   Row1, Row2: PRGBTripleArray;
 begin
   IntfImg1:=TLazIntfImage.Create(0,0);
   IntfImg1.LoadFromBitmap(aBitmap.Handle,aBitmap.MaskHandle);

   IntfImg2:=TLazIntfImage.Create(0,0);
   IntfImg2.LoadFromBitmap(aBitmap.Handle,aBitmap.MaskHandle);

   TempBitmap:=TBitmap.Create;
   
   //用到類似掃瞄線的功能
   for FadeStep:=1 to 32 do begin
     for py:=0 to IntfImg1.Height-1 do begin
       Row1 := IntfImg1.GetDataLineStart(py); //類似 Delphi TBitMap.ScanLine
       Row2 := IntfImg2.GetDataLineStart(py); //類似 Delphi TBitMap.ScanLine
       for px:=0 to IntfImg1.Width-1 do begin
         Row2^[px].rgbtRed:= (FadeStep * Row1^[px].rgbtRed) shr 5;
         Row2^[px].rgbtGreen := (FadeStep * Row1^[px].rgbtGreen) shr 5; // 淡出
         Row2^[px].rgbtBlue := (FadeStep * Row1^[px].rgbtBlue) shr 5;
       end;
     end;
     IntfImg2.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
     
     TempBitmap.Handle:=ImgHandle;
     TempBitmap.MaskHandle:=ImgMaskHandle;
     Canvas.Draw(0,0,TempBitmap);
   end; 

   IntfImg1.Free;
   IntfImg2.Free;
   TempBitmap.Free;
 end;

於 TLazIntfImage 與 TBitmap 之間轉換

自從 Lazarus 沒有 TBitmap.ScanLines 這內容後,想要最妥當的存取圖像圖素的方法就是讀跟寫都使用 TLazIntfImage。TBitmap 可以使用 TBitmap.CreateIntfImage() 轉換到 TLazIntfImage,再修改圖素後還可以再用TBitmap.LoadFromIntfImage() 轉回到 TBitmap; 這裡的範例就是從 TBitmap 建立一個 TLazIntfImage,修改後,再轉回到 TBitmap。

uses
  ...GraphType, IntfGraphics, LCLType, LCLProc,  LCLIntf ...

procedure TForm1.Button4Click(Sender: TObject);
var
  b: TBitmap;
  t: TLazIntfImage;
begin
  b := TBitmap.Create;
  try
    b.LoadFromFile('test.bmp');
    t := b.CreateIntfImage;

    // 對圖素讀或寫
    t.Colors[10,20] := colGreen;

    b.LoadFromIntfImage(t);
  finally
    t.Free;
    b.Free;
  end;
end;

動態的圖形 - 要怎麼避免閃爍

許多程式在他們的 GUI 畫面用到 2D 的繪圖。但若這些圖像想要有動態的變化,你馬上就會面臨到一個問題:快速的圖片轉換你的螢幕會閃爍,這會讓你的使用者有時只看到你的圖的部份而不是全部。這一定會發生,因為處理圖片需要時間。

但我要如何才能使繪圖達到最佳的效果而避免閃爍呢?當然你首先可以利用 OpenGL 圖形加速器,但這對小程式來講,程式碼會負擔變重,這個範例我們使用 TCanvas 來繪圖。如果你有需要到 OpenGL 的協助,那請再參看 Lazarus 對於 OpenGL 的文件,你也可以用 A.J. Venter's gamepack,這個繪圖元件有用到雙緩衝的功能。

現在我們來看看這幾個繪圖選項:

TImage 繪圖

TImage 包含兩個部份:TGraphic,通常也就是 TBitmap,在每一個 OnPaint 事件中負起在畫面保持一個可以繪圖的區域。TImage 下進行重新取樣並不會真的將點陣圖變更尺寸。 圖形 (或說點陣圖) 可以透過 Image1.Picture.Graphic (或 Image1.Picture.Bitmap) 存取,但控制畫面畫布區為 Image1.Picture.Bitmap.Canvas。 TImage 畫布的可視範圍可以在 Image1.OnPaint 事件中透過 Image1.Canvas 存取。

重要:千萬別在 Image1 的 OnPaint 事件中繪製 TImage 點陣圖。TImage 的圖形是存在緩衝區中的,所以你要繪製它的時候就直接在那執行,也會即時生效,但如果你會需要常常重新繪製它,影像就會閃爍,這樣的話你就得選用另一個方法。TImage 繪圖被視為比其他的方法都慢。

TImage 的點陣圖重新取樣

註:請勿於 OnPaint 事件時使用。

with Image1.Picture.Bitmap do begin
  Width:=100;
  Height:=120;
end;

繪製 TImage 點陣圖

註:請勿於 OnPaint 事件時使用。

with Image1.Picture.Bitmap.Canvas do begin
  // 將目前的區域填滿紅色
  Brush.Color := clRed;
  FillRect(0, 0, Width, Height);
end;

註:在 Image1.OnPaint 裡,Image1.Canvas 指到的是有時效性的可見區域,而在 Image1.OnPaint 之外 Image1.Canvas 指到 Image1.Picture.Bitmap.Canvas。

另一個範例:

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  x, y: Integer;
begin
  // 繪製背景
  MyImage.Canvas.Pen.Color := clWhite;
  MyImage.Canvas.Rectangle(0, 0, Image.Width, Image.Height);
   
  // 繪製方形
  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;

於有時效性的可見區域繪製 TImage

在 OnPaint 裡你只能在固定區域裡作畫。當區域無法繪製時 OnPaint 最後會自動被 LCL 呼叫,你可以用 Image1.Invalidate 來自訂無效的區域,這不會立即呼叫 OnPaint,而且你可以多次地做無效的指定。

procedure TForm.Image1Paint(Sender: TObject);
begin
  // 畫一條線
  Canvas.Pen.Color := clRed;
  Canvas.Line(0, 0, Width, Height);
end;

在 OnPaint 事件中繪圖

這裡的範例裡所有的繪圖作業都在表單的 OnPaint 事件發生時完成,或是某個另外的控制項。這無需像 TImage 的需要緩衝,它需要在事件處理器被呼叫的時候把所有工作一次做完。

procedure TForm.Form1Paint(Sender: TObject);
begin
  // 繪出一條線
  Canvas.Pen.Color := clRed;
  Canvas.Line(0, 0, Width, Height);
end;

建立自訂一個控制項用來自動繪圖

建立一個自訂的控制項的好處在於加強你程式的結構,控制項也可以用來重覆利用。這很快就能做到,但如果你不是在 TBitmap 下先繪圖再轉移上畫布區,這個做法還是會閃爍。在這裡我們就用不到 OnPaint 這個事件的控制項了。

以下即為自訂控制項的範例:

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
  // 取消註解就能開啟預設是抺白的背景
  //繼承抺除背景 EraseBackground(DC);
end; 
 
procedure TMyDrawingControl.Paint;
var
  x, y: Integer;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    // 初始點陣圖尺寸
    Bitmap.Height := Height;
    Bitmap.Width := Width;
 
    // 繪製背景
    Bitmap.Canvas.Pen.Color := clWhite;
    Bitmap.Canvas.Rectangle(0, 0, Width, Height);
 
    // 繪製方形
    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;

然後我們在表單上建立它:

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;

物件最後會自動釋放,因為擁有者我們設定為自己 (Self)。

將上邊界與左邊界定位點設定為零這個步驟到不一定需要,這只是個基準點,但這控制項放在哪其實都一樣。

"MyDrawingControl.Parent := Self;" 這步非常重要,如果不這麼做你會看不到你的控制項。

"MyDrawingControl.DoubleBuffered := True;" 是在 Windows 下,用來避免閃爍用的,在 gtk 下沒有效果。

使用 A.J. Venter's gamepack

該元件用於畫布上繪圖時會啟用雙緩衝功能,當在你一切都就緒的時候更新畫布上的內容,這在程式碼上要下點功夫,但這當在用於要快速大量的切換畫面的時候非常有用。如果你有這的需求,那就對 A.J. Venter's gamepack 一定有興趣了,該套件裡的元件常用來在 Lazarus 做遊戲開發,在畫面輸出像精靈 (sprite) 元件一樣做雙緩衝處理,設計可以將兩者組合在一起用。你可以透過 subversion 在這裡找到 gamepack:
svn co svn://silentcoder.co.za/lazarus/gamepack

這個網頁給你更多的資訊,文件與下載:首頁

Image formats

這個表提供每個影像格式所要使用的適當類別。

格式 影像類別 單元
游標 (cur) TCursor 圖形
點陣圖檔 (bmp) TBitmap 圖形
Windows 圖示 (ico) TIcon 圖形
Mac OS X 圖示 (icns) TicnsIcon 圖形
Pixmap (xpm) TPixmap 圖形
可傳遞網路圖形 (png) TPortableNetworkGraphic 圖形
JPEG (jpg, jpeg) TJpegImage 圖形
PNM (pnm) TPortableAnyMapGraphic 圖形

也可參見fcl-image 支援格式列表

轉換格式

有時候無法避免要將圖檔的格式轉換到另一個。 轉換圖檔有一個方法是使用中介格式,然後再轉換到 TBitmap。 大多數的格式都可以從 TBitmap 上再去建立。

轉換點陣圖檔到 PNG 格式然後再儲存它:

procedure SaveToPng(const bmp: TBitmap; PngFileName: String);
var
  png : TPortableNetworkGraphic; 
begin 
  png := TPortableNetworkGraphic.Create;
  try
    png.Assign(bmp);
    png.SaveToFile(PngFileName);
  finally 
    png.Free;
  end;
end;

圖像圖素格式

TColor

在 LCL 裡,為 TColor 內建的圖素格式是為 XXBBGGRR 格式,其符合 Windows 的原生格式,且也與大部份的函式庫 AARRGGBB 格式對衝。XX 是用來定義如果顏色為固定的色盤顏色,像 XX 若為 00 則代表他是系統預設的顏色之一,並沒有為 Alpha 頻道預留任何空間。

要將各別的 RGB 頻道轉換到 TColor 時使用:

RGBToColor(RedVal, GreenVal, BlueVal);

分別使用 Red,Green,Blue 函式取得此三個頻道的 TColor 變數值。

RedVal := Red(MyColor);
GreenVal := Green(MyColor);
BlueVal := Blue(MyColor);

TFPColor

TFPColor 使用 AARRGGBB 格式,普遍見於各種函式庫。

使用 TCanvas 作業

使用預設的 GUI 字型

以下簡單的程式碼就可以達成:

SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));

在固定寬度內繪製文字

使用 DrawText,先加入 DT_CALCRECT 然後再排除它。

// 首先要計算文字的尺寸才再進行繪製
TextBox := Rect(0, currentPos.Y, Width, High(Integer));
DrawText(ACanvas.Handle, PChar(Text), Length(Text),
  TextBox, DT_WORDBREAK or DT_INTERNAL or DT_CALCRECT);

DrawText(ACanvas.Handle, PChar(Text), Length(Text),
  TextBox, DT_WORDBREAK or DT_INTERNAL);

繪製有銳角的文字 (無反鋸齒補償)

某些工具可以達到這個效果

Canvas.Font.Quality := fqNonAntialiased;

有些工具,像是 gtk2 並不支援此效果,他繪製出來的永遠都有反鋸齒補償。這裡有一個簡單的方讓你使用 gtk2 畫出這種銳角。這並不代表所有的情況,只是其中一種概念:

procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
var
  w,h: integer;
  IntfImg: TLazIntfImage;
  Img: TBitmap;
  dy: Integer;
  dx: Integer;
  col: TFPColor;
  FontColor: TColor;
  c: TColor;
begin
  w:=0;
  h:=0;
  Canvas.GetTextSize(TheText,w,h);
  if (w<=0) or (h<=0) then exit;
  Img:=TBitmap.Create;
  IntfImg:=nil;
  try
    // 在點陣圖中繪製文字
    Img.Masked:=true;
    Img.SetSize(w,h);
    Img.Canvas.Brush.Style:=bsSolid;
    Img.Canvas.Brush.Color:=clWhite;
    Img.Canvas.FillRect(0,0,w,h);
    Img.Canvas.Font:=Canvas.Font;
    Img.Canvas.TextOut(0,0,TheText);
    // get memory image
    IntfImg:=Img.CreateIntfImage;
    // 取代灰色的圖素
    FontColor:=ColorToRGB(Canvas.Font.Color);
    for dy:=0 to h-1 do begin
      for dx:=0 to w-1 do begin
        col:=IntfImg.Colors[dx,dy];
        c:=FPColorToTColor(col);
        if c<>FontColor then
          IntfImg.Colors[dx,dy]:=colTransparent;
      end;
    end;
    // 建立點陣圖
    Img.LoadFromIntfImage(IntfImg);
    // 繪製
    Canvas.Draw(x,y,Img);
  finally
    IntfImg.Free;
    Img.Free;
  end;
end;

fcl-image 繪圖

如果你想要畫的圖不需要顯示在畫面上,你可以不用 LCL,直接採用 fcl-image。舉例來說像不透過 X11 在網路伺服器上執行的程式,就可以不用依賴視覺化函式庫。FPImage (又叫 fcl-image) 在 Pascal 下非常廣泛地被使用,函式庫也非常完整。事實上 LCL 在從檔案載入圖案來編輯的時候也是利用 FPImage 實作的函式來製作工具 (winapi,gtk,carbon...)。另一方面 Fcl-image 也可以做繪圖例行程序。

需要更多資訊,請閱讀 fcl-image 文章。