⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 icomponenteditorthemepanel.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        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);
{$ifdef MSWINDOWS}
var
  Registry : TRegistry;
  //INIFile  : TIniFile;
  AString  : 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;            }
    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;
        FScheme4Combo.Enabled        := False;
        FScheme4ComboLabel.Enabled   := False;
        FScheme4AddButton.Enabled    := False;
        FScheme4DeleteButton.Enabled := False;
        FScheme5Combo.Enabled        := False;
        FScheme5ComboLabel.Enabled   := False;
        FScheme5AddButton.Enabled    := False;
        FScheme5DeleteButton.Enabled := False;
        if Assigned(FiComponentPreview) then
          begin
            FiComponentPreview.Width  := 0;
            FiComponentPreview.Height := 0;
          end;
      end
    else
      begin
        FPreviewErrorLabel1.Visible   := False;
        FPreviewErrorLabel2.Visible   := False;
      end;

  finally
    Registry.Free;
  end;
  {$endif}
  {$ifdef LINUX}
  //==================================================================
  //Linux Specific Code
  //==================================================================
    //TODO
    //Temporarily hard-code paths for now
    IocompPathName := '/usr/local/Iocomp/components/themes';
    UserPathName   := '/root/.Iocomp/components/themes';
  {$endif}
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.LoadFromXMLFile;
var
  IocompFileStream : TiXMLMemoryStream;
  UserFileStream   : TiXMLMemoryStream;
  IocompFileName   : String;
  UserFileName     : String;
  IocompPathName   : String;
  UserPathName     : String;
begin
  if csDesigning in ComponentState then exit;
  ClearAllSchemes;
  GetThemePaths(IocompPathName, UserPathName);

  IocompFileName := iComponentPreview.ClassName + IocompFileSuffix;
    begin
      if FileExists(IocompPathName + IocompFileName) then
        begin
           try
            try
              IocompFileStream := TiXMLMemoryStream.Create;
              IocompFileStream.LoadFromFile(IocompPathName + IocompFileName);
              try
                LoadSchemes(IocompFileStream, TiIocompSchemeList);
              finally
                IocompFileStream.Free;
              end;
            except
              on EFOpenError do ;
            end;
          except
            on E : Exception do
              begin
                SetParentsToTopMost(Self);
                MessageDlg(IocompThemeOpenErrorMessage + ' - ' + E.Message, mtInformation, [mbOK], 0);
                SetParentsToTopMost(Owner As TWinControl);
              end;
          end;
        end;

      UserFileName := iComponentPreview.ClassName + UserFileSuffix;
      if FileExists(UserPathName + UserFileName) then
        begin
          try
            try
              UserFileStream := TiXMLMemoryStream.Create;
              UserFileStream.LoadFromFile(UserPathName + UserFileName);
              try
                LoadSchemes(UserFileStream, TiUserSchemeList);
              finally
                UserFileStream.Free;
              end;
            except
              on EFOpenError do ;
            end;
          except
            on E : Exception do
              begin
                SetParentsToTopMost(Self);
                MessageDlg(UserThemeOpenErrorMessage + ' - ' + E.Message, mtInformation, [mbOK], 0);
                SetParentsToTopMost(Owner As TWinControl);
              end;
          end;
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponentEditorThemePanel.LoadSchemes(FileStream: TiXMLMemoryStream; SchemeListClass: TiSchemeListClass);
var
  AString          : String;
  SchemeTypeList   : TStringList;
  SchemeList       : TStringList;
  ElementName      : String;
  ElementValue     : String;
begin
  with FileStream do
    begin
      GotoElementStart('SchemeTypes');
      while PeekNextPiece = 'SchemeType' do
        begin
          GotoElementStart('SchemeType');
          AString := GetElement('Name');
          SchemeTypeList := GetSchemeTypeListByName(AString);
          while PeekNextPiece = 'Scheme' do
            begin
              GotoElementStart('Scheme');
              AString := GetElement('Name');
              if Assigned(SchemeTypeList) then
                begin
                  SchemeList := SchemeListClass.Create;
                  SchemeTypeList.AddObject(AString, SchemeList);
                end
              else SchemeList := nil;
              GotoElementStart('Properties');
              while PeekNextPiece <> '/Properties' do
                begin
                  ElementName  := '';
                  ElementValue := '';
                  ElementName  := PeekNextPiece;
                  ElementValue := GetElement(ElementName);
                  if Assigned(SchemeList) then
                    begin
                      if ElementName <> '' then
                        SchemeList.Add(CombineNameValue(ElementName, ElementValue));
                    end;
                end;
              if GetNextPiece <

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -