3

画像 (白黒としましょう) をマトリックス (0 = 黒、1 = 白) に変換しようとしています。

私はこのコードで試しました:

procedure TForm1.Button1Click(Sender: TObject);
type
  tab = array[1..1000,1..1000] of byte;
var i,j: integer;
    s : string;
    image : TBitmap;
    t : tab;
begin
  image := TBitmap.Create;
  image.LoadFromFile('c:\image.bmp');

  s := '';
  for i := 0 to image.Height do
  begin
     for j := 0 to image.Width do
     begin
      if image.Canvas.Pixels[i,j] = clWhite then
        t[i,j] := 0
      else
        t[i,j] := 1;

     end;
  end;
  for i := 0 to image.Height do
  begin
    for j := 0 to image.Width do
     begin
      s:=s + IntToStr(t[i,j]);
     end;
     Memo1.Lines.Add(s);
     s:='';
  end;
end;

しかし、それは私に間違った結果をもたらしました。

何か案が？

4

3 に答える 3

12

あなたのコードには 5 つのバグと 2 つの問題があります。

まず、

for i := 0 to image.Height do

に置き換える必要があります

for i := 0 to image.Height - 1 do

（なぜ？） 同様に、

for j := 0 to image.Width do

に置き換える必要があります

for j := 0 to image.Width - 1 do

第 2に、配列はではなくPixels引数を取ります。したがって、交換する必要があります[x, y][y, x]

image.Canvas.Pixels[i,j]

に

image.Canvas.Pixels[j,i]

第三に、「0 = 黒、1 = 白」と書きましたが、明らかに逆です。

4 番目t[0, 0]に、マトリックスが でインデックス付けを開始しているにもかかわらず、にアクセスしようとします1。array[0..1000,0..1000] of byte;それを修正するために使用します。

第 5に、メモリ リークがあります (image解放されません -- 使用しますtry..finally)。

また、動的配列を使用することをお勧めします。

type
  TByteMatrix = array of array of byte;

var
  mat: TByteMatrix;

そして、あなたはから始めます

SetLength(mat, image.Height - 1, image.Width - 1);

インデックスにしたい場合は[y, x]反対、それ以外の場合は反対です。

最後Pixelsに、この場合、このプロパティは非常に遅いため、まったく使用しないでください。代わりに、Scanlineプロパティを使用してください。詳細については、これまたはそれまたは何かを参照してください。

また、メモ コントロールの更新のMemo1.Lines.BeginUpdate前後に追加するだけで、速度が大幅に向上します。Memo1.Lines.EndUpdate

于 2013-03-09T16:27:53.027 に答える
5

次の手順では、入力ABitmapビットマップをバイトの多次元AMatrix配列に変換します。これはピクセルを表し、0の値は白いピクセルを意味し、1はその他の色を意味します。

type
  TPixelMatrix = array of array of Byte;

procedure BitmapToMatrix(ABitmap: TBitmap; var AMatrix: TPixelMatrix);
type
  TRGBBytes = array[0..2] of Byte;
var
  I: Integer;
  X: Integer;
  Y: Integer;
  Size: Integer;
  Pixels: PByteArray;
  SourceColor: TRGBBytes;
const
  TripleSize = SizeOf(TRGBBytes);
begin
  case ABitmap.PixelFormat of
    pf24bit: Size := SizeOf(TRGBTriple);
    pf32bit: Size := SizeOf(TRGBQuad);
  else
    raise Exception.Create('ABitmap must be 24-bit or 32-bit format!');
  end;

  SetLength(AMatrix, ABitmap.Height, ABitmap.Width);
  for I := 0 to TripleSize - 1 do
    SourceColor[I] := Byte(clWhite shr (16 - (I * 8)));

  for Y := 0 to ABitmap.Height - 1 do
  begin
    Pixels := ABitmap.ScanLine[Y];
    for X := 0 to ABitmap.Width - 1 do
    begin
      if CompareMem(@Pixels[(X * Size)], @SourceColor, TripleSize) then
        AMatrix[Y, X] := 0
      else
        AMatrix[Y, X] := 1;
    end;
  end;
end;

この手順では、バイトの多次元AMatrix配列をAMemoメモボックスに出力します。

procedure ShowPixelMatrix(AMemo: TMemo; const AMatrix: TPixelMatrix);
var
  S: string;
  X: Integer;
  Y: Integer;
begin
  AMemo.Clear;
  AMemo.Lines.BeginUpdate;
  try
    AMemo.Lines.Add('Matrix size: ' + IntToStr(Length(AMatrix[0])) + 'x' +
      IntToStr(Length(AMatrix)));
    AMemo.Lines.Add('');

    for Y := 0 to High(AMatrix) do
    begin
      S := '';
      for X := 0 to High(AMatrix[Y]) - 1 do
      begin
        S := S + IntToStr(AMatrix[Y, X]);
      end;
      AMemo.Lines.Add(S);
    end;
  finally
    AMemo.Lines.EndUpdate;
  end;
end;

そして、上記の手順の使用法：

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  PixelMatrix: TPixelMatrix;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.LoadFromFile('d:\Image.bmp');
    BitmapToMatrix(Bitmap, PixelMatrix);
  finally
    Bitmap.Free;
  end;
  ShowPixelMatrix(Memo1, PixelMatrix);
end;

上記のBitmapToMatrix手順のこの拡張luminanceにより、パラメータで指定されたレベルでAMinIntensity、非白と見なされるピクセルを指定できます。

値が0に近いほど、AMinIntensity明るいピクセルは非白として扱われます。これにより、色の強度の許容範囲を操作できます（たとえば、アンチエイリアス処理されたテキストをより適切に認識できます）。

procedure BitmapToMatrixEx(ABitmap: TBitmap; var AMatrix: TPixelMatrix;
  AMinIntensity: Byte);
type
  TRGBBytes = array[0..2] of Byte;
var
  X: Integer;
  Y: Integer;
  Gray: Byte;
  Size: Integer;
  Pixels: PByteArray;
begin
  case ABitmap.PixelFormat of
    pf24bit: Size := SizeOf(TRGBTriple);
    pf32bit: Size := SizeOf(TRGBQuad);
  else
    raise Exception.Create('ABitmap must be 24-bit or 32-bit format!');
  end;

  SetLength(AMatrix, ABitmap.Height, ABitmap.Width);

  for Y := 0 to ABitmap.Height - 1 do
  begin
    Pixels := ABitmap.ScanLine[Y];
    for X := 0 to ABitmap.Width - 1 do
    begin
      Gray := 255 - Round((0.299 * Pixels[(X * Size) + 2]) +
        (0.587 * Pixels[(X * Size) + 1]) + (0.114 * Pixels[(X * Size)]));

      if Gray < AMinIntensity then
        AMatrix[Y, X] := 0
      else
        AMatrix[Y, X] := 1;
    end;
  end;
end;
于 2013-03-09T16:39:48.400 に答える
-1

メモ行の位置は下がりますが、最初にループする image.height はメモの結果が逆になるので、このコードを試してください

procedure TForm1.Button1Click(Sender: TObject);
var i,j: integer;
    s : string;
    image : TBitmap;
begin
  image := TBitmap.Create;
  image.LoadFromFile('c:\image.bmp');

  s := '';
  for i := 0 to image.width-1 do
  begin
     for j := 0 to image.Height-1 do
     begin
      if image.Canvas.Pixels[i,j] = clWhite then
        s := s+'0'
      else
        s := s+'1';
     end;
     memo1.Lines.Add(s);
     s:='';
  end;
end;
于 2013-03-09T16:45:21.100 に答える