path: root/src/gui/gui_basegrid.pas

unit gui_basegrid;

{$mode objfpc}{$H+}

{
  TODO:
    * Selecting the last fully visible row, scrolls the grid. Selection
      is corruct, but because of the scroll it is confusing.
}

{.$Define DEBUG}

interface

uses
  Classes,
  SysUtils,
  gfxbase,
  fpgfx,
  gfx_widget,
  gui_scrollbar;
  
type

  TfpgFocusChangeNotify = procedure(Sender: TObject; ARow, ACol: integer) of object;
  TfpgRowChangeNotify = procedure(Sender: TObject; ARow: integer) of object;


  // Column 2 is special just for testing purposes. Descendant classes will
  // override that special behavior anyway.
  TfpgBaseGrid = class(TfpgWidget)
  private
    FBackgroundColor: TfpgColor;
    FColResizing: boolean;
    FDragPos: integer;      // used for column resizing
    FResizedCol: integer;   // used for column resizing
    FDefaultColWidth: integer;
    FDefaultRowHeight: integer;
    FFocusCol: integer;
    FFocusRow: integer;
    FHeaderHeight: integer;
    FOnFocusChange: TfpgFocusChangeNotify;
    FOnRowChange: TfpgRowChangeNotify;
    FPrevCol: integer;
    FPrevRow: integer;
    FFirstRow: integer;
    FFirstCol: integer;
    FMargin: integer;
    FFont: TfpgFont;
    FHeaderFont: TfpgFont;
    FRowSelect: boolean;
    FShowGrid: boolean;
    FShowHeader: boolean;
    FTemp: integer;
    FVScrollBar: TfpgScrollBar;
    FHScrollBar: TfpgScrollBar;
    procedure   HScrollBarMove(Sender: TObject; position: integer);
    procedure   SetRowSelect(const AValue: boolean);
    procedure   VScrollBarMove(Sender: TObject; position: integer);
    procedure   SetBackgroundColor(const AValue: TfpgColor);
    procedure   SetDefaultColWidth(const AValue: integer);
    procedure   SetDefaultRowHeight(const AValue: integer);
    procedure   SetFocusCol(const AValue: integer);
    procedure   SetFocusRow(const AValue: integer);
    procedure   CheckFocusChange;
    procedure   SetShowGrid(const AValue: boolean);
    procedure   SetShowHeader(const AValue: boolean);
    function    VisibleLines: integer;
    function    VisibleWidth: integer;
  protected
    procedure   UpdateScrollBars; virtual;
    function    GetHeaderText(ACol: integer): string; virtual;
    function    GetColumnWidth(ACol: integer): integer; virtual;
    procedure   SetColumnWidth(ACol: integer; const AValue: integer); virtual;
    function    GetColumnCount: integer; virtual;
    function    GetRowCount: integer; virtual;
    procedure   DrawCell(ARow, ACol: integer; ARect: TfpgRect; AFlags: integer); virtual;
    procedure   DrawHeader(ACol: integer; ARect: TfpgRect; AFlags: integer); virtual;
    procedure   DrawGrid(ARow, ACol: integer; ARect: TfpgRect; AFlags: integer); virtual;
    procedure   HandlePaint; override;
    procedure   HandleShow; override;
    procedure   HandleResize(awidth, aheight: TfpgCoord); override;
    procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
    procedure   HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
    procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
    procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
    procedure   FollowFocus; virtual;
    property    DefaultColWidth: integer read FDefaultColWidth write SetDefaultColWidth default 64;
    property    DefaultRowHeight: integer read FDefaultRowHeight write SetDefaultRowHeight;
    property    Font: TfpgFont read FFont;
    property    HeaderFont: TfpgFont read FHeaderFont;
    property    BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor;
    property    FocusCol: integer read FFocusCol write SetFocusCol;
    property    FocusRow: integer read FFocusRow write SetFocusRow;
    property    RowSelect: boolean read FRowSelect write SetRowSelect;
    property    ColumnCount: integer read GetColumnCount;
    property    RowCount: integer read GetRowCount;
    property    ShowHeader: boolean read FShowHeader write SetShowHeader;
    property    ShowGrid: boolean read FShowGrid write SetShowGrid;
    property    HeaderHeight: integer read FHeaderHeight;
    property    ColResizing: boolean read FColResizing write FColResizing;
    property    ColumnWidth[ACol: integer]: integer read GetColumnWidth write SetColumnWidth;
    property    OnFocusChange: TfpgFocusChangeNotify read FOnFocusChange write FOnFocusChange;
    property    OnRowChange: TfpgRowChangeNotify read FOnRowChange write FOnRowChange;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   Update;
  end;

