RxFPC:RxDBGrid - started work on grouping data in grid

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5903 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2017-05-26 13:05:56 +00:00
parent cc669f527a
commit e5a35c6fb4
8 changed files with 1424 additions and 69 deletions

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,80 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, rxnew, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,358 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="28">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="31"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="42"/>
<CursorPos X="128" Y="44"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdb/rxdbgrid.pas"/>
<EditorIndex Value="1"/>
<TopLine Value="6168"/>
<CursorPos X="57" Y="6177"/>
<UsageCount Value="15"/>
<Bookmarks Count="5">
<Item0 X="3" Y="4356" ID="5"/>
<Item1 X="3" Y="5572" ID="3"/>
<Item2 X="5" Y="6159" ID="4"/>
<Item3 X="63" Y="4523" ID="1"/>
<Item4 X="3" Y="6172" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../../../install/source/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="70"/>
<CursorPos X="30" Y="91"/>
<UsageCount Value="9"/>
</Unit3>
<Unit4>
<Filename Value="../../../../install/source/fpcsrc/rtl/objpas/classes/lists.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="316"/>
<CursorPos X="13" Y="328"/>
<UsageCount Value="9"/>
</Unit4>
<Unit5>
<Filename Value="../../../../install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="1669"/>
<CursorPos X="14" Y="1687"/>
<UsageCount Value="9"/>
</Unit5>
<Unit6>
<Filename Value="../../../../install/source/fpcsrc/packages/fcl-db/src/base/datasource.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="212"/>
<CursorPos Y="218"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="../../../../install/source/fpcsrc/packages/fcl-db/src/base/dataset.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1825"/>
<CursorPos X="3" Y="1829"/>
<UsageCount Value="9"/>
</Unit7>
<Unit8>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdb/rxmemds.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="1108"/>
<CursorPos Y="1127"/>
<UsageCount Value="9"/>
</Unit8>
<Unit9>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="3"/>
<TopLine Value="4845"/>
<CursorPos X="24" Y="4847"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<EditorIndex Value="2"/>
<TopLine Value="965"/>
<CursorPos Y="978"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="/usr/local/share/lazarus/lcl/include/control.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1009"/>
<CursorPos Y="1029"/>
<UsageCount Value="11"/>
</Unit11>
<Unit12>
<Filename Value="/usr/local/share/lazarus/lcl/include/wincontrol.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="8038"/>
<CursorPos Y="8066"/>
<UsageCount Value="11"/>
</Unit12>
<Unit13>
<Filename Value="/usr/local/share/lazarus/lcl/include/scrollingwincontrol.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="76"/>
<CursorPos Y="95"/>
<UsageCount Value="9"/>
</Unit13>
<Unit14>
<Filename Value="../../../../install/source/fpcsrc/rtl/inc/systemh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="338"/>
<CursorPos X="9" Y="357"/>
<UsageCount Value="9"/>
</Unit14>
<Unit15>
<Filename Value="../../../../install/source/fpcsrc/rtl/objpas/classes/stringl.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1571"/>
<CursorPos X="3" Y="1573"/>
<UsageCount Value="9"/>
</Unit15>
<Unit16>
<Filename Value="../../../../install/source/fpcsrc/rtl/objpas/sysutils/sysstrh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="73"/>
<CursorPos X="10" Y="92"/>
<UsageCount Value="9"/>
</Unit16>
<Unit17>
<Filename Value="../../../../install/source/fpcsrc/rtl/objpas/sysutils/sysstr.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="551"/>
<CursorPos X="5" Y="553"/>
<UsageCount Value="9"/>
</Unit17>
<Unit18>
<Filename Value="../../../../install/source/fpcsrc/rtl/inc/ustringh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="87"/>
<CursorPos X="5" Y="106"/>
<UsageCount Value="9"/>
</Unit18>
<Unit19>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1579"/>
<CursorPos Y="1600"/>
<UsageCount Value="10"/>
</Unit19>
<Unit20>
<Filename Value="/usr/local/share/lazarus/lcl/include/winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="597"/>
<CursorPos Y="617"/>
<UsageCount Value="10"/>
</Unit20>
<Unit21>
<Filename Value="/usr/local/share/lazarus/lcl/widgetset/wsgrids.pp"/>
<UnitName Value="WSGrids"/>
<EditorIndex Value="-1"/>
<TopLine Value="35"/>
<CursorPos X="20" Y="53"/>
<UsageCount Value="11"/>
</Unit21>
<Unit22>
<Filename Value="/usr/local/share/lazarus/lcl/interfaces/gtk2/gtk2wsgrids.pp"/>
<UnitName Value="Gtk2WSGrids"/>
<EditorIndex Value="-1"/>
<TopLine Value="31"/>
<CursorPos Y="66"/>
<UsageCount Value="11"/>
</Unit22>
<Unit23>
<Filename Value="/usr/local/share/lazarus/lcl/controls.pp"/>
<UnitName Value="Controls"/>
<EditorIndex Value="-1"/>
<TopLine Value="2277"/>
<CursorPos X="3" Y="2298"/>
<UsageCount Value="11"/>
</Unit23>
<Unit24>
<Filename Value="../../../../install/source/fpcsrc/rtl/inc/typshrdh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="127"/>
<CursorPos X="17" Y="153"/>
<UsageCount Value="10"/>
</Unit24>
<Unit25>
<Filename Value="../../../../install/source/fpcsrc/rtl/inc/typshrd.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="300"/>
<CursorPos X="3" Y="302"/>
<UsageCount Value="10"/>
</Unit25>
<Unit26>
<Filename Value="/usr/local/share/lazarus/lcl/include/customcheckbox.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="114"/>
<CursorPos Y="134"/>
<UsageCount Value="10"/>
</Unit26>
<Unit27>
<Filename Value="/usr/local/share/lazarus/lcl/interfaces/gtk2/gtk2widgetset.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="16"/>
<CursorPos Y="44"/>
<UsageCount Value="10"/>
</Unit27>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3466" TopLine="3443"/>
</Position1>
<Position2>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3473" TopLine="3443"/>
</Position2>
<Position3>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3474" TopLine="3443"/>
</Position3>
<Position4>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3475" TopLine="3444"/>
</Position4>
<Position5>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3476" TopLine="3445"/>
</Position5>
<Position6>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3475" TopLine="3445"/>
</Position6>
<Position7>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3478" TopLine="3450"/>
</Position7>
<Position8>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3399" TopLine="3380"/>
</Position8>
<Position9>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="3400" TopLine="3380"/>
</Position9>
<Position10>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5921" TopLine="5911"/>
</Position10>
<Position11>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5922" TopLine="5911"/>
</Position11>
<Position12>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5923" TopLine="5911"/>
</Position12>
<Position13>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5929" TopLine="5911"/>
</Position13>
<Position14>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5931" TopLine="5911"/>
</Position14>
<Position15>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5932" TopLine="5911"/>
</Position15>
<Position16>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2094" TopLine="2075"/>
</Position16>
<Position17>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2095" TopLine="2075"/>
</Position17>
<Position18>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2098" TopLine="2075"/>
</Position18>
<Position19>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2099" TopLine="2075"/>
</Position19>
<Position20>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="5934" TopLine="5915"/>
</Position20>
<Position21>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="678" Column="18" TopLine="659"/>
</Position21>
<Position22>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2482" Column="61" TopLine="2451"/>
</Position22>
<Position23>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2483" Column="52" TopLine="2452"/>
</Position23>
<Position24>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2874" Column="28" TopLine="2843"/>
</Position24>
<Position25>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="2887" Column="24" TopLine="2857"/>
</Position25>
<Position26>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="4846" Column="24" TopLine="4813"/>
</Position26>
<Position27>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="4847" Column="24" TopLine="4813"/>
</Position27>
<Position28>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdb/rxdbgrid.pas"/>
<Caret Line="5166" Column="10" TopLine="5141"/>
</Position28>
<Position29>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdb/rxdbgrid.pas"/>
<Caret Line="912" Column="15" TopLine="884"/>
</Position29>
<Position30>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdb/rxdbgrid.pas"/>
<Caret Line="6177" Column="57" TopLine="6168"/>
</Position30>
</JumpHistory>
</ProjectSession>
<Debugging>
<Watches Count="1">
<Item1>
<Expression Value="RNew"/>
</Item1>
</Watches>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,297 @@
object Form1: TForm1
Left = 570
Height = 556
Top = 275
Width = 796
Caption = 'Form1'
ClientHeight = 556
ClientWidth = 796
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 493
Top = 63
Width = 796
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID'
Width = 50
FieldName = 'ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'GROUP'
Width = 60
FieldName = 'GROUP_ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'SUM'
Width = 90
FieldName = 'SUM'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footer.Alignment = taRightJustify
Footer.FieldName = 'SUM'
Footer.ValueType = fvtSum
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'TEXT'
Width = 264
FieldName = 'TEXT'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
WordWrap = True
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'AAA'
Width = 250
FieldName = 'AAA'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.Active = True
FooterOptions.Color = clYellow
FooterOptions.RowCount = 1
FooterOptions.DrawFullLine = True
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgFooterRows, rdgAllowQuickFilter]
FooterColor = clYellow
FooterRowCount = 1
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
Color = clWindow
DrawFullLine = True
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = dsData
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
TabOrder = 0
end
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 6
Height = 24
Top = 6
Width = 113
BorderSpacing.Around = 6
Caption = 'Groups active'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 1
end
object CheckBox2: TCheckBox
AnchorSideLeft.Control = CheckBox1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner
Left = 125
Height = 24
Top = 6
Width = 96
BorderSpacing.Around = 6
Caption = 'Footer row'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 2
end
object CheckBox3: TCheckBox
AnchorSideLeft.Control = CheckBox2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner
Left = 227
Height = 24
Top = 6
Width = 88
BorderSpacing.Around = 6
Caption = 'ReadOnly'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 3
end
object rxData: TRxMemoryData
FieldDefs = <
item
Name = 'ID'
DataType = ftInteger
end
item
Name = 'GROUP_ID'
DataType = ftInteger
end
item
Name = 'SUM'
DataType = ftCurrency
end
item
Name = 'TEXT'
DataType = ftString
Size = 500
end
item
Name = 'AAA'
DataType = ftString
Size = 50
end>
PacketRecords = 0
Left = 432
Top = 16
object rxDataID: TLongintField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataGROUP_ID: TLongintField
FieldKind = fkData
FieldName = 'GROUP_ID'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataSUM: TCurrencyField
FieldKind = fkData
FieldName = 'SUM'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
MaxValue = 0
MinValue = 0
Precision = 2
end
object rxDataTEXT: TStringField
FieldKind = fkData
FieldName = 'TEXT'
Index = 3
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 500
end
object rxDataAAA: TStringField
FieldKind = fkData
FieldName = 'AAA'
Index = 4
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 50
end
end
object dsData: TDataSource
DataSet = rxData
Left = 392
Top = 16
end
end

