lazarus/ide/frames/modematrixctrl.pas

{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************

}
unit ModeMatrixCtrl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, math, types, contnrs,
  // LCL
  Controls, LCLType, LCLIntf, Grids, Graphics, StdCtrls, Menus,
  // LazUtils
  LazLogger,
  // Codetools
  FileProcs,
  // IdeIntf
  IDEUtils,
  // IDE
  IDEProcs, LazarusIDEStrConsts;

const
  DefaultModeMatrixMaxUndo = 100;
  DefaultModeMatrixIndent = 10;
  DefaultModeMatrixOptions = DefaultGridOptions+[goEditing]-[goRangeSelect];
type
  TGroupedMatrix = class;
  TGroupedMatrixGroup = class;
  TGroupedMatrixControl = class;

  { TGroupedMatrixRow }

  TGroupedMatrixRow = class(TPersistent)
  private
    FLastDrawValueX: integer;
    FMatrix: TGroupedMatrix;
    FGroup: TGroupedMatrixGroup;
    FRowInGrid: integer;
    procedure SetGroup(AValue: TGroupedMatrixGroup);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(aMatrix: TGroupedMatrix); virtual;
    destructor Destroy; override;
    procedure Clear; virtual;
    function Equals(Obj: TObject): boolean; override;
    property Matrix: TGroupedMatrix read FMatrix;
    property Group: TGroupedMatrixGroup read FGroup write SetGroup;
    function GetGroupIndex: integer;
    property RowInGrid: integer read FRowInGrid; // in Grid, not in Group
    property LastDrawValueX: integer read FLastDrawValueX write FLastDrawValueX;
    function Level: integer;
    function GetNextSibling: TGroupedMatrixRow;
    function GetNext: TGroupedMatrixRow; virtual;
    function GetNextSkipChildren: TGroupedMatrixRow;
    function GetPreviousSibling: TGroupedMatrixRow;
    function GetPrevious: TGroupedMatrixRow; // the reverse of GetNext
    function GetLastLeaf: TGroupedMatrixRow; virtual; // get last child of last child of ...
    function GetTopLvlItem: TGroupedMatrixRow;
    function AsString: string; virtual;
  end;
  TGroupedMatrixRowClass = class of TGroupedMatrixRow;

  { TGroupedMatrixGroup }

  TGroupedMatrixGroup = class(TGroupedMatrixRow)
  private
    FCaption: TCaption;
    FColor: TColor;
    FItems: TFPList; // list of TGroupedMatrixRow
    FValue: string;
    FWritable: boolean;
    function GetCount: integer;
    function GetItems(Index: integer): TGroupedMatrixRow;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(aMatrix: TGroupedMatrix); override;
    destructor Destroy; override;
    procedure Clear; override;
    function Equals(Obj: TObject): boolean; override;
    property Caption: TCaption read FCaption write FCaption;
    property Value: string read FValue write FValue;
    property Writable: boolean read FWritable write FWritable;
    property Count: integer read GetCount;
    property Items[Index: integer]: TGroupedMatrixRow read GetItems; default;
    function IndexOfRow(aRow: TGroupedMatrixRow): integer;
    procedure Move(CurIndex, NewIndex: integer);
    function GetNext: TGroupedMatrixRow; override;
    function GetLastLeaf: TGroupedMatrixRow; override;
    property Color: TColor read FColor write FColor;
    function GetEffectiveColor: TColor;
    function AsString: string; override;
  end;

  { TGroupedMatrixValue }

  TGroupedMatrixValue = class(TGroupedMatrixRow)
  private
    FModeList: TStrings;
    FTyp: string;
    FValue: string;
    procedure SetModes(AValue: TStrings);
    procedure SetTyp(AValue: string);
    procedure SetValue(AValue: string);
  public
    ID: string;
    procedure Assign(Source: TPersistent); override;
    constructor Create(aControl: TGroupedMatrix); override;
    destructor Destroy; override;
    function Equals(Obj: TObject): boolean; override;
    property Value: string read FValue write SetValue;
    property Typ: string read FTyp write SetTyp;
    property ModeList: TStrings read FModeList write SetModes;
    function GetNormalizedModes(IgnoreModes: TStrings = nil): string;
    function AsString: string; override;
  end;

  { TGroupedMatrixMode }

  TGroupedMatrixMode = class(TPersistent)
  private
    FCaption: string;
    FColor: TColor;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create;
    function Equals(Obj: TObject): boolean; override;
    property Caption: string read FCaption write FCaption;
    property Color: TColor read FColor write FColor;
  end;
  TGroupedMatrixModeClass = class of TGroupedMatrixMode;

  { TGroupedMatrixModes }

  TGroupedMatrixModes = class(TPersistent)
  private
    fItems: TFPList; // list of TGroupedMatrixMode
    function GetItems(Index: integer): TGroupedMatrixMode;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Equals(Obj: TObject): boolean; override;
    property Items[Index: integer]: TGroupedMatrixMode read GetItems; default;
    function Count: integer;
    function Add(aCaption: string; aColor: TColor = clDefault): TGroupedMatrixMode;
    procedure Delete(Index: integer);
  end;
  TGroupedMatrixModesClass = class of TGroupedMatrixModes;

  { TGroupedMatrix }

  TGroupedMatrix = class(TPersistent)
  private
    FControl: TGroupedMatrixControl;
    FModes: TGroupedMatrixModes;
    FRows: TFPList; // list of TGroupedMatrixRow
    FTopLvlRows: TFPList; // list of TGroupedMatrixRow with Level=0
    function GetRowCount: integer;
    function GetRows(Index: integer): TGroupedMatrixRow;
    function GetTopLvlCount: integer;
    function GetTopLvlItems(Index: integer): TGroupedMatrixRow;
    procedure InternalAdd(Group: TGroupedMatrixGroup; Row: TGroupedMatrixRow);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(aControl: TGroupedMatrixControl);
    destructor Destroy; override;
    procedure Clear;
    function Equals(Obj: TObject): boolean; override;
    procedure RebuildRows;
    property RowCount: integer read GetRowCount;
    property Rows[Index: integer]: TGroupedMatrixRow read GetRows; default;
    procedure DeleteRow(Index: integer);
    function IndexOfRow(Row: TGroupedMatrixRow): integer;
    property TopLvlCount: integer read GetTopLvlCount;
    property TopLvlItems[Index: integer]: TGroupedMatrixRow read GetTopLvlItems;
    function IndexOfTopLvlItem(Row: TGroupedMatrixRow): integer;
    function IndexOfTopLvlGroup(aCaption: TCaption): integer;
    function GetTopLvlGroup(aCaption: TCaption): TGroupedMatrixGroup;
    function GetMaxLevel: integer;
    function AddGroup(ParentGroup: TGroupedMatrixGroup;
      aCaption: TCaption; aValue: string = ''): TGroupedMatrixGroup;
    function AddValue(ParentGroup: TGroupedMatrixGroup;
      ModesAsText, aType, AValue, aID: string): TGroupedMatrixValue;
    property Modes: TGroupedMatrixModes read FModes;
    property Control: TGroupedMatrixControl read FControl;
    procedure WriteDebugReport;
  end;

  TOnGetCellHightlightColor = procedure(Sender: TObject; aCol,aRow: integer;
    var aColor: TColor) of object;

  { TGroupedMatrixControl }

  TGroupedMatrixControl = class(TCustomDrawGrid)
  private
    FActiveMode: integer;
    FActiveModeColor: TColor;
    FIndent: integer;
    FMatrix: TGroupedMatrix;
    FMaxUndo: integer;
    FOnGetCellHightlightColor: TOnGetCellHightlightColor;
    FTypeColumn: TGridColumn;
    FValueColumn: TGridColumn;
    fTypePopupMenu: TPopupMenu;
    fTypePopupMenuRow: integer; // grid row of fTypePopupMenu
    fUndoItems: TObjectList; // list of TGroupedMatrix, 0=oldest
    fRedoItems: TObjectList; // list of TGroupedMatrix, 0=oldest
    function GetModeColumns(Index: integer): TGridColumn;
    function GetModes: TGroupedMatrixModes;
    procedure InvalidateGroupedCells({%H-}aCol, aRow: Integer);
    procedure SetActiveMode(AValue: integer);
    procedure SetActiveModeColor(AValue: TColor);
    procedure SetIndent(AValue: integer);
    procedure SetMaxUndo(AValue: integer);
    procedure ToggleModeValue(aCol, aRow: integer);
    procedure PopupTypes(aRow: integer);
    procedure OnTypePopupMenuClick(Sender: TObject);
  protected
    function EditingAllowed(ACol: Integer=-1): Boolean; override;
    function GetCells(ACol, ARow: Integer): string; override;
    function GetEditText(aCol, aRow: Longint): string; override;
    procedure AutoLayout; virtual;
    procedure BeforeMoveSelection(const DCol, DRow: Integer); override;
    procedure CreateWnd; override;
    procedure DoEditorShow; override;
    procedure DrawCellGrid(aCol, aRow: Integer; aRect: TRect;
      aState: TGridDrawState); override;
    procedure DrawIndent(aRow: integer; aRect: TRect);
    procedure DrawRow(aRow: Integer); override;
    procedure GetCheckBoxState(const aCol, aRow: Integer;
      var aState: TCheckboxState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer
      ); override;
    procedure MoveSelection; override;
    procedure PrepareGridCanvas; // prepare canvas for drawing the lines of the grid
    procedure SetCheckboxState(const aCol, aRow: Integer;
      const aState: TCheckboxState); override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
  public
    property ActiveModeColor: TColor read FActiveModeColor write SetActiveModeColor;
    procedure DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
      aState: TGridDrawState); override;
    property Matrix: TGroupedMatrix read FMatrix;
    property Modes: TGroupedMatrixModes read GetModes;
    procedure MatrixChanging;
    procedure MatrixChanged;
    procedure DeleteMatrixRow(aRow: integer);
    property ActiveMode: integer read FActiveMode write SetActiveMode;
    function ModeColFirst: integer;
    function ModeColLast: integer;
    property ModeColumns[Index: integer]: TGridColumn read GetModeColumns;
    property TypeColumn: TGridColumn read FTypeColumn;
    function TypeCol: integer;
    property ValueColumn: TGridColumn read FValueColumn;
    function ValueCol: integer;
    property Indent: integer read FIndent write SetIndent default DefaultModeMatrixIndent;
  public
    // undo/redo
    function CanUndo: boolean;
    function CanRedo: boolean;
    procedure Undo;
    procedure Redo;
    property MaxUndo: integer read FMaxUndo write SetMaxUndo default DefaultModeMatrixMaxUndo;
    procedure StoreUndo(EvenIfNothingChanged: boolean = false);
  public
    property Options default DefaultModeMatrixOptions;
    property TitleStyle default tsNative;
    property OnGetCellHightlightColor: TOnGetCellHightlightColor
                 read FOnGetCellHightlightColor write FOnGetCellHightlightColor;
  end;

