icomponenteditorthemepanel.pas

iocopm3.04源码,一套很好的工控开发工具

//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SetScheme3EnableModify(const Value: Boolean);
begin
  FScheme3EnableModify         := Value;
  FScheme3AddButton.Enabled    := Value;
  FScheme3DeleteButton.Enabled := Value;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SetScheme4EnableModify(const Value: Boolean);
begin
  FScheme4EnableModify         := Value;
  FScheme4AddButton.Enabled    := Value;
  FScheme4DeleteButton.Enabled := Value;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SetScheme5EnableModify(const Value: Boolean);
begin
  FScheme5EnableModify         := Value;
  FScheme5AddButton.Enabled    := Value;
  FScheme5DeleteButton.Enabled := Value;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.Scheme1ComboChange(Sender:TObject);begin SchemeComboChange(FScheme1Combo, FScheme1IsOverall, FScheme1DeleteButton); end;
procedure TiComponentEditorThemePanel.Scheme2ComboChange(Sender:TObject);begin SchemeComboChange(FScheme2Combo, FScheme2IsOverall, FScheme2DeleteButton); end;
procedure TiComponentEditorThemePanel.Scheme3ComboChange(Sender:TObject);begin SchemeComboChange(FScheme3Combo, FScheme3IsOverall, FScheme3DeleteButton); end;
procedure TiComponentEditorThemePanel.Scheme4ComboChange(Sender:TObject);begin SchemeComboChange(FScheme4Combo, FScheme4IsOverall, FScheme4DeleteButton); end;
procedure TiComponentEditorThemePanel.Scheme5ComboChange(Sender:TObject);begin SchemeComboChange(FScheme5Combo, FScheme5IsOverall, FScheme5DeleteButton); end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.Scheme1AddButtonClick(Sender:TObject);begin SchemeAdd(FScheme1Combo,FScheme1Title,FScheme1TypeList,FScheme1PropertyNames);end;
procedure TiComponentEditorThemePanel.Scheme2AddButtonClick(Sender:TObject);begin SchemeAdd(FScheme2Combo,FScheme2Title,FScheme2TypeList,FScheme2PropertyNames);end;
procedure TiComponentEditorThemePanel.Scheme3AddButtonClick(Sender:TObject);begin SchemeAdd(FScheme3Combo,FScheme3Title,FScheme3TypeList,FScheme3PropertyNames);end;
procedure TiComponentEditorThemePanel.Scheme4AddButtonClick(Sender:TObject);begin SchemeAdd(FScheme4Combo,FScheme4Title,FScheme4TypeList,FScheme4PropertyNames);end;
procedure TiComponentEditorThemePanel.Scheme5AddButtonClick(Sender:TObject);begin SchemeAdd(FScheme5Combo,FScheme5Title,FScheme5TypeList,FScheme5PropertyNames);end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SetScheme1Title(const Value:String);begin if Value<>FScheme1Title then begin FScheme1Title:=Value;FScheme1ComboLabel.Caption:=FScheme1Title+':';end;end;
procedure TiComponentEditorThemePanel.SetScheme2Title(const Value:String);begin if Value<>FScheme2Title then begin FScheme2Title:=Value;FScheme2ComboLabel.Caption:=FScheme2Title+':';end;end;
procedure TiComponentEditorThemePanel.SetScheme3Title(const Value:String);begin if Value<>FScheme3Title then begin FScheme3Title:=Value;FScheme3ComboLabel.Caption:=FScheme3Title+':';end;end;
procedure TiComponentEditorThemePanel.SetScheme4Title(const Value:String);begin if Value<>FScheme4Title then begin FScheme4Title:=Value;FScheme4ComboLabel.Caption:=FScheme4Title+':';end;end;
procedure TiComponentEditorThemePanel.SetScheme5Title(const Value:String);begin if Value<>FScheme5Title then begin FScheme5Title:=Value;FScheme5ComboLabel.Caption:=FScheme5Title+':';end;end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.Scheme1ComboDropDown(Sender: TObject);begin FScheme1DeleteButton.Enabled := False;FScheme1Combo.Items.Assign(FScheme1TypeList);end;
procedure TiComponentEditorThemePanel.Scheme2ComboDropDown(Sender: TObject);begin FScheme2DeleteButton.Enabled := False;FScheme2Combo.Items.Assign(FScheme2TypeList);end;
procedure TiComponentEditorThemePanel.Scheme3ComboDropDown(Sender: TObject);begin FScheme3DeleteButton.Enabled := False;FScheme3Combo.Items.Assign(FScheme3TypeList);end;
procedure TiComponentEditorThemePanel.Scheme4ComboDropDown(Sender: TObject);begin FScheme4DeleteButton.Enabled := False;FScheme4Combo.Items.Assign(FScheme4TypeList);end;
procedure TiComponentEditorThemePanel.Scheme5ComboDropDown(Sender: TObject);begin FScheme5DeleteButton.Enabled := False;FScheme5Combo.Items.Assign(FScheme5TypeList);end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SchemeComboChange(SchemeCombo: TComboBox; IsOverall: Boolean; SchemeDeleteButton: TiComponentEditorButton);
var
  StringList           : TStringList;
  SchemeComboItemIndex : Integer;
