tsdesign.pas

企业进销存管理系统

{*******************************************************}
{                                                       }
{       ObjectSight Visual Components                   }
{       TopGrid Component Editor                        }
{                                                       }
{       Copyright (c) 1997 - 2001 ObjectSight           }
{                                                       }
{*******************************************************}

unit TsDesign;

{$INCLUDE TSCmpVer}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MMSystem,
  ComCtrls, TSDBGrid, StdCtrls, Grids_ts, TSGrid, ExtCtrls, TypInfo, TSSetLib, ClipBrd,
  RichEdit,
  {$IFDEF TSVER_V6} Variants, IniFiles, DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF}
  {$IFDEF TSVER_V5} Contnrs, Menus, {$ENDIF} TSCommon;

type
    TtsGridInspector = class;
    TtsComponentEditor = class;
    TtsPropertySet = class;
    TtsPropertyElement = class;
    TtsPropertyPointerElement = class;
    TtsPropertyPointerSet = class;
    TtsActualValueElement = class;
    TtsActualValueSet = class;
    TtsGroupSet = class;
    TtsGroupElement = class;

    tsScanObjectsState = (soStart, soScan, soEnd);
    tsShowPropertyValueType = (pvShowAlways, pvShowNever, pvShowToggle1, pvShowToggle2);
    tsShowPropertyValueSet = set of tsShowPropertyValueType;
    tsInspectorElementType = (iePropertyElement, ieGroupElement);
    tsPropertyNilType = (pnUnKnown, pnAuto, pnTrue, pnFalse);
    tsValueSource = (vsComponent, vsValue, vsstrValue);

    TtsGetComponentEvent = procedure (Sender: TObject; var Component: TPersistent) of object;
    TtsGetComponentIdEvent = procedure (Sender: TObject; Component: TPersistent; var ComponentId: string) of object;
    TtsGetComponentWithIdEvent = procedure (Sender: TObject; ComponentId: string; var Component: TPersistent) of object;
    TtsGetComponentInfoEvent = procedure (Sender: TObject; DisplayMode: TtsGroupElement) of object;
    TtsGetComponentSelectionEvent = procedure (Sender: TObject; var ComponentSelection: Pointer; var ComponentCount: integer) of object;
    TtsGetComponentSelectionChangedEvent = procedure (Sender: TObject; CurSelection: Pointer; var Changed: Boolean) of object;
    TtsDestroyComponentSelectionEvent = procedure (Sender: TObject; ComponentSelection: Pointer) of object;
    TtsGetStringEvent = procedure (Sender: TObject; var Value: string) of object;
    TtsScanObjectsEvent = procedure (Sender: TObject; State: tsScanObjectsState; Writing: Boolean; Count: Longint; var Cancel: Boolean) of object;
    TtsSetValuesEvent = procedure (Sender: TObject; State: tsScanObjectsState; Component: Tpersistent; PropertyElement: TtsPropertyElement; strValue: string; Value: Variant; ValueSource: tsValueSource; ValueSet: Boolean; var Cancel: Boolean) of object;

    {TtsInspectorRow}
    {Contains information on each row in the TtsGridInspector}
    TtsInspectorRow = record
        Level: integer;
        Opened: Boolean;
        ButtonSet: Boolean;
        Deleted: Boolean;
        Selected: Boolean;
        SelectedChanged: integer;
        Parent: integer;
        SubFullySelected: Boolean;
        InspectorElementType: tsInspectorElementType;
        PropertyElement: TtsPropertyElement;
        GroupElement: TtsGroupElement;
    end;

    PtsInspectorRows = ^TtsInspectorRows;
    TtsInspectorRows = array[0..(MaxListSize div ((SizeOf(TtsInspectorRow) div SizeOf(Longint)) + 1))] of TtsInspectorRow;

    {TtsGridInspector}
    {Object inspector type component. Used to display and set the component
    properties and their values}

    TtsGridInspector = class(TtsGrid)
    protected
        FComponentEditor: TtsComponentEditor;
        CurrentComponentEditor: TtsComponentEditor;
        PropertyValueList: TStringList;
        FInspectorRows: PtsInspectorRows;
        FCurMaxInspectorRowCount: integer;
        FInspectorRowCount: integer;
        SelectedLastChanged: integer;
        SelectedLastUpdated: integer;

        InspectorKeyIsDown: Boolean;
        FComboOpen: Boolean;
        FDisplayModeName: string;

        procedure DoButtonClick(DataCol: Longint; DataRow: Variant); override;
        procedure DoDblClickCell(DataCol: Longint; DataRow: Variant; Pos: TtsClickPosition); override;
        procedure DoComboInit(DataCol: Longint; DataRow: Variant); override;
        procedure DoComboCellLoaded(DataCol, DataRow: Longint; var Value: Variant); override;
        procedure DoComboGetValue(GridDataCol: Longint; GridDataRow, ComboDataRow: Variant; var Value: Variant); override;
        procedure DoComboRollUp(DataCol: Longint; DataRow: Variant); override;
        procedure DoCellEdit(DataCol: Longint; DataRow: Variant; ByUser: Boolean); override;
        procedure DoEndCellEdit(DataCol: Longint; DataRow: Variant; var Cancel: Boolean); override;
        procedure DoKeyDown(var Key: Word; Shift: TShiftState); override;
        procedure DoKeyUp(var Key: Word; Shift: TShiftState); override;
        procedure DoComboDropDown(DataCol: Longint; DataRow: Variant); override;
        procedure DoStartCellEdit(DataCol: Longint; DataRow: Variant; var Cancel: Boolean); override;
        procedure DoColResized(RowColnr: Longint); override;
        procedure DoRowChanged(OldDataRow, NewDataRow: Variant); override;
        procedure DoExit; override;
        procedure DoCellLoaded(DataCol, DataRow: Longint; var Value: Variant); override;
        function  ActivateDoGetDrawInfo: Boolean; override;
        procedure DoGetDrawInfo(DataCol, DataRow: Longint; var DrawInfo: TtsDrawInfo); override;
        procedure DoMouseStatusChanged(OldStatus, NewStatus: TtsMouseStatus); override;

        procedure SetButton(DataRow: Integer);
        procedure GetMultiValue;
        procedure SetDisplayModeName(Value: string);
        procedure SetRowProperties;
        function GetInspectorRowCount: integer;
        procedure SetInspectorRowCount(NewValue: integer);
        procedure PlaceGroupSetInInspectorList(Node : TtsSetNode; Parent : integer);
        procedure PlacePropertiesInInspectorList(Node : TtsSetNode; Parent : integer; SubProperties: Boolean);
        procedure PlaceGroupElementInInspectorList(Group: TtsGroupElement; Parent: integer);
        procedure PlaceMarkedPropertiesInInspectorList(Node : TtsSetNode; Parent: integer);
        function GetInspectorRows: PtsInspectorRows;
        procedure SetInspectorRows;
        procedure GetDisplayName(InspectorRow: TtsInspectorRow; var DisplayName, IndentValue: string);
        procedure GetPropertyValues(const Value: string);
        procedure SetComponentEditor(Value: TtsComponentEditor);
        procedure UpdateContents(PropertiesChanged, SelectedComponentsChanged: Boolean);
        procedure RemoveEmptyGroups;
        function  IsEmptyGroup(GroupRow: integer): Boolean;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        procedure UpdateComponents;
        procedure UpdateSelectedRows;
        procedure OpenCurPropertyElement(var CurPropertyDataRow: integer);
        function GetPropertyDisplayValue(PropertyElement: TtsPropertyElement): string;

        procedure SetValues(PropertyElement: TtsPropertyElement; strValue: string; Value: Variant; ValueSource: tsValueSource; FirstSet: Boolean);
        function GetSubFullySelected(Row: integer): Boolean;
        function Selected(Row: integer): Boolean;

        property InspectorRows: PtsInspectorRows read GetInspectorRows write FInspectorRows;
        property InspectorRowCount: integer read GetInspectorRowCount write SetInspectorRowCount;
        property ComponentEditor: TtsComponentEditor read FComponentEditor write SetComponentEditor;
        property DisplayModeName: string read FDisplayModeName write SetDisplayModeName;
    end;

    {TtsPropertyElement}
    {Contains information for each property}

    TtsPropertyElement = class(TtsSetElement)
    protected
        FName: string;
        PropInfo: PPropInfo;
        FEditor: TPropertyEditor;
        FEditorComponent: TPersistent;
        FShowPropertyValue: tsShowPropertyValueType;
        DesignstrValue: string;
        PropertyLevel: Integer;
        FParent: TtsPropertyElement;
        ComponentEditor: TtsComponentEditor;
        FSubProperties: TtsPropertySet;
        SubPropertiesUpdated: Boolean;
        Mark: Boolean;
        MultiValue: Boolean;
        FPropertyNil: tsPropertyNilType;
        SetElementNumber: integer;
        function GetSubProperties: TtsPropertySet;
        function GetEditor: TPropertyEditor;
        function GetPropType: PTypeInfo;
        {$IFDEF TSVER_V6}
        procedure SetPropertyEditor(const Prop: IProperty);
        {$ELSE}
        procedure SetPropertyEditor(Prop: TPropertyEditor);
        {$ENDIF}
        function GetPropertyNil: tsPropertyNilType;
    public
        {$IFDEF TSVER_V6}
        constructor Create(Prop: IProperty; CurComponentEditor: TtsComponentEditor; ParentProperty: TtsPropertyElement);
        {$ELSE}
        constructor Create(Prop: TPropertyEditor; CurComponentEditor: TtsComponentEditor; ParentProperty: TtsPropertyElement);
        {$ENDIF}
        destructor  Destroy; override;

        procedure SetPropertyValue(Component: TPersistent; Value: Variant);
        function  GetPropertyValue(Component: TPersistent; FirstFromActualValueSet: Boolean): Variant;
        function  Compare(NodeSet: TtsCustomSet; Value : TtsSetElement) : TtsSetOrder; override;
        function  CompareKey(NodeSet: TtsCustomSet; const KeyValue : array of const) : TtsSetOrder; override;
        function ConvertDesignPropertystrValueToValue(const strValue: string): Variant;
        function ConvertDesignPropertyValueTostrValue(const Value: Variant): string;

        property Editor: TPropertyEditor read GetEditor write FEditor;
        property PropType: PTypeInfo read GetPropType;
        property SubProperties: TtsPropertySet read GetSubProperties write FSubProperties;
        property PropertyNil: tsPropertyNilType read GetPropertyNil write FPropertyNil;
        property Name: string read FName write FName;
        property ShowPropertyValue: tsShowPropertyValueType read FShowPropertyValue write FShowPropertyValue;
        property Parent: TtsPropertyElement read FParent write FParent;
    end;

    {TtsPropertySet}
    {Contains TtsPropertyElement information for all properties of a component
    or all subproperties of a property}

    TtsPropertySet = class(TtsObjectSet)
    protected
        procedure MarkAll(Node : TtsSetNode);
    public
        function GetItem(KeyValue : array of const) : TtsPropertyElement;
    end;

    {TtsPropertyPointerElement}
    {Containts a pointer to a TtsPropertyElement}

    TtsPropertyPointerElement = class(TtsSetElement)
    protected
        FElement: TtsPropertyElement;
    public
        function Compare(NodeSet: TtsCustomSet; Value : TtsSetElement) : TtsSetOrder; override;
        function CompareKey(NodeSet: TtsCustomSet; const KeyValue : array of const) : TtsSetOrder; override;
    end;

    {TtsPropertyPointerSet}
    {Contains a set of TtsPropertyPointerElement-s, used within a group}

    TtsPropertyPointerSet = class(TtsObjectSet)
    public
        function GetItem(KeyValue : array of const) : TtsPropertyPointerElement;
    end;

    {TtsGroupElement}
    {Used within the TtsInspectorGrid is logical elements to logically group
    properties. Also use to contain a display modes, such as 'alphbetical' or 'structured'}

    TtsGroupElement = class(TtsSetElement)
    protected
        FName: string;
        FSubGroups: TtsGroupSet;
        FPropertySet: TtsPropertyPointerSet;
        FGroupSet: TtsGroupSet;
        FOpened: Boolean;
        procedure SetName(NewName: string);
    public
        constructor Create;
        destructor  Destroy; override;

        function Release(DestroyingSet : Boolean) : TtsSetElement; override;
        function Compare(NodeSet: TtsCustomSet; Value : TtsSetElement) : TtsSetOrder; override;
        function CompareKey(NodeSet: TtsCustomSet; const KeyValue : array of const) : TtsSetOrder; override;
        function FindSubGroup(GroupName: string): TtsGroupElement;
        procedure AddGroup(Parent: string; Name: string; Opened: boolean);
        property Name: string read FName write SetName;
    end;

    {TtsGroupSet}
    {Contains the subgroups of a group elements or the displaymodes of a
    component editor}

    TtsGroupSet = class(TtsObjectSet)
    protected
        FInSetName: Boolean;
    public
        function GetItem(KeyValue : array of const) : TtsGroupElement;
        function Add(Element : TtsSetElement): Pointer; override;
    end;

    {TtsActualValueElement}
    {Used to contain the actual value of a property, when the value in the
    example component is not set directly always, such as the HeadingOn in the
    grdExample}

    TtsActualValueElement = class(TtsSetElement)
    protected
        FComponentId: string;
        FProperty: TtsPropertyElement;
        FActualstrValue: string;
    public
        property ActualValue: string read FActualstrValue;

        function Compare(NodeSet: TtsCustomSet; Value : TtsSetElement) : TtsSetOrder; override;
        function CompareKey(NodeSet: TtsCustomSet; const KeyValue : array of const) : TtsSetOrder; override;
    end;

    {TtsActualValueSet}
    {Contains all property values of properties in the component which are not
    always set in the example component}

    TtsActualValueSet = class(TtsObjectSet)
    protected
        FNumberOfToggleValues: integer;
        FNumberOfInvisibleValues: integer;
        FComponentEditor: TtsComponentEditor;
        procedure SetNumberOfToggleValues(Value: integer);
        procedure SetNumberOfInvisibleValues(Value: integer);
    public
        constructor Create; override;

        function Add(NodeValue : TtsSetElement) : Pointer; override;
        function Remove(KeyValue : array of const) : Pointer; override;
        function GetItem(KeyValue : array of const) : TtsActualValueElement;

        property NumberOfToggleValues: integer read FNumberOfToggleValues write SetNumberOfToggleValues;
        property NumberOfInvisibleValues: integer read FNumberOfInvisibleValues write SetNumberOfInvisibleValues;
    end;

    {TtsComponentEditor}
    {Contains all the information for retrieving and setting the properties of
    a component}
    TtsComponentEditor = class(TComponent)
    protected
        FComponent: TPersistent;
        FPropertySet: TtsPropertySet;
        FDisplayModes: TtsGroupSet;
        ComponentSelected: Boolean;
        MultipleComponentSelected: Boolean;
        FComponentAssigned: Boolean;
        FOnGetComponentInfo: TtsGetComponentInfoEvent;
        FOnGetFirstSelectedComponent: TtsGetComponentEvent;
        FOnGetNextSelectedComponent: TtsGetComponentEvent;
        FOnGetComponentWithId: TtsGetComponentWithIdEvent;
        FOnGetComponentId: TtsGetComponentIdEvent;
        FOnScanObjects: TtsScanObjectsEvent;
        FOnSetValues: TtsSetValuesEvent;
        FOnNumberofToggleValuesChanged: TNotifyEvent;
        FOnNumberofInvisibleValuesChanged: TNotifyEvent;
        FOnGetComponentSelection: TtsGetComponentSelectionEvent;
        FOnDestroyComponentSelection: TtsDestroyComponentSelectionEvent;
        FOnGetComponentSelectionChanged: TtsGetComponentSelectionChangedEvent;
        FCurPropertyElement: TtsPropertyElement;
        FComponentSelection: pointer;
        FComponentCount: integer;
        FActualValueSet: TtsActualValueSet;
        FShowDesignValue: tsShowPropertyValueSet;
        FDesignValuePropertiesInitialized: Boolean;
        procedure SetShowDesignValue(Value: tsShowPropertyValueSet);
        {$IFDEF TSVER_V6}
        procedure SetPropertyEditor(const Prop: IProperty);
        {$ELSE}
        procedure SetPropertyEditor(Prop: TPropertyEditor);
        {$ENDIF}
        function AssignComponent: TPersistent;
        function GetPropertySet: TtsPropertySet;
        function GetDisplayModes: TtsGroupSet;
        procedure DoGetComponentInfo(DisplayMode: TtsGroupElement); virtual;
        procedure DoGetComponentWithId(ComponentId: string; var Component: TPersistent); virtual;
        procedure DoGetComponentSelection(var ComponentSelection: Pointer; var ComponentCount: integer); virtual;
        procedure DoGetComponentSelectionChanged(CurSelection: Pointer; var Changed: Boolean); virtual;
        procedure DoDestroyComponentSelection(var ComponentSelection: Pointer; var ComponentCount: Integer);
        procedure DoScanObjects(State: tsScanObjectsState; Writing: Boolean; Count: Longint; var Cancel: Boolean); virtual;
        procedure DoSetValues(State: tsScanObjectsState; Component: Tpersistent; PropertyElement: TtsPropertyElement; strValue: string; Value: Variant; ValueSource: tsValueSource; ValueSet: Boolean; var Cancel: Boolean);
        procedure DoNumberofToggleValuesChanged; virtual;
        procedure DoNumberofInvisibleValuesChanged; virtual;
        function GetActualValueSet: TtsActualValueSet;
        procedure SetPropertyList;
        function AddDisplayMode(DisplayModeName: string): TtsGroupElement;
        property DisplayModes: TtsGroupSet read GetDisplayModes write FDisplayModes;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        procedure DoGetFirstSelectedComponent(var Component: TPersistent); virtual;
        procedure DoGetNextSelectedComponent(var Component: TPersistent); virtual;
        procedure DoGetComponentId(Component: TPersistent; var ComponentId: string); virtual;

        procedure AddProperty(DisplayMode: TtsGroupElement; GroupName: string; Name: string);
        procedure SetDesignProperty(PropertyName: string; ShowPropertyValue: tsShowPropertyValueType; DesignstrValue: string);
        procedure GetComponents;
        procedure SetActualValue(ComponentId: string; PropertyElement: TtsPropertyElement; strValue: string);