{*************************************************************************}
{                                                                         }
{ written by TMS Software                                                 }
{           copyright © 2013                                              }
{           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 component can be freely used in any application. 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.TMSListView;

interface

{$I TMSDEFS.INC}

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
  FMX.StdCtrls, FMX.Layouts, FMX.Grid;


type
  TTMSFMXListView = class;
  TListItems = class;
  TCustomData = Pointer;

  TListItemClass = class of TListItem;

  TListItem = class(TCollectionItem)
  private
    FSubItems: TStringList;
    FText: string;
    FChecked: Boolean;
    FData: TCustomData;
    procedure SetSubItems(Value: TStringList);
    procedure SetText(const Value: string);
    procedure SetChecked(const Value: Boolean);
    procedure SetState(const Value: Boolean);
    function GetState: Boolean;
  protected
    procedure SubItemsChanged(Sender: TObject);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Checked: Boolean read FChecked write SetChecked;
    property Data: TCustomData read FData write FData;
    property Selected: Boolean read GetState write SetState;
  published
    property Text: string read FText write SetText;
    property SubItems: TStringList read FSubItems write SetSubItems;
  end;

  TItemChangeEvent = procedure(Sender: TObject; Index: integer) of object;
  TListViewItemEvent = procedure(Sender: TObject; Item: TListItem) of object;

{ TListItems }

  TListItems = class(TOwnedCollection)
  private
    FOnChanged: TItemChangeEvent;
    function GetItems(Index: integer): TListItem;
    procedure SetItems(Index: integer; const Value: TListItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TTMSFMXListView);
    destructor Destroy; override;
    property Items[Index: integer]: TListItem read GetItems write SetItems; default;
    function Add: TListItem;
    property OnChanged: TItemChangeEvent read FOnChanged write FOnChanged;
  end;

  TListColumn = class(TCollectionItem)
  private
    FCaption: string;
    FTag: integer;
    procedure SetCaption(const Value: string);
  published
    property Caption: string read FCaption write SetCaption;
    property Tag: integer read FTag write FTag;
  end;

  TListColumns = class(TOwnedCollection)
  private
    FOnChange: TNotifyEvent;
    function GetItems(Index: Integer): TListColumn;
    procedure SetItems(Index: Integer; const Value: TListColumn);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TComponent);
    property OnChanged: TNotifyEvent read FOnChange write FOnChange;
    function Add: TListColumn;
    function Insert(Index: integer): TListColumn;
    property Items[Index: Integer]: TListColumn read GetItems write SetItems; default;
  end;

  TTMSFMXListView = class(TGrid)
  private
    FColumns: TListColumns;
    FItems: TListItems;
    FRowSelect: boolean;
    FOnItemChecked: TListViewItemEvent;
    FOnChange: TNotifyEvent;
    FItemIndex: Integer;
    procedure SetColumns(const Value: TListColumns);
    procedure ColumnsChanged(Sender: TObject);
    procedure ItemChanged(Sender: TObject; Index: integer);
    procedure SetItems(const Value: TListItems);
    procedure SetRowSelect(const Value: boolean);
    function GetSelected: TListItem;
    procedure SetSelectedEx(const Value: TListItem);
    procedure SetItemIndex(const Value: Integer);
    function GetItemIndex: Integer;
  protected
    function GetValue(Col, Row: Integer): TValue; override;
    procedure SetValue(Col, Row: Integer; const Value: TValue); override;
    procedure DoItemChecked(Item: TListItem); virtual;
    {$IFDEF DELPHIXE6_LVL}
    procedure SetSelected(const Value: Integer); override;
    {$ELSE}
    procedure DoSelChanged; override;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    property Selected: TListItem read GetSelected write SetSelectedEx;
  published
    property ItemIndex: Integer read GetItemIndex write SetItemIndex default -1;
    property Columns: TListColumns read FColumns write SetColumns;
    property Items: TListItems read FItems write SetItems;
    property RowSelect: boolean read FRowSelect write SetRowSelect default false;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnItemChecked: TListViewItemEvent read FOnItemChecked write FOnItemChecked;
  end;

implementation

{ TListColumns }

function TListColumns.Add: TListColumn;
begin
  Result := TListColumn(inherited Add);
end;

constructor TListColumns.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TListColumn);
end;

function TListColumns.GetItems(Index: Integer): TListColumn;
begin
  Result := TListColumn(inherited Items[Index]);
end;

function TListColumns.Insert(Index: integer): TListColumn;
begin
  Result := TListColumn(inherited Insert(Index));
end;

procedure TListColumns.SetItems(Index: Integer; const Value: TListColumn);
begin
  inherited Items[Index] := Value;
end;

procedure TListColumns.Update(Item: TCollectionItem);
begin
  inherited;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{ TTMSFMXListView }

procedure TTMSFMXListView.ColumnsChanged(Sender: TObject);
var
  i: integer;
  gc: TColumn;
begin
  for i := Content.ChildrenCount - 1 downto 0 do
  begin
    if (Content.Children[i] is TStringColumn) or (Content.Children[i] is TCheckColumn) then
    begin
      Content.Children[i].DisposeOf;
    end;
  end;

  for i := 0 to Columns.Count - 1 do
  begin

    if RowSelect and (i = 0) then
    begin
      gc := TCheckColumn.Create(Self);
      gc.ReadOnly := false;
    end
    else
    begin
      gc := TStringColumn.Create(Self);
      gc.ReadOnly := true;
    end;

    gc.Header := Columns[i].Caption;
    Content.AddObject(gc);
  end;
end;

