ビットマップ画像をトリミングするには？
解決TImageコンポーネントに貼り付けた、ビットマップ画像のWhiteの部分をトリミングしたいのですが、方法がわかりません。
よろしくお願いいたします。
方法はいろいろあると思いますが、
簡単なのはピクセルをループしてWhiteだった描画処理を飛ばすなどでしょうか。
ご回答ありがとうございます。
描画色を取得するところで先に進めずにいます。
1ピクセルずつビットマップを取得する方はScanLineというものかと思い、使用してみたのですが、色を取得する方法がわかりません。
すみません、よろしくお願いします。
はじめまして
以下はScanLineで色を取得する関数です。
24bit形式のビットマップ限定です。
type
TRGB = record
B, G, R: Byte;//ビットマップは内部で逆順に並んでいるので。
end;
TRGBArray = array[0..50000000] of TRGB;
PRGBArray = ^TRGBArray;
var
w, h: integer;
bmp1: TBitmap;
source: Array of Pointer;
procedure BMP();
var
i,x,y: integer;
r, g, b: Byte;
begin
bmp1 := TBitmap.Create;
try
bmp1.LoadFromFile('***.bmp');
bmp1.PixelFormat := pf24bit;
w := bmp1.Width;
h := bmp1.Height;
SetLength(Source, h);
for i:=0 to h-1 do
begin
Source[i] := bmp1.ScanLine[i];//ScanLineを一度、配列にコピー
end;
for y:=0 to h-1 do begin
for x:=0 to w-1 do begin
R := TRGB(PRGBArray(Source[h-1-y])^[x]).R;
G := TRGB(PRGBArray(Source[h-1-y])^[x]).G;
B := TRGB(PRGBArray(Source[h-1-y])^[x]).B;
if ((B > 230) and (G > 230)
and (R > 230)) then //各色が230以上であれば、白と判断
begin
//ここで何らかのトリミング処理をしてください。
TRGB(PRGBArray(Source[h-1-y])^[x]).R := 0;
TRGB(PRGBArray(Source[h-1-y])^[x]).G := 0;
TRGB(PRGBArray(Source[h-1-y])^[x]).B := 0;
end else
begin
//白でない場合の処理
end;
end;
end;
Form1.Image1.Canvas.Draw(0,0,bmp1);
finally
Finalize(Source);
bmp1.Free;
end;
end;
WhiteはR,G,Bが各255なのですが、厳密に判断すると白の範囲が狭くなるの
で、230以上としました。
とりあえず、ここでは白を黒くするという処理にしています。
> ビットマップ画像のWhiteの部分をトリミングしたいのですが
「トリミング」の意味がよく分からないのですが。
TBitmap のインスタンスに写し取って、その TransparentColor を設定するだけ
なのでは？
TransparentColor を使って、透過させたり、背景色を変更したりしてみました。
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
public
bmp:TBitmap;
BkColor:TColor;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
bmp := TBitmap.Create;
bmp.PixelFormat := pf24bit;
bmp.Height := 200;
bmp.Width := 200;
BkColor := clWhite;
with bmp.Canvas do begin
Brush.Color := BkColor;
FillRect(Rect(0,0,bmp.Width,bmp.Height));
Brush.Color := clLime;
Pen.Color := clRed;
Pen.Width := 3;
Ellipse(20,20,180,180);
Brush.Color := clYellow;
Pen.Color := clBlue;
Rectangle(30,30,170,170);
Brush.Color := BkColor;
Pen.Color := BkColor;
Ellipse(70,70,130,130);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bmp.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Refresh;
Canvas.Draw(10,10,bmp);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
tmp:TBitmap;
begin
tmp := TBitmap.Create;
try
tmp.Assign(bmp);
tmp.TransparentColor := BkColor;
tmp.Transparent := true;
Refresh;
Canvas.Draw(10,10,tmp);
finally
tmp.Free;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
tmp1,tmp2:TBitmap;
begin
tmp1 := TBitmap.Create;
tmp2 := TBitmap.Create;
try
tmp1.Assign(bmp);
tmp2.Assign(bmp);
tmp1.TransparentColor := BkColor;
tmp1.Transparent := true;
tmp2.Canvas.Brush.Color := clGreen;
tmp2.Canvas.FillRect(Rect(0,0,tmp2.Width,tmp2.Height));
tmp2.Canvas.Draw(0,0,tmp1);
Refresh;
Canvas.Draw(10,10,tmp2);
finally
tmp1.Free;
tmp2.Free;
end;
end;
FormCreate で、元になるビットマップを作成しています。200x200 で背景色は
白 clWhite です。
Button1Click では元画像をそのまま Form1 に描画します。
Button2Click では、背景色である clWhite を透過して、Form1 に描きます。
Button3Click では、背景色を clGreen に変更して描きます。
トリミング＝余白を取り除いた部分、ということでしょうか。
こんな感じでどうですか。
最適化していません。エラー処理もしていません。
動作確認済みです。
type
TColor24=packed record
R,G,B: BYTE;
end;
PColor24Array=^TColor24Array;
TColor24Array=array[0..0] of TColor24;
function TrimBitmap(AColor: TColor; Source, Dest: TBitmap): Boolean;
var
C: TColor24; // 探す色
x, y: Integer;//ループ変数
mx1, mx2, my1, my2: Integer; // トリムの最小値
lx1, lx2: Integer; // １ラインあたりのトリムの最小
SScan: PCOlor24Array;
IsLeftFound, IsTopFound: Boolean; // 内側範囲を見つけたらTrue
SR,DR: TRect;
function CheckColor(A,B: TColor24): Boolean;
begin
//色のチェック。必要なら、１色でなく平均値以下とかに変更。
if (SScan[x].R = C.R)
and (SScan[x].G = C.G)
and (SScan[x].B = C.B) then
Result := False // 余白
else
Result := True; // 余白ではない
end;
begin
mx1 := Source.Width - 1;
mx2 := 0;
my1 := Source.Height - 1;
my2 := 0;
C.R := AColor and 255;
C.G := (AColor shr 8) and 255;
C.B := (AColor shr 16) and 255;
Source.PixelFormat := pf24bit;
IsTopFound := False;
for y := 0 to Source.Height - 1 do
begin
SScan := Source.ScanLine[y];
IsLeftFound := False;
lx1 := 0;
lx2 := 0;
for x := 0 to Source.Width - 1 do
begin
//左からの値
if CheckColor(C, SScan[x]) then
begin
// 余白でない場所を発見
if not IsLeftFound then
begin
IsLeftFound := True;
lx1 := x;
end;
//右側の場合、最後に余白でない場所を探せばよいのでここでチェック
lx2 := x;
end
else
begin
//余白
if not IsLeftFound then lx1 := x;
end;
end;
//前に探した余白の位置より小さいなら今の位置を余白位置とする
if mx1 > lx1 then mx1 := lx1;
//前に探した余白の位置より大きいなら今の位置を余白位置とする
if mx2 < lx2 then mx2 := lx2;
if lx1 < lx2 then
begin
//余白ではない場所を発見
if not IsTopFound then
begin
IsTopFound := True;
my1 := y;
end;
//下側の場合、最後に余白でない場所を探せばよいのでここでチェック
my2 := y;
end
else
begin
//余白
if not IsTopFound then my1 := y;
end;
end;
//すべて余白ならコピーしないで戻る
if (mx1 > mx2) or (my1 > my2) then
begin
Result := False;
Exit;
end;
//Destにソースの範囲をコピー
Dest.Width := mx2 - mx1 + 1;
Dest.Height := my2 - my1 + 1;
Dest.PixelFormat := pf24bit;
SR.Left := mx1;
SR.Top := my1;
SR.Right := mx2 + 1;
SR.Bottom := my2 + 1;
DR.Left := 0;
DR.Top := 0;
DR.Right := mx2 - mx1 + 1;
DR.Bottom := my2 - my1 + 1;
Dest.Canvas.CopyRect(DR, Source.Canvas, SR);
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S,D: TBitmap;
begin
S := TBitmap.Create;
D := TBitmap.Create;
try
S.LoadFromFile(Edit1.Text);
if TrimBitmap(RGB(255,255,255), S, D) then
begin
D.SaveToFile(Edit2.Text);
ShowMessage('Trim完了');
end
else
begin
ShowMessage('Trimされませんでした');
end;
finally
D.Free;
S.Free;
end;
end;
ありがとうございました！
トリミングした画像を最後にファイルとして保存したかったので、ScanLineを使用し、余白の最小値、最大値を取得した後、CopyRectを使用し余白以外の画像をコピーする方法で成功しました。
| ツイート |  |