mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-31 00:22:51 +02:00
434 lines
13 KiB
ObjectPascal
434 lines
13 KiB
ObjectPascal
{ $Id$}
|
||
{
|
||
*****************************************************************************
|
||
* QtWSForms.pp *
|
||
* ------------ *
|
||
* *
|
||
* *
|
||
*****************************************************************************
|
||
|
||
*****************************************************************************
|
||
* *
|
||
* This file is part of the Lazarus Component Library (LCL) *
|
||
* *
|
||
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
||
* for details about the copyright. *
|
||
* *
|
||
* This program is distributed in the hope that it will be useful, *
|
||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||
* *
|
||
*****************************************************************************
|
||
}
|
||
unit QtWSForms;
|
||
|
||
{$mode delphi}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
// Bindings
|
||
qt4, qtwidgets,
|
||
// LCL
|
||
SysUtils, Controls, LCLType, Forms,
|
||
// Widgetset
|
||
InterfaceBase, WSForms, WSLCLClasses;
|
||
|
||
type
|
||
|
||
{ TQtWSScrollingWinControl }
|
||
|
||
TQtWSScrollingWinControl = class(TWSScrollingWinControl)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSScrollBox }
|
||
|
||
TQtWSScrollBox = class(TWSScrollBox)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSCustomFrame }
|
||
|
||
TQtWSCustomFrame = class(TWSCustomFrame)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSFrame }
|
||
|
||
TQtWSFrame = class(TWSFrame)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSCustomForm }
|
||
|
||
TQtWSCustomForm = class(TWSCustomForm)
|
||
private
|
||
class procedure SetQtWindowBorderStyle(const AHandle: TQtMainWindow; const AFormBorderStyle: TFormBorderStyle);
|
||
class procedure SetQtBorderIcons(const AHandle: TQtMainWindow; const ABorderIcons: TBorderIcons);
|
||
protected
|
||
public
|
||
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
|
||
class procedure DestroyHandle(const AWinControl: TWinControl); override;
|
||
|
||
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
|
||
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
|
||
|
||
class procedure CloseModal(const ACustomForm: TCustomForm); override;
|
||
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
|
||
class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
|
||
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
|
||
class procedure ShowModal(const ACustomForm: TCustomForm); override;
|
||
class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); override;
|
||
end;
|
||
|
||
{ TQtWSForm }
|
||
|
||
TQtWSForm = class(TWSForm)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSHintWindow }
|
||
|
||
TQtWSHintWindow = class(TWSHintWindow)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSScreen }
|
||
|
||
TQtWSScreen = class(TWSScreen)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
{ TQtWSApplicationProperties }
|
||
|
||
TQtWSApplicationProperties = class(TWSApplicationProperties)
|
||
private
|
||
protected
|
||
public
|
||
end;
|
||
|
||
|
||
implementation
|
||
|
||
uses QtWSControls;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.CreateHandle
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
Creates a Qt Form and initializes it according to it<69>s properties
|
||
------------------------------------------------------------------------------}
|
||
class function TQtWSCustomForm.CreateHandle(const AWinControl: TWinControl;
|
||
const AParams: TCreateParams): HWND;
|
||
var
|
||
QtMainWindow: TQtMainWindow;
|
||
Str: WideString;
|
||
Method: TMethod;
|
||
Hook : QObject_hookH;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('[TQtWSCustomForm.CreateHandle] Height: ', IntToStr(AWinControl.Height),
|
||
' Width: ', IntToStr(AWinControl.Width));
|
||
{$endif}
|
||
|
||
// Creates the window
|
||
|
||
QtMainWindow := TQtMainWindow.Create(AWinControl, AParams);
|
||
|
||
// Set<65>s initial properties
|
||
|
||
Str := UTF8Decode(AWinControl.Caption);
|
||
|
||
QtMainWindow.SetWindowTitle(@Str);
|
||
|
||
SetQtWindowBorderStyle(QtMainWindow, TCustomForm(AWinControl).BorderStyle);
|
||
|
||
SetQtBorderIcons(QtMainWindow, TCustomForm(AWinControl).BorderIcons);
|
||
|
||
// Sets Various Events
|
||
|
||
Hook := QObject_hook_create(QtMainWindow.Widget);
|
||
|
||
TEventFilterMethod(Method) := QtMainWindow.EventFilter;
|
||
|
||
QObject_hook_hook_events(Hook, Method);
|
||
|
||
// Return the handle
|
||
|
||
Result := THandle(QtMainWindow);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.DestroyHandle
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
Destroys a Qt Form and releases allocated memory and resources
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.DestroyHandle(const AWinControl: TWinControl);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('[TQtWSCustomForm.DestroyHandle]');
|
||
{$endif}
|
||
|
||
TQtMainWindow(AWinControl.Handle).Free;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.GetText
|
||
Params: AWinControl - the calling object
|
||
AText - The Text
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
class function TQtWSCustomForm.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
|
||
var
|
||
Str: WideString;
|
||
begin
|
||
TQtWidget(AWinControl.Handle).WindowTitle(@Str);
|
||
|
||
AText := UTF8Encode(Str);
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetText
|
||
Params: AWinControl - the calling object
|
||
AText - The Text
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetText(const AWinControl: TWinControl; const AText: string);
|
||
var
|
||
Str: WideString;
|
||
begin
|
||
Str := UTF8Decode(AText);
|
||
|
||
TQtWidget(AWinControl.Handle).SetWindowTitle(@Str);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.CloseModal
|
||
Params:
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
|
||
begin
|
||
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetFormBorderStyle
|
||
Params:
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
|
||
const AFormBorderStyle: TFormBorderStyle);
|
||
begin
|
||
SetQtWindowBorderStyle(TQtMainWindow(AForm.Handle), AFormBorderStyle);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetIcon
|
||
Params:
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetIcon(const AForm: TCustomForm; const AIcon: HICON);
|
||
begin
|
||
inherited SetIcon(AForm, AIcon);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetShowInTaskbar
|
||
Params:
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar);
|
||
begin
|
||
inherited SetShowInTaskbar(AForm, AValue);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.ShowModal
|
||
Params:
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('Trace:> [TQtWSCustomForm.ShowModal]');
|
||
{$endif}
|
||
|
||
TQtWidget(ACustomForm.Handle).Hide;
|
||
|
||
TQtWidget(ACustomForm.Handle).setWindowModality(QtApplicationModal);
|
||
|
||
TQtWidget(ACustomForm.Handle).Show;
|
||
|
||
{give it a real modal loop, CPU consumption is OK now ... }
|
||
// while Assigned(ACustomForm) and (ACustomForm.Visible)
|
||
while (ACustomForm.ModalResult = mrNone) do
|
||
begin
|
||
sleep(10);
|
||
Application.ProcessMessages;
|
||
end;
|
||
|
||
{BUG: if we assign OnCloseQuery(), Lazarus TCustomForm.Close() Fires ModalResult = mrCancel,
|
||
without counting on OnCloseQuery() result (CanClose), so if we set it up we'll jump over our
|
||
loop, and then comes into LCL loop with WidgetSet.AppProcessMessages
|
||
which burns CPU ...}
|
||
|
||
{$ifdef VerboseQt}
|
||
WriteLn('Trace:< [TQtWSCustomForm.ShowModal]');
|
||
{$endif}
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetBorderIcons
|
||
Params:
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
|
||
const ABorderIcons: TBorderIcons);
|
||
begin
|
||
SetQtBorderIcons(TQtMainWindow(AForm.Handle), ABorderIcons);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetQtWindowBorderStyle
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
We need this method because LCL doesn<73>t automatically calls SetWindowBorder
|
||
after the window is created, so we need to do it on CreateHandle procedure,
|
||
but CreateHandle cannot call other methods from TQtWSCustomForm because the
|
||
Handle isn<73>t created yet before it is finished.
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetQtWindowBorderStyle(const AHandle: TQtMainWindow;
|
||
const AFormBorderStyle: TFormBorderStyle);
|
||
var
|
||
Flags: QtWindowFlags;
|
||
QtOnlyDialog: Integer;
|
||
begin
|
||
Flags := AHandle.windowFlags;
|
||
|
||
{$ifdef VerboseQt}
|
||
WriteLn('Trace:> [TQtWSCustomForm.SetFormBorderStyle] Flags: ', IntToHex(Flags, 8));
|
||
{$endif}
|
||
|
||
QtOnlyDialog := QtDialog and not QtWindow;
|
||
|
||
case AFormBorderStyle of
|
||
bsNone:
|
||
begin
|
||
Flags := Flags or QtFramelessWindowHint;
|
||
Flags := Flags and not QtOnlyDialog;
|
||
end;
|
||
bsSingle:
|
||
begin
|
||
Flags := Flags or QtFramelessWindowHint;
|
||
Flags := Flags and not QtOnlyDialog;
|
||
end;
|
||
bsSizeable:
|
||
begin
|
||
Flags := Flags and not QtFramelessWindowHint;
|
||
Flags := Flags and not QtOnlyDialog;
|
||
end;
|
||
bsDialog:
|
||
begin
|
||
Flags := Flags and not QtFramelessWindowHint;
|
||
Flags := Flags or QtOnlyDialog;
|
||
end;
|
||
bsToolWindow:
|
||
begin
|
||
Flags := Flags or QtFramelessWindowHint;
|
||
Flags := Flags or QtOnlyDialog;
|
||
end;
|
||
bsSizeToolWin:
|
||
begin
|
||
Flags := Flags and not QtFramelessWindowHint;
|
||
Flags := Flags or QtOnlyDialog;
|
||
end;
|
||
end;
|
||
|
||
{$ifdef VerboseQt}
|
||
WriteLn('Trace:< [TQtWSCustomForm.SetFormBorderStyle] Flags: ', IntToHex(Flags, 8));
|
||
{$endif}
|
||
|
||
AHandle.setWindowFlags(Flags);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtWSCustomForm.SetQtBorderIcons
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
Same comment as SetQtWindowBorderStyle above
|
||
------------------------------------------------------------------------------}
|
||
class procedure TQtWSCustomForm.SetQtBorderIcons(const AHandle: TQtMainWindow;
|
||
const ABorderIcons: TBorderIcons);
|
||
var
|
||
Flags: QtWindowFlags;
|
||
begin
|
||
Flags := AHandle.windowFlags;
|
||
|
||
{$ifdef VerboseQt}
|
||
WriteLn('Trace:> [TQtWSCustomForm.SetBorderIcons] Flags: ', IntToHex(Flags, 8));
|
||
{$endif}
|
||
|
||
if biSystemMenu in ABorderIcons then Flags := Flags or QtWindowSystemMenuHint
|
||
else Flags := Flags and not QtWindowSystemMenuHint;
|
||
|
||
if biMinimize in ABorderIcons then Flags := Flags or QtWindowMinimizeButtonHint
|
||
else Flags := Flags and not QtWindowMinimizeButtonHint;
|
||
|
||
if biMaximize in ABorderIcons then Flags := Flags or QtWindowMaximizeButtonHint
|
||
else Flags := Flags and not QtWindowMaximizeButtonHint;
|
||
|
||
if biHelp in ABorderIcons then Flags := Flags or QtWindowContextHelpButtonHint
|
||
else Flags := Flags and not QtWindowContextHelpButtonHint;
|
||
|
||
{$ifdef VerboseQt}
|
||
WriteLn('Trace:< [TQtWSCustomForm.SetBorderIcons] Flags: ', IntToHex(Flags, 8));
|
||
{$endif}
|
||
|
||
AHandle.setWindowFlags(Flags);
|
||
end;
|
||
|
||
initialization
|
||
|
||
////////////////////////////////////////////////////
|
||
// I M P O R T A N T
|
||
////////////////////////////////////////////////////
|
||
// To improve speed, register only classes
|
||
// which actually implement something
|
||
////////////////////////////////////////////////////
|
||
// RegisterWSComponent(TScrollingWinControl, TQtWSScrollingWinControl);
|
||
// RegisterWSComponent(TScrollBox, TQtWSScrollBox);
|
||
// RegisterWSComponent(TCustomFrame, TQtWSCustomFrame);
|
||
// RegisterWSComponent(TFrame, TQtWSFrame);
|
||
RegisterWSComponent(TCustomForm, TQtWSCustomForm);
|
||
// RegisterWSComponent(TForm, TQtWSForm);
|
||
// RegisterWSComponent(THintWindow, TQtWSHintWindow);
|
||
// RegisterWSComponent(TScreen, TQtWSScreen);
|
||
// RegisterWSComponent(TApplicationProperties, TQtWSApplicationProperties);
|
||
////////////////////////////////////////////////////
|
||
end.
|