Delphi-int.ru: портал программистов

Вход Регистрация | Забыли пароль?

Просмотр кода

Идентификатор: 0739ce6b Описание: Код загружен: 12 августа 2011, 13:17 (min@y™)

unit uSettings;
 
interface
 
uses
  //============================== Модули проекта ==============================
  uRoutines, uXmlUtils,
  //=============================== Левые модули ===============================
  ECXMLParser, SynEdit, SynEditPrint, SynEditPrintHeaderFooter,
  SynEditPrintTypes, SynEditPrintMargins,
  //============================= Системные модули =============================
  Windows, SysUtils, Classes, Contnrs, Graphics, Variants, Forms;
 
type
  // Типы опций
  TOptionType = (otBoolean,
                 otInteger,
                 otCardinal,
                 otColor,
                 otFloat,
                 otString,
                 otText,  // Для хранения многострочного текста
                 otBooleanList,
                 otIntegerList,
                 otStringList,
                 otFont,
                 otSynOptions,
                 otSynEditPrint);
 
  // Класс-предок опций
  TCustomOption = class
  private
    // Поля
    FOptionType: TOptionType; // Тип опции
    FName: string; // Имя ноды в XML для поиска
    FCaption: string; // Надпись на контроле настройки, если требуестя
    FGroupName: string; // Название группы, которой принадлежит опция
    FNode: TXMLItem; // Нода, которая будет создаваться при сохранении и находиться при загрузке
  public
    // Конструктор и деструктор
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); virtual;
 
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); virtual;    // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); virtual;  // Загрузка
 
    // Свойства
    property Name: string read FName write FName;
    property OptionType: TOptionType read FOptionType;
    property Caption: string read FCaption write FCaption;
    property GroupName: string read FGroupName write FGroupName;
  end;
 
  // Контейнер для хранения Boolean
  TBooleanOption = class(TCustomOption)
  private
    FValue: Boolean; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: Boolean read FValue write FValue;
  end;
 
  // Контейнер для хранения Integer
  TIntegerOption = class(TCustomOption)
  private
    FValue: Integer; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: Integer read FValue write FValue;
  end;
 
  // Контейнер для хранения Cardinal
  TCardinalOption = class(TCustomOption)
  private
    FValue: Cardinal; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: Cardinal read FValue write FValue;
  end;
 
  // Контейнер для хранения TColor
  TColorOption = class(TCustomOption)
  private
    FValue: TColor; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: TColor read FValue write FValue;
  end;
 
  // Контейнер для хранения Extended
  TFloatOption = class(TCustomOption)
  private
    FValue: Extended; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: Extended read FValue write FValue;
  end;
 
  // Контейнер для хранения String
  TStringOption = class(TCustomOption)
  private
    FValue: string; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: string read FValue write FValue;
  end;
 
  // Контейнер для хранения многострочного текста
  TTextOption = class(TCustomOption)
  private
    FValue: string; // Хранимое значение
  public
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Value: string read FValue write FValue;
  end;
 
  // Контейнер для хранения списка Boolean-значений
  TBooleanListOption = class(TCustomOption)
  private
    FBits: TBits;
    function GetCount: Integer; // Количество
    procedure SetItem(const Index: Integer; const AValue: Boolean); // Установка бита
    function GetItem(const Index: Integer): Boolean; // Чтение бита
  public
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); override;
    destructor Destroy; override;
 
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Count: Integer read GetCount;
    property Bits: TBits read FBits;
    property Items[const Index: Integer]: Boolean read GetItem write SetItem; default;
  end;
 
  // Контейнер для хранения списка Integer-значений
  TIntegerListOption = class(TCustomOption)
  private
    FList: TList;
    function GetCount: Integer; // Количество
    procedure SetCount(const ANewCount: Integer); // Установка количества
    procedure SetItem(const Index, AValue: Integer); // Установка значения целого элемента списка
    function GetItem(const Index: Integer): Integer; // Чтение элемента
  public
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); override;
    destructor Destroy; override;
 
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Count: Integer read GetCount write SetCount;
    property List: TList read FList;
    property Items[const Index: Integer]: Integer read GetItem write SetItem; default;
  end;
 
  // Контейнер для хранения списка строк
  TStringListOption = class(TCustomOption)
  private
    FList: TStrings;
    procedure SetList(AList: TStrings); // Присвоение списка строк
    function GetCount: Integer; // Количество
    procedure SetCount(const ANewCount: Integer); // Установка количества
    procedure SetItem(const Index: Integer; const AValue: string); // Установка значения строки
    function GetItem(const Index: Integer): string; // Чтение элемента
  public
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); override;
    destructor Destroy; override;
 
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
    procedure PushItem(const ANewItem: string; const Max: Integer = 16); // Добавление строки в начало, без повторений
 
    // Свойства
    property Count: Integer read GetCount write SetCount;
    property List: TStrings read FList write SetList;
    property Items[const Index: Integer]: string read GetItem write SetItem; default;
  end;
 
  // Контейнер для хранения настроек шрифта
  TFontOption = class(TCustomOption)
  private
    FFont: TFont;
    procedure SetFont(ANewFont: TFont); // Установка шрифта
  public
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); override;
    destructor Destroy; override;
 
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property Font: TFont read FFont write SetFont;
  end;
 
  // Контейнер для хранения опций TSynEditorOptions
  TSynOptionsOption = class(TCustomOption)
  private
    FValue: TSynEditorOptions; // Хранимое значение
 
    function SynOptionsToCardinal(const AOptions: TSynEditorOptions): Cardinal;
    function CardinalToSynOptions(const ACardinal: Cardinal): TSynEditorOptions;
    function GetOptionCaption(const AOption: TSynEditorOption): string; // Получение заголовка опции
  public
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); override;
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
    function OptionExists(const AOption: TSynEditorOption): Boolean; // Чтение значения опции AOption
    procedure SetOption(const AOption: TSynEditorOption; const AEnabled: Boolean); // Включение/выключение опции
 
    // Свойства
    property Value: TSynEditorOptions read FValue write FValue;
    property Captions[const AOption: TSynEditorOption]: string read GetOptionCaption; // Заголовки опций
  end;
 
  // Класс для хранения настроек SynEditPrint
  // Класс-...
  TSynEditPrintOption = class(TCustomOption)
  private
    // Поля
    FSynEditPrint: TSynEditPrint;
 
    // Функции доступа к полям/свойствам
 
    // Технологические функции
    function FrameTypesToInt(const FT: TFrameTypes): Integer;
    function IntToFrameTypes(const AValue: Integer): TFrameTypes;
    procedure SaveHeaderFooterToXML(ANode: TXMLItem; HF: THeaderFooter); // Сохранение хэдера и футера
    procedure LoadHeaderFooterFromXML(ANode: TXMLItem; HF: THeaderFooter); // Загрузка хэдера и футера
    procedure SaveMarginsToXML(ANode: TXMLItem; Margins: TSynEditPrintMargins); // Сохранение полей
    procedure LoadMarginsFromXML(ANode: TXMLItem; Margins: TSynEditPrintMargins); // Загрузка полей
  public
    // Конструктор и деструктор
    constructor Create(const AType: TOptionType; const AGroupName, AName: string); override;
    destructor Destroy; override;
 
    // Методы
    procedure SaveToXML(AParentNode: TXMLItem); override;   // Сохранение
    procedure LoadFromXML(AParentNode: TXMLItem); override; // Загрузка
 
    // Свойства
    property PrintEngine: TSynEditPrint read FSynEditPrint;
 
    // События
  end;
 
  // --------- Класс глобальных настроек программы ------------
  TProgramSettings = class
  private
    // Поля
    FOptions: TObjectList; // Хранимые настройки
    FFileName: string; // имя файла для хранения настроек
 
    // Функции доступа к полям/свойствам
    function GetCount: Integer; // Чтение количества опций
    function GetOption(const Index: Integer): TCustomOption; // Чтение опции
    function GetOptionByName(const AName: string): TCustomOption; // Чтение опции по имени
 
    // Технологические функции
    procedure CreateOptions; // Создание опций
  public
    // Конструктор и деструктор
    constructor Create;
    destructor Destroy; override;
 
    // Методы
    function AddOption(const AOption: TCustomOption): Integer; // Добавление готовой опции
    function NewOption(const AType: TOptionType; const AGroupName, AName: string): TCustomOption; // Создание новой
