path: root/gui/grid.inc

{
    fpGUI  -  Free Pascal Graphical User Interface
    Copyright (C) 2000 - 2001 by
      Areca Systems GmbH / Sebastian Guenther
    Copyright (C) 2006 by Graeme Geldenhuys 
      member of the fpGUI development team.

    Grid class declarations

    See the file COPYING.fpGUI, included in this distribution,
    for details about the copyright.

    This program 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.

 **********************************************************************}


{%mainunit fpgui.pp}

{$IFDEF read_interface}

// -------------------------------------------------------------------
//   TCustomGrid
// -------------------------------------------------------------------

  EInvalidGridOperation = class(Exception);

  TGridDrawState = set of (gdSelected, gdFocused, gdFixed);


  PIntegerArray = ^TIntegerArray;
  TIntegerArray = array[0..(MAXINT div SizeOf(Integer))-1] of Integer;


  TCustomGrid = class(TWidget)
  private
    FColCount: Integer;
    FRowCount: Integer;
    FFixedCols: Integer;
    FFixedRows: Integer;
    FDefaultColWidth: Integer;
    FDefaultRowHeight: Integer;
    FGridWidth: Integer;
    FGridHeight: Integer;
    FFixedWidth: Integer;
    FFixedHeight: Integer;
    FColWidths, FRowHeights: PIntegerArray;
    procedure SetColCount(AColCount: Integer);
    procedure SetRowCount(ARowCount: Integer);
    procedure SetFixedCols(AFixedCols: Integer);
    procedure SetFixedRows(AFixedRows: Integer);
    procedure SetDefaultColWidth(AWidth: Integer);
    procedure SetDefaultRowHeight(AHeight: Integer);
    function  GetColWidths(ACol: Integer): Integer;
    procedure SetColWidths(ACol, AWidth: Integer);
    function  GetRowHeights(ARow: Integer): Integer;
    procedure SetRowHeights(ARow, AHeight: Integer);
    procedure HorzScrollBarScroll(Sender: TObject; var APosition: Integer);
    procedure VertScrollBarScroll(Sender: TObject; var APosition: Integer);
  protected
    ScrollingSupport: TScrollingSupport;
    procedure Paint(Canvas: TFCanvas); override;
    function  ProcessEvent(Event: TEventObj): Boolean; override;
    function  DistributeEvent(Event: TEventObj): Boolean; override;
    procedure CalcSizes; override;
    procedure Resized; override;
    procedure ColWidthsChanged; dynamic;
    procedure DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); virtual; abstract;
    procedure RowHeightsChanged; dynamic;
    procedure SizeChanged(OldColCount, OldRowCount: Integer); dynamic;
    property  CanExpandWidth default True;
    property  CanExpandHeight default True;
    property  ColCount: Integer read FColCount write SetColCount default 5;
    property  RowCount: Integer read FRowCount write SetRowCount default 5;
    property  FixedCols: Integer read FFixedCols write SetFixedCols default 1;
    property  FixedRows: Integer read FFixedRows write SetFixedRows default 1;
    property  GridWidth: Integer read FGridWidth;
    property  GridHeight: Integer read FGridHeight;
    property  FixedWidth: Integer read FFixedWidth;
    property  FixedHeight: Integer read FFixedHeight;
    property  DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64;
    property  DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24;
    property  ColWidths[ACol: Integer]: Integer read GetColWidths write SetColWidths;
    property  RowHeights[ARow: Integer]: Integer read GetRowHeights write SetRowHeights;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  end;


// -------------------------------------------------------------------
//   TDrawGrid
// -------------------------------------------------------------------

  TDrawCellEvent = procedure(Sender: TObject; ACanvas: TFCanvas;
    ACol, ARow: Integer; Rect: TRect; State: TGridDrawState) of object;


  TDrawGrid = class(TCustomGrid)
  private
    FOnDrawCell: TDrawCellEvent;
  protected
    procedure DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
  public
    function CellRect(ACol, ARow: Integer): TRect;
    property ColWidths;
    property RowHeights;
  published
    property CanExpandWidth;
    property CanExpandHeight;
    property ColCount;
    property RowCount;
    property FixedCols;
    property FixedRows;
    property DefaultColWidth;
    property DefaultRowHeight;
    property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
  end;


