首頁>編程相關>Delphi源碼
下載

位mappixels

[英語]

bitmappixels.pas -lazarus和delphi模塊，用於直接訪問TbitMap的像素

在Windows（Winapi），Linux（GTK2，QT5），OSX（可可）上工作

一個很受歡迎的問題是如何快速訪問tbitmap像素？
由於像素格式數量有限，但在拉撒路（Lazarus ）方面很難，在Delphi中很容易做到這一點。
例如：https：//wiki.freepascal.org/fast_direct_pixel_access

我提出了一個小的單個文件，模塊“ bitmappixels.pas” ，它簡化了工作，以調用tbitmapdata.map（）和tbitmapdata.unmap（） 。
您可以在數據屬性中獲得$ aarrggbb像素的數組，並使用setPixel（）/getPixel（）（）（）獲得Abilty set and set and set and color。 

 var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec; // for easy access to the channels 
begin
  // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode.
  // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 
  Data.Map(Bitmap, TAccessMode.ReadWrite, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        // Read color at (X, Y) to Pixel record
        Pixel := Data.GetPixel(X, Y);
        // some changes of Pixel
        Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3 ;
        Pixel.G := Pixel.R;
        Pixel.B := Pixel.R;
        // ...
        // Write Pixel record to (X, Y) in map
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    // Writing the map to the image.
    // Since we have abandoned Alpha, the pixel format will be set to pf24bit.
    Data.Unmap();
  end ;
end ;

關鍵功能：

  • 跨平台
  • 支持所有用於閱讀的TbitMap像素格式
  • 快速處理Windows/gtk/qt/osx中流行格式的快速處理
  • 可以將任何圖像映射為是否具有Alpha通道（24位/32位）

示例1-倒轉顏色（讀寫）

示例1.png

 procedure InvertColors ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, False); // RGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.R := 255 - Pixel.R;
        Pixel.G := 255 - Pixel.G;
        Pixel.B := 255 - Pixel.B;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例2-半圖透明度（讀寫，alpha）

example2.png

 procedure HalfAlpha ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, True); // ARGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.A := Pixel.A div 2 ;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例3-對位圖產生血漿效應（僅寫）

example3.png

 function MakePlasm (): TBitmap;
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize( 300 , 300 );

  Data.Map(Result, TAccessMode.Write, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel.R := Byte(Trunc(
          100 + 100 * (Sin(X * Cos(Y * 0.049 ) * 0.01 ) + Cos(X * 0.0123 - Y * 0.09 ))));
        Pixel.G := 0 ;
        Pixel.B := Byte(Trunc(
          Pixel.R + 100 * (Sin(X * Cos(X * 0.039 ) * 0.022 ) + Sin(X * 0.01 - Y * 0.029 ))));
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例4-將兩個位圖與一個位圖混合（僅讀，僅寫））

示例4.png

 function Mix ( const A, B: TBitmap): TBitmap;
  function Min (A, B: Integer): Integer;
  begin
    if A < B then Exit(A) else Exit(B);
  end ;
var
  DataA, DataB, DataResult: TBitmapData;
  X, Y: Integer;
  PixelA, PixelB, PixelResult: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height));
  // this needed for correct Unmap() on exception
  DataA.Init();
  DataB.Init();
  DataResult.Init();
  try
    DataA.Map(A, TAccessMode.Read, False);
    DataB.Map(B, TAccessMode.Read, False);
    DataResult.Map(Result, TAccessMode.Write, False);
    for Y := 0 to DataResult.Height - 1 do
    begin
      for X := 0 to DataResult.Width - 1 do
      begin
        PixelA := DataA.Pixels[X, Y];
        PixelB := DataB.Pixels[X, Y];
        PixelResult.R := (PixelA.R + PixelB.R) div 2 ;
        PixelResult.G := (PixelA.G + PixelB.G) div 2 ;
        PixelResult.B := (PixelA.B + PixelB.B) div 2 ;
        DataResult[X, Y] := PixelResult;
      end ;
    end ;
  finally
    DataA.Unmap();
    DataB.Unmap();
    DataResult.Unmap();
  end ;
