{********************************************************************}
{                                                                    }
{ written by TMS Software                                            }
{            copyright © 2013 - 2014                                 }
{            Email : info@tmssoftware.com                            }
{            Web : http://www.tmssoftware.com                        }
{                                                                    }
{ The source code is given as is. The author is not responsible      }
{ for any possible damage done due to the use of this code.          }
{ The complete source code remains property of the author and may    }
{ not be distributed, published, given or sold in any form as such.  }
{ No parts of the source code can be included in any other component }
{ or application without written authorization of the author.        }
{********************************************************************}

unit FMX.TMSGrid;

interface

{$I TMSDEFS.INC}

uses
  FMX.Dialogs, Classes, Types, FMX.TMSCustomGrid, FMX.TMSGridOptions, FMX.TMSGridData, FMX.TMSBaseControl,
  FMX.Types, SysUtils, FMX.Edit, UITypes
  ,Data.Bind.Components, Data.Bind.Grid, Data.Bind.DBScope, Data.DB, Data.Bind.Consts, FMX.TMSGridCell
  ,Generics.Collections
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  ;

type
  TColumnDescObject = class(TObject)
  private
    FColumnDesc: TCreateColumnDescription;
  public
    property ColumnDesc: TCreateColumnDescription read FColumnDesc write FColumnDesc;
  end;
  TBlobFieldProtected = class(TBlobField);

  TColumnDescList = class(TObjectList<TColumnDescObject>);

  TTMSFMXGridFormatCellDataExpression = procedure(Sender: TObject; AColumnDescription: TCreateColumnDescription; AColumn: Integer; var AFormat: String) of object;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXGrid = class(TTMSFMXCustomGrid)
  private
    FInternalCell: TCell;
    FColumnDescList: TColumnDescList;
    FSaveDataSetData: Boolean;
    FOnFormatCellDataExpression: TTMSFMXGridFormatCellDataExpression;
    function GetColumnIndex: Integer;
    function GetSelected: Integer;
    procedure SetColumnIndex(const Value: Integer);
    procedure SetSelected(const Value: Integer);
    function GetItemIndex: Integer;
    procedure SetItemIndex(const Value: Integer);
  protected
    procedure AssignBitmapEx(Source, Dest: TPersistent); override;
    function CanObserve(const ID: Integer): Boolean; override;
    procedure ObserverAdded(const ID: Integer; const Observer: IObserver); override;
    procedure ObserverToggle(const AObserver: IObserver; const Value: Boolean);
    function ObserverCurrent: TVarRec;
  public
    property ColumnDescList: TColumnDescList read FColumnDescList write FColumnDescList;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoGetCellReadOnly(ACol, ARow: Integer; var AReadOnly: Boolean); override;
    procedure DoCanInsertRow(ARow: Integer; var Allow: Boolean); override;
    procedure DoCanDeleteRow(ARow: Integer; var Allow: Boolean); override;
    procedure DoGetCellEditorType(ACol, ARow: Integer; var CellEditorType: TTMSFMXGridEditorType); override;
    procedure DoGetCellLayout(ACol, ARow: Integer;
      ALayout: TTMSFMXGridCellLayout; ACellState: TCellState); override;
    procedure DoGetCellProperties(ACol, ARow: Integer;
      Cell: TFmxObject); override;
    procedure DoCellCheckBoxClick(ACol, ARow: Integer; Cell: TFMXObject); override;
    procedure DoCellEditGetData(ACol, ARow: Integer; CellEditor: TFMXObject; var CellString: String); override;
    procedure CellEditKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
    procedure DoCellEditDone(ACol, ARow: Integer; CellEditor: TFMXObject); override;
    procedure SelectCell(Cell: TCell; Shift: TShiftState = []; MouseDragging: Boolean = False); override;
    procedure NotifyObserver;
    procedure NotifyObserverStartEdit;
    procedure NotifyObserverStopEdit;
    procedure NotifyObserverCheckClick(ACol, ARow: Integer);
    property Selected: Integer read GetSelected write SetSelected;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property ColumnIndex: Integer read GetColumnIndex write SetColumnIndex;
    property SaveDataSetData: Boolean read FSaveDataSetData write FSaveDataSetData;
  published
    property Columns;
    property OnFormatCellDataExpression: TTMSFMXGridFormatCellDataExpression read FOnFormatCellDataExpression write FOnFormatCellDataExpression;
  end;

implementation

{ TTMSFMXGrid }

procedure TTMSFMXGrid.AssignBitmapEx(Source, Dest: TPersistent);
var
  bf: TBlobField;
  bt: TBitmap;
  s: TMemoryStream;
  sig: word;
  b: byte;
  oletype: integer;
  oleoffset: integer;
  i: Integer;
  size: TPointF;
begin
  bf := nil;
  bt := nil;
  if Assigned(Source) and ((Source is TBlobField) or (Source is TGraphicField)) then
    bf := Source as TBlobField;

  if Assigned(Dest) and (Dest is TBitmap) then
    bt := Dest as TBitmap;

  if Assigned(bf) and Assigned(bt) then
  begin
    if (bf.GraphicHeader) then
    begin
      if (bf.BlobType = ftBlob) or (bf.BlobType = ftGraphic) then
      begin
        size.X := 0;
        size.Y := 0;

        s := TMemoryStream.Create;
        try
          bf.SaveToStream(S);
          s.Position := 0;

          oletype := -1;
          oleoffset := 0;

          if s.Size > 2 then
          begin
            S.Position := 0;
            S.Read(sig, 2);

            case sig of
              $1C15: // OLE storage
              begin
                i := 0;
                while (i < 512) do
                begin
                  S.Read(b, 1);
                  inc(i);
                  if (b = $FF) then
                  begin
                    S.Read(b, 1);
                    inc(i);
                    if b = $D8 then
                    begin
                      oletype := 1;
                      oleoffset := i;
                      break;
                    end
                  end;
                  if (b = 137) then
                  begin
                    S.Read(b, 1);
                    inc(i);
                    if b = 80 then
                    begin
                      oletype := 3;
                      oleoffset := i;
                      break;
                    end;
                  end;
                  if (b = $47) then
                  begin
                    S.Read(b, 1);
                    inc(i);
                    if b = $49 then
                    begin
                      oletype := 2;
                      oleoffset := i;
                      break;
                    end;
                  end;
                  if (b = ord('B')) then
                  begin
                    S.Read(b, 1);
                    inc(i);
                    if (b = ord('M')) then
                    begin
                      oletype := 0;
                      oleoffset := i;
                      Break;
                    end;
                  end;
                end;

                S.Seek(oleoffset, 0);

                case oletype of
                  0, 1, 2, 3: bt.LoadFromStream(S);
                end;
              end;
              $4947, $D8FF:
              begin
               S.Position := 0;
               bt.LoadFromStream(S);
              end;
            end;
          end;
          FreeAndNil(S);
        except
          if (S <> nil) then
            FreeAndNil(S);
        end;
      end;
    end;
  end;
end;

function TTMSFMXGrid.CanObserve(const ID: Integer): Boolean;
begin
  Result := False;
  if ID = TObserverMapping.EditGridLinkID then
    Result := True
  else if ID = TObserverMapping.PositionLinkID then
    Result := True;
end;

procedure TTMSFMXGrid.CellEditKeyDown(Sender: TObject; var Key: Word;
  var KeyChar: WideChar; Shift: TShiftState);
var
  c: Integer;
  obj: TColumnDescObject;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
begin
  if ColumnDescList.Count = 0 then
  begin
    inherited;
    Exit;
  end;

  if Key <> vkEscape then
  begin
    inherited;
    c := ColumnIndex;
    if (c >= 0) and (c <= ColumnDescList.Count - 1) then
    begin
      obj := TColumnDescObject(ColumnDescList.Items[c]);
      if Assigned(obj) then
      begin
        dts := obj.ColumnDesc.DataSource;
        if Assigned(dts) then
        begin
          if dts is TCustomBindSourceDB then
          begin
            ds := (dts as TCustomBindSourceDB).DataSet;
            if Assigned(ds) then
            begin
              BlockUpdate := True;
              if not (ds.State = dsEdit) then
                NotifyObserverStartEdit;
              BlockUpdate := False;
            end;
          end;
        end;
      end;
    end;
  end
  else
  begin
    if Options.Editing.AutoCancel then
    begin
      c := ColumnIndex;
      if (c >= 0) and (c <= ColumnDescList.Count - 1) then
      begin
        obj := TColumnDescObject(ColumnDescList.Items[c]);
        if Assigned(obj) then
        begin
          dts := obj.ColumnDesc.DataSource;
          if Assigned(dts) then
          begin
            if dts is TCustomBindSourceDB then
            begin
              ds := (dts as TCustomBindSourceDB).DataSet;
              if Assigned(ds) then
              begin
                BlockUpdate := True;
                ds.Cancel;
                BlockUpdate := False;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

constructor TTMSFMXGrid.Create(AOwner: TComponent);
begin
  inherited;
  FColumnDescList := TColumnDescList.Create;
  FInternalCell.Col := -1;
  FInternalCell.Row := -1;
end;

destructor TTMSFMXGrid.Destroy;
begin
  FColumnDescList.Free;
  inherited;
end;

procedure TTMSFMXGrid.DoCellEditDone(ACol, ARow: Integer;
  CellEditor: TFMXObject);
var
  c: Integer;
  obj: TColumnDescObject;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
begin
  inherited;

  NotifyObserverStopEdit;
  if Options.Editing.AutoPost = apCell then
  begin
    c := ColumnIndex;
    if (c >= 0) and (c <= ColumnDescList.Count - 1) then
    begin
      obj := TColumnDescObject(ColumnDescList.Items[c]);
      if Assigned(obj) then
      begin
        dts := obj.ColumnDesc.DataSource;
        if Assigned(dts) then
        begin
          if dts is TCustomBindSourceDB then
          begin
            ds := (dts as TCustomBindSourceDB).DataSet;
            if Assigned(ds) then
            begin
              BlockUpdate := True;
              if ds.State = dsEdit then
                ds.Post;
              BlockUpdate := False;
            end;
          end;
        end;
      end;
    end;
  end;

end;

procedure TTMSFMXGrid.DoCellEditGetData(ACol, ARow: Integer;
  CellEditor: TFMXObject; var CellString: String);
var
  c: Integer;
  obj: TColumnDescObject;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
begin
  inherited;

  if not (CellEditor is TEdit) then
  begin
    c := ColumnIndex;
    if (c >= 0) and (c <= ColumnDescList.Count - 1) then
    begin
      obj := TColumnDescObject(ColumnDescList.Items[c]);
      if Assigned(obj) then
      begin
        dts := obj.ColumnDesc.DataSource;
        if Assigned(dts) then
        begin
          if dts is TCustomBindSourceDB then
          begin
            ds := (dts as TCustomBindSourceDB).DataSet;
            if Assigned(ds) then
            begin
              BlockUpdate := True;
              ds.Edit;
              BlockUpdate := False;
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure TTMSFMXGrid.DoCellCheckBoxClick(ACol, ARow: Integer; Cell: TFMXObject);
begin
  inherited;
  NotifyObserverCheckClick(ACol, ARow);
end;


procedure TTMSFMXGrid.DoGetCellReadOnly(ACol, ARow: Integer; var AReadOnly: Boolean);
var
  obj: TColumnDescObject;
begin
  if (ACol >= 0) and (ACol <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[ACol - FixedColumns]);
    if Assigned(obj) then
      AReadOnly := obj.ColumnDesc.ReadOnly or (obj.ColumnDesc.MemberType = mtBoolean);
  end;
  inherited;
end;

procedure TTMSFMXGrid.DoCanInsertRow(ARow: Integer; var Allow: Boolean);
var
  c: Integer;
  obj: TColumnDescObject;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
begin
  inherited;
  c := ColumnIndex;
  if (c >= 0) and (c <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[c]);
    if Assigned(obj) then
    begin
      dts := obj.ColumnDesc.DataSource;
      if Assigned(dts) then
      begin
        if dts is TCustomBindSourceDB then
        begin
          ds := (dts as TCustomBindSourceDB).DataSet;
          if Assigned(ds) then
          begin
            Allow := False;
            ds.Insert;
          end;
        end;
      end;
    end;
  end;
end;

procedure TTMSFMXGrid.DoCanDeleteRow(ARow: Integer; var Allow: Boolean);
var
  c: Integer;
  obj: TColumnDescObject;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
begin
  inherited;
  c := ColumnIndex;
  if (c >= 0) and (c <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[c]);
    if Assigned(obj) then
    begin
      dts := obj.ColumnDesc.DataSource;
      if Assigned(dts) then
      begin
        if dts is TCustomBindSourceDB then
        begin
          ds := (dts as TCustomBindSourceDB).DataSet;
          if Assigned(ds) then
          begin
            Allow := False;
            if MessageDlg(TranslateText(SDeleteRecordQuestion), TMsgDlgType.mtConfirmation, mbOKCancel, 0) = mrOk then
              ds.Delete;
          end;
        end;
      end;
    end;
  end;
end;

procedure TTMSFMXGrid.DoGetCellLayout(ACol: Integer; ARow: Integer; ALayout: TTMSFMXGridCellLayout; ACellState: TCellState);
var
  obj: TColumnDescObject;
  c: Integer;
begin
  c := ACol - FixedColumns;
  if (c >= 0) and (c <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[c]);
    if Assigned(obj) then
    begin
      case obj.ColumnDesc.MemberType of
        mtMemo:
        begin
          ALayout.WordWrapping := True;
          {$IFDEF DELPHIXE6_LVL}
          ALayout.VerticalTextAlign := TTextAlign.Leading;
          {$ELSE}
          ALayout.VerticalTextAlign := TTextAlign.taLeading;
          {$ENDIF}
        end;
      end;
    end;
  end;
  inherited;
end;

procedure TTMSFMXGrid.DoGetCellProperties(ACol: Integer; ARow: Integer; Cell: TFmxObject);
var
  obj: TColumnDescObject;
  c: Integer;
begin
  c := ACol - FixedColumns;
  if (c >= 0) and (c <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[c]);
    if Assigned(obj) then
    begin
      if Cell is TTMSFMXBitmapGridCell then
        {$IFDEF DELPHIXE6_LVL}
        (Cell as TTMSFMXBitmapGridCell).Bitmap.Align := TAlignLayout.Client;
        {$ELSE}
        (Cell as TTMSFMXBitmapGridCell).Bitmap.Align := TAlignLayout.alClient;
        {$ENDIF}
    end;
  end;
  inherited;
end;

procedure TTMSFMXGrid.DoGetCellEditorType(ACol, ARow: Integer;
  var CellEditorType: TTMSFMXGridEditorType);
var
  obj: TColumnDescObject;
  c: Integer;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
  ft: TField;
begin
  if (ACol >= 0) and (ACol <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[ACol - FixedColumns]);
    if Assigned(obj) then
    begin
      case obj.ColumnDesc.MemberType of
        mtUnknown:;
        mtBitmap:;
        mtMemo:;
        mtInteger: CellEditorType := etNumericEdit;
        mtFloat: CellEditorType := etFloatEdit;
        mtBoolean:;
        mtBCD: ;
        mtUInteger: CellEditorType := etNumericEdit;
        mtDateTime: CellEditorType := etDatePicker;
        mtCurrency: CellEditorType := etMoneyEdit;
        mtObject: ;
        mtVariant: ;
      end;
    end;
  end;

  c := ColumnIndex;
  if (c >= 0) and (c <= ColumnDescList.Count - 1) then
  begin
    obj := TColumnDescObject(ColumnDescList.Items[c]);
    if Assigned(obj) then
    begin
      dts := obj.ColumnDesc.DataSource;
      if Assigned(dts) then
      begin
        if dts is TCustomBindSourceDB then
        begin
          ds := (dts as TCustomBindSourceDB).DataSet;
          if Assigned(ds) then
          begin
            ft := ds.FieldByName(obj.ColumnDesc.MemberName);
            if Assigned(ft) then
            begin
              case ft.FieldKind of
                fkData: ;
                fkCalculated: ;
                fkLookup: CellEditorType := etComboBox;
                fkInternalCalc: ;
                fkAggregate: ;
              end;
            end;
          end;
        end;
      end;
    end;
  end;

  inherited;
end;

function TTMSFMXGrid.GetColumnIndex: Integer;
begin
  Result := FocusedCell.Col - FixedColumns;
end;

function TTMSFMXGrid.GetItemIndex: Integer;
begin
  Result := Selected;
end;

function TTMSFMXGrid.GetSelected: Integer;
begin
  Result := FocusedCell.Row;
end;

procedure TTMSFMXGrid.NotifyObserver;
var
  obj: TColumnDescObject;
  c: Integer;
  dts: TBaseLinkingBindSource;
  ds: TDataSet;
begin
  if Observers.IsObserving(TObserverMapping.PositionLinkID) then
  begin
    try
      TLinkObservers.PositionLinkPosChanged(Observers)
    except
      TLinkObservers.EditGridLinkReset(Observers);
    end;
  end;

  if (Options.Editing.AutoPost = apRow) and (FInternalCell.Row <> FocusedCell.Row) then
  begin
    c := ColumnIndex;
    if (c >= 0) and (c <= ColumnDescList.Count - 1) then
    begin
      obj := TColumnDescObject(ColumnDescList.Items[c]);
      if Assigned(obj) then
      begin
        dts := obj.ColumnDesc.DataSource;
        if Assigned(dts) then
        begin
          if dts is TCustomBindSourceDB then
          begin
            ds := (dts as TCustomBindSourceDB).DataSet;
            if Assigned(ds) then
            begin
              BlockUpdate := True;
              if ds.State = dsEdit then
                ds.Post;
              BlockUpdate := False;
            end;
          end;
        end;
      end;
    end;
  end;

  FInternalCell := FocusedCell;

end;

procedure TTMSFMXGrid.NotifyObserverCheckClick(ACol, ARow: Integer);
var
  cl: TCell;
begin
  if Observers.IsObserving(TObserverMapping.EditGridLinkID) then
  begin
    try
      cl.Row := ARow;
      cl.Col := ACol;
      FocusedCell := cl;
      if TLinkObservers.EditGridLinkEdit(Observers) then
        TLinkObservers.EditGridLinkModified(Observers)
    except
      TLinkObservers.EditGridLinkReset(Observers);
    end;
  end;
end;

procedure TTMSFMXGrid.NotifyObserverStartEdit;
begin
  if Observers.IsObserving(TObserverMapping.EditGridLinkID) then
  begin
    try
      if TLinkObservers.EditGridLinkEdit(Observers) then
        TLinkObservers.EditGridLinkModified(Observers)
    except
      TLinkObservers.EditGridLinkReset(Observers);
    end;
  end;
end;

procedure TTMSFMXGrid.NotifyObserverStopEdit;
begin
  if Observers.IsObserving(TObserverMapping.EditGridLinkID) then
  begin
    try
      if TLinkObservers.EditGridLinkIsEditing(Observers) then
        TLinkObservers.EditGridLinkUpdate(Observers);
    except
      TLinkObservers.EditGridLinkReset(Observers);
    end;
  end;
end;

procedure TTMSFMXGrid.ObserverAdded(const ID: Integer;
  const Observer: IObserver);
var
  LGridLinkObserver: IEditGridLinkObserver;
begin
  if ID = TObserverMapping.EditGridLinkID then
    Observer.OnObserverToggle := ObserverToggle;
  if Supports(Observer, IEditGridLinkObserver, LGridLinkObserver) then
    LGridLinkObserver.OnObserverCurrent := ObserverCurrent;
end;

function TTMSFMXGrid.ObserverCurrent: TVarRec;
begin
  Result.VType := vtInteger;
  Result.VInteger := ColumnIndex;
end;

procedure TTMSFMXGrid.ObserverToggle(const AObserver: IObserver;
  const Value: Boolean);
begin

end;

procedure TTMSFMXGrid.SelectCell(Cell: TCell; Shift: TShiftState;
  MouseDragging: Boolean);
begin
  inherited;
  NotifyObserver;
end;

procedure TTMSFMXGrid.SetColumnIndex(const Value: Integer);
var
  cl: TCell;
begin
  cl.col := Value;
  cl.row := FocusedCell.Row;
  FocusedCell := cl;
end;

procedure TTMSFMXGrid.SetItemIndex(const Value: Integer);
begin
  Selected := Value;
end;

procedure TTMSFMXGrid.SetSelected(const Value: Integer);
var
  cl: TCell;
begin
  cl.Col := FocusedCell.Col;
  cl.Row := Value;
  FocusedCell := cl;
end;

end.