function VerticalIntersect(const aRect,bRect: TRect): boolean;
function HorizontalIntersect(const aRect,bRect: TRect): boolean;

implementation

function VerticalIntersect(const aRect,bRect: TRect): boolean;
begin
  result := (aRect.Top < bRect.Bottom) and (aRect.Bottom > bRect.Top);
end;

function HorizontalIntersect(const aRect,bRect: TRect): boolean;
begin
  result := (aRect.Left < bRect.Right) and (aRect.Right > bRect.Left);
end;

{ TGroupedMatrixMode }

procedure TGroupedMatrixMode.Assign(Source: TPersistent);
var
  aSource: TGroupedMatrixMode;
begin
  if Source=Self then exit;
  if Source is TGroupedMatrixMode then
  begin
    aSource:=TGroupedMatrixMode(Source);
    Color:=aSource.Color;
    Caption:=aSource.Caption;
  end else
    inherited Assign(Source);
end;

constructor TGroupedMatrixMode.Create;
begin
  FColor:=clDefault;
end;

function TGroupedMatrixMode.Equals(Obj: TObject): boolean;
var
  SrcMode: TGroupedMatrixMode;
begin
  Result:=false;
  if not (Obj is TGroupedMatrixMode) then exit;
  SrcMode:=TGroupedMatrixMode(Obj);
  if SrcMode.Caption<>Caption then exit;
  if SrcMode.Color<>Color then exit;
  Result:=true;
end;

{ TGroupedMatrixModes }

function TGroupedMatrixModes.GetItems(Index: integer): TGroupedMatrixMode;
begin
  Result:=TGroupedMatrixMode(fItems[Index]);
end;

procedure TGroupedMatrixModes.Assign(Source: TPersistent);
var
  SrcModes: TGroupedMatrixModes;
  i: Integer;
  SrcMode: TGroupedMatrixMode;
  NewMode: TGroupedMatrixMode;
begin
  if Source=Self then exit;
  if Source is TGroupedMatrixModes then
  begin
    SrcModes:=TGroupedMatrixModes(Source);
    Clear;
    for i:=0 to SrcModes.Count-1 do begin
      SrcMode:=SrcModes[i];
      NewMode:=TGroupedMatrixModeClass(SrcMode.ClassType).Create;
      fItems.Add(NewMode);
      NewMode.Assign(SrcMode);
    end;
  end else
    inherited Assign(Source);
end;

constructor TGroupedMatrixModes.Create;
begin
  fItems:=TFPList.Create;
end;

destructor TGroupedMatrixModes.Destroy;
begin
  Clear;
  FreeAndNil(fItems);
  inherited Destroy;
end;

procedure TGroupedMatrixModes.Clear;
var
  i: Integer;
begin
  for i:=0 to fItems.Count-1 do
    Items[i].Free;
  fItems.Clear;
end;

function TGroupedMatrixModes.Equals(Obj: TObject): boolean;
var
  SrcModes: TGroupedMatrixModes;
  i: Integer;
begin
  Result:=false;
  if not (Obj is TGroupedMatrixModes) then exit;
  SrcModes:=TGroupedMatrixModes(Obj);
  if SrcModes.Count<>Count then exit;
  for i:=0 to Count-1 do
    if not SrcModes[i].Equals(Items[i]) then exit;
  Result:=true;
end;

function TGroupedMatrixModes.Count: integer;
begin
  Result:=fItems.Count;
end;

function TGroupedMatrixModes.Add(aCaption: string; aColor: TColor): TGroupedMatrixMode;
begin
  Result:=TGroupedMatrixMode.Create;
  Result.Caption:=aCaption;
  Result.Color:=aColor;
  fItems.Add(Result);
end;

procedure TGroupedMatrixModes.Delete(Index: integer);
var
  Item: TGroupedMatrixMode;
