mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-30 12:42:49 +02:00
5270 lines
142 KiB
ObjectPascal
5270 lines
142 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
* QtObjects.pas *
|
|
* -------------- *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
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 qtobjects;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{$I qtdefines.inc}
|
|
|
|
uses
|
|
// Bindings
|
|
qt4,
|
|
// Free Pascal
|
|
Classes, SysUtils, Types,
|
|
// LCL
|
|
LCLType, LCLIntf, Menus, LCLProc, Graphics, ClipBrd, ExtCtrls, Interfacebase,
|
|
maps;
|
|
|
|
type
|
|
// forward declarations
|
|
TQActions = Array of QActionH;
|
|
TQtImage = class;
|
|
TQtFontMetrics = class;
|
|
TQtFontInfo = class;
|
|
TQtTimer = class;
|
|
TRop2OrCompositionSupport = (rocNotSupported, rocSupported, rocUndefined);
|
|
|
|
{ TQtObject }
|
|
TQtObject = class(TObject)
|
|
private
|
|
FUpdateCount: Integer;
|
|
FInEventCount: Integer;
|
|
FReleaseInEvent: Boolean;
|
|
public
|
|
FDeleteLater: Boolean;
|
|
FEventHook: QObject_hookH;
|
|
FDestroyedHook: QObject_hookH;
|
|
TheObject: QObjectH;
|
|
constructor Create; virtual; overload;
|
|
destructor Destroy; override;
|
|
procedure Release; virtual;
|
|
public
|
|
procedure AttachEvents; virtual;
|
|
procedure DetachEvents; virtual;
|
|
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; virtual; abstract;
|
|
procedure Destroyed; cdecl; virtual;
|
|
procedure BeginEventProcessing;
|
|
procedure EndEventProcessing;
|
|
function InEvent: Boolean;
|
|
public
|
|
procedure BeginUpdate; virtual;
|
|
procedure EndUpdate; virtual;
|
|
function InUpdate: Boolean;
|
|
end;
|
|
|
|
{ TQtResource }
|
|
|
|
TQtResource = class(TObject)
|
|
public
|
|
Owner: TObject;
|
|
FShared: Boolean;
|
|
FSelected: Boolean;
|
|
end;
|
|
|
|
{ TQtActionGroup }
|
|
|
|
TQtActionGroup = class(TObject)
|
|
private
|
|
FActions: TQActions;
|
|
FGroupIndex: integer;
|
|
FHandle: QActionGroupH;
|
|
function getEnabled: boolean;
|
|
function getExclusive: boolean;
|
|
function getVisible: boolean;
|
|
procedure setEnabled(const AValue: boolean);
|
|
procedure setExclusive(const AValue: boolean);
|
|
procedure setVisible(const AValue: boolean);
|
|
public
|
|
constructor Create(const AParent: QObjectH = nil);
|
|
destructor Destroy; override;
|
|
function addAction(action: QActionH): QActionH; overload;
|
|
function addAction(text: WideString): QActionH; overload;
|
|
function addAction(icon: QIconH; text: WideString): QActionH; overload;
|
|
procedure removeAction(action: QActionH);
|
|
function actions: TQActions;
|
|
function checkedAction: QActionH;
|
|
procedure setDisabled(ADisabled: Boolean);
|
|
property Enabled: boolean read getEnabled write setEnabled;
|
|
property Exclusive: boolean read getExclusive write setExclusive;
|
|
property GroupIndex: integer read FGroupIndex write FGroupIndex;
|
|
property Handle: QActionGroupH read FHandle;
|
|
property Visible: boolean read getVisible write setVisible;
|
|
end;
|
|
|
|
{ TQtAction }
|
|
|
|
TQtAction = class(TObject)
|
|
private
|
|
FIcon: QIconH;
|
|
public
|
|
FHandle: QActionH;
|
|
MenuItem: TMenuItem;
|
|
public
|
|
constructor Create(const AHandle: QActionH);
|
|
destructor Destroy; override;
|
|
public
|
|
procedure SlotTriggered(checked: Boolean = False); cdecl;
|
|
public
|
|
procedure setChecked(p1: Boolean);
|
|
procedure setCheckable(p1: Boolean);
|
|
procedure setEnabled(p1: Boolean);
|
|
procedure setIcon(const AIcon: QIconH);
|
|
procedure setImage(const AImage: TQtImage);
|
|
procedure setVisible(p1: Boolean);
|
|
end;
|
|
|
|
{ TQtImage }
|
|
|
|
TQtImage = class(TObject)
|
|
private
|
|
FData: PByte;
|
|
FDataOwner: Boolean;
|
|
FHandle: QImageH;
|
|
public
|
|
constructor Create;
|
|
constructor Create(vHandle: QImageH); overload;
|
|
constructor Create(AData: PByte; width: Integer; height: Integer; format: QImageFormat; const ADataOwner: Boolean = False); overload;
|
|
constructor Create(AData: PByte; width: Integer; height: Integer; bytesPerLine: Integer; format: QImageFormat; const ADataOwner: Boolean = False); overload;
|
|
destructor Destroy; override;
|
|
function AsIcon(AMode: QIconMode = QIconNormal; AState: QIconState = QIconOff): QIconH;
|
|
function AsPixmap(flags: QtImageConversionFlags = QtAutoColor): QPixmapH;
|
|
function AsBitmap(flags: QtImageConversionFlags = QtAutoColor): QBitmapH;
|
|
procedure CopyFrom(AImage: QImageH; x, y, w, h: integer);
|
|
public
|
|
function height: Integer;
|
|
function width: Integer;
|
|
function depth: Integer;
|
|
function dotsPerMeterX: Integer;
|
|
function dotsPerMeterY: Integer;
|
|
function bits: PByte;
|
|
function numBytes: Integer;
|
|
function bytesPerLine: Integer;
|
|
procedure invertPixels(InvertMode: QImageInvertMode = QImageInvertRgb);
|
|
function getFormat: QImageFormat;
|
|
property Handle: QImageH read FHandle;
|
|
end;
|
|
|
|
{ TQtFont }
|
|
|
|
TQtFont = class(TQtResource)
|
|
private
|
|
FDefaultFont: QFontH;
|
|
FMetrics: TQtFontMetrics;
|
|
FFontInfo: TQtFontInfo;
|
|
function GetFontInfo: TQtFontInfo;
|
|
function GetMetrics: TQtFontMetrics;
|
|
function GetDefaultFont: QFontH;
|
|
public
|
|
FHandle: QFontH;
|
|
Angle: Integer;
|
|
public
|
|
constructor Create(CreateHandle: Boolean); virtual;
|
|
constructor Create(AFromFont: QFontH); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
function getPointSize: Integer;
|
|
function getPixelSize: Integer;
|
|
function getWeight: Integer;
|
|
function getItalic: Boolean;
|
|
function getBold: Boolean;
|
|
function getUnderline: Boolean;
|
|
function getStrikeOut: Boolean;
|
|
function getFamily: WideString;
|
|
function getStyleStategy: QFontStyleStrategy;
|
|
|
|
procedure setPointSize(p1: Integer);
|
|
procedure setPixelSize(p1: Integer);
|
|
procedure setWeight(p1: Integer);
|
|
procedure setBold(p1: Boolean);
|
|
procedure setItalic(b: Boolean);
|
|
procedure setUnderline(p1: Boolean);
|
|
procedure setStrikeOut(p1: Boolean);
|
|
procedure setRawName(p1: string);
|
|
procedure setFamily(p1: string);
|
|
procedure setStyleStrategy(s: QFontStyleStrategy);
|
|
procedure family(retval: PWideString);
|
|
function fixedPitch: Boolean;
|
|
|
|
property FontInfo: TQtFontInfo read GetFontInfo;
|
|
property Metrics: TQtFontMetrics read GetMetrics;
|
|
end;
|
|
|
|
{ TQtFontMetrics }
|
|
|
|
TQtFontMetrics = class(TObject)
|
|
private
|
|
public
|
|
FHandle: QFontMetricsH;
|
|
public
|
|
constructor Create(Parent: QFontH); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
function height: Integer;
|
|
function width(p1: PWideString): Integer; overload;
|
|
function width(p1: PWideString; ALen: Integer): Integer; overload;
|
|
function ascent: Integer;
|
|
function descent: Integer;
|
|
function leading: Integer;
|
|
function maxWidth: Integer;
|
|
procedure boundingRect(retval: PRect; r: PRect; flags: Integer; text: PWideString; tabstops: Integer = 0; tabarray: PInteger = nil);
|
|
function charWidth(str: WideString; pos: Integer): Integer;
|
|
function averageCharWidth: Integer;
|
|
function elidedText(const AText: WideString;
|
|
const AMode: QtTextElideMode; const AWidth: Integer;
|
|
const AFlags: Integer = 0): WideString;
|
|
end;
|
|
|
|
{ TQtFontInfo }
|
|
|
|
TQtFontInfo = class(TObject)
|
|
private
|
|
function GetBold: Boolean;
|
|
function GetExactMatch: Boolean;
|
|
function GetFamily: WideString;
|
|
function GetFixedPitch: Boolean;
|
|
function GetFontStyle: QFontStyle;
|
|
function GetFontStyleHint: QFontStyleHint;
|
|
function GetItalic: Boolean;
|
|
function GetOverLine: Boolean;
|
|
function GetPixelSize: Integer;
|
|
function GetPointSize: Integer;
|
|
function GetRawMode: Boolean;
|
|
function GetStrikeOut: Boolean;
|
|
function GetUnderline: Boolean;
|
|
function GetWeight: Integer;
|
|
public
|
|
FHandle: QFontInfoH;
|
|
public
|
|
constructor Create(AFont: QFontH); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
property Bold: Boolean read GetBold;
|
|
property Italic: Boolean read GetItalic;
|
|
property ExactMatch: Boolean read GetExactMatch;
|
|
property Family: WideString read GetFamily;
|
|
property FixedPitch: Boolean read GetFixedPitch;
|
|
property Overline: Boolean read GetOverLine;
|
|
property PointSize: Integer read GetPointSize;
|
|
property PixelSize: Integer read GetPixelSize;
|
|
property RawMode: Boolean read GetRawMode;
|
|
property StrikeOut: Boolean read GetStrikeOut;
|
|
property Style: QFontStyle read GetFontStyle;
|
|
property StyleHint: QFontStyleHint read GetFontStyleHint;
|
|
property Underline: Boolean read GetUnderline;
|
|
property Weight: Integer read GetWeight;
|
|
end;
|
|
|
|
{ TQtBrush }
|
|
|
|
TQtBrush = class(TQtResource)
|
|
private
|
|
function getStyle: QtBrushStyle;
|
|
procedure setStyle(style: QtBrushStyle);
|
|
public
|
|
FHandle: QBrushH;
|
|
constructor Create(CreateHandle: Boolean); virtual;
|
|
destructor Destroy; override;
|
|
function getColor: PQColor;
|
|
function GetLBStyle(out AStyle: LongWord; out AHatch: PtrUInt): Boolean;
|
|
procedure setColor(AColor: PQColor);
|
|
procedure setTexture(pixmap: QPixmapH);
|
|
procedure setTextureImage(image: QImageH);
|
|
property Style: QtBrushStyle read getStyle write setStyle;
|
|
end;
|
|
|
|
{ TQtPen }
|
|
|
|
TQtPen = class(TQtResource)
|
|
private
|
|
FIsExtPen: Boolean;
|
|
public
|
|
FHandle: QPenH;
|
|
constructor Create(CreateHandle: Boolean); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
function getCapStyle: QtPenCapStyle;
|
|
function getColor: TQColor;
|
|
function getCosmetic: Boolean;
|
|
function getJoinStyle: QtPenJoinStyle;
|
|
function getWidth: Integer;
|
|
function getStyle: QtPenStyle;
|
|
function getDashPattern: TQRealArray;
|
|
|
|
procedure setCapStyle(pcs: QtPenCapStyle);
|
|
procedure setColor(p1: TQColor);
|
|
procedure setCosmetic(b: Boolean);
|
|
procedure setJoinStyle(pcs: QtPenJoinStyle);
|
|
procedure setStyle(AStyle: QtPenStyle);
|
|
procedure setBrush(brush: QBrushH);
|
|
procedure setWidth(p1: Integer);
|
|
procedure setDashPattern(APattern: PDWord; ALength: DWord);
|
|
|
|
property IsExtPen: Boolean read FIsExtPen write FIsExtPen;
|
|
end;
|
|
|
|
|
|
{ TQtRegion }
|
|
|
|
TQtRegion = class(TQtResource)
|
|
private
|
|
FPolygon: QPolygonH;
|
|
function GetIsPolyRegion: Boolean;
|
|
public
|
|
FHandle: QRegionH;
|
|
constructor Create(CreateHandle: Boolean); virtual; overload;
|
|
constructor Create(CreateHandle: Boolean; X1,Y1,X2,Y2: Integer;
|
|
Const RegionType: QRegionRegionType = QRegionRectangle); virtual; overload;
|
|
constructor Create(CreateHandle: Boolean; Poly: QPolygonH;
|
|
Const Fill: QtFillRule = QtWindingFill); virtual; overload;
|
|
destructor Destroy; override;
|
|
function containsPoint(X,Y: Integer): Boolean;
|
|
function containsRect(R: TRect): Boolean;
|
|
function intersects(R: TRect): Boolean; overload;
|
|
function intersects(Rgn: QRegionH): Boolean; overload;
|
|
function GetRegionType: integer;
|
|
function getBoundingRect: TRect;
|
|
function numRects: Integer;
|
|
procedure translate(dx, dy: Integer);
|
|
property IsPolyRegion: Boolean read GetIsPolyRegion;
|
|
property Polygon: QPolygonH read FPolygon;
|
|
end;
|
|
|
|
// NOTE: PQtDCData was a pointer to a structure with QPainter information
|
|
// about current state, currently this functionality is implemented
|
|
// using native functions qpainter_save and qpainter_restore. If in
|
|
// future it needs to save/restore aditional information, PQtDCData
|
|
// should point to a structure holding the additional information.
|
|
// see SaveDC and RestoreDC for more information.
|
|
// for example: what about textcolor, it's currently not saved....
|
|
|
|
{
|
|
TQtDCData = record
|
|
end;
|
|
PQtDCData = ^TQtDCData;
|
|
}
|
|
PQtDCData = pointer;
|
|
|
|
{ TQtDeviceContext }
|
|
|
|
TQtDeviceContext = class(TObject)
|
|
private
|
|
FSupportRasterOps: TRop2OrCompositionSupport;
|
|
FSupportComposition: TRop2OrCompositionSupport;
|
|
FRopMode: Integer;
|
|
FPenPos: TQtPoint;
|
|
FOwnPainter: Boolean;
|
|
SelFont: TQtFont;
|
|
SelBrush: TQtBrush;
|
|
SelPen: TQtPen;
|
|
PenColor: TQColor;
|
|
FMetrics: TQtFontMetrics;
|
|
function GetMetrics: TQtFontMetrics;
|
|
function GetRop: Integer;
|
|
function DeviceSupportsComposition: Boolean;
|
|
function DeviceSupportsRasterOps: Boolean;
|
|
function R2ToQtRasterOp(AValue: Integer): QPainterCompositionMode;
|
|
procedure RestorePenColor;
|
|
procedure RestoreTextColor;
|
|
procedure SetRop(const AValue: Integer);
|
|
public
|
|
{ public fields }
|
|
Widget: QPainterH;
|
|
Parent: QWidgetH;
|
|
ParentPixmap: QPixmapH;
|
|
vBrush: TQtBrush;
|
|
vFont: TQtFont;
|
|
vImage: TQtImage;
|
|
vPen: TQtPen;
|
|
vRegion: TQtRegion;
|
|
vBackgroundBrush: TQtBrush;
|
|
vClipRect: PRect; // is the cliprect paint event give to us
|
|
vClipRectDirty: boolean; // false=paint cliprect is still valid
|
|
vTextColor: TColorRef;
|
|
vMapMode: Integer;
|
|
public
|
|
{ Our own functions }
|
|
constructor Create(AWidget: QWidgetH; const APaintEvent: Boolean = False); virtual;
|
|
constructor CreatePrinterContext(ADevice: QPrinterH); virtual;
|
|
constructor CreateFromPainter(APainter: QPainterH);
|
|
destructor Destroy; override;
|
|
procedure CreateObjects;
|
|
procedure DestroyObjects;
|
|
function CreateDCData: PQtDCDATA;
|
|
function RestoreDCData(var DCData: PQtDCData): boolean;
|
|
procedure DebugClipRect(const msg: string);
|
|
procedure setImage(AImage: TQtImage);
|
|
procedure CorrectCoordinates(var ARect: TRect);
|
|
function GetLineLastPixelPos(PrevPos, NewPos: TPoint): TPoint;
|
|
public
|
|
{ Qt functions }
|
|
|
|
procedure qDrawPlainRect(x, y, w, h: integer; AColor: PQColor = nil;
|
|
lineWidth: Integer = 1; FillBrush: QBrushH = nil);
|
|
procedure qDrawShadeRect(x, y, w, h: integer; Palette: QPaletteH = nil; Sunken: Boolean = False;
|
|
lineWidth: Integer = 1; midLineWidth: Integer = 0; FillBrush: QBrushH = nil);
|
|
procedure qDrawWinPanel(x, y, w, h: integer; Palette: QPaletteH = nil; Sunken: Boolean = False;
|
|
lineWidth: Integer = 1; FillBrush: QBrushH = nil);
|
|
|
|
procedure drawPoint(x1: Integer; y1: Integer);
|
|
procedure drawRect(x1: Integer; y1: Integer; w: Integer; h: Integer;
|
|
const AQtBugWorkaroundNeeded: Boolean = False);
|
|
procedure drawRoundRect(x, y, w, h, rx, ry: Integer);
|
|
procedure drawText(x: Integer; y: Integer; s: PWideString); overload;
|
|
procedure drawText(x,y,w,h,flags: Integer; s:PWideString); overload;
|
|
procedure drawLine(x1: Integer; y1: Integer; x2: Integer; y2: Integer);
|
|
procedure drawEllipse(x: Integer; y: Integer; w: Integer; h: Integer);
|
|
procedure drawPixmap(p: PQtPoint; pm: QPixmapH; sr: PRect);
|
|
procedure drawPolyLine(P: PPoint; NumPts: Integer);
|
|
procedure drawPolygon(P: PPoint; NumPts: Integer; FillRule: QtFillRule = QtOddEvenFill);
|
|
procedure eraseRect(ARect: PRect);
|
|
procedure fillRect(ARect: PRect; ABrush: QBrushH); overload;
|
|
procedure fillRect(x, y, w, h: Integer; ABrush: QBrushH); overload;
|
|
procedure fillRect(x, y, w, h: Integer); overload;
|
|
|
|
function getBKMode: Integer;
|
|
procedure getBrushOrigin(retval: PPoint);
|
|
function getClipping: Boolean;
|
|
function getCompositionMode: QPainterCompositionMode;
|
|
procedure setCompositionMode(mode: QPainterCompositionMode);
|
|
procedure getPenPos(retval: PPoint);
|
|
function getWorldTransform: QTransformH;
|
|
procedure setBrushOrigin(x, y: Integer);
|
|
procedure setPenPos(x, y: Integer);
|
|
|
|
function font: TQtFont;
|
|
procedure setFont(AFont: TQtFont);
|
|
function brush: TQtBrush;
|
|
procedure setBrush(ABrush: TQtBrush);
|
|
function BackgroundBrush: TQtBrush;
|
|
function GetBkColor: TColorRef;
|
|
function pen: TQtPen;
|
|
function setPen(APen: TQtPen): TQtPen;
|
|
function SetBkColor(Color: TColorRef): TColorRef;
|
|
function SetBkMode(BkMode: Integer): Integer;
|
|
function getDepth: integer;
|
|
function getDeviceSize: TPoint;
|
|
function getRegionType(ARegion: QRegionH): integer;
|
|
function getClipRegion: TQtRegion;
|
|
procedure setClipping(const AValue: Boolean);
|
|
procedure setClipRect(const ARect: TRect);
|
|
procedure setClipRegion(ARegion: QRegionH; AOperation: QtClipOperation = QtReplaceClip);
|
|
procedure setRegion(ARegion: TQtRegion);
|
|
procedure drawImage(targetRect: PRect; image: QImageH; sourceRect: PRect;
|
|
mask: QImageH; maskRect: PRect; flags: QtImageConversionFlags = QtAutoColor);
|
|
function PaintEngine: QPaintEngineH;
|
|
procedure rotate(a: Double);
|
|
procedure setRenderHint(AHint: QPainterRenderHint; AValue: Boolean);
|
|
procedure save;
|
|
procedure restore;
|
|
procedure translate(dx: Double; dy: Double);
|
|
property Metrics: TQtFontMetrics read GetMetrics;
|
|
property Rop2: Integer read GetRop write SetRop;
|
|
end;
|
|
|
|
{ TQtPixmap }
|
|
|
|
TQtPixmap = class(TObject)
|
|
protected
|
|
FHandle: QPixmapH;
|
|
public
|
|
constructor Create(p1: PSize); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
property Handle: QPixmapH read FHandle;
|
|
|
|
function getHeight: Integer;
|
|
function getWidth: Integer;
|
|
procedure grabWidget(AWidget: QWidgetH; x: Integer = 0; y: Integer = 0; w: Integer = -1; h: Integer = -1);
|
|
procedure grabWindow(p1: Cardinal; x: Integer = 0; y: Integer = 0; w: Integer = -1; h: Integer = -1);
|
|
procedure toImage(retval: QImageH);
|
|
class procedure fromImage(retval: QPixmapH; image: QImageH; flags: QtImageConversionFlags = QtAutoColor);
|
|
end;
|
|
|
|
{ TQtIcon }
|
|
|
|
TQtIcon = class(TObject)
|
|
protected
|
|
FHandle: QIconH;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure addPixmap(pixmap: QPixmapH; mode: QIconMode = QIconNormal; state: QIconState = QIconOff);
|
|
property Handle: QIconH read FHandle;
|
|
end;
|
|
|
|
{ TQtCursor }
|
|
|
|
TQtCursor = class(TObject)
|
|
protected
|
|
FHandle: QCursorH;
|
|
public
|
|
constructor Create;
|
|
constructor Create(pixmap: QPixmapH; hotX: Integer = -1; hotY: Integer = -1);
|
|
constructor Create(shape: QtCursorShape);
|
|
destructor Destroy; override;
|
|
property Handle: QCursorH read FHandle;
|
|
end;
|
|
|
|
{ TQtSystemTrayIcon }
|
|
|
|
TQtSystemTrayIcon = class(TObject)
|
|
private
|
|
FHook: QSystemTrayIcon_hookH;
|
|
public
|
|
Handle: QSystemTrayIconH;
|
|
FTrayIcon: TCustomTrayIcon;
|
|
public
|
|
constructor Create(vIcon: QIconH); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
procedure setContextMenu(menu: QMenuH);
|
|
procedure setIcon(icon: QIconH);
|
|
procedure setToolTip(tip: WideString);
|
|
procedure signalActivated(AReason: QSystemTrayIconActivationReason); cdecl;
|
|
procedure showBaloonHint(const ATitle, AHint: String;
|
|
const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
|
|
procedure Show;
|
|
procedure Hide;
|
|
end;
|
|
|
|
{ TQtButtonGroup }
|
|
|
|
TQtButtonGroup = class(TObject)
|
|
private
|
|
public
|
|
Handle: QButtonGroupH;
|
|
constructor Create(AParent: QObjectH); virtual;
|
|
destructor Destroy; override;
|
|
public
|
|
procedure AddButton(AButton: QAbstractButtonH); overload;
|
|
procedure AddButton(AButton: QAbstractButtonH; Id: Integer); overload;
|
|
function ButtonFromId(id: Integer): QAbstractButtonH;
|
|
procedure RemoveButton(AButton: QAbstractButtonH);
|
|
function GetExclusive: Boolean;
|
|
procedure SetExclusive(AExclusive: Boolean);
|
|
procedure SignalButtonClicked(AButton: QAbstractButtonH); cdecl;
|
|
end;
|
|
|
|
{ TQtClipboard }
|
|
|
|
TQtClipboard = class(TQtObject)
|
|
private
|
|
FLockClip: Boolean;
|
|
FClipDataChangedHook: QClipboard_hookH;
|
|
{$IFDEF HASX11}
|
|
FClipSelectionChangedHook: QClipboard_hookH;
|
|
FSelTimer: TQtTimer; // timer for keyboard X11 selection
|
|
FSelFmtCount: Integer;
|
|
FLockX11Selection: Integer;
|
|
{$ENDIF}
|
|
FClipChanged: Boolean;
|
|
FClipBoardFormats: TStringList;
|
|
FOnClipBoardRequest: Array[TClipBoardType] of TClipboardRequestEvent;
|
|
function IsClipboardChanged: Boolean;
|
|
public
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
procedure AttachEvents; override;
|
|
procedure DetachEvents; override;
|
|
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
|
|
|
|
function Clipboard: QClipboardH; inline;
|
|
|
|
function getMimeData(AMode: QClipboardMode): QMimeDataH;
|
|
procedure setMimeData(AMimeData: QMimeDataH; AMode: QClipboardMode);
|
|
procedure Clear(AMode: QClipboardMode);
|
|
|
|
function FormatToMimeType(AFormat: TClipboardFormat): String;
|
|
function RegisterFormat(AMimeType: String): TClipboardFormat;
|
|
function GetData(ClipboardType: TClipboardType; FormatID: TClipboardFormat;
|
|
Stream: TStream): boolean;
|
|
function GetFormats(ClipboardType: TClipboardType; var Count: integer;
|
|
var List: PClipboardFormat): boolean;
|
|
function GetOwnerShip(ClipboardType: TClipboardType; OnRequestProc: TClipboardRequestEvent;
|
|
FormatCount: integer; Formats: PClipboardFormat): boolean;
|
|
|
|
procedure signalDataChanged; cdecl;
|
|
{$IFDEF HASX11}
|
|
procedure BeginX11SelectionLock;
|
|
procedure EndX11SelectionLock;
|
|
function InX11SelectionLock: Boolean;
|
|
procedure signalSelectionChanged; cdecl;
|
|
procedure selectionTimer;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TQtPrinter }
|
|
|
|
TQtPrinter = class(TObject)
|
|
protected
|
|
FHandle: QPrinterH;
|
|
FPrinterContext: TQtDeviceContext;
|
|
private
|
|
FPrinterActive: Boolean;
|
|
function GetDuplexMode: QPrinterDuplexMode;
|
|
function getPrinterContext: TQtDeviceContext;
|
|
function getCollateCopies: Boolean;
|
|
function getColorMode: QPrinterColorMode;
|
|
function getCreator: WideString;
|
|
function getDevType: Integer;
|
|
function getDocName: WideString;
|
|
function getDoubleSidedPrinting: Boolean;
|
|
function getFontEmbedding: Boolean;
|
|
function getFullPage: Boolean;
|
|
function getOutputFormat: QPrinterOutputFormat;
|
|
function getPaperSource: QPrinterPaperSource;
|
|
function getPrintProgram: WideString;
|
|
function getPrintRange: QPrinterPrintRange;
|
|
procedure setCollateCopies(const AValue: Boolean);
|
|
procedure setColorMode(const AValue: QPrinterColorMode);
|
|
procedure setCreator(const AValue: WideString);
|
|
procedure setDocName(const AValue: WideString);
|
|
procedure setDoubleSidedPrinting(const AValue: Boolean);
|
|
procedure SetDuplexMode(AValue: QPrinterDuplexMode);
|
|
procedure setFontEmbedding(const AValue: Boolean);
|
|
procedure setFullPage(const AValue: Boolean);
|
|
procedure setOutputFormat(const AValue: QPrinterOutputFormat);
|
|
procedure setPaperSource(const AValue: QPrinterPaperSource);
|
|
procedure setPrinterName(const AValue: WideString);
|
|
function getPrinterName: WideString;
|
|
procedure setOutputFileName(const AValue: WideString);
|
|
function getOutputFileName: WideString;
|
|
procedure setOrientation(const AValue: QPrinterOrientation);
|
|
function getOrientation: QPrinterOrientation;
|
|
procedure setPageSize(const AValue: QPrinterPageSize);
|
|
function getPageSize: QPrinterPageSize;
|
|
procedure setPageOrder(const AValue: QPrinterPageOrder);
|
|
function getPageOrder: QPrinterPageOrder;
|
|
procedure setPrintProgram(const AValue: WideString);
|
|
procedure setPrintRange(const AValue: QPrinterPrintRange);
|
|
procedure setResolution(const AValue: Integer);
|
|
function getResolution: Integer;
|
|
function getNumCopies: Integer;
|
|
procedure setNumCopies(const AValue: Integer);
|
|
function getPrinterState: QPrinterPrinterState;
|
|
public
|
|
constructor Create; virtual; overload;
|
|
constructor Create(AMode: QPrinterPrinterMode); virtual; overload;
|
|
destructor Destroy; override;
|
|
|
|
function DefaultPrinter: WideString;
|
|
function GetAvailablePrinters(Lst: TStrings): Boolean;
|
|
|
|
procedure beginDoc;
|
|
procedure endDoc;
|
|
|
|
function NewPage: Boolean;
|
|
function Abort: Boolean;
|
|
procedure setFromPageToPage(Const AFromPage, AToPage: Integer);
|
|
function fromPage: Integer;
|
|
function toPage: Integer;
|
|
function PaintEngine: QPaintEngineH;
|
|
function PageRect: TRect; overload;
|
|
function PaperRect: TRect; overload;
|
|
function PageRect(AUnits: QPrinterUnit): TRect; overload;
|
|
function PaperRect(AUnits: QPrinterUnit): TRect; overload;
|
|
function PrintEngine: QPrintEngineH;
|
|
function GetPaperSize(AUnits: QPrinterUnit): TSize;
|
|
procedure SetPaperSize(ASize: TSize; AUnits: QPrinterUnit);
|
|
function SupportedResolutions: TPtrIntArray;
|
|
|
|
property Collate: Boolean read getCollateCopies write setCollateCopies;
|
|
property ColorMode: QPrinterColorMode read getColorMode write setColorMode;
|
|
property Creator: WideString read getCreator write setCreator;
|
|
property DeviceType: Integer read getDevType;
|
|
property DocName: WideString read getDocName write setDocName;
|
|
property DoubleSidedPrinting: Boolean read getDoubleSidedPrinting write setDoubleSidedPrinting;
|
|
property Duplex: QPrinterDuplexMode read GetDuplexMode write SetDuplexMode;
|
|
property FontEmbedding: Boolean read getFontEmbedding write setFontEmbedding;
|
|
property FullPage: Boolean read getFullPage write setFullPage;
|
|
property Handle: QPrinterH read FHandle;
|
|
property NumCopies: Integer read getNumCopies write setNumCopies;
|
|
property Orientation: QPrinterOrientation read getOrientation write setOrientation;
|
|
property OutputFormat: QPrinterOutputFormat read getOutputFormat write setOutputFormat;
|
|
property OutputFileName: WideString read getOutputFileName write setOutputFileName;
|
|
property PageOrder: QPrinterPageOrder read getPageOrder write setPageOrder;
|
|
property PageSize: QPrinterPageSize read getPageSize write setPageSize;
|
|
property PaperSource: QPrinterPaperSource read getPaperSource write setPaperSource;
|
|
property PrinterContext: TQtDeviceContext read getPrinterContext;
|
|
property PrinterName: WideString read getPrinterName write setPrinterName;
|
|
property PrinterActive: Boolean read FPrinterActive;
|
|
property PrintRange: QPrinterPrintRange read getPrintRange write setPrintRange;
|
|
property PrinterState: QPrinterPrinterState read getPrinterState;
|
|
property PrintProgram: WideString read getPrintProgram write setPrintProgram;
|
|
property Resolution: Integer read getResolution write setResolution;
|
|
end;
|
|
|
|
{ TQtTimer }
|
|
|
|
TQtTimer = class(TQtObject)
|
|
private
|
|
FTimerHook: QTimer_hookH;
|
|
FCallbackFunc: TWSTimerProc;
|
|
FId: Integer;
|
|
FAppObject: QObjectH;
|
|
function getTimerEnabled: Boolean;
|
|
procedure setTimerEnabled(const AValue: Boolean);
|
|
public
|
|
constructor CreateTimer(Interval: integer; const TimerFunc: TWSTimerProc; App: QObjectH); virtual;
|
|
destructor Destroy; override;
|
|
procedure AttachEvents; override;
|
|
procedure DetachEvents; override;
|
|
procedure signalTimeout; cdecl;
|
|
property TimerEnabled: Boolean read getTimerEnabled write setTimerEnabled;
|
|
property TimerID: Integer read FId;
|
|
public
|
|
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
|
|
end;
|
|
|
|
{ TQtStringList }
|
|
|
|
TQtStringList = class(TStrings)
|
|
private
|
|
FHandle: QStringListH;
|
|
FOwnHandle: Boolean;
|
|
protected
|
|
function Get(Index: Integer): string; override;
|
|
function GetCount: Integer; override;
|
|
public
|
|
constructor Create;
|
|
constructor Create(Source: QStringListH);
|
|
destructor Destroy; override;
|
|
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: string); override;
|
|
property Handle: QStringListH read FHandle;
|
|
end;
|
|
|
|
{ TQtWidgetPalette }
|
|
|
|
TQtWidgetPalette = class(TObject)
|
|
private
|
|
procedure initializeSysColors;
|
|
function ColorChangeNeeded(const AColor: TQColor;
|
|
const ATextRole: Boolean): Boolean;
|
|
protected
|
|
FForceColor: Boolean;
|
|
FInReload: Boolean;
|
|
FWidget: QWidgetH;
|
|
FWidgetRole: QPaletteColorRole;
|
|
FTextRole: QPaletteColorRole;
|
|
FDefaultColor: TQColor;
|
|
FCurrentColor: TQColor;
|
|
FDefaultTextColor: TQColor;
|
|
FCurrentTextColor: TQColor;
|
|
FDisabledColor: TQColor;
|
|
FDisabledTextColor: TQColor;
|
|
FHandle: QPaletteH;
|
|
public
|
|
constructor Create(AWidgetColorRole: QPaletteColorRole;
|
|
AWidgetTextColorRole: QPaletteColorRole; AWidget: QWidgetH);
|
|
destructor Destroy; override;
|
|
procedure ReloadPaletteBegin; // used in QEventPaletteChange !
|
|
procedure ReloadPaletteEnd; // used in QEventPaletteChange !
|
|
procedure setColor(const AColor: PQColor); overload;
|
|
procedure setTextColor(const AColor: PQColor);
|
|
property Handle: QPaletteH read FHandle;
|
|
property CurrentColor: TQColor read FCurrentColor;
|
|
property CurrentTextColor: TQColor read FCurrentTextColor;
|
|
property DefaultColor: TQColor read FDefaultColor;
|
|
property DefaultTextColor: TQColor read FDefaultTextColor;
|
|
property DisabledColor: TQColor read FDisabledColor;
|
|
property DisabledTextColor: TQColor read FDisabledTextColor;
|
|
property InReload: Boolean read FInReload;
|
|
property ForceColor: Boolean read FForceColor write FForceColor;
|
|
end;
|
|
|
|
{TQtObjectDump}
|
|
|
|
TQtObjectDump = class(TObject) // helper class to dump complete children tree
|
|
private
|
|
FRoot: QObjectH;
|
|
FObjList: TFPList;
|
|
FList: TStrings;
|
|
procedure Iterator(ARoot: QObjectH);
|
|
procedure AddToList(AnObject: QObjectH);
|
|
public
|
|
constructor Create(AnObject: QObjectH);
|
|
destructor Destroy; override;
|
|
procedure DumpObject;
|
|
function findWidgetByName(const AName: WideString): QWidgetH;
|
|
function IsWidget(AnObject: QObjectH): Boolean;
|
|
function GetObjectName(AnObject: QObjectH): WideString;
|
|
function InheritsQtClass(AnObject: QObjectH; AQtClass: WideString): Boolean;
|
|
property List: TStrings read FList;
|
|
property ObjList: TFPList read FObjList;
|
|
end;
|
|
|
|
{ TQtGDIObjects }
|
|
|
|
TQtGDIObjects = class(TObject)
|
|
private
|
|
{$IFDEF DebugQTGDIObjects}
|
|
FMaxCount: Int64;
|
|
FInvalidCount: Int64;
|
|
{$ENDIF}
|
|
FCount: PtrInt;
|
|
FSavedHandlesList: TMap;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure AddGDIObject(AObject: TObject);
|
|
procedure RemoveGDIObject(AObject: TObject);
|
|
function IsValidGDIObject(AGDIObject: PtrUInt): Boolean;
|
|
property Count: PtrInt read FCount;
|
|
end;
|
|
|
|
|
|
const
|
|
LCLQt_Destroy = QEventType(Ord(QEventUser) + $1000);
|
|
|
|
procedure TQColorToColorRef(const AColor: TQColor; out AColorRef: TColorRef);
|
|
procedure ColorRefToTQColor(const AColorRef: TColorRef; var AColor:TQColor);
|
|
function EqualTQColor(const Color1, Color2: TQColor): Boolean;
|
|
procedure DebugRegion(const msg: string; Rgn: QRegionH);
|
|
|
|
function CheckGDIObject(const AGDIObject: HGDIOBJ; const AMethodName: String; AParamName: String = ''): Boolean;
|
|
function CheckBitmap(const ABitmap: HBITMAP; const AMethodName: String; AParamName: String = ''): Boolean;
|
|
|
|
function QtDefaultPrinter: TQtPrinter;
|
|
function Clipboard: TQtClipboard;
|
|
function QtDefaultContext: TQtDeviceContext;
|
|
function QtScreenContext: TQtDeviceContext;
|
|
|
|
procedure AssignQtFont(FromFont: QFontH; ToFont: QFontH);
|
|
function IsFontEqual(AFont1, AFont2: TQtFont): Boolean;
|
|
|
|
var
|
|
QtGDIObjects: TQtGDIObjects = nil;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Controls, qtproc;
|
|
|
|
const
|
|
ClipbBoardTypeToQtClipboard: array[TClipboardType] of QClipboardMode =
|
|
(
|
|
{ctPrimarySelection } QClipboardSelection,
|
|
{ctSecondarySelection} QClipboardSelection,
|
|
{ctClipboard } QClipboardClipboard
|
|
);
|
|
|
|
const
|
|
Rop2CompSupported: Array[Boolean] of TRop2OrCompositionSupport =
|
|
(rocNotSupported, rocSupported);
|
|
|
|
const
|
|
SQTWSPrefix = 'TQTWidgetSet.';
|
|
|
|
{$IFDEF HASX11}
|
|
// defined here to reduce includes (qtint)
|
|
LCLQt_ClipboardPrimarySelection = QEventType(Ord(QEventUser) + $1004);
|
|
{$ENDIF}
|
|
|
|
var
|
|
FClipboard: TQtClipboard = nil;
|
|
FDefaultContext: TQtDeviceContext = nil;
|
|
FScreenContext: TQtDeviceContext = nil;
|
|
FPrinter: TQtPrinter = nil;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: CheckGDIObject
|
|
Params: GDIObject - Handle to a GDI Object (TQTFont, ...)
|
|
AMethodName - Method name
|
|
AParamName - Param name
|
|
Returns: If the GDIObject is valid
|
|
|
|
Remark: All handles for GDI objects must be pascal objects so we can
|
|
distinguish between them
|
|
------------------------------------------------------------------------------}
|
|
function CheckGDIObject(const AGDIObject: HGDIOBJ; const AMethodName: String;
|
|
AParamName: String): Boolean;
|
|
begin
|
|
{$note CheckGDIObject TODO: make TQTImage a TQtResource}
|
|
Result := (TObject(AGDIObject) is TQtResource) or (TObject(AGDIObject) is TQtImage);
|
|
if Result then Exit;
|
|
|
|
if Pos('.', AMethodName) = 0 then
|
|
DebugLn(SQTWSPrefix + AMethodName + ' Error - invalid GDIObject ' +
|
|
AParamName + ' = ' + DbgS(AGDIObject) + '!')
|
|
else
|
|
DebugLn(AMethodName + ' Error - invalid GDIObject ' + AParamName + ' = ' +
|
|
DbgS(AGDIObject) + '!');
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Name: CheckBitmap
|
|
Params: Bitmap - Handle to a bitmap (TQTBitmap)
|
|
AMethodName - Method name
|
|
AParamName - Param name
|
|
Returns: If the bitmap is valid
|
|
------------------------------------------------------------------------------}
|
|
function CheckBitmap(const ABitmap: HBITMAP; const AMethodName: String;
|
|
AParamName: String): Boolean;
|
|
begin
|
|
Result := TObject(ABitmap) is TQTImage;
|
|
if Result then Exit;
|
|
|
|
if Pos('.', AMethodName) = 0 then
|
|
DebugLn(SQTWSPrefix + AMethodName + ' Error - invalid bitmap ' +
|
|
AParamName + ' = ' + DbgS(ABitmap) + '!')
|
|
else
|
|
DebugLn(AMethodName + ' Error - invalid bitmap ' + AParamName + ' = ' +
|
|
DbgS(ABitmap) + '!');
|
|
end;
|
|
|
|
function QtDefaultContext: TQtDeviceContext;
|
|
begin
|
|
if FDefaultContext = nil then
|
|
FDefaultContext := TQtDeviceContext.Create(nil, False);
|
|
Result := FDefaultContext;
|
|
end;
|
|
|
|
function QtScreenContext: TQtDeviceContext;
|
|
begin
|
|
if FScreenContext = nil then
|
|
FScreenContext := TQtDeviceContext.Create(QApplication_desktop(), False);
|
|
Result := FScreenContext;
|
|
end;
|
|
|
|
procedure AssignQtFont(FromFont: QFontH; ToFont: QFontH);
|
|
var
|
|
FntFam: WideString;
|
|
begin
|
|
QFont_family(FromFont, @FntFam);
|
|
QFont_setFamily(ToFont, @FntFam);
|
|
if QFont_pixelSize(FromFont) > 0 then
|
|
QFont_setPixelSize(ToFont, QFont_pixelSize(FromFont))
|
|
else
|
|
QFont_setPointSize(ToFont, QFont_pointSize(FromFont));
|
|
QFont_setWeight(ToFont, QFont_weight(FromFont));
|
|
QFont_setBold(ToFont, QFont_bold(FromFont));
|
|
QFont_setItalic(ToFont, QFont_italic(FromFont));
|
|
QFont_setUnderline(ToFont, QFont_underline(FromFont));
|
|
QFont_setStrikeOut(ToFont, QFont_strikeOut(FromFont));
|
|
QFont_setStyle(ToFont, QFont_style(FromFont));
|
|
QFont_setStyleStrategy(ToFont, QFont_styleStrategy(FromFont));
|
|
end;
|
|
|
|
function IsFontEqual(AFont1, AFont2: TQtFont): Boolean;
|
|
var
|
|
AInfo1, AInfo2: TQtFontInfo;
|
|
begin
|
|
Result := False;
|
|
if (AFont1 = nil) or (AFont2 = nil) then
|
|
exit;
|
|
if (AFont1.FHandle = nil) or (AFont2.FHandle = nil) then
|
|
exit;
|
|
AInfo1 := AFont1.FontInfo;
|
|
AInfo2 := AFont2.FontInfo;
|
|
if (AInfo1 = nil) or (AInfo2 = nil) then
|
|
exit;
|
|
Result := (AInfo1.Family = AInfo2.Family) and (AInfo1.Bold = AInfo2.Bold) and
|
|
(AInfo1.Italic = AInfo2.Italic) and (AInfo1.FixedPitch = AInfo2.FixedPitch) and
|
|
(AInfo1.Underline = AInfo2.Underline) and (AInfo1.Overline = AInfo2.OverLine) and
|
|
(AInfo1.PixelSize = AInfo2.PixelSize) and (AInfo1.PointSize = AInfo2.PointSize) and
|
|
(AInfo1.StrikeOut = AInfo2.StrikeOut) and (AInfo1.Weight = AInfo2.Weight) and
|
|
(AInfo1.RawMode = AInfo2.RawMode) and (AInfo1.Style = AInfo2.Style) and
|
|
(AInfo1.StyleHint = AInfo2.StyleHint);
|
|
end;
|
|
|
|
{ TQtFontInfo }
|
|
|
|
function TQtFontInfo.GetBold: Boolean;
|
|
begin
|
|
Result := QFontInfo_bold(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetExactMatch: Boolean;
|
|
begin
|
|
Result := QFontInfo_exactMatch(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetFamily: WideString;
|
|
var
|
|
WStr: WideString;
|
|
begin
|
|
QFontInfo_family(FHandle, @WStr);
|
|
Result := UTF8ToUTF16(WStr);
|
|
end;
|
|
|
|
function TQtFontInfo.GetFixedPitch: Boolean;
|
|
begin
|
|
Result := QFontInfo_fixedPitch(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetFontStyle: QFontStyle;
|
|
begin
|
|
Result := QFontInfo_style(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetFontStyleHint: QFontStyleHint;
|
|
begin
|
|
Result := QFontInfo_styleHint(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetItalic: Boolean;
|
|
begin
|
|
Result := QFontInfo_italic(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetOverLine: Boolean;
|
|
begin
|
|
Result := QFontInfo_overline(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetPixelSize: Integer;
|
|
begin
|
|
Result := QFontInfo_pixelSize(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetPointSize: Integer;
|
|
begin
|
|
Result := QFontInfo_pointSize(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetRawMode: Boolean;
|
|
begin
|
|
Result := QFontInfo_rawMode(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetStrikeOut: Boolean;
|
|
begin
|
|
Result := QFontInfo_strikeOut(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetUnderline: Boolean;
|
|
begin
|
|
Result := QFontInfo_underline(FHandle);
|
|
end;
|
|
|
|
function TQtFontInfo.GetWeight: Integer;
|
|
begin
|
|
Result := QFontInfo_weight(FHandle);
|
|
end;
|
|
|
|
constructor TQtFontInfo.Create(AFont: QFontH);
|
|
begin
|
|
FHandle := QFontInfo_create(AFont);
|
|
end;
|
|
|
|
destructor TQtFontInfo.Destroy;
|
|
begin
|
|
QFontInfo_destroy(FHandle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TQtObject }
|
|
|
|
constructor TQtObject.Create;
|
|
begin
|
|
FDeleteLater := False;
|
|
FEventHook := nil;
|
|
FUpdateCount := 0;
|
|
FInEventCount := 0;
|
|
FReleaseInEvent := False;
|
|
end;
|
|
|
|
destructor TQtObject.Destroy;
|
|
begin
|
|
if TheObject <> nil then
|
|
begin
|
|
DetachEvents;
|
|
if FDeleteLater then
|
|
QObject_deleteLater(TheObject)
|
|
else
|
|
QObject_destroy(TheObject);
|
|
TheObject := nil;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtObject.Release;
|
|
begin
|
|
if InEvent then
|
|
begin
|
|
FDeleteLater := True;
|
|
FReleaseInEvent := True;
|
|
end else
|
|
Free;
|
|
end;
|
|
|
|
procedure TQtObject.AttachEvents;
|
|
begin
|
|
FEventHook := QObject_hook_create(TheObject);
|
|
QObject_hook_hook_events(FEventHook, @EventFilter);
|
|
FDestroyedHook := QObject_hook_create(TheObject);
|
|
QObject_hook_hook_destroyed(FDestroyedHook, @Destroyed);
|
|
end;
|
|
|
|
procedure TQtObject.DetachEvents;
|
|
begin
|
|
if FEventHook <> nil then
|
|
begin
|
|
QObject_hook_destroy(FEventHook);
|
|
FEventHook := nil;
|
|
end;
|
|
if FDestroyedHook <> nil then
|
|
begin
|
|
QObject_hook_destroy(FDestroyedHook);
|
|
FDestroyedHook := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TQtObject.Destroyed; cdecl;
|
|
begin
|
|
end;
|
|
|
|
procedure TQtObject.BeginEventProcessing;
|
|
begin
|
|
inc(FInEventCount);
|
|
end;
|
|
|
|
procedure TQtObject.EndEventProcessing;
|
|
begin
|
|
if FInEventCount > 0 then
|
|
dec(FInEventCount);
|
|
if (FInEventCount = 0) and FReleaseInEvent then
|
|
Free;
|
|
end;
|
|
|
|
function TQtObject.InEvent: Boolean;
|
|
begin
|
|
Result := FInEventCount > 0;
|
|
end;
|
|
|
|
procedure TQtObject.BeginUpdate;
|
|
begin
|
|
inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TQtObject.EndUpdate;
|
|
begin
|
|
if FUpdateCount > 0 then
|
|
dec(FUpdateCount);
|
|
end;
|
|
|
|
function TQtObject.InUpdate: Boolean;
|
|
begin
|
|
Result := FUpdateCount > 0;
|
|
end;
|
|
|
|
{ TQtAction }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.Create
|
|
|
|
Constructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtAction.Create(const AHandle: QActionH);
|
|
begin
|
|
FHandle := AHandle;
|
|
FIcon := nil;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.Destroy
|
|
|
|
Destructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtAction.Destroy;
|
|
begin
|
|
if FIcon <> nil then
|
|
QIcon_destroy(FIcon);
|
|
|
|
if FHandle <> nil then
|
|
QAction_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.SlotTriggered
|
|
|
|
Callback for menu item click
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtAction.SlotTriggered(checked: Boolean); cdecl;
|
|
begin
|
|
if Assigned(MenuItem) and Assigned(MenuItem.OnClick) then
|
|
MenuItem.OnClick(Self.MenuItem);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.setChecked
|
|
|
|
Checks or unchecks a menu entry
|
|
|
|
To mimic the behavior LCL should have we added code to handle
|
|
setCheckable automatically
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtAction.setChecked(p1: Boolean);
|
|
begin
|
|
if p1 then setCheckable(True)
|
|
else setCheckable(False);
|
|
|
|
QAction_setChecked(FHandle, p1);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.setCheckable
|
|
|
|
Set's if a menu can be checked. Is false by default
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtAction.setCheckable(p1: Boolean);
|
|
begin
|
|
QAction_setCheckable(FHandle, p1);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.setEnabled
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtAction.setEnabled(p1: Boolean);
|
|
begin
|
|
QAction_setEnabled(FHandle, p1);
|
|
end;
|
|
|
|
procedure TQtAction.setIcon(const AIcon: QIconH);
|
|
begin
|
|
QAction_setIcon(FHandle, AIcon);
|
|
end;
|
|
|
|
procedure TQtAction.setImage(const AImage: TQtImage);
|
|
begin
|
|
if FIcon <> nil then
|
|
begin
|
|
QIcon_destroy(FIcon);
|
|
FIcon := nil;
|
|
end;
|
|
|
|
if AImage <> nil then
|
|
FIcon := AImage.AsIcon()
|
|
else
|
|
FIcon := QIcon_create();
|
|
|
|
setIcon(FIcon);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtAction.setVisible
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtAction.setVisible(p1: Boolean);
|
|
begin
|
|
QAction_setVisible(FHandle, p1);
|
|
end;
|
|
|
|
{ TQtImage }
|
|
|
|
constructor TQtImage.Create;
|
|
begin
|
|
FHandle := QImage_create();
|
|
FData := nil;
|
|
FDataOwner := False;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.Create
|
|
|
|
Constructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtImage.Create(vHandle: QImageH);
|
|
begin
|
|
FHandle := vHandle;
|
|
FData := nil;
|
|
FDataOwner := False;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.Create
|
|
|
|
Constructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtImage.Create(AData: PByte; width: Integer; height: Integer;
|
|
format: QImageFormat; const ADataOwner: Boolean = False);
|
|
begin
|
|
FData := AData;
|
|
FDataOwner := ADataOwner;
|
|
|
|
if FData = nil then
|
|
begin
|
|
FHandle := QImage_create(width, height, format);
|
|
QImage_fill(FHandle, 0);
|
|
end
|
|
else
|
|
begin
|
|
FHandle := QImage_create(FData, width, height, format);
|
|
if format = QImageFormat_Mono then
|
|
begin
|
|
QImage_setNumColors(FHandle, 2);
|
|
{$IFDEF DARWIN}
|
|
//rgba
|
|
QImage_SetColor(FHandle, 0, $000000FF);
|
|
{$ELSE}
|
|
//argb
|
|
QImage_SetColor(FHandle, 0, $FF000000);
|
|
{$ENDIF}
|
|
QImage_SetColor(FHandle, 1, $FFFFFFFF);
|
|
end;
|
|
end;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
constructor TQtImage.Create(AData: PByte; width: Integer; height: Integer;
|
|
bytesPerLine: Integer; format: QImageFormat; const ADataOwner: Boolean);
|
|
begin
|
|
FData := AData;
|
|
FDataOwner := ADataOwner;
|
|
|
|
if FData = nil then
|
|
FHandle := QImage_create(width, height, format)
|
|
else
|
|
begin
|
|
FHandle := QImage_create(FData, width, height, bytesPerLine, format);
|
|
if format = QImageFormat_Mono then
|
|
begin
|
|
QImage_setNumColors(FHandle, 2);
|
|
{$IFDEF DARWIN}
|
|
// rgba
|
|
QImage_SetColor(FHandle, 0, $000000FF);
|
|
{$ELSE}
|
|
// argb
|
|
QImage_SetColor(FHandle, 0, $FF000000);
|
|
{$ENDIF}
|
|
QImage_SetColor(FHandle, 1, $FFFFFFFF);
|
|
end;
|
|
end;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Destructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtImage.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtImage.Destroy Handle:', dbgs(Handle));
|
|
{$endif}
|
|
|
|
QtGDIObjects.RemoveGDIObject(Self);
|
|
|
|
if FHandle <> nil then
|
|
QImage_destroy(FHandle);
|
|
if (FDataOwner) and (FData <> nil) then
|
|
FreeMem(FData);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtImage.AsIcon(AMode: QIconMode = QIconNormal; AState: QIconState = QIconOff): QIconH;
|
|
var
|
|
APixmap: QPixmapH;
|
|
begin
|
|
APixmap := AsPixmap;
|
|
Result := QIcon_create();
|
|
if Result <> nil then
|
|
QIcon_addPixmap(Result, APixmap, AMode, AState);
|
|
QPixmap_destroy(APixmap);
|
|
end;
|
|
|
|
function TQtImage.AsPixmap(flags: QtImageConversionFlags = QtAutoColor): QPixmapH;
|
|
begin
|
|
Result := QPixmap_create();
|
|
QPixmap_fromImage(Result, FHandle, flags);
|
|
end;
|
|
|
|
function TQtImage.AsBitmap(flags: QtImageConversionFlags = QtAutoColor): QBitmapH;
|
|
begin
|
|
Result := QBitmap_create();
|
|
QBitmap_fromImage(Result, FHandle, flags);
|
|
end;
|
|
|
|
procedure TQtImage.CopyFrom(AImage: QImageH; x, y, w, h: integer);
|
|
begin
|
|
QImage_copy(AImage, FHandle, x, y, w, h);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.height
|
|
Params: None
|
|
Returns: The height of the image
|
|
------------------------------------------------------------------------------}
|
|
function TQtImage.height: Integer;
|
|
begin
|
|
Result := QImage_height(FHandle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.width
|
|
Params: None
|
|
Returns: The width of the image
|
|
------------------------------------------------------------------------------}
|
|
function TQtImage.width: Integer;
|
|
begin
|
|
Result := QImage_width(FHandle);
|
|
end;
|
|
|
|
function TQtImage.depth: Integer;
|
|
begin
|
|
Result := QImage_depth(FHandle);
|
|
end;
|
|
|
|
function TQtImage.dotsPerMeterX: Integer;
|
|
begin
|
|
Result := QImage_dotsPerMeterX(FHandle);
|
|
end;
|
|
|
|
function TQtImage.dotsPerMeterY: Integer;
|
|
begin
|
|
Result := QImage_dotsPerMeterY(FHandle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.bits
|
|
Params: None
|
|
Returns: The internal array of bits of the image
|
|
------------------------------------------------------------------------------}
|
|
function TQtImage.bits: PByte;
|
|
begin
|
|
Result := QImage_bits(FHandle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TQtImage.numBytes
|
|
Params: None
|
|
Returns: The number of bytes the image occupies in memory
|
|
------------------------------------------------------------------------------}
|
|
function TQtImage.numBytes: Integer;
|
|
begin
|
|
Result := QImage_numBytes(FHandle);
|
|
end;
|
|
|
|
function TQtImage.bytesPerLine: Integer;
|
|
begin
|
|
Result := QImage_bytesPerLine(FHandle);
|
|
end;
|
|
|
|
procedure TQtImage.invertPixels(InvertMode: QImageInvertMode = QImageInvertRgb);
|
|
begin
|
|
QImage_invertPixels(FHandle, InvertMode);
|
|
end;
|
|
|
|
function TQtImage.getFormat: QImageFormat;
|
|
begin
|
|
Result := QImage_format(FHandle);
|
|
end;
|
|
|
|
{ TQtFont }
|
|
|
|
function TQtFont.GetMetrics: TQtFontMetrics;
|
|
begin
|
|
if FMetrics = nil then
|
|
begin
|
|
if FHandle = nil then
|
|
FMetrics := TQtFontMetrics.Create(getDefaultFont)
|
|
else
|
|
FMetrics := TQtFontMetrics.Create(FHandle);
|
|
end;
|
|
Result := FMetrics;
|
|
end;
|
|
|
|
function TQtFont.GetFontInfo: TQtFontInfo;
|
|
begin
|
|
if not Assigned(FFontInfo) and Assigned(FHandle) then
|
|
FFontInfo := TQtFontInfo.Create(FHandle);
|
|
Result := FFontInfo;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtFont.GetDefaultFont
|
|
Params: None
|
|
Returns: QFontH
|
|
If our Widget is nil then we have to ask for default application font.
|
|
------------------------------------------------------------------------------}
|
|
function TQtFont.GetDefaultFont: QFontH;
|
|
begin
|
|
if FDefaultFont = nil then
|
|
begin
|
|
FDefaultFont := QFont_create();
|
|
QApplication_font(FDefaultFont);
|
|
end;
|
|
Result := FDefaultFont;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtFont.Create
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtFont.Create(CreateHandle: Boolean);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtFont.Create CreateHandle: ', dbgs(CreateHandle));
|
|
{$endif}
|
|
|
|
if CreateHandle then
|
|
FHandle := QFont_create
|
|
else
|
|
FHandle := nil;
|
|
|
|
FShared := False;
|
|
FMetrics := nil;
|
|
FDefaultFont := nil;
|
|
FFontInfo := nil;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
constructor TQtFont.Create(AFromFont: QFontH);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtFont.Create AFromFont: ', dbgs(AFromFont));
|
|
{$endif}
|
|
|
|
FHandle := QFont_create(AFromFont);
|
|
FShared := False;
|
|
FMetrics := nil;
|
|
FDefaultFont := nil;
|
|
GetFontInfo;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtFont.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtFont.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtFont.Destroy');
|
|
{$endif}
|
|
|
|
QtGDIObjects.RemoveGDIObject(Self);
|
|
|
|
if FMetrics <> nil then
|
|
FMetrics.Free;
|
|
|
|
if FFontInfo <> nil then
|
|
FFontInfo.Free;
|
|
|
|
if not FShared and (FHandle <> nil) then
|
|
QFont_destroy(FHandle);
|
|
|
|
if FDefaultFont <> nil then
|
|
QFont_destroy(FDefaultFont);
|
|
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtFont.getPointSize: Integer;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_pointSize(getDefaultFont)
|
|
else
|
|
Result := QFont_pointSize(FHandle);
|
|
end;
|
|
|
|
procedure TQtFont.setPointSize(p1: Integer);
|
|
begin
|
|
if p1 > 0 then
|
|
QFont_setPointSize(FHandle, p1);
|
|
end;
|
|
|
|
function TQtFont.getPixelSize: Integer;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_pixelSize(getDefaultFont)
|
|
else
|
|
Result := QFont_pixelSize(FHandle);
|
|
end;
|
|
|
|
procedure TQtFont.setPixelSize(p1: Integer);
|
|
begin
|
|
if p1 > 0 then
|
|
QFont_setPixelSize(FHandle, p1);
|
|
end;
|
|
|
|
function TQtFont.getWeight: Integer;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_weight(getDefaultFont)
|
|
else
|
|
Result := QFont_weight(FHandle);
|
|
end;
|
|
|
|
function TQtFont.getItalic: Boolean;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_italic(getDefaultFont)
|
|
else
|
|
Result := QFont_italic(FHandle);
|
|
end;
|
|
|
|
function TQtFont.getBold: Boolean;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_bold(getDefaultFont)
|
|
else
|
|
Result := QFont_bold(FHandle);
|
|
end;
|
|
|
|
function TQtFont.getUnderline: Boolean;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_underline(getDefaultFont)
|
|
else
|
|
Result := QFont_underline(FHandle);
|
|
end;
|
|
|
|
function TQtFont.getStrikeOut: Boolean;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_strikeOut(getDefaultFont)
|
|
else
|
|
Result := QFont_strikeOut(FHandle);
|
|
end;
|
|
|
|
function TQtFont.getFamily: WideString;
|
|
begin
|
|
if FHandle = nil then
|
|
QFont_family(getDefaultFont, @Result)
|
|
else
|
|
QFont_family(FHandle, @Result);
|
|
end;
|
|
|
|
function TQtFont.getStyleStategy: QFontStyleStrategy;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_styleStrategy(getDefaultFont)
|
|
else
|
|
Result := QFont_styleStrategy(FHandle);
|
|
end;
|
|
|
|
procedure TQtFont.setWeight(p1: Integer);
|
|
begin
|
|
QFont_setWeight(FHandle, p1);
|
|
end;
|
|
|
|
procedure TQtFont.setBold(p1: Boolean);
|
|
begin
|
|
QFont_setBold(FHandle, p1);
|
|
end;
|
|
|
|
procedure TQtFont.setItalic(b: Boolean);
|
|
begin
|
|
QFont_setItalic(FHandle, b);
|
|
end;
|
|
|
|
procedure TQtFont.setUnderline(p1: Boolean);
|
|
begin
|
|
QFont_setUnderline(FHandle, p1);
|
|
end;
|
|
|
|
procedure TQtFont.setStrikeOut(p1: Boolean);
|
|
begin
|
|
QFont_setStrikeOut(FHandle, p1);
|
|
end;
|
|
|
|
procedure TQtFont.setRawName(p1: string);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(p1);
|
|
|
|
QFont_setRawName(FHandle, @Str);
|
|
end;
|
|
|
|
procedure TQtFont.setFamily(p1: string);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(p1);
|
|
|
|
QFont_setFamily(FHandle, @Str);
|
|
end;
|
|
|
|
procedure TQtFont.setStyleStrategy(s: QFontStyleStrategy);
|
|
begin
|
|
QFont_setStyleStrategy(FHandle, s);
|
|
end;
|
|
|
|
procedure TQtFont.family(retval: PWideString);
|
|
begin
|
|
if FHandle = nil then
|
|
QFont_family(getDefaultFont, retval)
|
|
else
|
|
QFont_family(FHandle, retval);
|
|
end;
|
|
|
|
function TQtFont.fixedPitch: Boolean;
|
|
begin
|
|
if FHandle = nil then
|
|
Result := QFont_fixedPitch(getDefaultFont)
|
|
else
|
|
Result := QFont_fixedPitch(FHandle);
|
|
end;
|
|
|
|
{ TQtFontMetrics }
|
|
|
|
constructor TQtFontMetrics.Create(Parent: QFontH);
|
|
begin
|
|
FHandle := QFontMetrics_create(Parent);
|
|
end;
|
|
|
|
destructor TQtFontMetrics.Destroy;
|
|
begin
|
|
QFontMetrics_destroy(FHandle);
|
|
FHandle := nil;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtFontMetrics.height: Integer;
|
|
begin
|
|
Result := QFontMetrics_height(FHandle);
|
|
end;
|
|
|
|
function TQtFontMetrics.width(p1: PWideString): Integer;
|
|
begin
|
|
Result := QFontMetrics_width(FHandle, p1);
|
|
end;
|
|
|
|
function TQtFontMetrics.width(p1: PWideString; ALen: Integer): Integer;
|
|
begin
|
|
Result := QFontMetrics_width(FHandle, p1, ALen);
|
|
end;
|
|
|
|
function TQtFontMetrics.ascent: Integer;
|
|
begin
|
|
Result := QFontMetrics_ascent(FHandle);
|
|
end;
|
|
|
|
function TQtFontMetrics.descent: Integer;
|
|
begin
|
|
Result := QFontMetrics_descent(FHandle);
|
|
end;
|
|
|
|
function TQtFontMetrics.leading: Integer;
|
|
begin
|
|
Result := QFontMetrics_leading(FHandle);
|
|
end;
|
|
|
|
function TQtFontMetrics.maxWidth: Integer;
|
|
begin
|
|
Result := QFontMetrics_maxWidth(FHandle);
|
|
end;
|
|
|
|
procedure TQtFontMetrics.boundingRect(retval: PRect; r: PRect; flags: Integer; text: PWideString; tabstops: Integer = 0; tabarray: PInteger = nil);
|
|
begin
|
|
QFontMetrics_boundingRect(FHandle, retval, r, flags, text, tabstops, tabarray);
|
|
end;
|
|
|
|
function TQtFontMetrics.charWidth(str: WideString; pos: Integer): Integer;
|
|
begin
|
|
Result := QFontMetrics_charWidth(FHandle, @str, pos);
|
|
end;
|
|
|
|
function TQtFontMetrics.averageCharWidth: Integer;
|
|
begin
|
|
Result := QFontMetrics_averageCharWidth(FHandle);
|
|
end;
|
|
|
|
function TQtFontMetrics.elidedText(const AText: WideString;
|
|
const AMode: QtTextElideMode; const AWidth: Integer;
|
|
const AFlags: Integer = 0): WideString;
|
|
begin
|
|
QFontMetrics_elidedText(FHandle, @Result, @AText, AMode, AWidth, AFlags);
|
|
end;
|
|
|
|
{ TQtBrush }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtBrush.Create
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtBrush.Create(CreateHandle: Boolean);
|
|
begin
|
|
// Creates the widget
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtBrush.Create CreateHandle: ', dbgs(CreateHandle));
|
|
{$endif}
|
|
|
|
if CreateHandle then
|
|
FHandle := QBrush_create
|
|
else
|
|
FHandle := nil;
|
|
|
|
FShared := False;
|
|
FSelected := False;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtBrush.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtBrush.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtBrush.Destroy');
|
|
{$endif}
|
|
|
|
QtGDIObjects.RemoveGDIObject(Self);
|
|
|
|
if not FShared and (FHandle <> nil) and not FSelected then
|
|
QBrush_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtBrush.getColor: PQColor;
|
|
begin
|
|
Result := QBrush_Color(FHandle);
|
|
end;
|
|
|
|
function TQtBrush.GetLBStyle(out AStyle: LongWord; out AHatch: PtrUInt
|
|
): Boolean;
|
|
begin
|
|
Result := FHandle <> nil;
|
|
if not Result then
|
|
exit;
|
|
|
|
AStyle := BS_SOLID;
|
|
if Style in [QtHorPattern, QtVerPattern, QtCrossPattern,
|
|
QtBDiagPattern, QtFDiagPattern, QtDiagCrossPattern] then
|
|
AStyle := BS_HATCHED
|
|
else
|
|
AHatch := 0;
|
|
case Style of
|
|
QtNoBrush: AStyle := BS_NULL;
|
|
QtHorPattern: AHatch := HS_HORIZONTAL;
|
|
QtVerPattern: AHatch := HS_VERTICAL;
|
|
QtCrossPattern: AHatch := HS_CROSS;
|
|
QtBDiagPattern: AHatch := HS_BDIAGONAL;
|
|
QtFDiagPattern: AHatch := HS_FDIAGONAL;
|
|
QtDiagCrossPattern: AHatch := HS_DIAGCROSS;
|
|
QtTexturePattern: AStyle := BS_PATTERN;
|
|
end;
|
|
end;
|
|
|
|
procedure TQtBrush.setColor(AColor: PQColor);
|
|
begin
|
|
QBrush_setColor(FHandle, AColor);
|
|
end;
|
|
|
|
function TQtBrush.getStyle: QtBrushStyle;
|
|
begin
|
|
Result := QBrush_style(FHandle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtBrush.setStyle
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtBrush.setStyle(style: QtBrushStyle);
|
|
begin
|
|
QBrush_setStyle(FHandle, style);
|
|
end;
|
|
|
|
procedure TQtBrush.setTexture(pixmap: QPixmapH);
|
|
begin
|
|
QBrush_setTexture(FHandle, pixmap);
|
|
end;
|
|
|
|
procedure TQtBrush.setTextureImage(image: QImageH);
|
|
var
|
|
TempImage: QImageH;
|
|
begin
|
|
// workaround thurther deletion of original image
|
|
// When image is deleted its data will be deleted too
|
|
// If image has been created with predefined data then it will be owner of it
|
|
// => it will Free owned data => brush will be invalid
|
|
// as workaround we are copying an original image so qt create new image with own data
|
|
TempImage := QImage_create();
|
|
QImage_copy(image, TempImage, 0, 0, QImage_width(image), QImage_height(image));
|
|
QBrush_setTextureImage(FHandle, TempImage);
|
|
QImage_destroy(TempImage);
|
|
end;
|
|
|
|
{ TQtPen }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtPen.Create
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtPen.Create(CreateHandle: Boolean);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtPen.Create CreateHandle: ', dbgs(CreateHandle));
|
|
{$endif}
|
|
|
|
if CreateHandle then
|
|
FHandle := QPen_create
|
|
else
|
|
FHandle := nil;
|
|
FShared := False;
|
|
FIsExtPen := False;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtPen.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtPen.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtPen.Destroy');
|
|
{$endif}
|
|
|
|
QtGDIObjects.RemoveGDIObject(Self);
|
|
|
|
if not FShared and (FHandle <> nil) then
|
|
QPen_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtPen.getCapStyle: QtPenCapStyle;
|
|
begin
|
|
Result := QPen_capStyle(FHandle);
|
|
end;
|
|
|
|
function TQtPen.getWidth: Integer;
|
|
begin
|
|
Result := QPen_width(FHandle);
|
|
end;
|
|
|
|
function TQtPen.getStyle: QtPenStyle;
|
|
begin
|
|
Result := QPen_style(FHandle);
|
|
end;
|
|
|
|
function TQtPen.getDashPattern: TQRealArray;
|
|
begin
|
|
QPen_dashPattern(FHandle, @Result);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtPen.setBrush
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
|
|
procedure TQtPen.setBrush(brush: QBrushH);
|
|
begin
|
|
QPen_setBrush(FHandle, brush);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtPen.setStyle
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtPen.setStyle(AStyle: QtPenStyle);
|
|
begin
|
|
QPen_setStyle(FHandle, AStyle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtPen.setWidth
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtPen.setWidth(p1: Integer);
|
|
begin
|
|
QPen_setWidth(FHandle, p1);
|
|
end;
|
|
|
|
procedure TQtPen.setDashPattern(APattern: PDWord; ALength: DWord);
|
|
var
|
|
QtPattern: TQRealArray;
|
|
i: integer;
|
|
begin
|
|
SetLength(QtPattern, ALength);
|
|
for i := 0 to ALength - 1 do
|
|
QtPattern[i] := APattern[i];
|
|
QPen_setDashPattern(FHandle, @QtPattern);
|
|
end;
|
|
|
|
procedure TQtPen.setJoinStyle(pcs: QtPenJoinStyle);
|
|
begin
|
|
QPen_setJoinStyle(FHandle, pcs);
|
|
end;
|
|
|
|
function TQtPen.getColor: TQColor;
|
|
begin
|
|
QPen_color(FHandle, @Result);
|
|
end;
|
|
|
|
function TQtPen.getCosmetic: Boolean;
|
|
begin
|
|
Result := QPen_isCosmetic(FHandle);
|
|
end;
|
|
|
|
function TQtPen.getJoinStyle: QtPenJoinStyle;
|
|
begin
|
|
Result := QPen_joinStyle(FHandle);
|
|
end;
|
|
|
|
procedure TQtPen.setCapStyle(pcs: QtPenCapStyle);
|
|
begin
|
|
QPen_setCapStyle(FHandle, pcs);
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtPen.setColor
|
|
Params: p1: TQColor
|
|
Returns: Nothing
|
|
Setting pen color.
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtPen.setColor(p1: TQColor);
|
|
begin
|
|
QPen_setColor(FHandle, @p1);
|
|
end;
|
|
|
|
procedure TQtPen.setCosmetic(b: Boolean);
|
|
begin
|
|
QPen_setCosmetic(FHandle, b);
|
|
end;
|
|
|
|
|
|
{ TQtRegion }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtRegion.Create
|
|
Params: CreateHandle: Boolean
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtRegion.Create(CreateHandle: Boolean);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
|
|
{$endif}
|
|
FPolygon := nil;
|
|
// Creates the widget
|
|
if CreateHandle then
|
|
FHandle := QRegion_create()
|
|
else
|
|
FHandle := nil;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtRegion.Create (CreateRectRgn)
|
|
Params: CreateHandle: Boolean; X1,Y1,X2,Y2:Integer
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtRegion.Create(CreateHandle: Boolean; X1,Y1,X2,Y2:Integer;
|
|
Const RegionType: QRegionRegionType = QRegionRectangle);
|
|
var
|
|
W, H: Integer;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
|
|
{$endif}
|
|
FPolygon := nil;
|
|
// Creates the widget
|
|
// Note that QRegion_create expects a width and a height,
|
|
// and not a X2, Y2 bottom-right point
|
|
if CreateHandle then
|
|
begin
|
|
W := X2 - X1;
|
|
H := Y2 - Y1;
|
|
if W < 0 then
|
|
W := 0;
|
|
if H < 0 then
|
|
H := 0;
|
|
FHandle := QRegion_create(X1, Y1, W, H, RegionType);
|
|
end else
|
|
FHandle := nil;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
constructor TQtRegion.Create(CreateHandle: Boolean; Poly: QPolygonH;
|
|
Const Fill: QtFillRule = QtWindingFill);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtRegion.Create polyrgn CreateHandle: ', dbgs(CreateHandle));
|
|
{$endif}
|
|
FPolygon := nil;
|
|
if CreateHandle then
|
|
begin
|
|
FPolygon := QPolygon_create(Poly);
|
|
FHandle := QRegion_create(FPolygon, Fill);
|
|
end else
|
|
FHandle := nil;
|
|
QtGDIObjects.AddGDIObject(Self);
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtRegion.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtRegion.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtRegion.Destroy');
|
|
{$endif}
|
|
QtGDIObjects.RemoveGDIObject(Self);
|
|
if FPolygon <> nil then
|
|
QPolygon_destroy(FPolygon);
|
|
if FHandle <> nil then
|
|
QRegion_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtRegion.GetIsPolyRegion: Boolean;
|
|
begin
|
|
Result := FPolygon <> nil;
|
|
end;
|
|
|
|
function TQtRegion.containsPoint(X, Y: Integer): Boolean;
|
|
var
|
|
P: TQtPoint;
|
|
begin
|
|
P.X := X;
|
|
P.Y := Y;
|
|
Result := QRegion_contains(FHandle, PQtPoint(@P));
|
|
end;
|
|
|
|
function TQtRegion.containsRect(R: TRect): Boolean;
|
|
begin
|
|
Result := QRegion_contains(FHandle, PRect(@R));
|
|
end;
|
|
|
|
function TQtRegion.intersects(R: TRect): Boolean;
|
|
begin
|
|
Result := QRegion_intersects(FHandle, PRect(@R));
|
|
end;
|
|
|
|
function TQtRegion.intersects(Rgn: QRegionH): Boolean;
|
|
begin
|
|
Result := QRegion_intersects(FHandle, Rgn);
|
|
end;
|
|
|
|
function TQtRegion.GetRegionType: integer;
|
|
begin
|
|
try
|
|
if not IsPolyRegion and QRegion_isEmpty(FHandle) then
|
|
Result := NULLREGION
|
|
else
|
|
begin
|
|
if IsPolyRegion or (QRegion_numRects(FHandle) > 1) then
|
|
Result := COMPLEXREGION
|
|
else
|
|
Result := SIMPLEREGION;
|
|
end;
|
|
except
|
|
Result := ERROR;
|
|
end;
|
|
end;
|
|
|
|
function TQtRegion.getBoundingRect: TRect;
|
|
begin
|
|
if IsPolyRegion then
|
|
QPolygon_boundingRect(FPolygon, @Result)
|
|
else
|
|
QRegion_boundingRect(FHandle, @Result);
|
|
end;
|
|
|
|
function TQtRegion.numRects: Integer;
|
|
begin
|
|
Result := QRegion_numRects(FHandle);
|
|
end;
|
|
|
|
procedure TQtRegion.translate(dx, dy: Integer);
|
|
begin
|
|
QRegion_translate(FHandle, dx, dy);
|
|
end;
|
|
|
|
{ TQtDeviceContext }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.Create
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtDeviceContext.Create(AWidget: QWidgetH; const APaintEvent: Boolean = False);
|
|
var
|
|
W: Integer;
|
|
H: Integer;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtDeviceContext.Create (',
|
|
' WidgetHandle: ', dbghex(PtrInt(AWidget)),
|
|
' FromPaintEvent:',BoolToStr(APaintEvent),' )');
|
|
{$endif}
|
|
|
|
{NOTE FOR QT DEVELOPERS: Whenever you call TQtDeviceContext.Create() outside
|
|
of TQtWidgetSet.BeginPaint() SET APaintEvent TO FALSE !}
|
|
Parent := nil;
|
|
ParentPixmap := nil;
|
|
FMetrics := nil;
|
|
SelFont := nil;
|
|
SelBrush := nil;
|
|
SelPen := nil;
|
|
|
|
if AWidget = nil then
|
|
begin
|
|
ParentPixmap := QPixmap_Create(10, 10);
|
|
Widget := QPainter_Create(QPaintDeviceH(ParentPixmap));
|
|
end else
|
|
begin
|
|
Parent := AWidget;
|
|
if not APaintEvent then
|
|
begin
|
|
{avoid paints on null pixmaps !}
|
|
W := QWidget_width(Parent);
|
|
H := QWidget_height(Parent);
|
|
|
|
if W <= 0 then W := 1;
|
|
if H <= 0 then H := 1;
|
|
|
|
ParentPixmap := QPixmap_Create(W, H);
|
|
Widget := QPainter_create(QPaintDeviceH(ParentPixmap));
|
|
end else
|
|
Widget := QPainter_create(QWidget_to_QPaintDevice(Parent));
|
|
end;
|
|
|
|
FRopMode := R2_COPYPEN;
|
|
FOwnPainter := True;
|
|
CreateObjects;
|
|
FPenPos.X := 0;
|
|
FPenPos.Y := 0;
|
|
end;
|
|
|
|
constructor TQtDeviceContext.CreatePrinterContext(ADevice: QPrinterH);
|
|
begin
|
|
SelFont := nil;
|
|
SelBrush := nil;
|
|
SelPen := nil;
|
|
FMetrics := nil;
|
|
Parent := nil;
|
|
Widget := QPainter_Create(ADevice);
|
|
FRopMode := R2_COPYPEN;
|
|
FOwnPainter := True;
|
|
CreateObjects;
|
|
FPenPos.X := 0;
|
|
FPenPos.Y := 0;
|
|
end;
|
|
|
|
constructor TQtDeviceContext.CreateFromPainter(APainter: QPainterH);
|
|
begin
|
|
SelFont := nil;
|
|
SelBrush := nil;
|
|
SelPen := nil;
|
|
FMetrics := nil;
|
|
FRopMode := R2_COPYPEN;
|
|
Widget := APainter;
|
|
Parent := nil;
|
|
FOwnPainter := False;
|
|
CreateObjects;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtDeviceContext.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtDeviceContext.Destroy');
|
|
{$endif}
|
|
|
|
if (vClipRect <> nil) then
|
|
dispose(vClipRect);
|
|
|
|
if FMetrics <> nil then
|
|
FreeThenNil(FMetrics);
|
|
|
|
DestroyObjects;
|
|
|
|
if (Widget <> nil) and FOwnPainter then
|
|
begin
|
|
QPainter_destroy(Widget);
|
|
Widget := nil;
|
|
end;
|
|
|
|
if ParentPixmap <> nil then
|
|
begin
|
|
QPixmap_destroy(ParentPixmap);
|
|
ParentPixmap := nil;
|
|
end;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtDeviceContext.CreateObjects;
|
|
begin
|
|
FSupportComposition := rocUndefined;
|
|
FSupportRasterOps := rocUndefined;
|
|
|
|
vFont := TQtFont.Create(False);
|
|
vFont.Owner := Self;
|
|
|
|
vBrush := TQtBrush.Create(False);
|
|
vBrush.Owner := Self;
|
|
|
|
vPen := TQtPen.Create(False);
|
|
vPen.Owner := Self;
|
|
|
|
vRegion := TQtRegion.Create(False);
|
|
vRegion.Owner := Self;
|
|
|
|
vBackgroundBrush := TQtBrush.Create(False);
|
|
vBackgroundBrush.Owner := Self;
|
|
|
|
vTextColor := ColorToRGB(clWindowText);
|
|
|
|
vMapMode := MM_TEXT;
|
|
end;
|
|
|
|
procedure TQtDeviceContext.DestroyObjects;
|
|
begin
|
|
// vFont creates widget and copies font into it => we should destroy it
|
|
//vFont.Widget := nil;
|
|
FreeAndNil(vFont);
|
|
//WriteLn('Destroying brush: ', PtrUInt(vBrush), ' ', ClassName, ' ', PtrUInt(Self));
|
|
vBrush.FHandle := nil;
|
|
FreeAndNil(vBrush);
|
|
vPen.FHandle := nil;
|
|
FreeAndNil(vPen);
|
|
if vRegion.FHandle <> nil then
|
|
begin
|
|
QRegion_destroy(vRegion.FHandle);
|
|
vRegion.FHandle := nil;
|
|
end;
|
|
FreeAndNil(vRegion);
|
|
vBackgroundBrush.FHandle := nil;
|
|
FreeAndNil(vBackgroundBrush);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.DebugClipRect
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.DebugClipRect(const msg: string);
|
|
var
|
|
Rgn: QRegionH;
|
|
ok: boolean;
|
|
begin
|
|
ok := getClipping;
|
|
Write(Msg, 'DC: HasClipping=', ok);
|
|
|
|
if Ok then
|
|
begin
|
|
Rgn := QRegion_Create;
|
|
QPainter_ClipRegion(Widget, Rgn);
|
|
DebugRegion('', Rgn);
|
|
QRegion_Destroy(Rgn);
|
|
end
|
|
else
|
|
WriteLn;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.setImage
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
This function will destroy the previous DC handle and generate
|
|
a new one based on an image. This is necessary because when painting
|
|
is being done to a TBitmap, LCL will create a completely abstract DC,
|
|
using GetDC(0), and latter use SelectObject to associate that DC
|
|
with the Image.
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.setImage(AImage: TQtImage);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
writeln('TQtDeviceContext.setImage() ');
|
|
{$endif}
|
|
vImage := AImage;
|
|
|
|
QPainter_destroy(Widget);
|
|
|
|
Widget := QPainter_Create(vImage.FHandle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.CorrectCoordinates
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
If you draw an image with negative coordinates
|
|
(for example x: -50 y: -50 w: 100 h: 100), the result is not well
|
|
defined in Qt, and could well be: (x: 0 y: 0 w: 100 h: 100)
|
|
This method corrects the coordinates, cutting the result, so we draw:
|
|
(x: 0 y: 0 w: 50 h: 50)
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.CorrectCoordinates(var ARect: TRect);
|
|
begin
|
|
if ARect.Left < 0 then ARect.Left := 0;
|
|
|
|
if ARect.Top < 0 then ARect.Top := 0;
|
|
|
|
{ if ARect.Right > MaxRight then ARect.Right := MaxRight;
|
|
|
|
if ARect.Bottom > MaxBottom then ARect.Bottom := MaxBottom;}
|
|
end;
|
|
|
|
function TQtDeviceContext.GetLineLastPixelPos(PrevPos, NewPos: TPoint): TPoint;
|
|
begin
|
|
Result := NewPos;
|
|
|
|
if NewPos.X > PrevPos.X then
|
|
dec(Result.X)
|
|
else
|
|
if NewPos.X < PrevPos.X then
|
|
inc(Result.X);
|
|
|
|
if NewPos.Y > PrevPos.Y then
|
|
dec(Result.Y)
|
|
else
|
|
if NewPos.Y < PrevPos.Y then
|
|
inc(Result.Y);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.qDrawPlainRect(x, y, w, h: integer; AColor: PQColor = nil;
|
|
lineWidth: Integer = 1; FillBrush: QBrushH = nil);
|
|
begin
|
|
if AColor = nil then
|
|
AColor := BackgroundBrush.getColor;
|
|
// stop asserts from qtlib
|
|
if (w < x) or (h < y) then
|
|
exit;
|
|
q_DrawPlainRect(Widget, x, y, w, h, AColor, lineWidth, FillBrush);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.qDrawShadeRect(x, y, w, h: integer; Palette: QPaletteH = nil; Sunken: Boolean = False;
|
|
lineWidth: Integer = 1; midLineWidth: Integer = 0; FillBrush: QBrushH = nil);
|
|
var
|
|
AppPalette: QPaletteH;
|
|
begin
|
|
if (w < 0) or (h < 0) then
|
|
exit;
|
|
AppPalette := nil;
|
|
if Palette = nil then
|
|
begin
|
|
if Parent = nil then
|
|
begin
|
|
AppPalette := QPalette_create();
|
|
QApplication_palette(AppPalette);
|
|
Palette := AppPalette;
|
|
end else
|
|
Palette := QWidget_palette(Parent);
|
|
end;
|
|
q_DrawShadeRect(Widget, x, y, w, h, Palette, Sunken, lineWidth, midLineWidth, FillBrush);
|
|
if AppPalette <> nil then
|
|
begin
|
|
QPalette_destroy(AppPalette);
|
|
Palette := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TQtDeviceContext.qDrawWinPanel(x, y, w, h: integer;
|
|
Palette: QPaletteH; Sunken: Boolean; lineWidth: Integer; FillBrush: QBrushH);
|
|
var
|
|
i: integer;
|
|
AppPalette: QPaletteH;
|
|
begin
|
|
|
|
if (w < 0) or (h < 0) then
|
|
exit;
|
|
|
|
AppPalette := nil;
|
|
if Palette = nil then
|
|
begin
|
|
if Parent = nil then
|
|
begin
|
|
AppPalette := QPalette_create();
|
|
QApplication_palette(AppPalette);
|
|
Palette := AppPalette;
|
|
end else
|
|
Palette := QWidget_palette(Parent);
|
|
end;
|
|
// since q_DrawWinPanel doesnot supports lineWidth we should do it ourself
|
|
for i := 1 to lineWidth - 2 do
|
|
begin
|
|
q_DrawWinPanel(Widget, x, y, w, h, Palette, Sunken);
|
|
inc(x);
|
|
inc(y);
|
|
dec(w, 2);
|
|
dec(h, 2);
|
|
end;
|
|
|
|
if lineWidth > 1 then
|
|
q_DrawWinPanel(Widget, x, y, w, h, Palette, Sunken, FillBrush)
|
|
else
|
|
begin
|
|
if (FillBrush = nil) and Assigned(Parent) and
|
|
QObject_inherits(Parent,'QFrame') then
|
|
q_DrawShadePanel(Widget, x, y, w, h, Palette, Sunken, 1, QPalette_background(Palette))
|
|
else
|
|
q_DrawShadePanel(Widget, x, y, w, h, Palette, Sunken, 1, FillBrush);
|
|
end;
|
|
|
|
|
|
if AppPalette <> nil then
|
|
begin
|
|
QPalette_destroy(AppPalette);
|
|
Palette := nil;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.CreateDCData
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.CreateDCData: PQtDCDATA;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
writeln('TQtDeviceContext.CreateDCData() ');
|
|
{$endif}
|
|
QPainter_save(Widget);
|
|
Result := nil; // doesn't matter;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.RestoreDCData
|
|
Params: DCData, dummy in current implementation
|
|
Returns: true if QPainter state was successfuly restored
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.RestoreDCData(var DCData: PQtDCData):boolean;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
writeln('TQtDeviceContext.RestoreDCData() ');
|
|
{$endif}
|
|
QPainter_restore(Widget);
|
|
Result := True;
|
|
end;
|
|
|
|
function TQtDeviceContext.DeviceSupportsComposition: Boolean;
|
|
var
|
|
Engine: QPaintEngineH;
|
|
AType: QPaintEngineType;
|
|
begin
|
|
|
|
Result := (Widget <> nil) and QPainter_isActive(Widget);
|
|
|
|
if not Result then
|
|
exit;
|
|
|
|
Result := FSupportComposition = rocSupported;
|
|
|
|
if (FSupportComposition <> rocUndefined) then
|
|
exit;
|
|
|
|
Engine := QPainter_paintEngine(Widget);
|
|
|
|
if Engine <> nil then
|
|
begin
|
|
AType := QPaintEngine_type(Engine);
|
|
Result := not (AType in
|
|
[QPaintEngineX11, QPaintEngineWindows,
|
|
QPaintEngineQuickDraw, QPaintEngineCoreGraphics,
|
|
QPaintEngineQWindowSystem]);
|
|
|
|
FSupportComposition := Rop2CompSupported[Result];
|
|
end;
|
|
end;
|
|
|
|
function TQtDeviceContext.DeviceSupportsRasterOps: Boolean;
|
|
var
|
|
Engine: QPaintEngineH;
|
|
AType: QPaintEngineType;
|
|
begin
|
|
|
|
Result := (Widget <> nil) and QPainter_isActive(Widget);
|
|
|
|
if not Result then
|
|
exit;
|
|
|
|
Result := FSupportRasterOps = rocSupported;
|
|
|
|
if (FSupportRasterOps <> rocUndefined) then
|
|
exit;
|
|
|
|
Engine := QPainter_paintEngine(Widget);
|
|
if Engine <> nil then
|
|
begin
|
|
AType := QPaintEngine_type(Engine);
|
|
Result := not (AType in
|
|
[QPaintEngineQuickDraw, QPaintEngineCoreGraphics,
|
|
QPaintEngineQWindowSystem]);
|
|
|
|
FSupportRasterOps := Rop2CompSupported[Result];
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.R2ToQtRasterOp
|
|
Params: Raster ops binary operator
|
|
Returns: QPainterCompositionMode
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.R2ToQtRasterOp(AValue: Integer): QPainterCompositionMode;
|
|
begin
|
|
Result := QPainterCompositionMode_SourceOver;
|
|
|
|
if not DeviceSupportsRasterOps then
|
|
exit;
|
|
(*
|
|
IMPLEMENTED = +
|
|
NOT IMPLEMENTED = -
|
|
NOT SURE HOWTO IMPLEMENT = ?
|
|
+SRCCOPY = $00CC0020; { dest = source }
|
|
+SRCPAINT = $00EE0086; { dest = source OR dest }
|
|
+SRCAND = $008800C6; { dest = source AND dest }
|
|
+SRCINVERT = $00660046; { dest = source XOR dest }
|
|
+SRCERASE = $00440328; { dest = source AND (NOT dest ) }
|
|
+NOTSRCCOPY = $00330008; { dest = (NOT source) }
|
|
+NOTSRCERASE = $001100A6; { dest = (NOT src) AND (NOT dest) }
|
|
-MERGECOPY = $00C000CA; { dest = (source AND pattern) }
|
|
+MERGEPAINT = $00BB0226; { dest = (NOT source) OR dest }
|
|
-PATCOPY = $00F00021; { dest = pattern }
|
|
-PATPAINT = $00FB0A09; { dest = DPSnoo }
|
|
-PATINVERT = $005A0049; { dest = pattern XOR dest }
|
|
+DSTINVERT = $00550009; { dest = (NOT dest) }
|
|
?BLACKNESS = $00000042; { dest = BLACK }
|
|
?WHITENESS = $00FF0062; { dest = WHITE }
|
|
*)
|
|
|
|
case AValue of
|
|
BLACKNESS,
|
|
R2_BLACK: if DeviceSupportsComposition then
|
|
Result := QPainterCompositionMode_Clear;
|
|
|
|
SRCCOPY,
|
|
R2_COPYPEN: Result := QPainterCompositionMode_SourceOver; // default
|
|
|
|
MERGEPAINT,
|
|
R2_MASKNOTPEN: Result := QPainterRasterOp_NotSourceAndDestination;
|
|
|
|
SRCAND,
|
|
R2_MASKPEN: Result := QPainterRasterOp_SourceAndDestination;
|
|
|
|
SRCERASE,
|
|
R2_MASKPENNOT: Result := QPainterRasterOp_SourceAndNotDestination;
|
|
|
|
R2_MERGENOTPEN: Result := QPainterCompositionMode_SourceOver; // unsupported
|
|
|
|
SRCPAINT,
|
|
R2_MERGEPEN: Result := QPainterRasterOp_SourceOrDestination;
|
|
|
|
R2_MERGEPENNOT: Result := QPainterCompositionMode_SourceOver; // unsupported
|
|
|
|
R2_NOP: if DeviceSupportsComposition then
|
|
Result := QPainterCompositionMode_Destination;
|
|
R2_NOT: if DeviceSupportsComposition then
|
|
Result := QPainterCompositionMode_SourceOut; // unsupported
|
|
|
|
NOTSRCCOPY,
|
|
R2_NOTCOPYPEN: Result := QPainterRasterOp_NotSource;
|
|
|
|
PATPAINT,
|
|
R2_NOTMASKPEN: Result := QPainterRasterOp_NotSourceOrNotDestination;
|
|
|
|
NOTSRCERASE,
|
|
R2_NOTMERGEPEN: Result := QPainterRasterOp_NotSourceAndNotDestination;
|
|
|
|
DSTINVERT,
|
|
R2_NOTXORPEN: Result := QPainterRasterOp_NotSourceXorDestination;
|
|
|
|
WHITENESS,
|
|
R2_WHITE: if DeviceSupportsComposition then
|
|
Result := QPainterCompositionMode_Screen;
|
|
SRCINVERT,
|
|
R2_XORPEN: Result := QPainterRasterOp_SourceXorDestination;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.RestorePenColor
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.RestorePenColor;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
writeln('TQtDeviceContext.RestorePenColor() ');
|
|
{$endif}
|
|
QPainter_setPen(Widget, @PenColor);
|
|
end;
|
|
|
|
function TQtDeviceContext.GetRop: Integer;
|
|
begin
|
|
Result := FRopMode;
|
|
end;
|
|
|
|
function TQtDeviceContext.GetMetrics: TQtFontMetrics;
|
|
begin
|
|
Result := Font.Metrics;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.RestoreTextColor
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.RestoreTextColor;
|
|
var
|
|
CurPen: QPenH;
|
|
TxtColor: TQColor;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
writeln('TQtDeviceContext.RestoreTextColor() ');
|
|
{$endif}
|
|
CurPen := QPainter_Pen(Widget);
|
|
QPen_color(CurPen, @PenColor);
|
|
TxtColor := PenColor;
|
|
ColorRefToTQColor(vTextColor, TxtColor);
|
|
QPainter_setPen(Widget, @txtColor);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.SetRop(const AValue: Integer);
|
|
var
|
|
QtROPMode: QPainterCompositionMode;
|
|
begin
|
|
FRopMode := AValue;
|
|
QtRopMode := R2ToQtRasterOp(AValue);
|
|
if QPainter_compositionMode(Widget) <> QtRopMode then
|
|
QPainter_setCompositionMode(Widget, QtROPMode);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.drawRect
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Draws a rectangle. Helper function of winapi.Rectangle
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawRect(x1: Integer; y1: Integer; w: Integer;
|
|
h: Integer; const AQtBugWorkaroundNeeded: Boolean);
|
|
var
|
|
PW: Double;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
writeln('TQtDeviceContext.drawRect() x1: ',x1,' y1: ',y1,' w: ',w,' h: ',h);
|
|
{$endif}
|
|
{Workaround for Qt bug
|
|
https://bugreports.qt-project.org/browse/QTBUG-34303
|
|
related lazarus issue http://bugs.freepascal.org/view.php?id=25227
|
|
}
|
|
if AQtBugWorkaroundNeeded then
|
|
begin
|
|
PW := QPen_widthF(QPainter_pen(Widget));
|
|
QPen_setWidthF(QPainter_pen(Widget), 1.00001);
|
|
end;
|
|
QPainter_drawRect(Widget, x1, y1, w, h);
|
|
if AQtBugWorkaroundNeeded then
|
|
QPen_setWidthF(QPainter_pen(Widget), PW);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.drawRoundRect(x, y, w, h, rx, ry: Integer);
|
|
begin
|
|
QPainter_drawRoundedRect(Widget, x, y, w, h, rx, ry);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.drawText
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Draws a Text. Helper function of winapi.TextOut
|
|
|
|
Qt does not draw the text starting at Y position and downwards, like LCL.
|
|
|
|
Instead, Y becomes the baseline for the text and it's drawn upwards.
|
|
|
|
To get a correct behavior we need to sum the text's height to the Y coordinate.
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawText(x: Integer; y: Integer; s: PWideString);
|
|
{$IFDEF DARWIN}
|
|
var
|
|
OldBkMode: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.drawText TargetX: ', X, ' TargetY: ', Y);
|
|
{$endif}
|
|
|
|
// First translate and then rotate, that makes the
|
|
// correct rotation effect that we want
|
|
if Font.Angle <> 0 then
|
|
begin
|
|
Translate(x, y);
|
|
Rotate(-0.1 * Font.Angle);
|
|
end;
|
|
|
|
// what about Metrics.descent and Metrics.leading ?
|
|
y := y + Metrics.ascent;
|
|
|
|
RestoreTextColor;
|
|
|
|
// The ascent is only applied here, because it also needs
|
|
// to be rotated
|
|
{$IFDEF DARWIN}
|
|
OldBkMode := SetBkMode(TRANSPARENT);
|
|
{$ENDIF}
|
|
if Font.Angle <> 0 then
|
|
QPainter_drawText(Widget, 0, Metrics.ascent, s)
|
|
else
|
|
QPainter_drawText(Widget, x, y, s);
|
|
{$IFDEF DARWIN}
|
|
SetBkMode(OldBkMode);
|
|
{$ENDIF}
|
|
|
|
RestorePenColor;
|
|
|
|
// Restore previous angle
|
|
if Font.Angle <> 0 then
|
|
begin
|
|
y := y - Metrics.ascent;
|
|
Rotate(0.1 * Font.Angle);
|
|
Translate(-x, -y);
|
|
end;
|
|
|
|
{$ifdef VerboseQt}
|
|
WriteLn(' Font metrics height: ', Metrics.height, ' Angle: ',
|
|
Round(0.1 * Font.Angle));
|
|
{$endif}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.DrawText
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawText(x, y, w, h, flags: Integer; s: PWideString);
|
|
{$IFDEF DARWIN}
|
|
var
|
|
OldBkMode: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.drawText x: ', X, ' Y: ', Y,' w: ',w,' h: ',h);
|
|
{$endif}
|
|
|
|
// First translate and then rotate, that makes the
|
|
// correct rotation effect that we want
|
|
if Font.Angle <> 0 then
|
|
begin
|
|
Translate(x, y);
|
|
Rotate(-0.1 * Font.Angle);
|
|
end;
|
|
|
|
RestoreTextColor;
|
|
{$IFDEF DARWIN}
|
|
OldBkMode := SetBkMode(TRANSPARENT);
|
|
{$ENDIF}
|
|
if Font.Angle <> 0 then
|
|
QPainter_DrawText(Widget, 0, 0, w, h, Flags, s)
|
|
else
|
|
QPainter_DrawText(Widget, x, y, w, h, Flags, s);
|
|
{$IFDEF DARWIN}
|
|
SetBkMode(OldBkMode);
|
|
{$ENDIF}
|
|
RestorePenColor;
|
|
|
|
// Restore previous angle
|
|
if Font.Angle <> 0 then
|
|
begin
|
|
Rotate(0.1 * Font.Angle);
|
|
Translate(-x, -y);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.drawLine
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Draws a Text. Helper function for winapi.LineTo
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawLine(x1: Integer; y1: Integer; x2: Integer; y2: Integer);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.drawLine x1: ', X1, ' Y1: ', Y1,' x2: ',x2,' y2: ',y2);
|
|
{$endif}
|
|
QPainter_drawLine(Widget, x1, y1, x2, y2);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.drawEllipse
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Draws a ellipse. Helper function for winapi.Ellipse
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawEllipse(x: Integer; y: Integer; w: Integer; h: Integer);
|
|
begin
|
|
QPainter_drawEllipse(Widget, x, y, w, h);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.drawPixmap(p: PQtPoint; pm: QPixmapH; sr: PRect);
|
|
begin
|
|
QPainter_drawPixmap(Widget, p, pm, sr);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.drawPolyLine(P: PPoint; NumPts: Integer);
|
|
var
|
|
QtPoints: PQtPoint;
|
|
i: integer;
|
|
LastPoint: TPoint;
|
|
begin
|
|
GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
|
|
for i := 0 to NumPts - 2 do
|
|
QtPoints[i] := QtPoint(P[i].x, P[i].y);
|
|
|
|
LastPoint := P[NumPts - 1];
|
|
if NumPts > 1 then
|
|
LastPoint := GetLineLastPixelPos(P[NumPts - 2], LastPoint);
|
|
QtPoints[NumPts - 1] := QtPoint(LastPoint.X, LastPoint.Y);
|
|
|
|
QPainter_drawPolyline(Widget, QtPoints, NumPts);
|
|
FreeMem(QtPoints);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.drawPolygon(P: PPoint; NumPts: Integer;
|
|
FillRule: QtFillRule);
|
|
var
|
|
QtPoints: PQtPoint;
|
|
i: integer;
|
|
LastPoint: TPoint;
|
|
begin
|
|
GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
|
|
for i := 0 to NumPts - 2 do
|
|
QtPoints[i] := QtPoint(P[i].x, P[i].y);
|
|
|
|
LastPoint := P[NumPts - 1];
|
|
if NumPts > 1 then
|
|
LastPoint := GetLineLastPixelPos(P[NumPts - 2], LastPoint);
|
|
QtPoints[NumPts - 1] := QtPoint(LastPoint.X, LastPoint.Y);
|
|
|
|
QPainter_drawPolygon(Widget, QtPoints, NumPts, FillRule);
|
|
FreeMem(QtPoints);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.eraseRect(ARect: PRect);
|
|
begin
|
|
QPainter_eraseRect(Widget, ARect);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.fillRect(ARect: PRect; ABrush: QBrushH);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.fillRect() from PRect');
|
|
{$endif}
|
|
QPainter_fillRect(Widget, ARect, ABrush);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.fillRect(x, y, w, h: Integer; ABrush: QBrushH);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.fillRect() x: ',x,' y: ',y,' w: ',w,' h: ',h);
|
|
{$endif}
|
|
QPainter_fillRect(Widget, x, y, w, h, ABrush);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.fillRect(x, y, w, h: Integer);
|
|
begin
|
|
fillRect(x, y, w, h, BackgroundBrush.FHandle);
|
|
end;
|
|
|
|
function TQtDeviceContext.getBKMode: Integer;
|
|
begin
|
|
if QPainter_BackgroundMode(Widget) = QtOpaqueMode then
|
|
Result := OPAQUE
|
|
else
|
|
Result := TRANSPARENT;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.drawPoint
|
|
Params: x1,y1 : Integer
|
|
Returns: Nothing
|
|
|
|
Draws a point. Helper function of winapi. DrawFocusRect
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawPoint(x1: Integer; y1: Integer);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.drawPoint() x1: ',x1,' y1: ',y1);
|
|
{$endif}
|
|
QPainter_drawPoint(Widget, x1, y1);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.setBrushOrigin
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.setBrushOrigin(x, y: Integer);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setBrushOrigin() x: ',x,' y: ',y);
|
|
{$endif}
|
|
QPainter_setBrushOrigin(Widget, x, y);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.brushOrigin
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.getBrushOrigin(retval: PPoint);
|
|
var
|
|
QtPoint: TQtPoint;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.brushOrigin() ');
|
|
{$endif}
|
|
|
|
QPainter_brushOrigin(Widget, @QtPoint);
|
|
retval^.x := QtPoint.x;
|
|
retval^.y := QtPoint.y;
|
|
end;
|
|
|
|
function TQtDeviceContext.getClipping: Boolean;
|
|
begin
|
|
Result := QPainter_hasClipping(Widget);
|
|
end;
|
|
|
|
function TQtDeviceContext.getCompositionMode: QPainterCompositionMode;
|
|
begin
|
|
Result := QPainter_compositionMode(Widget);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.getPenPos(retval: PPoint);
|
|
begin
|
|
retval^.x := FPenPos.x;
|
|
retval^.y := FPenPos.y;
|
|
end;
|
|
|
|
function TQtDeviceContext.getWorldTransform: QTransformH;
|
|
begin
|
|
Result := QPainter_worldTransform(Widget);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.setPenPos(x, y: Integer);
|
|
begin
|
|
FPenPos.X := x;
|
|
FPenPos.Y := y;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.font
|
|
Params: None
|
|
Returns: The current font object of the DC
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.font: TQtFont;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.font()');
|
|
{$endif}
|
|
|
|
if SelFont = nil then
|
|
begin
|
|
if vFont <> nil then
|
|
begin
|
|
if vFont.FHandle <> nil then
|
|
begin
|
|
QFont_destroy(vFont.FHandle);
|
|
vFont.FHandle := nil;
|
|
end;
|
|
end;
|
|
Result := vFont;
|
|
end
|
|
else
|
|
Result := SelFont;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.setFont
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.setFont(AFont: TQtFont);
|
|
var
|
|
QFnt: QFontH;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setFont() ');
|
|
{$endif}
|
|
SelFont := AFont;
|
|
if (AFont.FHandle <> nil) and (Widget <> nil) then
|
|
begin
|
|
QFnt := QPainter_font(Widget);
|
|
AssignQtFont(AFont.FHandle, QFnt);
|
|
vFont.Angle := AFont.Angle;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.brush
|
|
Params: None
|
|
Returns: The current brush object of the DC
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.brush: TQtBrush;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.brush() ');
|
|
{$endif}
|
|
|
|
if vBrush <> nil then
|
|
vBrush.FHandle := QPainter_brush(Widget);
|
|
|
|
if SelBrush = nil then
|
|
Result := vBrush
|
|
else
|
|
Result := SelBrush;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.setBrush
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.setBrush(ABrush: TQtBrush);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setBrush() ');
|
|
{$endif}
|
|
if SelBrush <> nil then
|
|
SelBrush.FSelected := False;
|
|
SelBrush := ABrush;
|
|
if SelBrush <> nil then
|
|
SelBrush.FSelected := True;
|
|
|
|
if (ABrush.FHandle <> nil) and (Widget <> nil) then
|
|
QPainter_setBrush(Widget, ABrush.FHandle);
|
|
end;
|
|
|
|
function TQtDeviceContext.BackgroundBrush: TQtBrush;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.backgroundBrush() ');
|
|
{$endif}
|
|
vBackgroundBrush.FHandle := QPainter_background(Widget);
|
|
result := vBackGroundBrush;
|
|
end;
|
|
|
|
function TQtDeviceContext.GetBkColor: TColorRef;
|
|
var
|
|
TheBrush: QBrushH;
|
|
TheColor: TQColor;
|
|
begin
|
|
TheBrush := QPainter_background(Widget);
|
|
TheColor := QBrush_color(TheBrush)^;
|
|
TQColorToColorRef(TheColor, Result);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.pen
|
|
Params: None
|
|
Returns: The current pen object of the DC
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.pen: TQtPen;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.pen() ');
|
|
{$endif}
|
|
|
|
if vPen <> nil then
|
|
vPen.FHandle := QPainter_pen(Widget);
|
|
|
|
if SelPen = nil then
|
|
Result := vPen
|
|
else
|
|
Result := SelPen;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.setPen
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.setPen(APen: TQtPen): TQtPen;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setPen() ');
|
|
{$endif}
|
|
Result := pen;
|
|
SelPen := APen;
|
|
if (APen <> nil) and (APen.FHandle <> nil) and (Widget <> nil) then
|
|
QPainter_setPen(Widget, APen.FHandle);
|
|
end;
|
|
|
|
procedure TQColorToColorRef(const AColor: TQColor; out AColorRef: TColorRef);
|
|
begin
|
|
AColorRef := ((AColor.r shr 8) and $FF) or
|
|
(AColor.g and $FF00) or
|
|
((AColor.b shl 8) and $FF0000);
|
|
end;
|
|
|
|
procedure ColorRefToTQColor(const AColorRef: TColorRef; var AColor:TQColor);
|
|
begin
|
|
QColor_fromRgb(@AColor, Red(AColorRef),Green(AColorRef),Blue(AColorRef));
|
|
end;
|
|
|
|
function EqualTQColor(const Color1, Color2: TQColor): Boolean;
|
|
begin
|
|
Result := (Color1.r = Color2.r) and
|
|
(Color1.g = Color2.g) and
|
|
(Color1.b = Color2.b);
|
|
end;
|
|
|
|
procedure DebugRegion(const msg: string; Rgn: QRegionH);
|
|
var
|
|
R: TRect;
|
|
ok: boolean;
|
|
begin
|
|
Write(Msg);
|
|
ok := QRegion_isEmpty(Rgn);
|
|
QRegion_BoundingRect(Rgn, @R);
|
|
WriteLn(' Empty=',Ok,' Rect=', dbgs(R));
|
|
end;
|
|
|
|
function QtDefaultPrinter: TQtPrinter;
|
|
begin
|
|
if FPrinter = nil then
|
|
FPrinter := TQtPrinter.Create;
|
|
Result := FPrinter;
|
|
end;
|
|
|
|
function Clipboard: TQtClipboard;
|
|
begin
|
|
if FClipboard = nil then
|
|
FClipboard := TQtClipboard.Create;
|
|
Result := FClipboard;
|
|
end;
|
|
|
|
function TQtDeviceContext.SetBkColor(Color: TColorRef): TColorRef;
|
|
var
|
|
NColor: TQColor;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setBKColor() ');
|
|
{$endif}
|
|
Result := GetBkColor;
|
|
ColorRefToTQColor(ColorToRGB(TColor(Color)), NColor);
|
|
BackgroundBrush.setColor(@NColor);
|
|
end;
|
|
|
|
function TQtDeviceContext.SetBkMode(BkMode: Integer): Integer;
|
|
var
|
|
Mode: QtBGMode;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setBKMode() ');
|
|
{$endif}
|
|
Result := 0;
|
|
if Widget <> nil then
|
|
begin
|
|
Mode := QPainter_BackgroundMode(Widget);
|
|
if Mode = QtOpaqueMode then
|
|
Result := OPAQUE
|
|
else
|
|
Result := TRANSPARENT;
|
|
|
|
if BkMode = OPAQUE then
|
|
Mode := QtOpaqueMode
|
|
else
|
|
Mode := QtTransparentMode;
|
|
QPainter_SetBackgroundMode(Widget, Mode);
|
|
end;
|
|
end;
|
|
|
|
function TQtDeviceContext.getDepth: integer;
|
|
var
|
|
device: QPaintDeviceH;
|
|
begin
|
|
device := QPainter_device(Widget);
|
|
Result := QPaintDevice_depth(Device);
|
|
end;
|
|
|
|
function TQtDeviceContext.getDeviceSize: TPoint;
|
|
var
|
|
device: QPaintDeviceH;
|
|
begin
|
|
device := QPainter_device(Widget);
|
|
Result.x := QPaintDevice_width(device);
|
|
Result.y := QPaintDevice_height(device);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.getRegionType
|
|
Params: QRegionH
|
|
Returns: Region type
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.getRegionType(ARegion: QRegionH): integer;
|
|
begin
|
|
try
|
|
if QRegion_isEmpty(ARegion) then
|
|
Result := NULLREGION
|
|
else
|
|
begin
|
|
if QRegion_numRects(ARegion) = 1 then
|
|
Result := SIMPLEREGION
|
|
else
|
|
Result := COMPLEXREGION;
|
|
end;
|
|
except
|
|
Result := ERROR;
|
|
end;
|
|
end;
|
|
|
|
procedure TQtDeviceContext.setCompositionMode(mode: QPainterCompositionMode);
|
|
begin
|
|
QPainter_setCompositionMode(Widget, mode);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.region
|
|
Params: None
|
|
Returns: The current clip region
|
|
------------------------------------------------------------------------------}
|
|
function TQtDeviceContext.getClipRegion: TQtRegion;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.region() ');
|
|
{$endif}
|
|
if vRegion.FHandle <> nil then
|
|
begin
|
|
QRegion_destroy(vRegion.FHandle);
|
|
vRegion.FHandle := nil;
|
|
end;
|
|
if vRegion.FHandle = nil then
|
|
vRegion.FHandle := QRegion_Create();
|
|
|
|
QPainter_clipRegion(Widget, vRegion.FHandle);
|
|
Result := vRegion;
|
|
end;
|
|
|
|
procedure TQtDeviceContext.setClipping(const AValue: Boolean);
|
|
begin
|
|
QPainter_setClipping(Widget, AValue);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.setClipRect(const ARect: TRect);
|
|
begin
|
|
QPainter_setClipRect(Widget, @ARect);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.setClipRegion(ARegion: QRegionH;
|
|
AOperation: QtClipOperation = QtReplaceClip);
|
|
begin
|
|
{X11 and mac does not like QtNoClip & empty region.It makes disaster}
|
|
if (AOperation = QtNoClip) and QRegion_isEmpty(ARegion) and
|
|
(QPaintEngine_type(PaintEngine) in [QPaintEngineX11,QPaintEngineQuickDraw,
|
|
QPaintEngineCoreGraphics,QPaintEngineMacPrinter]) then
|
|
setClipping(False)
|
|
else
|
|
QPainter_SetClipRegion(Widget, ARegion, AOperation);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.setRegion
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.setRegion(ARegion: TQtRegion);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.setRegion() ');
|
|
{$endif}
|
|
if (ARegion.FHandle <> nil) and (Widget <> nil) then
|
|
setClipRegion(ARegion.FHandle);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.drawImage
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.drawImage(targetRect: PRect;
|
|
image: QImageH; sourceRect: PRect;
|
|
mask: QImageH; maskRect: PRect; flags: QtImageConversionFlags = QtAutoColor);
|
|
var
|
|
LocalRect: TRect;
|
|
APixmap, ATemp: QPixmapH;
|
|
AMask: QBitmapH;
|
|
ScaledImage: QImageH;
|
|
ScaledMask: QImageH;
|
|
NewRect: TRect;
|
|
|
|
function NeedScaling: boolean;
|
|
var
|
|
R: TRect;
|
|
TgtW, TgtH,
|
|
ClpW, ClpH: integer;
|
|
begin
|
|
|
|
if not getClipping or EqualRect(LocalRect, sourceRect^) then
|
|
exit(False);
|
|
|
|
R := getClipRegion.getBoundingRect;
|
|
|
|
TgtW := LocalRect.Right - LocalRect.Left;
|
|
TgtH := LocalRect.Right - LocalRect.Left;
|
|
ClpW := R.Right - R.Left;
|
|
ClpH := R.Bottom - R.Top;
|
|
|
|
Result := PtInRect(R, Point(R.Left + 1, R.Top + 1)) and
|
|
(ClpW <= TgtW) and (ClpH <= TgtH);
|
|
end;
|
|
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.drawImage() ');
|
|
{$endif}
|
|
ScaledImage := nil;
|
|
LocalRect := targetRect^;
|
|
|
|
if mask <> nil then
|
|
begin
|
|
if NeedScaling then
|
|
begin
|
|
ScaledImage := QImage_create();
|
|
QImage_copy(Image, ScaledImage, 0, 0, QImage_width(Image), QImage_height(Image));
|
|
QImage_scaled(ScaledImage, ScaledImage, LocalRect.Right - LocalRect.Left,
|
|
LocalRect.Bottom - LocalRect.Top);
|
|
NewRect := sourceRect^;
|
|
NewRect.Right := (LocalRect.Right - LocalRect.Left) + sourceRect^.Left;
|
|
NewRect.Bottom := (LocalRect.Bottom - LocalRect.Top) + sourceRect^.Top;
|
|
end;
|
|
// TODO: check maskRect
|
|
APixmap := QPixmap_create();
|
|
try
|
|
if ScaledImage <> nil then
|
|
QPixmap_fromImage(APixmap, ScaledImage, flags)
|
|
else
|
|
QPixmap_fromImage(APixmap, image, flags);
|
|
ATemp := QPixmap_create();
|
|
try
|
|
// QBitmap_fromImage raises assertion in the qt library
|
|
if ScaledImage <> nil then
|
|
begin
|
|
ScaledMask := QImage_create();
|
|
QImage_copy(Mask, ScaledMask, 0, 0, QImage_width(Mask), QImage_height(Mask));
|
|
QImage_scaled(ScaledMask, ScaledMask, LocalRect.Right - LocalRect.Left,
|
|
LocalRect.Bottom - LocalRect.Top);
|
|
QPixmap_fromImage(ATemp, ScaledMask, flags);
|
|
QImage_destroy(ScaledMask);
|
|
end else
|
|
QPixmap_fromImage(ATemp, mask, flags);
|
|
AMask := QBitmap_create(ATemp);
|
|
try
|
|
QPixmap_setMask(APixmap, AMask);
|
|
|
|
{$IFDEF DARWIN}
|
|
ScaledMask := QImage_create();
|
|
QPixmap_toImage(APixmap, ScaledMask);
|
|
if ScaledImage <> nil then
|
|
QPainter_drawImage(Widget, PRect(@LocalRect), image, @NewRect, flags)
|
|
else
|
|
QPainter_drawImage(Widget, PRect(@LocalRect), image, sourceRect, flags);
|
|
|
|
QImage_destroy(ScaledMask);
|
|
{$ELSE}
|
|
if ScaledImage <> nil then
|
|
QPainter_drawPixmap(Widget, PRect(@LocalRect), APixmap, @NewRect)
|
|
else
|
|
QPainter_drawPixmap(Widget, PRect(@LocalRect), APixmap, sourceRect);
|
|
{$ENDIF}
|
|
|
|
finally
|
|
QBitmap_destroy(AMask);
|
|
end;
|
|
finally
|
|
QPixmap_destroy(ATemp);
|
|
end;
|
|
finally
|
|
QPixmap_destroy(APixmap);
|
|
end;
|
|
if ScaledImage <> nil then
|
|
QImage_destroy(ScaledImage);
|
|
end else
|
|
begin
|
|
{$note TQtDeviceContext.drawImage workaround - possible qt4 bug with QPainter & RGB32 images.}
|
|
{Workaround: we must convert image to ARGB32 , since we can get strange
|
|
results with RGB32 images on Linux and Win32 if DstRect <> sourceRect.
|
|
Explanation: Look at #11713 linux & win screenshoots.
|
|
Note: This is slower operation than QImage_scaled() we used before.
|
|
Issue #25590 - check if we are RGB32 and mask is nil, so make conversion
|
|
too.}
|
|
if (not EqualRect(LocalRect, sourceRect^) or (Mask = nil)) and
|
|
(QImage_format(Image) = QImageFormat_RGB32) then
|
|
begin
|
|
|
|
ScaledImage := QImage_create();
|
|
try
|
|
|
|
QImage_convertToFormat(Image, ScaledImage, QImageFormat_ARGB32);
|
|
|
|
if NeedScaling then
|
|
begin
|
|
QImage_scaled(ScaledImage, ScaledImage, LocalRect.Right - LocalRect.Left,
|
|
LocalRect.Bottom - LocalRect.Top);
|
|
|
|
NewRect := sourceRect^;
|
|
NewRect.Right := (LocalRect.Right - LocalRect.Left) + sourceRect^.Left;
|
|
NewRect.Bottom := (LocalRect.Bottom - LocalRect.Top) + sourceRect^.Top;
|
|
|
|
QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, @NewRect, flags);
|
|
end else
|
|
QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, sourceRect, flags);
|
|
|
|
finally
|
|
QImage_destroy(ScaledImage);
|
|
end;
|
|
|
|
end else
|
|
begin
|
|
if NeedScaling then
|
|
begin
|
|
ScaledImage := QImage_create();
|
|
try
|
|
QImage_copy(Image, ScaledImage, 0, 0, QImage_width(Image), QImage_height(Image));
|
|
QImage_scaled(ScaledImage, ScaledImage, LocalRect.Right - LocalRect.Left,
|
|
LocalRect.Bottom - LocalRect.Top);
|
|
NewRect := sourceRect^;
|
|
NewRect.Right := (LocalRect.Right - LocalRect.Left) + sourceRect^.Left;
|
|
NewRect.Bottom := (LocalRect.Bottom - LocalRect.Top) + sourceRect^.Top;
|
|
QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, @NewRect, flags);
|
|
finally
|
|
QImage_destroy(ScaledImage);
|
|
end;
|
|
end else
|
|
QPainter_drawImage(Widget, PRect(@LocalRect), image, sourceRect, flags);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TQtDeviceContext.PaintEngine: QPaintEngineH;
|
|
begin
|
|
Result := QPainter_paintEngine(Widget);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.rotate
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Rotates the coordinate system
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.rotate(a: Double);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.rotate() ');
|
|
{$endif}
|
|
QPainter_rotate(Widget, a);
|
|
end;
|
|
|
|
procedure TQtDeviceContext.setRenderHint(AHint: QPainterRenderHint; AValue: Boolean);
|
|
begin
|
|
QPainter_setRenderHint(Widget, AHint, AValue);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.save
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Saves the state of the canvas
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.save;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.save() ');
|
|
{$endif}
|
|
QPainter_save(Widget);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.restore
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Restores the state of the canvas
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.restore;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
Write('TQtDeviceContext.restore() ');
|
|
{$endif}
|
|
QPainter_restore(Widget);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtDeviceContext.translate
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Tranlates the coordinate system
|
|
------------------------------------------------------------------------------}
|
|
procedure TQtDeviceContext.translate(dx: Double; dy: Double);
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtDeviceContext.translate() ');
|
|
{$endif}
|
|
QPainter_translate(Widget, dx, dy);
|
|
end;
|
|
|
|
{ TQtPixmap }
|
|
|
|
constructor TQtPixmap.Create(p1: PSize);
|
|
begin
|
|
FHandle := QPixmap_create(p1);
|
|
end;
|
|
|
|
destructor TQtPixmap.Destroy;
|
|
begin
|
|
if FHandle <> nil then
|
|
QPixmap_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtPixmap.getHeight: Integer;
|
|
begin
|
|
Result := QPixmap_height(Handle);
|
|
end;
|
|
|
|
function TQtPixmap.getWidth: Integer;
|
|
begin
|
|
Result := QPixmap_width(Handle);
|
|
end;
|
|
|
|
procedure TQtPixmap.grabWidget(AWidget: QWidgetH; x: Integer = 0; y: Integer = 0; w: Integer = -1; h: Integer = -1);
|
|
begin
|
|
QPixmap_grabWidget(FHandle, AWidget, x, y, w, h);
|
|
end;
|
|
|
|
procedure TQtPixmap.grabWindow(p1: Cardinal; x: Integer; y: Integer; w: Integer; h: Integer);
|
|
begin
|
|
QPixmap_grabWindow(FHandle, p1, x, y, w, h);
|
|
end;
|
|
|
|
procedure TQtPixmap.toImage(retval: QImageH);
|
|
begin
|
|
QPixmap_toImage(FHandle, retval);
|
|
end;
|
|
|
|
class procedure TQtPixmap.fromImage(retval: QPixmapH; image: QImageH; flags: QtImageConversionFlags = QtAutoColor);
|
|
begin
|
|
QPixmap_fromImage(retval, image, flags);
|
|
end;
|
|
|
|
{ TQtSystemTrayIcon }
|
|
|
|
constructor TQtSystemTrayIcon.Create(vIcon: QIconH);
|
|
begin
|
|
inherited Create;
|
|
|
|
if vIcon <> nil then
|
|
Handle := QSystemTrayIcon_create(vicon, nil)
|
|
else
|
|
Handle := QSystemTrayIcon_create();
|
|
FHook := QSystemTrayIcon_hook_create(Handle);
|
|
QSystemTrayIcon_hook_hook_activated(FHook, @signalActivated);
|
|
end;
|
|
|
|
destructor TQtSystemTrayIcon.Destroy;
|
|
begin
|
|
QSystemTrayIcon_hook_destroy(FHook);
|
|
QSystemTrayIcon_destroy(Handle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.setContextMenu(menu: QMenuH);
|
|
begin
|
|
QSystemTrayIcon_setContextMenu(handle, menu);
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.setIcon(icon: QIconH);
|
|
begin
|
|
QSystemTrayIcon_setIcon(handle, icon);
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.setToolTip(tip: WideString);
|
|
begin
|
|
QSystemTrayIcon_setToolTip(handle, @tip)
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.signalActivated(
|
|
AReason: QSystemTrayIconActivationReason); cdecl;
|
|
var
|
|
MousePos: TQtPoint;
|
|
begin
|
|
if not Assigned(FTrayIcon) then
|
|
exit;
|
|
|
|
QCursor_pos(@MousePos);
|
|
{$note: TODO: Mouse events of trayicon can be catched
|
|
in QApplication event filter (TQtWidgetSet.EventFilter),
|
|
so OnMouseDown and OnMouseUp can be properly sent.
|
|
Check if it works ok on qtwin32 and qtmac and
|
|
then replace this blind calls to mouse events.
|
|
To get systryicon object handle in application event filter
|
|
add property "lclsystrayicon" to this handle.}
|
|
case AReason of
|
|
QSystemTrayIconTrigger:
|
|
begin
|
|
if Assigned(FTrayIcon.OnMouseDown) then
|
|
FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
|
|
if Assigned(FTrayIcon.OnClick) then
|
|
FTrayIcon.OnClick(FTrayIcon);
|
|
if Assigned(FTrayIcon.OnMouseUp) then
|
|
FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
|
|
end;
|
|
QSystemTrayIconDoubleClick:
|
|
begin
|
|
if Assigned(FTrayIcon.OnMouseDown) then
|
|
FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
|
|
|
|
if Assigned(FTrayIcon.OnDblClick) then
|
|
FTrayIcon.OnDblClick(FTrayIcon);
|
|
|
|
if Assigned(FTrayIcon.OnMouseUp) then
|
|
FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
|
|
end;
|
|
QSystemTrayIconMiddleClick:
|
|
begin
|
|
if Assigned(FTrayIcon.OnMouseDown) then
|
|
FTrayIcon.OnMouseDown(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
|
|
if Assigned(FTrayIcon.OnMouseUp) then
|
|
FTrayIcon.OnMouseUp(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
|
|
end;
|
|
QSystemTrayIconContext:
|
|
begin
|
|
if Assigned(FTrayIcon.OnMouseDown) then
|
|
FTrayIcon.OnMouseDown(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
|
|
|
|
if Assigned(FTrayIcon.OnMouseUp) then
|
|
FTrayIcon.OnMouseUp(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.showBaloonHint(const ATitle, AHint: String;
|
|
const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
|
|
var
|
|
WHint: WideString;
|
|
WTitle: WideString;
|
|
begin
|
|
WHint := GetUTF8String(AHint);
|
|
WTitle := GetUTF8String(ATitle);
|
|
QSystemTrayIcon_showMessage(Handle, @WTitle, @WHint, AFlag, ATimeOut);
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.Show;
|
|
begin
|
|
QSystemTrayIcon_show(handle);
|
|
end;
|
|
|
|
procedure TQtSystemTrayIcon.Hide;
|
|
begin
|
|
QSystemTrayIcon_hide(handle);
|
|
end;
|
|
|
|
{ TQtButtonGroup }
|
|
|
|
constructor TQtButtonGroup.Create(AParent: QObjectH);
|
|
begin
|
|
inherited Create;
|
|
|
|
Handle := QButtonGroup_create(AParent);
|
|
end;
|
|
|
|
destructor TQtButtonGroup.Destroy;
|
|
begin
|
|
QButtonGroup_destroy(Handle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtButtonGroup.AddButton(AButton: QAbstractButtonH); overload;
|
|
begin
|
|
QButtonGroup_addButton(Handle, AButton);
|
|
end;
|
|
|
|
procedure TQtButtonGroup.AddButton(AButton: QAbstractButtonH; id: Integer); overload;
|
|
begin
|
|
QButtonGroup_addButton(Handle, AButton, id);
|
|
end;
|
|
|
|
function TQtButtonGroup.ButtonFromId(id: Integer): QAbstractButtonH;
|
|
begin
|
|
Result := QButtonGroup_button(Handle, id);
|
|
end;
|
|
|
|
procedure TQtButtonGroup.RemoveButton(AButton: QAbstractButtonH);
|
|
begin
|
|
QButtonGroup_removeButton(Handle, AButton);
|
|
end;
|
|
|
|
procedure TQtButtonGroup.SetExclusive(AExclusive: Boolean);
|
|
begin
|
|
QButtonGroup_setExclusive(Handle, AExclusive);
|
|
end;
|
|
|
|
function TQtButtonGroup.GetExclusive: Boolean;
|
|
begin
|
|
Result := QButtonGroup_exclusive(Handle);
|
|
end;
|
|
|
|
procedure TQtButtonGroup.SignalButtonClicked(AButton: QAbstractButtonH); cdecl;
|
|
begin
|
|
{todo}
|
|
end;
|
|
|
|
{ TQtClipboard }
|
|
|
|
constructor TQtClipboard.Create;
|
|
var
|
|
ClipboardType: TClipboardType;
|
|
begin
|
|
inherited Create;
|
|
FLockClip := False;
|
|
for ClipboardType := Low(TClipBoardType) to High(TClipBoardType) do
|
|
FOnClipBoardRequest[ClipBoardType] := nil;
|
|
FClipBoardFormats := TStringList.Create;
|
|
FClipBoardFormats.Add('foo'); // 0 is reserved
|
|
TheObject := QApplication_clipBoard;
|
|
{$IFDEF HASX11}
|
|
FLockX11Selection := 0;
|
|
FSelTimer := TQtTimer.CreateTimer(10, @selectionTimer, TheObject);
|
|
{$ENDIF}
|
|
AttachEvents;
|
|
end;
|
|
|
|
destructor TQtClipboard.Destroy;
|
|
begin
|
|
DetachEvents;
|
|
{$IFDEF HASX11}
|
|
if FSelTimer <> nil then
|
|
FSelTimer.Free;
|
|
{$ENDIF}
|
|
FClipBoardFormats.Free;
|
|
// This is global QApplication object so do NOT destroy it !!
|
|
TheObject := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtClipboard.AttachEvents;
|
|
begin
|
|
inherited AttachEvents;
|
|
FClipDataChangedHook := QClipboard_hook_create(TheObject);
|
|
QClipboard_hook_hook_dataChanged(FClipDataChangedHook, @signalDataChanged);
|
|
{$IFDEF HASX11}
|
|
FClipSelectionChangedHook := QClipboard_hook_create(TheObject);
|
|
QClipboard_hook_hook_selectionChanged(FClipSelectionChangedHook,
|
|
@signalSelectionChanged);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TQtClipboard.DetachEvents;
|
|
begin
|
|
if Assigned(FClipDataChangedHook) then
|
|
QClipboard_hook_destroy(FClipDataChangedHook);
|
|
FClipDataChangedHook := nil;
|
|
{$IFDEF HASX11}
|
|
if Assigned(FClipSelectionChangedHook) then
|
|
QClipboard_hook_destroy(FClipSelectionChangedHook);
|
|
FClipSelectionChangedHook := nil;
|
|
{$ENDIF}
|
|
inherited DetachEvents;
|
|
end;
|
|
|
|
procedure TQtClipboard.signalDataChanged; cdecl;
|
|
begin
|
|
{$IFDEF VERBOSE_QT_CLIPBOARD}
|
|
writeln('signalDataChanged()');
|
|
{$ENDIF}
|
|
FClipChanged := IsClipboardChanged;
|
|
end;
|
|
|
|
{$IFDEF HASX11}
|
|
procedure TQtClipboard.BeginX11SelectionLock;
|
|
begin
|
|
inc(FLockX11Selection);
|
|
end;
|
|
|
|
procedure TQtClipboard.EndX11SelectionLock;
|
|
begin
|
|
dec(FLockX11Selection);
|
|
end;
|
|
|
|
function TQtClipboard.InX11SelectionLock: Boolean;
|
|
begin
|
|
Result := FLockX11Selection > 0;
|
|
end;
|
|
|
|
procedure TQtClipboard.signalSelectionChanged; cdecl;
|
|
var
|
|
TempMimeData: QMimeDataH;
|
|
WStr: WideString;
|
|
Clip: TClipBoard;
|
|
begin
|
|
{$IFDEF VERBOSE_QT_CLIPBOARD}
|
|
writeln('signalSelectionChanged() OWNER?=', QClipboard_ownsSelection(Self.clipboard),
|
|
' FOnClipBoardRequest ? ',FOnClipBoardRequest[ctPrimarySelection] <> nil);
|
|
{$ENDIF}
|
|
if InX11SelectionLock then
|
|
exit;
|
|
TempMimeData := getMimeData(QClipboardSelection);
|
|
if (TempMimeData <> nil) and
|
|
(QMimeData_hasText(TempMimeData) or QMimeData_hasHtml(TempMimeData) or
|
|
QMimeData_hasURLS(TempMimeData)) then
|
|
begin
|
|
QMimeData_text(TempMimeData, @WStr);
|
|
// do not touch LCL's selection if shift is down
|
|
// since in that case event is tracked via FSelTimer
|
|
// until shift depressed.
|
|
if QApplication_keyboardModifiers() and QtShiftModifier <> 0 then
|
|
exit;
|
|
// do complete primaryselection cleanup at LCL side
|
|
// so it asks for clip from qt (no matter is it owner or not).
|
|
BeginUpdate;
|
|
Clip := Clipbrd.Clipboard(ctPrimarySelection);
|
|
Clip.OnRequest := nil;
|
|
FOnClipBoardRequest[ctPrimarySelection] := nil;
|
|
Clip.AsText := UTF8Decode(WStr);
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TQtClipboard.selectionTimer;
|
|
var
|
|
RptEvent: QLCLMessageEventH;
|
|
begin
|
|
if FOnClipBoardRequest[ctPrimarySelection] = nil then
|
|
begin
|
|
FSelTimer.TimerEnabled := False;
|
|
exit;
|
|
end;
|
|
if QApplication_keyboardModifiers() and QtShiftModifier = 0 then
|
|
begin
|
|
FSelTimer.TimerEnabled := False;
|
|
RptEvent := QLCLMessageEvent_create(LCLQt_ClipboardPrimarySelection,
|
|
Ord(ctPrimarySelection), FSelFmtCount, 0, 0);
|
|
QCoreApplication_postEvent(ClipBoard, RptEvent);
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function TQtClipboard.IsClipboardChanged: Boolean;
|
|
var
|
|
TempMimeData: QMimeDataH;
|
|
Str: WideString;
|
|
Str2: WideString;
|
|
begin
|
|
Result := not FLockClip;
|
|
if FLockClip then
|
|
exit;
|
|
// FLockClip: here we know that our clipboard is not changed by LCL Clipboard
|
|
FLockClip := True;
|
|
try
|
|
TempMimeData := getMimeData(QClipboardClipboard);
|
|
if (TempMimeData <> nil) and
|
|
(QMimeData_hasText(TempMimeData) or QMimeData_hasHtml(TempMimeData) or
|
|
QMimeData_hasURLS(TempMimeData)) then
|
|
begin
|
|
QMimeData_text(TempMimeData, @Str);
|
|
Str := UTF16ToUTF8(Str);
|
|
|
|
Str2 := Clipbrd.Clipboard.AsText;
|
|
|
|
Result := Str <> Str2;
|
|
if Result then
|
|
Clipbrd.Clipboard.AsText := Str;
|
|
end;
|
|
finally
|
|
FLockClip := False;
|
|
end;
|
|
end;
|
|
|
|
function TQtClipboard.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
|
|
{$IFDEF HASX11}
|
|
var
|
|
ClipboardType: TClipboardType;
|
|
FormatCount: PtrUint;
|
|
Modifiers: QtKeyboardModifiers;
|
|
|
|
procedure PutSelectionOnClipBoard;
|
|
var
|
|
MimeType: WideString;
|
|
MimeData: QMimeDataH;
|
|
Data: QByteArrayH;
|
|
DataStream: TMemoryStream;
|
|
I: Integer;
|
|
Clip: TClipboard;
|
|
begin
|
|
// We must track this event if shift is down, since
|
|
// we are doing keyboard selection.
|
|
// When shift is depressed, selectionTimer will trigger
|
|
// another event which will pass this point
|
|
// and assign selection to qt selection clipboard.
|
|
if Modifiers and QtShiftModifier <> 0 then
|
|
begin
|
|
if not FSelTimer.TimerEnabled then
|
|
FSelTimer.TimerEnabled := True;
|
|
exit;
|
|
end;
|
|
if FSelTimer.TimerEnabled then
|
|
FSelTimer.TimerEnabled := False;
|
|
|
|
Clip := Clipbrd.Clipboard(ClipboardType);
|
|
MimeData := QMimeData_create();
|
|
DataStream := TMemoryStream.Create;
|
|
for I := 0 to FormatCount - 1 do
|
|
begin
|
|
DataStream.Size := 0;
|
|
DataStream.Position := 0;
|
|
MimeType := FormatToMimeType(Clip.Formats[I]);
|
|
FOnClipBoardRequest[ClipboardType](Clip.Formats[I], DataStream);
|
|
Data := QByteArray_create(PAnsiChar(DataStream.Memory), DataStream.Size);
|
|
if (QByteArray_length(Data) > 1) and QByteArray_endsWith(Data, #0) then
|
|
QByteArray_chop(Data, 1);
|
|
QMimeData_setData(MimeData, @MimeType, Data);
|
|
QByteArray_destroy(Data);
|
|
end;
|
|
DataStream.Free;
|
|
// we must "wake up" QMimeData text property, otherwise
|
|
// some non ascii chars could be eaten (possible qt bug)
|
|
QMimeData_text(MimeData, @MimeType);
|
|
setMimeData(MimeData, ClipbBoardTypeToQtClipboard[ClipBoardType]);
|
|
// do not destroy MimeData!!!
|
|
end;
|
|
{$ENDIF}
|
|
begin
|
|
BeginEventProcessing;
|
|
Result := False;
|
|
|
|
{$IFDEF HASX11}
|
|
if QEvent_type(Event) = LCLQt_ClipboardPrimarySelection then
|
|
begin
|
|
ClipboardType := TClipBoardType(QLCLMessageEvent_getMsg(QLCLMessageEventH(Event)));
|
|
FormatCount := QLCLMessageEvent_getWParam(QLCLMessageEventH(Event));
|
|
Modifiers := QtKeyboardModifiers(QLCLMessageEvent_getLParam(QLCLMessageEventH(Event)));
|
|
if FOnClipBoardRequest[ClipboardType] <> nil then
|
|
PutSelectionOnClipboard;
|
|
Result := True;
|
|
QEvent_accept(Event);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if QEvent_type(Event) = QEventClipboard then
|
|
begin
|
|
Result := FClipChanged;
|
|
// Clipboard is changed, but we have no ability at moment to pass that info
|
|
// to LCL since LCL has no support for that event
|
|
// so we are using signalDataChanged() to pass changes to Clipbrd.Clipboard
|
|
if FClipChanged then
|
|
FClipChanged := False;
|
|
QEvent_accept(Event);
|
|
end;
|
|
EndEventProcessing;
|
|
end;
|
|
|
|
function TQtClipboard.Clipboard: QClipboardH;
|
|
begin
|
|
Result := QClipboardH(TheObject);
|
|
end;
|
|
|
|
function TQtClipboard.getMimeData(AMode: QClipboardMode): QMimeDataH;
|
|
begin
|
|
Result := QClipboard_mimeData(Clipboard, AMode);
|
|
end;
|
|
|
|
procedure TQtClipboard.setMimeData(AMimeData: QMimeDataH; AMode: QClipboardMode);
|
|
begin
|
|
QClipboard_setMimeData(Clipboard, AMimeData, AMode);
|
|
end;
|
|
|
|
procedure TQtClipboard.Clear(AMode: QClipboardMode);
|
|
begin
|
|
QClipboard_clear(ClipBoard, AMode);
|
|
end;
|
|
|
|
function TQtClipboard.FormatToMimeType(AFormat: TClipboardFormat): String;
|
|
begin
|
|
if FClipBoardFormats.Count > Integer(AFormat) then
|
|
Result := FClipBoardFormats[AFormat]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TQtClipboard.RegisterFormat(AMimeType: String): TClipboardFormat;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := FClipBoardFormats.IndexOf(AMimeType);
|
|
if Index < 0 then
|
|
Index := FClipBoardFormats.Add(AMimeType);
|
|
Result := Index;
|
|
end;
|
|
|
|
function TQtClipboard.GetData(ClipboardType: TClipboardType;
|
|
FormatID: TClipboardFormat; Stream: TStream): boolean;
|
|
var
|
|
QtMimeData: QMimeDataH;
|
|
MimeType: WideString;
|
|
Data: QByteArrayH;
|
|
p: PAnsiChar;
|
|
s: Integer;
|
|
begin
|
|
Result := False;
|
|
QtMimeData := getMimeData(ClipbBoardTypeToQtClipboard[ClipBoardType]);
|
|
MimeType := FormatToMimeType(FormatID);
|
|
Data := QByteArray_create();
|
|
QMimeData_data(QtMimeData, Data, @MimeType);
|
|
s := QByteArray_size(Data);
|
|
p := QByteArray_data(Data);
|
|
Stream.Write(p^, s);
|
|
// what to do with p? FreeMem or nothing?
|
|
QByteArray_destroy(Data);
|
|
Result := True;
|
|
end;
|
|
|
|
function TQtClipboard.GetFormats(ClipboardType: TClipboardType;
|
|
var Count: integer; var List: PClipboardFormat): boolean;
|
|
var
|
|
QtMimeData: QMimeDataH;
|
|
QtList: QStringListH;
|
|
i: Integer;
|
|
Str: WideString;
|
|
begin
|
|
Result := False;
|
|
Count := 0;
|
|
List := nil;
|
|
|
|
QtMimeData := getMimeData(ClipbBoardTypeToQtClipboard[ClipBoardType]);
|
|
|
|
QtList := QStringList_create;
|
|
QMimeData_formats(QtMimeData, QtList);
|
|
|
|
try
|
|
Count := QStringList_size(QtList);
|
|
GetMem(List, Count * SizeOf(TClipboardFormat));
|
|
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
QStringList_at(QtList, @Str, i);
|
|
Str := UTF16ToUTF8(Str);
|
|
List[i] := RegisterFormat(Str);
|
|
end;
|
|
|
|
Result := True;
|
|
|
|
finally
|
|
QStringList_destroy(QtList);
|
|
end;
|
|
end;
|
|
|
|
function TQtClipboard.GetOwnerShip(ClipboardType: TClipboardType;
|
|
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
|
|
Formats: PClipboardFormat): boolean;
|
|
|
|
procedure PutOnClipBoard;
|
|
var
|
|
MimeType: WideString;
|
|
MimeData: QMimeDataH;
|
|
Data: QByteArrayH;
|
|
DataStream: TMemoryStream;
|
|
I: Integer;
|
|
{$IFDEF HASX11}
|
|
Event: QLCLMessageEventH;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF HASX11}
|
|
// we must delay assigning selection to qt clipboard
|
|
// so generate our private event
|
|
if ClipboardType <> ctClipboard then
|
|
begin
|
|
FSelFmtCount := FormatCount;
|
|
Event := QLCLMessageEvent_create(LCLQt_ClipboardPrimarySelection,
|
|
Ord(ClipboardType), FormatCount, PtrUInt(QApplication_keyboardModifiers()), 0);
|
|
QCoreApplication_postEvent(ClipBoard, Event);
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
MimeData := QMimeData_create();
|
|
DataStream := TMemoryStream.Create;
|
|
for I := 0 to FormatCount - 1 do
|
|
begin
|
|
DataStream.Size := 0;
|
|
DataStream.Position := 0;
|
|
MimeType := FormatToMimeType(Formats[I]);
|
|
FOnClipBoardRequest[ClipboardType](Formats[I], DataStream);
|
|
Data := QByteArray_create(PAnsiChar(DataStream.Memory), DataStream.Size);
|
|
if (QByteArray_length(Data) > 1) and QByteArray_endsWith(Data, #0) then
|
|
QByteArray_chop(Data, 1);
|
|
QMimeData_setData(MimeData, @MimeType, Data);
|
|
QByteArray_destroy(Data);
|
|
end;
|
|
DataStream.Free;
|
|
setMimeData(MimeData, ClipbBoardTypeToQtClipboard[ClipBoardType]);
|
|
// do not destroy MimeData!!!
|
|
end;
|
|
begin
|
|
Result := False;
|
|
if (FormatCount = 0) or (OnRequestProc = nil) then
|
|
begin
|
|
{ The LCL indicates it doesn't have the clipboard data anymore
|
|
and the interface can't use the OnRequestProc anymore.}
|
|
FOnClipBoardRequest[ClipboardType] := nil;
|
|
Result := True;
|
|
end else
|
|
begin
|
|
if FLockClip then
|
|
exit;
|
|
{FLockClip: we are sure that this request comes from LCL Clipboard}
|
|
FLockClip := True;
|
|
try
|
|
{ clear OnClipBoardRequest to prevent destroying the LCL clipboard,
|
|
when emptying the clipboard}
|
|
FOnClipBoardRequest[ClipBoardType] := nil;
|
|
{$IFDEF HASX11}
|
|
// if we are InUpdate , then change is asked
|
|
// from selectionChanged trigger, so don't do anything
|
|
if (ClipboardType <> ctClipBoard) and InUpdate then
|
|
begin
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
FOnClipBoardRequest[ClipBoardType] := OnRequestProc;
|
|
PutOnClipBoard;
|
|
Result := True;
|
|
finally
|
|
FLockClip := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TQtPrinter }
|
|
|
|
constructor TQtPrinter.Create;
|
|
begin
|
|
FPrinterActive := False;
|
|
FHandle := QPrinter_create(QPrinterHighResolution);
|
|
end;
|
|
|
|
constructor TQtPrinter.Create(AMode: QPrinterPrinterMode);
|
|
begin
|
|
FPrinterActive := False;
|
|
FHandle := QPrinter_create(AMode);
|
|
end;
|
|
|
|
destructor TQtPrinter.Destroy;
|
|
begin
|
|
endDoc;
|
|
if FHandle <> nil then
|
|
QPrinter_destroy(FHandle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{returns default system printer}
|
|
function TQtPrinter.DefaultPrinter: WideString;
|
|
var
|
|
prnName: WideString;
|
|
PrnInfo: QPrinterInfoH;
|
|
begin
|
|
PrnInfo := QPrinterInfo_create();
|
|
QPrinterInfo_defaultPrinter(PrnInfo);
|
|
QPrinterInfo_printerName(PrnInfo, @PrnName);
|
|
QPrinterInfo_destroy(PrnInfo);
|
|
if PrnName = '' then
|
|
PrnName := 'unknown';
|
|
Result := UTF8ToUTF16(PrnName);
|
|
end;
|
|
|
|
{returns available list of printers.
|
|
if there's no printer on system result will be false.
|
|
Default sys printer is always 1st in the list.}
|
|
function TQtPrinter.GetAvailablePrinters(Lst: TStrings): Boolean;
|
|
var
|
|
Str: WideString;
|
|
PrnName: WideString;
|
|
i: Integer;
|
|
PrnInfo: QPrinterInfoH;
|
|
Prntr: QPrinterInfoH;
|
|
PrnList: TPtrIntArray;
|
|
begin
|
|
Result := False;
|
|
Str := DefaultPrinter;
|
|
// EnumQPrinters(Lst);
|
|
PrnInfo := QPrinterInfo_create();
|
|
try
|
|
Lst.Clear;
|
|
QPrinterInfo_availablePrinters(@PrnList);
|
|
for i := Low(PrnList) to High(PrnList) do
|
|
begin
|
|
Prntr := QPrinterInfoH(PrnList[i]);
|
|
if Assigned(Prntr) and not QPrinterInfo_isNull(Prntr) then
|
|
begin
|
|
QPrinterInfo_printerName(Prntr, @PrnName);
|
|
if QPrinterInfo_isDefault(Prntr) then
|
|
Lst.Insert(0, UTF8ToUTF16(PrnName))
|
|
else
|
|
Lst.Add(UTF8ToUTF16(PrnName));
|
|
end;
|
|
end;
|
|
finally
|
|
QPrinterInfo_destroy(PrnInfo);
|
|
end;
|
|
|
|
i := Lst.IndexOf(Str);
|
|
if i > 0 then
|
|
Lst.Move(i, 0);
|
|
Result := Lst.Count > 0;
|
|
end;
|
|
|
|
procedure TQtPrinter.beginDoc;
|
|
begin
|
|
getPrinterContext;
|
|
FPrinterActive := FPrinterContext <> nil;
|
|
end;
|
|
|
|
procedure TQtPrinter.endDoc;
|
|
begin
|
|
if FPrinterContext <> nil then
|
|
begin
|
|
if QPainter_isActive(FPrinterContext.Widget) then
|
|
QPainter_end(FPrinterContext.Widget);
|
|
FPrinterContext.Free;
|
|
FPrinterContext := nil;
|
|
end;
|
|
FPrinterActive := False;
|
|
end;
|
|
|
|
function TQtPrinter.getPrinterContext: TQtDeviceContext;
|
|
begin
|
|
if FPrinterContext = nil then
|
|
FPrinterContext := TQtDeviceContext.CreatePrinterContext(Handle);
|
|
Result := FPrinterContext;
|
|
end;
|
|
|
|
function TQtPrinter.GetDuplexMode: QPrinterDuplexMode;
|
|
begin
|
|
Result := QPrinter_duplex(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getCollateCopies: Boolean;
|
|
begin
|
|
Result := QPrinter_collateCopies(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getColorMode: QPrinterColorMode;
|
|
begin
|
|
Result := QPrinter_colorMode(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getCreator: WideString;
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
QPrinter_creator(FHandle, @Str);
|
|
Result := UTF16ToUTF8(Str);
|
|
end;
|
|
|
|
function TQtPrinter.getDevType: Integer;
|
|
begin
|
|
Result := QPrinter_devType(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getDocName: WideString;
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
QPrinter_docName(FHandle, @Str);
|
|
Result := UTF16ToUTF8(Str);
|
|
end;
|
|
|
|
function TQtPrinter.getDoubleSidedPrinting: Boolean;
|
|
begin
|
|
Result := QPrinter_doubleSidedPrinting(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getFontEmbedding: Boolean;
|
|
begin
|
|
Result := QPrinter_fontEmbeddingEnabled(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getFullPage: Boolean;
|
|
begin
|
|
Result := QPrinter_fullPage(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setOutputFormat(const AValue: QPrinterOutputFormat);
|
|
begin
|
|
QPrinter_setOutputFormat(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setPaperSource(const AValue: QPrinterPaperSource);
|
|
begin
|
|
QPrinter_setPaperSource(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtPrinter.getOutputFormat: QPrinterOutputFormat;
|
|
begin
|
|
Result := QPrinter_outputFormat(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getPaperSource: QPrinterPaperSource;
|
|
begin
|
|
Result := QPrinter_paperSource(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getPrintProgram: WideString;
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
QPrinter_printProgram(FHandle, @Str);
|
|
Result := UTF16ToUTF8(Str);
|
|
end;
|
|
|
|
function TQtPrinter.getPrintRange: QPrinterPrintRange;
|
|
begin
|
|
Result := QPrinter_printRange(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setCollateCopies(const AValue: Boolean);
|
|
begin
|
|
QPrinter_setCollateCopies(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setColorMode(const AValue: QPrinterColorMode);
|
|
begin
|
|
QPrinter_setColorMode(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setCreator(const AValue: WideString);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(AValue);
|
|
QPrinter_setCreator(FHandle, @Str);
|
|
end;
|
|
|
|
procedure TQtPrinter.setDocName(const AValue: WideString);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(AValue);
|
|
QPrinter_setDocName(FHandle, @Str);
|
|
end;
|
|
|
|
procedure TQtPrinter.setDoubleSidedPrinting(const AValue: Boolean);
|
|
begin
|
|
QPrinter_setDoubleSidedPrinting(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.SetDuplexMode(AValue: QPrinterDuplexMode);
|
|
begin
|
|
QPrinter_setDuplex(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setFontEmbedding(const AValue: Boolean);
|
|
begin
|
|
QPrinter_setFontEmbeddingEnabled(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setFullPage(const AValue: Boolean);
|
|
begin
|
|
QPrinter_setFullPage(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setPrinterName(const AValue: WideString);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(AValue);
|
|
QPrinter_setPrinterName(FHandle, @Str);
|
|
end;
|
|
|
|
function TQtPrinter.getPrinterName: WideString;
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
QPrinter_printerName(FHandle, @Str);
|
|
Result := UTF16ToUTF8(Str);
|
|
end;
|
|
|
|
procedure TQtPrinter.setOutputFileName(const AValue: WideString);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(AValue);
|
|
QPrinter_setOutputFileName(FHandle, @Str);
|
|
end;
|
|
|
|
function TQtPrinter.getOutputFileName: WideString;
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
QPrinter_outputFileName(FHandle, @Str);
|
|
Result := UTF16ToUTF8(Str);
|
|
end;
|
|
|
|
procedure TQtPrinter.setOrientation(const AValue: QPrinterOrientation);
|
|
begin
|
|
QPrinter_setOrientation(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtPrinter.getOrientation: QPrinterOrientation;
|
|
begin
|
|
Result := QPrinter_orientation(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setPageSize(const AValue: QPrinterPageSize);
|
|
begin
|
|
QPrinter_setPaperSize(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtPrinter.getPageSize: QPrinterPageSize;
|
|
begin
|
|
Result := QPrinter_paperSize(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setPageOrder(const AValue: QPrinterPageOrder);
|
|
begin
|
|
QPrinter_setPageOrder(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtPrinter.getPageOrder: QPrinterPageOrder;
|
|
begin
|
|
Result := QPrinter_pageOrder(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setPrintProgram(const AValue: WideString);
|
|
var
|
|
Str: WideString;
|
|
begin
|
|
Str := GetUtf8String(AValue);
|
|
QPrinter_setPrintProgram(FHandle, @Str);
|
|
end;
|
|
|
|
procedure TQtPrinter.setPrintRange(const AValue: QPrinterPrintRange);
|
|
begin
|
|
QPrinter_setPrintRange(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtPrinter.setResolution(const AValue: Integer);
|
|
begin
|
|
QPrinter_setResolution(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtPrinter.getResolution: Integer;
|
|
begin
|
|
Result := QPrinter_resolution(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.getNumCopies: Integer;
|
|
begin
|
|
Result := QPrinter_numCopies(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setNumCopies(const AValue: Integer);
|
|
begin
|
|
QPrinter_setNumCopies(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtPrinter.getPrinterState: QPrinterPrinterState;
|
|
begin
|
|
Result := QPrinter_printerState(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.NewPage: Boolean;
|
|
begin
|
|
Result := QPrinter_newPage(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.Abort: Boolean;
|
|
begin
|
|
Result := QPrinter_abort(FHandle);
|
|
end;
|
|
|
|
procedure TQtPrinter.setFromPageToPage(const AFromPage, AToPage: Integer);
|
|
begin
|
|
QPrinter_setFromTo(FHandle, AFromPage, AToPage);
|
|
end;
|
|
|
|
function TQtPrinter.fromPage: Integer;
|
|
begin
|
|
Result := QPrinter_fromPage(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.toPage: Integer;
|
|
begin
|
|
Result := QPrinter_toPage(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.PaintEngine: QPaintEngineH;
|
|
begin
|
|
Result := QPrinter_paintEngine(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.PageRect: TRect;
|
|
begin
|
|
QPrinter_pageRect(FHandle, @Result);
|
|
end;
|
|
|
|
function TQtPrinter.PaperRect: TRect;
|
|
begin
|
|
QPrinter_paperRect(FHandle, @Result);
|
|
end;
|
|
|
|
function TQtPrinter.PageRect(AUnits: QPrinterUnit): TRect;
|
|
var
|
|
R: QRectFH;
|
|
begin
|
|
R := QRectF_create();
|
|
QPrinter_pageRect(FHandle, R, AUnits);
|
|
QRectF_toRect(R, @Result);
|
|
QRectF_destroy(R);
|
|
end;
|
|
|
|
function TQtPrinter.PaperRect(AUnits: QPrinterUnit): TRect;
|
|
var
|
|
R: QRectFH;
|
|
begin
|
|
R := QRectF_create();
|
|
QPrinter_paperRect(FHandle, R, AUnits);
|
|
QRectF_toRect(R, @Result);
|
|
QRectF_destroy(R);
|
|
end;
|
|
|
|
function TQtPrinter.PrintEngine: QPrintEngineH;
|
|
begin
|
|
Result := QPrinter_printEngine(FHandle);
|
|
end;
|
|
|
|
function TQtPrinter.GetPaperSize(AUnits: QPrinterUnit): TSize;
|
|
var
|
|
SizeF: QSizeFH;
|
|
begin
|
|
SizeF := QSizeF_create(0, 0);
|
|
QPrinter_paperSize(FHandle, SizeF, AUnits);
|
|
Result.cx := Round(QSizeF_width(SizeF));
|
|
Result.cy := Round(QSizeF_height(SizeF));
|
|
QSizeF_destroy(SizeF);
|
|
end;
|
|
|
|
procedure TQtPrinter.SetPaperSize(ASize: TSize; AUnits: QPrinterUnit);
|
|
var
|
|
SizeF: QSizeFH;
|
|
begin
|
|
SizeF := QSizeF_create(@ASize);
|
|
try
|
|
QPrinter_setPaperSize(FHandle, SizeF, AUnits);
|
|
finally
|
|
QSizeF_destroy(SizeF);
|
|
end;
|
|
end;
|
|
|
|
function TQtPrinter.SupportedResolutions: TPtrIntArray;
|
|
begin
|
|
QPrinter_supportedResolutions(FHandle, @Result);
|
|
end;
|
|
|
|
|
|
{ TQtTimer }
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtTimer.CreateTimer
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
constructor TQtTimer.CreateTimer(Interval: integer;
|
|
const TimerFunc: TWSTimerProc; App: QObjectH);
|
|
begin
|
|
inherited Create;
|
|
FDeleteLater := True;
|
|
FAppObject := App;
|
|
|
|
FCallbackFunc := TimerFunc;
|
|
|
|
TheObject := QTimer_create(App);
|
|
|
|
QTimer_setInterval(QTimerH(TheObject), Interval);
|
|
|
|
AttachEvents;
|
|
|
|
// start timer and get ID
|
|
QTimer_start(QTimerH(TheObject), Interval);
|
|
FId := QTimer_timerId(QTimerH(TheObject));
|
|
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtTimer.CreateTimer: Interval = ', Interval, ' ID = ', FId);
|
|
{$endif}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtTimer.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
destructor TQtTimer.Destroy;
|
|
begin
|
|
{$ifdef VerboseQt}
|
|
WriteLn('TQtTimer.CreateTimer: Destroy. ID = ', FId);
|
|
{$endif}
|
|
|
|
FCallbackFunc := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtTimer.AttachEvents;
|
|
begin
|
|
FTimerHook := QTimer_hook_create(QTimerH(TheObject));
|
|
QTimer_hook_hook_timeout(FTimerHook, @signalTimeout);
|
|
inherited AttachEvents;
|
|
end;
|
|
|
|
procedure TQtTimer.DetachEvents;
|
|
begin
|
|
QTimer_stop(QTimerH(TheObject));
|
|
if FTimerHook <> nil then
|
|
QTimer_hook_destroy(FTimerHook);
|
|
inherited DetachEvents;
|
|
end;
|
|
|
|
procedure TQtTimer.signalTimeout; cdecl;
|
|
begin
|
|
if Assigned(FCallbackFunc) then
|
|
FCallbackFunc;
|
|
end;
|
|
|
|
function TQtTimer.getTimerEnabled: Boolean;
|
|
begin
|
|
if TheObject <> nil then
|
|
Result := QTimer_isActive(QTimerH(TheObject))
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TQtTimer.setTimerEnabled(const AValue: Boolean);
|
|
begin
|
|
if (TheObject <> nil) and (getTimerEnabled <> AValue) then
|
|
begin
|
|
if AValue then
|
|
QTimer_start(QTimerH(TheObject))
|
|
else
|
|
QTimer_stop(QTimerH(TheObject));
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Function: TQtTimer.EventFilter
|
|
Params: None
|
|
Returns: Nothing
|
|
------------------------------------------------------------------------------}
|
|
function TQtTimer.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
|
|
begin
|
|
Result := False;
|
|
QEvent_accept(Event);
|
|
end;
|
|
|
|
{ TQtIcon }
|
|
|
|
constructor TQtIcon.Create;
|
|
begin
|
|
FHandle := QIcon_create();
|
|
end;
|
|
|
|
destructor TQtIcon.Destroy;
|
|
begin
|
|
if FHandle <> nil then
|
|
QIcon_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtIcon.addPixmap(pixmap: QPixmapH; mode: QIconMode = QIconNormal; state: QIconState = QIconOff);
|
|
begin
|
|
QIcon_addPixmap(Handle, pixmap, mode, state);
|
|
end;
|
|
|
|
{ TQtStringList }
|
|
|
|
function TQtStringList.Get(Index: Integer): string;
|
|
var
|
|
W: Widestring;
|
|
begin
|
|
QStringList_at(FHandle, @W, Index);
|
|
Result := UTF16ToUTF8(W);
|
|
end;
|
|
|
|
function TQtStringList.GetCount: Integer;
|
|
begin
|
|
Result := QStringList_size(FHandle);
|
|
end;
|
|
|
|
constructor TQtStringList.Create;
|
|
begin
|
|
FHandle := QStringList_create();
|
|
FOwnHandle := True;
|
|
end;
|
|
|
|
constructor TQtStringList.Create(Source: QStringListH);
|
|
begin
|
|
FHandle := Source;
|
|
FOwnHandle := False;
|
|
end;
|
|
|
|
destructor TQtStringList.Destroy;
|
|
begin
|
|
if FOwnHandle then
|
|
QStringList_destroy(FHandle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtStringList.Clear;
|
|
begin
|
|
QStringList_clear(FHandle);
|
|
end;
|
|
|
|
procedure TQtStringList.Delete(Index: Integer);
|
|
begin
|
|
QStringList_removeAt(FHandle, Index);
|
|
end;
|
|
|
|
procedure TQtStringList.Insert(Index: Integer; const S: string);
|
|
var
|
|
W: WideString;
|
|
begin
|
|
W := GetUtf8String(S);
|
|
QStringList_insert(FHandle, Index, @W);
|
|
end;
|
|
|
|
{ TQtCursor }
|
|
|
|
constructor TQtCursor.Create;
|
|
begin
|
|
FHandle := QCursor_create();
|
|
end;
|
|
|
|
constructor TQtCursor.Create(pixmap: QPixmapH; hotX: Integer = -1; hotY: Integer = -1);
|
|
begin
|
|
FHandle := QCursor_create(pixmap, hotX, hotY);
|
|
end;
|
|
|
|
constructor TQtCursor.Create(shape: QtCursorShape);
|
|
begin
|
|
FHandle := QCursor_create(shape);
|
|
end;
|
|
|
|
destructor TQtCursor.Destroy;
|
|
begin
|
|
if FHandle <> nil then
|
|
QCursor_destroy(FHandle);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TQtWidgetPalette }
|
|
|
|
procedure TQtWidgetPalette.initializeSysColors;
|
|
var
|
|
Palette: QPaletteH;
|
|
begin
|
|
FillChar(FCurrentColor, SizeOf(FCurrentColor), 0);
|
|
FillChar(FCurrentColor, SizeOf(FCurrentTextColor), 0);
|
|
Palette := QPalette_create();
|
|
try
|
|
QApplication_palette(Palette);
|
|
FDefaultColor := QPalette_color(Palette, QPaletteActive, FWidgetRole)^;
|
|
FDefaultTextColor := QPalette_color(Palette, QPaletteActive, FTextRole)^;
|
|
FDisabledColor := QPalette_color(Palette, QPaletteDisabled, FWidgetRole)^;
|
|
FDisabledTextColor := QPalette_color(Palette, QPaletteDisabled, FTextRole)^;
|
|
finally
|
|
QPalette_destroy(Palette);
|
|
end;
|
|
end;
|
|
|
|
constructor TQtWidgetPalette.Create(AWidgetColorRole: QPaletteColorRole;
|
|
AWidgetTextColorRole: QPaletteColorRole; AWidget: QWidgetH);
|
|
begin
|
|
FInReload := False;
|
|
FForceColor := False;
|
|
FWidget := AWidget;
|
|
FWidgetRole := AWidgetColorRole;
|
|
FTextRole := AWidgetTextColorRole;
|
|
initializeSysColors;
|
|
|
|
// ugly qt mac bug
|
|
{$IFDEF DARWIN}
|
|
if QWidget_backgroundRole(FWidget) <> FWidgetRole then
|
|
begin
|
|
QWidget_setBackgroundRole(FWidget, FWidgetRole);
|
|
QWidget_setForegroundRole(FWidget, FTextRole);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
FHandle := QPalette_create();
|
|
end;
|
|
|
|
destructor TQtWidgetPalette.Destroy;
|
|
begin
|
|
if FHandle <> nil then
|
|
QPalette_destroy(FHandle);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtWidgetPalette.ColorChangeNeeded(const AColor: TQColor;
|
|
const ATextRole: Boolean): Boolean;
|
|
begin
|
|
if ATextRole then
|
|
Result := not (EqualTQColor(AColor, FDefaultTextColor) and
|
|
EqualTQColor(FCurrentTextColor, FDefaultTextColor))
|
|
else
|
|
Result := not (EqualTQColor(AColor, FDefaultColor) and
|
|
EqualTQColor(FCurrentColor, FDefaultColor));
|
|
end;
|
|
|
|
procedure TQtWidgetPalette.setColor(const AColor: PQColor);
|
|
begin
|
|
if not ColorChangeNeeded(AColor^, False) and not FInReload and not FForceColor then
|
|
exit;
|
|
|
|
QPalette_setColor(FHandle, QPaletteActive, FWidgetRole, AColor);
|
|
QPalette_setColor(FHandle, QPaletteInActive, FWidgetRole, AColor);
|
|
|
|
if EqualTQColor(AColor^, FDefaultColor) then
|
|
QPalette_setColor(FHandle, QPaletteDisabled, FWidgetRole, @FDisabledColor)
|
|
else
|
|
QPalette_setColor(FHandle, QPaletteDisabled, FWidgetRole, AColor);
|
|
|
|
QWidget_setPalette(FWidget, FHandle);
|
|
FCurrentColor := AColor^;
|
|
end;
|
|
|
|
procedure TQtWidgetPalette.setTextColor(const AColor: PQColor);
|
|
begin
|
|
if not ColorChangeNeeded(AColor^, True) and not FInReload and not FForceColor then
|
|
exit;
|
|
QPalette_setColor(FHandle, QPaletteActive, FTextRole, AColor);
|
|
QPalette_setColor(FHandle, QPaletteInActive, FTextRole, AColor);
|
|
if EqualTQColor(AColor^, FDefaultTextColor) or
|
|
EqualTQColor(FCurrentColor, FDefaultColor) then
|
|
QPalette_setColor(FHandle, QPaletteDisabled, FTextRole, @FDisabledTextColor)
|
|
else
|
|
QPalette_setColor(FHandle, QPaletteDisabled, FTextRole, AColor);
|
|
QWidget_setPalette(FWidget, FHandle);
|
|
FCurrentTextColor := AColor^;
|
|
end;
|
|
|
|
procedure TQtWidgetPalette.ReloadPaletteBegin;
|
|
var
|
|
AOldCurrent, AOldText: TQColor;
|
|
begin
|
|
FInReload := True;
|
|
AOldCurrent := FCurrentColor;
|
|
AOldText := FCurrentTextColor;
|
|
initializeSysColors;
|
|
FCurrentColor := AOldCurrent;
|
|
FCurrentTextColor := AOldText;
|
|
end;
|
|
|
|
procedure TQtWidgetPalette.ReloadPaletteEnd;
|
|
begin
|
|
FInReload := False;
|
|
end;
|
|
|
|
{ TQtActionGroup }
|
|
|
|
constructor TQtActionGroup.Create(const AParent: QObjectH);
|
|
begin
|
|
FGroupIndex := 0;
|
|
Initialize(FActions);
|
|
FHandle := QActionGroup_create(AParent);
|
|
end;
|
|
|
|
destructor TQtActionGroup.Destroy;
|
|
begin
|
|
if FHandle <> nil then
|
|
QActionGroup_destroy(FHandle);
|
|
Finalize(FActions);
|
|
FActions := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TQtActionGroup.getEnabled: boolean;
|
|
begin
|
|
Result := QActionGroup_isEnabled(FHandle);
|
|
end;
|
|
|
|
function TQtActionGroup.getExclusive: boolean;
|
|
begin
|
|
Result := QActionGroup_isExclusive(FHandle);
|
|
end;
|
|
|
|
function TQtActionGroup.getVisible: boolean;
|
|
begin
|
|
Result := QActionGroup_isVisible(FHandle);
|
|
end;
|
|
|
|
procedure TQtActionGroup.setEnabled(const AValue: boolean);
|
|
begin
|
|
QActionGroup_setEnabled(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtActionGroup.setExclusive(const AValue: boolean);
|
|
begin
|
|
QActionGroup_setExclusive(FHandle, AValue);
|
|
end;
|
|
|
|
procedure TQtActionGroup.setVisible(const AValue: boolean);
|
|
begin
|
|
QActionGroup_setVisible(FHandle, AValue);
|
|
end;
|
|
|
|
function TQtActionGroup.addAction(action: QActionH): QActionH;
|
|
begin
|
|
Result := QActionGroup_addAction(FHandle, action);
|
|
end;
|
|
|
|
function TQtActionGroup.addAction(text: WideString): QActionH;
|
|
var
|
|
WStr: WideString;
|
|
begin
|
|
WStr := GetUTF8String(text);
|
|
Result := QActionGroup_addAction(FHandle, @WStr);
|
|
end;
|
|
|
|
function TQtActionGroup.addAction(icon: QIconH; text: WideString): QActionH;
|
|
var
|
|
WStr: WideString;
|
|
begin
|
|
WStr := GetUTF8String(text);
|
|
Result := QActionGroup_addAction(FHandle, icon, @WStr);
|
|
end;
|
|
|
|
procedure TQtActionGroup.removeAction(action: QActionH);
|
|
begin
|
|
QActionGroup_removeAction(FHandle, action);
|
|
end;
|
|
|
|
function TQtActionGroup.actions: TQActions;
|
|
var
|
|
i: Integer;
|
|
Arr: TPtrIntArray;
|
|
begin
|
|
QActionGroup_actions(FHandle, @Arr);
|
|
SetLength(FActions, length(Arr));
|
|
for i := 0 to High(Arr) do
|
|
FActions[i] := QActionH(Arr[i]);
|
|
Result := FActions;
|
|
end;
|
|
|
|
function TQtActionGroup.checkedAction: QActionH;
|
|
begin
|
|
Result := QActionGroup_checkedAction(FHandle);
|
|
end;
|
|
|
|
procedure TQtActionGroup.setDisabled(ADisabled: Boolean);
|
|
begin
|
|
QActionGroup_setDisabled(FHandle, ADisabled);
|
|
end;
|
|
|
|
{ TQtObjectDump }
|
|
|
|
procedure TQtObjectDump.Iterator(ARoot: QObjectH);
|
|
var
|
|
i: Integer;
|
|
Children: TPtrIntArray;
|
|
begin
|
|
QObject_children(ARoot, @Children);
|
|
AddToList(ARoot);
|
|
for i := 0 to High(Children) do
|
|
Iterator(QObjectH(Children[i]))
|
|
end;
|
|
|
|
procedure TQtObjectDump.AddToList(AnObject: QObjectH);
|
|
// var
|
|
// ObjName: WideString;
|
|
begin
|
|
if AnObject <> nil then
|
|
begin
|
|
// QObject_objectName(AnObject, @ObjName);
|
|
if FObjList.IndexOf(AnObject) < 0 then
|
|
begin
|
|
FList.Add(dbghex(PtrUInt(AnObject)));
|
|
FObjList.Add(AnObject);
|
|
end else
|
|
raise Exception.Create('TQtObjectDump: Duplicated object in list '+dbghex(PtrUInt(AnObject)));
|
|
end;
|
|
end;
|
|
|
|
procedure TQtObjectDump.DumpObject;
|
|
begin
|
|
if FRoot = nil then
|
|
raise Exception.Create('TQtObjectDump: Invalid FRoot '+dbghex(PtrUInt(FRoot)));
|
|
Iterator(FRoot);
|
|
end;
|
|
|
|
function TQtObjectDump.findWidgetByName(const AName: WideString): QWidgetH;
|
|
var
|
|
j: Integer;
|
|
WS: WideString;
|
|
begin
|
|
Result := nil;
|
|
if AName = '' then
|
|
exit;
|
|
for j := 0 to FObjList.Count - 1 do
|
|
begin
|
|
QObject_objectName(QObjectH(FObjList.Items[j]), @WS);
|
|
if (WS = AName) and QObject_isWidgetType(QObjectH(FObjList.Items[j])) then
|
|
begin
|
|
Result := QWidgetH(FObjList.Items[j]);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TQtObjectDump.IsWidget(AnObject: QObjectH): Boolean;
|
|
begin
|
|
if AnObject <> nil then
|
|
Result := QObject_IsWidgetType(AnObject)
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TQtObjectDump.GetObjectName(AnObject: QObjectH): WideString;
|
|
begin
|
|
Result := '';
|
|
if AnObject = nil then
|
|
exit;
|
|
QObject_objectName(AnObject, @Result);
|
|
end;
|
|
|
|
function TQtObjectDump.InheritsQtClass(AnObject: QObjectH;
|
|
AQtClass: WideString): Boolean;
|
|
begin
|
|
if (AnObject = nil) or (AQtClass = '') then
|
|
Result := False
|
|
else
|
|
Result := QObject_inherits(AnObject, @AQtClass);
|
|
end;
|
|
|
|
constructor TQtObjectDump.Create(AnObject: QObjectH);
|
|
begin
|
|
FRoot := AnObject;
|
|
FList := TStringList.Create;
|
|
FObjList := TFPList.Create;
|
|
end;
|
|
|
|
destructor TQtObjectDump.Destroy;
|
|
begin
|
|
FList.Free;
|
|
FObjList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TQtGDIObjects }
|
|
|
|
constructor TQtGDIObjects.Create;
|
|
begin
|
|
inherited Create;
|
|
{$IFDEF DebugQTGDIObjects}
|
|
FMaxCount := 0;
|
|
FInvalidCount := 0;
|
|
{$ENDIF}
|
|
FCount := 0;
|
|
FSavedHandlesList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TObject));
|
|
{$IFDEF DebugQTGDIObjects}
|
|
DebugLn('TQtGDIObjects.Create ');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TQtGDIObjects.Destroy;
|
|
begin
|
|
{$IFDEF DebugQTGDIObjects}
|
|
DebugLn('TQtGDIObjects.Destroy: Count (must be zero) ',dbgs(FCount),
|
|
' FMaxCount ',dbgs(FMaxCount),' FInvalidCount ',dbgs(FInvalidCount));
|
|
{$ENDIF}
|
|
FSavedHandlesList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TQtGDIObjects.AddGDIObject(AObject: TObject);
|
|
begin
|
|
if not FSavedHandlesList.HasId(AObject) then
|
|
begin
|
|
FSavedHandlesList.Add(AObject, AObject);
|
|
inc(FCount);
|
|
{$IFDEF DebugQTGDIObjects}
|
|
if FMaxCount < FCount then
|
|
FMaxCount := FCount;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TQtGDIObjects.RemoveGDIObject(AObject: TObject);
|
|
begin
|
|
if FSavedHandlesList.HasId(AObject) then
|
|
begin
|
|
FSavedHandlesList.Delete(AObject);
|
|
dec(FCount);
|
|
end;
|
|
end;
|
|
|
|
function TQtGDIObjects.IsValidGDIObject(AGDIObject: PtrUInt): Boolean;
|
|
begin
|
|
if (AGDIObject = 0) then
|
|
Exit(False);
|
|
Result := FSavedHandlesList.HasId(TObject(AGDIObject));
|
|
{$IFDEF DebugQTGDIObjects}
|
|
if not Result then
|
|
begin
|
|
inc(FInvalidCount);
|
|
DebugLn('TQtGDIObjects.IsValidGDIObject: Invalid object ',dbgs(AGDIObject));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end.
|
|
|
|
|
|
|
|
|
|
|