View File

@ -0,0 +1,79 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, rxdbgrid, rxmemds, Forms, Controls, Graphics,
Dialogs, StdCtrls, db;
type
{ TForm1 }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
dsData: TDataSource;
rxDataAAA: TStringField;
rxDataGROUP_ID: TLongintField;
rxDataID: TLongintField;
rxDataSUM: TCurrencyField;
rxDataTEXT: TStringField;
RxDBGrid1: TRxDBGrid;
rxData: TRxMemoryData;
procedure CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
rxData.Open;
for i:=1 to 200 do
rxData.AppendRecord([i, ((i-1) div 4) + 1, Random * 1000, Format('Test string %d', [i])]);
RxDBGrid1.GroupItems.GroupFieldName:='GROUP_ID';
RxDBGrid1.ColumnByFieldName('SUM').GroupParam.ValueType:=fvtSum;
RxDBGrid1.ColumnByFieldName('SUM').GroupParam.Alignment:=taRightJustify;
RxDBGrid1.ColumnByFieldName('GROUP_ID').GroupParam.ValueType:=fvtCount;
RxDBGrid1.ColumnByFieldName('ID').GroupParam.ValueType:=fvtStaticText;
RxDBGrid1.ColumnByFieldName('ID').GroupParam.StaticText:='Группа:';
RxDBGrid1.ColumnByFieldName('AAA').GroupParam.ValueType:=fvtFieldValue;
RxDBGrid1.ColumnByFieldName('AAA').GroupParam.Alignment:=taCenter;
RxDBGrid1.ColumnByFieldName('AAA').GroupParam.Color:=clRed;
RxDBGrid1.GroupItems.Color:=clSkyBlue;
rxData.First;
CheckBox1Change(nil);
end;
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
RxDBGrid1.GroupItems.Active:=CheckBox1.Checked;
RxDBGrid1.FooterOptions.Active:=CheckBox2.Checked;
RxDBGrid1.ReadOnly:=CheckBox3.Checked;
end;
end.