end ;

[rus]

bitmappixels.pas -libous -ly光llaphi lphi到ddelphiдающий歇я崙訊。

°отаетнаWindows（Winapi），Linux（GTK2，QT5），OSX（可可）（可可）

e 。都
э期г™list光樞。 дол資源
μ。

f 。 tbitmapdata.unmap（） 。
~東помощ -setPixel（）/getPixel（） 。 

 var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec; // for easy access to the channels 
begin
  // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode.
  // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 
  Data.Map(Bitmap, TAccessMode.ReadWrite, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        // Read color at (X, Y) to Pixel record
        Pixel := Data.GetPixel(X, Y);
        // some changes of Pixel
        Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3 ;
        Pixel.G := Pixel.R;
        Pixel.B := Pixel.R;
        // ...
        // Write Pixel record to (X, Y) in map
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    // Writing the map to the image.
    // Since we have abandoned Alpha, the pixel format will be set to pf24bit.
    Data.Unmap();
  end ;
end ;

。

  • wimution
  • подерживаетвqOulChlChomйй
  • 生р
  • lim的γ了，б鈉函

示例1-函

示例1.png

 procedure InvertColors ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, False); // RGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.R := 255 - Pixel.R;
        Pixel.G := 255 - Pixel.G;
        Pixel.B := 255 - Pixel.B;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例2-見電激，ч電зγ

example2.png

 procedure HalfAlpha ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, True); // ARGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.A := Pixel.A div 2 ;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例3 -lothisth（僅寫）

example3.png

 function MakePlasm (): TBitmap;
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize( 300 , 300 );

  Data.Map(Result, TAccessMode.Write, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel.R := Byte(Trunc(
          100 + 100 * (Sin(X * Cos(Y * 0.049 ) * 0.01 ) + Cos(X * 0.0123 - Y * 0.09 ))));
        Pixel.G := 0 ;
        Pixel.B := Byte(Trunc(
          Pixel.R + 100 * (Sin(X * Cos(X * 0.039 ) * 0.022 ) + Sin(X * 0.01 - Y * 0.029 ))));
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例4-見訊

示例4.png

 function Mix ( const A, B: TBitmap): TBitmap;
  function Min (A, B: Integer): Integer;
  begin
    if A < B then Exit(A) else Exit(B);
  end ;
var
  DataA, DataB, DataResult: TBitmapData;
  X, Y: Integer;
  PixelA, PixelB, PixelResult: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height));
  // this needed for correct Unmap() on exception
  DataA.Init();
  DataB.Init();
  DataResult.Init();
  try
    DataA.Map(A, TAccessMode.Read, False);
    DataB.Map(B, TAccessMode.Read, False);
    DataResult.Map(Result, TAccessMode.Write, False);
    for Y := 0 to DataResult.Height - 1 do
    begin
      for X := 0 to DataResult.Width - 1 do
      begin
        PixelA := DataA.Pixels[X, Y];
        PixelB := DataB.Pixels[X, Y];
        PixelResult.R := (PixelA.R + PixelB.R) div 2 ;
        PixelResult.G := (PixelA.G + PixelB.G) div 2 ;
        PixelResult.B := (PixelA.B + PixelB.B) div 2 ;
        DataResult[X, Y] := PixelResult;
      end ;
    end ;
  finally
    DataA.Unmap();
    DataB.Unmap();
    DataResult.Unmap();
  end ;
end ;

[UA]

bitmappixels.pas -libous-ly光llphi，delphi，щодаєпря工作

працюєHindows（Winapi），Linux（GTK2，QT5），OSX（可可）（可可）

єдосить創荷EM，him /μllazarus。
цTem ​lazarus 。
прикладиQOLOMIMIPASCAL.OMImlibipascal.org/wiki.freepascal.org/fast_direct_pixel_access。

f ，， tbitmapdata.unmap（） 。
~~ ›飛失з執setPixel（）/getPixel（） 。 

 var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec; // for easy access to the channels 
