Adds LCLIntf functions for conveniently obtaining a native form Handle or a native Canvas Handle from the LCL

git-svn-id: trunk@34358 -

lcl/include/intfbaselcl.inc

@@ -362,6 +362,16 @@ begin
   Result := KeyAndShiftStateToKeyString(AVKey, AShiftState);
 end;
 
+function TWidgetSet.GetAvailableNativeCanvasTypes(DC: HDC; AAllowFallbackToParent: Boolean): TNativeCanvasTypes; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+begin
+  Result := [];
+end;
+
+function TWidgetSet.GetAvailableNativeHandleTypes(Handle: HWND; AAllowFallbackToParent: Boolean): TNativeHandleTypes; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+begin
+  Result := [];
+end;
+
 function TWidgetSet.GetCaretRespondToFocus(handle: HWND;
   var ShowHideOnFocus: boolean): Boolean;
 begin
@@ -411,6 +421,16 @@ begin
   else Result := nil;
 end;
 
+function TWidgetSet.GetNativeCanvas(DC: HDC; AHandleType: TNativeCanvasType; AAllowFallbackToParent: Boolean): PtrInt;
+begin
+  Result := 0;
+end;
+
+function TWidgetSet.GetNativeHandle(Handle: HWND; AHandleType: TNativeHandleType; AAllowFallbackToParent: Boolean): PtrInt;
+begin
+  Result := 0;
+end;
+
 // TODO: remove
 function TWidgetSet.GetScrollBarSize(Handle: HWND;
   SBStyle: Integer): integer;

lcl/include/lclintf.inc

@@ -211,6 +211,16 @@ begin
   Result := WidgetSet.Frame3d(DC, ARect, FrameWidth, Style);
 end;
 
+function GetAvailableNativeCanvasTypes(DC: HDC; AAllowFallbackToParent: Boolean): TNativeCanvasTypes;
+begin
+  Result := Widgetset.GetAvailableNativeCanvasTypes(DC, AAllowFallbackToParent);
+end;
+
+function GetAvailableNativeHandleTypes(Handle: HWND; AAllowFallbackToParent: Boolean): TNativeHandleTypes;
+begin
+  Result := Widgetset.GetAvailableNativeHandleTypes(Handle, AAllowFallbackToParent);
+end;
+
 function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean;
 begin
   Result := WidgetSet.GetCaretRespondToFocus(handle,ShowHideOnFocus);
@@ -297,6 +307,16 @@ begin
   Result := WidgetSet.GetAcceleratorString(AVKey, AShiftState);
 end;
 
