FMX.Types.TBitmap に ScanLine を付ける

Delphi-ML で「XE3 + FireMonkeyでScanlineプロパティが消えた？」というトピックが立ちました。

確かに、FMX.Types.TBitmap に ScanLine プロパティがありません。
Delphi-ML のログを読んでいただければ判るのですが FM2 では Map というメソッドで TBitmapData というレコードを受け取るように変わっていました。
こちらの方が洗練されていますが、今までのプログラムを移行するのは大変かもしれません。

そこで、クラスヘルパーを使って TBitmap に ScanLine を付けてみました。
ただ、終了処理が必要なので、どうしても同じにはなりませんし、初期化・終了処理がある分、速度的にも劣るかなと思います。

そんな訳で、できた Class Helper が↓こちら。
メソッド名は、BeginScanLine, EndScanLine としてみました（BeginUpdate, EndUpdate に準じた形）。

unit uBitmapScanLineHelper;

interface

uses
  FMX.Types;

type
  TBitmapScanLineHelper = class helper for TBitmap
  public
    function BeginScanLine(const Row: Integer): Pointer;
    procedure EndScanLine;
  end;

implementation

uses
  Generics.Collections, FMX.PixelFormats;

type
  TBmpDataDic = TDictionary<TBitmap, TBitmapData>;

var
  GBmpDataDic: TBmpDataDic = nil;

function TBitmapScanLineHelper.BeginScanLine(const Row: Integer): Pointer;
var
  BmpData: TBitmapData;
begin
  if (Map(TMapAccess.maReadWrite, BmpData)) then begin
    GBmpDataDic.Add(Self, BmpData);
    Result := BmpData.Data;
    Inc(PByte(Result), Row * Width * GetPixelFormatBytes(PixelFormat));
  end
  else
    Result := nil;
end;

procedure TBitmapScanLineHelper.EndScanLine;
var
  BmpData: TBitmapData;
begin
  if (GBmpDataDic.TryGetValue(Self, BmpData)) then begin
    Unmap(BmpData);
    GBmpDataDic.Remove(Self);
  end;
end;

initialization
begin
  GBmpDataDic := TBmpDataDic.Create;
end;

finalization
begin
  GBmpDataDic.Free;
end;

end.

ちなみに Class Helper はメンバー変数を持てない（追加できない）ので、ユニット変数(GBmpDataDic)を使って BitmapData を管理しています。

uBitmapScanLineHelper ソースはこちら（GitHub）


使い方は↓こんな感じです。

uses

  uBitmapScanLineHelper;

procedure TForm1.FormCreate(Sender: TObject);
const
  BMP_WIDTH = 320;
  BMP_HEIGHT = 240;
type
  PDWordArray = ^TDWordArray;
  TDWordArray = array [0.. 1] of DWORD;
var
  X, Y: Integer;
  Data: PDWordArray;
  Color: Cardinal;
begin
  Randomize;

  FBmp := TBitmap.Create(BMP_WIDTH, BMP_HEIGHT);

  // PixelFormat が A8R8G8B の 32bit を前提としています
  for Y := 0 to FBmp.Height - 1 do begin
    Color := $ff000000 or Cardinal(Random($1000000));

    Data := FBmp.BeginScanLine(Y);
    try
      for X := 0 to FBmp.Width - 1 do
        PDWordArray(Data)[X] := Color;
    finally
      FBmp.EndScanLine;
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBmp.Free;
end;

procedure TForm1.FormPaint(
  Sender: TObject;
  Canvas: TCanvas;
  const ARect: TRectF);
var
  W, H: Integer;
begin
  W := FBmp.Width;
  H := FBmp.Height;

  Canvas.DrawBitmap(
    FBmp,
    TRectF.Create(0, 0, W, H),
    TRectF.Create(0, 0, W, H),
    1);
end;

実行結果




あと、

BeginScanLine(0);

として呼び出せば、Map(); が返すポインタがそのまま返るので、普通に使う事もできます。

上のコードでは、for 文が回る度に BeginScanLine, EndScanLine としていますが、BeginScanLine(0); として後は自分でポインタ操作をすれば、速度は上がると思います（そうなった時点で最早 BegnScanLine を使う意味は無い本末転倒っぷりですが！）


書いているうちに、WorkToolSmith さんのところで、纏められていました！

Delphi XE3 FireMonkey変更点