опции
    function LoadFromFile(const AFileName: string): Boolean; // Загрузка всех настроек
    function SaveToFile(const AFileName: string): Boolean; // Сохранение всех настроек
 
    // Свойства
    property Count: Integer read GetCount;
    property Options[const Index: Integer]: TCustomOption read GetOption; default;
    property OptionsByName[const AName: string]: TCustomOption read GetOptionByName;
  end;
 
  // Тип для задания массива констант цветовых настроек
  TColorSettingConst = record
    Name: string;
    Caption: string;
    Default: TColor;
  end;
 
 
const
  // Группы настроек
  sgInterface =        'Interface';
  sgSearchReplace =    'SearchReplace';
  sgTextEditor =       'TextEditor';
  sgLastOpened =       'LastOpened';
  sgAutoEncoding =     'AutoEncoding';
  sgLogo =             'Logo';
  sgOther =            'Other';
  sgPrint =            'Print';
 
 
  // Имена настроек интерфейса
  snShowHints =                'ShowHints';
  snShowNotifications =        'ShowNotifications';
  snMinimizeToTray =           'MinimizeToTray';
  snTabPosition =              'TabPosition';
  snTabStyle =                 'TabStyle';
  snProjectTreeColor =         'ProjectTreeColor';
  snProjectTreeFont =          'ProjectTreeFont';
  snProjectTreeSort =          'ProjectTreeSort';
  snRememberOpened =           'RememberOpened';
  snClockForeground =          'ClockForeground';
  snClockBackground =          'ClockBackground';
 
  // Имена настроек редактора
  snUseSystemColors  = 'UseSystemColors'; // Использовать системные цвета
  snEditorBackground = 'EditorBackground';
  snGutterBackground = 'GutterBackground';
  snRightEdgeColor =   'RightEdgeColor';
  snActiveLineColor =  'ActiveLineColor';
  snEditorFont =       'EditorFont';
 
  EditorColorsCount = 4;
  snEditorColors: array[0..EditorColorsCount - 1] of TColorSettingConst = (
    (Name: snEditorBackground; Caption: 'Фон редактора';          Default: clWindow),
    (Name: snGutterBackground; Caption: 'Фон полосы закладок';    Default: clBtnFace),
    (Name: snRightEdgeColor;   Caption: 'Цвет правой границы';    Default: clSilver),
    (Name: snActiveLineColor;  Caption: 'Цвет строки с курсором'; Default: clNone));
 
  snTextEditorOptions = 'TextEditorOptions';
  snShowGutter =        'ShowGutter';
  snRightEdge =         'RightEdge';
  snTabWidth =          'TabWidth';
 
  // Опции SynEdit, исключённые из ручной пользовательской настройки
  InvisibleSynEditorOptions: set of TSynEditorOption =
    [eoAutoSizeMaxScrollWidth, eoDropFiles, eoNoCaret, eoNoSelection,
     eoScrollHintFollows, eoSpecialLineDefaultFg];
 
  // Имена настроек автораспознавания кодировки
  snAutoEncodingEnabled =      'AutoEncodingEnabled';
  snAutoEncodingDepth =        'AutoEncodingDepth';
  snAutoEncodingEdge =         'AutoEncodingEdge';
  snAutoEncodingFlashStatus =  'AutoEncodingFlashStatus';
 
  // Имена настроек поиска/замены
  snSearchTemplates =        'SearchTemplates';
  snReplaceTemplates =       'ReplaceTemplates';
  snSearchInFilesTemplates = 'SearchInFileTemplates';
  snSearchMasks =            'SearchMasks';
  snSearchPaths =            'SearchPaths';
 
  // Имена открытых файлов и проектов при выходе
  snOpenedProjects =   'OpenedProjects';
  snOpenedFiles =      'OpenedFiles';
 
  // Имена настроек логотипа :)
  snGradColor1 =       'GradColor1';
  snGradColor2 =       'GradColor2';
  snGradType =         'GradType';
  snGradShift =        'GradShift';
  snLogoFont =         'LogoFont';
  snLogoShadowPos =    'nLogoShadowPos';
  snLogoShadowColor =  'nLogoShadowColor';
  snLogoShadowSize =   'nLogoShadowSize';
 
  // Настрокий печати
  snSynEditPrintEngine = 'SynEditPrintEngine';
 
  // Программы для запуска файлов
  snLaunchPrograms =   'LaunchPrograms';
 
  // Номера строк переходов в окне "Перейти к строке"
  snGotoLines =        'GotoLines';
 
  // Ссылки и подсказки ссылок в окне "Вставка ссылки/картинки"
  snInsLinks =         'InsLinks';
  snInsTitles =        'InsTitles';
 
