unit foBafHistory;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// for showing the history of a data row

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, uBafPage, uBafInterpreter, System.Math;

type
  TfrmBafHistory = class(TForm)
    pnlDesk: TPanel;
    btnClose: TButton;
    PanelGrid: TPanel;
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    FSegment: TBafPageSegment;
    FInter: TBafInterpreter;
    FNoShowList: TStringList;
    FBafConName: string;
    procedure Init;
    procedure History;
    procedure InterNeedCommand(AInter: TBafInterpreter; AName: string; ACode: TStrings);
    procedure InterLog(AInter: TBafInterpreter; ALogType, ALogText: string);
    procedure InterNeedInfo(AInter: TBafInterpreter; AName, AParam: string; var AInfo: string);
    function GetHistSql: string;
    function GetHistCon: string;
    function GetHistTable: string;
    function GetHistMemoFieldname: string;
  public
    class procedure ShowSegment(ASegment: TBafPageSegment);
    destructor Destroy; override;
  end;



implementation

{$R *.fmx}

uses foMain, uBafInterpreterModuleList, dmMain, uBafTypes, uBafFmxUtils;

var
  mvInter: integer;

{ TfrmBafHistory }

procedure TfrmBafHistory.btnCloseClick(Sender: TObject);
begin
  Close;
end;

destructor TfrmBafHistory.Destroy;
begin
  FNoShowList.Free;
  FInter.Free;
  inherited;
end;

procedure TfrmBafHistory.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BafFormPos2Ini(Self, dataMain.UserIni, CAT_HIST);
  dataMain.UserIni.UpdateFile;
end;

procedure TfrmBafHistory.FormCreate(Sender: TObject);
begin
  BafIni2FormPos(Self, dataMain.UserIni, CAT_HIST, 10, 10, 1000, 700);
end;

function TfrmBafHistory.GetHistCon: string;
begin
  result := FBafConName;
  if result = '' then
    result := FSegment.BafConName[0];
  if result = '' then
    result := DC_DEFAULT;
end;

function TfrmBafHistory.GetHistMemoFieldname: string;
var
  LLinkSeg: TBafPageSegment;
begin
  if FSegment.SegmentType = stMemo then begin
    if Assigned(FSegment.LinkedCell) then begin
      LLinkSeg := FSegment.LinkedCell.Parents.Segment;
      case LLinkSeg.SegmentType of
        stValueList: result := FSegment.LinkedCell.DataFieldName;
        stGrid: result := FSegment.LinkedCell.Parents.Column.CellFieldName;
      end;
    end
    else
      result := 'ctext';
  end;
end;

function TfrmBafHistory.GetHistSql: string;
var
  LCell, LCell2: TBafSgCell;
  LTableName, LKeyName, LKeyValue, LBafConName: string;

  procedure lokXXGrid;
  var
    i, x, xx, qx: integer;
    LColumn: TBafSgColumn;
  begin
    LCell := FSegment.Grid.GetSelectedCell;
    if Assigned(LCell) then begin
      qx := LCell.Parents.Column.CellDataQIndex;
      if qx = 0 then begin
        LTableName := FSegment.DataTable[0];
        LKeyName := FSegment.DataKey[0];
        x := LCell.Parents.Column.XGridIndex;
        xx := LCell.Parents.Column.XXGridIndex;
        if (x >= 0) and (xx >= 0) then begin
          for i := LCell.Parents.Column.Index downto 0 do begin
            LColumn := FSegment.Grid.Columns.Items[i];
            if (x > LColumn.XGridIndex) or (xx > LColumn.XXGridIndex) then
              exit;
            if AnsiCompareText(LColumn.CellFieldName, FSegment.DataKey[0]) = 0 then begin
              LKeyValue := LCell.Parents.Row.Cells[i].Text;
              exit;
            end;
          end;
        end;
      end
