unit Preferences;

{
[Preferences] [1.9]
Delphi 2005
January 2009


LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[preferences.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005-8 Martin Holmes 
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
  Written by Martin Holmes, October 2005 - March 2008.

  This unit and associated form constitutes a Preferences screen which allows
  the user to control aspects of the application environment such as the fonts
  used for display or editing, or the display of tooltips.

  The form can read and write data from the application GUI, and can also
  store and retrieve its settings from the Application Data folder. To do this
  it uses a TAppVersionInfo object. The components identified as used for
  editing in the GUI are restricted to TntUnicodeControls because none of
  my applications uses any non-Unicode controls for user data.

  The user can change settings and see the results using the Preview button;
  pressing OK applies the settings or confirms any already applied in preview,
  and pressing Cancel rolls back the app to the state it was in when the form
  was shown. The idea is to encourage the user to play with these settings
  without having to commit to them.

  To use this form, just make sure that in the main form's Show method, you
  call:

  ufrmPreferences.StoreOriginalAppRef;
  ufrmPreferences.ReadSettingsFromDisk;

   so that settings are read and applied
  (assuming they exist) after all application forms have been created.

  Dependencies:

 FormState (to save and reload form state, and also to use its AppDirPath
 property).

 TntUnicode libraries (Troy Wolbrink).
 XDOM_4_1 (Dieter Köhler)
 UniSynEdit (Maël Hörz)
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TntForms, FormState, StdCtrls, TntStdCtrls, mdhSpin, Buttons, TntButtons,
  TntComCtrls, TypInfo, VersionInfo, XDOM_4_1, Translate, mdhTranslate, IconsIncluder,
  jclUnicode, SynEdit, SynMemo;

type
  TufrmPreferences = class(TTntForm)
    ustAppFont: TTntStaticText;
    ucbAppFont: TTntComboBox;
    seAppFontSize: TmdhSpinEdit;
    ustAppFontPt: TTntStaticText;
    ustEditFontPt: TTntStaticText;
    seEditFontSize: TmdhSpinEdit;
    ucbEditFont: TTntComboBox;
    ustEditFont: TTntStaticText;
    ubnOK: TTntBitBtn;
    ubnCancel: TTntBitBtn;
    seTooltipSeconds: TmdhSpinEdit;
    DomImpl: TDomImplementation;
    XmlToDomParser: TXmlToDomParser;
    DomToXmlParser: TDomToXmlParser;
    ulbTooltipSeconds: TTntLabel;
    uedInterfaceFile: TTntEdit;
    ustInterfaceFile: TTntStaticText;
    usbOpenInterfaceFile: TTntSpeedButton;
    ucbReloadLastFileOnStartup: TTntCheckBox;
    ulbToolbarBtnSize: TTntLabel;
    ustToolbarSizePx: TTntStaticText;
    ucbToolbarBtnSize: TTntComboBox;
    ubnPreview: TTntBitBtn;
    usbClearInterfaceFile: TTntSpeedButton;
    procedure usbClearInterfaceFileClick(Sender: TObject);
    procedure ubnPreviewClick(Sender: TObject);
    procedure usbOp(Sender: TObject);
    procedure TntFormCreate(Sender: TObject);
    procedure ubnCancelClick(Sender: TObject);
    procedure ubnOKClick(Sender: TObject);
    procedure TntFormDestroy(Sender: TObject);
  private
{The following group of variables is used for storing a backup of the
original settings, so rollback can be achieved if the user cancels after
previewing changes.}
    wsBkFontName: WideString;
    intBkFontSize: integer;
    wsBkEditFontName: WideString;
    intBkEditFontSize: integer;
    intBkTooltipSeconds: integer;
    intBkBtnSize: integer;
    wsBkInterfaceFile: WideString;

    FFormStateSaver: TFormStateSaver;
    PrefsFileName: TFileName;
    OriginalAppRef: TAppReflection;
    BackupAppRef: TAppReflection; //used to allow reversion to original
                                  //interface without restarting the app.

    procedure CopySettingsFromBackupToForm;
    { Private declarations }
  public

    procedure ApplySettingsToApp;
    procedure ReadSettingsFromApp;
    procedure SaveSettingsToDisk;
    procedure ReadSettingsFromDisk;
{The following would typically be invoked by the main form when the
application has just started up, before loading any translation file.
It stores a copy of the hard-coded (English) strings, so these can be
restored without a restart, in a situation where the user deletes the
path to a translation file.}

    procedure StoreOriginalAppRef;
    { Public declarations }
  end;

var
  ufrmPreferences: TufrmPreferences;

const ToolbarPadding = 6;

implementation

{$R *.dfm}

procedure TufrmPreferences.ApplySettingsToApp;
var
F, C, Col, B: integer;
AppRef: TAppReflection;
strTBBtnSize: string;
TBBtnSize: integer;
TBHeight: integer;
LV: TTntListView;
prevCursor: integer;

begin
//This can take a while, so we should show a wait cursor.
  prevCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    for F := 0 to Screen.FormCount - 1 do
      begin
        Screen.Forms[F].Canvas.Lock;
  //Changing the form font alone should change all controls
        Screen.Forms[F].Font.Name := ucbAppFont.Items[ucbAppFont.ItemIndex];
        Screen.Forms[F].Font.Size := seAppFontSize.Value;
  //Now we have to check for edit boxes
        for C := 0 to Screen.Forms[F].ComponentCount - 1 do
          begin
            if (Screen.Forms[F].Components[C] is TTntEdit) then
              begin
                TTntEdit(Screen.Forms[F].Components[C]).Font.Name := ucbEditFont.Items[ucbEditFont.ItemIndex];
                TTntEdit(Screen.Forms[F].Components[C]).Font.Size := seEditFontSize.Value;
              end;
            if (Screen.Forms[F].Components[C] is TTntMemo) then
              begin
                TTntMemo(Screen.Forms[F].Components[C]).Font.Name := ucbEditFont.Items[ucbEditFont.ItemIndex];
                TTntMemo(Screen.Forms[F].Components[C]).Font.Size := seEditFontSize.Value;
              end;
  //Handle UniSynEdits.
            if (Screen.Forms[F].Components[C] is TSynMemo) then
              begin
                TSynMemo(Screen.Forms[F].Components[C]).Font.Name := ucbEditFont.Items[ucbEditFont.ItemIndex];
                TSynMemo(Screen.Forms[F].Components[C]).Font.Size := seEditFontSize.Value;
              end;
            if (Screen.Forms[F].Components[C] is TSynEdit) then
              begin
                TSynEdit(Screen.Forms[F].Components[C]).Font.Name := ucbEditFont.Items[ucbEditFont.ItemIndex];
                TSynEdit(Screen.Forms[F].Components[C]).Font.Size := seEditFontSize.Value;
              end;
            if (Screen.Forms[F].Components[C] is TTntComboBox) then
              begin
                TTntComboBox(Screen.Forms[F].Components[C]).Font.Name := ucbAppFont.Items[ucbAppFont.ItemIndex];
                TTntComboBox(Screen.Forms[F].Components[C]).Font.Size := seAppFontSize.Value;
              end;
            if (Screen.Forms[F].Components[C] is TTntListView) then
              begin
                  LV :=  TTntListView(Screen.Forms[F].Components[C]);
                  LV.Font.Size := seEditFontSize.Value;
                  LV.Font.Name := ucbEditFont.Items[ucbEditFont.ItemIndex];

  {We need a workaround for bug in TntListView column header painting.
  This might just be a bug in my own graphics driver, though; doesn't show up
  on some other machines. What happens is that when a font is larger than the
  default, the original lower border of the column headers is left painted,
  obscuring part of the text. This works around it.}
                  if LV.ShowColumnHeaders then
                    begin
                      LV.ShowColumnHeaders := False;
                      LV.Invalidate;
                      Application.ProcessMessages;
                      LV.ShowColumnHeaders := True;
                      LV.Invalidate;
                      Application.ProcessMessages;
                    end;

              end;
            if (Screen.Forms[F].Components[C] is TTntToolbar) then
              if Pos('Normal', TImageList(TTntToolbar(Screen.Forms[F].Components[C]).Images).Name) > 0 then
                begin
                  strTBBtnSize := ucbToolbarBtnSize.Items[ucbToolbarBtnSize.ItemIndex];
                  TBBtnSize := StrToInt(strTBBtnSize);
                  Application.ProcessMessages;
                  Case TBBtnSize of
                    16: begin
                          TTntToolbar(Screen.Forms[F].Components[C]).Images := IconsInc.il16_Normal;
                          TTntToolbar(Screen.Forms[F].Components[C]).HotImages := IconsInc.il16_Hot;
                          TTntToolbar(Screen.Forms[F].Components[C]).DisabledImages := IconsInc.il16_Disabled;
                        end;
                    24:  begin
                          TTntToolbar(Screen.Forms[F].Components[C]).Images := IconsInc.il24_Normal;
                          TTntToolbar(Screen.Forms[F].Components[C]).HotImages := IconsInc.il24_Hot;
                          TTntToolbar(Screen.Forms[F].Components[C]).DisabledImages := IconsInc.il24_Disabled;
                        end;
                    32: begin
                          TTntToolbar(Screen.Forms[F].Components[C]).Images := IconsInc.il32_Normal;
                          TTntToolbar(Screen.Forms[F].Components[C]).HotImages := IconsInc.il32_Hot;
                          TTntToolbar(Screen.Forms[F].Components[C]).DisabledImages := IconsInc.il32_Disabled;
                        end;
                    48: begin
                          TTntToolbar(Screen.Forms[F].Components[C]).Images := IconsInc.il48_Normal;
                          TTntToolbar(Screen.Forms[F].Components[C]).HotImages := IconsInc.il48_Hot;
                          TTntToolbar(Screen.Forms[F].Components[C]).DisabledImages := IconsInc.il48_Disabled;
                        end;
                  end;
                  TTntToolbar(Screen.Forms[F].Components[C]).Invalidate;
                  Application.ProcessMessages;
                  TTntToolbar(Screen.Forms[F].Components[C]).ButtonHeight := TBBtnSize + ToolbarPadding;
                  TTntToolbar(Screen.Forms[F].Components[C]).ButtonWidth := TBBtnSize + ToolbarPadding;
                  TTntToolbar(Screen.Forms[F].Components[C]).Wrapable := True;
                  TTntToolbar(Screen.Forms[F].Components[C]).Autosize := True;
    {              TTntToolbar(Screen.Forms[F].Components[C]).Height := TBBtnSize + (ToolbarPadding*2);
                  TTntToolbar(Screen.Forms[F].Components[C]).Wrapable := True;
                  TTntToolbar(Screen.Forms[F].Components[C]).Height :=
                      ((TBBtnSize + ToolbarPadding) *
                      TTntToolbar(Screen.Forms[F].Components[C]).RowCount);
                  ShowMessage(TTntToolbar(Screen.Forms[F].Components[C]).Name + ': ' +
                    IntToStr(TTntToolbar(Screen.Forms[F].Components[C]).RowCount) + ' rows');  }
                  TTntToolbar(Screen.Forms[F].Components[C]).Invalidate;
                  Application.ProcessMessages;
                end;
            if TComponent(Screen.Forms[F].Components[C]) is TControl then
              TControl(Screen.Forms[F].Components[C]).Invalidate;
            Application.ProcessMessages;
          end;
        Screen.Forms[F].Canvas.Unlock;
        Screen.Forms[F].Refresh;
      end;
  //Tooltip display time
    Application.HintHidePause := seTooltipSeconds.Value * 1000;
    if seTooltipSeconds.Value < 1 then
      Application.ShowHint := False
    else
      Application.ShowHint := True; 

  //Interface translation file
    if (Length(uedInterfaceFile.Text) > 0) and (FileExists(uedInterfaceFile.Text)) then
      begin
  //Create a backup first, which can be used for reversion without a restart
        BackupAppRef := TAppReflection.Create;
  //Now create an object for loading the data from disk
        AppRef := TAppReflection.Create;
        try
          AppRef.ReadFromXMLFile(uedInterfaceFile.Text);
          AppRef.WriteToGUI;
        finally
          AppRef.Free;
        end;
      end
    else
      begin
  //If there's nothing in there, but something was previously loaded, revert
        if (Length(WideTrim(uedInterfaceFile.Text))= 0) and (OriginalAppRef <> nil) then
          OriginalAppRef.WriteToGUI
        else
          if BackupAppRef <> nil then
            BackupAppRef.WriteToGUI;
      end;
  finally
    Screen.Cursor := prevCursor;
  end;
end;

procedure TufrmPreferences.ReadSettingsFromApp;
var
i: integer;
BtnSize: integer;

begin
//Change 18/11/08: best to avoid putting in fonts which begin with '@', since
//these are intended for vertical text.
//  ucbAppFont.Items.Assign(Screen.Fonts);
//  ucbEditFont.Items.Assign(Screen.Fonts);
  ucbAppFont.Items.Clear;
  ucbEditFont.Items.Clear;
  for i := 0 to Screen.Fonts.Count-1 do
    if not (Screen.Fonts[i][1] = '@') then
      begin
        ucbAppFont.Items.Add(Screen.Fonts[i]);
        ucbEditFont.Items.Add(Screen.Fonts[i]);
      end;
  if ucbAppFont.Items.IndexOf(Font.Name) > -1 then
    ucbAppFont.ItemIndex := ucbAppFont.Items.IndexOf(Font.Name);
  wsBkFontName := Font.Name;

  seAppFontSize.Value := Font.Size;
  intBkFontSize := Font.Size;

  if ucbEditFont.Items.IndexOf(ucbEditFont.Font.Name) > -1 then
    ucbEditFont.ItemIndex := ucbEditFont.Items.IndexOf(ucbEditFont.Font.Name);
  wsBkEditFontName := ucbEditFont.Font.Name;

  seEditFontSize.Value := ucbEditFont.Font.Size;
  intBkEditFontSize := ucbEditFont.Font.Size;

  seTooltipSeconds.Value := (Application.HintHidePause div 1000);
  intBkTooltipSeconds := (Application.HintHidePause div 1000);

//Find the value of the mainform toolbar height
  BtnSize := 24;
  intBkBtnSize := 24;

  for i := 0 to Application.MainForm.ComponentCount-1 do
    begin
      if TComponent(Application.MainForm.Components[i]) is TTntToolbar then
        begin
          BtnSize := TTntToolbar(Application.MainForm.Components[i]).Height - ToolbarPadding;
          intBkBtnSize := BtnSize;
          break;
        end;
    end;
  if ucbToolbarBtnSize.Items.IndexOf(WideString(IntToStr(BtnSize))) > -1 then
     ucbToolbarBtnSize.ItemIndex := ucbToolbarBtnSize.Items.IndexOf(WideString(IntToStr(BtnSize)))
  else
     ucbToolbarBtnSize.ItemIndex := 1; //default (24)

  wsBkInterfaceFile := uedInterfaceFile.Text;
end;

procedure TufrmPreferences.TntFormDestroy(Sender: TObject);
begin
  FreeAndNil(FFormStateSaver);
  if BackupAppRef <> nil then
    FreeAndNil(BackupAppRef);
  if OriginalAppRef <> nil then
    FreeAndNil(OriginalAppRef);
end;

procedure TufrmPreferences.ubnOKClick(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  try
    ApplySettingsToApp;
    SaveSettingsToDisk;
  finally
    Screen.Cursor := crDefault;
  end;
  Close;
end;

procedure TufrmPreferences.ubnCancelClick(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  try
    CopySettingsFromBackupToForm;
    ApplySettingsToApp;
  finally
    Screen.Cursor := crDefault;
  end;
  Close;
end;

procedure TufrmPreferences.TntFormCreate(Sender: TObject);
begin
  Icon := Application.Icon;
  FFormStateSaver := TFormStateSaver.Create(Self, True, True, True, True,
                                            False, True, True, True, False);
  PrefsFileName := TFileName(FFormStateSaver.AppDirPath + '\' + 'ufrmPreferences_settings.xml');
  ReadSettingsFromApp; //get current settings, and also back them up
  BackupAppRef := nil;
  OriginalAppRef := nil;
end;

procedure TufrmPreferences.ReadSettingsFromDisk;
var
Doc: TDomDocument;
NodeIterator: TDomNodeIterator;
Node: TDomNode;

  procedure ReadComboElement(Node: TDomElement);
  var
  Name: WideString;
  TargetComp: TComponent;

  begin
    Name := Node.GetAttributeNormalizedValue('name');
    if Length(Name) < 1 then
      Exit;
    TargetComp := FindComponent(Name);
    if TargetComp <> nil then
      if TargetComp is TTntComboBox then
        with TTntComboBox(TargetComp) do
          ItemIndex := Items.IndexOf(Node.TextContent);
  end;

  procedure ReadSpinEditElement(Node: TDomElement);
  var
  Name: WideString;
  TargetComp: TComponent;

  begin
    Name := Node.GetAttributeNormalizedValue('name');
    if Length(Name) < 1 then
      Exit;
    TargetComp := FindComponent(Name);
    if TargetComp <> nil then
      if TargetComp is TmdhSpinEdit then
        with TmdhSpinEdit(TargetComp) do
          Value := StrToIntDef(Node.TextContent, Value);
  end;

  procedure ReadEditElement(Node: TDomElement);
  var
  Name: WideString;
  TargetComp: TComponent;

  begin
    Name := Node.GetAttributeNormalizedValue('name');
    if Length(Name) < 1 then
      Exit;
    TargetComp := FindComponent(Name);
    if TargetComp <> nil then
      if TargetComp is TTntEdit then
        with TTntEdit(TargetComp) do
          Text := Node.TextContent;
  end;

  procedure ReadCheckBoxElement(Node: TDomElement);
  var
  Name: WideString;
  TargetComp: TComponent;

  begin
    Name := Node.GetAttributeNormalizedValue('name');
    if Length(Name) < 1 then
      Exit;
    TargetComp := FindComponent(Name);
    if TargetComp <> nil then
      if TargetComp is TTntCheckBox then
        with TTntCheckBox(TargetComp) do
          Checked := StrToBool(Node.TextContent);
  end;

begin
  if not FileExists(PrefsFileName) then
    Exit;
  Doc := XMLToDomParser.ParseFile(PrefsFileName, False);
  NodeIterator := Doc.CreateNodeIterator(Doc.DocumentElement, [ntElement_Node], nil, True);
  Node := NodeIterator.NextNode;
  while Node <> nil do
    begin
      if Node.NodeName = 'TTntComboBox' then
        ReadComboElement(TDomElement(Node));
      if Node.NodeName = 'TmdhSpinEdit' then
        ReadSpinEditElement(TDomElement(Node));
      if Node.NodeName = 'TTntEdit' then
        ReadEditElement(TDomElement(Node));
      if Node.NodeName = 'TTntCheckBox' then
        ReadCheckBoxElement(TDomElement(Node));
      Node := NodeIterator.NextNode;
    end;
  ApplySettingsToApp;
end;

procedure TufrmPreferences.SaveSettingsToDisk;
var
Doc: TDomDocument;
TextNode: TDomText;
Stream: TFileStream;
i: integer;
Root: TDomElement;

  function BuildComboElement(SourceComp: TTntComboBox): TDomElement;
  begin
    Result := TDomElement.Create(Doc, 'TTntComboBox');
    Result.SetAttribute('name', TTntComboBox(SourceComp).Name);
    TextNode := TDomText.Create(Doc);
    TextNode.AppendData(TTntComboBox(SourceComp).Items[TTntComboBox(SourceComp).ItemIndex]);
    Result.AppendChild(TextNode);
  end;

  function BuildSpinEditElement(SourceComp: TmdhSpinEdit): TDomElement;
  begin
    Result := TDomElement.Create(Doc, 'TmdhSpinEdit');
    Result.SetAttribute('name', TmdhSpinEdit(SourceComp).Name);
    TextNode := TDomText.Create(Doc);
    TextNode.AppendData(IntToStr(TmdhSpinEdit(SourceComp).Value));
    Result.AppendChild(TextNode);
  end;

  function BuildEditElement(SourceComp: TTntEdit): TDomElement;
  begin
    Result := TDomElement.Create(Doc, 'TTntEdit');
    Result.SetAttribute('name', TTntEdit(SourceComp).Name);
    TextNode := TDomText.Create(Doc);
    TextNode.AppendData(TTntEdit(SourceComp).Text);
    Result.AppendChild(TextNode);
  end;

  function BuildCheckBoxElement(SourceComp: TTntCheckBox): TDomElement;
  begin
    Result := TDomElement.Create(Doc, 'TTntCheckBox');
    Result.SetAttribute('name', TTntCheckBox(SourceComp).Name);
    TextNode := TDomText.Create(Doc);
    TextNode.AppendData(BoolToStr(TTntCheckBox(SourceComp).Checked));
    Result.AppendChild(TextNode);
  end;

begin
  Doc := TDomDocument.Create(DomImpl);
  Root := TDomElement.Create(Doc, 'preferences');
  Doc.AppendChild(Root);
  for i := 0 to ComponentCount - 1 do
    begin
      if Components[i] is TTntComboBox then
        Root.AppendChild(BuildComboElement(TTntComboBox(Components[i])));
      if Components[i] is TmdhSpinEdit then
        Root.AppendChild(BuildSpinEditElement(TmdhSpinEdit(Components[i])));
      if Components[i] is TTntEdit then
        Root.AppendChild(BuildEditElement(TTntEdit(Components[i])));
      if Components[i] is TTntCheckBox then
        Root.AppendChild(BuildCheckBoxElement(TTntCheckBox(Components[i])));
    end;


  Stream := TFileStream.Create(PrefsFileName, fmCreate);
  try
    DomToXMLParser.WriteToStream(Doc, 'UTF-8', Stream);
  finally
    Stream.Free;
  end;

end;

procedure TufrmPreferences.usbOp(Sender: TObject);
begin
  if ufrmTranslate.udlgLoadTranslation.Execute then
    uedInterfaceFile.Text := ufrmTranslate.udlgLoadTranslation.FileName;
end;

procedure TufrmPreferences.CopySettingsFromBackupToForm;
begin
  ucbAppFont.ItemIndex := ucbAppFont.Items.IndexOf(wsBkFontName);

  seAppFontSize.Value := intBkFontSize;

  ucbEditFont.ItemIndex := ucbEditFont.Items.IndexOf(wsBkEditFontName);

  seEditFontSize.Value := intBkEditFontSize;

  seTooltipSeconds.Value := intBkTooltipSeconds;

  if ucbToolbarBtnSize.Items.IndexOf(WideString(IntToStr(intBkBtnSize))) > -1 then
     ucbToolbarBtnSize.ItemIndex := ucbToolbarBtnSize.Items.IndexOf(WideString(IntToStr(intBkBtnSize)))
  else
     ucbToolbarBtnSize.ItemIndex := 1; //default (24)

  uedInterfaceFile.Text := wsBkInterfaceFile;
end;

procedure TufrmPreferences.ubnPreviewClick(Sender: TObject);
begin
  ApplySettingsToApp;
end;

procedure TufrmPreferences.usbClearInterfaceFileClick(Sender: TObject);
begin
  uedInterfaceFile.Text := '';
end;

procedure TufrmPreferences.StoreOriginalAppRef;
begin
  OriginalAppRef := TAppReflection.Create;
end;

end.
