diff options
Diffstat (limited to 'gui/grid.inc')
| -rw-r--r-- | gui/grid.inc | 658 |
1 files changed, 658 insertions, 0 deletions
diff --git a/gui/grid.inc b/gui/grid.inc new file mode 100644 index 00000000..7079c3f7 --- /dev/null +++ b/gui/grid.inc @@ -0,0 +1,658 @@ +{ + 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} + |