我没有找到在FMX.Platform中获取屏幕截图的功能(无论如何,其他地方……).
有了VCL,有很多答案(stackoverflow,google,…).
但是如何在Windows和Mac OS X的图像(位图或其他)中获取屏幕截图?
问候,
W.
更新:
link from Tipiweb为OS X提供了一个很好的解决方案.
关于Windows部分:我编写了这个,但我不喜欢使用VCL和Stream来实现它…
有什么更好的建议,评论?
谢谢.
W.
uses ...,FMX.Types,Winapi.Windows,Vcl.Graphics; ... function DesktopLeft: Integer; begin Result := GetSystemMetrics(SM_XVIRTUALSCREEN); end; function DesktopWidth: Integer; begin Result := GetSystemMetrics(SM_cxvIRTUALSCREEN); end; function DesktopTop: Integer; begin Result := GetSystemMetrics(SM_YVIRTUALSCREEN); end; function DesktopHeight: Integer; begin Result := GetSystemMetrics(SM_CYVIRTUALSCREEN); end; procedure GetScreenShot(var dest: FMX.Types.TBitmap); var cVCL : Vcl.Graphics.TCanvas; bmpVCL: Vcl.Graphics.TBitmap; msBmp : TMemoryStream; begin bmpVCL := Vcl.Graphics.TBitmap.Create; cVCL := Vcl.Graphics.TCanvas.Create; cVCL.Handle := GetwindowDC(GetDesktopWindow); try bmpVCL.Width := DesktopWidth; bmpVCL.Height := DesktopHeight; bmpVCL.Canvas.copyRect(Rect(0,DesktopWidth,DesktopHeight),cVCL,Rect(DesktopLeft,DesktopTop,DesktopLeft + DesktopWidth,DesktopTop + DesktopHeight) ); finally ReleaseDC(0,cVCL.Handle); cVCL.Free; end; msBmp := TMemoryStream.Create; try bmpVCL.SavetoStream(msBmp); msBmp.Position := 0; dest.LoadFromStream(msBmp); finally msBmp.Free; end;
解决方法
我构建了一个小应用程序来截取屏幕截图(Windows / Mac),它可以工作:-)!
对于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);
如果您有其他想法,请与我联系:-)
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。