2

我在网上找到了这个代码，但 FMX.Bitmap 没有扫描线。是否可以以某种方式将 VCL.TBitmap 复制或绘制到 FMX.Bitmap？

{$IFDEF MSWINDOWS}
type
  TBitmap = FMX.Types.TBitmap;
  TVclBitmap = Vcl.Graphics.TBitmap;

procedure TakeScreenshot(Dest: FMX.Types.TBitmap);
var
  DC: HDC;
  Size: TPointF;
  VCLBitmap: TVclBitmap;
  Y: Integer;
begin
  VCLBitmap := nil;
  //Size := FMX.Platform.IFMXScreenService.GetScreenSize;
  DC := GetDC(0);
  try
    VCLBitmap := TVclBitmap.Create;
    VCLBitmap.PixelFormat := pf32bit;
    VCLBitmap.SetSize(Trunc(Size.X), Trunc(Size.Y));
    BitBlt(VCLBitmap.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height,
      DC, 0, 0, SRCCOPY);
    Dest.SetSize(VCLBitmap.Width, VCLBitmap.Height);
    { The format of a FMX bitmap and a 32 bit VCL bitmap is the same, so just
      copy the scanlines. - not true- FMX bitmap does not have ScanLine? }
    for Y := Dest.Height - 1 downto 0 do
      Move(VCLBitmap.ScanLine[Y]^, Dest.ScanLine[Y]^, Dest.Width * 4);
    {Dest.Canvas.DrawBitmap(); Not possible to assign or draw}
  finally
    ReleaseDC(0, DC);
    VCLBitmap.Free;
  end;
end;
{$ENDIF}
4

2 回答 2

6

您可以使用 Stream ：

{$IFDEF MSWINDOWS}

type

  TVclBitmap = Vcl.Graphics.TBitmap;

procedure TakeScreenshot(Dest: TBitmap);
var
  DC: HDC;
  Size: TPointF;
  VCLBitmap: TVclBitmap;
  Y: Integer;
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  VCLBitmap := nil;
  // Size := FMX.Platform.IFMXScreenService.GetScreenSize;
  DC := GetDC(0);
  Size.X := 500;
  Size.Y := 500;
  try
    VCLBitmap := TVclBitmap.Create;
    VCLBitmap.PixelFormat := pf32bit;
    VCLBitmap.SetSize(Trunc(Size.X), Trunc(Size.Y));
    BitBlt(VCLBitmap.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height, DC,
      0, 0, SRCCOPY);
    Dest.SetSize(VCLBitmap.Width, VCLBitmap.Height);
    { The format of a FMX bitmap and a 32 bit VCL bitmap is the same, so just
      copy the scanlines. - not true- FMX bitmap does not have ScanLine? }
    VCLBitmap.SaveToStream(MS);
    MS.Position := 0;
    Dest.LoadFromStream(MS);
    MS.Free;
    { Dest.Canvas.DrawBitmap(); Not possible to assign or draw }
  finally
    ReleaseDC(0, DC);
    VCLBitmap.Free;
  end;
end;
{$ENDIF}
于 2013-10-06T19:43:17.083 回答
1 
unit uScreenShot;

interface

uses
  FMX.Graphics;

type
  IScreenShot = interface
    ['{026A7002-AD30-47FD-A7B8-D633F3FAB130}']
    function Execute: IScreenShot;
    function Bitmap: TBitmap;
  end;

implementation

end.

unit uScreenShot.Clss;

{ =====================================================================
   How to use:
     TScreenShot.New(YourBitmapObject).Execute;
     TScreenShot.New.Execute.Bitmap;
  ====================================================================== }

interface

uses
  Vcl.Graphics,
  FMX.Graphics,
  uScreenShot;

type
  TVclBitmap = Vcl.Graphics.TBitmap;

  TScreenShot = class(TInterfacedObject, IScreenShot)
  private
    FBitmap: TBitmap;
    FTarget: TBitmap;
    class procedure TakeScreenshot(const ATarget: TBitmap); static;
    class procedure CopyBitmap(const ASource: TVclBitmap; const ATarget: TBitmap); static;
  protected
    function Execute: IScreenShot;
    function Bitmap: TBitmap;
  public
    class function New: IScreenShot; overload; static;
    class function New(const ATarget: TBitmap): IScreenShot; overload; static;
    constructor Create; overload;
    constructor Create(const ATarget: TBitmap); overload;
    destructor Destroy; override;
  end;

implementation

uses
  FMX.Forms,
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.Types;

{ TScreenShot }

class function TScreenShot.New: IScreenShot;
begin
  Result := TScreenShot.Create;
end;

class function TScreenShot.New(const ATarget: FMX.Graphics.TBitmap): IScreenShot;
begin
  Result := TScreenShot.Create(ATarget);
end;

constructor TScreenShot.Create;
begin
  inherited;
  FTarget := nil;
  FBitmap := FMX.Graphics.TBitmap.Create;
end;

constructor TScreenShot.Create(const ATarget: FMX.Graphics.TBitmap);
begin
  Self.Create;
  FTarget := ATarget;
end;

destructor TScreenShot.Destroy;
begin
  FTarget := nil;
  FreeAndNil(FBitmap);
  inherited;
end;

function TScreenShot.Bitmap: FMX.Graphics.TBitmap;
begin
  Result := FBitmap;
end;

function TScreenShot.Execute: IScreenShot;
begin
  Result := Self;
  TScreenShot.TakeScreenshot(FBitmap);
  if Assigned(FTarget) then
  begin
    FTarget.Size := FBitmap.Size;
    FTarget.CopyFromBitmap(FBitmap);
  end;
end;

class procedure TScreenShot.TakeScreenshot(const ATarget: FMX.Graphics.TBitmap);
var
  LDc: HDC;
  LSize: TPoint;
  LVclBitmap: TVclBitmap;
begin
  LSize.X := Screen.Size.Width;
  LSize.Y := Screen.Size.Height;
  // Getting Screenshot
  LDc := GetDC(0);
  LVclBitmap := TVclBitmap.Create;
  try
    LVclBitmap.PixelFormat := pf32bit;
    LVclBitmap.SetSize(LSize.X, LSize.Y);
    BitBlt(LVclBitmap.Canvas.Handle, 0, 0, LVclBitmap.Width, LVclBitmap.Height, LDc, 0, 0, SRCCOPY);
    ATarget.SetSize(LVclBitmap.Width, LVclBitmap.Height);
    // Saving Screenshot
    TScreenShot.CopyBitmap(LVclBitmap, ATarget);
  finally
    ReleaseDC(0, LDc);
    LVclBitmap.Free;
  end;
end;

class procedure TScreenShot.CopyBitmap(const ASource: TVclBitmap; const ATarget: FMX.Graphics.TBitmap);
var
  LStream: TMemoryStream;
begin
  LStream := TMemoryStream.Create;
  try
    ASource.SaveToStream(LStream);
    LStream.Position := 0;
    ATarget.LoadFromStream(LStream);
  finally
    LStream.Free;
  end;
end;

end.
于 2021-03-03T02:07:40.157 回答