david
08e42642b8
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@21 05c56307-c608-d34a-929d-697000501d7a
2295 lines
61 KiB
ObjectPascal
2295 lines
61 KiB
ObjectPascal
|
|
{********************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ Express Cross Platform Library classes }
|
|
{ }
|
|
{ Copyright (c) 2000-2007 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSCROSSPLATFORMLIBRARY AND ALL }
|
|
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM }
|
|
{ ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{********************************************************************}
|
|
|
|
unit cxClasses;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, ShellAPI, TypInfo, Classes;
|
|
|
|
const
|
|
dxBuildNumber = 30;
|
|
WM_DX = WM_APP + 100;
|
|
|
|
dxEndOfLine = #13#10;
|
|
cxE_NOINTERFACE = HResult($80004002);
|
|
|
|
type
|
|
PBytes = ^TBytes;
|
|
TBytes = array of Byte;
|
|
|
|
TcxAlignmentVert = (vaTop, vaBottom, vaCenter);
|
|
TcxCollectionOperation = (copAdd, copDelete, copChanged);
|
|
TcxDirection = (dirNone, dirLeft, dirRight, dirUp, dirDown);
|
|
TcxGetComponent = function(ACaller: TComponent; Index: Integer): TComponent;
|
|
TcxGetCaptionForIntegerItemFunc = function(AItem: Integer): string;
|
|
TcxPosition = (posNone, posLeft, posRight, posTop, posBottom);
|
|
TdxSkinName = type string;
|
|
|
|
{$IFNDEF DELPHI5}
|
|
TImageIndex = Integer;
|
|
{$ENDIF}
|
|
|
|
TcxTag = Longint;
|
|
|
|
TcxResourceStringID = Pointer;
|
|
|
|
IcxDesignSelectionChanged = interface
|
|
['{66B3AA59-1EBD-4135-AB18-E980F9C970F3}']
|
|
procedure DesignSelectionChanged(ASelection: TList);
|
|
end;
|
|
|
|
IcxDesignHelper = interface
|
|
['{4C78CC4F-699B-43BD-94AC-E3BD2233F7A1}']
|
|
procedure AddSelectionChangedListener(AObject: TPersistent);
|
|
function CanAddComponent(AOwner: TComponent): Boolean;
|
|
function CanDeleteComponent(AOwner: TComponent; AComponent: TComponent): Boolean;
|
|
procedure ChangeSelection(AOwner: TComponent; AObject: TPersistent);
|
|
function IsObjectSelected(AOwner: TComponent; AObject: TPersistent): Boolean;
|
|
procedure Modified;
|
|
procedure RemoveSelectionChangedListener(AObject: TPersistent);
|
|
procedure SelectObject(AOwner: TComponent; AObject: TPersistent; AClearSelection: Boolean = True;
|
|
AActivateOwner: Boolean = True);
|
|
procedure ShowComponentDefaultEventHandler(AComponent: TComponent);
|
|
function UniqueName(const ABaseName: string): string;
|
|
procedure UnselectObject(AOwner: TComponent; AObject: TPersistent);
|
|
end;
|
|
|
|
{ TcxInterfacedPersistent }
|
|
|
|
TcxInterfacedPersistentClass = class of TcxInterfacedPersistent;
|
|
|
|
TcxInterfacedPersistent = class({$IFDEF DELPHI6}TInterfacedPersistent{$ELSE}TPersistent, IUnknown{$ENDIF})
|
|
private
|
|
FOwner: TPersistent;
|
|
{$IFNDEF DELPHI6}
|
|
FOwnerInterface: IUnknown;
|
|
{$ENDIF}
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
{$IFNDEF DELPHI6}
|
|
{ IUnknown }
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
|
{$ENDIF}
|
|
public
|
|
constructor Create(AOwner: TPersistent); virtual;
|
|
{$IFNDEF DELPHI6}
|
|
procedure AfterConstruction; override;
|
|
{$ENDIF}
|
|
property Owner: TPersistent read FOwner;
|
|
end;
|
|
|
|
{ TcxOwnedPersistent }
|
|
|
|
TcxOwnedPersistent = class(TPersistent)
|
|
private
|
|
FOwner: TPersistent;
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
property Owner: TPersistent read FOwner write FOwner;
|
|
public
|
|
constructor Create(AOwner: TPersistent); virtual;
|
|
end;
|
|
|
|
{ TcxOwnedInterfacedPersistent }
|
|
|
|
TcxOwnedInterfacedPersistent = class(TcxOwnedPersistent, IUnknown)
|
|
protected
|
|
// IUnknown
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
|
end;
|
|
|
|
{ TcxComponent}
|
|
|
|
TcxComponent = class(TComponent{$IFNDEF DELPHI6}, IUnknown{$ENDIF})
|
|
private
|
|
FFakeComponentLink1: TComponent;
|
|
FFakeComponentLink2: TComponent;
|
|
FFakeComponentLink3: TComponent;
|
|
function GetFakeComponentLinkCount: Integer;
|
|
function GetIsDesigning: Boolean;
|
|
function GetIsDestroying: Boolean;
|
|
procedure SetFakeComponentLink(Index: Integer; Value: TComponent);
|
|
protected
|
|
procedure GetFakeComponentLinks(AList: TList); virtual;
|
|
procedure Loaded; override;
|
|
procedure UpdateFakeLinks;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure BeforeDestruction; override;
|
|
property IsDesigning: Boolean read GetIsDesigning;
|
|
property IsDestroying: Boolean read GetIsDestroying;
|
|
published
|
|
property FakeComponentLink1: TComponent read FFakeComponentLink1 write FFakeComponentLink1 stored False;
|
|
property FakeComponentLink2: TComponent read FFakeComponentLink2 write FFakeComponentLink2 stored False;
|
|
property FakeComponentLink3: TComponent read FFakeComponentLink3 write FFakeComponentLink3 stored False;
|
|
end;
|
|
|
|
{ TcxCollection }
|
|
|
|
TcxCollection = class(TCollection)
|
|
public
|
|
procedure Assign(Source: TPersistent); override;
|
|
{$IFNDEF DELPHI6}
|
|
function Owner: TPersistent;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TcxObjectList }
|
|
|
|
TcxObjectList = class(TList)
|
|
private
|
|
function GetItem(Index: Integer): TObject;
|
|
public
|
|
procedure Clear; override;
|
|
property Items[Index: Integer]: TObject read GetItem; default;
|
|
end;
|
|
|
|
{ TcxRegisteredClassList }
|
|
|
|
TcxRegisteredClassListItemData = class
|
|
ItemClass: TClass;
|
|
RegisteredClass: TClass;
|
|
end;
|
|
|
|
TcxRegisteredClassList = class
|
|
private
|
|
FItems: TList;
|
|
function GetCount: Integer;
|
|
function GetItem(Index: Integer): TcxRegisteredClassListItemData;
|
|
protected
|
|
function Find(AItemClass: TClass; var AIndex: Integer): Boolean; virtual;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
function FindClass(AItemClass: TClass): TClass;
|
|
procedure Register(AItemClass, ARegisteredClass: TClass); virtual;
|
|
procedure Unregister(AItemClass, ARegisteredClass: TClass); virtual;
|
|
property Count: Integer read GetCount;
|
|
property Items[Index: Integer]: TcxRegisteredClassListItemData read GetItem; default;
|
|
end;
|
|
|
|
{ TcxRegisteredClasses } // TODO: Name
|
|
|
|
TcxRegisteredClasses = class
|
|
private
|
|
FItems: TStringList;
|
|
FRegisterClasses: Boolean;
|
|
FSorted: Boolean;
|
|
function GetCount: Integer;
|
|
function GetDescription(Index: Integer): string;
|
|
function GetHint(Index: Integer): string;
|
|
function GetItem(Index: Integer): TClass;
|
|
procedure SetSorted(Value: Boolean);
|
|
protected
|
|
function CompareItems(AIndex1, AIndex2: Integer): Integer; virtual;
|
|
procedure Sort; virtual;
|
|
public
|
|
constructor Create(ARegisterClasses: Boolean = False);
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
function FindByClassName(const AClassName: string): TClass;
|
|
function FindByDescription(const ADescription: string): TClass;
|
|
function GetDescriptionByClass(AClass: TClass): string;
|
|
function GetHintByClass(AClass: TClass): string;
|
|
function GetIndexByClass(AClass: TClass): Integer;
|
|
procedure Register(AClass: TClass; const ADescription: string);
|
|
procedure Unregister(AClass: TClass);
|
|
property Count: Integer read GetCount;
|
|
property Descriptions[Index: Integer]: string read GetDescription;
|
|
property Hints[Index: Integer]: string read GetHint;
|
|
property Items[Index: Integer]: TClass read GetItem; default;
|
|
property RegisterClasses: Boolean read FRegisterClasses write FRegisterClasses;
|
|
property Sorted: Boolean read FSorted write SetSorted;
|
|
end;
|
|
|
|
{ TcxAutoWidthObject }
|
|
|
|
TcxAutoWidthItem = class
|
|
public
|
|
MinWidth: Integer;
|
|
Width: Integer;
|
|
Fixed: Boolean;
|
|
AutoWidth: Integer;
|
|
constructor Create;
|
|
end;
|
|
|
|
TcxAutoWidthObject = class
|
|
private
|
|
FAvailableWidth: Integer;
|
|
FItems: TList;
|
|
function GetCount: Integer;
|
|
function GetItem(Index: Integer): TcxAutoWidthItem;
|
|
function GetWidth: Integer;
|
|
protected
|
|
procedure Clear;
|
|
public
|
|
constructor Create(ACount: Integer);
|
|
destructor Destroy; override;
|
|
function AddItem: TcxAutoWidthItem;
|
|
procedure Calculate;
|
|
property AvailableWidth: Integer read FAvailableWidth write FAvailableWidth;
|
|
property Count: Integer read GetCount;
|
|
property Items[Index: Integer]: TcxAutoWidthItem read GetItem; default;
|
|
property Width: Integer read GetWidth;
|
|
end;
|
|
|
|
{ TcxAlignment }
|
|
|
|
TcxAlignment = class(TPersistent)
|
|
private
|
|
FDefaultHorz: TAlignment;
|
|
FDefaultVert: TcxAlignmentVert;
|
|
FHorz: TAlignment;
|
|
FIsHorzAssigned: Boolean;
|
|
FIsVertAssigned: Boolean;
|
|
FOwner: TPersistent;
|
|
FUseAssignedValues: Boolean;
|
|
FVert: TcxAlignmentVert;
|
|
FOnChanged: TNotifyEvent;
|
|
function IsHorzStored: Boolean;
|
|
function IsVertStored: Boolean;
|
|
procedure SetHorz(const Value: TAlignment);
|
|
procedure SetVert(const Value: TcxAlignmentVert);
|
|
protected
|
|
procedure DoChanged;
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
constructor Create(AOwner: TPersistent; AUseAssignedValues: Boolean = False;
|
|
ADefaultHorz: TAlignment = taLeftJustify;
|
|
ADefaultVert: TcxAlignmentVert = vaTop); virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Reset;
|
|
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
|
published
|
|
property Horz: TAlignment read FHorz write SetHorz stored IsHorzStored;
|
|
property Vert: TcxAlignmentVert read FVert write SetVert stored IsVertStored;
|
|
end;
|
|
|
|
{ Object Links }
|
|
|
|
TcxObjectLink = class
|
|
Ref: TObject;
|
|
end;
|
|
|
|
TcxObjectLinkController = class
|
|
private
|
|
FLinks: TList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function AddLink(AObject: TObject): TcxObjectLink;
|
|
procedure RemoveLink(ALink: TcxObjectLink);
|
|
procedure ClearLinks(AObject: TObject);
|
|
end;
|
|
|
|
{ TcxFreeNotificator }
|
|
|
|
TcxFreeNotificationEvent = procedure(Sender: TComponent) of object;
|
|
|
|
TcxFreeNotificator = class(TComponent)
|
|
private
|
|
FOnFreeNotification: TcxFreeNotificationEvent;
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
procedure AddSender(ASender: TComponent);
|
|
procedure RemoveSender(ASender: TComponent);
|
|
property OnFreeNotification: TcxFreeNotificationEvent read FOnFreeNotification write FOnFreeNotification;
|
|
end;
|
|
|
|
{ MRU items support }
|
|
|
|
TcxMRUItemClass = class of TcxMRUItem;
|
|
|
|
TcxMRUItem = class
|
|
public
|
|
function Equals(AItem: TcxMRUItem): Boolean; virtual; abstract;
|
|
end;
|
|
|
|
TcxMRUItems = class
|
|
private
|
|
FItems: TList;
|
|
FMaxCount: Integer;
|
|
function GetCount: Integer;
|
|
function GetItem(Index: Integer): TcxMRUItem;
|
|
procedure SetCount(Value: Integer);
|
|
procedure SetMaxCount(Value: Integer);
|
|
protected
|
|
procedure Delete(AIndex: Integer);
|
|
procedure UpdateCount;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure Add(AItem: TcxMRUItem);
|
|
procedure ClearItems;
|
|
function IndexOf(AItem: TcxMRUItem): Integer;
|
|
|
|
property Count: Integer read GetCount write SetCount;
|
|
property Items[Index: Integer]: TcxMRUItem read GetItem; default;
|
|
property MaxCount: Integer read FMaxCount write SetMaxCount;
|
|
end;
|
|
|
|
{ Open list }
|
|
|
|
TcxOpenList = class(TList)
|
|
private
|
|
function GetItem(Index: Integer): TObject;
|
|
procedure SetItem(Index: Integer; Value: TObject);
|
|
public
|
|
property Items[Index: Integer]: TObject read GetItem write SetItem; default;
|
|
end;
|
|
|
|
{ TcxComponentCollectionItem }
|
|
|
|
TcxComponentCollection = class;
|
|
|
|
TcxComponentCollectionItem = class(TComponent)
|
|
private
|
|
FCollection: TcxComponentCollection;
|
|
FID: Integer;
|
|
procedure AddToCollection(ACollection: TcxComponentCollection);
|
|
function GetIndex: Integer;
|
|
procedure RemoveFromCollection(ACollection: TcxComponentCollection);
|
|
protected
|
|
procedure Changed(AAllItems: Boolean);
|
|
function GetCollectionFromParent(AParent: TComponent): TcxComponentCollection; virtual; abstract;
|
|
function GetDisplayName: string; virtual;
|
|
procedure SetCollection(AValue: TcxComponentCollection); virtual;
|
|
procedure SetIndex(AValue: Integer); virtual;
|
|
public
|
|
destructor Destroy; override;
|
|
function GetParentComponent: TComponent; override;
|
|
function HasParent: Boolean; override;
|
|
procedure SetParentComponent(Value: TComponent); override;
|
|
|
|
property Collection: TcxComponentCollection read FCollection write SetCollection;
|
|
property DisplayName: string read GetDisplayName;
|
|
property ID: Integer read FID;
|
|
property Index: Integer read GetIndex write SetIndex;
|
|
end;
|
|
|
|
TcxComponentCollectionItemClass = class of TcxComponentCollectionItem;
|
|
|
|
{ TcxComponentCollection }
|
|
|
|
TcxComponentCollectionNotification = (ccnAdded, ccnChanged, ccnExtracting, ccnExtracted, ccnDeleting);
|
|
TcxComponentCollectionChangeEvent = procedure(Sender: TObject;
|
|
AItem: TcxComponentCollectionItem; AAction: TcxComponentCollectionNotification) of object;
|
|
|
|
TcxComponentCollection = class(TPersistent)
|
|
private
|
|
FItemClass: TcxComponentCollectionItemClass;
|
|
FItems: TList;
|
|
FNextID: Integer;
|
|
FParentComponent: TComponent;
|
|
FUpdateCount: Integer;
|
|
FOnChange: TcxComponentCollectionChangeEvent;
|
|
function GetCount: Integer;
|
|
procedure InsertItem(AItem: TcxComponentCollectionItem);
|
|
procedure RemoveItem(AItem: TcxComponentCollectionItem);
|
|
protected
|
|
procedure Changed(AItem: TcxComponentCollectionItem = nil;
|
|
AAction: TcxComponentCollectionNotification = ccnChanged);
|
|
function GetItem(AIndex: Integer): TcxComponentCollectionItem;
|
|
function GetOwner: TPersistent; override;
|
|
procedure Notify(AItem: TcxComponentCollectionItem;
|
|
AAction: TcxComponentCollectionNotification); virtual;
|
|
procedure SetItem(AIndex: Integer; Value: TcxComponentCollectionItem);
|
|
procedure SetItemName(AItem: TcxComponentCollectionItem); virtual;
|
|
procedure Update(AItem: TcxComponentCollectionItem;
|
|
AAction: TcxComponentCollectionNotification); virtual;
|
|
|
|
property NextID: Integer read FNextID;
|
|
property UpdateCount: Integer read FUpdateCount;
|
|
public
|
|
constructor Create(AParentComponent: TComponent; AItemClass: TcxComponentCollectionItemClass); virtual;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function Add: TcxComponentCollectionItem;
|
|
procedure BeginUpdate; virtual;
|
|
procedure Clear;
|
|
procedure Delete(AIndex: Integer);
|
|
procedure EndUpdate(AForceUpdate: Boolean = True); virtual;
|
|
function FindItemByID(ID: Integer): TcxComponentCollectionItem;
|
|
function Insert(AIndex: Integer): TcxComponentCollectionItem;
|
|
procedure Remove(AItem: TcxComponentCollectionItem);
|
|
|
|
property Count: Integer read GetCount;
|
|
property ParentComponent: TComponent read FParentComponent;
|
|
property Items[AIndex: Integer]: TcxComponentCollectionItem read GetItem write SetItem; default;
|
|
property OnChange: TcxComponentCollectionChangeEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
TcxNotifyProcedure = procedure(Sender: TObject);
|
|
|
|
function cxAddObjectLink(AObject: TObject): TcxObjectLink;
|
|
procedure cxRemoveObjectLink(ALink: TcxObjectLink);
|
|
procedure cxClearObjectLinks(AObject: TObject);
|
|
|
|
procedure CallNotify(ANotifyEvent: TNotifyEvent; ASender: TObject);
|
|
function ClassInheritsFrom(AClass: TClass; const AParentClassName: string): Boolean;
|
|
procedure CopyList(ASource, ADestination: TList);
|
|
procedure FillStringsWithEnumTypeValues(AStrings: TStrings; ATypeInfo: PTypeInfo;
|
|
AGetTypeItemCaption: TcxGetCaptionForIntegerItemFunc);
|
|
function GetPersistentOwner(APersistent: TPersistent): TPersistent;
|
|
function GetSubobjectName(AObject, ASubobject: TPersistent): string;
|
|
function GetValidName(AComponent: TComponent; const AName: string;
|
|
AIsBaseName: Boolean = False): string;
|
|
function HexToByte(const AHex: string): Byte;
|
|
procedure RenameComponents(ACaller, AOwner: TComponent;
|
|
ANewName, AOldName: TComponentName;
|
|
AComponentCount: Integer; AGetComponent: TcxGetComponent);
|
|
function RoundDiv(I1, I2: Integer): Integer;
|
|
function Size(cx, cy: Longint): TSize;
|
|
procedure SwapIntegers(var I1, I2: Integer);
|
|
function GetRangeCenter(ABound1, ABound2: Integer): Integer;
|
|
function StreamsEqual(AStream1, AStream2: TMemoryStream): Boolean;
|
|
procedure OpenWebPage(const AWebAddress: string);
|
|
function GetCorrectPath(const S: string): string;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
function IfThen(AValue: Boolean; ATrue: Integer; AFalse: Integer = 0): Integer;
|
|
function InRange(AValue, AMin, AMax: Integer): Boolean;
|
|
function Supports(const Instance: TObject; const IID: TGUID): Boolean; overload;
|
|
{$IFNDEF DELPHI5}
|
|
function Supports(const Instance: IUnknown; const Intf: TGUID; out Inst): Boolean; overload;
|
|
function Supports(Instance: TObject; const Intf: TGUID; out Inst): Boolean; overload;
|
|
procedure FreeAndNil(var Obj);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function cxGetLocaleInfo(ALocale, ALocaleType: Integer; const ADefaultValue: string): string;
|
|
function cxStrCharLength(const AStr: string; AIndex: Integer = 1): Integer;
|
|
function cxNextCharPos(const AStr: string; AIndex: Integer): Integer;
|
|
function cxPrevCharPos(const AStr: string; AIndex: Integer): Integer;
|
|
|
|
function cxGetResourceString(AResString: TcxResourceStringID): string; overload;
|
|
procedure cxSetResourceString(AResString: TcxResourceStringID; const Value: string);
|
|
function cxGetResourceString(const AResString: string): string; overload;{$IFDEF DELPHI6} deprecated;{$ENDIF}
|
|
function cxGetResourceStringNet(const AResString: string): string;{$IFDEF DELPHI6} deprecated;{$ENDIF}
|
|
procedure cxSetResourceStringNet(const AResString, Value: string);{$IFDEF DELPHI6} deprecated;{$ENDIF}
|
|
|
|
function CreateUniqueName(AOwnerForm, AOwnerComponent, AComponent: TComponent;
|
|
const APrefixName, ASuffixName: string): string;
|
|
|
|
procedure cxZeroMemory(ADestination: Pointer; ACount: Integer);
|
|
function cxAllocMem(Size: Cardinal): Pointer;
|
|
procedure cxFreeMem(P: Pointer);
|
|
|
|
procedure cxCopyData(Source, Dest: Pointer; Count: Integer); overload;
|
|
procedure cxCopyData(Source, Dest: Pointer; ASourceOffSet, ADestOffSet, Count: Integer); overload;
|
|
function ReadBoolean(ASource: Pointer; AOffset: Integer = 0): WordBool;
|
|
function ReadByte(ASource: Pointer; AOffset: Integer = 0): Byte;
|
|
function ReadInteger(ASource: Pointer; AOffset: Integer = 0): Integer;
|
|
function ReadWord(ASource: Pointer; AOffset: Integer = 0): Word;
|
|
procedure WriteBoolean(ADest: Pointer; AValue: WordBool; AOffset: Integer = 0);
|
|
procedure WriteByte(ADest: Pointer; AValue: Byte; AOffset: Integer = 0);
|
|
procedure WriteInteger(ADest: Pointer; AValue: Integer; AOffset: Integer = 0);
|
|
procedure WriteWord(ADest: Pointer; AValue: Word; AOffset: Integer = 0);
|
|
|
|
function cxSign(const AValue: Double): Integer;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Math, Graphics, Controls;
|
|
|
|
type
|
|
TPersistentAccess = class(TPersistent);
|
|
|
|
var
|
|
FObjectLinkController: TcxObjectLinkController;
|
|
FObjectLinkControllerRefCount: Integer;
|
|
|
|
function GetShortHint(const Hint: string): string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := AnsiPos('|', Hint);
|
|
if I = 0 then
|
|
Result := Hint else
|
|
Result := Copy(Hint, 1, I - 1);
|
|
end;
|
|
|
|
function GetLongHint(const Hint: string): string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := AnsiPos('|', Hint);
|
|
if I = 0 then
|
|
Result := Hint else
|
|
Result := Copy(Hint, I + 1, Maxint);
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
function IfThen(AValue: Boolean; ATrue, AFalse: Integer): Integer;
|
|
begin
|
|
if AValue then
|
|
Result := ATrue
|
|
else
|
|
Result := AFalse;
|
|
end;
|
|
|
|
function InRange(AValue, AMin, AMax: Integer): Boolean;
|
|
begin
|
|
Result := (AValue <= AMax) and (AValue >= AMin);
|
|
end;
|
|
|
|
function Supports(const Instance: TObject; const IID: TGUID): Boolean;
|
|
var
|
|
Temp: IUnknown;
|
|
begin
|
|
Result := Supports(Instance, IID, Temp);
|
|
end;
|
|
{$IFNDEF DELPHI5}
|
|
function Supports(const Instance: IUnknown; const Intf: TGUID; out Inst): Boolean; overload;
|
|
begin
|
|
Result := (Instance <> nil) and (Instance.QueryInterface(Intf, Inst) = 0);
|
|
end;
|
|
|
|
function Supports(Instance: TObject; const Intf: TGUID; out Inst): Boolean; overload;
|
|
var
|
|
Unk: IUnknown;
|
|
begin
|
|
Result := (Instance <> nil) and Instance.GetInterface(IUnknown, Unk) and
|
|
Supports(Unk, Intf, Inst);
|
|
end;
|
|
|
|
procedure FreeAndNil(var Obj);
|
|
var
|
|
Temp: TObject;
|
|
begin
|
|
Temp := TObject(Obj);
|
|
Pointer(Obj) := nil;
|
|
Temp.Free;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function cxGetLocaleInfo(ALocale, ALocaleType: Integer; const ADefaultValue: string): string;
|
|
var
|
|
ABuffer: string;
|
|
ABufferSize: Integer;
|
|
begin
|
|
ABufferSize := GetLocaleInfo(ALocale, ALocaleType, nil, 0);
|
|
if ABufferSize = 0 then
|
|
Result := ADefaultValue
|
|
else
|
|
begin
|
|
SetLength(ABuffer, ABufferSize);
|
|
GetLocaleInfo(ALocale, ALocaleType, PChar(ABuffer), ABufferSize);
|
|
Result := Copy(ABuffer, 1, ABufferSize - 1)
|
|
end;
|
|
end;
|
|
|
|
function GetPChar(const AStr: string; AIndex: Integer): PChar;
|
|
begin
|
|
Result := PChar(AStr) + AIndex - 1;
|
|
end;
|
|
|
|
function cxStrCharLength(const AStr: string; AIndex: Integer = 1): Integer;
|
|
begin
|
|
Result := Integer(CharNext(GetPChar(AStr, AIndex))) - Integer(GetPChar(AStr, AIndex));
|
|
end;
|
|
|
|
function cxNextCharPos(const AStr: string; AIndex: Integer): Integer;
|
|
begin
|
|
Result := Integer(CharNext(GetPChar(AStr, AIndex))) - Integer(GetPChar(AStr, 1)) + 1;
|
|
end;
|
|
|
|
function cxPrevCharPos(const AStr: string; AIndex: Integer): Integer;
|
|
begin
|
|
Result := Integer(CharPrev(GetPChar(AStr, 1), GetPChar(AStr, AIndex))) - Integer(GetPChar(AStr, 1)) + 1;
|
|
end;
|
|
|
|
{ TcxInterfacedPersistent }
|
|
|
|
constructor TcxInterfacedPersistent.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TcxInterfacedPersistent.GetOwner: TPersistent;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
|
|
function TcxInterfacedPersistent._AddRef: Integer;
|
|
begin
|
|
if FOwnerInterface <> nil then
|
|
Result := FOwnerInterface._AddRef
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TcxInterfacedPersistent._Release: Integer;
|
|
begin
|
|
if FOwnerInterface <> nil then
|
|
Result := FOwnerInterface._Release
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
function TcxInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
const
|
|
E_NOINTERFACE = HResult($80004002);
|
|
begin
|
|
if GetInterface(IID, Obj) then
|
|
Result := 0
|
|
else
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
procedure TcxInterfacedPersistent.AfterConstruction;
|
|
begin
|
|
inherited;
|
|
if GetOwner <> nil then
|
|
GetOwner.GetInterface(IUnknown, FOwnerInterface);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TcxOwnedPersistent }
|
|
|
|
constructor TcxOwnedPersistent.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TcxOwnedPersistent.GetOwner: TPersistent;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
{ TcxOwnedInterfacedPersistent }
|
|
|
|
function TcxOwnedInterfacedPersistent._AddRef: Integer;
|
|
begin
|
|
Result := -1;
|
|
end;
|
|
|
|
function TcxOwnedInterfacedPersistent._Release: Integer;
|
|
begin
|
|
Result := -1;
|
|
end;
|
|
|
|
function TcxOwnedInterfacedPersistent.QueryInterface(
|
|
const IID: TGUID; out Obj): HResult;
|
|
begin
|
|
if GetInterface(IID, Obj) then Result := 0 else Result := cxE_NOINTERFACE;
|
|
end;
|
|
|
|
{ TcxComponent }
|
|
|
|
destructor TcxComponent.Destroy;
|
|
begin
|
|
cxClearObjectLinks(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TcxComponent.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdateFakeLinks;
|
|
end;
|
|
|
|
procedure TcxComponent.BeforeDestruction;
|
|
begin
|
|
if not IsDestroying then Destroying;
|
|
end;
|
|
|
|
procedure TcxComponent.GetFakeComponentLinks(AList: TList);
|
|
begin
|
|
end;
|
|
|
|
procedure TcxComponent.UpdateFakeLinks;
|
|
var
|
|
I: Integer;
|
|
AList: TList;
|
|
begin
|
|
if not IsDesigning or IsDestroying or (Owner = nil) then Exit;
|
|
AList := TList.Create;
|
|
try
|
|
GetFakeComponentLinks(AList);
|
|
for I := 0 to GetFakeComponentLinkCount - 1 do
|
|
if I < AList.Count then
|
|
SetFakeComponentLink(I, TComponent(AList[I]))
|
|
else
|
|
SetFakeComponentLink(I, nil);
|
|
finally
|
|
AList.Free;
|
|
end;
|
|
end;
|
|
|
|
function TcxComponent.GetFakeComponentLinkCount: Integer;
|
|
begin
|
|
Result := 3;
|
|
end;
|
|
|
|
function TcxComponent.GetIsDesigning: Boolean;
|
|
begin
|
|
Result := csDesigning in ComponentState;
|
|
end;
|
|
|
|
function TcxComponent.GetIsDestroying: Boolean;
|
|
begin
|
|
Result := csDestroying in ComponentState;
|
|
end;
|
|
|
|
procedure TcxComponent.SetFakeComponentLink(Index: Integer; Value: TComponent);
|
|
begin
|
|
case Index of
|
|
0: FFakeComponentLink1 := Value;
|
|
1: FFakeComponentLink2 := Value;
|
|
2: FFakeComponentLink3 := Value;
|
|
end;
|
|
end;
|
|
|
|
{ TcxCollection }
|
|
|
|
procedure TcxCollection.Assign(Source: TPersistent);
|
|
var
|
|
I: Integer;
|
|
AItem: TCollectionItem;
|
|
begin
|
|
if Source is TCollection then
|
|
begin
|
|
if (Count = 0) and (TCollection(Source).Count = 0) then Exit;
|
|
BeginUpdate;
|
|
try
|
|
for I := 0 to TCollection(Source).Count - 1 do
|
|
begin
|
|
if I > Count - 1 then
|
|
AItem := Add
|
|
else
|
|
AItem := Items[I];
|
|
AItem.Assign(TCollection(Source).Items[I]);
|
|
end;
|
|
for I := Count - 1 downto TCollection(Source).Count do
|
|
Delete(I);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
function TcxCollection.Owner: TPersistent;
|
|
begin
|
|
Result := GetOwner;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TcxObjectList }
|
|
|
|
procedure TcxObjectList.Clear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Free;
|
|
inherited Clear;
|
|
end;
|
|
|
|
function TcxObjectList.GetItem(Index: Integer): TObject;
|
|
begin
|
|
Result := inherited Items[Index];
|
|
end;
|
|
|
|
{ TcxRegisteredClassList }
|
|
|
|
constructor TcxRegisteredClassList.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
destructor TcxRegisteredClassList.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(FItems);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TcxRegisteredClassList.Clear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FItems.Count - 1 do
|
|
TcxRegisteredClassListItemData(FItems[I]).Free;
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TcxRegisteredClassList.FindClass(AItemClass: TClass): TClass;
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
if Find(AItemClass, AIndex) then
|
|
Result := Items[AIndex].RegisteredClass
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TcxRegisteredClassList.Register(AItemClass, ARegisteredClass: TClass);
|
|
var
|
|
AIndex: Integer;
|
|
AData: TcxRegisteredClassListItemData;
|
|
begin
|
|
AIndex := -1;
|
|
AData := TcxRegisteredClassListItemData.Create;
|
|
AData.ItemClass := AItemClass;
|
|
AData.RegisteredClass := ARegisteredClass;
|
|
if Find(AItemClass, AIndex) then
|
|
FItems.Insert(AIndex + 1, AData)
|
|
else
|
|
if AIndex <> -1 then
|
|
FItems.Insert(AIndex, AData)
|
|
else
|
|
FItems.Add(AData);
|
|
end;
|
|
|
|
procedure TcxRegisteredClassList.Unregister(AItemClass, ARegisteredClass: TClass);
|
|
var
|
|
I: Integer;
|
|
AData: TcxRegisteredClassListItemData;
|
|
begin
|
|
for I := FItems.Count - 1 downto 0 do
|
|
begin
|
|
AData := Items[I];
|
|
if (AData.ItemClass = AItemClass) and (AData.RegisteredClass = ARegisteredClass) then
|
|
begin
|
|
AData.Free;
|
|
FItems.Delete(I);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TcxRegisteredClassList.Find(AItemClass: TClass; var AIndex: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
AData: TcxRegisteredClassListItemData;
|
|
begin
|
|
Result := False;
|
|
for I := FItems.Count - 1 downto 0 do
|
|
begin
|
|
AData := Items[I];
|
|
if AItemClass.InheritsFrom(AData.ItemClass) then
|
|
begin
|
|
AIndex := I;
|
|
Result := True;
|
|
Break;
|
|
end
|
|
else
|
|
if AData.ItemClass.InheritsFrom(AItemClass) then
|
|
AIndex := I;
|
|
end;
|
|
end;
|
|
|
|
function TcxRegisteredClassList.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TcxRegisteredClassList.GetItem(Index: Integer): TcxRegisteredClassListItemData;
|
|
begin
|
|
Result := TcxRegisteredClassListItemData(FItems[Index]);
|
|
end;
|
|
|
|
{ TcxRegisteredClasses }
|
|
|
|
type
|
|
TcxRegisteredClassesStringList = class(TStringList)
|
|
public
|
|
Owner: TcxRegisteredClasses;
|
|
end;
|
|
|
|
constructor TcxRegisteredClasses.Create(ARegisterClasses: Boolean = False);
|
|
begin
|
|
inherited Create;
|
|
FRegisterClasses := ARegisterClasses;
|
|
FItems := TcxRegisteredClassesStringList.Create;
|
|
TcxRegisteredClassesStringList(FItems).Owner := Self;
|
|
end;
|
|
|
|
destructor TcxRegisteredClasses.Destroy;
|
|
begin
|
|
Clear;
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetDescription(Index: Integer): string;
|
|
begin
|
|
Result := GetShortHint(FItems[Index]);
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetHint(Index: Integer): string;
|
|
begin
|
|
Result := GetLongHint(FItems[Index]);
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetItem(Index: Integer): TClass;
|
|
begin
|
|
Result := TClass(FItems.Objects[Index]);
|
|
end;
|
|
|
|
procedure TcxRegisteredClasses.SetSorted(Value: Boolean);
|
|
begin
|
|
if FSorted <> Value then
|
|
begin
|
|
FSorted := Value;
|
|
if FSorted then Sort;
|
|
end;
|
|
end;
|
|
|
|
function TcxRegisteredClasses.CompareItems(AIndex1, AIndex2: Integer): Integer;
|
|
begin
|
|
Result := AnsiCompareText(Descriptions[AIndex1], Descriptions[AIndex2]);
|
|
end;
|
|
|
|
function SortClasses(List: TStringList; Index1, Index2: Integer): Integer;
|
|
begin
|
|
Result := TcxRegisteredClassesStringList(List).Owner.CompareItems(Index1, Index2);
|
|
end;
|
|
|
|
procedure TcxRegisteredClasses.Sort;
|
|
begin
|
|
FItems.CustomSort(SortClasses);
|
|
end;
|
|
|
|
procedure TcxRegisteredClasses.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TcxRegisteredClasses.FindByClassName(const AClassName: string): TClass;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
if Items[I].ClassName = AClassName then
|
|
begin
|
|
Result := Items[I];
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TcxRegisteredClasses.FindByDescription(const ADescription: string): TClass;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
if Descriptions[I] = ADescription then
|
|
begin
|
|
Result := Items[I];
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetDescriptionByClass(AClass: TClass): string;
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
AIndex := GetIndexByClass(AClass);
|
|
if AIndex = -1 then
|
|
Result := ''
|
|
else
|
|
Result := Descriptions[AIndex];
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetHintByClass(AClass: TClass): string;
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
AIndex := GetIndexByClass(AClass);
|
|
if AIndex = -1 then
|
|
Result := ''
|
|
else
|
|
Result := Hints[AIndex];
|
|
end;
|
|
|
|
function TcxRegisteredClasses.GetIndexByClass(AClass: TClass): Integer;
|
|
begin
|
|
Result := FItems.IndexOfObject(TObject(AClass));
|
|
end;
|
|
|
|
procedure TcxRegisteredClasses.Register(AClass: TClass; const ADescription: string);
|
|
begin
|
|
if GetIndexByClass(AClass) = -1 then
|
|
begin
|
|
FItems.AddObject(ADescription, TObject(AClass));
|
|
if FSorted then Sort;
|
|
if FRegisterClasses then RegisterClass(TPersistentClass(AClass));
|
|
end;
|
|
end;
|
|
|
|
procedure TcxRegisteredClasses.Unregister(AClass: TClass);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := GetIndexByClass(AClass);
|
|
if I <> -1 then
|
|
FItems.Delete(I);
|
|
end;
|
|
|
|
{ TcxAutoWidthItem }
|
|
|
|
constructor TcxAutoWidthItem.Create;
|
|
begin
|
|
inherited;
|
|
AutoWidth := -1;
|
|
end;
|
|
|
|
{ TcxAutoWidthObject }
|
|
|
|
constructor TcxAutoWidthObject.Create(ACount: Integer);
|
|
begin
|
|
inherited Create;
|
|
FItems := TList.Create;
|
|
FItems.Capacity := ACount;
|
|
end;
|
|
|
|
destructor TcxAutoWidthObject.Destroy;
|
|
begin
|
|
Clear;
|
|
FItems.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TcxAutoWidthObject.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TcxAutoWidthObject.GetItem(Index: Integer): TcxAutoWidthItem;
|
|
begin
|
|
Result := TcxAutoWidthItem(FItems[Index]);
|
|
end;
|
|
|
|
function TcxAutoWidthObject.GetWidth: Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Items[I].Width);
|
|
end;
|
|
|
|
procedure TcxAutoWidthObject.Clear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Count - 1 downto 0 do Items[I].Free;
|
|
end;
|
|
|
|
function TcxAutoWidthObject.AddItem: TcxAutoWidthItem;
|
|
begin
|
|
Result := TcxAutoWidthItem.Create;
|
|
FItems.Add(Result);
|
|
end;
|
|
|
|
procedure TcxAutoWidthObject.Calculate;
|
|
var
|
|
AAvailableWidth, AWidth, ANewAvailableWidth, ANewWidth, AOffset, I,
|
|
AItemAutoWidth: Integer;
|
|
AAssignAllWidths, AItemWithMinWidthFound: Boolean;
|
|
|
|
procedure RemoveItemFromCalculation(AItem: TcxAutoWidthItem);
|
|
begin
|
|
with AItem do
|
|
begin
|
|
Dec(ANewAvailableWidth, AutoWidth);
|
|
Dec(ANewWidth, Width);
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessFixedItems;
|
|
var
|
|
I: Integer;
|
|
|
|
procedure ProcessItem(AItem: TcxAutoWidthItem);
|
|
begin
|
|
with AItem do
|
|
if Fixed then
|
|
begin
|
|
AutoWidth := Width;
|
|
RemoveItemFromCalculation(AItem);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
for I := 0 to Count - 1 do ProcessItem(Items[I]);
|
|
end;
|
|
|
|
{procedure ProcessFixedColumns;
|
|
var
|
|
AFixedIndex, I: Integer;
|
|
begin
|
|
if not (gcsColumnSizing in GridDefinition.Controller.State) then Exit;
|
|
AFixedIndex :=
|
|
(GridDefinition.Controller.DragAndDropObject as TcxGridColumnHeaderSizingObject).Column.VisibleIndex;
|
|
if AFixedIndex = Count - 1 then Exit;
|
|
for I := 0 to Count - 1 do
|
|
if I <= AFixedIndex then
|
|
begin
|
|
AColumnWidth := Items[I].CalculateWidth;
|
|
Items[I].Width := AColumnWidth;
|
|
Dec(AAvailableWidth, AColumnWidth);
|
|
Dec(AWidth, AColumnWidth);
|
|
end;
|
|
end;}
|
|
|
|
procedure ProcessItem(AItem: TcxAutoWidthItem);
|
|
|
|
function CalculateItemAutoWidth: Integer;
|
|
begin
|
|
Result :=
|
|
MulDiv(AOffset + AItem.Width, AAvailableWidth, AWidth) -
|
|
MulDiv(AOffset, AAvailableWidth, AWidth);
|
|
end;
|
|
|
|
begin
|
|
AItemAutoWidth := CalculateItemAutoWidth;
|
|
if AAssignAllWidths then
|
|
AItem.AutoWidth := AItemAutoWidth
|
|
else
|
|
if AItemAutoWidth <= AItem.MinWidth then
|
|
begin
|
|
AItem.AutoWidth := AItem.MinWidth;
|
|
RemoveItemFromCalculation(AItem);
|
|
AItemWithMinWidthFound := True;
|
|
end;
|
|
Inc(AOffset, AItem.Width);
|
|
end;
|
|
|
|
begin
|
|
AAvailableWidth := FAvailableWidth;
|
|
AWidth := Width;
|
|
|
|
ANewAvailableWidth := AAvailableWidth;
|
|
ANewWidth := AWidth;
|
|
ProcessFixedItems;
|
|
AAssignAllWidths := False;
|
|
repeat
|
|
AAvailableWidth := ANewAvailableWidth;
|
|
AWidth := ANewWidth;
|
|
AOffset := 0;
|
|
AItemWithMinWidthFound := False;
|
|
|
|
for I := 0 to Count - 1 do
|
|
if Items[I].AutoWidth = -1 then ProcessItem(Items[I]);
|
|
|
|
if not AItemWithMinWidthFound then
|
|
AAssignAllWidths := not AAssignAllWidths;
|
|
until (ANewWidth = 0) or not AItemWithMinWidthFound and not AAssignAllWidths;
|
|
end;
|
|
|
|
{ TcxAlignment }
|
|
|
|
constructor TcxAlignment.Create(AOwner: TPersistent; AUseAssignedValues: Boolean = False;
|
|
ADefaultHorz: TAlignment = taLeftJustify; ADefaultVert: TcxAlignmentVert = vaTop);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
FUseAssignedValues := AUseAssignedValues;
|
|
FDefaultHorz := ADefaultHorz;
|
|
FDefaultVert := ADefaultVert;
|
|
FHorz := FDefaultHorz;
|
|
FVert := FDefaultVert;
|
|
end;
|
|
|
|
procedure TcxAlignment.Assign(Source: TPersistent);
|
|
var
|
|
AChanged: Boolean;
|
|
begin
|
|
if Source is TcxAlignment then
|
|
with Source as TcxAlignment do
|
|
begin
|
|
AChanged := Self.FHorz <> FHorz;
|
|
Self.FHorz := FHorz;
|
|
AChanged := AChanged or (Self.FVert <> FVert);
|
|
Self.FVert := FVert;
|
|
Self.FIsHorzAssigned := FIsHorzAssigned;
|
|
Self.FIsVertAssigned := FIsVertAssigned;
|
|
if AChanged then
|
|
Self.DoChanged;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TcxAlignment.Reset;
|
|
var
|
|
AChanged: Boolean;
|
|
begin
|
|
FIsHorzAssigned := False;
|
|
FIsVertAssigned := False;
|
|
AChanged := FHorz <> FDefaultHorz;
|
|
FHorz := FDefaultHorz;
|
|
AChanged := AChanged or (FVert <> FDefaultVert);
|
|
FVert := FDefaultVert;
|
|
if AChanged then
|
|
DoChanged;
|
|
end;
|
|
|
|
procedure TcxAlignment.DoChanged;
|
|
begin
|
|
if Assigned(FOnChanged) then
|
|
FOnChanged(Self);
|
|
end;
|
|
|
|
function TcxAlignment.GetOwner: TPersistent;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
function TcxAlignment.IsHorzStored: Boolean;
|
|
begin
|
|
if FUseAssignedValues then
|
|
Result := FIsHorzAssigned
|
|
else
|
|
Result := FHorz <> FDefaultHorz;
|
|
end;
|
|
|
|
function TcxAlignment.IsVertStored: Boolean;
|
|
begin
|
|
if FUseAssignedValues then
|
|
Result := FIsVertAssigned
|
|
else
|
|
Result := FVert <> FDefaultVert;
|
|
end;
|
|
|
|
procedure TcxAlignment.SetHorz(const Value: TAlignment);
|
|
begin
|
|
FIsHorzAssigned := True;
|
|
if Value <> FHorz then
|
|
begin
|
|
FHorz := Value;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxAlignment.SetVert(const Value: TcxAlignmentVert);
|
|
begin
|
|
FIsVertAssigned := True;
|
|
if Value <> FVert then
|
|
begin
|
|
FVert := Value;
|
|
DoChanged;
|
|
end;
|
|
end;
|
|
|
|
{ TcxObjectLinkController }
|
|
|
|
constructor TcxObjectLinkController.Create;
|
|
begin
|
|
inherited Create;
|
|
FLinks := TList.Create;
|
|
end;
|
|
|
|
destructor TcxObjectLinkController.Destroy;
|
|
begin
|
|
FreeAndNil(FLinks);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TcxObjectLinkController.AddLink(AObject: TObject): TcxObjectLink;
|
|
begin
|
|
Result := TcxObjectLink.Create;
|
|
Result.Ref := AObject;
|
|
FLinks.Add(Result);
|
|
end;
|
|
|
|
procedure TcxObjectLinkController.RemoveLink(ALink: TcxObjectLink);
|
|
begin
|
|
if ALink.Ref <> nil then
|
|
FLinks.Remove(ALink);
|
|
ALink.Free;
|
|
end;
|
|
|
|
procedure TcxObjectLinkController.ClearLinks(AObject: TObject);
|
|
var
|
|
I: Integer;
|
|
ALink: TcxObjectLink;
|
|
begin
|
|
for I := FLinks.Count - 1 downto 0 do
|
|
begin
|
|
ALink := TcxObjectLink(FLinks[I]);
|
|
if ALink.Ref = AObject then
|
|
begin
|
|
ALink.Ref := nil;
|
|
FLinks.Delete(I);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TcxFreeNotificator }
|
|
|
|
procedure TcxFreeNotificator.AddSender(ASender: TComponent);
|
|
begin
|
|
if ASender <> nil then
|
|
ASender.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TcxFreeNotificator.RemoveSender(ASender: TComponent);
|
|
begin
|
|
{$IFDEF DELPHI5}
|
|
if ASender <> nil then
|
|
ASender.RemoveFreeNotification(Self);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TcxFreeNotificator.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and Assigned(FOnFreeNotification) then
|
|
FOnFreeNotification(AComponent);
|
|
end;
|
|
|
|
procedure AddObjectLinkControllerRefCount;
|
|
begin
|
|
Inc(FObjectLinkControllerRefCount);
|
|
if FObjectLinkController = nil then
|
|
FObjectLinkController := TcxObjectLinkController.Create;
|
|
end;
|
|
|
|
procedure ReleaseObjectLinkControllerRefCount;
|
|
begin
|
|
Dec(FObjectLinkControllerRefCount);
|
|
if FObjectLinkControllerRefCount = 0 then
|
|
FreeAndNil(FObjectLinkController);
|
|
end;
|
|
|
|
function cxAddObjectLink(AObject: TObject): TcxObjectLink;
|
|
begin
|
|
if AObject <> nil then
|
|
begin
|
|
AddObjectLinkControllerRefCount;
|
|
Result := FObjectLinkController.AddLink(AObject);
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure cxRemoveObjectLink(ALink: TcxObjectLink);
|
|
begin
|
|
if ALink <> nil then
|
|
begin
|
|
FObjectLinkController.RemoveLink(ALink);
|
|
ReleaseObjectLinkControllerRefCount;
|
|
end;
|
|
end;
|
|
|
|
procedure cxClearObjectLinks(AObject: TObject);
|
|
begin
|
|
if FObjectLinkController <> nil then
|
|
FObjectLinkController.ClearLinks(AObject);
|
|
end;
|
|
|
|
{ TcxMRUItems }
|
|
|
|
constructor TcxMRUItems.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
destructor TcxMRUItems.Destroy;
|
|
begin
|
|
ClearItems;
|
|
FItems.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TcxMRUItems.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TcxMRUItems.GetItem(Index: Integer): TcxMRUItem;
|
|
begin
|
|
Result := TcxMRUItem(FItems[Index]);
|
|
end;
|
|
|
|
procedure TcxMRUItems.SetCount(Value: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Value < Count then
|
|
for I := Count - 1 downto Value do
|
|
Delete(I);
|
|
end;
|
|
|
|
procedure TcxMRUItems.SetMaxCount(Value: Integer);
|
|
begin
|
|
if Value < 0 then Value := 0;
|
|
if FMaxCount <> Value then
|
|
begin
|
|
FMaxCount := Value;
|
|
UpdateCount;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxMRUItems.Delete(AIndex: Integer);
|
|
begin
|
|
Items[AIndex].Free;
|
|
FItems.Delete(AIndex);
|
|
end;
|
|
|
|
procedure TcxMRUItems.UpdateCount;
|
|
begin
|
|
if MaxCount <> 0 then Count := MaxCount;
|
|
end;
|
|
|
|
procedure TcxMRUItems.Add(AItem: TcxMRUItem);
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
AIndex := IndexOf(AItem);
|
|
if AIndex = -1 then
|
|
begin
|
|
FItems.Insert(0, AItem);
|
|
UpdateCount;
|
|
end
|
|
else
|
|
begin
|
|
FItems.Move(AIndex, 0);
|
|
AItem.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxMRUItems.ClearItems;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Count - 1 downto 0 do
|
|
Delete(I);
|
|
end;
|
|
|
|
function TcxMRUItems.IndexOf(AItem: TcxMRUItem): Integer;
|
|
begin
|
|
for Result := 0 to Count - 1 do
|
|
if Items[Result].Equals(AItem) then Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
{ TcxOpenList }
|
|
|
|
function TcxOpenList.GetItem(Index: Integer): TObject;
|
|
begin
|
|
Result := TObject(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TcxOpenList.SetItem(Index: Integer; Value: TObject);
|
|
begin
|
|
Count := Max(Count, 1 + Index);
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
{ TcxComponentCollectionItem }
|
|
|
|
destructor TcxComponentCollectionItem.Destroy;
|
|
begin
|
|
SetCollection(nil);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TcxComponentCollectionItem.Changed(AAllItems: Boolean);
|
|
begin
|
|
if not (csDestroying in ComponentState) and (Collection <> nil) then
|
|
if AAllItems then
|
|
Collection.Changed
|
|
else
|
|
Collection.Changed(Self);
|
|
end;
|
|
|
|
function TcxComponentCollectionItem.GetDisplayName: string;
|
|
begin
|
|
Result := Name;
|
|
end;
|
|
|
|
function TcxComponentCollectionItem.GetParentComponent: TComponent;
|
|
begin
|
|
if Collection <> nil then
|
|
Result := Collection.ParentComponent
|
|
else
|
|
Result := inherited GetParentComponent;
|
|
end;
|
|
|
|
function TcxComponentCollectionItem.HasParent: Boolean;
|
|
begin
|
|
Result := GetParentComponent <> nil;
|
|
end;
|
|
|
|
procedure TcxComponentCollectionItem.SetParentComponent(Value: TComponent);
|
|
begin
|
|
Collection := GetCollectionFromParent(Value);
|
|
end;
|
|
|
|
procedure TcxComponentCollectionItem.SetCollection(AValue: TcxComponentCollection);
|
|
begin
|
|
if Collection <> AValue then
|
|
begin
|
|
RemoveFromCollection(Collection);
|
|
AddToCollection(AValue);
|
|
end;
|
|
end;
|
|
|
|
procedure TcxComponentCollectionItem.SetIndex(AValue: Integer);
|
|
var
|
|
ACurIndex: Integer;
|
|
begin
|
|
ACurIndex := GetIndex;
|
|
if (ACurIndex >= 0) and (ACurIndex <> AValue) then
|
|
begin
|
|
Collection.FItems.Move(ACurIndex, AValue);
|
|
Changed(True);
|
|
end;
|
|
end;
|
|
|
|
procedure TcxComponentCollectionItem.AddToCollection(ACollection: TcxComponentCollection);
|
|
begin
|
|
if ACollection <> nil then
|
|
ACollection.InsertItem(Self);
|
|
end;
|
|
|
|
function TcxComponentCollectionItem.GetIndex: Integer;
|
|
begin
|
|
if Collection <> nil then
|
|
Result := Collection.FItems.IndexOf(Self)
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TcxComponentCollectionItem.RemoveFromCollection(ACollection: TcxComponentCollection);
|
|
begin
|
|
if ACollection <> nil then
|
|
ACollection.RemoveItem(Self);
|
|
end;
|
|
|
|
{ TcxComponentCollection }
|
|
|
|
constructor TcxComponentCollection.Create(AParentComponent: TComponent; AItemClass: TcxComponentCollectionItemClass);
|
|
begin
|
|
inherited Create;
|
|
FParentComponent := AParentComponent;
|
|
FItemClass := AItemClass;
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
destructor TcxComponentCollection.Destroy;
|
|
begin
|
|
FUpdateCount := 1;
|
|
if FItems <> nil then
|
|
Clear;
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Assign(Source: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Source is TcxComponentCollection then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
for I := 0 to TcxComponentCollection(Source).Count - 1 do
|
|
Add.Assign(TcxComponentCollection(Source).Items[I]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TcxComponentCollection.Add: TcxComponentCollectionItem;
|
|
begin
|
|
Result := FItemClass.Create(ParentComponent.Owner);
|
|
Result.SetParentComponent(ParentComponent);
|
|
SetItemName(Result);
|
|
end;
|
|
|
|
procedure TcxComponentCollection.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Clear;
|
|
begin
|
|
if FItems.Count = 0 then Exit;
|
|
BeginUpdate;
|
|
try
|
|
while FItems.Count > 0 do
|
|
TObject(FItems.Last).Free;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Delete(AIndex: Integer);
|
|
begin
|
|
Notify(Items[AIndex], ccnDeleting);
|
|
Items[AIndex].Free;
|
|
end;
|
|
|
|
procedure TcxComponentCollection.EndUpdate(AForceUpdate: Boolean = True);
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if AForceUpdate then
|
|
Changed;
|
|
end;
|
|
|
|
function TcxComponentCollection.FindItemByID(ID: Integer): TcxComponentCollectionItem;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FItems.Count-1 do
|
|
begin
|
|
Result := Items[I];
|
|
if Result.ID = ID then
|
|
Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TcxComponentCollection.Insert(AIndex: Integer): TcxComponentCollectionItem;
|
|
begin
|
|
Result := Add;
|
|
Result.Index := AIndex;
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Remove(AItem: TcxComponentCollectionItem);
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
AIndex := FItems.IndexOf(AItem);
|
|
if AIndex > -1 then
|
|
Delete(AIndex);
|
|
end;
|
|
|
|
procedure TcxComponentCollection.InsertItem(AItem: TcxComponentCollectionItem);
|
|
begin
|
|
if not (AItem is FItemClass) then
|
|
Exit;
|
|
FItems.Add(AItem);
|
|
AItem.FCollection := Self;
|
|
AItem.FID := FNextID;
|
|
Inc(FNextID);
|
|
Notify(AItem, ccnAdded);
|
|
Changed(AItem, ccnAdded);
|
|
end;
|
|
|
|
procedure TcxComponentCollection.RemoveItem(AItem: TcxComponentCollectionItem);
|
|
begin
|
|
Notify(AItem, ccnExtracting);
|
|
FItems.Remove(AItem);
|
|
AItem.FCollection := nil;
|
|
Notify(AItem, ccnExtracted);
|
|
Changed(AItem, ccnExtracted);
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Changed(AItem: TcxComponentCollectionItem = nil;
|
|
AAction: TcxComponentCollectionNotification = ccnChanged);
|
|
begin
|
|
if FUpdateCount = 0 then
|
|
Update(AItem, AAction);
|
|
end;
|
|
|
|
function TcxComponentCollection.GetItem(AIndex: Integer): TcxComponentCollectionItem;
|
|
begin
|
|
Result := TcxComponentCollectionItem(FItems[AIndex]);
|
|
end;
|
|
|
|
function TcxComponentCollection.GetOwner: TPersistent;
|
|
begin
|
|
Result := ParentComponent;
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Notify(AItem: TcxComponentCollectionItem;
|
|
AAction: TcxComponentCollectionNotification);
|
|
begin
|
|
end;
|
|
|
|
procedure TcxComponentCollection.SetItem(AIndex: Integer; Value: TcxComponentCollectionItem);
|
|
begin
|
|
Items[AIndex].Assign(Value);
|
|
end;
|
|
|
|
procedure TcxComponentCollection.SetItemName(AItem: TcxComponentCollectionItem);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TcxComponentCollection.Update(AItem: TcxComponentCollectionItem;
|
|
AAction: TcxComponentCollectionNotification);
|
|
begin
|
|
if Assigned(OnChange) then
|
|
OnChange(Self, AItem, AAction);
|
|
end;
|
|
|
|
function TcxComponentCollection.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
{ functions }
|
|
|
|
procedure CallNotify(ANotifyEvent: TNotifyEvent; ASender: TObject);
|
|
begin
|
|
if Assigned(ANotifyEvent) then
|
|
ANotifyEvent(ASender);
|
|
end;
|
|
|
|
function ClassInheritsFrom(AClass: TClass; const AParentClassName: string): Boolean;
|
|
var
|
|
AParentClass: TClass;
|
|
begin
|
|
AParentClass := AClass;
|
|
repeat
|
|
Result := AParentClass.ClassName = AParentClassName;
|
|
if Result then Break;
|
|
AParentClass := AParentClass.ClassParent;
|
|
until AParentClass = nil;
|
|
end;
|
|
|
|
procedure CopyList(ASource, ADestination: TList);
|
|
begin
|
|
ADestination.Count := ASource.Count;
|
|
Move(ASource.List^, ADestination.List^, ASource.Count * SizeOf(Pointer));
|
|
end;
|
|
|
|
procedure FillStringsWithEnumTypeValues(AStrings: TStrings; ATypeInfo: PTypeInfo;
|
|
AGetTypeItemCaption: TcxGetCaptionForIntegerItemFunc);
|
|
var
|
|
ATypeData: PTypeData;
|
|
I: Integer;
|
|
S: string;
|
|
begin
|
|
ATypeData := GetTypeData(ATypeInfo);
|
|
AStrings.BeginUpdate;
|
|
try
|
|
for I := ATypeData.MinValue to ATypeData.MaxValue do
|
|
begin
|
|
S := AGetTypeItemCaption(I);
|
|
if S <> '' then
|
|
AStrings.AddObject(S, TObject(I));
|
|
end;
|
|
finally
|
|
AStrings.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function GetPersistentOwner(APersistent: TPersistent): TPersistent;
|
|
begin
|
|
Result := TPersistentAccess(APersistent).GetOwner;
|
|
end;
|
|
|
|
function GetSubobjectName(AObject, ASubobject: TPersistent): string;
|
|
var
|
|
APropList: PPropList;
|
|
I: Integer;
|
|
begin
|
|
Result := '';
|
|
I := GetPropList(AObject.ClassInfo, [tkClass], nil);
|
|
GetMem(APropList, I * SizeOf(PPropInfo));
|
|
GetPropList(AObject.ClassInfo, [tkClass], APropList);
|
|
try
|
|
for I := 0 to I - 1 do
|
|
if APropList[I].PropType^ = ASubobject.ClassInfo then
|
|
begin
|
|
Result := APropList[I].Name;
|
|
Break;
|
|
end;
|
|
finally
|
|
FreeMem(APropList);
|
|
end;
|
|
end;
|
|
|
|
function GetValidName(AComponent: TComponent; const AName: string;
|
|
AIsBaseName: Boolean = False): string;
|
|
var
|
|
AOwner: TComponent;
|
|
I: Integer;
|
|
|
|
function GetNextName: string;
|
|
begin
|
|
Result := AName + IntToStr(I);
|
|
Inc(I);
|
|
end;
|
|
|
|
begin
|
|
Result := AName;
|
|
AOwner := AComponent.Owner;
|
|
if AOwner = nil then Exit;
|
|
I := 1;
|
|
if AIsBaseName then Result := GetNextName;
|
|
while AOwner.FindComponent(Result) <> nil do
|
|
Result := GetNextName;
|
|
end;
|
|
|
|
function HexToByte(const AHex: string): Byte;
|
|
|
|
function CharToByte(C: Char): Byte;
|
|
begin
|
|
if C <= '9' then
|
|
Result := Ord(C) - Ord('0')
|
|
else
|
|
Result := 10 + Ord(Upcase(C)) - Ord('A');
|
|
end;
|
|
|
|
begin
|
|
Result := 16 * CharToByte(AHex[1]) + CharToByte(AHex[2]);
|
|
end;
|
|
|
|
procedure RenameComponents(ACaller, AOwner: TComponent;
|
|
ANewName, AOldName: TComponentName;
|
|
AComponentCount: Integer; AGetComponent: TcxGetComponent);
|
|
var
|
|
I: Integer;
|
|
AComponent: TComponent;
|
|
AComponentName, ANamePrefix: TComponentName;
|
|
begin
|
|
// Components introduced in an ancestor will be renamed by IDE.
|
|
// We cannot rename components introduced in a successor because
|
|
// IDE will not refresh source code in a successor.
|
|
if csAncestor in ACaller.ComponentState then Exit;
|
|
for I := 0 to AComponentCount - 1 do
|
|
begin
|
|
AComponent := AGetComponent(ACaller, I);
|
|
if (AComponent.Owner = AOwner) {and not (csAncestor in AComponent.ComponentState)} then
|
|
begin
|
|
AComponentName := AComponent.Name;
|
|
if Length(AComponentName) > Length(AOldName) then
|
|
begin
|
|
ANamePrefix := Copy(AComponentName, 1, Length(AOldName));
|
|
if CompareText(AOldName, ANamePrefix) = 0 then
|
|
begin
|
|
Delete(AComponentName, 1, Length(AOldName));
|
|
Insert(ANewName, AComponentName, 1);
|
|
try
|
|
AComponent.Name := AComponentName;
|
|
except
|
|
on EComponentError do { Ignore rename errors };
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function RoundDiv(I1, I2: Integer): Integer;
|
|
begin
|
|
Result := I1 div I2 + Ord(I1 mod I2 <> 0);
|
|
end;
|
|
|
|
function Size(cx, cy: Longint): TSize;
|
|
begin
|
|
Result.cx := cx;
|
|
Result.cy := cy;
|
|
end;
|
|
|
|
procedure SwapIntegers(var I1, I2: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := I1;
|
|
I1 := I2;
|
|
I2 := I;
|
|
end;
|
|
|
|
function GetRangeCenter(ABound1, ABound2: Integer): Integer;
|
|
begin
|
|
if ABound1 + ABound2 > 0 then
|
|
Result := (ABound1 + ABound2) div 2
|
|
else
|
|
Result := (ABound1 + ABound2 - 1) div 2;
|
|
end;
|
|
|
|
function StreamsEqual(AStream1, AStream2: TMemoryStream): Boolean;
|
|
begin
|
|
Result := (AStream1.Size = AStream2.Size) and
|
|
CompareMem(AStream1.Memory, AStream2.Memory, AStream1.Size);
|
|
end;
|
|
|
|
procedure OpenWebPage(const AWebAddress: string);
|
|
begin
|
|
ShellExecute(0, 'OPEN', PChar(string(AWebAddress)), nil, nil, SW_SHOWMAXIMIZED);
|
|
end;
|
|
|
|
function GetCorrectPath(const S: string): string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := S;
|
|
for I := 1 to Length(Result) do
|
|
if Result[I] = '/' then
|
|
Result[I] := {$IFDEF DELPHI6}PathDelim{$ELSE}'\'{$ENDIF};
|
|
end;
|
|
|
|
type
|
|
TcxResourceStringsModificationMode = (rmmByResStringValue, rmmByResStringID, rmmUndefined);
|
|
|
|
TcxResOriginalStrings = class(TStringList)
|
|
public
|
|
{$IFNDEF DELPHI6}
|
|
function IndexOf(const S: string): Integer; override;
|
|
{$ELSE}
|
|
constructor Create;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
function TcxResOriginalStrings.IndexOf(const S: string): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
for I := 0 to Count - 1 do
|
|
if AnsiCompareStr(Get(I), S) = 0 then
|
|
begin
|
|
Result := I;
|
|
Break;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
constructor TcxResOriginalStrings.Create;
|
|
begin
|
|
inherited Create;
|
|
CaseSensitive := True;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
var
|
|
FResOriginalStrings: TcxResOriginalStrings;
|
|
FResStrings: TStringList;
|
|
FResStringsModificationMode: TcxResourceStringsModificationMode = rmmUndefined;
|
|
|
|
procedure CreateResStringLists(
|
|
AResStringsModificationMode: TcxResourceStringsModificationMode);
|
|
begin
|
|
if AResStringsModificationMode = rmmUndefined then
|
|
raise Exception.Create('');
|
|
if (FResStringsModificationMode <> rmmUndefined) and
|
|
(AResStringsModificationMode <> FResStringsModificationMode) then
|
|
raise Exception.Create('You cannot mix cxSetResourceString and cxSetResourceStringNet calls');
|
|
|
|
if FResStringsModificationMode = rmmUndefined then
|
|
begin
|
|
FResStringsModificationMode := AResStringsModificationMode;
|
|
FResOriginalStrings := TcxResOriginalStrings.Create;
|
|
FResStrings := TStringList.Create;
|
|
end;
|
|
end;
|
|
|
|
procedure DestroyResStringLists;
|
|
begin
|
|
FResStringsModificationMode := rmmUndefined;
|
|
FreeAndNil(FResOriginalStrings);
|
|
FreeAndNil(FResStrings);
|
|
end;
|
|
|
|
function GetResOriginalStringIndex(AResString: TcxResourceStringID): Integer;
|
|
begin
|
|
case FResStringsModificationMode of
|
|
rmmByResStringValue:
|
|
Result := FResOriginalStrings.IndexOf(LoadResString(AResString));
|
|
rmmByResStringID:
|
|
Result := FResOriginalStrings.IndexOfObject(TObject(AResString));
|
|
else
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function cxGetResourceString(AResString: TcxResourceStringID): string;
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
AIndex := GetResOriginalStringIndex(AResString);
|
|
if AIndex <> -1 then
|
|
Result := FResStrings[AIndex]
|
|
else
|
|
Result := LoadResString(AResString);
|
|
end;
|
|
|
|
procedure cxSetResourceString(AResString: TcxResourceStringID;
|
|
const Value: string);
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
CreateResStringLists(rmmByResStringID);
|
|
AIndex := GetResOriginalStringIndex(AResString);
|
|
if AIndex <> -1 then
|
|
FResStrings[AIndex] := Value
|
|
else
|
|
begin
|
|
FResOriginalStrings.AddObject(LoadResString(AResString), TObject(AResString));
|
|
FResStrings.Add(Value);
|
|
end;
|
|
end;
|
|
|
|
function cxGetResourceString(const AResString: string): string;{$IFDEF DELPHI6} deprecated;{$ENDIF}
|
|
begin
|
|
Result := cxGetResourceStringNet(AResString);
|
|
end;
|
|
|
|
function cxGetResourceStringNet(const AResString: string): string;{$IFDEF DELPHI6} deprecated;{$ENDIF}
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
Result := AResString;
|
|
if FResOriginalStrings <> nil then
|
|
begin
|
|
AIndex := FResOriginalStrings.IndexOf(AResString);
|
|
if AIndex <> -1 then
|
|
Result := FResStrings[AIndex];
|
|
end
|
|
end;
|
|
|
|
procedure cxSetResourceStringNet(const AResString, Value: string);{$IFDEF DELPHI6} deprecated;{$ENDIF}
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
CreateResStringLists(rmmByResStringValue);
|
|
AIndex := FResOriginalStrings.IndexOf(AResString);
|
|
if AIndex <> -1 then
|
|
FResStrings[AIndex] := Value
|
|
else
|
|
begin
|
|
FResOriginalStrings.Add(AResString);
|
|
FResStrings.Add(Value);
|
|
end;
|
|
end;
|
|
|
|
function CreateUniqueName(AOwnerForm, AOwnerComponent, AComponent: TComponent;
|
|
const APrefixName, ASuffixName: string): string;
|
|
var
|
|
I, J: Integer;
|
|
|
|
function GenerateName(AOwnerComponent: TComponent;
|
|
const AClassName, APrefixName, ASuffixName: string; ANumber: Integer): string;
|
|
var
|
|
S: string;
|
|
|
|
procedure CheckName(var AName: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := 1;
|
|
while I <= Length(AName) do
|
|
if AName[I] in ['A'..'Z','a'..'z','_','0'..'9'] then
|
|
Inc(I)
|
|
else
|
|
if AName[I] in LeadBytes then
|
|
Delete(AName, I, 2)
|
|
else
|
|
Delete(AName, I, 1);
|
|
end;
|
|
|
|
begin
|
|
S := ASuffixName;
|
|
CheckName(S);
|
|
if ((S = '') or (S[1] in ['0'..'9'])) and (AClassName <> '') then
|
|
if (APrefixName <> '') and
|
|
(CompareText(APrefixName, Copy(AClassName, 1, Length(APrefixName))) = 0) then
|
|
S := Copy(AClassName, Length(APrefixName) + 1, Length(AClassName)) + S
|
|
else
|
|
begin
|
|
S := AClassName + S;
|
|
if S[1] = 'T' then Delete(S, 1, 1);
|
|
end;
|
|
if AOwnerComponent <> nil then
|
|
Result := AOwnerComponent.Name + S
|
|
else
|
|
Result := S;
|
|
if ANumber > 0 then
|
|
Result := Result + IntToStr(ANumber);
|
|
end;
|
|
|
|
function IsUnique(const AName: string): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
with AOwnerForm do
|
|
for I := 0 to ComponentCount - 1 do
|
|
if (Components[I] <> AComponent) and
|
|
(CompareText(Components[I].Name, AName) = 0) then
|
|
begin
|
|
Result := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if ASuffixName <> '' then
|
|
J := 0
|
|
else
|
|
J := 1;
|
|
for I := J to MaxInt do
|
|
begin
|
|
Result := GenerateName(AOwnerComponent, AComponent.ClassName,
|
|
APrefixName, ASuffixName, I);
|
|
if IsUnique(Result) then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure cxZeroMemory(ADestination: Pointer; ACount: Integer);
|
|
begin
|
|
ZeroMemory(ADestination, ACount);
|
|
end;
|
|
|
|
function cxAllocMem(Size: Cardinal): Pointer;
|
|
begin
|
|
GetMem(Result, Size);
|
|
cxZeroMemory(Result, Size);
|
|
end;
|
|
|
|
procedure cxFreeMem(P: Pointer);
|
|
begin
|
|
FreeMem(P);
|
|
end;
|
|
|
|
procedure cxCopyData(Source, Dest: Pointer; Count: Integer);
|
|
begin
|
|
Move(Source^, Dest^, Count);
|
|
end;
|
|
|
|
procedure cxCopyData(Source, Dest: Pointer; ASourceOffSet, ADestOffSet, Count: Integer); overload;
|
|
begin
|
|
if ASourceOffSet > 0 then
|
|
Source := Pointer(Integer(Source) + ASourceOffSet);
|
|
if ADestOffSet > 0 then
|
|
Dest := Pointer(Integer(Dest) + ADestOffSet);
|
|
cxCopyData(Source, Dest, Count);
|
|
end;
|
|
|
|
function ReadBoolean(ASource: Pointer; AOffset: Integer = 0): WordBool;
|
|
begin
|
|
cxCopyData(ASource, @Result, AOffset, 0, SizeOf(WordBool));
|
|
end;
|
|
|
|
function ReadByte(ASource: Pointer; AOffset: Integer = 0): Byte;
|
|
begin
|
|
cxCopyData(ASource, @Result, AOffset, 0, SizeOf(Byte));
|
|
end;
|
|
|
|
function ReadInteger(ASource: Pointer; AOffset: Integer = 0): Integer;
|
|
begin
|
|
cxCopyData(ASource, @Result, AOffset, 0, SizeOf(Integer));
|
|
end;
|
|
|
|
function ReadPointer(ASource: Pointer): Pointer;
|
|
begin
|
|
Result := Pointer(ASource^);
|
|
end;
|
|
|
|
function ReadWord(ASource: Pointer; AOffset: Integer = 0): Word;
|
|
begin
|
|
cxCopyData(ASource, @Result, AOffset, 0, SizeOf(Word));
|
|
end;
|
|
|
|
procedure WriteBoolean(ADest: Pointer; AValue: WordBool; AOffset: Integer = 0);
|
|
begin
|
|
cxCopyData(@AValue, ADest, 0, AOffset, SizeOf(WordBool));
|
|
end;
|
|
|
|
procedure WriteByte(ADest: Pointer; AValue: Byte; AOffset: Integer = 0);
|
|
begin
|
|
cxCopyData(@AValue, ADest, 0, AOffset, SizeOf(Byte));
|
|
end;
|
|
|
|
procedure WriteInteger(ADest: Pointer; AValue: Integer; AOffset: Integer = 0);
|
|
begin
|
|
cxCopyData(@AValue, ADest, 0, AOffset, SizeOf(Integer));
|
|
end;
|
|
|
|
procedure WritePointer(ADest: Pointer; AValue: Pointer);
|
|
begin
|
|
Pointer(ADest^) := AValue;
|
|
end;
|
|
|
|
procedure WriteWord(ADest: Pointer; AValue: Word; AOffset: Integer = 0);
|
|
begin
|
|
cxCopyData(@AValue, ADest, 0, AOffset, SizeOf(Word));
|
|
end;
|
|
|
|
function cxSign(const AValue: Double): Integer;
|
|
begin
|
|
Result := IfThen(AValue >= 0, 1, -1);
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF DELPHI6}
|
|
StartClassGroup(TControl);
|
|
GroupDescendentsWith(TcxComponent, TControl);
|
|
{$ENDIF}
|
|
|
|
finalization
|
|
DestroyResStringLists;
|
|
|
|
end.
|
|
|