// -------------------------------------------------------------------
//   TStringGrid
// -------------------------------------------------------------------

  PCells = ^TCells;
  TCells = array[0..(1 shl 30) div SizeOf(AnsiString)] of AnsiString;


  TStringGrid = class(TDrawGrid)
  private
    CellStrings: PCells;
    function    GetCells(ACol, ARow: Integer): String;
    procedure   SetCells(ACol, ARow: Integer; const AValue: String);
  protected
    //function GetEditText(ACol, ARow: Integer): String; override;
    //procedure SetEditText(ACol, ARow: Integer; const AValue: String); override;
    procedure   SizeChanged(OldColCount, OldRowCount: Integer); override;
    //procedure ColumnMoved(AFrom, ATo: Integer); override;
    //procedure RowMoved(AFrom, ATo: Integer); override;
    procedure   DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property    Cells[ACol, ARow: Integer]: String read GetCells write SetCells;
    property    Cols[Index: Integer]: TStrings;
    property    Objects[ACol, ARow: Integer]: TObject;
    property    Rows[Index: Integer]: TStrings;
  end;

{$ENDIF read_interface}



{$IFDEF read_implementation}


resourcestring

  SGridIndexOutOfRange = 'Grid index out of range';

// ===================================================================
//   TCustomGrid
// ===================================================================

// public methods

constructor TCustomGrid.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(AOwner);
  WidgetStyle := WidgetStyle + [wsOpaque];
  FCanExpandWidth := True;
  FCanExpandHeight := True;
  ScrollingSupport := TScrollingSupport.Create(Self);
  ScrollingSupport.HorzScrollBar.OnScroll := @HorzScrollBarScroll;
  ScrollingSupport.VertScrollBar.OnScroll := @VertScrollBarScroll;

  FDefaultColWidth := 64;
  FDefaultRowHeight := 24;
  FColCount := 5;
  FRowCount := 5;
  FFixedCols := 1;
  FFixedRows := 1;
  GetMem(FColWidths, FColCount * SizeOf(Integer));
  GetMem(FRowHeights, FRowCount * SizeOf(Integer));

  for i := 0 to 4 do
  begin
    FColWidths^[i] := FDefaultColWidth;
    FRowHeights^[i] := FDefaultRowHeight;
  end;
  ColWidthsChanged;
  RowHeightsChanged;
end;

destructor TCustomGrid.Destroy;
begin
  FreeMem(FRowHeights);
  FreeMem(FColWidths);
  ScrollingSupport.Free;
  inherited Destroy;
end;


// protected methods

procedure TCustomGrid.Paint(Canvas: TFCanvas);
var
  x1, y1, x2, y2, x, y, Sum: Integer;
  CellRect: TRect;
  GridDrawState: TGridDrawState;
