path: root/gui/fpguigrid.inc

{
    fpGUI  -  Free Pascal GUI Library
    
    Grid class declarations
    
    Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

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

    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.pas}

{$IFDEF read_interface}

// -------------------------------------------------------------------
//   TFCustomGrid
// -------------------------------------------------------------------

  EInvalidGridOperation = class(Exception);

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


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


  TFCustomGrid = class(TFWidget)
  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;


// -------------------------------------------------------------------
//   TFDrawGrid
// -------------------------------------------------------------------

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


  TFDrawGrid = class(TFCustomGrid)
  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;


// -------------------------------------------------------------------
//   TFStringGrid
// -------------------------------------------------------------------

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


  TFStringGrid = class(TFDrawGrid)
  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';

// ===================================================================
//   TFCustomGrid
// ===================================================================

// public methods

constructor TFCustomGrid.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 TFCustomGrid.Destroy;
begin
  FreeMem(FRowHeights);
  FreeMem(FColWidths);
  ScrollingSupport.Free;
  inherited Destroy;
end;


// protected methods

procedure TFCustomGrid.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 TFCustomGrid.ProcessEvent(Event: TEventObj): Boolean;
begin
  Result := ScrollingSupport.ProcessEvent(Event) or
    inherited ProcessEvent(Event);
end;

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

procedure TFCustomGrid.CalcSizes;
begin
  ScrollingSupport.CalcSizes;
end;

procedure TFCustomGrid.Resized;
begin
  ScrollingSupport.Resized;
end;

procedure TFCustomGrid.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 TFCustomGrid.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 TFCustomGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
  Assert(OldColCount = OldColCount);
  Assert(OldRowCount = OldRowCount);
  // This dynamic method is only used for descendants of TFCustomGrid
end;


// private methods

procedure TFCustomGrid.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 TFCustomGrid.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 TFCustomGrid.SetFixedCols(AFixedCols: Integer);
begin
  if AFixedCols <> FixedCols then
  begin
    FFixedCols := AFixedCols;
    ScrollingSupport.HorzScrollBar.Max := ColCount -  FixedCols - 1;
  end;
end;

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

procedure TFCustomGrid.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 TFCustomGrid.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 TFCustomGrid.GetColWidths(ACol: Integer): Integer;
begin
  if (ACol < 0) or (ACol >= FColCount) then
    raise EInvalidGridOperation(SGridIndexOutOfRange);
  Result := FColWidths^[ACol];
end;

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

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

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

procedure TFCustomGrid.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 TFCustomGrid.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;


// -------------------------------------------------------------------
//   TFDrawGrid
// -------------------------------------------------------------------

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

function TFDrawGrid.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;


// -------------------------------------------------------------------
//   TFStringGrid
// -------------------------------------------------------------------

function TFStringGrid.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 TFStringGrid.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 TFStringGrid.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 TFStringGrid.DrawCell(ACanvas: TFCanvas; ACol, ARow: Integer;
  ARect: TRect;
 AState: TGridDrawState);
var
  s: String;
begin
  // WriteLn('TFStringGrid.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 TFStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.SizeChanged(0, 0);
end;

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


{$ENDIF read_implementation}