Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 4498|回复: 1

以 Lazarus 實作取代 TBitmap.ScanLine 處理方式

[复制链接]

该用户从未签到

发表于 2010-8-25 22:08:51 | 显示全部楼层 |阅读模式
在 Delphi 中 ScanLine 是 TBitmap 元件中的一個 Property, 存放著 Bitmap 某一橫列的色彩值在記憶體中存放的起始指標, 有了這個指標, 我們就可以直接在記憶體中直接存取, 修改影像內容; 很多高速影像轉換處理都會用到這個屬性, 可是在 Lazarus 中的 TBitmap 並不支援這個屬性, 原因是這個屬性有高度的裝置依賴性, 不適合跨平台上使用

Developing with Graphics 中有說明
The first thing to remember is that Lazarus is meant to be platform independent, so any methods using Windows API functionality are out of the question. So a method like ScanLine is not supported by Lazarus because it is intended for Device Independant Bitmap and uses functions from the GDI32.dll.
其中也有舉了 FadeIn() (即影像的 "淡入" 處理) 分別以 Delphi 及 Lazarus 程式碼撰寫的例子; 當然, Delphi 例子是透過 TBitmap.ScanLine 處理, 效率會比較好(影像處理速度較快)

但我個人覺得 Developing with Graphics 網頁中這兩個 FadeIn() 例子舉的很爛, 好像是不同兩個人寫的, 區域變數命名也差很多, 對照兩相程式碼很難瞭解差異點, 所以我把它改了一下成為下面兩個例子, 是否比較好閱讀及比較差異點,呢 ?
■ Delphi 版本 FadeIn()
procedure TForm1.FadeIn(aBitMap: TBitMap);
var
  Bitmap1, Bitmap2: TBitmap;
  Row1, Row2: PRGBTripleArray;
  px, py, FadeStep: integer;
  CurColor: TColor;
begin
  Bitmap1 := TBitmap.Create;
  Bitmap1.PixelFormat := pf32bit;  //  or pf24bit
  Bitmap1.Assign(aBitMap);
  Bitmap2 := TBitmap.Create;
  Bitmap2.PixelFormat := pf32bit;
  Bitmap2.Assign(aBitMap);
  //With Scanline
  for FadeStep := 0 to 32 do begin
    for py := 0 to (Bitmap1.Height - 1) do begin
      Row1 := Bitmap1.Scanline[py];
      Row2 := Bitmap2.Scanline[py];
      for px := 0 to (Bitmap1.Width - 1) do begin
        Row2[px].rgbtRed := (FadeStep * Row1[px].rgbtRed) shr 5;
        Row2[px].rgbtGreen := (FadeStep * Row1[px].rgbtGreen) shr 5; // Fading
        Row2[px].rgbtBlue := (FadeStep * Row1[px].rgbtBlue) shr 5;
      end;
    end;
    Form1.Canvas.Draw(0, 0, Bitmap2);
    InvalidateRect(Form1.Handle, nil, False);
    RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
  end;
  
  
  Bitmap1.Free;
  Bitmap2.Free;
end;


■ Lazarus 版本 FadeIn()
uses LCLType, // HBitmap type
     IntfGraphics, // TLazIntfImage type
     fpImage; // TFPColor type
procedure TForm1.FadeIn(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);

   //Without Scanline
   for FadeStep:=1 to 32 do begin
     for py:=0 to IntfImg1.Height-1 do begin
       for px:=0 to IntfImg1.Width-1 do begin
         CurColor:=IntfImg1.Colors[px,py];
         CurColor.Red:=(CurColor.Red*FadeStep) shr 5;
         CurColor.Green:=(CurColor.Green*FadeStep) shr 5;
         CurColor.Blue:=(CurColor.Blue*FadeStep) shr 5;
         IntfImg2.Colors[px,py]:=CurColor;
       end;
     end;
     IntfImg2.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
     TempBitmap:=TBitmap.Create;
     TempBitmap.Handle:=ImgHandle;
     TempBitmap.MaskHandle:=ImgMaskHandle;
     Canvas.Draw(0,0,TempBitmap);
   end;

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

-----------------------------------------------------------------------------------------------------------------
■ Lazarus 版本取代 TBitmap.ScanLine 處理方式 (讓 Lazarus 也能高效率處理圖型)
參考了上兩個我改寫的例子後, 馬上發現差異點就是 : Delphi 全程以 TBitMap 處理圖型, 而 Lazarus 是先把 TBitMap 轉成 TLazIntfImage 再做處理, 在先前搜尋資料時有印象 TLazIntfImage 有類似 TBitmap.ScanLine 的屬性, 也就是 TLazIntfImage.GetDataLineStart, 這也是透過指標方式高速處理的方式, 所以再把上面兩個例子綜合一下, 就成了 Lazarus With Scanline 高速處理圖型版本, 經過實測的確有 Delphi TBitmap.ScanLine 的處理速度, 而且透過TLazIntfImage 物件的這種寫法是跨平台的 (較低的裝置依賴性)
uses LCLType, // HBitmap type
     IntfGraphics, // TLazIntfImage type
     fpImage; // TFPColor type

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;
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;   

   //With Scanline
   for FadeStep:=1 to 32 do begin
     for py:=0 to IntfImg1.Height-1 do begin
       Row1 := IntfImg1.GetDataLineStart(py); //like Delphi TBitMap.ScanLine
       Row2 := IntfImg2.GetDataLineStart(py); //like 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; // Fading
         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;

评分

参与人数 1威望 +1 收起 理由
猫工 + 1 谢谢分享

查看全部评分

回复

使用道具 举报

该用户从未签到

 楼主| 发表于 2010-8-25 23:50:43 | 显示全部楼层
這篇的 SOURCECODE 下載位置一定要貼出來, 讓大家實際體驗有沒有應用指標(指針)處理, 對圖檔處理速度的差別


digitraveler.homelinux.com/down_load/LazScanLineTest.zip  (前面請自行加 HTTP://)
回复 支持 反对

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2025-5-2 20:11 , Processed in 0.036657 second(s), 14 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表