implementation

{ TfpgBaseGrid }

procedure TfpgBaseGrid.HScrollBarMove(Sender: TObject; position: integer);
begin
  if FFirstCol <> position then
  begin
    if Position < 1 then
      Position := 1;
    FFirstCol := position;
    RePaint;
  end;
end;

procedure TfpgBaseGrid.SetRowSelect(const AValue: boolean);
begin
  if FRowSelect = AValue then
    Exit; //==>
  FRowSelect := AValue;
  RePaint;
end;

procedure TfpgBaseGrid.VScrollBarMove(Sender: TObject; position: integer);
begin
  if FFirstRow <> position then
  begin
    FFirstRow := position;
    RePaint;
  end;
end;

procedure TfpgBaseGrid.SetBackgroundColor(const AValue: TfpgColor);
begin
  if FBackgroundColor = AValue then
    Exit; //==>
  FBackgroundColor := AValue;
  RePaint;
end;

procedure TfpgBaseGrid.SetDefaultColWidth(const AValue: integer);
begin
  if FDefaultColWidth = AValue then
    Exit; //==>
  FDefaultColWidth := AValue;
  RePaint;
end;

procedure TfpgBaseGrid.SetDefaultRowHeight(const AValue: integer);
begin
  if FDefaultRowHeight = AValue then
    Exit; //==>
  FDefaultRowHeight := AValue;
  RePaint;
end;

function TfpgBaseGrid.GetColumnWidth(ACol: integer): integer;
begin
  // GetColumnWidth and SetColumnWidth will be overriden in decendant!
  // Column 2 is special just for testing purposes
  if ACol = 2 then
    Result := FTemp
  else
    Result := FDefaultColWidth+(ACol*16);
end;

procedure TfpgBaseGrid.SetColumnWidth(ACol: integer; const AValue: integer);
begin
  // GetColumnWidth and SetColumnWidth will be overriden in decendant!
  // Column 2 is special just for testing purposes
  if (ACol = 2) and (AValue <> FTemp) then
  begin
    FTemp := AValue;
    UpdateScrollBars;
    Repaint;
  end;
end;

function TfpgBaseGrid.GetColumnCount: integer;
begin
  Result := 7;
end;

function TfpgBaseGrid.GetRowCount: integer;
begin
  Result := 24;
end;

procedure TfpgBaseGrid.DrawCell(ARow, ACol: integer; ARect: TfpgRect; AFlags: integer);
var
  s: string;
begin
  s := 'c(' + IntToStr(ARow) + ',' + IntToStr(ACol) + ')';
  if (ARow = 5) and (ACol = 2) then
    s := 'Here lives Graeme!';
  if not Enabled then
    Canvas.SetTextColor(clShadow1);
  Canvas.DrawString(ARect.Left+1, ARect.Top+1, s);
end;

procedure TfpgBaseGrid.DrawHeader(ACol: integer; ARect: TfpgRect; AFlags: integer);
var
  s: string;
  r: TfpgRect;
  x: integer;
begin
  // Here we can implement a head style check
  Canvas.DrawButtonFace(ARect, [btnIsEmbedded]);
  r := ARect;
  InflateRect(r, -2, -2);
  Canvas.SetClipRect(r);  // text cannot oversheet header border
