paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 18:58:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@34358 -
This commit is contained in:
sekelsenmat 2011-12-21 20:13:07 +00:00
parent c01e1b5cde
commit cf2403a126
7 changed files with 125 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lcl/include/intfbaselcl.inc
View File

@ -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;

20
lcl/include/lclintf.inc
View File

@ -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;

4
lcl/include/lclintfh.inc
View File

@ -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}

17
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -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}

54
lcl/interfaces/customdrawn/customdrawnlclintf.inc
View File

@ -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;

8
lcl/interfaces/customdrawn/customdrawnlclintfh.inc
View File

@ -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();

9
lcl/lcltype.pp
View File

@ -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;