begin
  if not Canvas.IntersectClipRect(ScrollingSupport.ClientRect) then
    exit;

  with Canvas.GetClipRect do
  begin
    x1 := Left;
    y1 := Top;
    x2 := Right;
    y2 := Bottom;
  end;

  { Initialize these for the case that the cell drawing loop won't get
    executed at all: }
  CellRect.Left := 0;
  CellRect.Right := 0;

  // Draw the cells

  CellRect.Top := ScrollingSupport.ClientRect.Top;
  y := 0;
  while y < RowCount do
  begin
    CellRect.Bottom := CellRect.Top + RowHeights[y];
    if CellRect.Bottom > y1 then
    begin
      CellRect.Left := ScrollingSupport.ClientRect.Left;
      x := 0;
      while x < ColCount do
      begin
        CellRect.Right := CellRect.Left + ColWidths[x];
	if CellRect.Right > x1 then
	begin
	  GridDrawState := [];
	  if (x < FixedCols) or (y < FixedRows) then
	    Include(GridDrawState, gdFixed);

	  Canvas.SaveState;
	  if gdFixed in GridDrawState then
	  begin
	    with CellRect do
	      Style.DrawButtonFace(Canvas,
	        Rect(Left, Top, Right + 1, Bottom + 1), []);
	    Style.SetUIColor(Canvas, clBtnText);
	  end else
	  begin
	    Style.SetUIColor(Canvas, clWindow);
	    Canvas.FillRect(CellRect);
	    Style.SetUIColor(Canvas, clWindowText);
	  end;
	  DrawCell(Canvas, x, y, CellRect, GridDrawState);
	  Canvas.RestoreState;
	end;

	CellRect.Left := CellRect.Right + 1;
	if CellRect.Left >= x2 then
	  break;

        Inc(x);
        if x = FixedRows then
          Inc(x, ScrollingSupport.HorzScrollBar.Position);
      end;
    end;

    CellRect.Top := CellRect.Bottom + 1;
    if CellRect.Top >= y2 then
      break;

    Inc(y);
    if y = FixedRows then
      Inc(y, ScrollingSupport.VertScrollBar.Position);
  end;


  // Draw the grid lines

  Style.SetUIColor(Canvas, cl3DFace);

  y := 0;
  Sum := ScrollingSupport.ClientRect.Top;
  while y < RowCount do
  begin
    Inc(Sum, RowHeights[y]);
    if (y >= FixedRows) and (Sum >= y1) then
      Canvas.DrawLine(Point(ScrollingSupport.ClientRect.Left + FixedWidth, Sum),
        Point(CellRect.Right + 1, Sum));
    Inc(Sum);
    if Sum >= y2 then
      break;

    Inc(y);
    if y = FixedRows then
      Inc(y, ScrollingSupport.VertScrollBar.Position);
  end;

  x := 0;
  Sum := ScrollingSupport.ClientRect.Left;
  while x < ColCount do
  begin
    Inc(Sum, ColWidths[x]);
    if (x >= FixedCols) and (Sum >= x1) then
      Canvas.DrawLine(Point(Sum, ScrollingSupport.ClientRect.Top + FixedHeight),
        Point(Sum, CellRect.Bottom));
    Inc(Sum);
    if Sum >= x2 then
      break;

    Inc(x);
    if x = FixedCols then
      Inc(x, ScrollingSupport.HorzScrollBar.Position);
  end;


  // Clear the empty space right and below the grid itself

  Style.SetUIColor(Canvas, clWindow);
  if CellRect.Right + 1 < x2 then
    Canvas.FillRect(Rect(CellRect.Right + 1, y1, x2, y2));
  if CellRect.Bottom + 1 < y2 then
    Canvas.FillRect(Rect(x1, CellRect.Top, CellRect.Right + 1, y2));
end;

function TCustomGrid.ProcessEvent(Event: TEventObj): Boolean;
begin
  Result := ScrollingSupport.ProcessEvent(Event) or
    inherited ProcessEvent(Event);
end;

function TCustomGrid.DistributeEvent(Event: TEventObj): Boolean;
begin
  Result := ScrollingSupport.DistributeEvent(Event) or
    inherited DistributeEvent(Event);
end;

procedure TCustomGrid.CalcSizes;
begin
  ScrollingSupport.CalcSizes;
end;

procedure TCustomGrid.Resized;
begin
  ScrollingSupport.Resized;
end;

procedure TCustomGrid.ColWidthsChanged;
var
  i: Integer;
begin
  FGridWidth := 0;
  for i := 0 to ColCount - 1 do
    Inc(FGridWidth, ColWidths[i] + 1);
  if FGridWidth > 0 then
    Dec(FGridWidth);

  FFixedWidth := 0;
  for i := 0 to FixedCols - 1 do
    Inc(FFixedWidth, ColWidths[i] + 1);
  if FFixedWidth > 0 then
    Dec(FFixedWidth);
end;

procedure TCustomGrid.RowHeightsChanged;
var
  i: Integer;
begin
  FGridHeight := 0;
  for i := 0 to RowCount - 1 do
    Inc(FGridHeight, RowHeights[i] + 1);
  if FGridHeight > 0 then
    Dec(FGridHeight);

  FFixedHeight := 0;
  for i := 0 to FixedRows - 1 do
    Inc(FFixedHeight, RowHeights[i] + 1);
  if FFixedHeight > 0 then
    Dec(FFixedHeight);
end;

procedure TCustomGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
  // This dynamic method is only used for descendants of TCustomGrid
end;


// private methods