(*
  // drawing grid lines
  Canvas.SetColor(clGridLines);
  Canvas.DrawLine(r.Left, r.Bottom+1, r.Right+1, r.Bottom+1);  // horizontal bottom
  Canvas.DrawLine(r.Right+1, r.Top, r.Right+1, r.Bottom+1);    // vertical right

  if (ACol mod 2) = 0 then
    Canvas.SetColor(clGridHeader)
  else
    Canvas.SetColor(clMagenta);
  Canvas.FillRectangle(ARect);
*)

  Canvas.SetTextColor(clText1);
  s := GetHeaderText(ACol);
  x := (ARect.Left + (ARect.Width div 2)) - (FHeaderFont.TextWidth(s) div 2);
  if x < 1 then
    x := 1;
  fpgStyle.DrawString(Canvas, x, ARect.Top+1, s, Enabled);
end;

procedure TfpgBaseGrid.DrawGrid(ARow, ACol: integer; ARect: TfpgRect;
  AFlags: integer);
begin
  // default is inside bottom/right edge or cell
  Canvas.SetColor(clGridLines);
  Canvas.DrawLine(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom); // cell bottom
  Canvas.DrawLine(ARect.Right, ARect.Bottom, ARect.Right, ARect.Top-1); // cell right
end;

procedure TfpgBaseGrid.SetFocusCol(const AValue: integer);
begin
  if FFocusCol = AValue then
    Exit; //==>
  FFocusCol := AValue;

  // apply min/max limit
  if FFocusCol < 1 then
    FFocusCol := 1;
  if FFocusCol > ColumnCount then
    FFocusCol := ColumnCount;

  FollowFocus;
  CheckFocusChange;
  UpdateScrollBars;
end;

procedure TfpgBaseGrid.SetFocusRow(const AValue: integer);
begin
  if FFocusRow = AValue then
    Exit; //==>
  FFocusRow := AValue;

  // apply min/max limit
  if FFocusRow < 1 then
    FFocusRow := 1;
  if FFocusRow > RowCount then
    FFocusRow := RowCount;
    
  FollowFocus;
  CheckFocusChange;
  UpdateScrollBars;
end;

procedure TfpgBaseGrid.CheckFocusChange;
begin
  if ((FPrevCol <> FFocusCol) and not RowSelect) or (FPrevRow <> FFocusRow) then
    if Assigned(FOnFocusChange) then
      FOnFocusChange(self, FFocusRow, FFocusCol);

  if (FPrevRow <> FFocusRow) then
    if Assigned(FOnRowChange) then
      FOnRowChange(self, FFocusRow);

  FPrevCol := FFocusCol;
  FPrevRow := FFocusRow;
end;

procedure TfpgBaseGrid.SetShowGrid(const AValue: boolean);
begin
  if FShowGrid = AValue then
    Exit; //==>
  FShowGrid := AValue;
  RePaint;
end;

procedure TfpgBaseGrid.SetShowHeader(const AValue: boolean);
begin
  if FShowHeader = AValue then
    Exit; //==>
  FShowHeader := AValue;
  UpdateScrollBars;
  RePaint;
end;

function TfpgBaseGrid.VisibleLines: integer;
var
  hh: integer;
begin
  if FHScrollBar.Visible then
    hh := FHScrollbar.Height
  else
    hh := 0;
  if ShowHeader then
    hh := hh + FHeaderHeight+1;
  Result := (Height - 2*FMargin - hh) div (FDefaultRowHeight+1)
end;

function TfpgBaseGrid.VisibleWidth: integer;
var
  sw: integer;
begin
  if FVScrollBar.Visible then
    sw := FVScrollBar.Width-1
  else
    sw := 0;
  Result := Width - FMargin*2 - sw;
end;

procedure TfpgBaseGrid.UpdateScrollBars;
var
  HWidth: integer;
  VHeight: integer;
  vw: integer;
  cw: integer;
  i: integer;
