Сканировать изображение
| Код |
procedure TForm1.Button1Click(Sender: TObject);
var
B, b2 : TBitMap;
p : array of PbyteArray;
i, j : Integer;
fl : boolean;
fromtop, fromleft, fromright, frombottom : integer;
begin
B := TBitMap.Create;
B.LoadFromFile('H:\Рисунки\фон\Копия Облака.bmp');
b.PixelFormat := pf24Bit;
setLength(p, b.Height);
for i := 0 to b.Height - 1
do
p[i] := b.ScanLine[i];
for i := 0 to b.Height - 1
do
Begin
fl := true;
for j := 0 to b.Width * 3 - 1
do
if p[i][j] <> 255
then
Begin
fl := false;
fromtop := i;
break;
end;
if not fl
then
break;
end;
for I := b.Height - 1 downto 0
do
Begin
fl := true;
for j := 0 to b.Width * 3 - 1
do
if p[i][j] <> 255
then
Begin
fl := false;
frombottom := i;
break;
end;
if not fl
then
break;
end;
for j := 0 to b.Width - 1
do
Begin
fl := true;
for I := 0 to b.Height - 1
do
if (p[i][j*3] <> 255) or
(p[i][j*3+1] <> 255) or
(p[i][j*3+2] <> 255)
then
Begin
fl := false;
fromLeft := j;
break;
end;
if not fl
then
break;
end;
for j := b.Width - 1 downto 0
do
Begin
fl := true;
for I := 0 to b.Height - 1
do
if (p[i][j*3] <> 255) or
(p[i][j*3+1] <> 255) or
(p[i][j*3+2] <> 255)
then
Begin
fl := false;
fromRight := j;
break;
end;
if not fl
then
break;
end;
b2 := TBitMap.Create;
b2.Width := fromRight - fromLeft + 1;
b2.Height := frombottom - fromtop + 1;
b2.Canvas.CopyRect(Rect(0, 0,
fromRight - fromLeft+2,
frombottom - fromtop+1),
b.Canvas, Rect(fromLeft, fromtop,
fromRight+1, frombottom+1));
b2.SaveToFile('H:\Рисунки\фон\Копия Облака2.bmp');
b2.Free;
b.Free;
end;
|
|