View File

@ -487,56 +487,103 @@ type
{ TColumnGroupItem }
TColumnGroupItem = class
RecordNo:integer;
private
FValues:TFPList;
RecBookMark:TBookMark;
FieldValue:string;
RecordCount:integer;
RecordNo:integer;
function GetItems(FieldName: string): TColumnGroupItemValue;
procedure ClearValues;
function AddItem(AFieldName:string):TColumnGroupItemValue;
public
constructor Create;
destructor Destroy; override;
property Items[FieldName:string]:TColumnGroupItemValue read GetItems;
end;
{ TColumnGroupItems }
TColumnGroupItems = class
private
FColor: TColor;
//for calc
FGroupField:TField;
FCurItem:TColumnGroupItem;
FCurrentValue:String;
//params
FActive: boolean;
FGroupFieldName: string;
FList:TFPList;
FRxDBGrid:TRxDBGrid;
procedure SetActive(AValue: boolean);
procedure SetColor(AValue: TColor);
protected
function FindGroupItem(ARecBookMark: TBookMark): TColumnGroupItem;
function AddGroupItem:TColumnGroupItem;
procedure InitGroup;
procedure DoneGroup;
public
constructor Create;
constructor Create(ARxDBGrid:TRxDBGrid);
destructor Destroy; override;
function FindGroup(ARecordNo:integer):TColumnGroupItem;
procedure Clear;
procedure UpdateValues;
property GroupFieldName:string read FGroupFieldName write FGroupFieldName;
published
property Active:boolean read FActive write SetActive;
property Color:TColor read FColor write SetColor;
end;
{ TRxColumnGroupParam }
TRxColumnGroupParam = class(TCollectionItem)
TRxColumnGroupParam = class
private
FFileName: string;
FAlignment: TAlignment;
FColor: TColor;
FDisplayFormat: string;
FLayout: TTextLayout;
FStaticText: string;
FValueType: TFooterValueType;
published
property FileName:string read FFileName write FFileName;
property ValueType:TFooterValueType read FValueType write FValueType;
end;
{ TRxColumnGroupParams }
TRxColumnGroupParams = class(TOwnedCollection)
private
function GetItem(Index: integer): TRxColumnGroupParam;
procedure SetItem(Index: integer; AValue: TRxColumnGroupParam);
FColumn:TRxColumn;
FIsDefaultFont: boolean;
FFont: TFont;
procedure FontChanged(Sender: TObject);
function GetDisplayText: string;
function GetFont: TFont;
function IsFontStored: Boolean;
procedure SetAlignment(AValue: TAlignment);
procedure SetColor(AValue: TColor);
procedure SetDisplayFormat(AValue: string);
procedure SetFont(AValue: TFont);
procedure SetLayout(AValue: TTextLayout);
procedure SetStaticText(AValue: string);
protected
function GetGroupItems:TColumnGroupItem;
function GetGroupItem:TColumnGroupItemValue;
function GetRecordsCount: string;
function GetGroupTotal: string;
function GetGroupValue: string;
function GetRecNo: string;
public
function Add: TRxColumnGroupParam;
public
property Items[Index: integer]: TRxColumnGroupParam read GetItem write SetItem; default;
constructor Create(AColumn:TRxColumn);
destructor Destroy; override;
procedure FillDefaultFont;
procedure UpdateValues;
property DisplayText:string read GetDisplayText;
published
property ValueType:TFooterValueType read FValueType write FValueType default fvtNon;
property Alignment:TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
property StaticText: string read FStaticText write SetStaticText;
property Font: TFont read GetFont write SetFont stored IsFontStored;
property Color : TColor read FColor write SetColor stored IsFontStored default clNone;
end;
{ TRxColumn }
TRxColumn = class(TColumn)
@ -546,6 +593,7 @@ type
FFooter: TRxColumnFooterItem;
FConstraints:TRxDBGridCollumnConstraints;
FFilter: TRxColumnFilter;
FGroupParam: TRxColumnGroupParam;
FImageList: TImageList;
FKeyList: TStrings;
FNotInKeyListIndex: integer;
@ -556,8 +604,6 @@ type
FSortPosition: integer;
FWordWrap: boolean;
FFooters: TRxColumnFooterItems;
//Group support
FGroupItems:TColumnGroupItems;
function GetConstraints: TRxDBGridCollumnConstraints;
function GetFooter: TRxColumnFooterItem;
function GetFooters: TRxColumnFooterItems;
@ -581,6 +627,7 @@ type
procedure OptimizeWidth;
property SortOrder: TSortMarker read FSortOrder write FSortOrder;
property SortPosition: integer read FSortPosition;
property GroupParam:TRxColumnGroupParam read FGroupParam;
published
property Constraints:TRxDBGridCollumnConstraints read GetConstraints write SetConstraints;
property DirectInput : boolean read FDirectInput write FDirectInput default true;
@ -725,6 +772,9 @@ type
FOnDataHintShow:TRxDBGridDataHintShowEvent;
FSaveOnDataSetScrolled: TDataSetScrolledEvent;
//Group data suppert
FGroupItems:TColumnGroupItems;
FGroupItemDrawCur:TColumnGroupItem;
procedure DoCreateJMenu;
function GetColumns: TRxDbGridColumns;
@ -811,6 +861,8 @@ type
override;
procedure SetDBHandlers(Value: boolean);virtual;
procedure DrawRow(ARow: Integer); override;
procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
procedure DrawFooterRows; virtual;
procedure DoTitleClick(ACol: longint; ACollumn: TRxColumn; Shift: TShiftState); virtual;
@ -857,6 +909,7 @@ type
procedure DoEditorHide; override;
procedure DoEditorShow; override;
procedure CheckNewCachedSizes(var AGCache:TGridDataCache); override;
property Editor;
public
@ -902,6 +955,7 @@ type
property SortOrder:TSortMarker read GetSortOrder;
property SortColumns:TRxDbGridColumnsSortList read FSortColumns;
property GroupItems:TColumnGroupItems read FGroupItems;
published
property AfterQuickSearch: TRxQuickSearchNotifyEvent read FAfterQuickSearch write FAfterQuickSearch;
property ColumnDefValues:TRxDBGridColumnDefValues read FColumnDefValues write SetColumnDefValues;
@ -1169,22 +1223,260 @@ type
procedure EditingDone; override;
end;
{ TRxColumnGroupParams }
{ TRxColumnGroupParam }
function TRxColumnGroupParams.GetItem(Index: integer): TRxColumnGroupParam;
procedure TRxColumnGroupParam.FontChanged(Sender: TObject);
begin
Result:= TRxColumnGroupParam(inherited Items[Index]);
FisDefaultFont := False;
FColumn.ColumnChanged;
end;
procedure TRxColumnGroupParams.SetItem(Index: integer;
AValue: TRxColumnGroupParam);
function TRxColumnGroupParam.GetDisplayText: string;
begin
inherited SetItem(Index, AValue);
case FValueType of
fvtCount : Result := GetRecordsCount;
fvtSum,
fvtAvg,
fvtMax,
fvtMin : Result := GetGroupTotal;
fvtRecNo : Result := GetRecNo;
fvtStaticText:Result := FStaticText;
fvtFieldValue:Result := GetGroupValue;
else
//fvtNon,
Result:='';
end;
end;
function TRxColumnGroupParams.Add: TRxColumnGroupParam;
function TRxColumnGroupParam.GetFont: TFont;
begin
Result:=TRxColumnGroupParam.Create(Self);
Result := FFont;
end;
function TRxColumnGroupParam.IsFontStored: Boolean;
begin
Result := not FisDefaultFont;
end;
procedure TRxColumnGroupParam.SetAlignment(AValue: TAlignment);
begin
if FAlignment=AValue then Exit;
FAlignment:=AValue;
end;
procedure TRxColumnGroupParam.SetColor(AValue: TColor);
begin
if FColor=AValue then Exit;
FColor:=AValue;
end;
procedure TRxColumnGroupParam.SetDisplayFormat(AValue: string);
begin
if FDisplayFormat=AValue then Exit;
FDisplayFormat:=AValue;
end;
procedure TRxColumnGroupParam.SetFont(AValue: TFont);
begin
if not FFont.IsEqual(AValue) then
FFont.Assign(AValue);
end;
procedure TRxColumnGroupParam.SetLayout(AValue: TTextLayout);
begin
if FLayout=AValue then Exit;
FLayout:=AValue;
end;
procedure TRxColumnGroupParam.SetStaticText(AValue: string);
begin
if FStaticText=AValue then Exit;
FStaticText:=AValue;
end;
function TRxColumnGroupParam.GetGroupItems: TColumnGroupItem;
begin
Result:=nil;
if TRxDBGrid(FColumn.Grid).DatalinkActive then
Result:=TRxDBGrid(FColumn.Grid).FGroupItemDrawCur;
end;
function TRxColumnGroupParam.GetGroupItem: TColumnGroupItemValue;
var
FCGDI: TColumnGroupItem;
begin
Result:=nil;
if TRxDBGrid(FColumn.Grid).DatalinkActive then
begin
FCGDI:=TRxDBGrid(FColumn.Grid).FGroupItemDrawCur;
if Assigned(FCGDI) then
Result:=FCGDI.GetItems(FColumn.FieldName);
end
end;
function TRxColumnGroupParam.GetRecordsCount: string;
var
V: TColumnGroupItem;
begin
V:=GetGroupItems;
if Assigned(V) then
begin
if DisplayFormat <> '' then
Result := Format(DisplayFormat, [V.RecordCount])
else
Result := IntToStr(V.RecordCount);
end
else
Result := '';
end;
function TRxColumnGroupParam.GetGroupTotal: string;
var
V: TColumnGroupItemValue;
F: TField;
begin
V:=GetGroupItem;
if Assigned(V) then
begin
F := TRxDBGrid(FColumn.Grid).DataSource.DataSet.FieldByName(FColumn.FieldName);
if Assigned(F) then
begin
if F.DataType in [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
ftDate, ftTime, ftDateTime, ftTimeStamp, ftLargeint, ftBCD] then
begin
if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
begin
if FValueType in [fvtSum, fvtAvg] then
Result := ''
else
if V.GroupValue = 0 then
Result := ''
else
if FDisplayFormat = '' then
Result := DateToStr(V.GroupValue)
else
Result := FormatDateTime(FDisplayFormat, V.GroupValue);
end
else
if F.DataType in [ftSmallint, ftInteger, ftWord, ftLargeint] then
begin
if FDisplayFormat = '' then
Result := IntToStr(Round(V.GroupValue))
else
Result := FormatFloat(FDisplayFormat, V.GroupValue);
end
else
begin
if FDisplayFormat <> '' then
Result := FormatFloat(FDisplayFormat, V.GroupValue)
else
if F.DataType = ftCurrency then
Result := FloatToStrF(V.GroupValue, ffCurrency, 12, 2)
else
Result := FloatToStr(V.GroupValue);
end;
end
else
Result := '';
end
else
Result := '';
end
else
Result := '';
end;
function TRxColumnGroupParam.GetGroupValue: string;
var
V: TColumnGroupItem;
begin
V:=GetGroupItems;
if Assigned(V) then
Result := V.FieldValue
else
Result := '';
end;
function TRxColumnGroupParam.GetRecNo: string;
var
V: TColumnGroupItem;
begin
V:=GetGroupItems;
if Assigned(V) then
begin
if DisplayFormat <> '' then
Result := Format(DisplayFormat, [V.RecordNo])
else
Result := IntToStr(V.RecordNo);
end
else
Result := '';
end;
constructor TRxColumnGroupParam.Create(AColumn: TRxColumn);
begin
inherited Create;
FColumn:=AColumn;
FValueType:=fvtNon;
FAlignment:=taLeftJustify;
FLayout := tlCenter;
FColor:=clNone;
FFont := TFont.Create;
FillDefaultFont;
FFont.OnChange := @FontChanged;
end;
destructor TRxColumnGroupParam.Destroy;
begin
FreeAndNil(FFont);
inherited Destroy;
end;
procedure TRxColumnGroupParam.FillDefaultFont;
var
AGrid: TCustomGrid;
begin
if not Assigned(FColumn) then exit;
AGrid := FColumn.Grid;
if (AGrid<>nil) then
begin
FFont.Assign(AGrid.Font);
FIsDefaultFont := True;
end;
end;
procedure TRxColumnGroupParam.UpdateValues;
var
F: TField;
V: TColumnGroupItemValue;
begin
if (ValueType in [fvtSum, fvtAvg, fvtMax, fvtMin]) and (FColumn.FieldName <> '') then
begin
F := TRxDBGrid(FColumn.Grid).DataSource.DataSet.FindField(FColumn.FieldName);
V:=TRxDBGrid(FColumn.Grid).FGroupItems.FCurItem.Items[FColumn.FieldName];
if not Assigned(V) then
V:=TRxDBGrid(FColumn.Grid).FGroupItems.FCurItem.AddItem(FColumn.FieldName);
if Assigned(F) and Assigned(V) then
begin
if F.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
begin
case FValueType of
fvtMax: V.GroupValue := Max(V.GroupValue, F.AsDateTime);
fvtMin: V.GroupValue := Min(V.GroupValue, F.AsDateTime);
end;
end
else
begin
case FValueType of
fvtAvg,
fvtSum: V.GroupValue := V.GroupValue + F.AsFloat;
fvtMax: V.GroupValue := Max(V.GroupValue, F.AsFloat);
fvtMin: V.GroupValue := Min(V.GroupValue, F.AsFloat);
end;
end;
end;
end;
end;
{ TRxColumnFooterItemsEnumerator }
@ -1212,43 +1504,160 @@ procedure TColumnGroupItems.SetActive(AValue: boolean);
begin
if FActive=AValue then Exit;
FActive:=AValue;
if FActive then
begin
FRxDBGrid.CalcStatTotals;
end;
//FRxDBGrid.UpdateRowsHeight;
FRxDBGrid.VisualChange;
end;
constructor TColumnGroupItems.Create;
procedure TColumnGroupItems.SetColor(AValue: TColor);
begin
if FColor=AValue then Exit;
FColor:=AValue;
FRxDBGrid.Invalidate;
end;
constructor TColumnGroupItems.Create(ARxDBGrid: TRxDBGrid);
begin
inherited Create;
FActive:=false;
FList:=TFPList.Create;
FRxDBGrid:=ARxDBGrid;
end;
destructor TColumnGroupItems.Destroy;
begin
Clear;
FreeAndNil(FList);
inherited Destroy;
end;
function TColumnGroupItems.FindGroup(ARecordNo: integer): TColumnGroupItem;
function TColumnGroupItems.FindGroupItem(ARecBookMark: TBookMark
): TColumnGroupItem;
var
S, E, i: Integer;
begin
Result:=nil;
if FList.Count = 0 then exit;
S:=0;
E:=FList.Count - 1;
{
while (S<=E) do
begin
i:=(E+S) div 2;
if (TColumnGroupItem(FList[i]).RecordNo = ARecordNo) then
begin
Result:=TColumnGroupItem(FList[i]);
Exit;
end
else
if (TColumnGroupItem(FList[i]).RecordNo > ARecordNo) then E:=i-1
else S:=i+1;
end; }
for i:=0 to FList.Count-1 do
if FRxDBGrid.DataSource.DataSet.CompareBookmarks(TColumnGroupItem(FList[i]).RecBookMark, ARecBookMark) = 0 then
exit(TColumnGroupItem(FList[i]))
end;
procedure TColumnGroupItems.Clear;
var
i: Integer;
begin
for i:=0 to FList.Count-1 do
TColumnGroupItem(FList[i]).Free;
FList.Clear;
end;
procedure TColumnGroupItems.UpdateValues;
begin
if not Assigned(FGroupField) then Exit;
if (FCurrentValue <> FGroupField.DisplayText) or (not Assigned(FCurItem)) then
begin
DoneGroup;
FCurItem:=AddGroupItem;
FCurrentValue:=FGroupField.DisplayText;
FCurItem.RecordCount:=1;
FCurItem.RecordNo:=FRxDBGrid.DataSource.DataSet.RecNo;
FCurItem.RecBookMark:=FRxDBGrid.DataSource.DataSet.Bookmark;
FCurItem.FieldValue:=FCurrentValue;
end
else
begin
Inc(FCurItem.RecordCount);
FCurItem.RecordNo:=FRxDBGrid.DataSource.DataSet.RecNo;
FCurItem.RecBookMark:=FRxDBGrid.DataSource.DataSet.Bookmark;
end;
end;
function TColumnGroupItems.AddGroupItem: TColumnGroupItem;
begin
Result:=TColumnGroupItem.Create;
FList.Add(Result);
end;
procedure TColumnGroupItems.InitGroup;
begin
if (FRxDBGrid.DataSource.DataSet.RecordCount > 0) and (FGroupFieldName <> '') then
begin
FGroupField:=FRxDBGrid.DataSource.DataSet.FieldByName(FGroupFieldName);
FCurrentValue:=FGroupField.DisplayText;
end;
end;
procedure TColumnGroupItems.DoneGroup;
begin
{ TODO : Необходимо список закладок отсортировать }
if Assigned(FCurItem) then
begin
//FCurItem.RecordNo:=FRxDBGrid.DataSource.DataSet.RecNo;
//FCurItem.RecordNo:=PtrInt(FRxDBGrid.DataSource.DataSet.ActiveBuffer);
//FList.Sort(@DoListSortCompare);
//FCurItem.RecordNo:=FRxDBGrid.DataSource.DataSet.Bookmark;
end;
FCurItem:=nil;
end;
{ TColumnGroupItem }
function TColumnGroupItem.GetItems(FieldName: string): TColumnGroupItemValue;
var
i: Integer;
begin
Result:=nil;
for i:=0 to FValues.Count-1 do
if TColumnGroupItemValue(FValues[i]).FieldName = FieldName then
Exit(TColumnGroupItemValue(FValues[i]));
end;
procedure TColumnGroupItem.ClearValues;
var
i: Integer;
begin
for i:=0 to FValues.Count-1 do
TColumnGroupItemValue(FValues[i]).Free;
FValues.Clear;
end;
function TColumnGroupItem.AddItem(AFieldName: string): TColumnGroupItemValue;
begin
Result:=TColumnGroupItemValue.Create;
FValues.Add(Result);
Result.FieldName:=AFieldName;
end;
constructor TColumnGroupItem.Create;
begin
inherited Create;
FValues:=TFPList.Create;
end;
destructor TColumnGroupItem.Destroy;
begin
ClearValues;
FreeAndNil(FValues);
inherited Destroy;
end;
@ -3377,10 +3786,11 @@ var
S:string;
CurActiveRecord: Integer;
R:TRxColumn;
P: PtrInt;
begin
Result:=0;
if not (Assigned(DataLink) and DataLink.Active) then
if (not (Assigned(DataLink) and DataLink.Active)) or ((GCache.VisibleGrid.Top=0) and (GCache.VisibleGrid.Bottom=0)) then
exit;
CurActiveRecord:=DataLink.ActiveRecord;
@ -3389,6 +3799,7 @@ begin
for i:=GCache.VisibleGrid.Top to GCache.VisibleGrid.Bottom do
begin
DataLink.ActiveRecord:=i - FixedRows;
P:=PtrInt(DataSource.DataSet.ActiveBuffer);
H:=1;
for j:=0 to Columns.Count-1 do
begin
@ -3410,6 +3821,11 @@ begin
H:=Max(H, H1);
end;
if FGroupItems.Active and DatalinkActive then
if Assigned(FGroupItems.FindGroupItem(DataSource.DataSet.Bookmark)) then
Inc(H);
if i<RowCount then
begin
if Assigned(FOnCalcRowHeight) then
@ -3559,7 +3975,7 @@ begin
if Assigned(FSaveOnDataSetScrolled) then
FSaveOnDataSetScrolled(aDataSet, Distance);
if rdgWordWrap in FOptionsRx then
if (rdgWordWrap in FOptionsRx) or (FGroupItems.Active) then
UpdateRowsHeight;
end;
@ -3908,9 +4324,10 @@ end;
procedure TRxDBGrid.DrawCell(aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
var
RxColumn: TRxColumn;
RxColumn, C: TRxColumn;
AImageIndex: integer;
FBackground: TColor;
gRect: TRect;
begin
if (gdFixed in aState) and (aRow = 0) then
begin
@ -3920,17 +4337,24 @@ begin
if not ((gdFixed in aState) or ((aCol = 0) and (dgIndicator in Options)) or
((aRow = 0) and (dgTitles in Options))) then
begin
PrepareCanvas(aCol, aRow, aState);
if FGroupItems.Active and Assigned(FGroupItemDrawCur) then
begin
gRect:=aRect;
aRect.Bottom:=aRect.Bottom - DefaultRowHeight - 1;
gRect.Top:=aRect.Bottom;
gRect.Bottom:=gRect.Bottom - 2;
end;
if Assigned(FOnGetCellProps) and not (gdSelected in aState) then
begin
FBackground := Canvas.Brush.Color;
FOnGetCellProps(Self, GetFieldFromGridColumn(aCol), Canvas.Font, FBackground);
Canvas.Brush.Color := FBackground;
end;
Canvas.FillRect(aRect);
DrawCellGrid(aCol, aRow, aRect, aState);
RxColumn := TRxColumn(ColumnFromGridColumn(aCol));
@ -3943,7 +4367,29 @@ begin
DrawCellBitmap(RxColumn, aRect, aState, AImageIndex);
end
else
DefaultDrawCellData(aCol, aRow, aRect, aState);
DefaultDrawCellData(aCol, aRow, aRect, aState)
;
if FGroupItems.Active and Assigned(FGroupItemDrawCur) then
begin
C := ColumnFromGridColumn(aCol) as TRxColumn;
if C.FGroupParam.Color <> clNone then
Canvas.Brush.Color := C.FGroupParam.Color
else
if FGroupItems.Color <> clNone then
Canvas.Brush.Color := FGroupItems.Color
else
Canvas.Brush.Color := Color;
Canvas.Font.Color:=Font.Color;
Canvas.FillRect(gRect);
if C.FGroupParam.FValueType <> fvtNon then
WriteTextHeader(Canvas, gRect, C.FGroupParam.DisplayText, C.FGroupParam.Alignment);
end;
end
else
inherited DrawCell(aCol, aRow, aRect, aState);
@ -4031,6 +4477,31 @@ begin
end;
end;
procedure TRxDBGrid.DrawRow(ARow: Integer);
var
P: TBookMark;
begin
FGroupItemDrawCur:=nil;
if FGroupItems.Active and DatalinkActive then
begin
if (ARow>=FixedRows) then
begin
DataLink.ActiveRecord:=ARow-FixedRows;
P:=DataSource.DataSet.Bookmark;
FGroupItemDrawCur:=FGroupItems.FindGroupItem(P);
end;
end;
inherited DrawRow(ARow);
end;
procedure TRxDBGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
begin
if FGroupItems.Active and Assigned(FGroupItemDrawCur) then
ARect.Bottom:=ARect.Bottom - DefaultRowHeight;
inherited DrawFocusRect(aCol, aRow, ARect);
end;
procedure TRxDBGrid.DrawFooterRows;
var
FooterRect: TRect;
@ -4049,7 +4520,7 @@ var
ABrush: TBrush;
begin
TotalWidth := GCache.ClientWidth;
TotalYOffs := GCache.ClientHeight - (GetDefaultRowHeight * FFooterOptions.RowCount);
TotalYOffs := GCache.ClientHeight {- (GetDefaultRowHeight * FFooterOptions.RowCount)};
FooterRect := Rect(0, TotalYOffs, TotalWidth, TotalYOffs + GetDefaultRowHeight * FFooterOptions.RowCount);
@ -4695,26 +5166,19 @@ var
H, H1:integer;
i: LongInt;
begin
{ Result := ClientHeight div DefaultRowHeight;
if dgTitles in Options then
Dec(Result, 1);}
if GetDefaultRowHeight > 0 then
begin
H:=ClientHeight - GCache.FixedHeight;
H:=ClientHeight;
if FFooterOptions.Active then
H:=H - GetDefaultRowHeight * FFooterOptions.RowCount;
if rdgWordWrap in FOptionsRx then
begin
H1:=0;
Result:=1;
for i:=GCache.VisibleGrid.Top to GCache.VisibleGrid.Bottom do
begin
H1:=H1 + RowHeights[i];
if H1>H then Break;
Inc(Result);
end;
if Result = 0 then Result:=1;
end
else
Result := H div GetDefaultRowHeight;
if dgTitles in Options then
Dec(Result, 1);
end
else
Result := 1;
@ -4911,7 +5375,7 @@ begin
MaxClientXY.Y:=MaxClientXY.Y - (GetDefaultRowHeight * FFooterOptions.RowCount + 2);
end;
if rdgWordWrap in FOptionsRx then
if ((rdgWordWrap in FOptionsRx) or (Assigned(FGroupItems) and FGroupItems.Active)) and (HandleAllocated) then
UpdateRowsHeight;
inherited VisualChange;
@ -4994,8 +5458,9 @@ var
FCList, FCList2:TFPList;
j: Integer;
F: TRxColumnFooterItem;
S: String;
begin
if (not (FFooterOptions.Active and DatalinkActive)) or (Columns.Count = 0) or (gsAddingAutoColumns in GridStatus) then
if (not (DatalinkActive and (FGroupItems.Active or FFooterOptions.Active))) or (Columns.Count = 0) or (gsAddingAutoColumns in GridStatus) then
Exit;
if Assigned(OnRxCalcFooterValues)then
@ -5015,7 +5480,7 @@ begin
APresent := False;
for C in Columns do
begin
APresent := (C.Footer.FValueType in [fvtSum, fvtAvg, fvtMax, fvtMin, fvtCount]) or (C.FGroupItems.Active);
APresent := (C.Footer.FValueType in [fvtSum, fvtAvg, fvtMax, fvtMin, fvtCount]) {or (C.FGroupItems.Active)};
if not APresent then
begin
for F in C.Footers do
@ -5029,17 +5494,19 @@ begin
break;
end;
if not APresent then Exit;
if (not APresent) and (not FGroupItems.Active) then Exit;
Inc(FInProcessCalc);
cnt:=0;
if FGroupItems.Active then FGroupItems.Clear;
for C in Columns do
begin
C.Footer.ResetTestValue;
for F in C.Footers do F.ResetTestValue;
C.FGroupItems.Clear;
end;
if (DataSource.DataSet.RecordCount<=0) then
@ -5088,10 +5555,16 @@ begin
end;
end;
if C.FGroupItems.Active then FCList2.Add(C);
if FGroupItems.Active then
if C.FGroupParam.ValueType <> fvtNon then
FCList2.Add(C);
end;
DHS.First;
if FGroupItems.Active then
FGroupItems.InitGroup;
while not DHS.EOF do
begin
for i:=0 to FCList.Count-1 do
@ -5107,16 +5580,18 @@ begin
end;
end;
if FGroupItems.Active then
begin
FGroupItems.UpdateValues;
for i:=0 to FCList2.Count-1 do
TRxColumn(FCList[i]).FGroupItems.UpdateValues;
TRxColumn(FCList2[i]).FGroupParam.UpdateValues;
end;
inc(cnt);
DHS.Next;
end;
FCList2.Free;
FCList.Free;
//calc agregate values
for C in Columns do
begin
if C.Footer.ValueType = fvtCount then
@ -5135,6 +5610,13 @@ begin
end;
end;
if FGroupItems.Active then
FGroupItems.DoneGroup;
FCList2.Free;
FCList.Free;
//Restore cursor position
if Min(Datalink.RecordCount + SavePos - 1, DHS.RecNo) > 0 then
DHS.RecNo := Min(Datalink.RecordCount + SavePos - 1, DHS.RecNo);
@ -5657,11 +6139,45 @@ begin
end;
procedure TRxDBGrid.DoEditorShow;
var
R, R1: TRect;
FSaveRow: Integer;
P: TBookMark;
FG: TColumnGroupItem;
begin
inherited DoEditorShow;
{ if FGroupItems.Active then
begin
if (Row>=FixedRows) then
begin
FSaveRow:=DataLink.ActiveRecord;
DataLink.ActiveRecord:=Row-FixedRows;
P:=DataSource.DataSet.Bookmark;
DataLink.ActiveRecord:=FSaveRow;
FG:=FGroupItems.FindGroupItem(P);
if Assigned(FG) then
begin
R:=CellRect(Col, Row);
Editor.SetBounds(R.Left, R.Top, R.Right - R.Left - 1, R.Bottom - R.Top - DefaultRowHeight - 1);
R1:=Editor.BoundsRect;
end;
end;
end; }
DoSetColEdtBtn;
end;
procedure TRxDBGrid.CheckNewCachedSizes(var AGCache: TGridDataCache);
begin
inherited CheckNewCachedSizes(AGCache);
if FFooterOptions.Active then
begin
AGCache.ClientHeight:=AGCache.ClientHeight - DefaultRowHeight * FFooterOptions.RowCount;
AGCache.ScrollHeight:=AGCache.ScrollHeight - DefaultRowHeight * FFooterOptions.RowCount;
AGCache.ClientRect.Bottom:=AGCache.ClientRect.Bottom - DefaultRowHeight * FFooterOptions.RowCount;
end;
end;
procedure TRxDBGrid.GetOnCreateLookup;
begin
if Assigned(F_CreateLookup) then
@ -5824,10 +6340,14 @@ begin
FSearchOptions:=TRxDBGridSearchOptions.Create(Self);
FSortColumns:=TRxDbGridColumnsSortList.Create;
FGroupItems:=TColumnGroupItems.Create(Self);
F_MenuBMP := CreateResBitmap('rx_menu_grid');
Options := Options - [dgTabs];
// TDrawGrid(Self).Options:=TDrawGrid(Self).Options + [goColSpanning];
OptionsRx := OptionsRx + [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter];
FAutoSort := True;
@ -5893,6 +6413,7 @@ begin
FreeAndNil(FToolsList);
FreeAndNil(FColumnDefValues);
FreeAndNil(FSearchOptions);
FreeAndNil(FGroupItems);
inherited Destroy;
FreeAndNil(FSortColumns);
@ -6122,12 +6643,12 @@ begin
FEditButtons:=TRxColumnEditButtons.Create(Self);
FOptions:=[coCustomizeVisible, coCustomizeWidth];
FFooters:=TRxColumnFooterItems.Create(Self);
FGroupItems:=TColumnGroupItems.Create;
FGroupParam:=TRxColumnGroupParam.Create(Self);
end;
destructor TRxColumn.Destroy;
begin
FreeAndNil(FGroupItems);
FreeAndNil(FGroupParam);
FreeAndNil(FFooters);
FreeAndNil(FEditButtons);
if FKeyList <> nil then
@ -6531,6 +7052,5 @@ finalization
FreeAndNil(FUpDownRxBMP);
FreeAndNil(FPlusRxBMP);
FreeAndNil(FMinusRxBMP);
end.