//      else begin
//        LTableName := FSegment.DataTable[qx];
//        LKeyName := FSegment.DataKey[qx];
//        for i := 0 to FSegment.Grid.Columns.Count - 1 do begin
//          if FSegment.Grid.Columns.Items[i].CellFieldName = LKeyName then begin
//            LCell2 := LCell.Parents.Row.Cells[i];
//            LKeyValue := LCell2.Text;
//            LKeyName := LCell2.Parents.Column.CellYFieldName;
//            exit;
//          end;
//        end;
//      end;
    end;
  end; // procedure lokXXGrid

  procedure lokXGrid;
  var
    i, x, qx: integer;
    LColumn: TBafSgColumn;
  begin
    LCell := FSegment.Grid.GetSelectedCell;
    if Assigned(LCell) then begin
      qx := LCell.Parents.Column.CellDataQIndex;
      if qx = 0 then begin
        LTableName := FSegment.DataTable[0];
        LKeyName := FSegment.DataKey[0];
        x := LCell.Parents.Column.XGridIndex;
        if x >= 0 then begin
          for i := LCell.Parents.Column.Index downto 0 do begin
            LColumn := FSegment.Grid.Columns.Items[i];
            if (x > LColumn.XGridIndex) then
              exit;
            if AnsiCompareText(LColumn.CellFieldName, FSegment.DataKey[0]) = 0 then begin
              LKeyValue := LCell.Parents.Row.Cells[i].Text;
              exit;
            end;
          end;
        end;
        LKeyName := FSegment.DataKey[0];
      end
      else begin
        LTableName := FSegment.DataTable[qx];
        LKeyName := FSegment.DataKey[qx];
        for i := 0 to FSegment.Grid.Columns.Count - 1 do begin
          if FSegment.Grid.Columns.Items[i].CellFieldName = LKeyName then begin
            LCell2 := LCell.Parents.Row.Cells[i];
            LKeyValue := LCell2.Text;
            LKeyName := LCell2.Parents.Column.CellYFieldName;
            exit;
          end;
        end;
      end;
    end;
  end; // procedure lokXGrid

  procedure lokGrid;
  var
    i, ix: integer;
  begin
    LKeyName := FSegment.DataKey[0];
    LCell := FSegment.Grid.GetSelectedCell;
    if Assigned(LCell) then begin
      ix := LCell.Parents.Column.CellDataQIndex;
      LTableName := FSegment.DataTable[ix];
      LKeyName := FSegment.DataKey[ix];
      LBafConName := FSegment.BafConName[ix];
      for i := 0 to FSegment.Grid.Columns.Count - 1 do begin
        if FSegment.Grid.Columns.Items[i].CellFieldName = LKeyName then begin
          LCell2 := LCell.Parents.Row.Cells[i];
          LKeyValue := LCell2.Text;
          LKeyName := LCell2.Parents.Column.CellYFieldName;
          exit;
        end;
      end;
    end;
  end;

  procedure lokVL;
  var
    ix: integer;
  begin
    LCell := FSegment.Grid.GetSelectedCell;
    ix := 0;
    if Assigned(LCell) then
      ix := LCell.DataQIndex;
    LTableName := FSegment.DataTable[ix];
    LKeyName := FSegment.Grid.GetVlCellIndexFieldName(ix);
    LKeyValue := FSegment.Grid.GetVlCellText(LKeyName);
  end;

  procedure lokMemo;
  var
    i, ix: integer;
    LLinkSeg: TBafPageSegment;
  begin
    if Assigned(FSegment.LinkedCell) then begin
      LLinkSeg := FSegment.LinkedCell.Parents.Segment;
      case LLinkSeg.SegmentType of
        stValueList: begin
          ix := FSegment.LinkedCell.DataQIndex;
          LTableName := LLinkSeg.DataTable[ix];
          LKeyName := LLinkSeg.DataKey[ix];
          LKeyValue := LLinkSeg.Grid.GetVlCellText(LKeyName);
        end;
        stGrid: begin
          ix := FSegment.LinkedCell.Parents.Column.CellDataQIndex;
          LTableName := LLinkSeg.DataTable[ix];
          LKeyName := LLinkSeg.DataKey[ix];
          for i := 0 to LLinkSeg.Grid.Columns.Count - 1 do begin
            if LLinkSeg.Grid.Columns.Items[i].CellFieldName = LKeyName then begin
              LKeyValue := FSegment.LinkedCell.Parents.Row.Cells[i].Text;
              exit;
            end;
          end;
        end;
      end;
    end
    else begin
      dataMain.GetDataMemoHistTable(LTableName, LKeyName);
      LKeyValue := FSegment.DataKeyValue;
    end;
  end; // procedure lokMemo

begin
  case FSegment.SegmentType of
    stValueList: lokVL;
    stGrid: lokGrid;
    stXGrid: lokXGrid;
    stXXGrid: lokXXGrid;
    stMemo: lokMemo;
  else
    exit;
  end;
//  if (LTableName <> '') and (LKeyName <> '') and (LKeyValue <> '') then
  if LBafConName = '' then
    FSegment.BafConName[0];
  FBafConName := LBafConName;
  if (LTableName <> '') and (LKeyName <> '') then
    result := dataMain.GetHistSqlStatement(LBafConName, LTableName, LKeyName, LKeyValue);
// function TfrmBafHistory.GetHistSql
end;

function TfrmBafHistory.GetHistTable: string;
var
  LCell: TBafSgCell;
  ix: integer;

  procedure lokMemo;
  var
    ix: integer;
    LLinkSeg: TBafPageSegment;
    s: string;
  begin
    if Assigned(FSegment.LinkedCell) then begin
      LLinkSeg := FSegment.LinkedCell.Parents.Segment;
      case LLinkSeg.SegmentType of
        stValueList: begin
          ix := FSegment.LinkedCell.DataQIndex;
          result := LLinkSeg.DataTable[ix];
        end;
        stGrid: begin
          ix := FSegment.LinkedCell.Parents.Column.CellDataQIndex;
          result := LLinkSeg.DataTable[ix];
        end;
      end;
    end
    else
      dataMain.GetDataMemoHistTable(result, s);
  end; // procedure lokMemo

