tsdesign.pas

企业进销存管理系统

        property PropertySet: TtsPropertySet read GetPropertySet write FPropertySet;
        property ShowDesignValue: tsShowPropertyValueSet read FShowDesignValue write SetShowDesignValue;
        property DesignValuePropertiesInitialized: Boolean read FDesignValuePropertiesInitialized write FDesignValuePropertiesInitialized;
        property CurPropertyElement: TtsPropertyElement read FCurPropertyElement write FCurPropertyElement;
        property Component: TPersistent read AssignComponent write FComponent;
        property ComponentCount: integer read FComponentCount;
        property ActualValueSet: TtsActualValueSet read GetActualValueSet write FActualValueSet;
        property ComponentAssigned: Boolean read FComponentAssigned write FComponentAssigned;
    published
        property OnGetComponentInfo: TtsGetComponentInfoEvent read FOnGetComponentInfo write FOnGetComponentInfo;
        property OnGetFirstSelectedComponent: TtsGetComponentEvent read FOnGetFirstSelectedComponent write FOnGetFirstSelectedComponent;
        property OnGetNextSelectedComponent: TtsGetComponentEvent read FOnGetNextSelectedComponent write FOnGetNextSelectedComponent;
        property OnGetComponentWithId: TtsGetComponentWithIdEvent read FOnGetComponentWithId write FOnGetComponentWithId;
        property OnGetComponentId: TtsGetComponentIdEvent read FOnGetComponentId write FOnGetComponentId;
        property OnScanObjects: TtsScanObjectsEvent read FOnScanObjects write FOnScanObjects;
        property OnSetValues: TtsSetValuesEvent read FOnSetValues write FOnSetValues;
        property OnNumberofToggleValuesChanged: TNotifyEvent read FOnNumberofToggleValuesChanged write FOnNumberofToggleValuesChanged;
        property OnNumberofInvisibleValuesChanged: TNotifyEvent read FOnNumberofInvisibleValuesChanged write FOnNumberofInvisibleValuesChanged;
        property OnGetComponentSelection: TtsGetComponentSelectionEvent read FOnGetComponentSelection write FOnGetComponentSelection;
        property OnGetComponentSelectionChanged: TtsGetComponentSelectionChangedEvent read FOnGetComponentSelectionChanged write FOnGetComponentSelectionChanged;
        property OnDestroyComponentSelection: TtsDestroyComponentSelectionEvent read FOnDestroyComponentSelection write FOnDestroyComponentSelection;
    end;

    TtsComponentEditorClass = class of TtsComponentEditor;

    {TDummyDesigner}
    {Used only when the component editor is not in designtime to retrieve property
    information. Delphi functions require a designer component to retrieve
    property information. In design time a designer is supplied by Delphi itself}

