On Wed, 2007-06-20 at 17:51 -0500, Jesus Reyes wrote:
> > Attached is a patch to allow 'subrows' in a row in a grid. You can
> > say,
> > for example that each row should contain two subrows. Then the
> > columns
> > will be divided over those two rows. Second you can specify for
> > each
> > column how much subrows it has to 'span'.
> >
> > For example, with two subrows, and a subrowspan of two for the
> > first
> > column, you can get something like this:
> > http://menora.cnoc.nl/public/GridSubrows.png
> >
> > Attached is a patch. It works reasonable, but there are still some
> > issues. For example if 'subrows mod columncount<>0' then no
> > background
> > is painted for the 'empty' part.
> >
> > I also think that resizing columns and reordening them will give
> > problems.
> >
> > But what do you guys think of the idea and patch?
> >
> > Joost.
>
> Looks nice!
>
> About the patch, I just applied and didn't take a closer look, will
> try to do later, initially there seems to be many problems for
> example, the TStringGrid editor doesn't know about subrows, and
> crashed my lazarus badly, I also wasn't able to reproduce your image,
> if issues are fixed I think we should add it.
Here is a new patch. This one works better.
--
Met vriendelijke groeten,
Joost van der Sluis
CNOC Informatiesystemen en Netwerken
http://www.cnoc.nl
Index: grids.pas
===================================================================
--- grids.pas (revision 11403)
+++ grids.pas (working copy)
@@ -362,6 +362,7 @@
FisDefaultFont: Boolean;
FPickList: TStrings;
FMinSize, FMaxSize, FSizePriority: ^Integer;
+ FSpanSubRows: Integer;
procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment;
@@ -442,6 +443,7 @@
property Title: TGridColumnTitle read FTitle write SetTitle;
property Width: Integer read GetWidth write SetWidth stored IsWidthStored default DEFCOLWIDTH;
property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored default true;
+ property SpanSubRows: Integer read FSpanSubRows write FSpanSubRows stored IsVisibleStored default 1;
end;
TGridPropertyBackup=record
@@ -501,6 +503,7 @@
ValidGrid: boolean; // true if there are not fixed cells to show
AccumWidth: TList; // Accumulated width per column
AccumHeight: TList; // Accumulated Height per row
+ SubRow: TList; // Place this column in subrow X
TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels
MaxTopLeft: TPoint; // Max Top left ( cell coorditates)
HotCell: TPoint; // currently hot cell
@@ -534,6 +537,7 @@
FFastEditing: boolean;
FAltColorStartNormal: boolean;
FFlat: Boolean;
+ FSubRowcount: Integer;
FTitleStyle: TTitleStyle;
FOnCompareCells: TOnCompareCells;
FGridLineStyle: TPenStyle;
@@ -702,7 +706,7 @@
procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic;
procedure ColRowInserted(IsColumn: boolean; index: integer); dynamic;
procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); dynamic;
- function ColRowToOffset(IsCol, Relative: Boolean; Index:Integer;
+ function ColRowToOffset(IsCol, Relative: Boolean; Index:Integer; Col : integer;
var StartPos, EndPos: Integer): Boolean;
function ColumnIndexFromGridColumn(Column: Integer): Integer;
function ColumnFromGridColumn(Column: Integer): TGridColumn;
@@ -763,6 +767,7 @@
function GetColumnReadonly(Column: Integer): boolean;
function GetColumnTitle(Column: Integer): string;
function GetColumnWidth(Column: Integer): Integer;
+ function GetColumnSpanSubRows(Column: Integer): Integer;
function GetDeltaMoveNext(const Inverse: boolean; var ACol,ARow: Integer): boolean; virtual;
function GetDefaultColumnAlignment(Column: Integer): TAlignment; virtual;
function GetDefaultColumnWidth(Column: Integer): Integer; virtual;
@@ -904,6 +909,8 @@
property VisibleColCount: Integer read GetVisibleColCount stored false;
property VisibleRowCount: Integer read GetVisibleRowCount stored false;
+ property SubRowCount: Integer read FSubRowcount write FSubRowcount default 1;
+
property OnBeforeSelection: TOnSelectEvent read FOnBeforeSelection write FOnBeforeSelection;
property OnCompareCells: TOnCompareCells read FOnCompareCells write FOnCompareCells;
property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
@@ -1313,6 +1320,7 @@
property RowCount;
property ScrollBars;
property ShowHint;
+ property SubRowCount;
property TabOrder;
property TabStop;
property TitleFont;
@@ -1611,7 +1619,6 @@
Count: Integer;
aPriority, aMin, aMax: Integer;
AvailableSize: Integer;
- TotalWidth: Integer; // total grid's width
FixedSizeWidth: Integer; // total width of Fixed Sized Columns
begin
if not AutoFillColumns then
@@ -1635,15 +1642,15 @@
Count := 0;
FixedSizeWidth := 0;
- TotalWidth := 0;
for i:=0 to ColCount-1 do begin
GetAutoFillColumnInfo(i, aMin, aMax, aPriority);
AvailableSize := GetColWidths(i);
- if aPriority>0 then
- Inc(Count)
+ if aPriority>0 then begin
+ if PtrInt(FGCache.SubRow[i]) = 0 then
+ Inc(Count)
+ end
else
Inc(FixedSizeWidth, AvailableSize);
- Inc(TotalWidth, AvailableSize);
end;
if Count=0 then begin
@@ -2014,6 +2021,7 @@
if IsColumn then begin
AddDel(FCols, NewValue);
FGCache.AccumWidth.Count:=NewValue;
+ FGCache.SubRow.Count:=newValue;
OldCount:=RowCount;
if (OldValue=0)and(NewValue>=0) then begin
FTopLeft.X:=FFixedCols;
@@ -2041,6 +2049,7 @@
FTopLeft.X:=0;
AddDel(FCols, 1);
FGCache.AccumWidth.Count:=1;
+ FGCache.SubRow.Count:=1;
end;
end;
SizeChanged(OldCount, OldValue);
@@ -2261,13 +2270,17 @@
procedure CalcNewCachedSizes;
var
i: Integer;
+ SubRow : PtrInt;
begin
// Calculate New Cached Values
FGCache.GridWidth:=0;
FGCache.FixedWidth:=0;
+ SubRow := 0;
For i:=0 To ColCount-1 do begin
FGCache.AccumWidth[i]:=Pointer(PtrInt(FGCache.GridWidth));
- FGCache.GridWidth:=FGCache.GridWidth + GetColWidths(i);
+ FGCache.SubRow[i]:=Pointer(SubRow mod FSubRowcount);
+ subrow := subrow+GetColumnSpanSubRows(i);
+ if ((subrow mod FSubRowcount) = 0) or (i=colcount-1) then FGCache.GridWidth:=FGCache.GridWidth + GetColWidths(i);
if i<FixedCols then FGCache.FixedWidth:=FGCache.GridWidth;
{$IfDef dbgVisualChange}
//DebugLn('FGCache.AccumWidth[',dbgs(i),']=',dbgs(Integer(FGCache.AccumWidth[i])));
@@ -2498,8 +2511,8 @@
function TCustomGrid.CellRect(ACol, ARow: Integer): TRect;
begin
//Result:=ColRowToClientCellRect(aCol,aRow);
- ColRowToOffset(True, True, ACol, Result.Left, Result.Right);
- ColRowToOffSet(False,True, ARow, Result.Top, Result.Bottom);
+ ColRowToOffset(True, True, ACol, ACol, Result.Left, Result.Right);
+ ColRowToOffSet(False,True, ARow, ACol, Result.Top, Result.Bottom);
end;
// The visible grid Depends on TopLeft and ClientWidht,ClientHeight,
@@ -2524,7 +2537,8 @@
W:=GetColWidths(Result.Left) + FGCache.FixedWidth- FGCache.TLColOff;
while (Result.Right<ColCount-1)and(W<FGCache.ClientWidth) do begin
Inc(Result.Right);
- W:=W+GetColWidths(Result.Right);
+ if (ptrint(FGCache.SubRow[Result.Right]) mod FSubRowcount)=0 then
+ W:=W+GetColWidths(Result.Right);
end;
FGCache.MaxClientXY.X := W;
end else begin
@@ -2977,7 +2991,7 @@
begin
// Upper and Lower bounds for this row
- ColRowToOffSet(False, True, aRow, R.Top, R.Bottom);
+ ColRowToOffSet(False, True, aRow, -1, R.Top, R.Bottom);
// is this row within the ClipRect?
ClipArea := Canvas.ClipRect;
@@ -2991,7 +3005,8 @@
// Draw columns in this row
with FGCache.VisibleGrid do begin
for aCol:=left to Right do begin
- ColRowToOffset(True, True, aCol, R.Left, R.Right);
+ ColRowToOffset(True, True, aCol, aCol, R.Left, R.Right);
+ ColRowToOffSet(False, True, aRow, aCol, R.Top, R.Bottom);
if not HorizontalIntersect(R, ClipArea) then
continue;
gds := [];
@@ -3020,7 +3035,8 @@
//if EditorAlwaysShown and (FEditor<>nil) and FEditor.Visible then begin
//DebugLn('No Draw Focus Rect');
end else begin
- ColRowToOffset(True, True, FCol, R.Left, R.Right);
+ ColRowToOffset(True, True, FCol, FCol, R.Left, R.Right);
+ ColRowToOffset(False, True, FRow, FCol, R.Top, R.Bottom);
// is this column within the ClipRect?
if HorizontalIntersect( R, ClipArea) then
DrawFocusRect(FCol,FRow, R);
@@ -3033,7 +3049,7 @@
// Draw Fixed Columns
For aCol:=0 to FFixedCols-1 do begin
gds:=[gdFixed];
- ColRowToOffset(True, True, aCol, R.Left, R.Right);
+ ColRowToOffset(True, True, aCol, aCol , R.Left, R.Right);
// is this column within the ClipRect?
if HorizontalIntersect( R, ClipArea) then
DoDrawCell;
@@ -4026,7 +4042,7 @@
begin
//fSplitter.Y:=OffsetToColRow(False, True, Y, OffTop{dummy});
if OffsetToColRow(False, True, Y, FSplitter.Y, OffTop{dummy}) then begin
- ColRowToOffset(False, True, FSplitter.Y, OffTop, OffBottom);
+ ColRowToOffset(False, True, FSplitter.Y,FSplitter.X, OffTop, OffBottom);
FSplitter.X:=Y;
if (OffBottom-Y)<(Y-OffTop) then SwapInt(OffTop, OffBottom)
else Dec(FSplitter.y);
@@ -4171,7 +4187,7 @@
IsCol=true, Index:=100, TopLeft.x:=98, FixedCols:=1, all ColWidths:=20
Relative => StartPos := WidthfixedCols+WidthCol98+WidthCol99
not Relative = Absolute => StartPos := WidthCols(0..99) }
-function TCustomGrid.ColRowToOffset(IsCol, Relative: Boolean; Index:Integer;
+function TCustomGrid.ColRowToOffset(IsCol, Relative: Boolean; Index:Integer; Col : integer;
var StartPos, EndPos: Integer): Boolean;
var
Dim: Integer;
@@ -4181,8 +4197,13 @@
StartPos:=PtrInt(AccumWidth[index]);
Dim:=GetColWidths(index);
end else begin
- StartPos:=PtrInt(AccumHeight[index]);
- Dim:= GetRowHeights(index);
+ if col = -1 then begin
+ Dim:= (GetRowHeights(index));
+ StartPos:=PtrInt(AccumHeight[index]);
+ end else begin
+ Dim := (GetRowHeights(index)) div FSubRowcount * GetColumnSpanSubRows(col);
+ StartPos := PtrInt(AccumHeight[index])+(PtrInt(FGCache.SubRow[Col]) * Dim);
+ end;
end;
StartPos := StartPos + GetBorderWidth;
if not Relative then begin
@@ -4329,10 +4350,12 @@
end else begin
FCols.Insert(Index, pointer(-1));
FGCache.AccumWidth.Insert(Index, nil);
+ FGCache.SubRow.Insert(Index,nil);
end;
end else begin
Frows.Insert(Index, pointer(-1));
FGCache.AccumHeight.Insert(Index, nil);
+ FGCache.SubRow.Insert(Index,nil);
end;
ColRowInserted(IsColumn, index);
VisualChange;
@@ -4370,6 +4393,7 @@
end;
FCols.Delete(Index);
FGCache.AccumWidth.Delete(Index);
+ FGCache.SubRow.Delete(Index);
ColRowDeleted(True, Index);
FixPosition;
end;
@@ -5062,6 +5086,13 @@
// Do not raise Exception if out of range
OffsetToColRow(True, True, X, ACol, dummy);
OffsetToColRow(False,True, Y, ARow, dummy);
+
+ while (dummy > (GetRowHeights(ARow) div FSubRowcount)*GetColumnSpanSubRows(ACol)) and
+ (ACol < FColumns.Count-1) do
+ begin
+ dummy := dummy - (GetRowHeights(ARow) div FSubRowcount)*GetColumnSpanSubRows(ACol);
+ inc(ACol);
+ end;
end;
{ Convert a fisical Mouse coordinate into a logical cell coordinate }
@@ -6014,6 +6045,17 @@
Result := GetDefaultColumnWidth(Column);
end;
+function TCustomGrid.GetColumnSpanSubRows(Column: Integer): Integer;
+var
+ C: TGridColumn;
+begin
+ C := ColumnFromGridColumn(Column);
+ if C<>nil then
+ Result := C.SpanSubRows
+ else
+ Result := 1;
+end;
+
// return the relative cell coordinate of the next cell
// considering AutoAdvance property and selectable cells.
function TCustomGrid.GetDeltaMoveNext(const Inverse: boolean;
@@ -6418,7 +6460,9 @@
// fGrid needs to be created before that
FCols:=TList.Create;
FRows:=TList.Create;
+ FSubRowcount := 1;
FGCache.AccumWidth:=TList.Create;
+ FGCache.SubRow:=TList.Create;
FGCache.AccumHeight:=TList.Create;
FGSMHBar := GetSystemMetrics(SM_CYHSCROLL) + GetSystemMetricsGapSize(SM_CYHSCROLL);
FGSMVBar := GetSystemMetrics(SM_CXVSCROLL) + GetSystemMetricsGapSize(SM_CXVSCROLL);
@@ -6502,6 +6546,7 @@
FreeThenNil(FButtonEditor);
FreeThenNil(FColumns);
FreeThenNil(FGCache.AccumWidth);
+ FreeThenNil(FGCache.SubRow);
FreeThenNil(FGCache.AccumHeight);
FreeThenNil(FCols);
FreeThenNil(FRows);
@@ -8292,6 +8337,7 @@
Title := TGridColumn(Source).Title;
Width := TGridCOlumn(Source).Width;
Visible := TGridColumn(Source).Visible;
+ SpanSubRows := TGridColumn(Source).SpanSubRows;
finally
Collection.EndUpdate;
end;
@@ -8342,6 +8388,8 @@
FPickList:= TStringList.Create;
FButtonStyle := cbsAuto;
FDropDownRows := 7;
+
+ FSpanSubRows := 1;
end;
destructor TGridColumn.Destroy;