var
  ProgramSettings: TProgramSettings;
 
implementation
 
{ TCustomOption }
 
constructor TCustomOption.Create(const AType: TOptionType; const AGroupName, AName: string);
begin
  FOptionType:= AType;
  FName:= AName;
  FGroupName:= AGroupName;
  FCaption:= '';
end;
 
procedure TCustomOption.LoadFromXML(AParentNode: TXMLItem);
begin
  FNode:= AParentNode.NamedItem[FName];
  // Далее действуют наследники
end;
 
procedure TCustomOption.SaveToXML(AParentNode: TXMLItem);
begin
  FNode:= AParentNode.New();
  FNode.Name:= FName;
  // Далее действуют наследники
end;
 
{ TBooleanOption }
 
procedure TBooleanOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= XmlGetBoolParam(FNode, 'Value', FValue);
end;
 
procedure TBooleanOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddBoolParam(FNode, 'Value', Boolean(FValue));
end;
 
{ TIntegerOption }
 
procedure TIntegerOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= XmlGetIntegerParam(FNode, 'Value', FValue);
end;
 
procedure TIntegerOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddIntegerParam(FNode, 'Value', FValue);
end;
 
{ TCardinalOption }
 
procedure TCardinalOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= XmlGetCardinalParam(FNode, 'Value', FValue);
end;
 
procedure TCardinalOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddCardinalParam(FNode, 'Value', FValue);
end;
 
{ TColorOption }
 
procedure TColorOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= XmlGetColorParam(FNode, 'Value', FValue);
end;
 
procedure TColorOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddColorParam(FNode, 'Value', FValue);
end;
 
{ TFloatOption }
 
procedure TFloatOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= XmlGetFloatParam(FNode, 'Value', FValue);
end;
 
procedure TFloatOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddFloatParam(FNode, 'Value', FValue);
end;
 
{ TStringOption }
 
procedure TStringOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= XmlGetStringParam(FNode, 'Value', FValue);
end;
 
procedure TStringOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddStringParam(FNode, 'Value', FValue);
end;
 
{ TTextOption }
 
procedure TTextOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= FNode.Text;
end;
 
procedure TTextOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  FNode.Text:= FValue;
end;
 
{ TBooleanListOption }
 
constructor TBooleanListOption.Create(const AType: TOptionType;
  const AGroupName, AName: string);
begin
  inherited;
  FBits:= TBits.Create();
end;
 
destructor TBooleanListOption.Destroy;
begin
  FBits.Free();
  inherited;
end;
 
function TBooleanListOption.GetCount: Integer;
begin
  Result:= FBits.Size;
end;
 
function TBooleanListOption.GetItem(const Index: Integer): Boolean;
begin
  Result:= FBits[Index];
end;
 
procedure TBooleanListOption.SetItem(const Index: Integer;
  const AValue: Boolean);
begin
  FBits[Index]:= AValue;
end;
 
procedure TBooleanListOption.LoadFromXML(AParentNode: TXMLItem);
var
  Index: Integer;
  SubItem: TXMLItem;
begin
  inherited;
 
  for Index:= 0 to FNode.Count - 1 do
    begin
      SubItem:= FNode[Index];
      FBits[Index]:= XmlGetBoolParam(SubItem, 'Value', FBits[Index]);
    end;
end;
 
procedure TBooleanListOption.SaveToXML(AParentNode: TXMLItem);
var
  Index: Integer;
  SubItem: TXMLItem;
begin
  inherited;
  XmlAddIntegerParam(FNode, 'Count', Self.Count);
  for Index:= 0 to Self.Count - 1 do
    begin
      SubItem:= FNode.New();
      SubItem.Name:= 'Item' + IntToStr(Index);
      XmlAddBoolParam(SubItem, 'Value', FBits[Index]);
    end;
end;
 
{ TIntegerListOption }
 
constructor TIntegerListOption.Create(const AType: TOptionType;
  const AGroupName, AName: string);
begin
  inherited;
  FList:= TList.Create();
end;
 
destructor TIntegerListOption.Destroy;
begin
  FList.Free();
  inherited;
