/// 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) 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)
  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.
