Finishes screenshot code in LCL-CustomDrawn-Cocoa

git-svn-id: trunk@34292 -
This commit is contained in:
sekelsenmat 2011-12-19 19:46:23 +00:00
parent 45d2898b79
commit b41b044791
8 changed files with 48 additions and 168 deletions

View File

@ -116,12 +116,6 @@ type
function WinRegister: Boolean;
procedure CreateAppHandle;
{$endif}
{$ifdef CD_Cocoa}
pool : NSAutoreleasePool;
NSApp : NSApplication;
delegate : TCDAppDelegate;
{$endif}
public
{$ifdef CD_X11}
FDisplayName: string;
@ -148,6 +142,12 @@ type
procedure AndroidDebugLn(AStr: string);
function AndroidKeyCodeToLCLKeyCode(AAndroidKeyCode: Integer): Word;
{$endif}
{$ifdef CD_Cocoa}
pool : NSAutoreleasePool;
NSApp : NSApplication;
delegate : TCDAppDelegate;
ScreenBitmapContext: CGContextRef;
{$endif}
// For generic methods added in customdrawn
// They are used internally in LCL-CustomDrawn, LCL app should not use them
public

View File

@ -158,47 +158,28 @@ end;
------------------------------------------------------------------------------}
function TCDWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
var
Desc: TRawImageDescription absolute ARawImage.Description;
screenshotImage: CGImageRef;
imageDataProv: CGDataProviderRef;
imageData: CFDataRef;
lBitsPerComponent, lBitsPerPixel, lBytesPerRow: size_t;
lDataPtr: UnivPtr;
lDataLength: CFIndex;
lRect: CGRect;
lScreenRawImage: TRawImage;
lDataLength: Integer;
begin
Result := True;
ARawImage.Init;
ARawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(0, 0);
ARawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(ScreenBitmapWidth, ScreenBitmapHeight);
// Take the screenshot and obtain the pixel data
// Take the screenshot
screenshotImage := CGDisplayCreateImage(CGMainDisplayID()); // Requires 10.6+
imageDataProv := CGImageGetDataProvider(screenshotImage); // Requires 10.5+
imageData := CGDataProviderCopyData(imageDataProv);
// Now read the image description and convert it to our own
lBitsPerComponent := CGImageGetBitsPerComponent(screenshotImage);
ARawImage.Description.AlphaPrec := 0;
ARawImage.Description.RedPrec := lBitsPerComponent;
ARawImage.Description.GreenPrec := lBitsPerComponent;
ARawImage.Description.BluePrec := lBitsPerComponent;
ARawImage.Description.RedShift := 0;
ARawImage.Description.GreenShift := 8;
ARawImage.Description.BlueShift := 16;
ARawImage.Description.Width := CGImageGetWidth(screenshotImage);
ARawImage.Description.Height := CGImageGetHeight(screenshotImage);
lBitsPerPixel := CGImageGetBitsPerPixel(screenshotImage); // For now support it will give us 32
lBytesPerRow := CGImageGetBytesPerRow(screenshotImage);
// Draw it to our screen bitmap
lRect := CGRectMake(0, 0, ScreenBitmapWidth, ScreenBitmapHeight);
CGContextDrawImage(ScreenBitmapContext, lRect, screenshotImage);
// Now copy the data
lDataPtr := CFDataGetBytePtr(imageData);
lDataLength := CFDataGetLength(imageData);
ScreenImage.GetRawImage(lScreenRawImage, False);
ARawImage.CreateData(False);
lDataLength := Min(lDataLength, ARawImage.DataSize);
System.Move(lDataPtr^, ARawImage.Data^, lDataLength);
lDataLength := Min(lScreenRawImage.DataSize, ARawImage.DataSize);
System.Move(lScreenRawImage.Data^, ARawImage.Data^, lDataLength);
end;
procedure TCDWidgetset.ShowVirtualKeyboard();

View File

