cxoi.pas

delphi的的三方控件

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressVerticalGrid                                          }
{                                                                    }
{       Copyright (c) 1998-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 EXPRESSVERTICALGRID 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 cxOI;

{$I cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, TypInfo,
{$IFDEF DELPHI6}
  RTLConsts,
{$ENDIF}
  cxVGrid, cxEdit, cxInplaceContainer, cxGraphics;

const
  CN_PropertyChanged = WM_APP + 170;

type
  TcxPropertyEditor = class;
  TcxRTTIInspectorController = class;
  TcxCustomRTTIInspector = class;

  { TcxComponentList }

  TcxComponentList = class(TObject)
  private
    FList: TList;
    function GetItem(Index: Integer): TPersistent;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    function Add(Item: TPersistent): Integer;
    function Equals(List: TcxComponentList): Boolean;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TPersistent read GetItem; default;
  end;

  TcxPropertyAttribute =
    (ipaValueList, ipaSubProperties, ipaDialog, ipaMultiSelect, ipaAutoUpdate,
     ipaSortList, ipaReadOnly, ipaRevertable);
  TcxPropertyAttributes = set of TcxPropertyAttribute;

  TcxInstProp = record
    Instance: TPersistent;
    PropInfo: PPropInfo;
  end;

  PcxInstPropList = ^TcxInstPropList;
  TcxInstPropList = array[0..1023] of TcxInstProp;

  TcxGetPropEditProc = procedure(APropertyEditor: TcxPropertyEditor) of object;

  { TcxPropertyEditor }

  TcxPropertyEditor = class
  private
    FInspector: TcxCustomRTTIInspector;
    FAncestorList: TList;
    FPropCount: Integer;
    FPropList: PcxInstPropList;
    FOwner: TComponent;
    FRoot: TComponent;
    FAncestor: TPersistent;
    FRootAncestor: TComponent;
    FLookingFor: TComponent;
    FDoneLooking: Boolean;
    procedure AddAncestor(Component: TComponent);
    procedure GetLookupInfo(var Ancestor: TPersistent;
      var Root, LookupRoot, RootAncestor: TComponent);
    procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
      APropInfo: PPropInfo);
    procedure WriteComponentSimulation(Component: TComponent);
  protected
    procedure AdjustInnerEditProperties(AProperties: TcxCustomEditProperties); virtual;
    function GetFloatValue: Extended;
    function GetFloatValueAt(Index: Integer): Extended;
    function GetInt64Value: Int64;
    function GetInt64ValueAt(Index: Integer): Int64;
    function GetOrdValue: Longint;
    function GetOrdValueAt(Index: Integer): Longint;
    function GetPropInfo: PPropInfo;
    function GetStrValue: string;
    function GetStrValueAt(Index: Integer): string;
    function GetVarValue: Variant;
    function GetVarValueAt(Index: Integer): Variant;
    function FindRoot: TComponent;
    procedure PostChangedNotification;
    procedure SetFloatValue(Value: Extended);
    procedure SetInt64Value(Value: Int64);
    procedure SetOrdValue(Value: Longint);
    procedure SetStrValue(const Value: string);
    procedure SetVarValue(const Value: Variant);

    property Inspector: TcxCustomRTTIInspector read FInspector;
  public
    constructor Create(AOwner: TComponent; AInspector: TcxCustomRTTIInspector;
      APropCount: Integer);
    destructor Destroy; override;

    function AllEqual: Boolean; virtual;
    procedure Edit; virtual;
    function GetAttributes: TcxPropertyAttributes; virtual;
    function GetComponent(Index: Integer): TPersistent;
    function GetEditLimit: Integer; virtual;
    function GetName: string; virtual;
    procedure GetProperties(AOwner: TComponent; Proc: TcxGetPropEditProc); virtual;
    function GetPropType: PTypeInfo;
    function GetValue: string; virtual;
    procedure GetValues(Proc: TGetStrProc); virtual;
    procedure SetValue(const Value: string); virtual;
    function IsDefaultValue: Boolean; virtual;
    function ValueAvailable: Boolean;

    property PropCount: Integer read FPropCount;
    property Value: string read GetValue write SetValue;
  end;

  TcxPropertyEditorClass = class of TcxPropertyEditor;

  { TcxOrdinalProperty }

  TcxOrdinalProperty = class(TcxPropertyEditor)
    function AllEqual: Boolean; override;
    function GetEditLimit: Integer; override;
  end;

  { TcxIntegerProperty }

  TcxIntegerProperty = class(TcxOrdinalProperty)
  public
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxCharProperty }

  TcxCharProperty = class(TcxOrdinalProperty)
  public
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxEnumProperty }

  TcxEnumProperty = class(TcxOrdinalProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxBoolProperty }

  TcxBoolProperty = class(TcxEnumProperty)
  public
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxFloatProperty }

  TcxFloatProperty = class(TcxPropertyEditor)
  public
    function AllEqual: Boolean; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TInt64Property }

  TcxInt64Property = class(TcxPropertyEditor)
  public
    function AllEqual: Boolean; override;
    function GetEditLimit: Integer; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxStringProperty}

  TcxStringProperty = class(TcxPropertyEditor)
  public
    function AllEqual: Boolean; override;
    function GetEditLimit: Integer; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxSetElementProperty }

  TcxSetElementProperty = class(TcxPropertyEditor)
  private
    FElement: Integer;
    constructor Create(APropList: PcxInstPropList; APropCount: Integer; AElement: Integer);
  public
    destructor Destroy; override;
    function AllEqual: Boolean; override;
    function GetAttributes: TcxPropertyAttributes; override;
    function GetName: string; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
    function IsDefaultValue: Boolean; override;
  end;

  { TcxSetProperty }

  TcxSetProperty = class(TcxOrdinalProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    procedure GetProperties(AOwner: TComponent; Proc: TcxGetPropEditProc); override;
    function GetValue: string; override;
  end;

  { TcxClassProperty }

  TcxClassProperty = class(TcxPropertyEditor)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    procedure GetProperties(AOwner: TComponent; Proc: TcxGetPropEditProc); override;
    function GetValue: string; override;
  end;

  { TcxComponentProperty }

  TcxComponentProperty = class(TcxPropertyEditor)
  private
    function GetFullName(AComponent: TComponent): string;
  protected
    function IsValidComponent(AComponent: TComponent): Boolean; virtual;
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetEditLimit: Integer; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxComponentNameProperty }

  TcxComponentNameProperty = class(TcxStringProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetEditLimit: Integer; override;
  end;

  { TcxFontNameProperty }

  TcxFontNameProperty = class(TcxStringProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  { TcxFontCharsetProperty }

  TcxFontCharsetProperty = class(TcxIntegerProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxImeNameProperty }

  TcxImeNameProperty = class(TcxStringProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  { TColorProperty }

  TcxColorProperty = class(TcxIntegerProperty)
  public
    procedure Edit; override;
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  { TcxCursorProperty }

  TcxCursorProperty = class(TcxIntegerProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxFontProperty }

  TcxFontProperty = class(TcxClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TcxPropertyAttributes; override;
  end;

  { TcxStringsProperty }

  TcxStringsProperty = class(TcxClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TcxPropertyAttributes; override;
  end;

  { TcxGraphicProperty }

  TcxGraphicProperty = class(TcxClassProperty)
  private
    function HasGraphic: Boolean;
  protected
    function GetGraphic: TGraphic; virtual;
    procedure SetGraphic(Value: TGraphic); virtual;

    function GetClipboardFormat: Word; virtual;
    function GetGraphicFilter: string; virtual;
    function GraphicClass: TGraphicClass;
  public
    procedure Edit; override;
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxPictureProperty }

  TcxPictureProperty = class(TcxGraphicProperty)
  protected
    function GetGraphic: TGraphic; override;
    procedure SetGraphic(Value: TGraphic); override;
  end;


  { TcxModalResultProperty }

  TcxModalResultProperty = class(TcxIntegerProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxShortCutProperty }

  TcxShortCutProperty = class(TcxOrdinalProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxMPFilenameProperty }

  TcxMPFilenameProperty = class(TcxStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TcxPropertyAttributes; override;
  end;

  { TcxTabOrderProperty }

  TcxTabOrderProperty = class(TcxIntegerProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
  end;

  { TCaptionProperty }

  TcxCaptionProperty = class(TcxStringProperty)
  public
    function GetAttributes: TcxPropertyAttributes; override;
  end;

  { TcxDateProperty }

  TcxDateProperty = class(TcxPropertyEditor)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxTimeProperty }

  TcxTimeProperty = class(TcxPropertyEditor)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxDateTimeProperty }

  TcxDateTimeProperty = class(TcxPropertyEditor)
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  { TcxVariantProperty }

  TcxVariantProperty = class(TcxPropertyEditor)
    function GetAttributes: TcxPropertyAttributes; override;
    procedure GetProperties(AOwner: TComponent; Proc: TcxGetPropEditProc); override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  // the support DevExpress editor's properties

  { TcxEditPropertiesProperty }

  TcxEditPropertiesProperty = class(TcxClassProperty)