procedure TCustomGrid.SetColCount(AColCount: Integer);
var
  OldColCount, i: Integer;
begin
  if AColCount <> FColCount then
  begin
    OldColCount := FColCount;
    FColCount := AColCount;

    ReallocMem(FColWidths, FColCount * SizeOf(Integer));
    for i := OldColCount to FColCount - 1 do
      FColWidths^[i] := FDefaultColWidth;

    ScrollingSupport.HorzScrollBar.Max := ColCount -  FixedCols - 1;

    ColWidthsChanged;
    SizeChanged(OldColCount, FRowCount);
  end;
end;

procedure TCustomGrid.SetRowCount(ARowCount: Integer);
var
  OldRowCount, i: Integer;
begin
  if ARowCount <> FRowCount then
  begin
    OldRowCount := FRowCount;
    FRowCount := ARowCount;

    ReallocMem(FRowHeights, FRowCount * SizeOf(Integer));
    for i := OldRowCount to FRowCount - 1 do
      FRowHeights^[i] := FDefaultRowHeight;

    ScrollingSupport.VertScrollBar.Max := RowCount - FixedRows - 1;

    RowHeightsChanged;
    SizeChanged(FColCount, OldRowCount);
  end;
end;

procedure TCustomGrid.SetFixedCols(AFixedCols: Integer);
begin
  if AFixedCols <> FixedCols then
  begin
    FFixedCols := AFixedCols;
    ScrollingSupport.HorzScrollBar.Max := ColCount -  FixedCols - 1;
  end;
end;

procedure TCustomGrid.SetFixedRows(AFixedRows: Integer);
begin
  if AFixedRows <> FixedRows then
  begin
    FFixedRows := AFixedRows;
    ScrollingSupport.VertScrollBar.Max := RowCount - FixedRows - 1;
  end;
end;

procedure TCustomGrid.SetDefaultColWidth(AWidth: Integer);
var
  i: Integer;
begin
  if AWidth <> FDefaultColWidth then
  begin
    FDefaultColWidth := AWidth;
    for i := 0 to FColCount - 1 do
      FColWidths^[i] := AWidth;
    ColWidthsChanged;
  end;
end;

procedure TCustomGrid.SetDefaultRowHeight(AHeight: Integer);
var
  i: Integer;
begin
  if AHeight <> FDefaultRowHeight then
  begin
    FDefaultRowHeight := AHeight;
    for i := 0 to FRowCount - 1 do
      FRowHeights^[i] := AHeight;
    RowHeightsChanged;
  end;
end;

function TCustomGrid.GetColWidths(ACol: Integer): Integer;
begin
  if (ACol < 0) or (ACol >= FColCount) then
    raise EInvalidGridOperation(SGridIndexOutOfRange);
  Result := FColWidths^[ACol];
end;

procedure TCustomGrid.SetColWidths(ACol, AWidth: Integer);
begin
  if (ACol < 0) or (ACol >= FColCount) then
    raise EInvalidGridOperation(SGridIndexOutOfRange);
  FColWidths^[ACol] := AWidth;
end;

function TCustomGrid.GetRowHeights(ARow: Integer): Integer;
begin
  if (ARow < 0) or (ARow >= FRowCount) then
    raise EInvalidGridOperation(SGridIndexOutOfRange);
  Result := FRowHeights^[ARow];
end;

procedure TCustomGrid.SetRowHeights(ARow, AHeight: Integer);
begin
  if (ARow < 0) or (ARow >= FRowCount) then
    raise EInvalidGridOperation(SGridIndexOutOfRange);
  FRowHeights^[ARow] := AHeight;
end;

procedure TCustomGrid.HorzScrollBarScroll(Sender: TObject;
  var APosition: Integer);
var
  i, Delta: Integer;
  r: TRect;
begin
  Delta := 0;
  if APosition > ScrollingSupport.HorzScrollBar.Position then
    for i := ScrollingSupport.HorzScrollBar.Position to APosition - 1 do
      Dec(Delta, ColWidths[i + FixedCols] + 1)
  else
    for i := APosition to ScrollingSupport.HorzScrollBar.Position - 1 do
      Inc(Delta, ColWidths[i + FixedCols] + 1);

  // Scroll the horizontal fixed cells
  r := ScrollingSupport.ClientRect;
  Inc(r.Left, FixedWidth + 1);
  if r.Left <= r.Right then
  begin
    if Delta < 0 then		// Scrolling to the right side
      Dec(r.Left, Delta)
    else			// Scrolling to the left side
      Dec(r.Right, Delta);
    Scroll(r, Delta, 0);
  end;