begin
  Item:=Items[Index];
  fItems.Delete(Index);
  Item.Free;
end;

{ TGroupedMatrix }

function TGroupedMatrix.GetRows(Index: integer): TGroupedMatrixRow;
begin
  Result:=TGroupedMatrixRow(FRows[Index]);
end;

function TGroupedMatrix.GetRowCount: integer;
begin
  Result:=FRows.Count;
end;

function TGroupedMatrix.GetTopLvlCount: integer;
begin
  Result:=FTopLvlRows.Count;
end;

function TGroupedMatrix.GetTopLvlItems(Index: integer): TGroupedMatrixRow;
begin
  Result:=TGroupedMatrixRow(FTopLvlRows[Index]);
end;

procedure TGroupedMatrix.InternalAdd(Group: TGroupedMatrixGroup;
  Row: TGroupedMatrixRow);
begin
  if Group=nil then begin
    FTopLvlRows.Add(Row);
    Row.FRowInGrid:=FRows.Count;
    FRows.Add(Row);
  end else begin
    Row.Group:=Group;
    RebuildRows;
  end;
end;

procedure TGroupedMatrix.RebuildRows;

  procedure Traverse(Row: TGroupedMatrixRow);
  var
    i: Integer;
  begin
    Row.FRowInGrid:=FRows.Count;
    FRows.Add(Row);
    if Row is TGroupedMatrixGroup then
      for i:=0 to TGroupedMatrixGroup(Row).Count-1 do
        Traverse(TGroupedMatrixGroup(Row)[i]);
  end;

var
  i: Integer;
begin
  FRows.Clear;
  for i:=0 to TopLvlCount-1 do
    Traverse(TopLvlItems[i]);
end;

procedure TGroupedMatrix.Assign(Source: TPersistent);
var
  SrcMatrix: TGroupedMatrix;
  i: Integer;
  SrcRow: TGroupedMatrixRow;
  NewRow: TGroupedMatrixRow;
begin
  if Source=Self then exit;
  if Source is TGroupedMatrix then
  begin
    SrcMatrix:=TGroupedMatrix(Source);
    Clear;
    Modes.Assign(SrcMatrix.Modes);
    for i:=0 to SrcMatrix.TopLvlCount-1 do begin
      SrcRow:=SrcMatrix.TopLvlItems[i];
      NewRow:=TGroupedMatrixRowClass(SrcRow.ClassType).Create(Self);
      FTopLvlRows.Add(NewRow);
      NewRow.Assign(SrcRow);
    end;
    RebuildRows;
  end else
    inherited Assign(Source);
end;

constructor TGroupedMatrix.Create(aControl: TGroupedMatrixControl);
begin
  FControl:=aControl;
  FRows:=TFPList.Create;
  FTopLvlRows:=TFPList.Create;
  FModes:=TGroupedMatrixModes.Create;
end;

destructor TGroupedMatrix.Destroy;
begin
  Clear;
  FreeAndNil(FModes);
  FreeAndNil(FRows);
  FreeAndNil(FTopLvlRows);
  inherited Destroy;
end;

procedure TGroupedMatrix.Clear;
var
  i: Integer;
begin
  for i:=TopLvlCount-1 downto 0 do
    TopLvlItems[i].Free;
  FTopLvlRows.Clear;
  FRows.Clear;
  FModes.Clear;
end;

function TGroupedMatrix.Equals(Obj: TObject): boolean;
var
  SrcMatrix: TGroupedMatrix;
  i: Integer;
begin
  Result:=false;
  if not (Obj is TGroupedMatrix) then exit;
  SrcMatrix:=TGroupedMatrix(Obj);
  if SrcMatrix.RowCount<>RowCount then exit;
  if SrcMatrix.TopLvlCount<>TopLvlCount then exit;
  if not SrcMatrix.Modes.Equals(Modes) then exit;
  for i:=0 to TopLvlCount-1 do
    if not SrcMatrix.TopLvlItems[i].Equals(TopLvlItems[i]) then exit;
  Result:=true;
end;

procedure TGroupedMatrix.DeleteRow(Index: integer);
begin
  Rows[Index].Free;
  RebuildRows;
end;

function TGroupedMatrix.IndexOfRow(Row: TGroupedMatrixRow): integer;
begin
  for Result:=0 to RowCount-1 do
    if Row=Rows[Result] then exit;
  Result:=-1;
end;

function TGroupedMatrix.IndexOfTopLvlItem(Row: TGroupedMatrixRow): integer;
begin
  for Result:=0 to TopLvlCount-1 do
    if Row=TopLvlItems[Result] then exit;
  Result:=-1;
end;

function TGroupedMatrix.GetMaxLevel: integer;
var
  i: Integer;
begin
  Result:=0;
  for i:=0 to RowCount-1 do
    Result:=Max(Result,Rows[i].Level);
end;

function TGroupedMatrix.AddGroup(ParentGroup: TGroupedMatrixGroup;
  aCaption: TCaption; aValue: string): TGroupedMatrixGroup;
begin
  Result:=TGroupedMatrixGroup.Create(Self);
  Result.Caption:=aCaption;
  Result.Value:=aValue;
  Result.Writable:=aValue<>'';
  InternalAdd(ParentGroup,Result);
end;

function TGroupedMatrix.AddValue(ParentGroup: TGroupedMatrixGroup; ModesAsText,
  aType, AValue, aID: string): TGroupedMatrixValue;
begin
  Result:=TGroupedMatrixValue.Create(Self);
  Result.Typ:=aType;
  Result.Value:=AValue;
  Result.ModeList.Text:=ModesAsText;
  Result.ID:=aID;
  InternalAdd(ParentGroup,Result);
end;

procedure TGroupedMatrix.WriteDebugReport;
var
  i: Integer;
  MatRow: TGroupedMatrixRow;
begin
  for i:=0 to RowCount-1 do begin
    MatRow:=Rows[i];
    debugln(Space(MatRow.Level*2),MatRow.AsString);
  end;
end;

function TGroupedMatrix.IndexOfTopLvlGroup(aCaption: TCaption): integer;
var
  i: Integer;
  Row: TGroupedMatrixRow;
begin
  Result:=0;
  for i:=0 to TopLvlCount-1 do begin
    Row:=TopLvlItems[i];
    if (Row is TGroupedMatrixGroup)
    and (TGroupedMatrixGroup(Row).Caption=aCaption) then
      exit(i);
  end;
end;

function TGroupedMatrix.GetTopLvlGroup(aCaption: TCaption): TGroupedMatrixGroup;
var
  i: Integer;
begin
  i:=IndexOfTopLvlGroup(aCaption);
  if i>=0 then
    Result:=TGroupedMatrixGroup(TopLvlItems[i])
  else
    Result:=nil;
end;

{ TGroupedMatrixValue }

procedure TGroupedMatrixValue.SetModes(AValue: TStrings);
begin
  if FModeList=AValue then Exit;
  FModeList.Assign(AValue);
end;

procedure TGroupedMatrixValue.SetTyp(AValue: string);
begin
  if FTyp=AValue then Exit;
  FTyp:=AValue;
end;

procedure TGroupedMatrixValue.SetValue(AValue: string);
begin
  if FValue=AValue then Exit;
  FValue:=AValue;
end;

procedure TGroupedMatrixValue.Assign(Source: TPersistent);
var
  aSource: TGroupedMatrixValue;
