Delphi二值图像腐蚀算法


procedure BitmapErose(Bitmap: TBitmap; bHoric: Boolean);
//传入的Bitmap是一个二值位图,bHoric标志是水平方向还是竖直方向腐蚀
var
 X, Y: integer;
 newbmp: TBitmap;
 P, Q, R, O: pByteArray;
begin
 newbmp := TBitmap.Create;
 //动态创建位图
 newbmp.Assign(bitmap);
 if (bHoric) then
 begin
 for Y := 1 to newbmp.Height - 2 do
 begin
 O := bitmap.ScanLine[Y];
 P := newbmp.ScanLine[Y - 1];
 Q := newbmp.ScanLine[Y];
 R := newbmp.ScanLine[Y + 1];
 for X := 1 to newbmp.Width - 2 do
 begin
 if ((O[3 * X] = 0) and (O[3 * X + 1] = 0) and (O[3 * X + 2]= 0)) then
 begin
 // 判断黑点左右邻居是否有白色点,有则腐蚀,置该点为白色
 // 白色点则保持不变
 if (((Q[3 * (X - 1)] = 255) and (Q[3 * (X - 1) + 1] = 255) and (Q[3 * (X - 1) + 2] = 255))
 or ((Q[3 * (X + 1)] = 255) and (Q[3 * (X + 1) + 1] = 255) and (Q[3 * (X + 1) + 2] = 255))
 or ((P[3 * X] = 0) and (P[3 * X + 1] = 255) and (P[3 * X + 2] = 255))
 or ((R[3 * X] = 255) and (R[3 * X + 1] = 255) and (R[3 * X + 2] = 255))) then
 begin
 O[3 * X] := 255;
 O[3 * X + 1] := 255;
 O[3 * X + 2] := 255;
 // 将满足条件的黑色点置为白色
 end;
 end;
 end;
 end;
 end else begin
 for Y := 1 to newbmp.Height - 2 do
 begin
 O := bitmap.ScanLine[Y];
 Q := newbmp.ScanLine[Y];
 for X := 1 to newbmp.Width - 2 do
 begin
 //  判断一个黑点上下邻居是否有白点,有则腐蚀,置黑点为白色
 //  白色点就保持不变
 if ((O[3 * X] = 0) and (O[3 * X + 1] = 0) and (O[3 * X + 2]= 0)) then
 begin
 if (((Q[3 * (X - 1)] = 255) and (Q[3 * (X - 1) + 1] = 255) and (Q[3 * (X - 1) + 2] = 255))
 or ((Q[3 * (X + 1)] = 255) and (Q[3 * (X + 1) + 1] = 255) and (Q[3 * (X + 1) + 2] = 255))) then
 begin
 O[3 * X] := 255;
 O[3 * X + 1] := 255;
 O[3 * X + 2] := 255;
 // 将满足条件的黑色点置为白色
 end;
 end;
 end;
 end;
 end;
end;


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678