paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 19:59:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: forms: add TApplication.Handle

Browse Source 
git-svn-id: trunk@58107 -
This commit is contained in:
ondrej 2018-06-04 01:01:55 +00:00
parent 50dc18646e
commit 9d0ffcca3c
2 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/forms.pp
View File

@ -1415,6 +1415,7 @@ type
function GetActive: boolean; function GetActive: boolean;
function GetCurrentHelpFile: string; function GetCurrentHelpFile: string;
function GetExename: String; function GetExename: String;
function GetHandle: THandle;
function GetMainFormHandle: HWND; function GetMainFormHandle: HWND;
function GetTitle: string; function GetTitle: string;
procedure FreeIconHandles; procedure FreeIconHandles;
@ -1429,6 +1430,7 @@ type
procedure UpdateMouseControl(NewMouseControl: TControl); procedure UpdateMouseControl(NewMouseControl: TControl);
procedure UpdateMouseHint(CurrentControl: TControl); procedure UpdateMouseHint(CurrentControl: TControl);
procedure SetCaptureExceptions(const AValue: boolean); procedure SetCaptureExceptions(const AValue: boolean);
procedure SetHandle(const AHandle: THandle);
procedure SetHint(const AValue: string); procedure SetHint(const AValue: string);
procedure SetHintColor(const AValue: TColor); procedure SetHintColor(const AValue: TColor);
procedure SetIcon(AValue: TIcon); procedure SetIcon(AValue: TIcon);
@ -1591,6 +1593,7 @@ type
write FFindGlobalComponentEnabled; write FFindGlobalComponentEnabled;
property Flags: TApplicationFlags read FFlags write SetFlags; property Flags: TApplicationFlags read FFlags write SetFlags;
//property HelpSystem : IHelpSystem read FHelpSystem; //property HelpSystem : IHelpSystem read FHelpSystem;
property Handle: THandle read GetHandle write SetHandle; platform;
property Hint: string read FHint write SetHint; property Hint: string read FHint write SetHint;
property HintColor: TColor read FHintColor write SetHintColor; property HintColor: TColor read FHintColor write SetHintColor;
property HintHidePause: Integer read FHintHidePause write FHintHidePause; property HintHidePause: Integer read FHintHidePause write FHintHidePause;

10
lcl/include/application.inc
View File

@ -251,6 +251,11 @@ Begin
Result := ParamStrUTF8(0); Result := ParamStrUTF8(0);
end; end;
function TApplication.GetHandle: THandle;
begin
Result := WidgetSet.AppHandle;
end;
function TApplication.GetMainFormHandle: HWND; function TApplication.GetMainFormHandle: HWND;
var var
i: Integer; i: Integer;
@ -550,6 +555,11 @@ begin
FFlags := Flags - [AppNoExceptionMessages] + AValue*[AppNoExceptionMessages]; FFlags := Flags - [AppNoExceptionMessages] + AValue*[AppNoExceptionMessages];
end; end;
procedure TApplication.SetHandle(const AHandle: THandle);
begin
WidgetSet.AppHandle := AHandle;
end;
procedure TApplication.SetMainFormOnTaskBar(const AValue: Boolean); procedure TApplication.SetMainFormOnTaskBar(const AValue: Boolean);
begin begin
if FMainFormOnTaskBar = AValue then exit; if FMainFormOnTaskBar = AValue then exit;