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

FPC: Extend System.UITypes

Browse Source
This commit is contained in:
Ondrej Pokorny 2022-12-18 08:49:59 +01:00
parent 5b0ed449f3
commit 43d7f20349
5 changed files with 163 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
lcl/controls.pp
View File

@ -33,34 +33,42 @@ interface
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
{$MACRO ON}
{$IF FPC_FULLVERSION >= 30300}
{$DEFINE SysUITypes:=System.UITypes}
{$ELSE}
{$DEFINE SysUITypes:=UITypes}
{$ENDIF}
{$INTERFACES CORBA}
uses
SysUITypes,
Classes, SysUtils, TypInfo, Types, Laz_AVL_Tree,
// LCL
LCLStrConsts, LCLType, LCLProc, Graphics, LMessages, LCLIntf, InterfaceBase,
ImgList, PropertyStorage, Menus, ActnList, LCLClasses, LResources, LCLPlatformDef,
// LazUtils
GraphType, UITypes, LazMethodList, LazLoggerBase, LazTracer, LazUtilities;
GraphType, LazMethodList, LazLoggerBase, LazTracer, LazUtilities;
{$I controlconsts.inc}
const
// Used for ModalResult
mrNone = UITypes.mrNone;
mrOK = UITypes.mrOK;
mrCancel = UITypes.mrCancel;
mrAbort = UITypes.mrAbort;
mrRetry = UITypes.mrRetry;
mrIgnore = UITypes.mrIgnore;
mrYes = UITypes.mrYes;
mrNo = UITypes.mrNo;
mrAll = UITypes.mrAll;
mrNoToAll = UITypes.mrNoToAll;
mrYesToAll= UITypes.mrYesToAll;
mrClose = UITypes.mrClose;
mrLast = UITypes.mrLast;
mrNone = SysUITypes.mrNone;
mrOK = SysUITypes.mrOK;
mrCancel = SysUITypes.mrCancel;
mrAbort = SysUITypes.mrAbort;
mrRetry = SysUITypes.mrRetry;
mrIgnore = SysUITypes.mrIgnore;
mrYes = SysUITypes.mrYes;
mrNo = SysUITypes.mrNo;
mrAll = SysUITypes.mrAll;
mrNoToAll = SysUITypes.mrNoToAll;
mrYesToAll= SysUITypes.mrYesToAll;
mrClose = SysUITypes.mrClose;
mrLast = SysUITypes.mrLast;
function GetModalResultStr(ModalResult: TModalResult): ShortString;
deprecated 'Use the ModalResultStr array from unit UITypes directly.';
@ -167,11 +175,28 @@ type
TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient, alCustom);
TAlignSet = set of TAlign;
{$IF FPC_FULLVERSION >= 30300}
TAnchorKind = SysUITypes.TAnchorKind;
TAnchors = SysUITypes.TAnchors;
TAnchorSideReference = SysUITypes.TAnchorSideReference;
{$ELSE}
TAnchorKind = (akTop, akLeft, akRight, akBottom);
TAnchors = set of TAnchorKind;
TAnchorSideReference = (asrTop, asrBottom, asrCenter);
{$ENDIF}
const
{$IF FPC_FULLVERSION >= 30300}
akLeft = SysUITypes.akLeft;
akTop = SysUITypes.akTop;
akRight = SysUITypes.akRight;
akBottom = SysUITypes.akBottom;
asrTop = SysUITypes.asrTop;
asrBottom = SysUITypes.asrBottom;
asrCenter = SysUITypes.asrCenter;
{$ENDIF}
asrLeft = asrTop;
asrRight = asrBottom;
@ -193,9 +218,21 @@ type
TBevelCut = TGraphicsBevelCut;
{$IF FPC_FULLVERSION >= 30300}
TMouseButton = SysUITypes.TMouseButton;
{$ELSE}
TMouseButton = (mbLeft, mbRight, mbMiddle, mbExtra1, mbExtra2);
{$ENDIF}
const
{$IF FPC_FULLVERSION >= 30300}
mbLeft = SysUITypes.mbLeft;
mbRight = SysUITypes.mbRight;
mbMiddle = SysUITypes.mbMiddle;
mbExtra1 = SysUITypes.mbExtra1;
mbExtra2 = SysUITypes.mbExtra2;
{$ENDIF}
fsAllStayOnTop = [fsStayOnTop, fsSystemStayOnTop];
fsAllNonSystemStayOnTop = [fsStayOnTop];
@ -430,11 +467,18 @@ type
TDragObject = class;
{$IF FPC_FULLVERSION >= 30300}
TDragKind = SysUITypes.TDragKind;
TDragMode = SysUITypes.TDragMode;
TDragState = SysUITypes.TDragState;
TDragMessage = SysUITypes.TDragMessage;
{$ELSE}
TDragKind = (dkDrag, dkDock);
TDragMode = (dmManual , dmAutomatic);
TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop,
dmDragCancel,dmFindTarget);
{$ENDIF}
TDragOverEvent = procedure(Sender, Source: TObject;
X,Y: Integer; State: TDragState; var Accept: Boolean) of object;
@ -938,7 +982,11 @@ type
);
TControlAutoSizePhases = set of TControlAutoSizePhase;
{$IF FPC_FULLVERSION >= 30300}
TTabOrder = SysUITypes.TTabOrder;
{$ELSE}
TTabOrder = -1..32767;
{$ENDIF}
TControlShowHintEvent = procedure(Sender: TObject; HintInfo: PHintInfo) of object;
TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint;
@ -2804,6 +2852,25 @@ function CompareDataObjectWithLazAccessibleObject(o, ao: Pointer): Integer;
// register (called by the package initialization in design mode)
procedure Register;
{$IF FPC_FULLVERSION >= 30300}
const
dkDrag = SysUITypes.dkDrag;
dkDock = SysUITypes.dkDock;
dmManual = SysUITypes.dmManual;
dmAutomatic = SysUITypes.dmAutomatic;
dsDragEnter = SysUITypes.dsDragEnter;
dsDragLeave = SysUITypes.dsDragLeave;
dsDragMove = SysUITypes.dsDragMove;
dmDragEnter = SysUITypes.dmDragEnter;
dmDragLeave = SysUITypes.dmDragLeave;
dmDragMove = SysUITypes.dmDragMove;
dmDragDrop = SysUITypes.dmDragDrop;
dmDragCancel = SysUITypes.dmDragCancel;
dmFindTarget = SysUITypes.dmFindTarget;
{$ENDIF}
implementation
@ -3051,7 +3118,7 @@ end;
function GetModalResultStr(ModalResult: TModalResult): ShortString;
begin
Result := UITypes.ModalResultStr[ModalResult];
Result := SysUITypes.ModalResultStr[ModalResult];
end;
{------------------------------------------------------------------------------

23
lcl/forms.pp
View File

@ -50,11 +50,6 @@ uses
;
type
// forward class declarations
TIDesigner = class;
TMonitor = class;
TScrollingWinControl = class;
TProcedure = procedure;
TProcedureOfObject = procedure of object;
@ -72,7 +67,25 @@ type
);
TWindowState = (wsNormal, wsMinimized, wsMaximized, wsFullScreen);
{$IF FPC_FULLVERSION >= 30300}
TCloseAction = System.UITypes.TCloseAction;
{$ELSE}
TCloseAction = (caNone, caHide, caFree, caMinimize);
{$ENDIF}
{$IF FPC_FULLVERSION >= 30300}
const
caNone = System.UITypes.caNone;
caHide = System.UITypes.caHide;
caFree = System.UITypes.caFree;
caMinimize = System.UITypes.caMinimize;
{$ENDIF}
type
// forward class declarations
TIDesigner = class;
TMonitor = class;
TScrollingWinControl = class;
{ Hint actions }

