qicomponenteditorthemepanel.pas

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

                      //Colors under LINUX do not support "Windows" system colors
                      //Need to convert to VCL Colors from the stored Integers
                      //Windows Colors have negative Values
                      if Pos('COLOR', UpperCase(PropertyNameString)) > 0 then
                        begin
                          ColorValue := StrToInt(PropertyValueString);
                          if ColorValue < 0 then
                            begin
                              ColorValue := (ColorValue and $000000FF);
                              case ColorValue of
                                 0: NewColor := clScrollBar;
                                 1: NewColor := clBackground;
                                 2: NewColor := clActiveCaption;
                                 3: NewColor := clInactiveCaption;
                                 4: NewColor := clMenu;
                                 5: NewColor := clWindow;
                                 6: NewColor := clWindowFrame;
                                 7: NewColor := clMenuText;
                                 8: NewColor := clWindowText;
                                 9: NewColor := clCaptionText;
                                10: NewColor := clActiveBorder;
                                11: NewColor := clInactiveBorder;
                                12: NewColor := clAppWorkSpace;
                                13: NewColor := clHighlight;
                                14: NewColor := clHighlightText;
                                15: NewColor := clBtnFace;
                                16: NewColor := clBtnShadow;
                                17: NewColor := clGrayText;
                                18: NewColor := clBtnText;
                                19: NewColor := clInactiveCaptionText;
                                20: NewColor := clBtnHighlight;
                                21: NewColor := cl3DDkShadow;
                                22: NewColor := cl3DLight;
                                23: NewColor := clInfoText;
                                24: NewColor := clInfoBk;
                                //26: NewColor := clHotLight;
                                //27: NewColor := clGradientActiveCaption;
                                //28: NewColor := clGradientInactiveCaption;
                                //29: NewColor := clMenuHighlight;
                                //30: NewColor := clMenuBar;
                              end;
                            PropertyValueString := IntToStr(NewColor);
                          end;
                        end;
                      SetOrdProp  (Instance, PropInfo, StrToInt  (PropertyValueString));
                    end;
        tkEnumeration, tkSet, tkChar : SetOrdProp  (Instance, PropInfo, StrToInt  (PropertyValueString));
        {$endif}
        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;
        end;
    end;
    UserFileStream.Free;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SaveSchemeType(Stream: TiXMLMemoryStream; SchemeTypeList: TStringList; SchemeTitle: String);
var
  SchemeList     : TStringList;
  TypeListIndex  : Integer;
  DataItemIndex  : Integer;
  PropertyName   : String;
  PropertyValue  : String;
begin
  with Stream do
    begin
      StartElement('SchemeType');
        WriteElement('Name', SchemeTitle);
        for TypeListIndex := 0 to SchemeTypeList.Count-1 do
          begin
            SchemeList := SchemeTypeList.Objects[TypeListIndex] as TStringList;
            if SchemeList is TiUserSchemeList then
              begin
                StartElement('Scheme');
                  WriteElement('Name', SchemeTypeList.Strings[TypeListIndex]);
                  StartElement('Properties');
                    for DataItemIndex := 0 to SchemeList.Count-1 do
                      begin
                        PropertyName  := '';
                        PropertyValue := ''; //If property doesn't exist, this needs to be preset/reset to blank
                                            //to prevent using the previuos property's value.
                        SeparateNameValue(SchemeList.Strings[DataItemIndex], PropertyName, PropertyValue);
                        if PropertyName <> '' then
                          WriteElement(PropertyName, PropertyValue);
                      end;
                  EndElement('Properties');
                EndElement('Scheme');
              end;
          end;
      EndElement('SchemeType');
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.SeparateNameValue(AText: String; var Name: String; var Value: String);
var
  EqualPosition: Integer;
begin
  EqualPosition := AnsiPos('=', AText);
  if (EqualPosition <> 0) then
    begin
      Name  := Trim(Copy(AText, 1, EqualPosition - 1));
      Value := Copy(AText, EqualPosition + 2, Length(AText) - EqualPosition);
    end
  else
    begin
      Name  := '';
      Value := '';
    end;
end;
//****************************************************************************************************************************************************
function TiComponentEditorThemePanel.CombineNameValue(Name, Value: String): String;
begin
  Result := Name + ' = ' + Value;