end;
 
function TIntegerListOption.GetCount: Integer;
begin
  Result:= FList.Count;
end;
 
function TIntegerListOption.GetItem(const Index: Integer): Integer;
begin
  Result:= Integer(FList[Index]);
end;
 
procedure TIntegerListOption.LoadFromXML(AParentNode: TXMLItem);
var
  Index: Integer;
  SubItem: TXMLItem;
begin
  inherited;
 
  Self.Count:= FNode.Count; // Установка размера
 
  for Index:= 0 to FNode.Count - 1 do
    begin
      SubItem:= FNode[Index];
      Self[Index]:= XmlGetIntegerParam(SubItem, 'Value', Self[Index]);
    end;
end;
 
procedure TIntegerListOption.SaveToXML(AParentNode: TXMLItem);
var
  Index: Integer;
  SubItem: TXMLItem;
begin
  inherited;
  XmlAddIntegerParam(FNode, 'Count', Self.Count);
  for Index:= 0 to Self.Count - 1 do
    begin
      SubItem:= FNode.New();
      SubItem.Name:= 'Item' + IntToStr(Index);
      XmlAddIntegerParam(SubItem, 'Value', Self[Index]);
    end;
end;
 
procedure TIntegerListOption.SetCount(const ANewCount: Integer);
var
  Index: Integer;
begin
  // Установка количества
  if ANewCount = Self.Count
    then Exit;
 
  if ANewCount > Self.Count
    then for Index:= Self.Count to ANewCount - 1 do
           List.Add(Pointer(0))
    else for Index:= Self.Count - 1 downto ANewCount do
           List.Delete(Index);
end;
 
procedure TIntegerListOption.SetItem(const Index, AValue: Integer);
begin
  if Index > Count - 1
    then Count:= Index + 1;
  Self[Index]:= AValue;
end;
 
{ TStringListOption }
 
constructor TStringListOption.Create(const AType: TOptionType;
  const AGroupName, AName: string);
begin
  inherited;
  FList:= TStringList.Create();
end;
 
destructor TStringListOption.Destroy;
begin
  FList.Free();
  inherited;
end;
 
function TStringListOption.GetCount: Integer;
begin
  Result:= FList.Count;
end;
 
function TStringListOption.GetItem(const Index: Integer): string;
begin
  Result:= FList[Index];
end;
 
procedure TStringListOption.LoadFromXML(AParentNode: TXMLItem);
var
  Index: Integer;
  SubItem: TXMLItem;
begin
  inherited;
 
  Self.Count:= FNode.Count; // Установка размера
 
  for Index:= 0 to FNode.Count - 1 do
    begin
      SubItem:= FNode[Index];
      Self[Index]:= XmlGetStringParam(SubItem, 'Value', Self[Index]);
    end;
end;
 
procedure TStringListOption.PushItem(const ANewItem: string; const Max: Integer = 16);
begin
  // Добавление строки в начало, без повторений
  PushStringItem(FList, ANewItem, Max);
end;
 
procedure TStringListOption.SaveToXML(AParentNode: TXMLItem);
var
  Index: Integer;
  SubItem: TXMLItem;
begin
  inherited;
  XmlAddIntegerParam(FNode, 'Count', Self.Count);
  for Index:= 0 to Self.Count - 1 do
    begin
      SubItem:= FNode.New();
      SubItem.Name:= 'Item' + IntToStr(Index);
      XmlAddStringParam(SubItem, 'Value', Self[Index]);
    end;
end;
 
procedure TStringListOption.SetCount(const ANewCount: Integer);
var
  Index: Integer;
begin
  // Установка количества
  if ANewCount = Self.Count
    then Exit;
 
  if ANewCount > Self.Count
    then for Index:= Self.Count to ANewCount - 1 do
           List.Add('')
    else for Index:= Self.Count - 1 downto ANewCount do
           List.Delete(Index);
end;
 
procedure TStringListOption.SetItem(const Index: Integer;
  const AValue: string);
begin
  Self.List[Index]:= AValue;
end;
 
procedure TStringListOption.SetList(AList: TStrings);
begin
  // Присвоение списка строк
  FList.Assign(AList);
end;
 
{ TFontOption }
 
constructor TFontOption.Create(const AType: TOptionType;
  const AGroupName, AName: string);
begin
  inherited;
  FFont:= TFont.Create();
  FFont.Name:= 'Tahoma';
  FFont.Size:= 8;
  FFont.Color:= clWindowText;
end;
 
destructor TFontOption.Destroy;
begin
  FFont.Free();
  inherited;
end;
 
procedure TFontOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FFont.Name:= XmlGetStringParam(FNode, 'Name', Self.Font.Name);
  FFont.Size:= XmlGetIntegerParam(FNode, 'Size', Self.Font.Size);
  FFont.Color:= XmlGetColorParam(FNode, 'Color', Self.Font.Color);
end;
 
procedure TFontOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddStringParam(FNode, 'Name', FFont.Name);
  XmlAddIntegerParam(FNode, 'Size', FFont.Size);
  XmlAddColorParam(FNode, 'Color', FFont.Color);
end;
 
procedure TFontOption.SetFont(ANewFont: TFont);
begin
  FFont.Assign(ANewFont);
end;
 
{ TSynOptionsOption }
 
function TSynOptionsOption.OptionExists(
  const AOption: TSynEditorOption): Boolean;
begin
  Result:= AOption in FValue;
end;
 
procedure TSynOptionsOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
  FValue:= CardinalToSynOptions(XmlGetCardinalParam(FNode, 'Value', SynOptionsToCardinal(FValue)));
end;
 