+function GetNativeCanvas(DC: HDC; AHandleType: TNativeCanvasType; AAllowFallbackToParent: Boolean): PtrInt;
+begin
+  Result := Widgetset.GetNativeCanvas(DC, AHandleType, AAllowFallbackToParent);
+end;
+
+function GetNativeHandle(Handle: HWND; AHandleType: TNativeHandleType; AAllowFallbackToParent: Boolean): PtrInt;
+begin
+  Result := Widgetset.GetNativeHandle(Handle, AHandleType, AAllowFallbackToParent);
+end;
+
 {------------------------------------------------------------------------------
   function GetWindowRelativePosition(Handle: hwnd;
     var Left, Top: integer): boolean;

lcl/include/lclintfh.inc

@@ -74,6 +74,8 @@ function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF IF_BASE_MEMBER}vir
 function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TGraphicsBevelCut): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
 function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function GetAvailableNativeCanvasTypes(DC: HDC; AAllowFallbackToParent: Boolean = False): TNativeCanvasTypes; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function GetAvailableNativeHandleTypes(Handle: HWND; AAllowFallbackToParent: Boolean = False): TNativeHandleTypes; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetClientBounds(handle : HWND; var ARect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetCmdLineParamDescForInterface: string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@@ -82,6 +84,8 @@ function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var Origi
 function GetDesignerDC(WindowHandle: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetLCLOwnerObject(Handle: HWnd): TObject; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function GetNativeCanvas(DC: HDC; AHandleType: TNativeCanvasType; AAllowFallbackToParent: Boolean = False): PtrInt; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function GetNativeHandle(Handle: HWND; AHandleType: TNativeHandleType; AAllowFallbackToParent: Boolean = False): PtrInt; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetScrollBarSize(Handle: HWND; SBStyle: Integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

lcl/interfaces/customdrawn/customdrawnint.pas

@@ -137,6 +137,7 @@ type
     LastKey: Word;       // Used for KeyRelease event
 
     function FindWindowByXID(XWindowID: X.TWindow; out AWindowInfo: TX11WindowInfo): TWinControl;
+    procedure AppProcessMessage;
     {$endif}
     {$ifdef CD_Android}
     procedure AndroidDebugLn(AStr: string);
@@ -193,9 +194,6 @@ type
     procedure AppRun(const ALoop: TApplicationMainLoop); override;
     procedure AppWaitMessage; override;
     procedure AppProcessMessages; override;
-    {$ifdef CD_X11}
-    procedure AppProcessMessage;
-    {$endif}
     procedure AppTerminate; override;
     procedure AppMinimize; override;
     procedure AppRestore; override;
@@ -318,6 +316,19 @@ uses
   customdrawnprivate,
   LCLMessageGlue;
 
+const
+  {$ifdef CD_Windows}
+  CDBackendNativeHandle = nhtWindowsHWND;
+  {$define CD_HasNativeFormHandle}
+  {$endif}
+  {$ifdef CD_X11}
+  CDBackendNativeHandle = nhtX11TWindow;
+  {$define CD_HasNativeFormHandle}
+  {$endif}
+  {$ifdef CD_Cocoa}
+  CDBackendNativeHandle = nhtCocoaNSWindow;
+  {$define CD_HasNativeFormHandle}
+  {$endif}
 
 {$I customdrawnobject.inc}
 

lcl/interfaces/customdrawn/customdrawnlclintf.inc

@@ -237,10 +237,26 @@ begin
 	    QFontInfo_destroy(QtFontInfo);
     end;
   end;
+end;*)
+
+function TCDWidgetSet.GetAvailableNativeCanvasTypes(DC: HDC; AAllowFallbackToParent: Boolean = False): TNativeCanvasTypes;
+begin
+  Result := [nctLazCanvas];
 end;
 
+function TCDWidgetSet.GetAvailableNativeHandleTypes(Handle: HWND; AAllowFallbackToParent: Boolean = False): TNativeHandleTypes;
+var
+  lBaseControl: TCDBaseControl absolute Handle;
+begin
+  Result := [];
+  {$ifdef CD_HasNativeFormHandle}
+  if Handle = 0 then Exit;
+  if (lBaseControl is TCDForm) or AAllowFallbackToParent then
+    Result := [CDBackendNativeHandle];
+  {$endif}
+end;
 
-function TQtWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC;
+(*function TQtWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC;
 var
   Widget: TQtWidget;
 begin
@@ -253,6 +269,40 @@ begin
 
   if Result = 0 then
     Result := GetDC(WindowHandle);
+end;*)
+
+function TCDWidgetSet.GetNativeCanvas(DC: HDC; AHandleType: TNativeCanvasType; AAllowFallbackToParent: Boolean = False): PtrInt;
+begin
+  Result := 0;
+  if AHandleType = nctLazCanvas then Result := PtrInt(DC);
+end;
+
+function TCDWidgetSet.GetNativeHandle(Handle: HWND; AHandleType: TNativeHandleType; AAllowFallbackToParent: Boolean = False): PtrInt;
+var
+  lBaseControl: TCDBaseControl absolute Handle;
+  lFormHandle: TCDForm;
+  lForm: TCustomForm;
+begin
+  Result := 0;
+  {$ifdef CD_HasNativeFormHandle}
+  if Handle = 0 then Exit;
+  if (lBaseControl is TCDForm) or AAllowFallbackToParent then
+  begin
+    if (lBaseControl is TCDWinControl) then
+    begin
+      lForm := Forms.GetParentForm((lBaseControl as TCDWinControl).WinControl);
+      if lForm = nil then Exit;
+      lFormHandle := TCDForm(lForm.Handle);
+    end
+    else
+      lFormHandle := TCDForm(lBaseControl);
+
+    if AHandleType = CDBackendNativeHandle then
+    begin
+      Result := lFormHandle.NativeHandle;
+    end;
+  end;
+  {$endif}
 end;
 
 {------------------------------------------------------------------------------
@@ -261,7 +311,7 @@ end;
   Returns:
  ------------------------------------------------------------------------------}
 
-function TQtWidgetSet.IntfSendsUTF8KeyPress: boolean;
+(*function TQtWidgetSet.IntfSendsUTF8KeyPress: boolean;
 begin
   Result := True;
 end;

lcl/interfaces/customdrawn/customdrawnlclintfh.inc

@@ -43,9 +43,13 @@ procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); override;
 procedure DestroyRubberBand(ARubberBand: HWND); override;*)
 
 (*function FontCanUTF8(Font: HFont): boolean; override; // Dont implement, deprecated
-function FontIsMonoSpace(Font: HFont): boolean; override;
+function FontIsMonoSpace(Font: HFont): boolean; override;*)
 
-function GetDesignerDC(WindowHandle: HWND): HDC; override;*)
+function GetAvailableNativeCanvasTypes(DC: HDC; AAllowFallbackToParent: Boolean = False): TNativeCanvasTypes; override;
+function GetAvailableNativeHandleTypes(Handle: HWND; AAllowFallbackToParent: Boolean = False): TNativeHandleTypes; override;
+//function GetDesignerDC(WindowHandle: HWND): HDC; override;
+function GetNativeCanvas(DC: HDC; AHandleType: TNativeCanvasType; AAllowFallbackToParent: Boolean = False): PtrInt; override;
+function GetNativeHandle(Handle: HWND; AHandleType: TNativeHandleType; AAllowFallbackToParent: Boolean = False): PtrInt; override;
 
 procedure HideVirtualKeyboard();
 

lcl/lcltype.pp

@@ -87,6 +87,15 @@ type
 
   TDockImageOperation = (disShow, disMove, disHide);
 
+  // Types for native Handle integration
+
+  TNativeHandleType = (nhtWindowsHWND, nhtX11TWindow, nhtCocoaNSWindow,
+    nhtQtQWidget);
+  TNativeHandleTypes = set of TNativeHandleType;
+
+  TNativeCanvasType = (nctWindowsDC, nctLazCanvas);
+  TNativeCanvasTypes = set of TNativeCanvasType;
+
   {$ifndef WINDOWS}
   THandle = type PtrUInt; // define our own, because the SysUtils.THandle = System.THandle is a longint
   HANDLE = THandle;