begin
  if Source=Self then exit;
  inherited Assign(Source);
  if Source is TGroupedMatrixValue then
  begin
    aSource:=TGroupedMatrixValue(Source);
    Value:=aSource.Value;
    Typ:=aSource.Typ;
    ModeList:=aSource.ModeList;
  end;
end;

constructor TGroupedMatrixValue.Create(aControl: TGroupedMatrix);
begin
  inherited Create(aControl);
  FModeList:=TStringList.Create;
end;

destructor TGroupedMatrixValue.Destroy;
begin
  FreeAndNil(FModeList);
  inherited Destroy;
end;

function TGroupedMatrixValue.Equals(Obj: TObject): boolean;
var
  SrcValue: TGroupedMatrixValue;
  i: Integer;
begin
  Result:=false;
  if not (Obj is TGroupedMatrixValue) then exit;
  if not (inherited Equals(Obj)) then exit;
  SrcValue:=TGroupedMatrixValue(Obj);
  if SrcValue.ModeList.Count<>ModeList.Count then exit;
  if SrcValue.Typ<>Typ then exit;
  if SrcValue.Value<>Value then exit;
  for i:=0 to ModeList.Count-1 do
    if SrcValue.ModeList[i]<>ModeList[i] then exit;
  Result:=true;
end;

function TGroupedMatrixValue.GetNormalizedModes(IgnoreModes: TStrings): string;
var
  i: Integer;
  m: String;
begin
  Result:='';
  for i:=0 to ModeList.Count-1 do begin
    m:=ModeList[i];
    if m='' then continue;
    if (IgnoreModes<>nil)
    and (IndexInStringList(IgnoreModes,cstCaseInsensitive,m)>=0) then
      continue;
    if Result<>'' then Result+=#10;
    Result+=m;
  end;
end;

function TGroupedMatrixValue.AsString: string;
begin
  Result:=inherited AsString+Typ+':'+Value;
end;

{ TGroupedMatrixGroup }

function TGroupedMatrixGroup.GetCount: integer;
begin
  Result:=FItems.Count;
end;

function TGroupedMatrixGroup.GetItems(Index: integer): TGroupedMatrixRow;
begin
  Result:=TGroupedMatrixRow(FItems[Index]);
end;

procedure TGroupedMatrixGroup.Assign(Source: TPersistent);
var
  SrcGroup: TGroupedMatrixGroup;
  i: Integer;
  SrcItem: TGroupedMatrixRow;
  Item: TGroupedMatrixRow;
begin
  if Source=Self then exit;
  inherited Assign(Source);
  if Source is TGroupedMatrixGroup then
  begin
    SrcGroup:=TGroupedMatrixGroup(Source);
    FColor:=SrcGroup.FColor;
    FCaption:=SrcGroup.FCaption;
    FValue:=SrcGroup.FValue;
    FWritable:=SrcGroup.FWritable;
    Clear;
    for i:=0 to SrcGroup.Count-1 do begin
      SrcItem:=SrcGroup[i];
      Item:=TGroupedMatrixRowClass(SrcItem.ClassType).Create(Matrix);
      FItems.Add(Item);
      Item.FGroup:=Self;
      Item.Assign(SrcItem);
    end;
  end;
end;

constructor TGroupedMatrixGroup.Create(aMatrix: TGroupedMatrix);
begin
  inherited Create(aMatrix);
  FItems:=TFPList.Create;
  FColor:=clDefault;
end;

destructor TGroupedMatrixGroup.Destroy;
begin
  Clear;
  FreeAndNil(FItems);
  inherited Destroy;
end;

procedure TGroupedMatrixGroup.Clear;
var
  i: Integer;
begin
  if FItems=nil then exit;
  for i:=Count-1 downto 0 do
    Items[i].Free;
  inherited Clear;
end;

function TGroupedMatrixGroup.Equals(Obj: TObject): boolean;
var
  SrcGroup: TGroupedMatrixGroup;
  i: Integer;
begin
  Result:=false;
  if not (Obj is TGroupedMatrixGroup) then
    exit;
  if not (inherited Equals(Obj)) then exit;
  SrcGroup:=TGroupedMatrixGroup(Obj);
  if SrcGroup.Count<>Count then exit;
  if SrcGroup.Color<>Color then exit;
  if SrcGroup.Caption<>Caption then exit;
  if SrcGroup.Value<>Value then exit;
  if SrcGroup.Writable<>Writable then exit;
  for i:=0 to Count-1 do
    if not SrcGroup[i].Equals(Items[i]) then exit;
  Result:=true;
end;

function TGroupedMatrixGroup.IndexOfRow(aRow: TGroupedMatrixRow): integer;
begin
  for Result:=0 to Count-1 do
    if aRow=Items[Result] then exit;
  Result:=-1;
end;

procedure TGroupedMatrixGroup.Move(CurIndex, NewIndex: integer);
begin
  FItems.Move(CurIndex,NewIndex);
end;

function TGroupedMatrixGroup.GetNext: TGroupedMatrixRow;
begin
  if Count>0 then
    Result:=Items[0]
  else
    Result:=GetNextSibling;
end;

function TGroupedMatrixGroup.GetLastLeaf: TGroupedMatrixRow;
var
  aGroup: TGroupedMatrixGroup;
begin
  if Count=0 then exit(nil);
  Result:=Items[Count-1];
  while (Result is TGroupedMatrixGroup) do begin
    aGroup:=TGroupedMatrixGroup(Result);
    if aGroup.Count=0 then exit;
    Result:=aGroup[aGroup.Count-1];
  end;
end;

function TGroupedMatrixGroup.GetEffectiveColor: TColor;
var
  aGroup: TGroupedMatrixGroup;
begin
  aGroup:=Self;
  while aGroup<>nil do begin
    Result:=aGroup.Color;
    if Result<>clDefault then exit;
    aGroup:=aGroup.Group;
  end;
  Result:=Matrix.Control.Color;
end;

function TGroupedMatrixGroup.AsString: string;
begin
  Result:=inherited AsString+Caption;
end;

{ TGroupedMatrixRow }

procedure TGroupedMatrixRow.SetGroup(AValue: TGroupedMatrixGroup);
begin
  if FGroup=AValue then Exit;
  if FGroup<>nil then
    FGroup.FItems.Remove(Self);
  FGroup:=AValue;
  if FGroup<>nil then
    FGroup.FItems.Add(Self);
end;

procedure TGroupedMatrixRow.Assign(Source: TPersistent);
var
  aSource: TGroupedMatrixRow;
begin
  if Source=Self then exit;
  if Source is TGroupedMatrixRow then
  begin
    aSource:=TGroupedMatrixRow(Source);
    FRowInGrid:=aSource.FRowInGrid;
  end else
    inherited Assign(Source);
end;

constructor TGroupedMatrixRow.Create(aMatrix: TGroupedMatrix);
begin
  fMatrix:=aMatrix;
end;

destructor TGroupedMatrixRow.Destroy;
begin
  Clear;
  if Group=nil then
    Matrix.FTopLvlRows.Remove(Self)
  else begin
    Group.FItems.Remove(Self);
    FGroup:=nil;
  end;
  inherited Destroy;
end;

procedure TGroupedMatrixRow.Clear;
begin

end;

function TGroupedMatrixRow.Equals(Obj: TObject): boolean;
var
  SrcRow: TGroupedMatrixRow;
begin
  Result:=false;
  if not (Obj is TGroupedMatrixRow) then exit;
  SrcRow:=TGroupedMatrixRow(Obj);
  if SrcRow.RowInGrid<>RowInGrid then exit;
  Result:=true;
