mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 00:58:04 +02:00
871 lines
28 KiB
ObjectPascal
871 lines
28 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
* QtWSControls.pp *
|
|
* --------------- *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
unit QtWSControls;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{$I qtdefines.inc}
|
|
|
|
uses
|
|
// Bindings
|
|
qt6,
|
|
qtwidgets, qtobjects, qtproc, qtint,
|
|
// LCL
|
|
SysUtils, Classes, Types, Controls, LCLType, LazUTF8, Forms, Graphics,
|
|
// Widgetset
|
|
InterfaceBase, WSProc, WSControls, WSLCLClasses;
|
|
|
|
type
|
|
|
|
{ TQtWSDragImageListResolution }
|
|
|
|
TQtWSDragImageListResolution = class(TWSDragImageListResolution)
|
|
published
|
|
class function BeginDrag(const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, Y: Integer): Boolean; override;
|
|
class function DragMove(const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean; override;
|
|
class procedure EndDrag(const ADragImageList: TDragImageListResolution); override;
|
|
class function HideDragImage(const ADragImageList: TDragImageListResolution;
|
|
ALockedWindow: HWND; DoUnLock: Boolean): Boolean; override;
|
|
class function ShowDragImage(const ADragImageList: TDragImageListResolution;
|
|
ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; override;
|
|
end;
|
|
|
|
{ TQtWSLazAccessibleObject }
|
|
{$IFDEF QTACCESSIBILITY}
|
|
TQtWSLazAccessibleObject = class(TWSLazAccessibleObject)
|
|
public
|
|
class function CreateHandle(const AObject: TLazAccessibleObject): HWND; override;
|
|
class procedure DestroyHandle(const AObject: TLazAccessibleObject); override;
|
|
class procedure SetAccessibleRole(const AObject: TLazAccessibleObject; const ARole: TLazAccessibilityRole); override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TQtWSControl }
|
|
|
|
TQtWSControl = class(TWSControl)
|
|
published
|
|
end;
|
|
|
|
{ TQtWSWinControl }
|
|
|
|
TQtWSWinControl = class(TWSWinControl)
|
|
published
|
|
class function CanFocus(const AWinControl: TWinControl): Boolean; override;
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLHandle; override;
|
|
class procedure DestroyHandle(const AWinControl: TWinControl); override;
|
|
class procedure Invalidate(const AWinControl: TWinControl); override;
|
|
class procedure AddControl(const AControl: TControl); override;
|
|
class function GetCanvasScaleFactor(const AControl: TControl): Double; override;
|
|
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
|
|
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
|
|
class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
|
|
|
|
class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override;
|
|
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
|
|
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
|
|
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
|
|
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
|
|
class procedure ShowHide(const AWinControl: TWinControl); override; //TODO: rename to SetVisible(control, visible)
|
|
class procedure SetColor(const AWinControl: TWinControl); override;
|
|
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCURSOR); override;
|
|
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
|
|
class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
|
|
|
|
class procedure GetPreferredSize(const AWinControl: TWinControl;
|
|
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
|
|
|
|
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
|
|
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
|
|
|
|
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
|
|
const AOldPos, ANewPos: Integer;
|
|
const AChildren: TFPList); override;
|
|
|
|
class procedure ConstraintsChange(const AWinControl: TWinControl); override;
|
|
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
|
|
class procedure Repaint(const AWinControl: TWinControl); override;
|
|
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
|
|
end;
|
|
|
|
{ TQtWSGraphicControl }
|
|
|
|
TQtWSGraphicControl = class(TWSGraphicControl)
|
|
published
|
|
end;
|
|
|
|
{ TQtWSCustomControl }
|
|
|
|
TQtWSCustomControl = class(TWSCustomControl)
|
|
published
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLHandle; override;
|
|
end;
|
|
|
|
{ TQtWSImageList }
|
|
|
|
TQtWSImageList = class(TWSImageList)
|
|
published
|
|
end;
|
|
|
|
const
|
|
TBorderStyleToQtFrameShapeMap: array[TBorderStyle] of QFrameShape =
|
|
(
|
|
{ bsNone } QFrameNoFrame,
|
|
{ bsSingle } QFrameStyledPanel
|
|
);
|
|
TLayoutDirectionMap: array[Boolean] of QtLayoutDirection =
|
|
(
|
|
{ False } QtLeftToRight,
|
|
{ True } QtRightToLeft
|
|
);
|
|
implementation
|
|
|
|
uses LCLProc;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSCustomControl.CreateHandle
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
class function TQtWSCustomControl.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLHandle;
|
|
var
|
|
QtCustomControl: TQtCustomControl;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('> TQtWSCustomControl.CreateHandle for ',dbgsname(AWinControl));
|
|
{$endif}
|
|
|
|
QtCustomControl := TQtCustomControl.Create(AWinControl, AParams);
|
|
QtCustomControl.setFrameShape(TBorderStyleToQtFrameShapeMap[TCustomControl(AWinControl).BorderStyle]);
|
|
QtCustomControl.viewportNeeded;
|
|
QtCustomControl.verticalScrollBar;
|
|
QtCustomControl.horizontalScrollBar;
|
|
QtCustomControl.AttachEvents;
|
|
Result := TLCLHandle(QtCustomControl);
|
|
|
|
{$ifdef VerboseQt}
|
|
WriteLn('< TQtWSCustomControl.CreateHandle for ',dbgsname(AWinControl),' Result: ', dbgHex(Result));
|
|
{$endif}
|
|
end;
|
|
|
|
{$IFDEF QTACCESSIBILITY}
|
|
class function TQtWSLazAccessibleObject.CreateHandle(const AObject: TLazAccessibleObject): HWND;
|
|
var
|
|
widget: QWidgetH;
|
|
WinControl: TWinControl;
|
|
H: TQtWidget;
|
|
begin
|
|
QAccessible_installFactory(@QtAxFactory);
|
|
Result := 0;
|
|
if (AObject.OwnerControl <> nil) and (AObject.OwnerControl is TWinControl) and
|
|
(AObject.OwnerControl.GetAccessibleObject() = AObject) then begin
|
|
{ Need to improve handling here. Problem is that we hit here before TWinControl
|
|
has handle allocated but nothing will send us back here once handle is allocated
|
|
thus code in TQtCustomControl.initializeAccessibility that does
|
|
TLazAccessibleObject.handle assignment when TWinControl.Handle created}
|
|
//if TQtWidget(TWinControl(AObject.OwnerControl).HandleAllocated then begin
|
|
// widget := QWidgetH(TQtWidget(TWinControl(AObject.OwnerControl).Handle).Widget);
|
|
// Result := HWND(TQtAccessibleObject.Create(AObject, widget));
|
|
// end;
|
|
end
|
|
else begin
|
|
if AObject.AccessibleRole = larTreeItem then
|
|
Result := HWND(TQtAccessibleTreeRow.Create(AObject, QWidgetH(0)))
|
|
else
|
|
Result := HWND(TQtAccessibleObject.Create(AObject, QWidgetH(0)));
|
|
end;
|
|
end;
|
|
|
|
class procedure TQtWSLazAccessibleObject.DestroyHandle(const AObject: TLazAccessibleObject);
|
|
begin
|
|
TQtAccessibleObject(AObject.Handle).Free;
|
|
end;
|
|
|
|
class procedure TQtWSLazAccessibleObject.SetAccessibleRole(const AObject: TLazAccessibleObject; const ARole: TLazAccessibilityRole);
|
|
begin
|
|
{Need to improve this to do something similar to Cocoa where handle is recreated
|
|
if accessibleRole has changed}
|
|
CreateHandle(AObject);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtWSWinControl.CanFocus
|
|
Params: TWinControl
|
|
Returns: Boolean
|
|
------------------------------------------------------------------------------}
|
|
class function TQtWSWinControl.CanFocus(const AWinControl: TWinControl): Boolean;
|
|
var
|
|
Widget: TQtWidget;
|
|
begin
|
|
if AWinControl.HandleAllocated then
|
|
begin
|
|
Widget := TQtWidget(AWinControl.Handle);
|
|
Result := (Widget.getFocusPolicy <> QtNoFocus);
|
|
end else
|
|
Result := False;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.CreateHandle
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
class function TQtWSWinControl.CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLHandle;
|
|
var
|
|
QtWidget: TQtWidget;
|
|
begin
|
|
|
|
{$ifdef VerboseQt}
|
|
WriteLn('> TQtWSWinControl.CreateHandle for ',dbgsname(AWinControl));
|
|
{$endif}
|
|
QtWidget := TQtWidget.Create(AWinControl, AParams);
|
|
|
|
QtWidget.AttachEvents;
|
|
|
|
// Finalization
|
|
|
|
Result := TLCLHandle(QtWidget);
|
|
|
|
{$ifdef VerboseQt}
|
|
WriteLn('< TQtWSWinControl.CreateHandle for ',dbgsname(AWinControl),' Result: ', dbgHex(Result));
|
|
{$endif}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.DestroyHandle
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.DestroyHandle(const AWinControl: TWinControl);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'DestroyHandle') then
|
|
Exit;
|
|
if QtWidgetSet.IsValidHandle(AWinControl.Handle) then
|
|
TQtWidget(AWinControl.Handle).Release;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.Invalidate
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.Invalidate(const AWinControl: TWinControl);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'Invalidate') then
|
|
Exit;
|
|
|
|
TQtWidget(AWinControl.Handle).Update;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.AddControl(const AControl: TControl);
|
|
var
|
|
Child: TQtWidget;
|
|
Parent: TQtWidget;
|
|
begin
|
|
if (AControl is TWinControl) and (TWinControl(AControl).HandleAllocated) then
|
|
begin
|
|
Child := TQtWidget(TWinControl(AControl).Handle);
|
|
Parent := TQtWidget(AControl.Parent.Handle);
|
|
if Child.getParent <> Parent.GetContainerWidget then
|
|
begin
|
|
Child.BeginUpdate;
|
|
Child.setParent(Parent.GetContainerWidget);
|
|
Child.EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TQtWSWinControl.GetCanvasScaleFactor(const AControl: TControl
|
|
): Double;
|
|
begin
|
|
Result := 1;
|
|
if not WSCheckHandleAllocated(TWinControl(AControl), 'GetCanvasScaleFactor') then
|
|
Exit;
|
|
Result := QPaintDevice_devicePixelRatioF(QWidget_to_QPaintDevice(TQtWidget(TWinControl(AControl).Handle).Widget));
|
|
end;
|
|
|
|
class function TQtWSWinControl.GetClientBounds(const AWincontrol: TWinControl;
|
|
var ARect: TRect): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not WSCheckHandleAllocated(AWinControl, 'GetClientBounds') then
|
|
Exit;
|
|
|
|
ARect := TQtWidget(AWinControl.Handle).getClientBounds;
|
|
Result := True;
|
|
end;
|
|
|
|
class function TQtWSWinControl.GetClientRect(const AWincontrol: TWinControl;
|
|
var ARect: TRect): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not WSCheckHandleAllocated(AWinControl, 'GetClientRect') then
|
|
Exit;
|
|
|
|
ARect := TQtWidget(AWinControl.Handle).getClientBounds;
|
|
Types.OffsetRect(ARect, -ARect.Left, -ARect.Top);
|
|
Result := True;
|
|
end;
|
|
|
|
class function TQtWSWinControl.GetDesignInteractive(
|
|
const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not WSCheckHandleAllocated(AWinControl, 'GetDesignInteractive') then
|
|
Exit;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.SetBiDiMode(const AWinControl : TWinControl;
|
|
UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then
|
|
Exit;
|
|
|
|
TQtWidget(AWinControl.Handle).setLayoutDirection(TLayoutDirectionMap[UseRightToLeftAlign]);
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.GetPreferredSize(const AWinControl: TWinControl;
|
|
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'GetPreferredSize') then
|
|
Exit;
|
|
TQtWidget(AWinControl.Handle).PreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);
|
|
end;
|
|
|
|
class function TQtWSWinControl.GetText(const AWinControl: TWinControl;
|
|
var AText: String): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not WSCheckHandleAllocated(AWincontrol, 'GetText') then
|
|
Exit;
|
|
if not QtWidgetSet.IsValidHandle(AWinControl.Handle) then
|
|
exit;
|
|
Result := not TQtWidget(AWinControl.Handle).getTextStatic;
|
|
if Result then
|
|
AText := UTF16ToUTF8(TQtWidget(AWinControl.Handle).getText);
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.SetText(const AWinControl: TWinControl;
|
|
const AText: string);
|
|
var
|
|
Wdgt: TQtWidget;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetText') then
|
|
Exit;
|
|
if not QtWidgetSet.IsValidHandle(AWinControl.Handle) then
|
|
exit;
|
|
Wdgt := TQtWidget(AWinControl.Handle);
|
|
Wdgt.BeginUpdate;
|
|
Wdgt.setText(AText{%H-});
|
|
Wdgt.EndUpdate;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.SetChildZPosition(const AWinControl,
|
|
AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList);
|
|
var
|
|
n: Integer;
|
|
Child: TWinControl;
|
|
Reorder: TFPList;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition') then
|
|
Exit;
|
|
if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)') then
|
|
Exit;
|
|
|
|
if (ANewPos <= 0) or (ANewPos >= AChildren.Count - 1) then
|
|
begin
|
|
// simple
|
|
if ANewPos <= 0 then // bottom
|
|
TQtWidget(AChild.Handle).lowerWidget
|
|
else
|
|
TQtWidget(AChild.Handle).raiseWidget;
|
|
end else
|
|
begin
|
|
if (ANewPos >= 0) and (ANewPos < AChildren.Count -1) then
|
|
begin
|
|
Reorder := TFPList.Create;
|
|
for n := AChildren.Count - 1 downto 0 do
|
|
Reorder.Add(AChildren[n]);
|
|
Child := TWinControl(Reorder[ANewPos + 1]);
|
|
if Child.HandleAllocated then
|
|
TQtWidget(AChild.Handle).stackUnder(TQtWidget(Child.Handle).Widget)
|
|
else
|
|
TQtWidget(AChild.Handle).lowerWidget;
|
|
Reorder.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.ConstraintsChange(const AWinControl: TWinControl);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'ConstraintsChange') then
|
|
Exit;
|
|
TQtWidget.ConstraintsChange(AWinControl);
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.PaintTo(const AWinControl: TWinControl;
|
|
ADC: HDC; X, Y: Integer);
|
|
var
|
|
Context: TQtDeviceContext absolute ADC;
|
|
Widget: TQtWidget;
|
|
DCSize: TSize;
|
|
APoint: TQtPoint;
|
|
ARect: TRect;
|
|
Pixmap: QPixmapH;
|
|
ASourceRegion: QRegionH;
|
|
AFlags: Integer;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'PaintTo') or (ADC = 0) then
|
|
Exit;
|
|
|
|
if not AWinControl.Visible or not TQtWidget(AWinControl.Handle).getVisible then
|
|
exit;
|
|
|
|
Widget := TQtWidget(AWinControl.Handle);
|
|
ARect := Widget.getFrameGeometry;
|
|
|
|
with DCSize, ARect do
|
|
begin
|
|
cx := Right - Left;
|
|
cy := Bottom - Top;
|
|
end;
|
|
Pixmap := QPixmap_create(PSize(@DCSize));
|
|
try
|
|
APoint := QtPoint(0, 0);
|
|
ASourceRegion := QRegion_Create(0, 0, DCSize.cx, DCSize.cy);
|
|
AFlags := QWidgetDrawChildren;
|
|
if (Widget is TQtMainWindow) then
|
|
AFlags := AFlags or QWidgetDrawWindowBackground;
|
|
QWidget_render(Widget.Widget, QPaintDeviceH(Pixmap), @APoint, ASourceRegion, AFlags);
|
|
QRegion_destroy(ASourceRegion);
|
|
|
|
APoint := QtPoint(X, Y);
|
|
ARect := Rect(0, 0, QPixmap_width(Pixmap), QPixmap_height(Pixmap));
|
|
Context.drawPixmap(@APoint, Pixmap, @ARect);
|
|
finally
|
|
QPixmap_destroy(Pixmap);
|
|
end;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.Repaint(const AWinControl: TWinControl);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'Repaint') then
|
|
Exit;
|
|
TQtWidget(AWinControl.Handle).Repaint;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.ScrollBy(const AWinControl: TWinControl;
|
|
DeltaX, DeltaY: integer);
|
|
var
|
|
Widget: TQtCustomControl;
|
|
ABar: TQtScrollBar;
|
|
APosition: Integer;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'ScrollBy') then
|
|
Exit;
|
|
if TQtWidget(AWinControl.Handle) is TQtCustomControl then
|
|
begin
|
|
Widget := TQtCustomControl(AWinControl.Handle);
|
|
Widget.viewport.scroll(DeltaX, DeltaY);
|
|
end else
|
|
if TQtWidget(AWinControl.Handle) is TQtAbstractScrollArea then
|
|
begin
|
|
ABar := TQtAbstractScrollArea(AWinControl.Handle).horizontalScrollBar;
|
|
if ABar = nil then
|
|
exit;
|
|
if ABar.getTracking then
|
|
APosition := ABar.getSliderPosition
|
|
else
|
|
APosition := ABar.getValue;
|
|
if DeltaX <> 0 then
|
|
begin
|
|
APosition += -DeltaX;
|
|
if ABar.getTracking then
|
|
ABar.setSliderPosition(APosition)
|
|
else
|
|
ABar.setValue(APosition);
|
|
end;
|
|
ABar := TQtAbstractScrollArea(AWinControl.Handle).verticalScrollBar;
|
|
if ABar = nil then
|
|
exit;
|
|
if ABar.getTracking then
|
|
APosition := ABar.getSliderPosition
|
|
else
|
|
APosition := ABar.getValue;
|
|
if DeltaY <> 0 then
|
|
begin
|
|
APosition += -DeltaY;
|
|
if ABar.getTracking then
|
|
ABar.setSliderPosition(APosition)
|
|
else
|
|
ABar.setValue(APosition);
|
|
end;
|
|
end
|
|
{$IFDEF VerboseQt}
|
|
else
|
|
DebugLn(Format('WARNING: TQtWSWinControl.ScrollBy(): Qt widget handle %s is not TQtCustomControl',[DbgSName(TQtWidget(AWinControl.Handle))]));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.SetBounds
|
|
Params: AWinControl - the calling object
|
|
ALeft, ATop - Position
|
|
AWidth, AHeight - Size
|
|
Returns: Nothing
|
|
|
|
Sets the position and size of a widget
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.SetBounds(const AWinControl: TWinControl;
|
|
const ALeft, ATop, AWidth, AHeight: Integer);
|
|
var
|
|
R: TRect;
|
|
Box: TQtWidget;
|
|
AForm: TCustomForm;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetBounds') then
|
|
Exit;
|
|
R := Bounds(ALeft, ATop, AWidth, AHeight);
|
|
|
|
Box := nil;
|
|
if Assigned(AWinControl.Parent) and
|
|
AWinControl.Parent.HandleAllocated then
|
|
Box := TQtWidget(AWinControl.Parent.Handle);
|
|
|
|
if Assigned(Box) and
|
|
(Box.ChildOfComplexWidget = ccwScrollingWinControl) then
|
|
begin
|
|
R := Bounds(ALeft - TQtCustomControl(Box).horizontalScrollBar.getValue,
|
|
ATop - TQtCustomControl(Box).verticalScrollBar.getValue, AWidth, AHeight);
|
|
end;
|
|
|
|
{$IFDEF QTSCROLLABLEFORMS}
|
|
if Assigned(AWinControl.Parent) and
|
|
(AWinControl.Parent.FCompStyle = csForm) then
|
|
begin
|
|
AForm := TCustomForm(AWinControl.Parent);
|
|
if Assigned(TQtMainWindow(AForm.Handle).ScrollArea) then
|
|
begin
|
|
Box := TQtMainWindow(AForm.Handle).ScrollArea;
|
|
R := Bounds(ALeft - TQtWindowArea(Box).horizontalScrollBar.getValue,
|
|
ATop - TQtWindowArea(Box).verticalScrollBar.getValue, AWidth, AHeight);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF VerboseQtResize}
|
|
DebugLn('>TQtWSWinControl.SetBounds(',dbgsName(AWinControl),') NewBounds=',dbgs(R));
|
|
{$ENDIF}
|
|
TQtWidget(AWinControl.Handle).BeginUpdate;
|
|
with R do
|
|
begin
|
|
TQtWidget(AWinControl.Handle).move(Left, Top);
|
|
TQtWidget(AWinControl.Handle).resize(Right - Left, Bottom - Top);
|
|
end;
|
|
TQtWidget(AWinControl.Handle).EndUpdate;
|
|
{$IFDEF VerboseQtResize}
|
|
DebugLn('<TQtWSWinControl.SetBounds(',dbgsName(AWinControl),') NewBounds=',dbgs(R));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.SetPos
|
|
Params: AWinControl - the calling object
|
|
ALeft, ATop - Position
|
|
Returns: Nothing
|
|
|
|
Sets the position of a widget
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.SetPos(const AWinControl: TWinControl;
|
|
const ALeft, ATop: Integer);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetPos') then
|
|
Exit;
|
|
|
|
TQtWidget(AWinControl.Handle).BeginUpdate;
|
|
TQtWidget(AWinControl.Handle).move(ALeft, ATop);
|
|
TQtWidget(AWinControl.Handle).EndUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.SetSize
|
|
Params: AWinControl - the calling object
|
|
AWidth, AHeight - Size
|
|
Returns: Nothing
|
|
|
|
Sets the size of a widget
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.SetSize(const AWinControl: TWinControl;
|
|
const AWidth, AHeight: Integer);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetSize') then
|
|
Exit;
|
|
TQtWidget(AWinControl.Handle).BeginUpdate;
|
|
TQtWidget(AWinControl.Handle).resize(AWidth, AHeight);
|
|
TQtWidget(AWinControl.Handle).EndUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.ShowHide
|
|
Params: AWinControl - the calling object
|
|
|
|
Returns: Nothing
|
|
|
|
Shows or hides a widget.
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.ShowHide(const AWinControl: TWinControl);
|
|
var
|
|
Widget: TQtWidget;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'ShowHide') then
|
|
Exit;
|
|
|
|
Widget := TQtWidget(AWinControl.Handle);
|
|
Widget.BeginUpdate;
|
|
// issue #28437, #30966 - regression from r53365: when FontChanged() is called
|
|
// here handle is recreated inside LCL, so we are dead - SEGFAULT.
|
|
if AWinControl.HandleObjectShouldBeVisible and
|
|
IsFontNameDefault(AWinControl.Font.Name) then
|
|
begin
|
|
if AWinControl.IsParentFont and Assigned(AWinControl.Parent) then
|
|
SetFont(AWinControl, AWinControl.Parent.Font) {DO NOT TOUCH THIS PLEASE !}
|
|
else
|
|
SetFont(AWinControl, AWinControl.Font); {DO NOT TOUCH THIS PLEASE !}
|
|
end;
|
|
|
|
Widget.setVisible(AWinControl.HandleObjectShouldBeVisible);
|
|
Widget.EndUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.SetColor
|
|
Params: AWinControl - the calling object
|
|
Returns: Nothing
|
|
|
|
Sets the color of the widget.
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.SetColor(const AWinControl: TWinControl);
|
|
var
|
|
QColor: TQColor;
|
|
ColorRef: TColorRef;
|
|
QtWidget: TQtWidget;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
|
|
Exit;
|
|
|
|
QtWidget := TQtWidget(AWinControl.Handle);
|
|
QtWidget.BeginUpdate;
|
|
QtWidget.WidgetState := QtWidget.WidgetState + [qtwsColorUpdating];
|
|
try
|
|
// Get the color numeric value (system colors are mapped to numeric colors depending on the widget style)
|
|
if AWinControl.Color = clDefault then
|
|
QtWidget.SetDefaultColor(dctBrush)
|
|
else
|
|
begin
|
|
ColorRef := ColorToRGB(AWinControl.Color);
|
|
|
|
// Fill QColor
|
|
QColor_fromRgb(@QColor,Red(ColorRef),Green(ColorRef),Blue(ColorRef));
|
|
|
|
// Set color of the widget to QColor
|
|
QtWidget.SetColor(@QColor);
|
|
end;
|
|
finally
|
|
QtWidget.WidgetState := QtWidget.WidgetState - [qtwsColorUpdating];
|
|
QtWidget.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.SetCursor
|
|
Params: AWinControl - the calling object
|
|
Returns: Nothing
|
|
|
|
Sets the cursor of the widget.
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCURSOR);
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'SetCursor') then
|
|
Exit;
|
|
if ACursor <> 0 then
|
|
TQtWidget(AWinControl.Handle).SetCursor(TQtCursor(ACursor).Handle)
|
|
else
|
|
TQtWidget(AWinControl.Handle).SetCursor(nil);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtWSWinControl.SetFont
|
|
Params: AWinControl - the calling object, AFont - object font
|
|
Returns: Nothing
|
|
|
|
Sets the font of the widget.
|
|
------------------------------------------------------------------------------}
|
|
class procedure TQtWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
|
|
var
|
|
QtWidget: TQtWidget;
|
|
QColor: TQColor;
|
|
ColorRef: TColorRef;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'SetFont') then
|
|
Exit;
|
|
|
|
QtWidget := TQtWidget(AWinControl.Handle);
|
|
QtWidget.BeginUpdate;
|
|
QtWidget.WidgetState := QtWidget.WidgetState + [qtwsFontUpdating];
|
|
try
|
|
QtWidget.SetLCLFont(TQtFont(AFont.Reference.Handle));
|
|
QtWidget.setFont(TQtFont(AFont.Reference.Handle).FHandle);
|
|
|
|
// tscrollbar, ttrackbar etc.
|
|
if not QtWidget.CanChangeFontColor then
|
|
begin
|
|
with QtWidget do
|
|
begin
|
|
Palette.ForceColor := True;
|
|
setDefaultColor(dctFont);
|
|
Palette.ForceColor := False;
|
|
end;
|
|
exit;
|
|
end;
|
|
|
|
if AFont.Color = clDefault then
|
|
QtWidget.SetDefaultColor(dctFont)
|
|
else
|
|
begin
|
|
ColorRef := ColorToRGB(AFont.Color);
|
|
QColor_fromRgb(@QColor,Red(ColorRef),Green(ColorRef),Blue(ColorRef));
|
|
QtWidget.SetTextColor(@QColor);
|
|
end;
|
|
finally
|
|
QtWidget.WidgetState := QtWidget.WidgetState - [qtwsFontUpdating];
|
|
QtWidget.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.SetShape(const AWinControl: TWinControl;
|
|
const AShape: HBITMAP);
|
|
var
|
|
Widget: TQtWidget;
|
|
Shape: TQtImage;
|
|
AMask: QBitmapH;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'SetShape') then
|
|
Exit;
|
|
Widget := TQtWidget(AWinControl.Handle);
|
|
|
|
if AShape <> 0 then
|
|
begin
|
|
Shape := TQtImage(AShape);
|
|
// invert white/black
|
|
Shape.invertPixels;
|
|
AMask := Shape.AsBitmap;
|
|
Widget.setMask(AMask);
|
|
QBitmap_destroy(AMask);
|
|
// invert back
|
|
Shape.invertPixels;
|
|
end
|
|
else
|
|
Widget.clearMask;
|
|
end;
|
|
|
|
class procedure TQtWSWinControl.SetBorderStyle(const AWinControl: TWinControl;
|
|
const ABorderStyle: TBorderStyle);
|
|
var
|
|
Widget: TQtWidget;
|
|
QtEdit: IQtEdit;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWinControl, 'SetBorderStyle') then
|
|
Exit;
|
|
|
|
Widget := TQtWidget(AWinControl.Handle);
|
|
QtEdit := nil;
|
|
if Widget is TQtFrame then
|
|
TQtFrame(Widget).setFrameShape(TBorderStyleToQtFrameShapeMap[ABorderStyle])
|
|
else
|
|
if Supports(Widget, IQtEdit, QtEdit) then
|
|
QtEdit.setBorder(ABorderStyle = bsSingle);
|
|
end;
|
|
|
|
{ TQtWSDragImageListResolution }
|
|
|
|
class function TQtWSDragImageListResolution.BeginDrag(
|
|
const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, Y: Integer): Boolean;
|
|
var
|
|
ABitmap: TBitmap;
|
|
begin
|
|
ABitmap := TBitmap.Create;
|
|
try
|
|
ADragImageList.GetBitmap(AIndex, ABitmap);
|
|
|
|
if (ABitmap.Handle = 0) or (ABitmap.Width = 0) or (ABitmap.Height = 0) then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
Result := TQtWidgetset(Widgetset).DragImageList_BeginDrag(
|
|
TQtImage(ABitmap.Handle).Handle, ADragImageList.DragHotSpot);
|
|
if Result then
|
|
TQtWidgetset(Widgetset).DragImageList_DragMove(X, Y);
|
|
finally
|
|
ABitmap.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TQtWSDragImageListResolution.DragMove(
|
|
const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean;
|
|
begin
|
|
Result := TQtWidgetset(Widgetset).DragImageList_DragMove(X, Y);
|
|
end;
|
|
|
|
class procedure TQtWSDragImageListResolution.EndDrag(const ADragImageList: TDragImageListResolution);
|
|
begin
|
|
TQtWidgetset(Widgetset).DragImageList_EndDrag;
|
|
end;
|
|
|
|
class function TQtWSDragImageListResolution.HideDragImage(
|
|
const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; DoUnLock: Boolean
|
|
): Boolean;
|
|
begin
|
|
TQtWidgetset(Widgetset).DragImageLock := False;
|
|
Result := TQtWidgetset(Widgetset).DragImageList_SetVisible(False);
|
|
end;
|
|
|
|
class function TQtWSDragImageListResolution.ShowDragImage(
|
|
const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; X, Y: Integer;
|
|
DoLock: Boolean): Boolean;
|
|
begin
|
|
Result := TQtWidgetset(Widgetset).DragImageLock;
|
|
if not DoLock then
|
|
begin
|
|
if not Result then
|
|
Result := TQtWidgetset(Widgetset).DragImageList_SetVisible(True);
|
|
end else
|
|
begin
|
|
TQtWidgetset(Widgetset).DragImageLock := True;
|
|
Result := TQtWidgetset(Widgetset).DragImageList_DragMove(X, Y) and
|
|
TQtWidgetset(Widgetset).DragImageList_SetVisible(True);
|
|
end;
|
|
end;
|
|
|
|
end.
|