paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 20:43:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

qt: follow carbon way of drawing designer items (though hintwindow is crashing sometimes)

Browse Source 
git-svn-id: trunk@14026 -
This commit is contained in:
paul 2008-02-08 08:01:32 +00:00
parent 0230315a7c
commit 2fd9462bd6
7 changed files with 266 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/carbon/carbonprivate.pp
View File

@ -511,7 +511,7 @@ begin
end;
{------------------------------------------------------------------------------
Method: TCarbonDesignWindow.BoundsChanged
Method: TCarbonDesignWindow.ControlAdded
Notifies about control added
------------------------------------------------------------------------------}

28
lcl/interfaces/qt/qtlclintf.inc
View File

@ -166,6 +166,22 @@ begin
end;
end;
function TQtWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC;
var
Widget: TQtWidget;
begin
Widget := TQtWidget(WindowHandle);
if (Widget <> nil) and (Widget is TQtDesignWidget) then
Result := TQtDesignWidget(Widget).DesignContext
else
Result := 0;
if Result = 0 then
Result := GetDC(WindowHandle);
end;
{------------------------------------------------------------------------------
Function: IntfSendsUTF8KeyPress
Params:
@ -177,6 +193,13 @@ begin
Result := True;
end;
function TQtWidgetSet.IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean;
begin
Result := (WindowHandle <> 0) and (TQtWidget(WindowHandle) is TQtDesignWidget);
if Result then
Result := TQtDesignWidget(WindowHandle).DesignContext = DC;
end;
{------------------------------------------------------------------------------
Function: PromptUser
Params:
@ -512,6 +535,11 @@ begin
{$endif}
end;
function TQtWidgetSet.ReleaseDesignerDC(Window: HWND; DC: HDC): Integer;
begin
Result := 1;
end;
function TQtWidgetSet.TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean;
begin
Result := False;

4
lcl/interfaces/qt/qtlclintfh.inc
View File

@ -37,7 +37,10 @@ procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImage
function FontCanUTF8(Font: HFont): boolean; override;
function FontIsMonoSpace(Font: HFont): boolean; override;
function GetDesignerDC(WindowHandle: HWND): HDC; override;
function IntfSendsUTF8KeyPress: boolean; override;
function IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; override;
function PromptUser(const DialogCaption : string;
const DialogMessage : string;
@ -55,6 +58,7 @@ function RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescriptio
function RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMask: HBITMAP; const ARect: TRect): Boolean; override;
function RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean; override;
function ReleaseDesignerDC(Window: HWND; DC: HDC): Integer; override;
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;

249
lcl/interfaces/qt/qtwidgets.pas
View File

@ -50,6 +50,7 @@ type
// records
TPaintData = record
PaintWidget: QWidgetH;
ClipRect: Prect;
ClipRegion: QRegionH;
end;
@ -103,8 +104,13 @@ type
function _AddRef : longint;stdcall;
function _Release : longint;stdcall;
function GetContext: HDC; virtual;
function CreateWidget(const Params: TCreateParams):QWidgetH; virtual;
procedure DestroyWidget; virtual;
procedure SetHasCaret(const AValue: Boolean);
class procedure removeProperty(AObject: QObjectH; APropName: PAnsiChar);
class procedure setProperty(AObject: QObjectH; APropName: PAnsiChar; APropValue: Int64);
public
LCLObject: TWinControl;
public
@ -166,10 +172,10 @@ type
function getWidth: Integer;
procedure grabMouse; virtual;
function hasFocus: Boolean; virtual;
procedure lowerWidget;
procedure lowerWidget; virtual;
procedure move(ANewLeft, ANewTop: Integer);
procedure preferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); virtual;
procedure raiseWidget;
procedure raiseWidget; virtual;
procedure resize(ANewWidth, ANewHeight: Integer);
procedure releaseMouse;
procedure scroll(dx, dy: integer);
@ -202,7 +208,7 @@ type
function windowFlags: QtWindowFlags;
function windowModality: QtWindowModality;
property Context: HDC read FContext;
property Context: HDC read GetContext;
property KeysToEat: TByteSet read FKeysToEat write FKeysToEat;
property Props[AnIndex:String]:pointer read GetProps write SetProps;
property PaintData: TPaintData read FPaintData write FPaintData;
@ -1069,12 +1075,38 @@ type
private
FShape: QRubberBandShape;
protected
function CreateWidget(const AParams: TCreateParams):QWidgetH; override;
function CreateWidget(const AParams: TCreateParams): QWidgetH; override;
public
constructor Create(const AWinControl: TWinControl; const AParams: TCreateParams); override;
function getShape: QRubberBandShape;
procedure setShape(AShape: QRubberBandShape);
end;
{ TQtDesignWidget }
TQtDesignWidget = class(TQtMainWindow)
protected
FDesignControlEventHook: QObject_hookH;
FDesignControl: QWidgetH;
FDesignContext: HDC;
function CreateWidget(const AParams: TCreateParams): QWidgetH; override;
procedure DestroyWidget; override;
procedure SlotDesignControlPaint(Sender: QObjectH; Event: QEventH); cdecl;
procedure BringDesignerToFront;
procedure ResizeDesigner;
function GetContext: HDC; virtual;
public
function DesignControlEventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
procedure AttachEvents; override;
procedure DetachEvents; override;
procedure lowerWidget; override;
procedure raiseWidget; override;
public
property DesignContext: HDC read FDesignContext;
end;
const
AlignmentMap: array[TAlignment] of QtAlignment =
@ -1178,10 +1210,7 @@ begin
QWidget_cursor(Widget, FDefaultCursor);
// set Handle->QWidget map
AVariant := QVariant_create(Int64(PtrUInt(Self)));
QObject_setProperty(QObjectH(Widget), 'lclwidget', AVariant);
QVariant_destroy(AVariant);
setProperty(Widget, 'lclwidget', Int64(PtrUInt(Self)));
FillChar(FPaintData, sizeOf(FPaintData), 0);
// set focus policy
@ -1218,9 +1247,7 @@ begin
{$endif}
// set Handle->QWidget map
AVariant := QVariant_create(Int64(PtrUInt(Self)));
QObject_setProperty(Widget, 'lclwidget', AVariant);
QVariant_destroy(AVariant);
setProperty(Widget, 'lclwidget', Int64(PtrUInt(Self)));
FillChar(FPaintData, sizeOf(FPaintData), 0);
@ -1240,27 +1267,19 @@ begin
end;
procedure TQtWidget.DeInitializeWidget;
var
V: QVariantH;
begin
if Widget <> nil then
DetachEvents;
if Widget <> nil then
begin
V := QVariant_create(QVariantInvalid);
QObject_setProperty(Widget, 'lclwidget', V);
QVariant_destroy(V);
end;
removeProperty(Widget, 'lclwidget');
QCursor_destroy(FDefaultCursor);
if HasCaret then
DestroyCaret;
if (Widget <> nil) and FOwnWidget then
QObject_deleteLater(Widget);
Widget := nil;
DestroyWidget;
end;
procedure TQtWidget.RecreateWidget;
@ -2213,6 +2232,7 @@ begin
with PaintData do
begin
PaintWidget := Widget;
ClipRegion := QPaintEvent_Region(QPaintEventH(Event));
if ClipRect = nil then
New(ClipRect);
@ -2823,6 +2843,24 @@ begin
FHasCaret := AValue;
end;
class procedure TQtWidget.removeProperty(AObject: QObjectH; APropName: PAnsiChar);
var
AVariant: QVariantH;
begin
AVariant := QVariant_create(QVariantInvalid);
QObject_setProperty(AObject, APropName, AVariant);
QVariant_destroy(AVariant);
end;
class procedure TQtWidget.setProperty(AObject: QObjectH; APropName: PAnsiChar; APropValue: Int64);
var
AVariant: QVariantH;
begin
AVariant := QVariant_create(APropValue);
QObject_setProperty(AObject, APropName, AVariant);
QVariant_destroy(AVariant);
end;
function TQtWidget.LCLKeyToQtKey(AKey: Word): Integer;
const
VKKeyToQtKeyMap: array[0..255] of Integer = // Keyboard mapping table
@ -3134,6 +3172,11 @@ begin
result := nil;
end;
function TQtWidget.GetContext: HDC;
begin
Result := FContext;
end;
function TQtWidget.GetWidget: QWidgetH;
begin
if TheObject <> nil then
@ -3186,6 +3229,13 @@ begin
Result := Widget;
end;
procedure TQtWidget.DestroyWidget;
begin
if (Widget <> nil) and FOwnWidget then
QObject_deleteLater(Widget);
Widget := nil;
end;
{ TQtAbstractButton }
{------------------------------------------------------------------------------
@ -7849,4 +7899,161 @@ begin
QWidget_setAttribute(Result, QtWA_NoMousePropagation);
end;
{ TQtDesignWidget }
function TQtDesignWidget.CreateWidget(const AParams: TCreateParams): QWidgetH;
begin
Result := inherited CreateWidget(AParams);
FDesignControl := QWidget_create(Result);
QWidget_setMouseTracking(FDesignControl, True);
setProperty(FDesignControl, 'lclwidget', Int64(PtrUInt(Self)));
BringDesignerToFront;
end;
procedure TQtDesignWidget.DestroyWidget;
begin
removeProperty(FDesignControl, 'lclwidget');
QObject_deleteLater(FDesignControl);
FDesignControl := nil;
inherited DestroyWidget;
end;
procedure TQtDesignWidget.SlotDesignControlPaint(Sender: QObjectH; Event: QEventH); cdecl;
var
Msg: TLMPaint;
AStruct: PPaintStruct;
begin
{$ifdef VerboseQt}
WriteLn('TQtWidget.SlotPaint ', dbgsName(LCLObject));
{$endif}
if (LCLObject is TWinControl) then
begin
FillChar(Msg, SizeOf(Msg), #0);
Msg.Msg := LM_PAINT;
New(AStruct);
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
Msg.PaintStruct := AStruct;
with PaintData do
begin
PaintWidget := FDesignControl;
ClipRegion := QPaintEvent_Region(QPaintEventH(Event));
if ClipRect = nil then
New(ClipRect);
QPaintEvent_Rect(QPaintEventH(Event), ClipRect);
end;
Msg.DC := BeginPaint(THandle(Self), AStruct^);
FDesignContext := Msg.DC;
Msg.PaintStruct^.rcPaint := PaintData.ClipRect^;
Msg.PaintStruct^.hdc := FDesignContext;
with getClientBounds do
SetWindowOrgEx(Msg.DC, -Left, -Top, nil);
// send paint message
try
// Saving clip rect and clip region
try
LCLObject.WindowProc(TLMessage(Msg));
finally
Dispose(PaintData.ClipRect);
Fillchar(FPaintData, SizeOf(FPaintData), 0);
FDesignContext := 0;
EndPaint(THandle(Self), AStruct^);
Dispose(AStruct);
end;
except
Application.HandleException(nil);
end;
end;
end;
procedure TQtDesignWidget.BringDesignerToFront;
begin
if FDesignControl <> nil then
QWidget_raise(FDesignControl);
end;
procedure TQtDesignWidget.ResizeDesigner;
begin
if FDesignControl = nil then
Exit;
with getClientBounds do
begin
QWidget_move(FDesignControl, Left, Top);
QWidget_resize(FDesignControl, Right - Left, Bottom - Top);
end;
end;
function TQtDesignWidget.GetContext: HDC;
begin
if FDesignContext <> 0 then
Result := FDesignContext
else
Result := FContext;
end;
function TQtDesignWidget.DesignControlEventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
begin
Result := False;
if LCLObject <> nil then
begin
QEvent_Accept(Event);
case QEvent_type(Event) of
QEventPaint: SlotDesignControlPaint(Sender, Event);
end;
end;
end;
function TQtDesignWidget.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
begin
Result := False;
if LCLObject <> nil then
begin
QEvent_accept(Event);
case QEvent_type(Event) of
QEventChildAdded,
QEventChildRemoved: BringDesignerToFront;
QEventResize:
begin
Result := inherited EventFilter(Sender, Event);
ResizeDesigner;
end;
else
Result := inherited EventFilter(Sender, Event);
end;
end;
end;
procedure TQtDesignWidget.AttachEvents;
var
Method: TMethod;
begin
inherited AttachEvents;
FDesignControlEventHook := QObject_hook_create(FDesignControl);
TEventFilterMethod(Method) := @DesignControlEventFilter;
QObject_hook_hook_events(FDesignControlEventHook, Method);
end;
procedure TQtDesignWidget.DetachEvents;
begin
inherited DetachEvents;
end;
procedure TQtDesignWidget.lowerWidget;
begin
inherited lowerWidget;
BringDesignerToFront;
end;
procedure TQtDesignWidget.raiseWidget;
begin
inherited raiseWidget;
BringDesignerToFront;
end;
end.

11
lcl/interfaces/qt/qtwinapi.inc
View File

@ -76,14 +76,9 @@ begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI BeginPaint] Handle=', dbghex(Handle));
{$endif}
{ if IsDoubleBuffered then
Result :=GetDoubleBufferedDC(Handle)
else}
Widget := TQtWidget(Handle);
if Widget <> nil then
DC := TQtDeviceContext.Create(Widget.Widget, True)
DC := TQtDeviceContext.Create(Widget.PaintData.PaintWidget, True)
else
DC := TQtDeviceContext.Create(nil, True);
@ -1987,10 +1982,6 @@ begin
{$endif}
end;
function TQtWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC;
begin
Result := GetDC(WindowHandle);
end;
{------------------------------------------------------------------------------
Function: GetDeviceCaps
Params: DC: HDC; Index: Integer

1
lcl/interfaces/qt/qtwinapih.inc
View File

@ -101,7 +101,6 @@ function GetClipRGN(DC: hDC; RGN: hRGN): Longint; override;
function GetCursorPos(var lpPoint: TPoint ): Boolean; override;
function GetDC(hWnd: HWND): HDC; override;
function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;
function GetDesignerDC(WindowHandle: HWND): HDC; override;
function GetDeviceCaps(DC: HDC; Index: Integer): Integer; override;
function GetDeviceSize(DC: HDC; var P: TPoint): Boolean; Override;
function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;

5
lcl/interfaces/qt/qtwsforms.pp
View File

@ -157,7 +157,10 @@ begin
// Creates the window
QtMainWindow := TQtMainWindow.Create(AWinControl, AParams);
if csDesigning in AWinControl.ComponentState then
QtMainWindow := TQtDesignWidget.Create(AWinControl, AParams)
else
QtMainWindow := TQtMainWindow.Create(AWinControl, AParams);
// Set´s initial properties