begin
  VHeight := Height - 4;
  HWidth  := Width - 4;
  
  vw := VisibleWidth;
  cw := 0;
  for i := 1 to ColumnCount do
    cw := cw + ColumnWidth[i];

  // This needs improving while resizing
  if cw > vw then
    FHScrollBar.Visible := True
  else
  begin
    FHScrollBar.Visible := False;
    FFirstCol := 1;
  end;
  
  // This needs improving while resizing
  if (RowCount > VisibleLines) then
    FVScrollBar.Visible := True
  else
  begin
    FVScrollBar.Visible := False;
    FFirstRow := 1;
  end;

  if FVScrollBar.Visible then
  begin
    Dec(HWidth, FVScrollBar.Width);
    FVScrollBar.Min         := 1;
    if RowCount > 0 then
      FVScrollBar.SliderSize := VisibleLines / RowCount
    else
      FVScrollBar.SliderSize := 0;
    FVScrollBar.Max         := RowCount-VisibleLines+1;
    FVScrollBar.Position    := FFirstRow;
    FVScrollBar.RepaintSlider;
  end;
  
  if FHScrollBar.Visible then
  begin
    Dec(VHeight, FHScrollBar.Height);
    FHScrollBar.Min         := 1;
    FHScrollBar.SliderSize  := 0.2;
    FHScrollBar.Max         := ColumnCount;
    FHScrollBar.Position    := FFirstCol;
    FHScrollBar.RepaintSlider;
  end;

  FHScrollBar.Top     := Height -FHScrollBar.Height - 2;
  FHScrollBar.Left    := 2;
  FHScrollBar.Width   := HWidth;

  FVScrollBar.Top     := 2;
  FVScrollBar.Left    := Width - FVScrollBar.Width - 2;
  FVScrollBar.Height  := VHeight;

  FVScrollBar.UpdateWindowPosition;
  FHScrollBar.UpdateWindowPosition;
end;

function TfpgBaseGrid.GetHeaderText(ACol: integer): string;
begin
  Result := 'Head ' + IntToStr(ACol);
end;

procedure TfpgBaseGrid.HandlePaint;
var
  r: TfpgRect;
  r2: TfpgRect;
  col: integer;
  row: integer;
  clipr: TfpgRect;   // clip rectangle
begin
  Canvas.BeginDraw;
//  inherited HandlePaint;
  Canvas.ClearClipRect;

  r.SetRect(0, 0, Width, Height);
  Canvas.DrawControlFrame(r);

  InflateRect(r, -2, -2);
  Canvas.SetClipRect(r);
  Canvas.SetColor(FBackgroundColor);
  Canvas.FillRectangle(r);
  
  clipr.SetRect(FMargin, FMargin, VisibleWidth, Height-(2*FMargin));
  r := clipr;

  if (ColumnCount > 0) and ShowHeader then
  begin
    // Drawing horizontal headers
    r.Height := FHeaderHeight;
    Canvas.SetFont(FHeaderFont);
    for col := FFirstCol to ColumnCount do
    begin
      r.Width := ColumnWidth[col];
      Canvas.SetClipRect(clipr);
      Canvas.AddClipRect(r);
      DrawHeader(col, r, 0);
      inc(r.Left, r.Width);
      if r.Left >= clipr.Right then
        Break;  // small optimization. Don't draw what we can't see
    end;
    inc(r.Top, r.Height);
  end;

  if (RowCount > 0) and (ColumnCount > 0) then
  begin
    // Drawing cells
    r.Height := DefaultRowHeight;
    Canvas.SetFont(FFont);

    for row := FFirstRow to RowCount do
    begin
      r.Left := FMargin;
      for col := FFirstCol to ColumnCount do
      begin
        r.Width := ColumnWidth[col];
        Canvas.SetClipRect(clipr);
//        Canvas.SetClipRect(r);

        if (row = FFocusRow) and (RowSelect or (col = FFocusCol)) then
        begin
          if FFocused then
          begin
            Canvas.SetColor(clSelection);
            Canvas.SetTextColor(clSelectionText);
          end
          else
          begin
            Canvas.SetColor(clInactiveSel);
            Canvas.SetTextColor(clInactiveSelText);
          end;
        end
        else
        begin
          Canvas.SetColor(BackgroundColor);
          Canvas.SetTextColor(clText1);
        end;
        Canvas.AddClipRect(r);
        Canvas.FillRectangle(r);
        DrawCell(row, col, r, 0);

        // drawing grid lines
        if FShowGrid then
          DrawGrid(row, col, r, 0);

        inc(r.Left, r.Width);
        if r.Left >= clipr.Right then
          Break;  // small optimization. Don't draw what we can't see
      end;
