cxclasses.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,401 行 · 第 1/5 页

{********************************************************************}
{                                                                    }
{           Developer Express Visual Component Library               }
{           Express Cross Platform Library classes                   }
{                                                                    }
{           Copyright (c) 2000-2008 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, SysUtils, Classes, Forms;

const
  dxBuildNumber = 38;
  WM_DX = WM_APP + 100;

  dxEndOfLine = #13#10;
  cxE_NOINTERFACE = HResult($80004002);

type
  PBytes = ^TBytes;
  TBytes = array of Byte;

  TcxAlignmentVert = (vaTop, vaBottom, vaCenter);
  TcxTopBottom = vaTop..vaBottom;
  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;

  { TcxIUnknownObject }

  TcxIUnknownObject = class(TObject, IUnknown)
  protected
    // IUnknown
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  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;

  { TcxEventHandlerCollection }

  TcxEventHandler = procedure (Sender: TObject; const AEventArgs) of object;

  TcxEventHandlerCollection = class(TObject)
  private
    FEvents: array of TcxEventHandler;
    procedure Delete(AIndex: Integer);
    function IndexOf(AEvent: TcxEventHandler): Integer;
  public
    procedure Add(AEvent: TcxEventHandler);
    procedure CallEvents(Sender: TObject; const AEventArgs);
    procedure Remove(AEvent: TcxEventHandler);
  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;