delphi 截屏保存图片

function TfrmShareSheet.GetMakeScreenshot:string;
var
tempPath:string;
begin
if FimgSharePath='' then
begin
tempPath:=FormatDateTime('yyyymmddhhssmm',Now());
FimgSharePath:=MainDM.SJGY.GetHuanCunPath('ekelian')+tempPath+'.jpg';
FimgThumbSharePath:=MainDM.SJGY.GetHuanCunPath('ekelian')+'Thumb'+tempPath+'.jpg';
RecForm.MakeScreenshot.SaveToFile(FimgSharePath);
CreateThumbBitmap(FimgSharePath,FimgThumbSharePath);
end;

Result:=FimgSharePath;
end;

 

procedure TfrmShareSheet.CreateThumbBitmap(Apath, Thumbpath: string);
var
ThumbBitmap:TBitmap;
OriginBitmap:TBitmap;
begin
OriginBitmap:=TBitmap.Create;
OriginBitmap.LoadFromFile(Apath);

ThumbBitmap:=TBitmap.Create(200,355);

 

ThumbBitmap.Canvas.BeginScene;
try
ThumbBitmap.Canvas.Clear(TAlphaColorRec.White);
ThumbBitmap.Canvas.DrawBitmap(OriginBitmap,
RectF(0,0,OriginBitmap.Width,OriginBitmap.Height),
RectF(0,0,ThumbBitmap.Width,ThumbBitmap.Height),1);
finally
ThumbBitmap.Canvas.EndScene;
end;

ThumbBitmap.SaveToFile(Thumbpath);

FreeAndNil(OriginBitmap);
FreeAndNil(ThumbBitmap);

end;