//      Inc(r.Top, FDefaultRowHeight+1);
      inc(r.Top, r.Height);
      if r.Top >= clipr.Bottom then
        break;
    end;
  end; // item drawing

  Canvas.SetClipRect(clipr);
  Canvas.SetColor(FBackgroundColor);
  
  // clearing after the last column
  if r.Left <= clipr.Right then
  begin
    r2.Left   := r.Left;
    r2.Top    := clipr.Top;
    r2.SetRight(clipr.Right);
    r2.Height := clipr.Height;
    Canvas.FillRectangle(r2);
  end;

  // clearing after the last row
  if r.Top <= clipr.Bottom then
  begin
    r.Left    := clipr.Left;
    r.Width   := clipr.Width;
    r.SetBottom(clipr.Bottom);
    Canvas.FillRectangle(r);
  end;

  // The little square in the bottom right corner
  if FHScrollBar.Visible and FVScrollBar.Visible then
  begin
    Canvas.ClearClipRect;
    Canvas.SetColor(clButtonFace);
    Canvas.FillRectangle(FHScrollBar.Left+FHScrollBar.Width,
                         FVScrollBar.Top+FVScrollBar.Height,
                         FVScrollBar.Width,
                         FHScrollBar.Height);
  end;


  Canvas.EndDraw;
end;

procedure TfpgBaseGrid.HandleShow;
begin
  inherited HandleShow;
  UpdateScrollBars;
end;

procedure TfpgBaseGrid.HandleResize(awidth, aheight: TfpgCoord);
begin
  inherited HandleResize(awidth, aheight);
  UpdateScrollBars;
end;

procedure TfpgBaseGrid.HandleKeyPress(var keycode: word;
  var shiftstate: TShiftState; var consumed: boolean);
var
  w: integer;
begin
  consumed := True;
  case keycode of
    keyRight:
        begin
          if RowSelect then
          begin
            w := 0;
            FFocusCol := FFirstCol;
            while FFocusCol < ColumnCount do
            begin
              inc(w, ColumnWidth[FFocusCol]+1);
              if w + ColumnWidth[FFocusCol+1]+1 > VisibleWidth then
                Break;
              inc(FFocusCol);
            end;
          end;

          if FFocusCol < ColumnCount then
          begin
            inc(FFocusCol);
            FollowFocus;
            RePaint;
            //DoChange;
          end;
        end;

    keyLeft:
        begin
          if RowSelect then
            FFocusCol := FFirstCol;
          if FFocusCol > 1 then
          begin
            dec(FFocusCol);
            FollowFocus;
            RePaint;
            //DoChange;
          end;
        end;

    keyUp:
        begin
          if FFocusRow > 1 then
          begin
            dec(FFocusRow);
            FollowFocus;
            RePaint;
            //DoChange;
          end;
        end;

    keyDown:
        begin
          if FFocusRow < RowCount then
          begin
            inc(FFocusRow);
            FollowFocus;
            RePaint;
            //DoChange;
          end;
        end;

    keyPageUp:
        begin
          dec(FFocusRow,VisibleLines);
          if FFocusRow < 1 then
            FFocusRow := 1;
          FollowFocus;
          RePaint;
          //DoChange;
        end;

    keyPageDown:
        begin
          inc(FFocusRow,VisibleLines);
          if FFocusRow > RowCount then
            FFocusRow := RowCount;
          FollowFocus;
          RePaint;
          //DoChange;
        end;
        
    keyHome:
        begin
          FFocusCol := 1;
          FollowFocus;
          RePaint;
          //DoChange;
        end;
        
    keyEnd:
        begin
          FFocusCol := ColumnCount;
          FollowFocus;
          RePaint;
          //DoChange;
        end;

  else
    consumed := False;
  end;
  
  if consumed then
    CheckFocusChange;

  inherited HandleKeyPress(keycode, shiftstate, consumed);
end;

procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
var
  lRow: integer;
  lCol: integer;