30
lcl/graphics.pp
View File

@ -72,6 +72,16 @@ type
PColor = {$IFDEF UseSystemUITypes}System.UITypes.PColor{$ELSE}^TColor{$ENDIF};
TColor = TGraphicsColor;
{$IF FPC_FULLVERSION>=30300}
TFontPitch = System.UITypes.TFontPitch;
TFontName = System.UITypes.TFontName;
TFontDataName = System.UITypes.TFontDataName;
TFontStyle = System.UITypes.TFontStyle;
TFontStyles = System.UITypes.TFontStyles;
TFontStylesBase = System.UITypes.TFontStylesBase;
TFontCharSet = System.UITypes.TFontCharSet;
TFontQuality = System.UITypes.TFontQuality;
{$ELSE}
TFontPitch = (fpDefault, fpVariable, fpFixed);
TFontName = string;
TFontDataName = string[LF_FACESIZE -1];
@ -81,6 +91,7 @@ type
TFontCharSet = 0..255;
TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased,
fqCleartype, fqCleartypeNatural);
{$ENDIF}
TFontData = record
Handle: HFont;
@ -94,6 +105,25 @@ type
end;
const
{$IF FPC_FULLVERSION>=30300}
fpDefault = System.UITypes.fpDefault;
fpVariable = System.UITypes.fpVariable;
fpFixed = System.UITypes.fpFixed;
fsBold = System.UITypes.fsBold;
fsItalic = System.UITypes.fsItalic;
fsUnderline = System.UITypes.fsUnderline;
fsStrikeOut = System.UITypes.fsStrikeOut;
fqDefault = System.UITypes.fqDefault;
fqDraft = System.UITypes.fqDraft;
fqProof = System.UITypes.fqProof;
fqNonAntialiased = System.UITypes.fqNonAntialiased;
fqAntialiased = System.UITypes.fqAntialiased;
fqCleartype = System.UITypes.fqCleartype;
fqCleartypeNatural = System.UITypes.fqCleartypeNatural;
{$ENDIF}
// New TFont instances are initialized with the values in this structure.
// About font default values: The default font is chosen by the interfaces
// depending on the context. For example, there can be a different default

