function IsEmpty(Bmp: TBitmap; Line: Integer): Boolean;
var
i: Integer;
begin
Result := True;
for i := 0 to Bmp.Height - 1 do
if PByteArray(Bmp.ScanLine)[Line] = 0 then begin
Result := False;
Exit;
end;
end;
procedure FindColumn(Bmp: TBitmap; var First, Last: Integer);
begin
while (First < Bmp.Width) and IsEmpty(Bmp, First) do
Inc(First);
Last := First;
while (Last < Bmp.Width) and not IsEmpty(Bmp, Last) do
Inc(Last);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Res, Bmp: TBitmap;
Count, First, Last: Integer;
begin
Bmp := TBitmap.Create;
Res := TBitmap.Create;
try
Bmp.LoadFromFile('e:/myfiles/12345.bmp');
Bmp.PixelFormat := pf8Bit;
Count := 1;
First := 0;
repeat
FindColumn(Bmp, First, Last);
if First = Last then Break
else begin
Res.Width := Last - First + 1;
Res.Height := Bmp.Height;
Res.Canvas.CopyRect(
Rect(0, 0, Res.Width, Res.Height),
Bmp.Canvas,
Rect(First, 0, Last + 1, Res.Height));
Res.SaveToFile('e:/myfiles/' + IntToStr(Count) + '.bmp');
Inc(Count);
First := Last + 1;
end;
until False;
finally
Bmp.Free;
Res.Free;
end;
end;
