mORMot Open Source

{
    This file is part of the Free Pascal run time library.
  (EDITED / TRUNCATED)

  TSQLMenus = class(TSQLRecord)
  protected
    fTable: RawUTF8;
    fCustomCaption: PResStringRec;
    fCustomHint: PResStringRec;
    fSelect: RawUTF8;
    fSQLWhere : RawUTF8;
    fGroup: integer;
    fOrdre : integer;
    fFieldWidth: RawUTF8;
    fFieldAlign: RawUTF8;
    fShowID: boolean;
    fOrderFieldIndex: integer;
    fReverseOrder: boolean;
    fLayout: TSQLListLayout;
    fListWidth: integer;
    fNoReport: boolean;
    fAutoRefresh: boolean;
    fEditFieldHints: PResStringRec;
    fEditExpandFieldHints: boolean;
    fEditFieldNameWidth: integer;
    fEditFieldNameToHideCSV: RawUTF8;
    fEditFieldHintsToReport: boolean;
    fVisible : boolean;
  published
    property TableName: RawUTF8 read fTable write fTable;
    property Selection: RawUTF8 read fSelect write fSelect;
    property SQLWhere : RawUTF8 read fSQLWhere write fSQLWhere;
    property Groupe: integer read fGroup write fGroup;
    property Ordre : integer read fOrdre write fOrdre;
    property FieldWidth: RawUTF8 read fFieldWidth write fFieldWidth;
    property FieldAlign: RawUTF8 read fFieldAlign write fFieldAlign;
    property ShowID: boolean read fShowID write fShowID;
    property OrderFieldIndex: integer read fOrderFieldIndex write fOrderFieldIndex;
    property ReverseOrder: boolean read fReverseOrder write fReverseOrder;
    property Layout: TSQLListLayout read fLayout write fLayout;
    property ListWidth: integer read fListWidth write fListWidth;
    property NoReport: boolean read fNoReport write fNoReport;
    property AutoRefresh: boolean read fAutoRefresh write fAutoRefresh;
    property EditExpandFieldHints: boolean read fEditExpandFieldHints write fEditExpandFieldHints;
    property EditFieldNameWidth: integer read fEditFieldNameWidth write fEditFieldNameWidth;
    property EditFieldNameToHideCSV: RawUTF8 read fEditFieldNameToHideCSV write fEditFieldNameToHideCSV;
    property EditFieldHintsToReport: boolean read fEditFieldHintsToReport write fEditFieldHintsToReport;   
    property Visible : boolean read fVisible write fVisible;
  public
    property Operation : TRecOper read fOperation write fOperation;
  end;

var globalClient: TSQLHttpClient;
     globalModel: TSQLModel;

function CopyFromFileTabs:boolean;
var i : integer;
begin
  result := false;
  SetLength(menuTabs, length(FileTabs));
  for i:=Low(FileTabs) to high(FileTabs) do
  begin
    menuTabs[i].Table    := FileTabs[i].Table;
    menuTabs[i].Select   := FileTabs[i].Select;
    menuTabs[i].SQLWhere := FileTabs[i].SQLWhere;
    menuTabs[i].Group    := FileTabs[i].Group;
    menuTabs[i].FieldWidth := FileTabs[i].FieldWidth;
    menuTabs[i].FieldAlign := FileTabs[i].FieldAlign;
    menuTabs[i].ShowID     := FileTabs[i].ShowID;
    menuTabs[i].OrderFieldIndex := FileTabs[i].OrderFieldIndex;
    menuTabs[i].ReverseOrder := FileTabs[i].ReverseOrder;
    menuTabs[i].Layout       := FileTabs[i].Layout;
    menuTabs[i].ListWidth    := FileTabs[i].ListWidth;
    menuTabs[i].NoReport     := FileTabs[i].NoReport;
    menuTabs[i].AutoRefresh  := FileTabs[i].AutoRefresh;
  end;
  result := True;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var menuTabs : array of TFileRibbonTabParameters;
     menu : TSQLMenus;
begin

  try
    menu := TSQLMenus.CreateAndFillPrepare(globalParam, 'visible=? order by ordre', [True]);
    while menu.FillOne do
    begin
      SetLength(menuTabs, length(menuTabs)+1);
      with menuTabs[high(menuTabs)] do
      begin
        Table := globalModel.Table[menu.TableName];
        Select := menu.Selection;
        SQLWhere := menu.SQLWhere;
        FieldWidth := menu.FieldWidth;
        FieldAlign := menu.FieldAlign;
        Group      := menu.Groupe;
        ShowID     := menu.ShowID;
        OrderFieldIndex := menu.OrderFieldIndex;
        ReverseOrder    := menu.ReverseOrder;
        Layout          := menu.Layout;
        ListWidth       := menu.ListWidth;
        NoReport        := menu.NoReport;
        AutoRefresh     := menu.AutoRefresh;
      end;
    end;
  finally
    menu.Free;
  end;

  LoadImageListFromEmbeddedZip(ImgListe32,'buttons.bmp');
  ImageListStretch(ImgListe32,ImgList16);
  if length(menutabs) = 0 then
  begin
    if CopyFromFileTabs then
      Ribbon := TSQLRibbon.Create(self, nil, nil, ImgListe32, ImgList16,
      globalClient, ALL_ACCESS_RIGHTS, ValueText, globalClient.OnSetAction, sFileActionsToolbar,
      sFileActionsHints, nil, ActionClick, integer(faRefresh), 1, false,
      length(menutabs), @menutabs[0], sizeof(menutabs[0]),
      sFileTabsGroup, ',BannerData,BannerSafe',true)
    else
    Ribbon := TSQLRibbon.Create(self, nil, nil, ImgListe32, ImgList16,
        globalClient, ALL_ACCESS_RIGHTS, ValueText, globalClient.OnSetAction, sFileActionsToolbar,
        sFileActionsHints, nil, ActionClick, integer(faRefresh), 1, false,
        length(FileTabs), @FileTabs[0], sizeof(FileTabs[0]),
        sFileTabsGroup, ',BannerData,BannerSafe',true);
  end
  else
    Ribbon := TSQLRibbon.Create(self, nil, nil, ImgListe32, ImgList16,
      globalClient, ALL_ACCESS_RIGHTS, ValueText, globalClient.OnSetAction, sFileActionsToolbar,
      sFileActionsHints, nil, ActionClick, integer(faRefresh), 1, false,
      length(menutabs), @menutabs[0], sizeof(menutabs[0]),
      sFileTabsGroup, ',BannerData,BannerSafe',true);

  Ribbon.ToolBar.Caption.Caption := Caption;
  Ribbon.ToolBar.HelpButton.OnClick := HelpClick;
  for P := 0 to high(Ribbon.Page) do
    with Ribbon.Page[P] do
      if Lister<>nil then
      begin
        Lister.Grid.OnDblClick := ListDblClick;
      end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var menu : TSQLMenus;
    i : integer;
    old : boolean;
    Results: TIntegerDynArray;
begin

  try
    menu := TSQLMenus.Create();
    if globalClient.TransactionBegin(TSQLMenus, 20) then
    try
      if globalClient.BatchStart(TSQLMenus) then
      begin
        for i:=low(menuTabs) to high(menuTabs) do
        begin
          old := False;
          menu.FillPrepare(globalParam, 'TableName=?', [menuTabs[i].Table.SQLTableName]);
          old := menu.FillOne;

          menu.TableName  := menuTabs[i].Table.SQLTableName;
          menu.Selection  := menuTabs[i].Select;
          menu.SQLWhere   := menuTabs[i].SQLWhere;
          menu.Groupe     := menuTabs[i].Group;
          menu.Ordre      := i;
          menu.FieldWidth := menuTabs[i].FieldWidth;
          menu.FieldAlign := menuTabs[i].FieldAlign;
          menu.ShowID     := menuTabs[i].ShowID;
          menu.OrderFieldIndex := menuTabs[i].OrderFieldIndex;
          menu.ReverseOrder := menuTabs[i].ReverseOrder;
          menu.Layout       := menuTabs[i].Layout;
          menu.ListWidth    := menuTabs[i].ListWidth;
          menu.NoReport     := menuTabs[i].NoReport;
          menu.AutoRefresh  := menuTabs[i].AutoRefresh;
          menu.Visible      := True;
          if not old then
            globalClient.Add(menu, True)
          else
            globalClient.Update(menu);
        end;
        globalClient.BatchSend(Results);
      end;
      globalClient.Commit(0);
    except
      globalClient.RollBack(0);
    end;
  finally
    menu.Free;
  end;
end;

  TSQLEtat = class(TSQLRecord)
  private
    fLibelle : RawUTF8;
    fFiche : RawUTF8;
    fEtat : TSQLRawBlob;
  published
    property ManCode : RawUTF8 index 10 read fManCode write fManCode stored AS_UNIQUE;
    property Fiche : RawUTF8 index 20 read fFiche write fFiche;
    property Etat : TSQLRawBlob read fEtat write fEtat;
  end;  

  
function TF_Etat.frxDesigner1SaveReport(Report: TfrxReport;
  SaveAs: Boolean): Boolean;
var Stream: TRawByteStringStream;
  fEtat : TSQLEtat;
begin
  try
    fEtat := TSQLEtat.Create;
    Stream := TRawByteStringStream.Create;
    Stream.Position := 0;
    Report.SaveToStream(Stream);
    Stream.seek(0,soBeginning);
    fEtat.Etat := S2U(Stream.DataString);
    globalClient.Add(fetat, true);
  finally
      fEtat.Free;
    Stream.Free;  
  end;
end;  

function TF_Etat.LoadFromStream():boolean;
var Stream : TMemoryStream;
begin
  if not globalClient.RetrieveBlobFields(fEtat) then
  begin
    result := False;
    exit;
  end
  else
    result := True;
  try
    Stream := TMemoryStream.Create;
    WriteStringToStream(Stream, fEtat.Etat);
    if (Stream.Size > 0) and (fEtat.Etat <> '') then
    begin
      Stream.Position := 0;
      frxReport.LoadFromStream(Stream);
      frxReport.ShowReport();
    end
    else
      result := False;
  finally
    Stream.Free;
  end;
end;