@ -79,18 +79,6 @@ begin
CDWidgetSet := Self;
FTerminating := False;
{$ifndef CD_UseNativeText}
// Create the dummy screen DC
ScreenBitmapRawImage.Init;
ScreenBitmapHeight := 100;
ScreenBitmapWidth := 100;
ScreenBitmapRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(ScreenBitmapWidth, ScreenBitmapHeight);
ScreenBitmapRawImage.CreateData(True);
ScreenImage := TLazIntfImage.Create(0, 0);
ScreenImage.SetRawImage(ScreenBitmapRawImage);
ScreenDC := TLazCanvas.Create(ScreenImage);
{$endif}
BackendCreate;
end;
@ -105,12 +93,6 @@ destructor TCDWidgetSet.Destroy;
begin
BackendDestroy;
{$ifndef CD_UseNativeText}
// Free the dummy screen DC
ScreenImage.Free;
ScreenDC.Free;
{$endif}
CDWidgetSet := nil;
inherited Destroy;
end;

View File

@ -108,13 +108,10 @@ end;
Constructor for the class
------------------------------------------------------------------------------}
procedure TCDWidgetSet.BackendCreate;
var
ScreenBitmapContext: CGContextRef;
begin
{ Creates the AutoreleasePool }
pool := NSAutoreleasePool(NSAutoreleasePool.alloc).init;
{$ifdef CD_UseNativeText}
{ Prepares the Native DC for the ScreenDC }
{ NSImage / NSBitmapImageRep are very limited. They simply don't support
@ -131,8 +128,8 @@ begin
see: http://lists.apple.com/archives/carbon-dev/2006/Jan/msg01055.html
}
ScreenBitmapHeight := 100;
ScreenBitmapWidth := 100;
ScreenBitmapWidth := Round(NSScreen.mainScreen.frame.size.width);
ScreenBitmapHeight := Round(NSScreen.mainScreen.frame.size.height);
ScreenBitmapRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(ScreenBitmapWidth, ScreenBitmapHeight);
ScreenBitmapRawImage.CreateData(True);
ScreenBitmapContext := CGBitmapContextCreate(
@ -148,7 +145,6 @@ begin
ScreenDC := TLazCanvas.Create(ScreenImage);
ScreenDC.NativeDC := PtrInt(TCocoaContext.Create);
TCocoaContext(ScreenDC.NativeDC).cgctx := ScreenBitmapContext; //NSGraphicsContext.graphicsContextWithBitmapImageRep(ScreenBitmap.imagerep);
{$endif}
end;
{------------------------------------------------------------------------------
@ -161,12 +157,10 @@ begin
{ Releases the AutoreleasePool }
pool.release;
{$ifdef CD_UseNativeText}
{ Release the screen DC and Image}
{ Release the screen DC and Image }
ScreenDC.Free;
ScreenImage.Free;
// ScreenBitmap.Free;
{$endif}
end;
{------------------------------------------------------------------------------

View File

@ -62,6 +62,15 @@ end;
------------------------------------------------------------------------------}
procedure TCDWidgetSet.BackendCreate;
begin
// Create the dummy screen DC
ScreenBitmapRawImage.Init;
ScreenBitmapHeight := 100;
ScreenBitmapWidth := 100;
ScreenBitmapRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(ScreenBitmapWidth, ScreenBitmapHeight);
ScreenBitmapRawImage.CreateData(True);
ScreenImage := TLazIntfImage.Create(0, 0);
ScreenImage.SetRawImage(ScreenBitmapRawImage);
ScreenDC := TLazCanvas.Create(ScreenImage);
end;
{------------------------------------------------------------------------------
@ -73,6 +82,9 @@ end;
------------------------------------------------------------------------------}
procedure TCDWidgetSet.BackendDestroy;
begin
{ Release the screen DC and Image }
ScreenDC.Free;
ScreenImage.Free;
end;
{------------------------------------------------------------------------------

View File

@ -4756,21 +4756,6 @@ begin
Result := True;
end;*)
{$ifndef CD_Android}
function TCDWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer;
{var
Str: WideString;
TitleStr: WideString;
OkStr: WideString;}
begin
{ //TODO: Finish full implementation of MessageBox
Str := GetUtf8String('TQtWidgetSet.MessageBox - not implemented');
TitleStr := GetUtf8String(lpCaption);
OkStr := GetUtf8String('Ok');
Result := QMessageBox_information(TQtWidget(hWnd).Widget, @Str, @TitleStr, @OkStr);}
end;
{$endif}
{------------------------------------------------------------------------------
Function: MoveToEx
Params: none

View File

@ -565,21 +565,24 @@ begin
Result:=False;
end;
function TCDWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer;
{var
Str: WideString;
TitleStr: WideString;
OkStr: WideString;}
begin
{ //TODO: Finish full implementation of MessageBox
Str := GetUtf8String('TQtWidgetSet.MessageBox - not implemented');
TitleStr := GetUtf8String(lpCaption);
OkStr := GetUtf8String('Ok');
Result := QMessageBox_information(TQtWidget(hWnd).Widget, @Str, @TitleStr, @OkStr);}
end;
(*function TCocoaWidgetSet.UpdateWindow(Handle: HWND): Boolean;
begin
Result:=InvalidateRect(Handle, nil, false);
end;
function TCocoaWidgetSet.GetProp(Handle : hwnd; Str : PChar): Pointer;
begin
Result:=nil;
end;
function TCocoaWidgetSet.SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean;
begin
Result:=False;
end;
{----------------------------- WINDOWS SCROLLING ------------------------------}
function TCocoaWidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
@ -607,81 +610,6 @@ begin
Result:=False;
end;
{----------------------------------- DRAWING ----------------------------------}
type
TPointArray = array [word] of TPoint;
PPointArray = ^TPointArray;
function TCocoaWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
var
ctx : TCocoaContext;
begin
ctx:=CheckDC(DC);
Result:=Assigned(ctx);
if not Result then Exit;
ctx.LineTo(x,y);
end;
function TCocoaWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
var
ctx : TCocoaContext;
begin
ctx:=CheckDC(DC);
Result:=Assigned(ctx);
if not Result then Exit;
if Assigned(OldPoint) then OldPoint^:=ctx.PenPos;
ctx.MoveTo(x,y);
end;
function TCocoaWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean;
var
ctx : TCocoaContext;
begin
ctx:=CheckDC(DC);
Result:=Assigned(ctx) and Assigned(Points) and (NumPts>=2);
if not Result then Exit;
ctx.Polygon(PPointArray(Points)^, NumPts, Winding);
Result:=True;
end;
function TCocoaWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
var
ctx : TCocoaContext;
begin
ctx:=CheckDC(DC);
Result:=Assigned(ctx) and Assigned(Points) and (NumPts>0);
if not Result then Exit;
ctx.Polyline(PPointArray(Points)^, NumPts);
Result:=True;
end;
function TCocoaWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var
ctx : TCocoaContext;
begin
{$IFDEF VerboseWinAPI}
DebugLn('[TCocoaWidgetSet.Rectangle] DC: %x X1: %d Y1: %d X2: %d Y2: %d',
[DC, X1, Y1, X2, Y2]);
{$ENDIF}
ctx:=CheckDC(DC);
Result:=Assigned(ctx);
if not Result then Exit;
ctx.Rectangle(X1, Y1, X2, Y2, False, nil);
Result:=True;
end;
function TCDWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer;
begin
Result := 0;
end;
function TCocoaWidgetSet.SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
var
dc: TCocoaContext;

View File

@ -4742,20 +4742,18 @@ begin
end;
Result := True;
end;
end;*)
function TCDWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer;
begin
// X11 has no native dialog, so just use the one installed by Dialogs.pas
// X11 has no native dialogs, so just use the one installed by Dialogs.pas
Result := Application.MessageBox(lpText, lpCaption, uType);
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: MoveToEx
Params: none
Returns: Nothing
------------------------------------------------------------------------------}
function TQtWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
begin