end;

function TGroupedMatrixRow.GetGroupIndex: integer;
begin
  if Group=nil then
    Result:=Matrix.IndexOfTopLvlItem(Self)
  else
    Result:=Group.IndexOfRow(Self);
end;

function TGroupedMatrixRow.Level: integer;
var
  aGroup: TGroupedMatrixGroup;
begin
  Result:=0;
  aGroup:=Group;
  while aGroup<>nil do begin
    inc(Result);
    aGroup:=aGroup.Group;
  end;
end;

function TGroupedMatrixRow.GetNextSibling: TGroupedMatrixRow;
var
  i: Integer;
begin
  i:=GetGroupIndex+1;
  if Group<>nil then begin
    if i>=Group.Count then exit(nil);
    Result:=Group[i];
  end else begin
    if i>=Matrix.TopLvlCount then exit(nil);
    Result:=Matrix.TopLvlItems[i];
  end;
end;

function TGroupedMatrixRow.GetNext: TGroupedMatrixRow;
begin
  Result:=GetNextSibling;
end;

function TGroupedMatrixRow.GetNextSkipChildren: TGroupedMatrixRow;
var
  aRow: TGroupedMatrixRow;
begin
  Result:=Self;
  repeat
    aRow:=Result.GetNextSibling;
    if aRow<>nil then exit(aRow);
    Result:=Result.Group;
  until Result=nil;
  Result:=nil;
end;

function TGroupedMatrixRow.GetPreviousSibling: TGroupedMatrixRow;
var
  i: Integer;
begin
  i:=GetGroupIndex-1;
  if i<0 then exit(nil);
  if Group<>nil then
    Result:=Group[i]
  else
    Result:=Matrix.TopLvlItems[i];
end;

function TGroupedMatrixRow.GetPrevious: TGroupedMatrixRow;
var
  aRow: TGroupedMatrixRow;
begin
  Result:=GetPreviousSibling;
  if Result=nil then
    exit(Group);
  aRow:=Result.GetLastLeaf;
  if aRow<>nil then
    Result:=aRow;
end;

function TGroupedMatrixRow.GetLastLeaf: TGroupedMatrixRow;
begin
  Result:=nil;
end;

function TGroupedMatrixRow.GetTopLvlItem: TGroupedMatrixRow;
begin
  Result:=Self;
  while Result.Group<>nil do
    Result:=Result.Group;
end;

function TGroupedMatrixRow.AsString: string;
begin
  Result:=Space(Level*2);
end;

{ TGroupedMatrixControl }

procedure TGroupedMatrixControl.ToggleModeValue(aCol, aRow: integer);
var
  aState: TCheckboxState;
begin
  aState:=cbUnchecked;
  GetCheckBoxState(aCol,aRow,aState);
  if aState=cbUnchecked then
    aState:=cbChecked
  else
    aState:=cbUnchecked;
  SetCheckboxState(aCol,aRow,aState);
end;

procedure TGroupedMatrixControl.PopupTypes(aRow: integer);
var
  i: Integer;
  Item: TMenuItem;
  XY: TPoint;
begin
  if aRow=0 then exit;
  // create popup menu
  if fTypePopupMenu=nil then
    fTypePopupMenu:=TPopupMenu.Create(Self);
  // fill popup menu with types from pick list
  for i:=0 to TypeColumn.PickList.Count-1 do begin
    if i>=fTypePopupMenu.Items.Count then
      fTypePopupMenu.Items.Add(TMenuItem.Create(Self));
    Item:=fTypePopupMenu.Items[i];
    Item.Caption:=TypeColumn.PickList.Names[i]+': '+TypeColumn.PickList.ValueFromIndex[i];
    Item.OnClick:=@OnTypePopupMenuClick;
  end;
  // delete not needed items
  while fTypePopupMenu.Items.Count>TypeColumn.PickList.Count do
    fTypePopupMenu.Items[fTypePopupMenu.Items.Count-1].Free;

  XY:=Point(0,0);
  i:=TypeColumn.PickList.Count-1;
  ColRowToOffset(true,true,TypeCol,XY.X,i);
  ColRowToOffset(false,true,aRow,i,XY.Y);
  XY:=ClientToScreen(XY);
  fTypePopupMenuRow:=aRow;
  fTypePopupMenu.PopUp(XY.X,XY.Y);
end;

procedure TGroupedMatrixControl.OnTypePopupMenuClick(Sender: TObject);
var
  Item: TMenuItem;
  ValueRow: TGroupedMatrixValue;
  NewType: String;
begin
  Item:=Sender as TMenuItem;
  if (fTypePopupMenuRow<=0) or (fTypePopupMenuRow>Matrix.RowCount) then exit;
  if Matrix.Rows[fTypePopupMenuRow-1] is TGroupedMatrixValue then begin
    ValueRow:=TGroupedMatrixValue(Matrix[fTypePopupMenuRow-1]);
    NewType:=TypeColumn.PickList.Names[Item.MenuIndex];
    if NewType=ValueRow.Typ then exit;
    StoreUndo;
    if Assigned(OnSetEditText) then
      OnSetEditText(Sender,TypeCol,fTypePopupMenuRow,NewType);
    ValueRow.Typ:=NewType;
    InvalidateCell(TypeCol,fTypePopupMenuRow);
    EditingDone;
  end;
end;

procedure TGroupedMatrixControl.BeforeMoveSelection(const DCol, DRow: Integer);
begin
  // invalidate old cells
  InvalidateGroupedCells(Col,Row);
  inherited BeforeMoveSelection(DCol, DRow);
end;

procedure TGroupedMatrixControl.MoveSelection;
begin
  // invalidate new cells
  InvalidateGroupedCells(Col,Row);
  inherited MoveSelection;
end;

function TGroupedMatrixControl.GetModeColumns(Index: integer): TGridColumn;
begin
  if (Index<0) or (Index>=Modes.Count) then
    raise Exception.Create('Index out of bounds '+dbgs(Index));
  Result:=Columns[Index];
end;

function TGroupedMatrixControl.GetModes: TGroupedMatrixModes;
begin
  Result:=Matrix.Modes;
end;

procedure TGroupedMatrixControl.InvalidateGroupedCells(aCol, aRow: Integer);
var
  MatRow: TGroupedMatrixRow;
begin
  if Matrix=nil then exit;
  if (aRow>=FixedRows) and (aRow<=Matrix.RowCount) then begin
    MatRow:=Matrix[aRow-FixedRows];
    if MatRow is TGroupedMatrixGroup then
      InvalidateRow(aRow);
  end;
end;

procedure TGroupedMatrixControl.SetActiveMode(AValue: integer);
begin
  if FActiveMode=AValue then Exit;
  FActiveMode:=AValue;
  Invalidate;
end;

procedure TGroupedMatrixControl.SetActiveModeColor(AValue: TColor);
begin
  if FActiveModeColor=AValue then Exit;
  FActiveModeColor:=AValue;
  Invalidate;
end;

procedure TGroupedMatrixControl.SetIndent(AValue: integer);
begin
  if FIndent=AValue then Exit;
  FIndent:=AValue;
end;