8
lcl/grids.pas
View File

@ -2136,7 +2136,11 @@ begin
cfg.SetValue(AKey + '/name/value', AFont.Name);
cfg.SetValue(AKey + '/size/value', AFont.Size);
cfg.SetValue(AKey + '/color/value', ColorToString(AFont.Color));
{$IF FPC_FULLVERSION>=30300}
cfg.SetValue(AKey + '/style/value', Byte(AFont.Style));
{$ELSE}
cfg.SetValue(AKey + '/style/value', Integer(AFont.Style));
{$ENDIF}
end;
procedure CfgGetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont);
@ -2144,7 +2148,11 @@ begin
AFont.Name := cfg.GetValue(AKey + '/name/value', 'default');
AFont.Size := cfg.GetValue(AKey + '/size/value', 0);
AFont.Color:= StringToColor(cfg.GetValue(AKey + '/color/value', 'clWindowText'));
{$IF FPC_FULLVERSION>=30300}
AFont.Style:= TFontStyles(Byte(cfg.GetValue(AKey + '/style/value', 0)));
{$ELSE}
AFont.Style:= TFontStyles(cfg.GetValue(AKey + '/style/value', 0));
{$ENDIF}
end;
// Draws a dotted rectangle by drawing each enabled side. By default all sides are

28
lcl/printers.pas
View File

@ -22,6 +22,9 @@ unit Printers;
interface
uses
{$IF FPC_FULLVERSION >= 30300}
System.UITypes,
{$ENDIF}
Classes, SysUtils,
// LazUtils
LazLoggerBase, LazUTF8,
@ -29,15 +32,34 @@ uses
LCLProc, Graphics;
type
TPrinter = Class;
EPrinter = class(Exception);
{$IF FPC_FULLVERSION >= 30300}
TPrinterOrientation = System.UITypes.TPrinterOrientation;
TPrinterCapability = System.UITypes.TPrinterCapability;
TPrinterCapabilities = System.UITypes.TPrinterCapabilities;
{$ELSE}
TPrinterOrientation = (poPortrait,poLandscape,poReverseLandscape,poReversePortrait);
TPrinterCapability = (pcCopies, pcOrientation, pcCollation);
TPrinterCapabilities= Set of TPrinterCapability;
{$ENDIF}
TPrinterState = (psNoDefine,psReady,psPrinting,psStopped);
TPrinterType = (ptLocal,ptNetWork);
{$IF FPC_FULLVERSION >= 30300}
const
poPortrait = System.UITypes.poPortrait;
poLandscape = System.UITypes.poLandscape;
poReverseLandscape = System.UITypes.poReverseLandscape;
poReversePortrait = System.UITypes.poReversePortrait;
pcCopies = System.UITypes.pcCopies;
pcOrientation = System.UITypes.pcOrientation;
pcCollation = System.UITypes.pcCollation;
{$ENDIF}
type
TPrinter = Class;
EPrinter = class(Exception);
{
This object it's a base class for TCanvas for TPrinter Object.
Few properties it's replicate for can create an TPrinterCavas not