procedure TSynOptionsOption.SaveToXML(AParentNode: TXMLItem);
begin
  inherited;
  XmlAddCardinalParam(FNode, 'Value', SynOptionsToCardinal(FValue));
end;
 
constructor TSynOptionsOption.Create(const AType: TOptionType;
  const AGroupName, AName: string);
begin
  inherited;
 
  FValue:= [eoAltSetsColumnMode,
            eoAutoIndent,
            eoDragDropEditing,
            eoScrollPastEol,
            eoShowScrollHint,
            eoSmartTabs,
            eoTabsToSpaces,
            eoTrimTrailingSpaces,
            eoSmartTabDelete,
            eoGroupUndo];
end;
 
function TSynOptionsOption.CardinalToSynOptions(
  const ACardinal: Cardinal): TSynEditorOptions;
var
  Opt: TSynEditorOption;
begin
  Result:= [];
  for Opt:= Low(TSynEditorOption) to High(TSynEditorOption) do
    if (ACardinal and (1 shl Integer(Opt))) <> 0
      then Include(Result, Opt);
end;
 
function TSynOptionsOption.SynOptionsToCardinal(
  const AOptions: TSynEditorOptions): Cardinal;
var
  Opt: TSynEditorOption;
begin
  Result:= $00000000;
  for Opt:= Low(TSynEditorOption) to High(TSynEditorOption) do
    if Opt in AOptions
      then Result:= Result or (1 shl Integer(Opt));
end;
 
function TSynOptionsOption.GetOptionCaption(
  const AOption: TSynEditorOption): string;
begin
  // Получение заголовка опции
  case AOption of
    eoAltSetsColumnMode:      Result:= 'Выделение колонки с <Alt>';
    eoAutoIndent:             Result:= 'Автоотступ';
    eoAutoSizeMaxScrollWidth: Result:= 'Автоматически увеличивать максимальную длину строки при вставке текста';
    eoDisableScrollArrows:    Result:= 'Гасить кнопки скролла, если прокрутка невозможна';
    eoDragDropEditing:        Result:= 'Перетаскивание текста мышью';
    eoDropFiles:              Result:= 'Примать файлы из проводника';
    eoEnhanceHomeKey:         Result:= 'Позиционирование курсора по <Home> на начало текста строки';
    eoGroupUndo:              Result:= 'Групповой откат';
    eoHalfPageScroll:         Result:= 'Перемотка в пол-страницы';
    eoHideShowScrollbars:     Result:= 'Автоматически скрывать полосы прокрутки';
    eoKeepCaretX:             Result:= 'Не позиционировать курсор на концах строк при вертикальной прокрутке';
    eoNoCaret:                Result:= 'Не показывать курсор';
    eoNoSelection:            Result:= 'Не показывать выделение';
    eoRightMouseMovesCursor:  Result:= 'Правая кнопка мыши позиционирует курсор';
    eoScrollByOneLess:        Result:= 'Перемотка на одну строку меньше';
    eoScrollHintFollows:      Result:= 'Подсказка следует за мышью';
    eoScrollPastEof:          Result:= 'Перемотка после конца файла';
    eoScrollPastEol:          Result:= 'Курсор за концом строки';
    eoShowScrollHint:         Result:= 'Подсказка с номером строки при перемотке';
    eoShowSpecialChars:       Result:= 'Отображать спецсимволы';
    eoSmartTabDelete:         Result:= 'Удаление по словам предыдущих строк';
    eoSmartTabs:              Result:= 'Табуляция по словам пред. строк';
    eoSpecialLineDefaultFg:   Result:= 'disables the foreground text color override when using the OnSpecialLineColor
event';
    eoTabIndent:              Result:= 'Регулирование отступа по <Tab> и <Shift>+<Tab>';
    eoTabsToSpaces:           Result:= 'Преобразование символов табуляции в пробелы';
    eoTrimTrailingSpaces:     Result:= 'Удалять завершающие пробелы в строках';
  else                        Result:= '';
  end; // case
end;
 
procedure TSynOptionsOption.SetOption(const AOption: TSynEditorOption;
  const AEnabled: Boolean);
begin
  // Включение/выключение опции
  if AEnabled
    then Include(FValue, AOption)
    else Exclude(FValue, AOption);
end;
 
{ TSynEditPrintOption }
 
constructor TSynEditPrintOption.Create(const AType: TOptionType;
  const AGroupName, AName: string);
begin
  inherited;
  FSynEditPrint:= TSynEditPrint.Create(nil);
  FSynEditPrint.Colors:= True; // По умолчанию
end;
 
destructor TSynEditPrintOption.Destroy;
begin
  FSynEditPrint.Free();
  inherited;
end;
 
function TSynEditPrintOption.FrameTypesToInt(
  const FT: TFrameTypes): Integer;
var
  Index: TFrameType;
begin
  Result:= 0;
 
  for Index:= Low(TFrameType) to High(TFrameType) do
    if Index in FT
      then Result:= Result or (1 shl (Integer(Index)));
end;
 
function TSynEditPrintOption.IntToFrameTypes(
  const AValue: Integer): TFrameTypes;
var
  Index: TFrameType;
begin
  Result:= [];
 
  for Index:= Low(TFrameType) to High(TFrameType) do
    if AValue and (1 shl (Integer(Index))) <> 0
      then Result:= Result + [Index];
end;
 
procedure TSynEditPrintOption.LoadHeaderFooterFromXML(
  ANode: TXMLItem; HF: THeaderFooter);
begin
  // Загрузка хэдера и футера
  HF.FrameTypes:=     IntToFrameTypes(XmlGetIntegerParam(ANode, 'FrameTypes', 1));
  HF.LineColor:=      XmlGetColorParam(ANode, 'LineColor',      HF.LineColor);
  HF.MirrorPosition:= XmlGetBoolParam(ANode,  'MirrorPosition', HF.MirrorPosition);
  HF.RomanNumbers:=   XmlGetBoolParam(ANode,  'RomanNumbers',   HF.RomanNumbers);
  HF.ShadedColor:=    XmlGetColorParam(ANode, 'ShadedColor',    HF.ShadedColor);