end;

procedure TCustomGrid.VertScrollBarScroll(Sender: TObject;
  var APosition: Integer);
var
  i, Delta: Integer;
  r: TRect;
begin
  Delta := 0;
  if APosition > ScrollingSupport.VertScrollBar.Position then
    for i := ScrollingSupport.VertScrollBar.Position to APosition - 1 do
      Dec(Delta, RowHeights[i + FixedRows] + 1)
  else
    for i := APosition to ScrollingSupport.VertScrollBar.Position - 1 do
      Inc(Delta, RowHeights[i + FixedRows] + 1);

  // Scroll the grid body
  r := ScrollingSupport.ClientRect;
  Inc(r.Top, FixedHeight + 1);
  if r.Top <= r.Bottom then
  begin
    if Delta < 0 then		// Scrolling downwards
      Dec(r.Top, Delta)
    else			// Scrolling upwards
      Dec(r.Bottom, Delta);
    Scroll(r, 0, Delta);
  end;
end;


// -------------------------------------------------------------------
//   TDrawGrid
// -------------------------------------------------------------------

procedure TDrawGrid.DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer;
  ARect: TRect;
 AState: TGridDrawState);
begin
  if Assigned(OnDrawCell) then
    OnDrawCell(Self, ACanvas, ACol, ARow, ARect, AState);
end;

function TDrawGrid.CellRect(ACol, ARow: Integer): TRect;
var
  i: Integer;
begin
  Result.Left := 0;
  for i := 0 to ACol - 1 do
    Inc(Result.Left, ColWidths[i]);
  Result.Right := Result.Left + ColWidths[ACol];

  Result.Top := 0;
  for i := 0 to ARow - 1 do
    Inc(Result.Top, RowHeights[i]);
  Result.Bottom := Result.Top + RowHeights[ARow];
end;


// -------------------------------------------------------------------
//   TStringGrid
// -------------------------------------------------------------------

function TStringGrid.GetCells(ACol, ARow: Integer): String;
begin
  if (ACol >= 0) and (ARow >= 0) and (ACol < ColCount) and (ARow < RowCount) then
    Result := CellStrings^[ARow * ColCount + ACol]
  else
    SetLength(Result, 0);
end;

procedure TStringGrid.SetCells(ACol, ARow: Integer; const AValue: String);
begin
  if (ACol >= 0) and (ARow >= 0) and (ACol < ColCount) and (ARow < RowCount) then
    CellStrings^[ARow * ColCount + ACol] := AValue;
end;

procedure TStringGrid.SizeChanged(OldColCount, OldRowCount: Integer);
var
  Count: Integer;
begin
  inherited SizeChanged(OldColCount, OldRowCount);
  ReallocMem(CellStrings, ColCount * RowCount * SizeOf(AnsiString));
  Count := ColCount * RowCount - OldColCount * OldRowCount;
  if Count > 0 then
    FillChar(CellStrings^[OldColCount * OldRowCount],
      Count * SizeOf(AnsiString), #0);
end;

procedure TStringGrid.DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer;
  ARect: TRect;
 AState: TGridDrawState);
var
  s: String;
begin
  // WriteLn('TStringGrid.DrawCell(', ACol, ', ', ARow, ', ', Integer(AState), ');');
  s := Cells[ACol, ARow];
  if Length(s) > 0 then
    ACanvas.TextOut(ARect.TopLeft + Point(2, 2), s);
  if Assigned(OnDrawCell) then
    OnDrawCell(Self, ACanvas, ACol, ARow, ARect, AState);
end;

constructor TStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.SizeChanged(0, 0);
end;

destructor TStringGrid.Destroy;
var
  i: Integer;
begin
  for i := 0 to RowCount * ColCount - 1 do
    CellStrings^[i] := '';
  FreeMem(CellStrings);
  inherited Destroy;
end;


{$ENDIF read_implementation}