procedure CutAFile(FileName: string; qry: TQuery);
var
i: Cardinal;
FromStream, ToStream: TMemoryStream;
SubFileName, Path, fName, MainName, ExtName: string;
NewFileName, Sub_PicName, TemplateName: string;
r: TRect;
begin
if Not FileExists(FileName) then Exit;
ExtName := ExtractFileExt(FileName);
fName := ExtractFileName(FileName); //提取文件名
MainName := copy(fName, 1, length(fName) - Length(ExtName));
TemplateName := RightStr(MainName, 6);
Path := ExtractFilepath(FileName) + TemplateName + '\';
FromStream := TMemoryStream.Create;
FromStream.LoadFromFile(FileName);
ToStream := TMemoryStream.Create;
i := 0; // 图像块号
qry.First;
while not qry.Eof do begin
i := i + 1;
NewFileName := MainName + Format('_%0.2d', [i]);
Sub_PicName := NewFileName + ExtName;
SubFileName := Path + format('%0.2d\', [i]) + Sub_PicName;
with qry do begin
r.Left := FieldByName('selX1').AsInteger;
r.Top := FieldByName('selY1').AsInteger;
r.Right := FieldByName('selX2').AsInteger;
r.Bottom := FieldByName('selY2').AsInteger;
FromStream.Position := 0;
ToStream.Position := 0;
// JpegLosslessTransform(FileName,SubFileName,jtCut,False,jcCopyAll,r);
JpegLosslessTransformStream(FromStream,ToStream,jtCut,False,jcCopyAll,r);
ToStream.Position := 0;
ToStream.SaveToFile(SubFileName);
Next;
end;
end;
FromStream.Free;
ToStream.Free;
end;