begin
  SchemeComboItemIndex := SchemeCombo.ItemIndex;
  if SchemeComboItemIndex < 0 then exit;
  if IsOverall = True then
    begin
      ClearSelectedSchemes;
      SchemeCombo.ItemIndex := SchemeComboItemIndex;
    end;
  StringList := SchemeCombo.Items.Objects[SchemeComboItemIndex] as TStringList;
  TransferSchemeData(StringList);
  SchemeDeleteButton.Enabled := (StringList is TiUserSchemeList);
  if FAutoAcceptPreview = True then
    FOnAcceptChanges(Self);
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SchemeAdd(SchemeCombo: TComboBox; SchemeTypeTitle: String; SchemeTypeList, SchemePropertyNames: TStringList);
var
  NewSchemeName        : String;
  ItemIndex            : Integer;
  AcceptPreviewEnabled : Boolean;
begin
  SetParentsToTopMost(Self);
  iComponentEditorThemePanelAddDialogForm := TiComponentEditorThemePanelAddDialogForm.Create(Owner);


  iComponentEditorThemePanelAddDialogForm.Caption := 'Add Scheme to ' + SchemeTypeTitle;
  iComponentEditorThemePanelAddDialogForm.SchemeName.Text := SchemeCombo.Text;
  try
    if iComponentEditorThemePanelAddDialogForm.ShowModal = mrOk then
      begin
        NewSchemeName := Trim(iComponentEditorThemePanelAddDialogForm.SchemeName.Text);
        if NewSchemeName = '' then
          begin
            MessageDlg(NoNameEnteredErrorMessage, mtError, [mbOK], 0);
            exit;
          end;
        ItemIndex := UserSchemeNameExist(NewSchemeName, SchemeTypeList);
        if ItemIndex <> -1 then
          begin
            if MessageDlg('Do you want to overwrite ' + NewSchemeName + '?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;
            SchemeTypeList.Objects[ItemIndex].Free;
            SchemeTypeList.Delete(ItemIndex);
          end;
        CreateNewScheme(NewSchemeName, SchemeTypeList, SchemePropertyNames);
        SchemeCombo.OnDropDown(Self);
        SchemeCombo.ItemIndex := SchemeCombo.Items.IndexOf(NewSchemeName);
        AcceptPreviewEnabled := FAcceptPreviewButton.Enabled;
        SchemeCombo.OnChange(Self);
        FAcceptPreviewButton.Enabled := AcceptPreviewEnabled;
      end;
  finally
    iComponentEditorThemePanelAddDialogForm.Free;
  end;
  SetParentsToTopMost(Owner as TWinControl);
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.CleanScheme(SchemeTypeList, SchemePropertyNames: TStringList; NoConfirmation: Boolean);
var
  x                  : Integer;
  NewSchemeName      : String;
  NumberSchemes      : Integer;
  StringList         : TStringList;
  TempSchemeTypeList : TStringList;
begin
  SetParentsToTopMost(Self);

  if NoConfirmation = False then
    begin
      if MessageDlg(CleanSchemesMessage, mtWarning, [mbYes, mbNo], 0) = mrNo then exit;
    end;
  if Assigned(FOnAcceptChanges) then
    begin
      //Loop through Schemes
      TempSchemeTypeList := TStringList.Create;
      NumberSchemes := SchemeTypeList.Count;
      for x := 0 to NumberSchemes - 1 do
        begin
          //Apply Schemes to Component Preview
          StringList := SchemeTypeList.Objects[x] as TStringList;
          TransferSchemeData(StringList);
          FOnAcceptChanges(Self);
          //Add New Scheme
          NewSchemeName := SchemeTypeList.Strings[x];
          CreateNewScheme(NewSchemeName, TempSchemeTypeList, SchemePropertyNames);
        end;
      for x := 0 to NumberSchemes - 1 do
        begin
          //Remove old Schemes
          SchemeTypeList.Objects[0].Free;
          SchemeTypeList.Delete(0);
        end;
      //Assign TempSchemeTypeList to SchemeTypeList
      SchemeTypeList.Assign(TempSchemeTypeList);
      //Save changes to XML File
      SaveToXMLFile;
      FAcceptPreviewButton.Enabled := True;
    end
  else
    begin
        MessageDlg(AcceptChangesNotAssignedEM , mtError, [mbOK], 0);
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.TransferSchemeData(TypeList: TStringList);
var
  x                   : Integer;
  AString             : String;
  PropertyNameString  : String;
  PropertyValueString : String;
begin
  for x := 0 to TypeList.Count - 1 do
    begin
      AString := TypeList.Strings[x];
      SeparateNameValue(AString, PropertyNameString, PropertyValueString);
      if (PropertyNameString <> '') {and (PropertyValueString <> '')} then
        SetProperty(iComponentPreview, PropertyNameString, PropertyValueString);
    end;
    ReCenterPreview;
    FAcceptPreviewButton.Enabled := True;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.CreateNewScheme(SchemeName: String; SchemeList: TStringList; PropertyNameList: TStringList);
var
  x           : Integer;
  NameString  : String;
  ValueString : String;
  BuildString : String;
  StringList  : TiUserSchemeList;
begin
  StringList := TiUserSchemeList.Create;
  try
    for x := 0 to PropertyNameList.Count - 1 do
      begin
        NameString  := PropertyNameList.Strings[x];
        ValueString := GetProperty(FiComponentPreview, NameString);
        BuildString := CombineNameValue(NameString, ValueString);
        StringList.Add(BuildString);
      end;
    SchemeList.AddObject(SchemeName, StringList);
    SchemeList.Add(SchemeName);
    SaveToXMLFile;
    ResetThemePanel;
    LoadFromXMLFile;
  except
    StringList.Free;
  end;
end;
//****************************************************************************************************************************************************
function TiComponentEditorThemePanel.GetProperty(Instance : TPersistent; PropertyNameString : String): String;
var
  PropInfo : PPropInfo;
begin
  PropInfo := GetPropertyInfo(Instance, PropertyNameString);
  if PropInfo <> nil then
    begin
      case PropInfo^.PropType^.Kind of
        tkInteger, tkEnumeration, tkSet, tkChar : Result := IntToStr  (GetOrdProp  (Instance, PropInfo));
        tkFloat                                 : Result := FloatToStr(GetFloatProp(Instance, PropInfo));
        tkString, tkLString, tkWString          : Result :=            GetStrProp  (Instance, PropInfo);
      end;
    end;
end;
//****************************************************************************************************************************************************
function TiComponentEditorThemePanel.GetPropertyInfo(var Instance : TPersistent; PropertyNameString : String): PPropInfo;
var
  I, J, L   : Integer;
  PropInfo  : PPropInfo;
  PropValue : TObject;
  PropName  : String;
begin
  Result := nil;
  I := 1;
  L := Length(PropertyNameString);     
  while True do
    begin
      J := I;
      while (I <= L) and (PropertyNameString[I] <> '.') do Inc(I);
      PropName := Trim(Copy(PropertyNameString, J, I - J));
      if I > L then Break;
      PropInfo := GetPropInfo(Instance.ClassInfo, PropName);
      if PropInfo = nil then Exit;
      PropValue := nil;
      if PropInfo^.PropType^.Kind = tkClass then
        PropValue := TObject(GetOrdProp(Instance, PropInfo));
      if not (PropValue is TPersistent) then Exit;
      Instance := TPersistent(PropValue);
      Inc(I);
    end;
  Result := GetPropInfo(Instance.ClassInfo, PropName);
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SetProperty(Instance : TPersistent; PropertyNameString, PropertyValueString : String);
var
  PropInfo : PPropInfo;
begin
  PropInfo := GetPropertyInfo(Instance, PropertyNameString);
  if PropInfo <> nil then
    begin
      case PropInfo^.PropType^.Kind of
        tkInteger, tkEnumeration, tkSet, tkChar, tkFloat : if Trim(PropertyValueString) = '' then exit;
      end;
      case PropInfo^.PropType^.Kind of
        tkInteger, tkEnumeration, tkSet, tkChar : SetOrdProp  (Instance, PropInfo, StrToInt  (PropertyValueString));
        tkFloat                                 : SetFloatProp(Instance, PropInfo, StrToFloat(PropertyValueString));
        tkString, tkLString, tkWString          : if PropertyValueString = '' then
                                                      SetStrProp  (Instance, PropInfo, ' ')
                                                    else
                                                      SetStrProp  (Instance, PropInfo, PropertyValueString);
      end;
    end;
end;
//****************************************************************************************************************************************************
function TiComponentEditorThemePanel.SaveToXMLFile: Boolean;
var
  UserFileStream : TiXMLMemoryStream;
  UserPathName   : String;
  UserFileName   : String;
  IocompPathName : String;
begin

  SaveToXMLFile := True;
  GetThemePaths(IocompPathName, UserPathName);

  UserFileName := iComponentPreview.ClassName + UserFileSuffix;
  UserFileStream := TiXMLMemoryStream.Create;
  try
    UserFileStream.StartElement('SchemeTypes');
      if FScheme1Show then SaveSchemeType(UserFileStream, FScheme1TypeList, FScheme1Title);
      if FScheme2Show then SaveSchemeType(UserFileStream, FScheme2TypeList, FScheme2Title);
      if FScheme3Show then SaveSchemeType(UserFileStream, FScheme3TypeList, FScheme3Title);
      if FScheme4Show then SaveSchemeType(UserFileStream, FScheme4TypeList, FScheme4Title);
      if FScheme5Show then SaveSchemeType(UserFileStream, FScheme5TypeList, FScheme5Title);
    UserFileStream.EndElement('SchemeTypes');
  finally
    try
      UserFileStream.SaveToFile(UserPathName + UserFileName);
    except
      on E : Exception do
        begin
          SetParentsToTopMost(Self);
          MessageDlg(IocompThemeSaveErrorMessage + ' - ' + E.Message, mtError, [mbOK], 0);
          SetParentsToTopMost(Owner As TWinControl);
          SaveToXMLFile := False;