begin
  inherited HandleMouseScroll(x, y, shiftstate, delta);

  lRow := FFirstRow;
  lCol := FFirstCol;

  if delta > 0 then // scroll down
    inc(FFirstRow, abs(delta))
  else              // scroll up
    dec(FFirstRow, abs(delta));

  // apply limits
  if FFirstRow > RowCount - VisibleLines + 1 then
    FFirstRow := RowCount - VisibleLines + 1;
  if FFirstRow < 1 then
    FFirstRow := 1;
    
  // scroll left/right
  // If vertical scrollbar is not visible, but
  // horizontal is. Mouse wheel will scroll horizontally.  :)
  if FHScrollBar.Visible and  (not FVScrollBar.Visible) then
  begin
    if delta > 0 then // scroll right
    begin
      if FFirstCol < ColumnCount then
        inc(FFirstCol);
    end
    else
    begin
      if FFirstCol > 1 then
        dec(FFirstCol);
    end;
  end;

  if (lRow <> FFirstRow) or (lCol <> FFirstCol) then
  begin
    UpdateScrollBars;
    RePaint;
  end;
end;

procedure TfpgBaseGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
var
  hh: integer;
  cw: integer;
  n: integer;
  colresize: boolean;
begin
  inherited HandleMouseMove(x, y, btnstate, shiftstate);
  
  if (ColumnCount < 0) or (RowCount < 1) then
    Exit; //==>

  if FColResizing then
  begin
    if (btnstate and 1) = 0 then
      FColResizing := False
    else
    begin
      cw := ColumnWidth[FResizedCol]+x-FDragPos;
      if cw < 1 then
        cw := 1;
      SetColumnWidth(FResizedCol, cw);
      FDragPos := x;
    end;
  end
  else if ShowHeader then
  begin
    colresize := False;
    hh := FHeaderHeight;

    if (y <= FMargin + hh) then // we are over the Header row
    begin
      cw := 0;
      for n := FFirstCol to ColumnCount do
      begin
        inc(cw, ColumnWidth[n]);
        // Resizing is enabled 4 pixel either way of the cell border
        if ((x >= (FMargin+cw - 4)) and (x <= (FMargin+cw+4))) or
           (cw > (FMargin + VisibleWidth)) and (x >= FMargin + VisibleWidth-4)   then
        begin
          colresize := True;
          Break;
        end;

        if cw > VisibleWidth then
          Break;
      end;  { if }
    end;  { if/else }

    if colresize then
      MouseCursor := mcSizeEW
    else
      MouseCursor := mcDefault;
  end;  { if/else }
end;

procedure TfpgBaseGrid.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
begin
  inherited HandleLMouseUp(x, y, shiftstate);

  {$IFDEF DEBUG}
  if FColResizing then
    Writeln('Column ', FResizedCol,' width = ', ColumnWidth[FResizedCol]);
  {$ENDIF}

  FColResizing  := False;
  MouseCursor   := mcDefault;
end;

procedure TfpgBaseGrid.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
var
  hh: integer;
  n: integer;
  cw: integer;
  nw: integer;
  prow: integer;
  pcol: integer;
begin
  inherited HandleLMouseDown(x, y, shiftstate);

  if (ColumnCount < 0) or (RowCount < 1) then
    Exit; //==>

  pcol := FFocusCol;
  prow := FFocusRow;

  // searching for the appropriate character position
  if ShowHeader then
    hh := FHeaderHeight+1
  else
    hh := 0;

  if ShowHeader and (y <= FMargin+hh) then  // inside Header row
  begin
    {$IFDEF DEBUG} Writeln('header click...'); {$ENDIF}
    cw := 0;
    for n := FFirstCol to ColumnCount do
    begin
      inc(cw, ColumnWidth[n]);
      if (x >= (FMargin+cw - 4)) and (x <= (FMargin+cw + 4)) then
      begin
        {$IFDEF DEBUG} Writeln('column resize...'); {$ENDIF}
        FColResizing  := True;
        FResizedCol   := n;
        FDragPos      := x;
        Break;
      end
      else if (cw > FMargin+VisibleWidth) and (x >= FMargin+VisibleWidth-4) then
      begin
        FColResizing  := True;
        FResizedCol   := n;
        FDragPos      := x;
        nw := ColumnWidth[FResizedCol] - (cw+FMargin-x);
        if nw > 0 then
          SetColumnWidth(FResizedCol, nw );
        Break;
      end;  { if/else }

      if cw > VisibleWidth then
        Break;
    end;  { for }
  end
  else
  begin   // Selecting a Cell via mouse
    FFocusRow := FFirstRow + ((y - FMargin - hh) div FDefaultRowHeight);
    if FFocusRow > RowCount then
      FFocusRow := RowCount;
    cw := 0;
    for n := FFirstCol to ColumnCount do
    begin
      inc(cw, ColumnWidth[n]);
      if FMargin+cw >= x then
      begin
        FFocusCol := n;
        Break;
      end;
    end;
  end;  { if/else }

  if (prow <> FFocusRow) or (pcol <> FFocusCol) then
  begin
    FollowFocus;
    Repaint;
  end;

  if FColResizing then
    MouseCursor := mcSizeEW;

  CheckFocusChange;
