• Android实例-程序界面内截取屏幕(XE8+小米2)


    结果:

    1.只能截取程序界面内的图片。

    2.图片有点不清楚,自己设置清楚度。

    实例代码:

     1 unit Unit1;
     2 
     3 interface
     4 
     5 uses
     6   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
     7   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
     8   FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Layouts;
     9 
    10 type
    11   TForm1 = class(TForm)
    12     Label1: TLabel;
    13     Button1: TButton;
    14     Image1: TImage;
    15     Layout1: TLayout;
    16     procedure Button1Click(Sender: TObject);
    17   private
    18     { Private declarations }
    19   public
    20     { Public declarations }
    21   end;
    22 
    23 var
    24   Form1: TForm1;
    25 
    26 implementation
    27 uses
    28   FMX.Platform; //需要引入
    29 {$R *.fmx}
    30 {$R *.NmXhdpiPh.fmx ANDROID}
    31 
    32 function MakeScaleScreenshot(Sender: TControl): TBitmap;//截取屏幕函数
    33 var
    34   fScreenScale: Single;
    35   function GetScreenScale: Single;
    36   var
    37   ScreenService: IFMXScreenService;
    38   begin
    39     Result := 1;
    40     if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, IInterface(ScreenService)) then
    41     begin
    42       Result := ScreenService.GetScreenScale;
    43     end;
    44   end;
    45 begin
    46   fScreenScale := GetScreenScale;
    47   Result := TBitmap.Create(Round(Sender.Width * fScreenScale), Round(Sender.Height * fScreenScale));
    48   Result.Clear(0);
    49   if Result.Canvas.BeginScene then
    50   try
    51     Sender.PaintTo(Result.Canvas, RectF(0, 0, Result.Width, Result.Height));
    52   finally
    53     Result.Canvas.EndScene;
    54   end;
    55 end;
    56 
    57 procedure TForm1.Button1Click(Sender: TObject);
    58 var
    59   oBitmap: TBitmap;
    60 begin
    61   oBitmap := MakeScaleScreenshot(Layout1);//此处Layout1为所有容器的容器
    62   Image1.Bitmap.Assign(oBitmap);
    63   oBitmap.DisposeOf;
    64 end;
    65 
    66 end.
  • 相关阅读:
    关于JDK和JRE的一些总结
    Jackson 格式化日期问题
    CentOS6.8安装mysql5.6
    CentOS6.8安装JDK1.7
    VMware NAT方式 CentOS 6.8配置静态IP
    CentOS6.8使用源码安装Git
    关于SourceTree License
    记录平时遇到的问题
    使用React-Router遇到的那些坑
    移动端响应式布局好文收集
  • 原文地址:https://www.cnblogs.com/FKdelphi/p/4784788.html
Copyright © 2020-2023  润新知