mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 19:23:44 +02:00
3544 lines
94 KiB
ObjectPascal
3544 lines
94 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 copyright. *
|
||
* *
|
||
* This program is distributed in the hope that it will be useful, *
|
||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||
* *
|
||
*****************************************************************************
|
||
}
|
||
unit qtobjects;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
interface
|
||
|
||
{$I qtdefines.inc}
|
||
|
||
uses
|
||
// Bindings
|
||
qt4,
|
||
// Free Pascal
|
||
Classes, SysUtils, Types,
|
||
// LCL
|
||
LCLType, LCLIntf, Menus, LCLProc, Graphics, ClipBrd;
|
||
|
||
type
|
||
// forward declarations
|
||
TQtImage = class;
|
||
TQtFontMetrics = class;
|
||
|
||
{ TQtObject }
|
||
TQtObject = class(TObject)
|
||
private
|
||
FUpdateCount: Integer;
|
||
FInEventCount: Integer;
|
||
FReleaseInEvent: Boolean;
|
||
public
|
||
{$IF DEFINED(USE_QT_44) or DEFINED(USE_QT_45)}
|
||
FDeleteLater: Boolean;
|
||
{$ENDIF}
|
||
FEventHook: 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 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;
|
||
|
||
{ TQtAction }
|
||
|
||
TQtAction = class(TObject)
|
||
private
|
||
FIcon: QIconH;
|
||
public
|
||
Handle: 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;
|
||
public
|
||
Handle: 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;
|
||
end;
|
||
|
||
{ TQtFont }
|
||
|
||
TQtFont = class(TQtResource)
|
||
private
|
||
FDefaultFont: QFontH;
|
||
FMetrics: TQtFontMetrics;
|
||
function GetMetrics: TQtFontMetrics;
|
||
function GetDefaultFont: QFontH;
|
||
public
|
||
Widget: QFontH;
|
||
Angle: Integer;
|
||
public
|
||
constructor Create(CreateHandle: Boolean; Const AShared: Boolean = False); 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 Metrics: TQtFontMetrics read GetMetrics;
|
||
end;
|
||
|
||
{ TQtFontMetrics }
|
||
|
||
TQtFontMetrics = class(TObject)
|
||
private
|
||
public
|
||
Widget: 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;
|
||
end;
|
||
|
||
{ TQtBrush }
|
||
|
||
TQtBrush = class(TQtResource)
|
||
private
|
||
public
|
||
Widget: QBrushH;
|
||
constructor Create(CreateHandle: Boolean; const AShared: Boolean = False); virtual;
|
||
destructor Destroy; override;
|
||
function getColor: PQColor;
|
||
procedure setColor(AColor: PQColor);
|
||
procedure setStyle(style: QtBrushStyle);
|
||
procedure setTexture(pixmap: QPixmapH);
|
||
procedure setTextureImage(image: QImageH);
|
||
end;
|
||
|
||
{ TQtPen }
|
||
|
||
TQtPen = class(TQtResource)
|
||
private
|
||
FIsExtPen: Boolean;
|
||
public
|
||
Widget: QPenH;
|
||
constructor Create(CreateHandle: Boolean; const AShared: Boolean = False); 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
|
||
public
|
||
Widget: 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 GetRegionType: integer;
|
||
function getBoundingRect: TRect;
|
||
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
|
||
FPenPos: TQtPoint;
|
||
FOwnPainter: Boolean;
|
||
SelFont: TQTFont;
|
||
SelBrush: TQTBrush;
|
||
SelPen: TQtPen;
|
||
PenColor: TQColor;
|
||
procedure RestorePenColor;
|
||
procedure RestoreTextColor;
|
||
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: TColor;
|
||
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);
|
||
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 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;
|
||
|
||
procedure getBrushOrigin(retval: PPoint);
|
||
function getClipping: Boolean;
|
||
function getCompositionMode: QPainterCompositionMode;
|
||
procedure setCompositionMode(mode: QPainterCompositionMode);
|
||
procedure getPenPos(retval: PPoint);
|
||
function getWorldMatrix: QMatrixH;
|
||
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 pen: TQtPen;
|
||
function setPen(APen: TQtPen): TQtPen;
|
||
function SetBkColor(Color: TcolorRef): TColorRef;
|
||
function SetBkMode(BkMode: Integer): 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);
|
||
procedure rotate(a: Double);
|
||
procedure setRenderHint(AHint: QPainterRenderHint; AValue: Boolean);
|
||
procedure save;
|
||
procedure restore;
|
||
procedure translate(dx: Double; dy: Double);
|
||
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)
|
||
public
|
||
Handle: QSystemTrayIconH;
|
||
public
|
||
constructor Create(vIcon: QIconH); virtual;
|
||
destructor Destroy; override;
|
||
public
|
||
procedure setContextMenu(menu: QMenuH);
|
||
procedure setIcon(icon: QIconH);
|
||
procedure setToolTip(tip: WideString);
|
||
procedure show;
|
||
procedure hide;
|
||
end;
|
||
|
||
{ TQtButtonGroup }
|
||
|
||
TQtButtonGroup = class(TObject)
|
||
private
|
||
public
|
||
constructor Create(AParent: QObjectH); virtual;
|
||
destructor Destroy; override;
|
||
Handle: QButtonGroupH;
|
||
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;
|
||
FClipChanged: Boolean;
|
||
FClipBoardFormats: TStringList;
|
||
FOnClipBoardRequest: TClipboardRequestEvent;
|
||
function IsClipboardChanged: Boolean;
|
||
public
|
||
constructor Create; override;
|
||
destructor Destroy; override;
|
||
procedure AttachEvents; 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;
|
||
end;
|
||
|
||
{ TQtPrinter }
|
||
|
||
TQtPrinter = class(TObject)
|
||
protected
|
||
FHandle: QPrinterH;
|
||
FPrinterContext: TQtDeviceContext;
|
||
private
|
||
FPrinterActive: Boolean;
|
||
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 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;
|
||
destructor Destroy; override;
|
||
|
||
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;
|
||
function PaperRect: TRect;
|
||
function PrintEngine: QPrintEngineH;
|
||
|
||
property Collate: Boolean read getCollateCopies write setCollateCopies;
|
||
property ColorMode: QPrinterColorMode read getColorMode write setColorMode;
|
||
property Creator: WideString read getCreator write setCreator;
|
||
property DocName: WideString read getDocName write setDocName;
|
||
property DoubleSidedPrinting: Boolean read getDoubleSidedPrinting write setDoubleSidedPrinting;
|
||
property DeviceType: Integer read getDevType;
|
||
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: TFNTimerProc;
|
||
FId: Integer;
|
||
FAppObject: QObjectH;
|
||
public
|
||
constructor CreateTimer(Interval: integer; const TimerFunc: TFNTimerProc; App: QObjectH); virtual;
|
||
destructor Destroy; override;
|
||
procedure AttachEvents; override;
|
||
procedure DetachEvents; override;
|
||
procedure signalTimeout; cdecl;
|
||
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;
|
||
|
||
const
|
||
LCLQt_Destroy = QEventType(Ord(QEventUser) + $1000);
|
||
|
||
procedure TQColorToColorRef(const AColor: TQColor; out AColorRef: TColorRef);
|
||
procedure ColorRefToTQColor(const AColorRef: TColorRef; var AColor:TQColor);
|
||
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;
|
||
|
||
implementation
|
||
|
||
uses
|
||
qtproc;
|
||
|
||
const
|
||
ClipbBoardTypeToQtClipboard: array[TClipboardType] of QClipboardMode =
|
||
(
|
||
{ctPrimarySelection } QClipboardSelection,
|
||
{ctSecondarySelection} QClipboardSelection,
|
||
{ctClipboard } QClipboardClipboard
|
||
);
|
||
|
||
const
|
||
SQTWSPrefix = 'TQTWidgetSet.';
|
||
|
||
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 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;
|
||
|
||
{ TQtObject }
|
||
|
||
constructor TQtObject.Create;
|
||
begin
|
||
{$IF DEFINED(USE_QT_44) or DEFINED(USE_QT_45)}
|
||
FDeleteLater := False;
|
||
{$ENDIF}
|
||
FEventHook := nil;
|
||
FUpdateCount := 0;
|
||
FInEventCount := 0;
|
||
FReleaseInEvent := False;
|
||
end;
|
||
|
||
destructor TQtObject.Destroy;
|
||
begin
|
||
if TheObject <> nil then
|
||
begin
|
||
{$IF DEFINED(USE_QT_44) or DEFINED(USE_QT_45)}
|
||
DetachEvents;
|
||
if FDeleteLater then
|
||
QObject_deleteLater(TheObject)
|
||
else
|
||
QObject_destroy(TheObject);
|
||
{$ELSE}
|
||
QCoreApplication_removePostedEvents(TheObject);
|
||
DetachEvents;
|
||
QObject_deleteLater(TheObject);
|
||
{$ENDIF}
|
||
TheObject := nil;
|
||
end;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TQtObject.Release;
|
||
begin
|
||
if InEvent then
|
||
begin
|
||
{$IF DEFINED(USE_QT_44) or DEFINED(USE_QT_45)}
|
||
FDeleteLater := True;
|
||
{$ENDIF}
|
||
FReleaseInEvent := True;
|
||
end else
|
||
Free;
|
||
end;
|
||
|
||
procedure TQtObject.AttachEvents;
|
||
var
|
||
Method: TMethod;
|
||
begin
|
||
FEventHook := QObject_hook_create(TheObject);
|
||
TEventFilterMethod(Method) := @EventFilter;
|
||
QObject_hook_hook_events(FEventHook, Method);
|
||
end;
|
||
|
||
procedure TQtObject.DetachEvents;
|
||
begin
|
||
if FEventHook <> nil then
|
||
begin
|
||
QObject_hook_destroy(FEventHook);
|
||
FEventHook := nil;
|
||
end;
|
||
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
|
||
Handle := AHandle;
|
||
FIcon := nil;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtAction.Destroy
|
||
|
||
Destructor for the class.
|
||
------------------------------------------------------------------------------}
|
||
destructor TQtAction.Destroy;
|
||
begin
|
||
if FIcon <> nil then
|
||
QIcon_destroy(FIcon);
|
||
|
||
if Handle <> nil then
|
||
QAction_destroy(Handle);
|
||
|
||
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(Handle, 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(Handle, p1);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtAction.setEnabled
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtAction.setEnabled(p1: Boolean);
|
||
begin
|
||
QAction_setEnabled(Handle, p1);
|
||
end;
|
||
|
||
procedure TQtAction.setIcon(const AIcon: QIconH);
|
||
begin
|
||
QAction_setIcon(Handle, 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(Handle, p1);
|
||
end;
|
||
|
||
{ TQtImage }
|
||
|
||
constructor TQtImage.Create;
|
||
begin
|
||
Handle := QImage_create();
|
||
FData := nil;
|
||
FDataOwner := False;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtImage.Create
|
||
|
||
Constructor for the class.
|
||
------------------------------------------------------------------------------}
|
||
constructor TQtImage.Create(vHandle: QImageH);
|
||
begin
|
||
Handle := vHandle;
|
||
FData := nil;
|
||
FDataOwner := False;
|
||
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
|
||
Handle := QImage_create(width, height, format);
|
||
QImage_fill(Handle, 0);
|
||
end
|
||
else
|
||
Handle := QImage_create(FData, width, height, format);
|
||
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
|
||
Handle := QImage_create(width, height, format)
|
||
else
|
||
Handle := QImage_create(FData, width, height, bytesPerLine, format);
|
||
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}
|
||
|
||
if Handle <> nil then
|
||
QImage_destroy(Handle);
|
||
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, Handle, flags);
|
||
end;
|
||
|
||
function TQtImage.AsBitmap(flags: QtImageConversionFlags = QtAutoColor): QBitmapH;
|
||
begin
|
||
Result := QBitmap_create();
|
||
QBitmap_fromImage(Result, Handle, flags);
|
||
end;
|
||
|
||
procedure TQtImage.CopyFrom(AImage: QImageH; x, y, w, h: integer);
|
||
begin
|
||
QImage_copy(AImage, Handle, x, y, w, h);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtImage.height
|
||
Params: None
|
||
Returns: The height of the image
|
||
------------------------------------------------------------------------------}
|
||
function TQtImage.height: Integer;
|
||
begin
|
||
Result := QImage_height(Handle);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtImage.width
|
||
Params: None
|
||
Returns: The width of the image
|
||
------------------------------------------------------------------------------}
|
||
function TQtImage.width: Integer;
|
||
begin
|
||
Result := QImage_width(Handle);
|
||
end;
|
||
|
||
function TQtImage.depth: Integer;
|
||
begin
|
||
Result := QImage_depth(Handle);
|
||
end;
|
||
|
||
function TQtImage.dotsPerMeterX: Integer;
|
||
begin
|
||
Result := QImage_dotsPerMeterX(Handle);
|
||
end;
|
||
|
||
function TQtImage.dotsPerMeterY: Integer;
|
||
begin
|
||
Result := QImage_dotsPerMeterY(Handle);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtImage.bits
|
||
Params: None
|
||
Returns: The internal array of bits of the image
|
||
------------------------------------------------------------------------------}
|
||
function TQtImage.bits: PByte;
|
||
begin
|
||
Result := QImage_bits(Handle);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TQtImage.numBytes
|
||
Params: None
|
||
Returns: The number of bytes the image occupies in memory
|
||
------------------------------------------------------------------------------}
|
||
function TQtImage.numBytes: Integer;
|
||
begin
|
||
Result := QImage_numBytes(Handle);
|
||
end;
|
||
|
||
function TQtImage.bytesPerLine: Integer;
|
||
begin
|
||
Result := QImage_bytesPerLine(Handle);
|
||
end;
|
||
|
||
procedure TQtImage.invertPixels(InvertMode: QImageInvertMode = QImageInvertRgb);
|
||
begin
|
||
QImage_invertPixels(Handle, InvertMode);
|
||
end;
|
||
|
||
function TQtImage.getFormat: QImageFormat;
|
||
begin
|
||
Result := QImage_format(Handle);
|
||
end;
|
||
|
||
{ TQtFont }
|
||
|
||
function TQtFont.GetMetrics: TQtFontMetrics;
|
||
begin
|
||
if FMetrics = nil then
|
||
begin
|
||
if Widget = nil then
|
||
FMetrics := TQtFontMetrics.Create(getDefaultFont)
|
||
else
|
||
FMetrics := TQtFontMetrics.Create(Widget);
|
||
end;
|
||
Result := FMetrics;
|
||
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; Const AShared: Boolean = False);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtFont.Create CreateHandle: ', dbgs(CreateHandle));
|
||
{$endif}
|
||
|
||
if CreateHandle then
|
||
Widget := QFont_create;
|
||
|
||
FShared := AShared;
|
||
FMetrics := nil;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtFont.Destroy
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
destructor TQtFont.Destroy;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtFont.Destroy');
|
||
{$endif}
|
||
|
||
FMetrics.Free;
|
||
if not FShared and (Widget <> nil) then
|
||
QFont_destroy(Widget);
|
||
|
||
if FDefaultFont <> nil then
|
||
QFont_destroy(FDefaultFont);
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TQtFont.getPointSize: Integer;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_pointSize(getDefaultFont)
|
||
else
|
||
Result := QFont_pointSize(Widget);
|
||
end;
|
||
|
||
procedure TQtFont.setPointSize(p1: Integer);
|
||
begin
|
||
if p1 > 0 then
|
||
QFont_setPointSize(Widget, p1);
|
||
end;
|
||
|
||
function TQtFont.getPixelSize: Integer;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_pixelSize(getDefaultFont)
|
||
else
|
||
Result := QFont_pixelSize(Widget);
|
||
end;
|
||
|
||
procedure TQtFont.setPixelSize(p1: Integer);
|
||
begin
|
||
if p1 > 0 then
|
||
QFont_setPixelSize(Widget, p1);
|
||
end;
|
||
|
||
function TQtFont.getWeight: Integer;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_weight(getDefaultFont)
|
||
else
|
||
Result := QFont_weight(Widget);
|
||
end;
|
||
|
||
function TQtFont.getItalic: Boolean;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_italic(getDefaultFont)
|
||
else
|
||
Result := QFont_italic(Widget);
|
||
end;
|
||
|
||
function TQtFont.getBold: Boolean;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_bold(getDefaultFont)
|
||
else
|
||
Result := QFont_bold(Widget);
|
||
end;
|
||
|
||
function TQtFont.getUnderline: Boolean;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_underline(getDefaultFont)
|
||
else
|
||
Result := QFont_underline(Widget);
|
||
end;
|
||
|
||
function TQtFont.getStrikeOut: Boolean;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_strikeOut(getDefaultFont)
|
||
else
|
||
Result := QFont_strikeOut(Widget);
|
||
end;
|
||
|
||
function TQtFont.getFamily: WideString;
|
||
begin
|
||
if Widget = nil then
|
||
QFont_family(getDefaultFont, @Result)
|
||
else
|
||
QFont_family(Widget, @Result);
|
||
end;
|
||
|
||
function TQtFont.getStyleStategy: QFontStyleStrategy;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_styleStrategy(getDefaultFont)
|
||
else
|
||
Result := QFont_styleStrategy(Widget);
|
||
end;
|
||
|
||
procedure TQtFont.setWeight(p1: Integer);
|
||
begin
|
||
QFont_setWeight(Widget, p1);
|
||
end;
|
||
|
||
procedure TQtFont.setBold(p1: Boolean);
|
||
begin
|
||
QFont_setBold(Widget, p1);
|
||
end;
|
||
|
||
procedure TQtFont.setItalic(b: Boolean);
|
||
begin
|
||
QFont_setItalic(Widget, b);
|
||
end;
|
||
|
||
procedure TQtFont.setUnderline(p1: Boolean);
|
||
begin
|
||
QFont_setUnderline(Widget, p1);
|
||
end;
|
||
|
||
procedure TQtFont.setStrikeOut(p1: Boolean);
|
||
begin
|
||
QFont_setStrikeOut(Widget, p1);
|
||
end;
|
||
|
||
procedure TQtFont.setRawName(p1: string);
|
||
var
|
||
Str: WideString;
|
||
begin
|
||
Str := GetUtf8String(p1);
|
||
|
||
QFont_setRawName(Widget, @Str);
|
||
end;
|
||
|
||
procedure TQtFont.setFamily(p1: string);
|
||
var
|
||
Str: WideString;
|
||
begin
|
||
Str := GetUtf8String(p1);
|
||
|
||
QFont_setFamily(Widget, @Str);
|
||
end;
|
||
|
||
procedure TQtFont.setStyleStrategy(s: QFontStyleStrategy);
|
||
begin
|
||
QFont_setStyleStrategy(Widget, s);
|
||
end;
|
||
|
||
procedure TQtFont.family(retval: PWideString);
|
||
begin
|
||
if Widget = nil then
|
||
QFont_family(getDefaultFont, retval)
|
||
else
|
||
QFont_family(Widget, retval);
|
||
end;
|
||
|
||
function TQtFont.fixedPitch: Boolean;
|
||
begin
|
||
if Widget = nil then
|
||
Result := QFont_fixedPitch(getDefaultFont)
|
||
else
|
||
Result := QFont_fixedPitch(Widget);
|
||
end;
|
||
|
||
{ TQtFontMetrics }
|
||
|
||
constructor TQtFontMetrics.Create(Parent: QFontH);
|
||
begin
|
||
Widget := QFontMetrics_create(Parent);
|
||
end;
|
||
|
||
destructor TQtFontMetrics.Destroy;
|
||
begin
|
||
QFontMetrics_destroy(Widget);
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TQtFontMetrics.height: Integer;
|
||
begin
|
||
Result := QFontMetrics_height(Widget);
|
||
end;
|
||
|
||
function TQtFontMetrics.width(p1: PWideString): Integer;
|
||
begin
|
||
Result := QFontMetrics_width(Widget, p1);
|
||
end;
|
||
|
||
function TQtFontMetrics.width(p1: PWideString; ALen: Integer): Integer;
|
||
begin
|
||
Result := QFontMetrics_width(Widget, p1, ALen);
|
||
end;
|
||
|
||
function TQtFontMetrics.ascent: Integer;
|
||
begin
|
||
Result := QFontMetrics_ascent(Widget);
|
||
end;
|
||
|
||
function TQtFontMetrics.descent: Integer;
|
||
begin
|
||
Result := QFontMetrics_descent(Widget);
|
||
end;
|
||
|
||
function TQtFontMetrics.leading: Integer;
|
||
begin
|
||
Result := QFontMetrics_leading(Widget);
|
||
end;
|
||
|
||
function TQtFontMetrics.maxWidth: Integer;
|
||
begin
|
||
Result := QFontMetrics_maxWidth(Widget);
|
||
end;
|
||
|
||
procedure TQtFontMetrics.boundingRect(retval: PRect; r: PRect; flags: Integer; text: PWideString; tabstops: Integer = 0; tabarray: PInteger = nil);
|
||
begin
|
||
QFontMetrics_boundingRect(Widget, retval, r, flags, text, tabstops, tabarray);
|
||
end;
|
||
|
||
function TQtFontMetrics.charWidth(str: WideString; pos: Integer): Integer;
|
||
begin
|
||
Result := QFontMetrics_charWidth(Widget, @str, pos);
|
||
end;
|
||
|
||
function TQtFontMetrics.averageCharWidth: Integer;
|
||
begin
|
||
Result := QFontMetrics_averageCharWidth(Widget);
|
||
end;
|
||
|
||
{ TQtBrush }
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtBrush.Create
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
constructor TQtBrush.Create(CreateHandle: Boolean; Const AShared: Boolean = False);
|
||
begin
|
||
// Creates the widget
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtBrush.Create CreateHandle: ', dbgs(CreateHandle));
|
||
{$endif}
|
||
|
||
if CreateHandle then
|
||
Widget := QBrush_create;
|
||
|
||
FShared := AShared;
|
||
FSelected := False;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtBrush.Destroy
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
destructor TQtBrush.Destroy;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtBrush.Destroy');
|
||
{$endif}
|
||
|
||
if not FShared and (Widget <> nil) and not FSelected then
|
||
QBrush_destroy(Widget);
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TQtBrush.getColor: PQColor;
|
||
begin
|
||
Result := QBrush_Color(Widget);
|
||
end;
|
||
|
||
procedure TQtBrush.setColor(AColor: PQColor);
|
||
begin
|
||
QBrush_setColor(Widget, AColor);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtBrush.setStyle
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtBrush.setStyle(style: QtBrushStyle);
|
||
begin
|
||
QBrush_setStyle(Widget, style);
|
||
end;
|
||
|
||
procedure TQtBrush.setTexture(pixmap: QPixmapH);
|
||
begin
|
||
QBrush_setTexture(Widget, 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(Widget, TempImage);
|
||
QImage_destroy(TempImage);
|
||
end;
|
||
|
||
{ TQtPen }
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtPen.Create
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
constructor TQtPen.Create(CreateHandle: Boolean; const AShared: Boolean = False);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtPen.Create CreateHandle: ', dbgs(CreateHandle));
|
||
{$endif}
|
||
|
||
if CreateHandle then
|
||
Widget := QPen_create;
|
||
FShared := AShared;
|
||
FIsExtPen := False;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtPen.Destroy
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
destructor TQtPen.Destroy;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtPen.Destroy');
|
||
{$endif}
|
||
|
||
if not FShared and (Widget <> nil) then
|
||
QPen_destroy(Widget);
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TQtPen.getCapStyle: QtPenCapStyle;
|
||
begin
|
||
Result := QPen_capStyle(Widget);
|
||
end;
|
||
|
||
function TQtPen.getWidth: Integer;
|
||
begin
|
||
Result := QPen_width(Widget);
|
||
end;
|
||
|
||
function TQtPen.getStyle: QtPenStyle;
|
||
begin
|
||
Result := QPen_style(Widget);
|
||
end;
|
||
|
||
function TQtPen.getDashPattern: TQRealArray;
|
||
begin
|
||
QPen_dashPattern(Widget, @Result);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtPen.setBrush
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
|
||
procedure TQtPen.setBrush(brush: QBrushH);
|
||
begin
|
||
QPen_setBrush(Widget, brush);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtPen.setStyle
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtPen.setStyle(AStyle: QtPenStyle);
|
||
begin
|
||
QPen_setStyle(Widget, AStyle);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtPen.setWidth
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtPen.setWidth(p1: Integer);
|
||
begin
|
||
QPen_setWidth(Widget, 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(Widget, @QtPattern);
|
||
end;
|
||
|
||
procedure TQtPen.setJoinStyle(pcs: QtPenJoinStyle);
|
||
begin
|
||
QPen_setJoinStyle(Widget, pcs);
|
||
end;
|
||
|
||
function TQtPen.getColor: TQColor;
|
||
begin
|
||
QPen_color(Widget, @Result);
|
||
end;
|
||
|
||
function TQtPen.getCosmetic: Boolean;
|
||
begin
|
||
Result := QPen_isCosmetic(Widget);
|
||
end;
|
||
|
||
function TQtPen.getJoinStyle: QtPenJoinStyle;
|
||
begin
|
||
Result := QPen_joinStyle(Widget);
|
||
end;
|
||
|
||
procedure TQtPen.setCapStyle(pcs: QtPenCapStyle);
|
||
begin
|
||
QPen_setCapStyle(Widget, pcs);
|
||
end;
|
||
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtPen.setColor
|
||
Params: p1: TQColor
|
||
Returns: Nothing
|
||
Setting pen color.
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtPen.setColor(p1: TQColor);
|
||
begin
|
||
QPen_setColor(Widget, @p1);
|
||
end;
|
||
|
||
procedure TQtPen.setCosmetic(b: Boolean);
|
||
begin
|
||
QPen_setCosmetic(Widget, 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}
|
||
|
||
// Creates the widget
|
||
if CreateHandle then Widget := QRegion_create;
|
||
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);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
|
||
{$endif}
|
||
|
||
// Creates the widget
|
||
// Note that QRegion_create expects a width and a height,
|
||
// and not a X2, Y2 bottom-right point
|
||
if CreateHandle then Widget := QRegion_create(X1,Y1,X2-X1,Y2-Y1, RegionType);
|
||
end;
|
||
|
||
constructor TQtRegion.Create(CreateHandle: Boolean; Poly: QPolygonH;
|
||
Const Fill: QtFillRule = QtWindingFill);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtRegion.Create polyrgn CreateHandle: ', dbgs(CreateHandle));
|
||
{$endif}
|
||
if CreateHandle then Widget := QRegion_create(Poly, Fill);
|
||
end;
|
||
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtRegion.Destroy
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
destructor TQtRegion.Destroy;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
WriteLn('TQtRegion.Destroy');
|
||
{$endif}
|
||
|
||
QRegion_destroy(Widget);
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TQtRegion.containsPoint(X, Y: Integer): Boolean;
|
||
var
|
||
P: TQtPoint;
|
||
begin
|
||
P.X := X;
|
||
P.Y := Y;
|
||
Result := QRegion_contains(Widget, PQtPoint(@P));
|
||
end;
|
||
|
||
function TQtRegion.containsRect(R: TRect): Boolean;
|
||
begin
|
||
Result := QRegion_contains(Widget, PRect(@R));
|
||
end;
|
||
|
||
function TQtRegion.GetRegionType: integer;
|
||
var
|
||
R: TRect;
|
||
begin
|
||
try
|
||
if QRegion_isEmpty(Widget) then
|
||
Result := NULLREGION
|
||
else
|
||
begin
|
||
QRegion_boundingRect(Widget, @R);
|
||
if QRegion_contains(Widget, PRect(@R)) then
|
||
Result := SIMPLEREGION
|
||
else
|
||
Result := COMPLEXREGION;
|
||
end;
|
||
except
|
||
Result := ERROR;
|
||
end;
|
||
end;
|
||
|
||
function TQtRegion.getBoundingRect: TRect;
|
||
begin
|
||
QRegion_boundingRect(Widget, @Result);
|
||
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 !}
|
||
if AWidget = nil then
|
||
begin
|
||
Parent := nil;
|
||
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
|
||
begin
|
||
Widget := QPainter_create(QWidget_to_QPaintDevice(Parent));
|
||
end;
|
||
end;
|
||
FOwnPainter := True;
|
||
CreateObjects;
|
||
FPenPos.X := 0;
|
||
FPenPos.Y := 0;
|
||
end;
|
||
|
||
constructor TQtDeviceContext.CreatePrinterContext(ADevice: QPrinterH);
|
||
begin
|
||
Parent := nil;
|
||
Widget := QPainter_Create(ADevice);
|
||
FOwnPainter := True;
|
||
CreateObjects;
|
||
FPenPos.X := 0;
|
||
FPenPos.Y := 0;
|
||
end;
|
||
|
||
constructor TQtDeviceContext.CreateFromPainter(APainter: QPainterH);
|
||
begin
|
||
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);
|
||
|
||
DestroyObjects;
|
||
|
||
if (Widget <> nil) and FOwnPainter then
|
||
QPainter_destroy(Widget);
|
||
|
||
if ParentPixmap <> nil then
|
||
QPixmap_destroy(ParentPixmap);
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TQtDeviceContext.CreateObjects;
|
||
begin
|
||
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);
|
||
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.Widget := nil;
|
||
FreeAndNil(vBrush);
|
||
vPen.Widget := nil;
|
||
FreeAndNil(vPen);
|
||
vRegion.Widget := nil;
|
||
FreeAndNil(vRegion);
|
||
vBackgroundBrush.Widget := 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.Handle);
|
||
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;
|
||
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);
|
||
begin
|
||
if Palette = nil then
|
||
Palette := QWidget_palette(Parent);
|
||
q_DrawShadeRect(Widget, x, y, w, h, Palette, Sunken, lineWidth, midLineWidth, FillBrush);
|
||
end;
|
||
|
||
procedure TQtDeviceContext.qDrawWinPanel(x, y, w, h: integer;
|
||
Palette: QPaletteH; Sunken: Boolean; lineWidth: Integer; FillBrush: QBrushH);
|
||
var
|
||
i: integer;
|
||
begin
|
||
if Palette = nil then
|
||
Palette := QWidget_palette(Parent);
|
||
// 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 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;
|
||
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.RestorePenColor
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtDeviceContext.RestorePenColor;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
writeln('TQtDeviceContext.RestorePenColor() ');
|
||
{$endif}
|
||
Qpainter_setPen(Widget, @PenColor);
|
||
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;
|
||
|
||
{------------------------------------------------------------------------------
|
||
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);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
writeln('TQtDeviceContext.drawRect() x1: ',x1,' y1: ',y1,' w: ',w,' h: ',h);
|
||
{$endif}
|
||
QPainter_drawRect(Widget, x1, y1, w, h);
|
||
end;
|
||
|
||
procedure TQtDeviceContext.drawRoundRect(x, y, w, h, rx, ry: Integer);
|
||
begin
|
||
QPainter_drawRoundRect(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<69>s drawn upwards.
|
||
|
||
To get a correct behavior we need to sum the text<78>s height to the Y coordinate.
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtDeviceContext.drawText(x: Integer; y: Integer; s: PWideString);
|
||
var
|
||
AFont: TQtFont;
|
||
ARect: TRect;
|
||
dy: Integer;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
Write('TQtDeviceContext.drawText TargetX: ', X, ' TargetY: ', Y);
|
||
{$endif}
|
||
|
||
AFont := Font;
|
||
with AFont do
|
||
if Angle <> 0 then
|
||
begin
|
||
Translate(x, y);
|
||
Rotate(-0.1 * Angle);
|
||
Translate(-x, -y);
|
||
end;
|
||
|
||
// what about AFont.Metrics.descent and AFont.Metrics.leading ?
|
||
y := y + AFont.Metrics.ascent;
|
||
|
||
// manual check for clipping
|
||
if getClipping then
|
||
begin
|
||
dy := AFont.Metrics.height;
|
||
ARect := getClipRegion.getBoundingRect;
|
||
if (y + dy < ARect.Top) or (y > ARect.Bottom) or
|
||
(x > ARect.Right) then
|
||
Exit;
|
||
end;
|
||
|
||
RestoreTextColor;
|
||
|
||
QPainter_drawText(Widget, x, y, s);
|
||
|
||
RestorePenColor;
|
||
|
||
{$ifdef VerboseQt}
|
||
WriteLn(' Font metrics height: ', AFont.Metrics.height, ' Angle: ',
|
||
Round(0.1 * AFont.Angle));
|
||
{$endif}
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtDeviceContext.DrawText
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtDeviceContext.DrawText(x, y, w, h, flags: Integer; s: PWideString);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
Write('TQtDeviceContext.drawText x: ', X, ' Y: ', Y,' w: ',w,' h: ',h);
|
||
{$endif}
|
||
|
||
with Font do
|
||
if Angle <> 0 then
|
||
begin
|
||
Translate(x, y);
|
||
Rotate(-0.1 * Angle);
|
||
Translate(-x, -y);
|
||
// todo: something wrong with coordinates happen after that
|
||
end;
|
||
RestoreTextColor;
|
||
QPainter_DrawText(Widget, x, y, w, h, Flags, s);
|
||
RestorePenColor;
|
||
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.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.Widget);
|
||
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.getWorldMatrix: QMatrixH;
|
||
begin
|
||
Result := QPainter_worldMatrix(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.Widget <> nil then
|
||
QFont_destroy(vFont.Widget);
|
||
QFont_create(QPainter_font(Widget));
|
||
end;
|
||
Result := vFont;
|
||
end
|
||
else
|
||
Result := SelFont;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtDeviceContext.setFont
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TQtDeviceContext.setFont(AFont: TQtFont);
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
Write('TQtDeviceContext.setFont() ');
|
||
{$endif}
|
||
SelFont := AFont;
|
||
if (AFont.Widget <> nil) and (Widget <> nil) then
|
||
begin
|
||
QPainter_setFont(Widget, QFontH(AFont.Widget));
|
||
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.Widget := 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.Widget <> nil) and (Widget <> nil) then
|
||
QPainter_setBrush(Widget, ABrush.Widget);
|
||
end;
|
||
|
||
function TQtDeviceContext.BackgroundBrush: TQtBrush;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
Write('TQtDeviceContext.backgroundBrush() ');
|
||
{$endif}
|
||
vBackgroundBrush.Widget := QPainter_background(Widget);
|
||
result := vBackGroundBrush;
|
||
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.Widget := 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.Widget <> nil) and (Widget <> nil) then
|
||
QPainter_setPen(Widget, APen.Widget);
|
||
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;
|
||
|
||
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}
|
||
NColor := BackgroundBrush.getColor^;
|
||
TQColorToColorRef(NColor, Result);
|
||
ColorRefToTQColor(ColorToRGB(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.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;
|
||
var
|
||
R: TRect;
|
||
begin
|
||
try
|
||
if QRegion_isEmpty(ARegion) then
|
||
Result := NULLREGION
|
||
else
|
||
begin
|
||
QRegion_boundingRect(ARegion, @R);
|
||
if QRegion_contains(ARegion, PRect(@R)) 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.Widget=nil then
|
||
vRegion.Widget := QRegion_Create();
|
||
|
||
QPainter_clipRegion(Widget, vRegion.Widget);
|
||
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
|
||
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.Widget <> nil) and (Widget <> nil) then
|
||
setClipRegion(ARegion.Widget);
|
||
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;
|
||
begin
|
||
{$ifdef VerboseQt}
|
||
Write('TQtDeviceContext.drawImage() ');
|
||
{$endif}
|
||
LocalRect := targetRect^;
|
||
if mask <> nil then
|
||
begin
|
||
// TODO: check maskRect
|
||
APixmap := QPixmap_create();
|
||
try
|
||
QPixmap_fromImage(APixmap, image, flags);
|
||
ATemp := QPixmap_create();
|
||
try
|
||
// QBitmap_fromImage raises assertion in the qt library
|
||
QPixmap_fromImage(ATemp, mask, flags);
|
||
AMask := QBitmap_create(ATemp);
|
||
try
|
||
QPixmap_setMask(APixmap, AMask);
|
||
QPainter_drawPixmap(Widget, PRect(@LocalRect), APixmap, sourceRect);
|
||
finally
|
||
QBitmap_destroy(AMask);
|
||
end;
|
||
finally
|
||
QPixmap_destroy(ATemp);
|
||
end;
|
||
finally
|
||
QPixmap_destroy(APixmap);
|
||
end;
|
||
end else
|
||
begin
|
||
{$note 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.}
|
||
|
||
if not EqualRect(LocalRect, sourceRect^) and
|
||
(QImage_format(Image) = QImageFormat_RGB32) then
|
||
begin
|
||
ScaledImage := QImage_create();
|
||
try
|
||
QImage_convertToFormat(Image, ScaledImage, QImageFormat_ARGB32);
|
||
QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, sourceRect, flags);
|
||
finally
|
||
QImage_destroy(ScaledImage);
|
||
end;
|
||
end else
|
||
QPainter_drawImage(Widget, PRect(@LocalRect), image, sourceRect, flags);
|
||
end;
|
||
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();
|
||
end;
|
||
|
||
destructor TQtSystemTrayIcon.Destroy;
|
||
begin
|
||
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.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;
|
||
begin
|
||
inherited Create;
|
||
FLockClip := False;
|
||
FOnClipBoardRequest := nil;
|
||
FClipBoardFormats := TStringList.Create;
|
||
FClipBoardFormats.Add('foo'); // 0 is reserved
|
||
TheObject := QApplication_clipBoard;
|
||
AttachEvents;
|
||
end;
|
||
|
||
destructor TQtClipboard.Destroy;
|
||
begin
|
||
DetachEvents;
|
||
FClipBoardFormats.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TQtClipboard.AttachEvents;
|
||
var
|
||
Method: TMethod;
|
||
begin
|
||
inherited AttachEvents;
|
||
FClipDataChangedHook := QClipboard_hook_create(TheObject);
|
||
QClipboard_dataChanged_Event(Method) := @signalDataChanged;
|
||
QClipboard_hook_hook_dataChanged(FClipDataChangedHook, Method);
|
||
end;
|
||
|
||
procedure TQtClipboard.signalDataChanged; cdecl;
|
||
begin
|
||
{$IFDEF VERBOSE_QT_CLIPBOARD}
|
||
writeln('signalDataChanged()');
|
||
{$ENDIF}
|
||
FClipChanged := IsClipboardChanged;
|
||
end;
|
||
|
||
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;
|
||
begin
|
||
BeginEventProcessing;
|
||
Result := False;
|
||
|
||
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 := Count > 0;
|
||
|
||
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;
|
||
begin
|
||
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(Formats[I], DataStream);
|
||
Data := QByteArray_create(PAnsiChar(DataStream.Memory), DataStream.Size);
|
||
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 := 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 := nil;
|
||
FOnClipBoardRequest := OnRequestProc;
|
||
PutOnClipBoard;
|
||
Result := True;
|
||
finally
|
||
FLockClip := False;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{ TQtPrinter }
|
||
|
||
constructor TQtPrinter.Create;
|
||
begin
|
||
FPrinterActive := False;
|
||
FHandle := QPrinter_create();
|
||
end;
|
||
|
||
destructor TQtPrinter.Destroy;
|
||
begin
|
||
endDoc;
|
||
if FHandle <> nil then
|
||
QPrinter_destroy(FHandle);
|
||
inherited Destroy;
|
||
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.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.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_setPageSize(FHandle, AValue);
|
||
end;
|
||
|
||
function TQtPrinter.getPageSize: QPrinterPageSize;
|
||
begin
|
||
Result := QPrinter_pageSize(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.PrintEngine: QPrintEngineH;
|
||
begin
|
||
Result := QPrinter_printEngine(FHandle);
|
||
end;
|
||
|
||
|
||
{ TQtTimer }
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TQtTimer.CreateTimer
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
constructor TQtTimer.CreateTimer(Interval: integer;
|
||
const TimerFunc: TFNTimerProc; App: QObjectH);
|
||
begin
|
||
inherited Create;
|
||
{$IF DEFINED(USE_QT_44) or DEFINED(USE_QT_45)}
|
||
FDeleteLater := True;
|
||
{$ENDIF}
|
||
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;
|
||
var
|
||
Method: TMethod;
|
||
begin
|
||
FTimerHook := QTimer_hook_create(QTimerH(TheObject));
|
||
QTimer_timeout_Event(Method) := @signalTimeout;
|
||
QTimer_hook_hook_timeout(FTimerHook, Method);
|
||
inherited AttachEvents;
|
||
end;
|
||
|
||
procedure TQtTimer.DetachEvents;
|
||
begin
|
||
{$IF DEFINED(USE_QT_44) or DEFINED(USE_QT_45)}
|
||
QTimer_stop(QTimerH(TheObject));
|
||
{$ENDIF}
|
||
if FTimerHook <> nil then
|
||
QTimer_hook_destroy(FTimerHook);
|
||
inherited DetachEvents;
|
||
end;
|
||
|
||
procedure TQtTimer.signalTimeout; cdecl;
|
||
begin
|
||
if Assigned(FCallbackFunc) then
|
||
FCallbackFunc;
|
||
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;
|
||
|
||
end.
|
||
|
||
|
||
|
||
|
||
|