end;

procedure TfpgBaseGrid.FollowFocus;
var
  n: integer;
  w: TfpgCoord;
begin
  if (RowCount > 0) and (FFocusRow < 1) then
    FFocusRow := 1;
  if FFocusRow > RowCount then
    FFocusRow := RowCount;

  if (ColumnCount > 0) and (FFocusCol < 1) then
    FFocusCol := 1;
  if FFocusCol > ColumnCount then
    FFocusCol := ColumnCount;

  if FFirstRow < 1 then
    FFirstRow := 1;
  if FFirstCol < 1 then
    FFirstCol := 1;

  if FFocusRow < FFirstRow then
    FFirstRow := FFocusRow
  else
  begin
    if (FFirstRow + VisibleLines - 1) < FFocusRow then
      FFirstRow := FFocusRow - VisibleLines + 1;
  end;  { if/else }

  if FFocusCol < FFirstCol then
    FFirstCol := FFocusCol
  else
  begin
    w := 0;
    for n := FFocusCol downto FFirstCol do
    begin
      w := w + ColumnWidth[n]+1;
      if w > VisibleWidth then
      begin
        if n = FFocusCol then
          FFirstCol := n
        else
          FFirstCol := n+1;
        break;
      end;
    end;  { for }
  end;  { if/else }

  UpdateScrollBars;
end;

constructor TfpgBaseGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Focusable   := True;
  Width       := 120;
  Height      := 80;
  FFocusCol   := 1;
  FPrevCol    := 0;
  FFocusRow   := 1;
  FPrevRow    := 0;
  FFirstRow   := 1;
  FFirstCol   := 1;
  FMargin     := 2;
  FShowHeader := True;
  FShowGrid   := True;
  FRowSelect  := False;
  
  FFont       := fpgGetFont('#Grid');
  FHeaderFont := fpgGetFont('#GridHeader');
  
  FTemp             := 50;  // Just to prove that ColumnWidth does adjust.
  FDefaultColWidth  := 64;
  FDefaultRowHeight := FFont.Height + 2;
  FHeaderHeight     := FHeaderFont.Height + 2;
  FBackgroundColor  := clBoxColor;
  FColResizing      := False;

  MinHeight   := HeaderHeight + DefaultRowHeight + FMargin;
  MinWidth    := DefaultColWidth + FMargin;
  
  FVScrollBar := TfpgScrollBar.Create(self);
  FVScrollBar.Orientation := orVertical;
  FVScrollBar.Visible     := False;
  FVScrollBar.OnScroll    := @VScrollBarMove;

  FHScrollBar := TfpgScrollBar.Create(self);
  FHScrollBar.Orientation := orHorizontal;
  FHScrollBar.Visible     := False;
  FHScrollBar.OnScroll    := @HScrollBarMove;
  FHScrollBar.ScrollStep  := 5;
end;

destructor TfpgBaseGrid.Destroy;
begin
  FOnRowChange := nil;
  FOnFocusChange := nil;
  FFont.Free;
  FHeaderFont.Free;
  inherited Destroy;
end;

procedure TfpgBaseGrid.Update;
begin
  UpdateScrollBars;
  FollowFocus;
  RePaint;
end;

end.