begin
  // Reading the colors of the image into map "Data", width mode "ReadWrite", in the "False" alpha channel mode.
  // The alpha channel will be set to 0 on every element of the array. ($00RRGGBB, $00RRGGBB, ...) 
  Data.Map(Bitmap, TAccessMode.ReadWrite, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        // Read color at (X, Y) to Pixel record
        Pixel := Data.GetPixel(X, Y);
        // some changes of Pixel
        Pixel.R := (Pixel.R + Pixel.G + Pixel.B) div 3 ;
        Pixel.G := Pixel.R;
        Pixel.B := Pixel.R;
        // ...
        // Write Pixel record to (X, Y) in map
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    // Writing the map to the image.
    // Since we have abandoned Alpha, the pixel format will be set to pf24bit.
    Data.Unmap();
  end ;
end ;

|с

  • 函數
  • п在¼CCImфєμ。
  • прискоренаоб點發
  • lom的γ-uistiousouter，-uist-umupinum，з都

示例1-。

示例1.png

 procedure InvertColors ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, False); // RGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.R := 255 - Pixel.R;
        Pixel.G := 255 - Pixel.G;
        Pixel.B := 255 - Pixel.B;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例2 -q宿。

example2.png

 procedure HalfAlpha ( const Bitmap: TBitmap);
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Data.Map(Bitmap, TAccessMode.ReadWrite, True); // ARGB access
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel := Data.GetPixel(X, Y);
        Pixel.A := Pixel.A div 2 ;
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例3--見電

example3.png

 function MakePlasm (): TBitmap;
var
  Data: TBitmapData;
  X, Y: Integer;
  Pixel: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize( 300 , 300 );

  Data.Map(Result, TAccessMode.Write, False);
  try
    for Y := 0 to Data.Height - 1 do
    begin
      for X := 0 to Data.Width - 1 do
      begin
        Pixel.R := Byte(Trunc(
          100 + 100 * (Sin(X * Cos(Y * 0.049 ) * 0.01 ) + Cos(X * 0.0123 - Y * 0.09 ))));
        Pixel.G := 0 ;
        Pixel.B := Byte(Trunc(
          Pixel.R + 100 * (Sin(X * Cos(X * 0.039 ) * 0.022 ) + Sin(X * 0.01 - Y * 0.029 ))));
        Data.SetPixel(X, Y, Pixel);
      end ;
    end ;
  finally
    Data.Unmap();
  end ;
end ;

示例4-з執шш訊至

示例4.png

 function Mix ( const A, B: TBitmap): TBitmap;
  function Min (A, B: Integer): Integer;
  begin
    if A < B then Exit(A) else Exit(B);
  end ;
var
  DataA, DataB, DataResult: TBitmapData;
  X, Y: Integer;
  PixelA, PixelB, PixelResult: TPixelRec;
begin
  Result := TBitmap.Create();
  Result.SetSize(Min(A.Width, B.Width), Min(A.Height, B.Height));
  // this needed for correct Unmap() on exception
  DataA.Init();
  DataB.Init();
  DataResult.Init();
  try
    DataA.Map(A, TAccessMode.Read, False);
    DataB.Map(B, TAccessMode.Read, False);
    DataResult.Map(Result, TAccessMode.Write, False);
    for Y := 0 to DataResult.Height - 1 do
    begin
      for X := 0 to DataResult.Width - 1 do
      begin
        PixelA := DataA.Pixels[X, Y];
        PixelB := DataB.Pixels[X, Y];
        PixelResult.R := (PixelA.R + PixelB.R) div 2 ;
        PixelResult.G := (PixelA.G + PixelB.G) div 2 ;
        PixelResult.B := (PixelA.B + PixelB.B) div 2 ;
        DataResult[X, Y] := PixelResult;
      end ;
    end ;
  finally
    DataA.Unmap();
    DataB.Unmap();
    DataResult.Unmap();
  end ;
end ;
展開
附加信息
相關應用
爲您推薦
相關資訊 全部