end;
 
procedure TSynEditPrintOption.LoadMarginsFromXML(
  ANode: TXMLItem; Margins: TSynEditPrintMargins);
begin
  // Загрузка полей
  with Margins do
    begin
      Left:=              XmlGetFloatParam(ANode, 'Left',              Left);
      Right:=             XmlGetFloatParam(ANode, 'Right',             Right);
      Top:=               XmlGetFloatParam(ANode, 'Top',               Top);
      Bottom:=            XmlGetFloatParam(ANode, 'Bottom',            Bottom);
      Header:=            XmlGetFloatParam(ANode, 'Header',            Header);
      Footer:=            XmlGetFloatParam(ANode, 'Footer',            Footer);
      LeftHFTextIndent:=  XmlGetFloatParam(ANode, 'LeftHFTextIndent',  LeftHFTextIndent);
      RightHFTextIndent:= XmlGetFloatParam(ANode, 'RightHFTextIndent', RightHFTextIndent);
      HFInternalMargin:=  XmlGetFloatParam(ANode, 'HFInternalMargin',  HFInternalMargin);
      Gutter:=            XmlGetFloatParam(ANode, 'Gutter',            Gutter);
      MirrorMargins:=     XmlGetBoolParam (ANode, 'MirrorMargins',     MirrorMargins);
    end;
end;
 
procedure TSynEditPrintOption.SaveMarginsToXML(ANode: TXMLItem;
  Margins: TSynEditPrintMargins);
begin
  // Сохранение полей
  with Margins do
    begin
      XmlAddFloatParam(ANode, 'Left',              Left);
      XmlAddFloatParam(ANode, 'Right',             Right);
      XmlAddFloatParam(ANode, 'Top',               Top);
      XmlAddFloatParam(ANode, 'Bottom',            Bottom);
      XmlAddFloatParam(ANode, 'Header',            Header);
      XmlAddFloatParam(ANode, 'Footer',            Footer);
      XmlAddFloatParam(ANode, 'LeftHFTextIndent',  LeftHFTextIndent);
      XmlAddFloatParam(ANode, 'RightHFTextIndent', RightHFTextIndent);
      XmlAddFloatParam(ANode, 'HFInternalMargin',  HFInternalMargin);
      XmlAddFloatParam(ANode, 'Gutter',            Gutter);
      XmlAddBoolParam (ANode, 'MirrorMargins',     MirrorMargins);
    end;
end;
 
procedure TSynEditPrintOption.SaveHeaderFooterToXML(ANode: TXMLItem;
  HF: THeaderFooter);
begin
  // Сохранение хэдера и футера
  XmlAddIntegerParam(ANode, 'FrameTypes', FrameTypesToInt(HF.FrameTypes));
  XmlAddColorParam(ANode, 'LineColor', HF.LineColor);
  XmlAddBoolParam(ANode, 'MirrorPosition', HF.MirrorPosition);
  XmlAddBoolParam(ANode, 'RomanNumbers', HF.RomanNumbers);
  XmlAddColorParam(ANode, 'ShadedColor', HF.ShadedColor);
end;
 
procedure TSynEditPrintOption.LoadFromXML(AParentNode: TXMLItem);
begin
  inherited;
 
  // -------- Загрузка простых параметров -----------
  XmlAddColorParam(FNode,   'Color',               FSynEditPrint.Color);
  XmlAddBoolParam(FNode,    'Colors',              FSynEditPrint.Colors);
  XmlAddBoolParam(FNode,    'Highlight',           FSynEditPrint.Highlight);
  XmlAddBoolParam(FNode,    'LineNumbers',         FSynEditPrint.LineNumbers);
  XmlAddBoolParam(FNode,    'LineNumbersInMargin', FSynEditPrint.LineNumbersInMargin);
  XmlAddIntegerParam(FNode, 'LineOffset',          FSynEditPrint.LineOffset);
  XmlAddIntegerParam(FNode, 'PageOffset',          FSynEditPrint.PageOffset);
  XmlAddBoolParam(FNode,    'Wrap',                FSynEditPrint.Wrap);
 
  // ------- Загрузка составных параметров (TPersistent) ---------
  LoadHeaderFooterFromXML(FNode.NamedItem['Header'], FSynEditPrint.Header);   // Верний колонтитул
  LoadHeaderFooterFromXML(FNode.NamedItem['Footer'], FSynEditPrint.Footer); // Нижний колонтитул
  LoadMarginsFromXML(FNode.NamedItem['Margins'], FSynEditPrint.Margins); // Поля
end;
 
procedure TSynEditPrintOption.SaveToXML(AParentNode: TXMLItem);
var
  Temp: TXMLItem;