{$IFNDEF TSVER_V4}
    TDummyDesigner = class(IDesigner)
    public
        function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; override;
        function GetMethodName(const Method: TMethod): string; override;
        procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); override;
        function GetPrivateDirectory: string; override;
        procedure GetSelections(List: TComponentList); override;
        function MethodExists(const Name: string): Boolean; override;
        procedure RenameMethod(const CurName, NewName: string); override;
        {$IFDEF TSVER_V3}
        procedure SelectComponent(Instance: TPersistent); override;
        {$ELSE}
        procedure SelectComponent(Instance: TComponent); override;
        {$ENDIF}
        procedure SetSelections(List: TComponentList); override;
        procedure ShowMethod(const Name: string); override;
        function UniqueName(const BaseName: string): string; override;
        procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); override;
        function GetComponent(const Name: string): TComponent; override;
        function GetComponentName(Component: TComponent): string; override;
        {$IFDEF TSVER_V3}
        function GetObject(const Name: string): TPersistent; override;
        function GetObjectName(Instance: TPersistent): string; override;
        procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); override;
        {$ENDIF}
        function MethodFromAncestor(const Method: TMethod): Boolean; override;
        function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
          Left, Top, Width, Height: Integer): TComponent; override;
        function IsComponentLinkable(Component: TComponent): Boolean; override;
        procedure MakeComponentLinkable(Component: TComponent); override;
        function GetRoot: TComponent; override;
        procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); override;
        {$IFDEF TSVER_V3}
        function GetIsDormant: Boolean; override;
        function HasInterface: Boolean; override;
        function HasInterfaceMember(const Name: string): Boolean; override;
        {$IFNDEF TSVER_CBUILD}
        procedure AddInterfaceMember(const MemberText: string); override;
        {$ELSE} {$IFDEF TSVER_V3}
        procedure AddToInterface(InvKind: Integer; const Name: string; VT: Word;
          const TypeInfo: string); override;
        procedure GetProjectModules(Proc: TGetModuleProc); override;
        {$ENDIF} {$ENDIF}
        {$ENDIF}

        function IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean;
          override;
        procedure Modified; override;
        procedure Notification(AComponent: TComponent;
          Operation: TOperation); override;
        procedure PaintGrid; override;
        procedure ValidateRename(AComponent: TComponent;
          const CurName, NewName: string); override;
    end;
{$ELSE} {TFormDesigner no longer present in Delphi 4. Use IFormDesigner instead}
{$IFDEF TSVER_V6}
    TDummyDesigner = class(TInterfacedObject, IDesigner)
{$ELSE}
    TDummyDesigner = class(TInterfacedObject, IFormDesigner)
{$ENDIF}
    protected
        FCustomForm: TCustomForm;
        FIsControl: Boolean;

    public
        constructor Create;
{$IFDEF TSVER_V6}
        procedure Activate;
        function GetBaseRegKey: string;
        function GetIDEOptions: TCustomIniFile;
        function GetPathAndBaseExeName: string;
        function CreateCurrentComponent(Parent: TComponent; const Rect: TRect): TComponent;
        function IsComponentHidden(Component: TComponent): Boolean;
{$ENDIF}
        function CreateMethod(const Name: string; TypeData: PTypeData): TMethod;
        function GetMethodName(const Method: TMethod): string;
        procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
        function GetPrivateDirectory: string;

        procedure GetSelections(const List: IDesignerSelections);
        function MethodExists(const Name: string): Boolean;
        procedure RenameMethod(const CurName, NewName: string);
        procedure SelectComponent(Instance: TPersistent);
        procedure SetSelections(const List: IDesignerSelections);
        procedure ShowMethod(const Name: string);
        function UniqueName(const BaseName: string): string;
        procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc);
        function GetComponent(const Name: string): TComponent;
        function GetComponentName(Component: TComponent): string;
        function GetObject(const Name: string): TPersistent;
        function GetObjectName(Instance: TPersistent): string;
        procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc);
        function MethodFromAncestor(const Method: TMethod): Boolean;
        function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
          Left, Top, Width, Height: Integer): TComponent;
        function IsComponentLinkable(Component: TComponent): Boolean;
        procedure MakeComponentLinkable(Component: TComponent);
        function GetRoot: TComponent;
        procedure Revert(Instance: TPersistent; PropInfo: PPropInfo);
        function GetIsDormant: Boolean;
        function HasInterface: Boolean;
        function HasInterfaceMember(const Name: string): Boolean;
        procedure AddInterfaceMember(const MemberText: string);
        procedure AddToInterface(InvKind: Integer; const Name: string; VT: Word; const TypeInfo: string);
        procedure GetProjectModules(Proc: TGetModuleProc);
{$IFDEF TSVER_V6}
        function GetAncestorDesigner: IDesigner;
{$ELSE}
        function GetAncestorDesigner: IFormDesigner;
{$ENDIF}
        function IsSourceReadOnly: Boolean;
        function GetCustomForm: TCustomForm;
        procedure SetCustomForm(Value: TCustomForm);
        function GetIsControl: Boolean;
        procedure SetIsControl(Value: Boolean);
        function IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean;

        {$IFDEF TSVER_V5}
        function GetContainerWindow: TWinControl;
        procedure SetContainerWindow(const NewContainer: TWinControl);
        function GetScrollRanges(const ScrollPosition: TPoint): TPoint;

{$IFDEF TSVER_V6}
        procedure Edit(const Component: TComponent);
        function GetShiftState: TShiftState;
        procedure ModalEdit(EditKey: Char; const ReturnWindow: IActivatable);
        procedure SelectItemName(const PropertyName: string);
        procedure Resurrect;
        procedure DeleteSelection(ADoAll: Boolean = False);
{$ELSE}
        procedure DeleteSelection; 
        procedure Edit(const Component: IComponent);
        function BuildLocalMenu(Base: TPopupMenu; Filter: TLocalMenuFilters): TPopupMenu;
{$ENDIF}

        procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string;
          TypeData: PTypeData);
        procedure CopySelection;
        procedure CutSelection;
        function CanPaste: Boolean;
        procedure PasteSelection;

        procedure ClearSelection;
        procedure ModuleFileNames(var ImplFileName, IntfFileName, FormFileName: string);
        procedure NoSelection;
        function GetRootClassName: string;
        {$ENDIF}

        procedure Modified;
        procedure Notification(AnObject: TPersistent; Operation: TOperation);
        procedure PaintGrid;
        procedure ValidateRename(AComponent: TComponent;
          const CurName, NewName: string);

        property Form: TCustomForm read FCustomForm;
    end;
{$ENDIF}

var
{$IFDEF TSVER_V6}
    Designer: IDesigner = nil;
{$ELSE}
    Designer: IFormDesigner = nil;
{$IFNDEF TSVER_V4}
    Designer: TFormDesigner = nil;
{$ENDIF}
{$ENDIF}
    ChangesMade: Boolean = False;

