delphi – 如何使用FireMonkey(多平台)截取屏幕截图

对于Windows和Mac兼容性,我使用流.

API Mac Capture –> TStream

API Windows Capture –> Vcl.Graphics.TBitmap –> TStream.

之后,我将我的Windows或Mac TStream加载到FMX.Types.TBitmap中(从流中加载)

Windows单位代码：

unit tools_WIN;

interface
{$IFDEF MSWINDOWS}
uses Classes {$IFDEF MSWINDOWS},Windows {$ENDIF},System.SysUtils,VCL.Forms,VCL.Graphics;


  procedure TakeScreenshot(Dest: FMX.Types.TBitmap);
{$ENDIF MSWINDOWS}

implementation

{$IFDEF MSWINDOWS}


procedure WriteWindowsToStream(AStream: TStream);
var
  dc: HDC; lpPal : PLOGPALETTE;
  bm: TBitMap;
begin
{test width and height}
  bm := TBitmap.Create;

  bm.Width := Screen.Width;
  bm.Height := Screen.Height;

  //get the screen dc
  dc := GetDc(0);
  if (dc = 0) then exit;
 //do we have a palette device?
  if (GetDeviceCaps(dc,RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then
  begin
    //allocate memory for a logical palette
    GetMem(lpPal,sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
    //zero it out to be neat
    FillChar(lpPal^,sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)),#0);
    //fill in the palette version
    lpPal^.palVersion := $300;
    //grab the system palette entries
    lpPal^.palNumEntries :=GetSystemPaletteEntries(dc,256,lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then
    begin
      //create the palette
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal,sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
  end;
  //copy from the screen to the bitmap
  BitBlt(bm.Canvas.Handle,Screen.Width,Screen.Height,Dc,SRCCOPY);

  bm.SaveToStream(AStream);

  FreeAndNil(bm);
  //release the screen dc
  ReleaseDc(0,dc);
end;


procedure TakeScreenshot(Dest: FMX.Types.TBitmap);
var
  Stream: TMemoryStream;
begin
  try
    Stream := TMemoryStream.Create;
    WriteWindowsToStream(Stream);
    Stream.Position := 0;
    Dest.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

{$ENDIF MSWINDOWS}
end.

Mac单位代码：

unit tools_OSX;


interface
{$IFDEF MACOS}
uses

  Macapi.CoreFoundation,Macapi.CocoaTypes,Macapi.CoreGraphics,Macapi.ImageIO,system.Classes,system.SysUtils;

  procedure TakeScreenshot(Dest: TBitmap);
{$ENDIF MACOS}

implementation
{$IFDEF MACOS}

{$IF NOT DECLARED(CGRectInfinite)}
const
  CGRectInfinite: CGRect = (origin: (x: -8.98847e+30; y: -8.98847e+307);
    size: (width: 1.79769e+308; height: 1.79769e+308));
{$IFEND}


function PutBytesCallback(Stream: TStream; NewBytes: Pointer;
  Count: LongInt): LongInt; cdecl;
begin
  Result := Stream.Write(NewBytes^,Count);
end;

procedure ReleaseConsumerCallback(Dummy: Pointer); cdecl;
begin
end;

procedure WriteCGImageToStream(const AImage: CGImageRef; AStream: TStream;
  const AType: string = 'public.png'; AOptions: CFDictionaryRef = nil);
var
  Callbacks: CGDataConsumerCallbacks;
  Consumer: CGDataConsumerRef;
  ImageDest: CGImageDestinationRef;
  TypeCF: CFStringRef;
begin
  Callbacks.putBytes := @PutBytesCallback;
  Callbacks.releaseConsumer := ReleaseConsumerCallback;
  ImageDest := nil;
  TypeCF := nil;
  Consumer := CGDataConsumerCreate(AStream,@Callbacks);
  if Consumer = nil then RaiseLastOSError;
  try
    TypeCF := CFStringCreateWithCharactersNoCopy(nil,PChar(AType),Length(AType),kCFAllocatorNull); //wrap the Delphi string in a CFString shell
    ImageDest := CGImageDestinationCreateWithDataConsumer(Consumer,TypeCF,1,AOptions);
    if ImageDest = nil then RaiseLastOSError;
    CGImageDestinationAddImage(ImageDest,AImage,nil);
    if CGImageDestinationFinalize(ImageDest) = 0 then RaiseLastOSError;
  finally
    if ImageDest <> nil then CFRelease(ImageDest);
    if TypeCF <> nil then CFRelease(TypeCF);
    CGDataConsumerRelease(Consumer);
  end;
end;

procedure TakeScreenshot(Dest: TBitmap);
var
  Screenshot: CGImageRef;
  Stream: TMemoryStream;
begin
  Stream := nil;
  ScreenShot := CGWindowListCreateImage(CGRectInfinite,kCGWindowListOptionOnScreenOnly,kCGNullWindowID,kCGWindowImageDefault);
  if ScreenShot = nil then RaiseLastOSError;
  try
    Stream := TMemoryStream.Create;
    WriteCGImageToStream(ScreenShot,Stream);
    Stream.Position := 0;
    Dest.LoadFromStream(Stream);
  finally
    CGImageRelease(ScreenShot);
    Stream.Free;
  end;
end;



 {$ENDIF MACOS}
end.

在您的mainForm单元中：

...
{$IFDEF MSWINDOWS}
  uses tools_WIN;
{$ELSE}
  uses tools_OSX;
{$ENDIF MSWINDOWS}

...
var
  imgDest: TImageControl;
...
TakeScreenshot(imgDest.Bitmap);

如果您有其他想法,请与我联系:-)