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.