constructor TTMSFMXListView.Create(AOwner: TComponent);
begin
  inherited;
  FItemIndex := -1;
  FColumns := TListColumns.Create(Self);
  FColumns.OnChanged := ColumnsChanged;
  FItems := TListItems.Create(Self);
  FItems.OnChanged := ItemChanged;
  FRowSelect := false;
end;

destructor TTMSFMXListView.Destroy;
begin
  FColumns.Free;
  FItems.Free;
  inherited;
end;

procedure TTMSFMXListView.DoItemChecked(Item: TListItem);
begin
  if Assigned(OnItemChecked) then
    OnItemChecked(Self, Item);
end;

{$IFDEF DELPHIXE6_LVL}
procedure TTMSFMXListView.SetSelected(const Value: Integer);
{$ELSE}
procedure TTMSFMXListView.DoSelChanged;
{$ENDIF}
begin
  inherited;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TTMSFMXListView.GetItemIndex: Integer;
begin
  Result := FItemIndex;
  if Assigned(Selected) then
    Result := Selected.Index;
end;

function TTMSFMXListView.GetSelected: TListItem;
var
  sel: Integer;
begin
  Result := nil;
  sel := inherited Selected;
  if (sel >= 0) and (sel <= Items.Count - 1) then
    Result := Items[sel];
end;

function TTMSFMXListView.GetValue(Col, Row: Integer): TValue;
var
  li: TListItem;
  c: integer;
begin
  Result := '';

  if (Row >= 0) and (Row < FItems.Count) then
  begin
    if (Col = 0) and (RowSelect) then
    begin
      Result := FItems[Row].Checked;
    end
    else
    begin
      li := FItems[Row];

      if Col > 0 then
      begin
        c := Col - 1;
        if Assigned(li.SubItems) and (c < li.SubItems.Count) then
          Result := li.SubItems[c];
      end
      else
      begin
        Result := li.Text;
      end;
    end;
  end;
end;

procedure TTMSFMXListView.ItemChanged(Sender: TObject; Index: integer);
begin
  RowCount := FItems.Count;
  UpdateColumns;

{
  for i := 0 to Content.ChildrenCount - 1 do
  begin
    if (Content.Children[i] is TStringColumn) or (Content.Children[i] is TCheckColumn) then
    begin
      (Content.Children[i] as TColumn).UpdateCell(Index);
    end;
  end;
}
end;

procedure TTMSFMXListView.Loaded;
begin
  inherited;
  ColumnsChanged(Self);
end;

procedure TTMSFMXListView.SetColumns(const Value: TListColumns);
begin
  FColumns.Assign(Value);
end;

procedure TTMSFMXListView.SetItemIndex(const Value: Integer);
begin
  FItemIndex := Value;
  if (Value >= 0) and (Value <= Items.Count - 1) then
    Selected := Items[Value];
end;

procedure TTMSFMXListView.SetItems(const Value: TListItems);
begin
  FItems.Assign(Value);
end;

procedure TTMSFMXListView.SetRowSelect(const Value: boolean);
begin
  if (FRowSelect <> Value) then
  begin
    FRowSelect := Value;
    ColumnsChanged(Self);
  end;
end;

procedure TTMSFMXListView.SetSelectedEx(const Value: TListItem);
begin
  inherited Selected := Value.Index;
end;

procedure TTMSFMXListView.SetValue(Col, Row: Integer; const Value: TValue);
begin
  inherited;
  if (Col = 0) and (RowSelect) then
  begin
    Items[Row].Checked := Value.AsBoolean;
    DoItemChecked(Items[Row]);
  end;
end;

{ TListItems }

function TListItems.Add: TListItem;
begin
  Result := TListItem(inherited Add);
end;

constructor TListItems.Create(AOwner: TTMSFMXListView);
begin
  inherited Create(AOwner, TListItem);
end;

destructor TListItems.Destroy;
begin
  inherited;
end;

function TListItems.GetItems(Index: integer): TListItem;
begin
  Result := TListItem(inherited Items[Index]);
end;

procedure TListItems.SetItems(Index: integer; const Value: TListItem);
begin
  inherited Items[Index] := Value;
end;

procedure TListItems.Update(Item: TCollectionItem);
begin
  inherited;
  if Assigned(FOnChanged) then
  begin
    if Assigned(Item) then
      FOnChanged(Self, Item.Index)
    else
      FOnChanged(Self, 0);
  end;
end;

{ TListItem }

constructor TListItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FSubItems := TStringList.Create;
  FSubItems.OnChange := SubItemsChanged;
end;

destructor TListItem.Destroy;
begin
  FSubItems.Free;
  inherited;
end;

procedure TListItem.SetState(const Value: Boolean);
var
  lv: TTMSFMXListView;
begin
  lv := (Collection as TListItems).Owner as TTMSFMXListView;
  lv.Selected := self;
end;

procedure TListItem.SetText(const Value: string);
begin
  FText := Value;
  Changed(False);
end;

procedure TListItem.SetChecked(const Value: Boolean);
begin
  FChecked := Value;
  Changed(False);
end;

function TListItem.GetState: Boolean;
var
  lv: TTMSFMXListView;
begin
  lv := (Collection as TListItems).Owner as TTMSFMXListView;
  Result := lv.Selected = self;
end;

procedure TListItem.SetSubItems(Value: TStringList);
begin
  FSubItems.Assign(Value);
end;

procedure TListItem.SubItemsChanged(Sender: TObject);
begin
  Changed(False);
end;

{ TListColumn }

procedure TListColumn.SetCaption(const Value: string);
begin
  FCaption := Value;
  Changed(false);
end;


end.