begin
  // Сохранение в XML
  inherited;
 
  // -------- Сохранение простых параметров -----------
  XmlAddColorParam(FNode, 'Color', FSynEditPrint.Color);
  XmlAddBoolParam(FNode, 'Colors', FSynEditPrint.Colors);
  XmlAddBoolParam(FNode, 'Highlight', FSynEditPrint.Highlight);
  XmlAddBoolParam(FNode, 'LineNumbers', FSynEditPrint.LineNumbers);
  XmlAddBoolParam(FNode, 'LineNumbersInMargin', FSynEditPrint.LineNumbersInMargin);
  XmlAddIntegerParam(FNode, 'LineOffset', FSynEditPrint.LineOffset);
  XmlAddIntegerParam(FNode, 'PageOffset', FSynEditPrint.PageOffset);
  XmlAddBoolParam(FNode, 'Wrap', FSynEditPrint.Wrap);
 
  // ------- Сохранение составных параметров (TPersistent) ---------
  // Верний колонтитул
  Temp:= FNode.New();
  Temp.Name:= 'Header';
  SaveHeaderFooterToXML(Temp, FSynEditPrint.Header);
 
  // Нижний колонтитул
  Temp:= FNode.New();
  Temp.Name:= 'Footer';
  SaveHeaderFooterToXML(Temp, FSynEditPrint.Footer);
 
  // Поля
  Temp:= FNode.New();
  Temp.Name:= 'Margins';
  SaveMarginsToXML(Temp, FSynEditPrint.Margins);
end;
 
{ TProgramSettings }
 
function TProgramSettings.AddOption(const AOption: TCustomOption): Integer;
begin
  // Добавление готовой опции
  FOptions.Add(AOption);
  Result:= Self.Count - 1; // Возращаю индекс добавленной опции
end;
 
constructor TProgramSettings.Create;
begin
  FOptions:= TObjectList.Create(True);
  CreateOptions(); // Создание опций
  FFileName:= ProgramDirectory + '\Settings.xml';
  if FileExists(FFileName)
    then LoadFromFile(FFileName);
end;
 
destructor TProgramSettings.Destroy;
begin
  SaveToFile(FFileName);
  FOptions.Free();
  inherited;
end;
 
function TProgramSettings.GetOption(const Index: Integer): TCustomOption;
begin
  // Чтение опции
  if IntegerInRange(Index, 0, Self.Count - 1)
    then Result:= TCustomOption(FOptions[Index])
    else Result:= nil;
end;
 
function TProgramSettings.GetOptionByName(
  const AName: string): TCustomOption;
var
  Index: Integer;
begin
  // Чтение опции по имени
  Result:= nil;
 
  for Index:= 0 to Self.Count - 1 do
    if Self[Index].Name = AName
      then begin
             Result:= Self[Index];
             Exit;
           end;
end;
 
function TProgramSettings.NewOption(const AType: TOptionType;
  const AGroupName, AName: string): TCustomOption;
begin
  // Создание новой опции
  Result:= nil;
 
  case AType of
    otBoolean:       Result:= TBooleanOption.Create(AType, AGroupName, AName);
    otInteger:       Result:= TIntegerOption.Create(AType, AGroupName, AName);
    otCardinal:      Result:= TCardinalOption.Create(AType, AGroupName, AName);
    otColor:         Result:= TColorOption.Create(AType, AGroupName, AName);
    otFloat:         Result:= TFloatOption.Create(AType, AGroupName, AName);
    otString:        Result:= TStringOption.Create(AType, AGroupName, AName);
    otText:          Result:= TTextOption.Create(AType, AGroupName, AName);
    otBooleanList:   Result:= TBooleanListOption.Create(AType, AGroupName, AName);
    otIntegerList:   Result:= TIntegerListOption.Create(AType, AGroupName, AName);
    otStringList:    Result:= TStringListOption.Create(AType, AGroupName, AName);
    otFont:          Result:= TFontOption.Create(AType, AGroupName, AName);
    otSynOptions:    Result:= TSynOptionsOption.Create(AType, AGroupName, AName);
    otSynEditPrint:  Result:= TSynEditPrintOption.Create(AType, AGroupName, AName);
  end; // case
 
  FOptions.Add(Result);
end;
 
function TProgramSettings.LoadFromFile(const AFileName: string): Boolean;
var
  Index: Integer;
  Parser: TECXMLParser;
  GroupItem: TXMLItem;
begin
  // Загрузка всех настроек
  Parser:= TECXMLParser.Create(nil);
  try
    // Загрузка файла
    try
      Parser.LoadFromFile(AFileName);
      Result:= True;
    except
      Result:= False;
      Application.MessageBox(PChar('Не могу прочитать файл настроек "' + AFileName + '".'),
                             PChar('Ошибка'),
                             MB_OK + MB_ICONERROR);
    end;
 
    // Загрузка настроек
    for Index:= 0 to Self.Count - 1 do
      begin
        GroupItem:= Parser.Root.NamedItem[Self[Index].GroupName];
        Self[Index].LoadFromXML(GroupItem);
      end;
  finally
    Parser.Free();
  end;
end;
 
function TProgramSettings.SaveToFile(const AFileName: string): Boolean;
var
  Index: Integer;
  Parser: TECXMLParser;
  GroupItem: TXMLItem;
begin
  // Сохранение всех настроек
  Parser:= TECXMLParser.Create(nil);
  try
    Parser.Root.Name:= 'SourceEditor_settings_file';
    XmlAddStringParam(Parser.Root, 'WARNING', 'Don''t edit!');
 
    // Сохранение настроек
    for Index:= 0 to Self.Count - 1 do
      begin
        GroupItem:= Parser.Root.NamedItem[Self[Index].GroupName];
        Self[Index].SaveToXML(GroupItem);
      end;
 
    // Сохранение файла
    try
      Parser.SaveToFile(AFileName);
      Result:= True;
    except
      Result:= False;
      Application.MessageBox(PChar('Не могу сохранить файл настроек "' + AFileName + '".'),
                             PChar('Ошибка'),
                             MB_OK + MB_ICONERROR);
    end;
  finally
    Parser.Free();
  end;
end;
 
function TProgramSettings.GetCount: Integer;
begin
  // Чтение количества опций
  Result:= FOptions.Count;
end;
 
procedure TProgramSettings.CreateOptions;
var
  Index: Integer;
