tsdesign.pas

企业进销存管理系统

function TtsActualValueElement.Compare(NodeSet: TtsCustomSet; Value : TtsSetElement) : TtsSetOrder;
begin
    Result := CompareKey(NodeSet, [TtsActualValueElement(Value).FComponentId, TtsActualValueElement(Value).FProperty.Name]);
end;

function TtsActualValueElement.CompareKey(NodeSet: TtsCustomSet; const KeyValue : array of const) : TtsSetOrder;
var
    CompareValue: integer;

begin
    CompareValue := CompareText(String(KeyValue[0].VAnsiString), FComponentId);
    if  CompareValue > 0 then
        Result := ordLarger
    else if CompareValue < 0 then
        Result := ordSmaller
    else
        Result := FProperty.CompareKey(NodeSet, KeyValue[1]);
end;

{End TtsActualValueElement}

{TtsActualValueSet}

procedure TtsActualValueSet.SetNumberOfToggleValues(Value: integer);
begin
    FNumberOfToggleValues := Value;

    FComponentEditor.DoNumberofToggleValuesChanged;
end;

procedure TtsActualValueSet.SetNumberOfInvisibleValues(Value: integer);
begin
    FNumberOfInvisibleValues := Value;

    FComponentEditor.DoNumberofInvisibleValuesChanged;
end;

constructor TtsActualValueSet.Create;
begin
    inherited;

    FNumberOfToggleValues := 0;
    FNumberOfInvisibleValues := 0;
    FComponentEditor := nil;
end;

function TtsActualValueSet.Add(NodeValue : TtsSetElement) : Pointer;
begin
    result := inherited Add(NodeValue);

    if TtsActualValueElement(NodeValue).FProperty.ShowPropertyValue = pvShowToggle1 then
        NumberOfToggleValues := NumberOfToggleValues + 1
    else if TtsActualValueElement(NodeValue).FProperty.ShowPropertyValue = pvShowToggle2 then
        NumberOfInvisibleValues := NumberOfInvisibleValues + 1;
end;

function TtsActualValueSet.Remove(KeyValue : array of const) : Pointer;
var
    ActualValueElement: TtsActualValueElement;
begin
    ActualValueElement := GetItem(KeyValue);
    if ActualValueElement <> nil then
    begin
        if ActualValueElement.FProperty.ShowPropertyValue = pvShowToggle1 then
            NumberOfToggleValues := NumberOfToggleValues - 1
        else if ActualValueElement.FProperty.ShowPropertyValue = pvShowToggle2 then
            NumberOfInvisibleValues := NumberOfInvisibleValues - 1;

        result := inherited Remove(KeyValue);
    end
    else
        result := nil;
end;

function TtsActualValueSet.GetItem(KeyValue : array of const) : TtsActualValueElement;
begin
    result := TtsActualValueElement(Get(KeyValue));
end;

{End TtsActualValueSet}

{TtsGroupElement}

constructor TtsGroupElement.Create;
begin
    inherited;

    FSubGroups := TtsGroupSet.Create;
    FPropertySet := TtsPropertyPointerSet.Create;
    FGroupSet := nil;
end;

destructor TtsGroupElement.Destroy;
begin
    FSubGroups.Free;
    FSubGroups := nil;
    FPropertySet.Free;
    FPropertySet := nil;

    inherited Destroy;
end;

function TtsGroupElement.FindSubGroup(GroupName: string): TtsGroupElement;
var
    CurGroup: TtsGroupElement;
    GroupNameItem: string;
    GroupNameRemainder: string;
    Msg: string;

begin
    CurGroup := Self;

    GroupNameRemainder := GroupName;
    while (GroupNameRemainder <> '') and (CurGroup <> nil) do
    begin
        SeparateFirstPart(GroupNameRemainder, GroupNameItem, '.');
        CurGroup := CurGroup.FSubGroups.GetItem([GroupNameItem]);
    end;

    if CurGroup = nil  then
    begin
        Msg := Format(StsGroupNameNotFound, [GroupName]);
        ShowMessage(Msg);
    end;

    Result := CurGroup;
end;

procedure TtsGroupElement.AddGroup(Parent, Name: string; Opened: Boolean);
var
    CurGroup: TtsGroupElement;
    Element: TtsGroupElement;

begin
    CurGroup := FindSubGroup(Parent);
    if CurGroup <> nil then
    begin
        Element := TtsGroupElement.Create;
        Element.Name := Name;
        Element.FOpened := Opened;
        CurGroup.FSubGroups.Add(Element);
    end;
end;

function TtsGroupElement.Release(DestroyingSet : Boolean) : TtsSetElement;
begin
    if not FGroupSet.FInSetName then
        result := inherited Release(DestroyingSet)
    else
        result := self;
end;

procedure TtsGroupElement.SetName(NewName: string);
begin
    if FGroupSet <> nil then
    begin
        FGroupSet.FInSetName := True;

        try
            FGroupSet.Remove([FName]);
            FName := NewName;
            FGroupSet.Add(Self);
        finally
            FGroupSet.FInSetName := False;
        end;
    end
    else
        FName := NewName;
end;

function TtsGroupElement.Compare(NodeSet: TtsCustomSet; Value : TtsSetElement) : TtsSetOrder;
begin
    Result := CompareKey(NodeSet, [TtsGroupElement(Value).FName]);
end;

function TtsGroupElement.CompareKey(NodeSet: TtsCustomSet; const KeyValue : array of const) : TtsSetOrder;
var
    CompareValue: integer;