end;
//****************************************************************************************************************************************************
function TiComponentEditorThemePanel.GetSchemeTypeListByName(Name: String): TStringList;
begin
  if Name = FScheme1Title      then result := FScheme1TypeList
   else if Name = FScheme2Title then result := FScheme2TypeList
    else if Name = FScheme3Title then result := FScheme3TypeList
     else if Name = FScheme4Title then result := FScheme4TypeList
      else if Name = FScheme5Title then result := FScheme5TypeList
       else Result := nil;//else raise exception.create('Scheme Type ' + Name + ' Not Found');
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.GetThemePaths(var IocompPathName, UserPathName: String);
var
{$ifdef MSWINDOWS}
  Registry : TRegistry;
  //INIFile  : TIniFile;
  AString  : String;
{$endif}
{$ifdef LINUX}
  INIFile      : TMemIniFile;
  HOMEDIRECTORY: String;
  INIFILENAME  : String;
  TempString   : String;
{$endif}
begin
  {$ifdef MSWINDOWS}
  //==================================================================
  //Windows Specific Code
  //==================================================================
  Registry := TRegistry.Create;
  try
    //First look in Local Machine
    Registry.RootKey := HKEY_LOCAL_MACHINE;
    Registry.OpenKeyReadOnly('SOFTWARE\Iocomp\Themes');
    IocompPathName := Trim(Registry.ReadString('Iocomp Defined Theme Path'));
    UserPathName   := Trim(Registry.ReadString('User Defined Theme Path'));

    //Let Current User override Local Machine settings
    Registry.RootKey := HKEY_CURRENT_USER;
    Registry.OpenKeyReadOnly('SOFTWARE\Iocomp\Themes');

    AString := '';
    AString := Trim(Registry.ReadString('Iocomp Defined Theme Path'));
    if AString <> '' then IocompPathName := AString;

    AString := '';
    AString := Trim(Registry.ReadString('User Defined Theme Path'));
    if AString <> '' then UserPathName   := AString;

    FSchemeFound := False;

    if (IocompPathName <> '') then FSchemeFound := True;
    if (UserPathName   <> '') then FSchemeFound := True;

    if Length(IocompPathName) <> 0 then
      begin
        if Copy(IocompPathName, Length(IocompPathName), 1) <> '\' then IocompPathName := IocompPathName + '\';
      end;

    if Length(UserPathName) <> 0 then
      begin
        if Copy(UserPathName,   Length(UserPathName),   1) <> '\' then UserPathName   := UserPathName   + '\';
      end;

    {if (IocompPathName <> '') then
      begin
        if LastDelimiter('\',IocompPathName) <> Length(IocompPathName) then
          IocompPathName := IocompPathName + '\';
      end;

    if (UserPathName <> '') then
      begin
        if LastDelimiter('\',UserPathName) <> Length(UserPathName) then
          UserPathName := UserPathName + '\';
      end;            }
  finally
    Registry.Free;
  end;
  {$endif}
  {$ifdef LINUX}
  //==================================================================
  //Linux Specific Code
  //==================================================================
  HOMEDIRECTORY := GetEnvironmentVariable('HOME');
  INIFILENAME   := IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(HOMEDIRECTORY) + '.iocomp') + 'registry.ini';
  //Create "Iocomp Registry" under INIFileName Directory
  if DirectoryExists(ExtractFilePath(INIFILENAME)) then
    begin
      FSchemeFound := False;
      TempString   := '';
      //Get Default Installation Directory from "Registry"
      INIFile := TMemIniFile.Create(INIFILENAME);
      try
        TempString     := INIFile.ReadString('Themes', 'Iocomp Defined Theme Path', '');
        if TempString <> '' then
          begin
            IocompPathName := IncludeTrailingPathDelimiter(TempString);
            FSchemeFound := True;
          end;
        TempString     := INIFile.ReadString('Themes', 'User Defined Theme Path',   '');
        if TempString <> '' then
          begin
            UserPathName   := IncludeTrailingPathDelimiter(TempString);
            FSchemeFound := True;
          end;
      finally
        INIFile.Free;
      end;
    end;
  {$endif}
  //==================================================================
  //Common Code
  //==================================================================
  if not FSchemeFound then
    begin
      FPreviewErrorLabel1.Visible   := True;
      FPreviewErrorLabel2.Visible   := True;
      FScheme1Combo.Enabled        := False;
      FScheme1ComboLabel.Enabled   := False;
      FScheme1AddButton.Enabled    := False;
      FScheme1DeleteButton.Enabled := False;
      FScheme2Combo.Enabled        := False;
      FScheme2ComboLabel.Enabled   := False;
      FScheme2AddButton.Enabled    := False;
      FScheme2DeleteButton.Enabled := False;
      FScheme3Combo.Enabled        := False;
      FScheme3ComboLabel.Enabled   := False;
      FScheme3AddButton.Enabled    := False;
      FScheme3DeleteButton.Enabled := False;