procedure TGroupedMatrixControl.SetMaxUndo(AValue: integer);
begin
  AValue:=Max(AValue,1);
  if FMaxUndo=AValue then Exit;
  FMaxUndo:=AValue;
  while fUndoItems.Count+fRedoItems.Count>FMaxUndo do begin
    if fRedoItems.Count>0 then begin
      fRedoItems.Delete(0);
    end else begin
      fUndoItems.Delete(0);
    end;
  end;
end;

procedure TGroupedMatrixControl.DrawRow(aRow: Integer);
var
  aRect: TRect;
  ClipArea: TRect;
  MatRow: TGroupedMatrixRow;
  Lvl: Integer;
  gds: TGridDrawState;
  i: Integer;
  GroupRow: TGroupedMatrixGroup;
  x: Integer;
  s: String;
  h: Integer;
begin
  aRect:=Rect(0,0,0,0);
  // Upper and Lower bounds for this row
  ColRowToOffSet(False, True, aRow, aRect.Top, aRect.Bottom);
  // is this row within the ClipRect?
  ClipArea := Canvas.ClipRect;
  if (aRect.Top>=aRect.Bottom) or not VerticalIntersect(aRect, ClipArea) then
    exit;

  if aRow>0 then begin
    MatRow:=Matrix.Rows[aRow-1];
    if MatRow is TGroupedMatrixGroup then begin
      GroupRow:=TGroupedMatrixGroup(MatRow);
      Lvl:=MatRow.Level;
      gds := GetGridDrawState(0, ARow);
      PrepareCanvas(0,aRow,gds);
      i:=0;
      ColRowToOffset(true,True,0,aRect.Left,i);
      ColRowToOffset(true,True,ColCount-1,i,aRect.Right);
      x:=aRect.Left+Lvl*Indent;
      // background
      //Canvas.Brush.Color:=GroupRow.GetEffectiveColor;
      Canvas.GradientFill(Rect(x,aRect.Top-1,x+2*Indent,aRect.Bottom),GroupRow.GetEffectiveColor,Color,gdHorizontal);
      Canvas.FillRect(x+2*Indent,aRect.Top-1,aRect.Right,aRect.Bottom);
      // draw group caption
      s:=GroupRow.Caption;
      if (aRow<>Row) or (not EditorMode) then
        s+=GroupRow.Value;
      h:=Canvas.TextHeight(s);
      Canvas.TextRect(aRect,constCellPadding+x,(aRect.Top+aRect.Bottom-h) div 2,s);
      GroupRow.LastDrawValueX:=constCellPadding+x+Canvas.TextWidth(GroupRow.Caption);
      // draw focus rect
      if aRow=Row then
        DrawFocusRect(0,aRow,Rect(x,aRect.Top,aRect.Right,aRect.Bottom));
      // draw grid
      PrepareGridCanvas;
      Canvas.MoveTo(x-1,aRect.Top-1);
      Canvas.LineTo(aRect.Right-1,aRect.Top-1);
      Canvas.LineTo(aRect.Right-1,aRect.Bottom-1);
      if GroupRow.Count>0 then
        Canvas.LineTo(x+Indent-1,aRect.Bottom-1)
      else
        Canvas.LineTo(x-1,aRect.Bottom-1);
      DrawIndent(aRow,aRect);
      exit;
    end;
  end;
  inherited DrawRow(aRow);
  if aRow>0 then
    DrawIndent(aRow,aRect);
end;

function TGroupedMatrixControl.EditingAllowed(ACol: Integer): Boolean;
var
  MatRow: TGroupedMatrixRow;
begin
  Result:=false;
  if (Row=0) or (Matrix=nil) or (Row>Matrix.RowCount) then exit;
  MatRow:=Matrix[Row-1];
  if MatRow is TGroupedMatrixValue then begin
    if ACol<>ValueCol then exit;
    Result:=true;
  end else if MatRow is TGroupedMatrixGroup then begin
    if ACol<>ValueCol then exit;
    Result:=TGroupedMatrixGroup(MatRow).Writable;
  end;
end;

procedure TGroupedMatrixControl.DrawCellGrid(aCol, aRow: Integer; aRect: TRect;
  aState: TGridDrawState);
begin
  if (aCol=0) then begin
    PrepareGridCanvas;
    if aRow=0 then exit;
    if goVertLine in Options then begin
      // right border is left border of mode checkbox
      Canvas.MoveTo(aRect.Right - 1, aRect.Top);
      Canvas.LineTo(aRect.Right - 1, aRect.Bottom);
    end;
    exit;
  end;
  inherited DrawCellGrid(aCol, aRow, aRect, aState);
end;

procedure TGroupedMatrixControl.GetCheckBoxState(const aCol, aRow: Integer;
  var aState: TCheckboxState);
var
  MatRow: TGroupedMatrixRow;
begin
  if (aCol>=1) and (aCol<=Modes.Count)
  and (aRow>0) then begin
    MatRow:=Matrix.Rows[aRow-1];
    if MatRow is TGroupedMatrixValue then begin
      //debugln(['TGroupedMatrixControl.GetCheckBoxState ',aCol,' ',aRow,' "',Modes[aCol-1],'" ',TGroupedMatrixValue(MatRow).ModeList.Text]);
      if IndexInStringList(TGroupedMatrixValue(MatRow).ModeList,cstCaseInsensitive,Modes[aCol-1].Caption)>=0
      then begin
        aState:=cbChecked;
        //debugln(['TGroupedMatrixControl.GetCheckBoxState ',aCol,' ',aRow,' "',Modes[aCol-1],'" ',TGroupedMatrixValue(MatRow).ModeList.Text]);
      end else
        aState:=cbUnchecked;
    end;
  end;
  inherited GetCheckBoxState(aCol, aRow, aState);
end;

procedure TGroupedMatrixControl.SetCheckboxState(const aCol, aRow: Integer;
  const aState: TCheckboxState);
var
  MatRow: TGroupedMatrixRow;
  ValueRow: TGroupedMatrixValue;
  ModeName: String;
  i: Integer;
begin
  if (aCol>=1) and (aCol<=Modes.Count)
  and (aRow>0) then begin
    MatRow:=Matrix.Rows[aRow-1];
    if MatRow is TGroupedMatrixValue then begin
      ValueRow:=TGroupedMatrixValue(MatRow);
      if assigned(OnSetCheckboxState) then
        OnSetCheckboxState(Self, aCol, aRow, aState);
      ModeName:=Modes[aCol-1].Caption;
      i:=IndexInStringList(ValueRow.ModeList,cstCaseInsensitive,ModeName);
      if (i<0) = (aState=cbUnchecked) then exit;
      StoreUndo;
      if i>=0 then begin
        ValueRow.ModeList.Delete(i);
      end else begin
        ValueRow.ModeList.Add(ModeName);
      end;
      InvalidateRow(aRow);
      EditingDone;
      exit;
    end;
  end;
  inherited SetCheckboxState(aCol, aRow, aState);
end;

procedure TGroupedMatrixControl.AutoLayout;
var
  TitleHeight: Integer;
  i: Integer;
  MatRow: TGroupedMatrixRow;
  ValueRow: TGroupedMatrixValue;
  W: Integer;
