delphi xe10 获取屏幕截图

Posted 2022-03-17 guorongtao

//截取屏幕图片
function MakeScaleScreenshot(Sender: TControl): TBitmap;
  function GetScreenScale: Single;
  var
    ScreenService: IFMXScreenService;
  begin
    Result := 1;
    if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService,  IInterface(ScreenService)) then
    begin
      Result := ScreenService.GetScreenScale;
    end;
  end;
var
  fScreenScale: Single;
begin 
  fScreenScale := GetScreenScale;
  Result := TBitmap.Create(Round(Sender.Width * fScreenScale),
    Round(Sender.Height * fScreenScale));
  Result.Clear(0);
  if Result.Canvas.BeginScene then
    try
      Sender.PaintTo(Result.Canvas, RectF(0, 0, Result.Width, Result.Height));
    finally
      Result.Canvas.EndScene;
    end;
end;