begin
    CompareValue := CompareText(String(KeyValue[0].VAnsiString), FName);
    if  CompareValue > 0 then
        Result := ordLarger
    else if CompareValue < 0 then
        Result := ordSmaller
    else
        Result := ordEqual;
end;

{End TtsGroupElement}

{TtsGroupSet}

function TtsGroupSet.Add(Element : TtsSetElement): Pointer;
begin
    result := inherited Add(Element);

    TtsGroupElement(Element).FGroupSet := Self;
end;

function TtsGroupSet.GetItem(KeyValue : array of const) : TtsGroupElement;
begin
    result := TtsGroupElement(Get(KeyValue));
end;

{End TtsGroupSet}

{TtsComponentEditor}

constructor TtsComponentEditor.Create(AOwner: TComponent);
begin
    ShowMessage('TtsComponentEditor.Create Start');
    inherited Create(AOwner);

    FComponent := nil;
    FPropertySet := nil;
    FDisplayModes := nil;
    ComponentSelected := False;
    MultipleComponentSelected := False;
    FComponentAssigned := False;
    FCurPropertyElement := nil;
    FComponentSelection := nil;
    FComponentCount := 0;
    FActualValueSet := nil;
    FShowDesignValue := [pvShowAlways];
    FDesignValuePropertiesInitialized := False;
    ShowMessage('TtsComponentEditor.Create End');
end;

destructor TtsComponentEditor.Destroy;
begin
    FPropertySet.Free;
    FPropertySet := nil;
    FDisplayModes.Free;
    FDisplayModes := nil;
    FActualValueSet.Free;
    FActualValueSet := nil;
    DoDestroyComponentSelection(FComponentSelection, FComponentCount);

    inherited Destroy;
end;

{$IFDEF TSVER_V6}
procedure TtsComponentEditor.SetPropertyEditor(const Prop: IProperty);
{$ELSE}
procedure TtsComponentEditor.SetPropertyEditor(Prop: TPropertyEditor);
{$ENDIF}
var
    Element: TtsPropertyElement;

begin
    Element := PropertySet.GetItem([Prop.GetName]);

    if Element = nil then
    begin
        Element := TtsPropertyElement.Create(Prop, Self, nil);
        PropertySet.Add(Element);
    end
    else
    begin
        Element.FEditor.Free;
        Element.Editor := TPropertyEditor(Prop);
        Element.FEditorComponent := TPropertyEditor(Prop).GetComponent(0);
    end;

end;

procedure TtsComponentEditor.SetPropertyList;
var
    {$IFDEF TSVER_V5}
    {$IFDEF TSVER_V6}
    Components: TDesignerSelections;
    {$ELSE}
    Components: TDesignerSelectionList;
    {$ENDIF}
    {$ELSE}
    Components: TComponentList;
    {$ENDIF}
begin
    {$IFDEF TSVER_V5}
    {$IFDEF TSVER_V6}
    Components := TDesignerSelections.Create;
    {$ELSE}
    Components := TDesignerSelectionList.Create;
    {$ENDIF}
    {$ELSE}
    Components := TComponentList.Create;
    {$ENDIF}

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

function TtsComponentEditor.AssignComponent: TPersistent;
begin
    if (not ComponentAssigned) then
    begin
        GetComponents;
        ComponentAssigned := True;
    end;

    result := FComponent;
end;

procedure TtsComponentEditor.GetComponents;
var
    FirstComponent: TPersistent;
    NextComponent: TPersistent;

begin
    DoGetFirstSelectedComponent(FirstComponent);

    FComponent := FirstComponent;

    ComponentSelected := (FComponent <> nil);

    if ComponentSelected then
    begin
        NextComponent := FirstComponent;
        DoGetNextSelectedComponent(NextComponent);
        MultipleComponentSelected := (NextComponent <> nil);
    end
    else
        MultipleComponentSelected := False;
end;

procedure TtsComponentEditor.SetShowDesignValue(Value: tsShowPropertyValueSet);
var
    ActualValueList: TtsSetList;
    i: integer;
    CurComponent: TPersistent;
    PropertyElement: TtsPropertyElement;
    PropertyValue: Variant;
    PropertystrValue: string;

begin
    FShowDesignValue := Value;

    ActualValueList := ActualValueSet.List;
    try
        for i := 1 to ActualValueList.Count do
        begin
            DoGetComponentWithId(TtsActualValueElement(ActualValueList.Items[i]).FComponentId, CurComponent);
            if CurComponent = nil then
                ActualValueSet.Remove([TtsActualValueElement(ActualValueList.Items[i]).FComponentId, TtsActualValueElement(ActualValueList.Items[i]).FProperty.Name])
            else
            begin
                PropertyElement := PropertySet.GetItem([TtsActualValueElement(ActualValueList.Items[i]).FProperty.Name]);

                if (not ((PropertyElement.Parent = nil) and (PropertyElement.Name = 'Name'))) and (PropertyElement.Name <> 'Width') and (PropertyElement.Name <> 'Height') then
                begin
                    if PropertyElement.ShowPropertyValue in FShowDesignValue then
                        PropertystrValue := TtsActualValueElement(ActualValueList.Items[i]).FActualstrValue
                    else
                        PropertystrValue := PropertyElement.DesignstrValue;

                    PropertyValue := PropertyElement.ConvertDesignPropertystrValueToValue(PropertystrValue);