implementation

type
    TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;

    TtsBaseGrid_ = class(TtsBaseGrid) end;
    TtsCustomGrid_ = class(TtsCustomGrid) end;
    TtsCustomDBGrid_ = class(TtsCustomDBGrid) end;

const
    StsGroupNameNotFound = 'GroupName ''%s'' not found.';
    StsPropertyNotFound  = 'Property ''%s'' not found.';
    StsDeletePropertyNotAllowed = 'Properties may not be deleted.';
    StsOkToDeleteSeletedGroups = 'You are about to delete %d group(s). Are you sure?';

var
    ComboValueSelected: Boolean;

{TtsPropertyElement}

function TtsPropertyElement.GetSubProperties: TtsPropertySet;
begin
    if Editor = nil then
        result := nil
    else if not (paSubProperties in Editor.GetAttributes) then
        result := nil
    else
    begin
        if (PropertyNil <> pnTrue) and (FSubProperties = nil) then
        begin
            FSubProperties := TtsPropertySet.Create;
            Editor.GetProperties(SetPropertyEditor);
        end;

        result := FSubProperties;
    end;
end;

function TtsPropertyElement.GetEditor: TPropertyEditor;
var
    {$IFDEF TSVER_V5}
      {$IFDEF TSVER_V6}
      Components: TDesignerSelections;
      {$ELSE}
      Components: TDesignerSelectionList;
      {$ENDIF}
    {$ELSE}
      Components: TComponentList;
    {$ENDIF}
    CreateEditor: Boolean;
    ClassParent: TtsPropertyElement;
begin
    ShowMessage('TtsPropertyElement.GetEditor');
    if FEditor = nil then
        CreateEditor := True
    else if (Parent <> nil) then
    begin
        ClassParent := Parent;
        ShowMessage('ClassParent.PropType.Kind');
        while ClassParent.PropType.Kind <> tkClass do
        begin
            ClassParent := ClassParent.Parent;
            if ClassParent = nil then break;
        end;

        ShowMessage('if ClassParent = nil then');
        if ClassParent = nil then
        begin
            if FEditorComponent <> ComponentEditor.Component then
                CreateEditor := True
            else
                CreateEditor := False;
        end
        else if FEditorComponent <> Pointer(integer(ClassParent.GetPropertyValue(ComponentEditor.Component, True))) then
            CreateEditor := True
        else
            CreateEditor := False;
    end
    else if FEditorComponent <> ComponentEditor.Component then
        CreateEditor := True
    else
        CreateEditor := False;

    if CreateEditor then
    begin
        if Parent = nil then
        begin
            {$IFDEF TSVER_V5}
              {$IFDEF TSVER_V6}
              Components := TDesignerSelections.Create;
              {$ELSE}
              Components := TDesignerSelectionList.Create;
              {$ENDIF}
            {$ELSE}
            Components := TComponentList.Create;
            {$ENDIF}

            try
                ShowMessage('ComponentEditor.Component');
                if ComponentEditor.Component <> nil then
                begin
                    {$IFDEF TSVER_V6}
                    (Components as IDesignerSelections).Add(ComponentEditor.Component);
                    {$ELSE}
                    Components.Add(TComponent(ComponentEditor.Component));
                    {$ENDIF}
                    ShowMessage('GetComponentProperties');
                    GetComponentProperties(Components, tkProperties, Designer, ComponentEditor.SetPropertyEditor);
                end;
            finally
                Components.Free;
            end;
        end
        else if Parent.Editor <> nil then
        begin
            ShowMessage('Parent.Editor <> nil');
            Parent.Editor.GetProperties(Parent.SetPropertyEditor);
        end;
    end;

    result := FEditor;
end;

function TtsPropertyElement.GetPropType: PTypeInfo;
begin
    if PropInfo = nil then
        result := nil
    else if PropInfo.PropType = nil then
        result := nil
    else
        {$IFDEF TSVER_V3}
        result := PropInfo.PropType^;
        {$ELSE}
        result := PropInfo.PropType;
        {$ENDIF}
end;

procedure TtsPropertyElement.SetPropertyValue(Component: TPersistent; Value: Variant);
var
    S: TIntegerSet;
    ParentValue: Variant;

begin
    if PropInfo = nil then
    begin
        if Parent = nil then
            exit;

        if Parent.PropType = nil then
            exit;

        if Parent.PropType^.Kind = tkSet then
        begin
            ParentValue := Parent.GetPropertyValue(Component, True);
            if VarIsEmpty(ParentValue) then
            begin
                ParentValue := ParentValue;
                exit;
            end;

            Integer(S) := ParentValue;
            if Boolean(Value) then
                Include(S, SetElementNumber)
            else
                Exclude(S, SetElementNumber);

            Parent.SetPropertyValue(Component, Integer(S));
        end;
    end