begin
  if (not HandleAllocated) or (Parent=nil) then exit;

  // title row height
  TitleHeight:=20;
  for i:=0 to Modes.Count-1 do
    TitleHeight:=Max(TitleHeight,Canvas.TextWidth(Modes[i].Caption));
  RowHeights[0]:=TitleHeight+2*constCellPadding;

  // tree column width
  ColWidths[0]:=Matrix.GetMaxLevel*Indent;

  // type width
  W:=Canvas.TextWidth(TypeColumn.Title.Caption);
  for i:=0 to TypeColumn.PickList.Count-1 do
    W:=Max(W,Canvas.TextWidth(TypeColumn.PickList.Names[i]));
  for i:=0 to Matrix.RowCount-1 do begin
    MatRow:=Matrix.Rows[i];
    if MatRow is TGroupedMatrixValue then begin
      ValueRow:=TGroupedMatrixValue(MatRow);
      W:=Max(W,Canvas.TextWidth(ValueRow.Typ));
    end;
  end;
  TypeColumn.Width:=W+2*constCellPadding;

  // value width
  W:=0;
  for i:=0 to Matrix.RowCount-1 do begin
    MatRow:=Matrix.Rows[i];
    if MatRow is TGroupedMatrixValue then
      W:=Max(W,Canvas.TextWidth(TGroupedMatrixValue(MatRow).Value));
  end;
  ValueColumn.MinSize:=W;
end;

procedure TGroupedMatrixControl.CreateWnd;
begin
  inherited CreateWnd;
  AutoLayout;
end;

procedure TGroupedMatrixControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  aCol: Longint;
  aRow: Longint;
  MatRow: TGroupedMatrixRow;
  GroupRow: TGroupedMatrixGroup;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (csDesigning in componentState) or not MouseButtonAllowed(Button) then
    Exit;
  aCol:=0;
  aRow:=0;
  MouseToCell(X,Y,aCol,aRow);
  if (aRow=RowCount-1) and (Y>CellRect(aCol,aRow).Bottom) then exit;
  if aRow>0 then begin
    MatRow:=Matrix[aRow-1];
    if MatRow is TGroupedMatrixValue then begin
      if (aCol>=ModeColFirst) and (aCol<=ModeColLast) then begin
        if Shift*[ssCtrl,ssShift,ssLeft]=[ssLeft] then begin
          ToggleModeValue(aCol, aRow);
        end;
      end else if aCol=TypeCol then begin
        if Shift*[ssCtrl,ssShift,ssLeft]=[ssLeft] then begin
          PopupTypes(aRow);
        end;
      end else if aCol=ValueCol then begin
        SelectEditor;
        EditorShow(False);
      end;
    end else if MatRow is TGroupedMatrixGroup then begin
      GroupRow:=TGroupedMatrixGroup(MatRow);
      if GroupRow.Writable and (X>GroupRow.LastDrawValueX) then begin
        Col:=ValueCol;
        SelectEditor;
        EditorShow(False);
      end;
    end;
  end;
end;

procedure TGroupedMatrixControl.PrepareGridCanvas;
begin
  Canvas.Pen.Style := GridLineStyle;
  Canvas.Pen.Color := GridLineColor;
  Canvas.Pen.Width := GridLineWidth;
end;

procedure TGroupedMatrixControl.DrawIndent(aRow: integer; aRect: TRect);
var
  Group: TGroupedMatrixGroup;
  x: Integer;
begin
  Group:=Matrix[aRow-1].Group;
  while Group<>nil do begin
    x:=Indent*Group.Level;
    Canvas.GradientFill(Rect(x,aRect.Top-1,x+Indent,aRect.Bottom),
      Group.GetEffectiveColor,Color,gdHorizontal);
    PrepareGridCanvas;
    inc(x,Indent-1);
    Canvas.Line(x,aRect.Top-1,x,aRect.Bottom);
    Group:=Group.Group;
    if Group=nil then break;
  end;
  if aRow=RowCount-1 then begin
    // last row, draw line
    PrepareGridCanvas;
    Canvas.Line(0,aRect.Bottom-1,Indent*Matrix[aRow-1].Level,aRect.Bottom-1);
  end;
end;

function TGroupedMatrixControl.GetEditText(aCol, aRow: Longint): string;
var
  MatRow: TGroupedMatrixRow;
begin
  if (aCol=ValueCol) and (aRow>=FixedRows) then begin
    MatRow:=Matrix[aRow-FixedRows];
    if MatRow is TGroupedMatrixValue then
      Result:=TGroupedMatrixValue(MatRow).Value
    else
      Result:=TGroupedMatrixGroup(MatRow).Value;
    exit;
  end;
  Result:=inherited GetEditText(aCol, aRow);
end;

procedure TGroupedMatrixControl.SetEditText(ACol, ARow: Longint;
  const Value: string);
var
  ValueRow: TGroupedMatrixValue;
  MatRow: TGroupedMatrixRow;
  GroupRow: TGroupedMatrixGroup;
begin
  if (aCol=ValueCol) and (aRow>0) then begin
    MatRow:=Matrix[aRow-FixedRows];
    if MatRow is TGroupedMatrixValue then begin
      ValueRow:=TGroupedMatrixValue(MatRow);
      if ValueRow.Value=Value then exit;
      StoreUndo;
      ValueRow.Value:=Value;
    end else begin
      GroupRow:=TGroupedMatrixGroup(MatRow);
      if GroupRow.Value=Value then exit;
      StoreUndo;
      GroupRow.Value:=Value;
      InvalidateRow(ARow);
    end;
  end;
  inherited SetEditText(ACol, ARow, Value);
end;

procedure TGroupedMatrixControl.DoEditorShow;
begin
  inherited DoEditorShow;
  InvalidateGroupedCells(Col,Row);
end;

function TGroupedMatrixControl.GetCells(ACol, ARow: Integer): string;
var
  MatRow: TGroupedMatrixRow;
begin
  if (aCol=ValueCol) and (aRow>0) then begin
    MatRow:=Matrix[ARow-FixedRows];
    if MatRow is TGroupedMatrixValue then
      Result:=TGroupedMatrixValue(MatRow).Value
    else
      Result:=TGroupedMatrixGroup(MatRow).Value;
    exit;
  end;
  Result:=inherited GetCells(ACol, ARow);
end;

constructor TGroupedMatrixControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  MouseWheelOption := mwGrid;

  FMatrix:=TGroupedMatrix.Create(Self);
  fUndoItems:=TObjectList.Create(true);
  fRedoItems:=TObjectList.Create(true);
  FMaxUndo:=DefaultModeMatrixMaxUndo;

  Options:=DefaultModeMatrixOptions;
  RowCount:=1;
  TitleStyle:=tsNative;
  AutoFillColumns:=true;
  FIndent:=DefaultModeMatrixIndent;
  FActiveModeColor:=RGBToColor(220,255,220);

  // type column
  FTypeColumn:=Columns.Add;
  FTypeColumn.Title.Caption:=dlgEnvType;
  FTypeColumn.SizePriority:=0;

  // value column
  FValueColumn:=Columns.Add;
  FValueColumn.Title.Caption:=lisValue;
  FValueColumn.SizePriority:=1;
end;

destructor TGroupedMatrixControl.Destroy;
begin
  Clear;
  FreeAndNil(fUndoItems);
  FreeAndNil(fRedoItems);
  FreeAndNil(FMatrix);
  inherited Destroy;
end;

procedure TGroupedMatrixControl.Clear;
begin
  fUndoItems.Clear;
  fRedoItems.Clear;
  inherited Clear;
end;