begin
  //================== Создание опций ====================
 
  // ---------- Опции интерфейса ----------
  TBooleanOption(NewOption(otBoolean, sgInterface, snShowHints)).Value:= True;
  TBooleanOption(NewOption(otBoolean, sgInterface, snShowNotifications)).Value:= True;
  TBooleanOption(NewOption(otBoolean, sgInterface, snMinimizeToTray)).Value:= False;
  TBooleanOption(NewOption(otBoolean, sgInterface, snTabPosition)).Value:= False; // False - сверху
  TIntegerOption(NewOption(otInteger, sgInterface, snTabStyle)).Value:= 0; // 0 - Обычные вкладки
  TBooleanOption(NewOption(otBoolean, sgInterface, snRememberOpened)).Value:= True;
 
  // Опции дерева проектов
  TColorOption(NewOption(otColor, sgInterface, snProjectTreeColor)).Value:= clWindow;
  with TFontOption(NewOption(otFont, sgInterface, snProjectTreeFont)) do
    begin
      Font.Name:= 'Tahoma';
      Font.Size:= 8;
      Font.Color:= clWindowText;
    end;
  TIntegerOption(NewOption(otInteger, sgInterface, snProjectTreeSort)).Value:= 0; // Без сортировки (по умолчанию)
 
  // Опции часов
  TColorOption(NewOption(otColor, sgInterface, snClockForeground)).Value:= clYellow;
  TColorOption(NewOption(otColor, sgInterface, snClockBackground)).Value:= clBlack;
 
  // ----------- Опции редактора ----------
  // Опции редактирования
  NewOption(otSynOptions, sgTextEditor, snTextEditorOptions);
 
  // Цвета редактора
  TBooleanOption(NewOption(otBoolean, sgTextEditor, snUseSystemColors)).Value:= True;
 
  for Index:= 0 to High(snEditorColors) do
    with TColorOption(NewOption(otColor, sgTextEditor, snEditorColors[Index].Name)) do
      begin
        Value:=   snEditorColors[Index].Default;
        Caption:= snEditorColors[Index].Caption;
      end;
 
  // Другие опции
  TBooleanOption(NewOption(otBoolean, sgTextEditor, snShowGutter)).Value:= True; // Показывать полосу закладок
  TIntegerOption(NewOption(otInteger, sgTextEditor, snRightEdge)).Value:= 80; // 80 символов
  TIntegerOption(NewOption(otInteger, sgTextEditor, snTabWidth)).Value:= 8; // 8 символов
  with TFontOption(NewOption(otFont, sgTextEditor, snEditorFont)) do
    begin
      Font.Name:= 'Courier New';
      Font.Size:= 10;
      Font.Color:= clWindowText;
    end;
 
  // -------- Параметры автораспознавания кодировки ----------
  TBooleanOption(NewOption(otBoolean, sgAutoEncoding, snAutoEncodingEnabled)).Value:= True;
  TIntegerOption(NewOption(otInteger, sgAutoEncoding, snAutoEncodingDepth)).Value:= 128; // 128 строк файла
  TIntegerOption(NewOption(otInteger, sgAutoEncoding, snAutoEncodingEdge)).Value:= 5; // 5% - порог разницы для показа
ручного выбора кодировки
  TBooleanOption(NewOption(otBoolean, sgAutoEncoding, snAutoEncodingFlashStatus)).Value:= False; // Мигать статусбаром
 
  // Запоминание имён открытых проектов и файлов
  NewOption(otStringList, sgLastOpened, snOpenedProjects);
  NewOption(otStringList, sgLastOpened, snOpenedFiles);
 
  // Запомненные шаблоны поиска и замены
  NewOption(otStringList, sgSearchReplace, snSearchTemplates);
  NewOption(otStringList, sgSearchReplace, snReplaceTemplates);
 
  // Запомненные шаблоны поиска в файлах, маски и пути поиска
  NewOption(otStringList, sgSearchReplace, snSearchInFilesTemplates);
  NewOption(otStringList, sgSearchReplace, snSearchMasks);
  NewOption(otStringList, sgSearchReplace, snSearchPaths);
 
  // Настройки логотипа :)
  TColorOption(NewOption(otColor, sgLogo, snGradColor1)).Value:= clBlack;
  TColorOption(NewOption(otColor, sgLogo, snGradColor2)).Value:= clBlue;
  TIntegerOption(NewOption(otInteger, sgLogo, snGradType)).Value:= 1; // gsRadialC
  TIntegerOption(NewOption(otInteger, sgLogo, snGradShift)).Value:= 0; // Смещение -100...+100
 
  with TFontOption(NewOption(otFont, sgLogo, snLogoFont)) do
    begin
      Font.Name:= 'Times New Roman';
      Font.Size:= 32;
      Font.Style:= [fsBold];
      Font.Color:= clTeal;
    end;
 
  TIntegerOption(NewOption(otInteger, sgLogo, snLogoShadowPos)).Value:= 2; // spRightBottom
  TColorOption(NewOption(otColor, sgLogo, snLogoShadowColor)).Value:= clYellow;
  TIntegerOption(NewOption(otInteger, sgLogo, snLogoShadowSize)).Value:= 1;
 
  // Печать
  NewOption(otSynEditPrint, sgPrint, snSynEditPrintEngine);
 
  // Прочее
  NewOption(otStringList, sgOther, snLaunchPrograms);  // Программы для запуска файлов
  NewOption(otStringList, sgOther, snGotoLines);       // Номера строк переходов в окне "Перейти к строке"
  NewOption(otStringList, sgOther, snInsLinks);        // Ссылки и подсказки ссылок
  NewOption(otStringList, sgOther, snInsTitles);       // в окне "Вставка ссылки/картинки"
end;
 
 
end.

Ссылка на данный код:

На главную страницу сервиса обмена кодом »