/// General Options setting dialog for mORmot // - this unit is a part of the freeware Synopse mORMot framework, // licensed under a MPL/GPL/LGPL tri-license; version 1.18 unit mORMotUIOptions; (* This file is part of Synopse mORMot framework. Synopse mORMot framework. Copyright (C) 2020 Arnaud Bouchez Synopse Informatique - https://synopse.info *** BEGIN LICENSE BLOCK ***** Version: MPL 1.1/GPL 2.0/LGPL 2.1 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 Synopse mORMot framework. The Initial Developer of the Original Code is Arnaud Bouchez. Portions created by the Initial Developer are Copyright (C) 2020 the Initial Developer. All Rights Reserved. Contributor(s): Alternatively, the contents of this file may be used under the terms of either the GNU General Public License Version 2 or later (the "GPL"), or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which case the provisions of the GPL or the LGPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of either the GPL or the LGPL, and not to allow others to use your version of this file under the terms of the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL or the LGPL. If you do not delete the provisions above, a recipient may use your version of this file under the terms of any one of the MPL, the GPL or the LGPL. ***** END LICENSE BLOCK ***** Version 1.4 - February 8, 2010 - whole Synopse SQLite3 database framework released under the GNU Lesser General Public License version 3, instead of generic "Public Domain" Version 1.5 - February 17, 2010 - allow to hide some nodes/pages, depending of User level e.g. - add toolbar buttons per user customization Version 1.9 - some code refactoring to share code with the new SQLite3UIEdit unit - minor fixes and enhancements Version 1.13 - Delphi 2009/2010/XE compatibility fixes Version 1.15 - Get rid of TMS components dependency Version 1.18 - renamed SQLite3UIOptions.pas to mORMotUIOptions.pas *) interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, SynCommons, mORMot, mORMotUILogin, mORMotUI, mORMotUIEdit, mORMotToolBar, mORMoti18n, {$ifdef USETMSPACK} TaskDialog, {$endif} StdCtrls, ExtCtrls, ComCtrls, SynTaskDialog; type /// Options setting dialog // - the settings parameters are taken from the RTTI of supplied objects: // all the user interface is created from the code definition of classes; // a visual tree node will reflect the properties recursion, and published // properties are displayed as editing components // - published textual properties may be defined as generic RawUTF8 or // as generic string (with some possible encoding issue prior to Delphi 2009) // - caller must initialize some events, OnComponentCreate at least, // in order to supply the objects to be added on the form // - components creation is fully customizable by some events TOptionsForm = class(TRTTIForm) List: TTreeView; procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ListClick(Sender: TObject); procedure BtnSaveClick(Sender: TObject); protected /// every char is a bit index for a tkInt64 TCheckBox fAddToolbar: RawByteString; procedure SubButtonClick(Sender: TObject); // avoid Windows Vista and Seven screen refresh bug (at least with Delphi 7) procedure WMUser(var Msg: TMessage); message WM_USER; public BtnSave: TSynButton; BtnCancel: TSynButton; /// creator may define this property to force a particular node to // be selected at form showing SelectedNodeObjectOnShow: TObject; /// create corresponding nodes and components for updating Obj // - to be used by OnComponentCreate(nil,nil,OptionsForm) in order // to populate the object tree of this Form // - properties which name starts by '_' are not added to the UI window // - published properties of parents of Obj are also added function AddEditors(Node: TTreeNode; Obj: TObject; const aCustomCaption: string=''; const aTitle: string=''): TTreeNode; /// create corresponding checkboxes lists for a given action toolbar // - aEnum points to the Action RTTI // - aActionHints is a multi line value containing the Hint captions // for all available Actions // - if aActionsBits is not nil, its bits indicates the Buttons to // appear in the list procedure AddToolbars(Scroll: TScrollBox; const aToolbarName: string; aEnum: PTypeInfo; const aActionHints: string; aActionsBits: pointer; aProp: PPropInfo; Obj: TObject); end; implementation {$R *.dfm} procedure TOptionsForm.FormShow(Sender: TObject); var i, n: integer; Name: string; begin Application.ProcessMessages; Screen.Cursor := crHourGlass; try if not Assigned(OnComponentCreate) then begin // nothing to modify ModalResult := mrCancel; // code implementation error -> cancel exit; end; OnComponentCreate(nil,nil,self); // will call AddEditors() List.FullCollapse; List.TopItem.Expand(false); // show main sub nodes if List.Items.Count<>0 then begin n := List.Items.Count-1; // select the last entered item by default if SelectedNodeObjectOnShow<>nil then begin Name := CaptionName(OnCaptionName,'',SelectedNodeObjectOnShow); for i := 0 to n do if SameText(List.Items[i].Text,Name) then begin n := i; break; end; end; List.Selected := List.Items[n]; end; SetStyle(self); finally Screen.Cursor := crDefault; end; PostMessage(Handle,WM_USER,0,0); // avoid Vista and Seven screen refresh bug end; procedure TOptionsForm.FormCreate(Sender: TObject); begin BtnSave := TSynButton.CreateKind(Self,cbRetry,312,432,100,41); BtnSave.SetBitmap(BitmapOK); BtnSave.Font.Style := [fsBold]; BtnSave.Caption := sSave; BtnSave.OnClick := BtnSaveClick; BtnSave.Anchors := [akRight, akBottom]; BtnCancel := TSynButton.CreateKind(Self,cbCancel,424,432,100,41); BtnCancel.Anchors := [akRight, akBottom]; end; procedure TOptionsForm.FormClose(Sender: TObject; var Action: TCloseAction); var i: integer; begin for i := 0 to List.Items.Count-1 do TScrollBox(List.Items[i].Data).Free; List.Items.Clear; end; const /// X coordinates of the field content (left side must be used for caption) AddEditorsX=200; function TOptionsForm.AddEditors(Node: TTreeNode; Obj: TObject; const aCustomCaption, aTitle: string): TTreeNode; var i, j, CW: integer; P: PPropInfo; E: PEnumType; EP: PShortString; C: TWinControl; CLE: TLabeledEdit absolute C; CNE: TSynLabeledEdit absolute C; CC: TCheckbox absolute C; CB: TCombobox absolute C; aCaption, SubCaption, CustomCaption: string; Scroll: TScrollBox; O: TObject; aClassType: TClass; procedure AddEditor(Obj: TObject; Index: integer); begin if OnComponentCreate(Obj,nil,nil)<>nil then exit; // ignore this Object with TSynButton.Create(Scroll) do begin Parent := Scroll; Scroll.Tag := Scroll.Tag+4; SetBounds(AddEditorsX,Scroll.Tag,140,20); Caption := CaptionName(OnCaptionName,'',Obj,Index); Tag := PtrInt(AddEditors(result,Obj,Caption,SubCaption)); OnClick := SubButtonClick; Scroll.Tag := Scroll.Tag+24; end; end; begin if (self=nil) or (Obj=nil) or not Assigned(OnComponentCreate) then exit; Scroll := TScrollBox.Create(self); Scroll.Parent := self; Scroll.Visible := false; Scroll.SetBounds(List.Width,0,ClientWidth-List.Width,List.Height); Scroll.Anchors := [akLeft,akTop,akRight,akBottom]; CW := Scroll.ClientWidth; if aCustomCaption='' then CustomCaption := CaptionName(OnCaptionName,'',Obj) else CustomCaption := aCustomCaption; if Node=nil then SubCaption := '' else if aTitle='' then SubCaption := CustomCaption else SubCaption := aTitle+' - '+CustomCaption; result := List.Items.AddChild(Node,CustomCaption); result.Data := pointer(Scroll); with TLabel.Create(Scroll) do begin Parent := Scroll; Font.Style := [fsBold]; Font.Size := 12; Left := 32; Top := 8; if SubCaption='' then Caption := CustomCaption else Caption := SubCaption; end; with TBevel.Create(Scroll) do begin Parent := Scroll; SetBounds(8,32,CW-32,4); Shape := bsTopLine; end; Scroll.Tag := 48; aClassType := PPointer(Obj)^; while (aClassType<>nil) and (aClassType<>TComponent) and // TComponent have Name and Tag to be ignored (aClassType<>TObject) do begin // TObject don't have any published properties for i := 1 to InternalClassPropInfo(aClassType,P) do if P^.Name[1]<>'_' then begin // ignore properties which name starts by _ aCaption := CaptionName(OnCaptionName,ShortStringToUTF8(P^.Name)); if not Assigned(OnComponentCreate) then C := nil else C := OnComponentCreate(Obj,P,Scroll); if C=nil then // default creation if not handled by OnComponentCreate() case P^.PropType^^.Kind of tkInteger: begin CNE := TSynLabeledEdit.Create(Scroll); CNE.Kind := sleInteger; CNE.Value := P^.GetOrdValue(Obj); CNE.RaiseExceptionOnError := true; // force show errors on screen end; tkEnumeration: if (P^.PropType^=TypeInfo(boolean)) then begin CC := TCheckBox.Create(Scroll); CC.Checked := boolean(P^.GetOrdValue(Obj)); end else begin E := P^.PropType^^.EnumBaseType; CB := TComboBox.Create(Scroll); CB.Parent := Scroll; // need parent now for CB.Items access CB.Style := csDropDownList; EP := @E^.NameList; for j := 0 to E^.MaxValue do begin CB.Items.Add(CaptionName(OnCaptionName,EP)); inc(PtrInt(EP),ord(EP^[0])+1); // next enumeration item end; CB.ItemIndex := P^.GetOrdValue(Obj); end; tkLString: begin CLE := TLabeledEdit.Create(Scroll); if P^.PropType^=TypeInfo(RawUTF8) then CLE.Text := U2S(P^.GetLongStrValue(Obj)) else CLE.Text := P^.GetGenericStringValue(Obj); end; {$ifdef HASVARUSTRING} tkUString: begin CLE := TLabeledEdit.Create(Scroll); CLE.Text := P^.GetUnicodeStrValue(Obj); end; {$endif} tkClass: begin O := P^.GetObjProp(Obj); if (O<>nil) and (PtrInt(O)<>-1) then if O.InheritsFrom(TCollection) then with TCollection(O) do for j := 0 to Count-1 do AddEditor(Items[j],j) else AddEditor(O,-1); end; end; if (C<>nil) and (C<>self) and (C<>Obj) then begin C.Parent := Scroll; C.Tag := PtrInt(P); // for BtnSaveClick() event if Assigned(OnComponentCreated) then OnComponentCreated(Obj,P,C); if C.InheritsFrom(TLabeledEdit) then begin CLE.EditLabel.Caption := aCaption; CLE.LabelPosition := lpLeft; end else with TLabel.Create(Scroll) do begin Parent := Scroll; Caption := aCaption; SetBounds(8,Scroll.Tag+4,AddEditorsX-12,Height); Alignment := taRightJustify; if not C.Enabled then Enabled := false; end; if C.InheritsFrom(TCheckBox) then // trick to avoid black around box CC.SetBounds(AddEditorsX,Scroll.Tag+5,13,13) else C.SetBounds(AddEditorsX,Scroll.Tag,160,22); Scroll.Tag := Scroll.Tag+24; end; P := P^.Next; end; aClassType := aClassType.ClassParent; // also add parents properties end; with TBevel.Create(Scroll) do begin // draw a line at the bottom Parent := Scroll; SetBounds(8,Scroll.Tag+8,CW-32,16); Shape := bsTopLine; end; Scroll.Tag := PtrInt(Obj); // for BtnSaveClick() end; procedure TOptionsForm.AddToolbars(Scroll: TScrollBox; const aToolbarName: string; aEnum: PTypeInfo; const aActionHints: string; aActionsBits: pointer; aProp: PPropInfo; Obj: TObject); var W: integer; A: integer; E: PEnumType; V: Int64; begin if (Self=nil) or (Scroll=nil) or (aEnum=nil) or (aProp=nil) then exit; if aProp^.PropType^^.Kind<>tkInt64 then exit; W := Scroll.Width-128; Scroll.Tag := Scroll.Tag+12; with TLabel.Create(Scroll) do begin Parent := Scroll; Font.Style := [fsBold]; Caption := aToolbarName; SetBounds(32,Scroll.Tag,W,22); // Scroll.Tag = current Y in this scrollbox end; Scroll.Tag := Scroll.Tag+24; E := aEnum^.EnumBaseType; assert(E^.MaxValue<64); // Value is a Int64 (i.e. max 64 actions) for A := 0 to E^.MaxValue do if (aActionsBits=nil) or GetBitPtr(aActionsBits,A) then begin with TCheckBox.Create(Scroll) do begin Parent := Scroll; Hint := GetCSVItemString(pointer(aActionHints),A,#13); ShowHint := true; Caption := E^.GetCaption(A); SetBounds(64,Scroll.Tag,W,16); V := aProp^.GetInt64Value(Obj); fAddToolbar := fAddToolbar+AnsiChar(A); // every char is a bit index Checked := GetBitPtr(@V,A); Tag := PtrInt(aProp); // for BtnSaveClick() event end; Scroll.Tag := Scroll.Tag+16; end; end; procedure TOptionsForm.ListClick(Sender: TObject); var i: integer; S,N: TTreeNode; begin S := List.Selected; if S=nil then exit; for i := 0 to List.Items.Count-1 do begin N := List.Items[i]; if N<>S then TScrollBox(N.Data).Hide; end; with TScrollBox(S.Data) do begin Show; for i := 0 to ControlCount-1 do Controls[i].Repaint; // avoid Vista and Seven screen refresh bug end; end; procedure TOptionsForm.SubButtonClick(Sender: TObject); begin if TSynButton(Sender).Tag=0 then exit; List.Select(TTreeNode(TSynButton(Sender).Tag)); ListClick(nil); end; procedure TOptionsForm.BtnSaveClick(Sender: TObject); var i, j, Index, IndexSorted, ToolbarIndex: integer; P: PPropInfo; Scroll: TScrollBox; Obj: TObject; C: TControl; CLE: TLabeledEdit absolute C; CNE: TSynLabeledEdit absolute C; CC: TCheckbox absolute C; CB: TCombobox absolute C; ToolbarValue: Int64; begin // update the properties of the settings object from screen ToolbarIndex := 0; for i := 0 to List.Items.Count-1 do begin Scroll := TScrollBox(List.Items[i].Data); if Scroll=nil then continue; Obj := pointer(Scroll.Tag); // get corresponding Object to update properties if Obj=nil then continue; for j := 0 to Scroll.ControlCount-1 do begin C := Scroll.Controls[j]; if not C.Enabled then continue; // disabled components didn't modify their value P := pointer(C.Tag); // get corresponding PPropInfo if P=nil then continue; // not a value component (label or button) if C.InheritsFrom(TSynLabeledEdit) then try P^.SetOrdValue(Obj,CNE.Value); // call CNE.GetValue for range checking except on E: ESynLabeledEdit do begin // triggered by CNE.GetValue List.Selected := List.Items[i]; // focus corresponding scroll ListClick(nil); Application.ProcessMessages; CNE.SetFocus; // focus corresponding field ShowMessage(CNE.EditLabel.Caption+':'#13+E.Message,true); exit; end; end else if C.InheritsFrom(TLabeledEdit) then {$ifdef HASVARUSTRING} if P^.PropType^^.Kind=tkUString then P^.SetUnicodeStrValue(Obj,CLE.Text) else {$endif} if P^.PropType^=TypeInfo(RawUTF8) then P^.SetLongStrValue(Obj,S2U(CLE.Text)) else P^.SetGenericStringValue(Obj,CLE.Text) else if C.InheritsFrom(TCheckBox) then if P^.PropType^^.Kind=tkInt64 then begin // created by AddToolbars() method -> set bit if checked inc(ToolbarIndex); // follows the same order as in AddToolbars() if ToolbarIndex<=length(fAddToolbar) then begin ToolbarValue := P^.GetInt64Value(Obj); if CC.Checked then SetBit64(ToolbarValue,ord(fAddToolbar[ToolbarIndex])) else UnsetBit64(ToolbarValue,ord(fAddToolbar[ToolbarIndex])); P^.SetInt64Prop(Obj,ToolbarValue); end; end else P^.SetOrdValue(Obj,integer(CC.Checked)) else if C.InheritsFrom(TComboBox) then if P^.PropType^^.Kind=tkLString then begin // don't store index but string value P^.SetLongStrValue(Obj,S2U(CB.Text)); end else begin Index := CB.ItemIndex; // store index value if Index>=0 then begin IndexSorted := PtrInt(CB.Items.Objects[Index]); if IndexSorted<>0 then // Objects[] = original index+1 (if sorted) Index := IndexSorted-1; // store raw index, before sort P^.SetOrdValue(Obj,Index); end; end; end; end; ModalResult := mrOk; // close window if all OK end; procedure TOptionsForm.WMUser(var Msg: TMessage); begin // avoid Vista and Seven screen refresh bug ListClick(nil); end; end.