procedure TGroupedMatrixControl.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
  aState: TGridDrawState);

  procedure DrawActiveModeRow(ValueRow: TGroupedMatrixValue);
  begin
    if ActiveMode<0 then exit;
    if IndexInStringList(ValueRow.ModeList,cstCaseInsensitive,Modes[ActiveMode].Caption)<0
    then
      exit;
    Canvas.GradientFill(Rect(aRect.Left,(aRect.Top+aRect.Bottom) div 2,aRect.Right,aRect.Bottom),
      Color,ActiveModeColor,gdVertical);
  end;

var
  ts: TTextStyle;
  MatRow: TGroupedMatrixRow;
  ChkState: TCheckBoxState;
  Column: TGridColumn;
  ValueRow: TGroupedMatrixValue;
  ModeColor: TColor;
  StateColor: TColor;
  aHighlightColor: TColor;
begin
  //DebugLn(['TModeMatrixControl.DefaultDrawCell ']);
  if aRow=0 then begin
    // titles
    if aCol=0 then begin
      // title of tree
      DrawThemedCell(aCol, aRow, aRect, aState);
      exit;
    end else if (aCol>=1) and (aCol<=Modes.Count) then begin
      // mode names
      DrawThemedCell(aCol, aRow, aRect, aState);
      ts:=DefaultTextStyle;
      ts.Opaque:=false;
      Canvas.Brush.Style:=bsClear;
      Canvas.TextStyle:=ts;
      Canvas.Font.Orientation:=900;
      Canvas.TextOut(aRect.Left+1,aRect.Bottom-2,Modes[aCol-1].Caption);
      exit;
    end;
  end else if aCol=0 then begin
    // first column of a non group
    exit;
  end else begin
    Column:=Columns[aCol-1];
    MatRow:=Matrix.Rows[aRow-1];
    if MatRow is TGroupedMatrixValue then begin
      Canvas.FillRect(aRect);
      ValueRow:=TGroupedMatrixValue(MatRow);
      if aCol<=ModeColLast then begin
        ModeColor:=Modes[aCol-ModeColFirst].Color;
        if ModeColor=clDefault then ModeColor:=Color;
        StateColor:=Color;
        if ActiveMode=aCol-ModeColFirst then
          StateColor:=ActiveModeColor;
        if (ModeColor<>Color) or (StateColor<>Color) then begin
          Canvas.GradientFill(aRect,ModeColor,StateColor,gdHorizontal);
        end;
        ChkState:=cbUnchecked;
        GetCheckBoxState(aCol,aRow,ChkState);
        DrawGridCheckboxBitmaps(aCol,aRow,aRect,ChkState);
      end else if Column=TypeColumn then begin
        DrawActiveModeRow(ValueRow);
        DrawCellText(aCol,aRow,aRect,aState,ValueRow.Typ);
      end else if Column=ValueColumn then begin
        if Assigned(OnGetCellHightlightColor) then begin
          aHighlightColor:=clDefault;
          OnGetCellHightlightColor(Self,aCol,aRow,aHighlightColor);
          if aHighlightColor<>clDefault then
            Canvas.GradientFill(
              Rect(aRect.Left,aRect.Top,aRect.Right,(aRect.Top+aRect.Bottom) div 2),
              aHighlightColor,Color,gdVertical);
        end;
        DrawActiveModeRow(ValueRow);
        DrawCellText(aCol,aRow,aRect,aState,ValueRow.Value);
      end;
      exit;
    end;
  end;
  inherited DefaultDrawCell(aCol, aRow, aRect, aState);
end;

procedure TGroupedMatrixControl.MatrixChanging;
begin
  EditorHide;
end;

procedure TGroupedMatrixControl.MatrixChanged;
var
  i: Integer;
  aCol: TGridColumn;
begin
  for i:=0 to Modes.Count-1 do begin
    aCol:=Columns[i];
    if aCol=TypeColumn then begin
      // insert column
      Columns.Insert(i);
      aCol:=Columns[i];
      aCol.SizePriority:=0;
    end;
    aCol.Title.Caption:=Modes[i].Caption;
    {$IFDEF LCLcarbon}
    aCol.Alignment:=taLeftJustify;
    {$ELSE}
    aCol.Alignment:=taCenter;
    {$ENDIF}
    aCol.Width:=24;
  end;
  // free unneeded columns
  while Columns[Modes.Count]<>TypeColumn do
    Columns[Modes.Count].Free;

  RowCount:=Matrix.RowCount+1;

  AutoLayout;
  Invalidate;
end;

procedure TGroupedMatrixControl.DeleteMatrixRow(aRow: integer);
begin
  if (aRow<FixedRows) or (aRow>=RowCount) then exit;
  MatrixChanging;
  try
    StoreUndo;
    Matrix.DeleteRow(aRow-1);
  finally
    MatrixChanged;
  end;
end;

function TGroupedMatrixControl.ModeColFirst: integer;
begin
  Result:=1;
end;

function TGroupedMatrixControl.ModeColLast: integer;
begin
  Result:=Modes.Count;
end;

function TGroupedMatrixControl.TypeCol: integer;
begin
  Result:=Modes.Count+1;
end;

function TGroupedMatrixControl.ValueCol: integer;
begin
  Result:=Modes.Count+2;
end;

function TGroupedMatrixControl.CanUndo: boolean;
begin
  Result:=fUndoItems.Count>0;
end;

function TGroupedMatrixControl.CanRedo: boolean;
begin
  Result:=fRedoItems.Count>0;
end;

procedure TGroupedMatrixControl.Undo;
var
  DoMatrix: TGroupedMatrix;
begin
  if not CanUndo then exit;
  MatrixChanging;
  try
    DoMatrix:=TGroupedMatrix.Create(nil);
    DoMatrix.Assign(Matrix);
    fRedoItems.Add(DoMatrix);
    if MaxUndo<fRedoItems.Count then
      fRedoItems.Delete(0);
    DoMatrix:=TGroupedMatrix(fUndoItems[fUndoItems.Count-1]);
    fUndoItems.OwnsObjects:=false;
    fUndoItems.Delete(fUndoItems.Count-1);
    fUndoItems.OwnsObjects:=true;
    Matrix.Assign(DoMatrix);
  finally
    MatrixChanged;
  end;
end;

procedure TGroupedMatrixControl.Redo;
var
  DoMatrix: TGroupedMatrix;
begin
  if not CanRedo then exit;
  MatrixChanging;
  try
    DoMatrix:=TGroupedMatrix.Create(nil);
    DoMatrix.Assign(Matrix);
    fUndoItems.Add(DoMatrix);
    if MaxUndo<fUndoItems.Count then
      fUndoItems.Delete(0);
    DoMatrix:=TGroupedMatrix(fRedoItems[fRedoItems.Count-1]);
    fRedoItems.OwnsObjects:=false;
    fRedoItems.Delete(fRedoItems.Count-1);
    fRedoItems.OwnsObjects:=true;
    Matrix.Assign(DoMatrix);
  finally
    MatrixChanged;
  end;
end;

procedure TGroupedMatrixControl.StoreUndo(EvenIfNothingChanged: boolean);
var
  DoMatrix: TGroupedMatrix;
begin
  if (not EvenIfNothingChanged)
  and (fUndoItems.Count>0)
  and TGroupedMatrix(fUndoItems[fUndoItems.Count-1]).Equals(Matrix) then
    exit;
  fRedoItems.Clear;
  DoMatrix:=TGroupedMatrix.Create(nil);
  DoMatrix.Assign(Matrix);
  fUndoItems.Add(DoMatrix);
  if fUndoItems.Count>MaxUndo then
    fUndoItems.Delete(0);
end;

end.