begin
  case FSegment.SegmentType of
    stValueList: begin
      LCell := FSegment.Grid.GetSelectedCell;
      ix := 0;
      if Assigned(LCell) then
        ix := LCell.DataQIndex;
      result := FSegment.DataTable[ix];
    end;
    stGrid: begin
      LCell := FSegment.Grid.GetSelectedCell;
      if Assigned(LCell) then begin
        ix := LCell.Parents.Column.CellDataQIndex;
        result := FSegment.DataTable[ix];
      end;
    end;
    stXGrid: FSegment.DataTable[0];
    stMemo: lokMemo;
  end;
end;

procedure TfrmBafHistory.History;
var
  i: integer;
begin
  case FSegment.SegmentType of
    stGrid, stXGrid, stXXGrid: begin
      FNoShowList.Text := FSegment.HistoryNoShowFields.Text;
      for i := 0 to FSegment.Grid.Columns.Count - 1 do begin
        if not FSegment.Grid.Columns.Items[i].CellVisible then
          FNoShowList.Add(FSegment.Grid.Columns.Items[i].CellFieldName);
      end;
      if (FSegment.Grid.SelectedCol >= 0)
        and (FSegment.Grid.SelectedRow >= 0) then
          FInter.Execute('_history_grid')
      else begin
        FSegment.Grid.SelectedCol := 0;
        FSegment.Grid.SelectedRow := 0;
        FInter.Execute('_history_grid');
      end;
    end;
    stValueList: begin
      FNoShowList.Text := FSegment.HistoryNoShowFields.Text;
      FInter.Execute('_history_grid');
    end;
    stMemo: FInter.Execute('_history_memo');
  end;

end;

procedure TfrmBafHistory.Init;
begin
  inc(mvInter);
  FInter := TBafInterpreter.Create(itSrvProc);
  FInter.Inter := FInter;
  FInter.Name := 'I' + IntToStr(mvInter);
  FInter.OnNeedCommand := InterNeedCommand;
  FInter.OnNeedInfo := InterNeedInfo;
  FInter.OnLog := InterLog;
  FInter.ParentPanel := PanelGrid;
  TBafInterpreterModuleList.CreateModule(FInter);
  FNoShowList := TStringList.Create;
  FBafConName := '';
end;

procedure TfrmBafHistory.InterLog(AInter: TBafInterpreter; ALogType,
  ALogText: string);
begin
//
end;

procedure TfrmBafHistory.InterNeedCommand(AInter: TBafInterpreter;
  AName: string; ACode: TStrings);
begin
  AName := AnsiLowerCase(AName);
  if not dataMain.GetCommand(AName, ACode) then
    InterLog(nil, 'E', 'Kommando nicht gefunden: ' + AName);
end;

procedure TfrmBafHistory.InterNeedInfo(AInter: TBafInterpreter; AName,
  AParam: string; var AInfo: string);
begin
  AName := AnsiLowerCase(AName);
  if AName = 'usrid' then AInfo := dataMain.UserGuid
  else if AName = 'rightusrid' then AInfo := dataMain.RightUserId
  else if AName = 'root' then AInfo := dataMain.Root
  else if AName = 'usrroot' then AInfo := dataMain.UserRoot
  else if AName = 'usrini' then AInfo := dataMain.UserIni.ReadString(CAT_USRDATA, AParam, '')
  else if AName = 'ini' then AInfo := dataMain.Ini.ReadString(CAT_DATA, AParam, '')
  else if AName = 'histsql' then AInfo := GetHistSql
  else if AName = 'histcon' then AInfo := GetHistCon
  else if AName = 'histtable' then AInfo := GetHistTable
  else if AName = 'histmemofield' then AInfo := GetHistMemoFieldname
  else if AName = 'noshowlist' then AInfo := FNoShowList.Text
  ;
end;

class procedure TfrmBafHistory.ShowSegment(ASegment: TBafPageSegment);
var
  frmBafHistory: TfrmBafHistory;
begin
  frmBafHistory := TfrmBafHistory.Create(Application);
  try
    frmBafHistory.FSegment := ASegment;
    if frmMain.Scale > 0.45 then begin
      frmBafHistory.pnlDesk.Scale.X := frmMain.Scale;
      frmBafHistory.pnlDesk.Scale.Y := frmMain.Scale;
    end;
    frmBafHistory.pnlDesk.RecalcSize;
    frmBafHistory.Init;
    frmBafHistory.History;
    frmBafHistory.ShowModal;
  finally
    frmBafHistory.Free;
  end;
end;

end.
