RxFPC:start work on merge cells in RxDBGrid

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5926 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2017-06-09 13:26:54 +00:00
parent 060777b723
commit 06fca537ad
10 changed files with 789 additions and 8 deletions

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,82 @@
<?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>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<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"/>
<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,273 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="17">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<TopLine Value="43"/>
<CursorPos X="138" Y="62"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdb/rxdbgrid.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="4317"/>
<CursorPos Y="4335"/>
<UsageCount Value="10"/>
<Bookmarks Count="1">
<Item0 X="7" Y="4331" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="8"/>
<TopLine Value="4437"/>
<CursorPos Y="4468"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<EditorIndex Value="7"/>
<TopLine Value="1920"/>
<CursorPos Y="1939"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../../../install/source/fpcsrc/tests/bench/shootout/src/fannkuch.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="16"/>
<CursorPos X="11" Y="25"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="../../../../install/source/fpcsrc/rtl/inc/systemh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="834"/>
<CursorPos Y="848"/>
<UsageCount Value="10"/>
</Unit6>
<Unit7>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxtools/rxutils.pas"/>
<EditorIndex Value="5"/>
<TopLine Value="64"/>
<CursorPos X="2" Y="91"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxtools/rxstrutils.pas"/>
<EditorIndex Value="6"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="../../../../install/source/fpcsrc/rtl/objpas/objpas.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="49"/>
<CursorPos X="8" Y="35"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="../../../../install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<EditorIndex Value="3"/>
<TopLine Value="1783"/>
<CursorPos X="15" Y="1801"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="../../../../install/source/fpcsrc/packages/fcl-db/src/base/datasource.inc"/>
<EditorIndex Value="4"/>
<TopLine Value="146"/>
<CursorPos X="48" Y="149"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="/usr/local/share/lazarus/lcl/include/wincontrol.inc"/>
<EditorIndex Value="2"/>
<TopLine Value="8050"/>
<CursorPos Y="8080"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="/usr/local/share/lazarus/lcl/lclproc.pas"/>
<UnitName Value="LCLProc"/>
<EditorIndex Value="-1"/>
<TopLine Value="899"/>
<CursorPos Y="918"/>
<UsageCount Value="10"/>
</Unit13>
<Unit14>
<Filename Value="/usr/local/share/lazarus/lcl/include/control.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="3877"/>
<CursorPos Y="3897"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<EditorIndex Value="10"/>
<TopLine Value="1273"/>
<CursorPos Y="1303"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="/usr/local/share/lazarus/lcl/graphics.pp"/>
<UnitName Value="Graphics"/>
<EditorIndex Value="9"/>
<TopLine Value="1193"/>
<CursorPos X="15" Y="1210"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit16>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1246" TopLine="1226"/>
</Position1>
<Position2>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1239" Column="119" TopLine="1226"/>
</Position2>
<Position3>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1248" TopLine="1226"/>
</Position3>
<Position4>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1251" TopLine="1226"/>
</Position4>
<Position5>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1252" TopLine="1226"/>
</Position5>
<Position6>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1255" TopLine="1226"/>
</Position6>
<Position7>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1257" TopLine="1227"/>
</Position7>
<Position8>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1263" TopLine="1233"/>
</Position8>
<Position9>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1264" TopLine="1243"/>
</Position9>
<Position10>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1266" TopLine="1243"/>
</Position10>
<Position11>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1267" TopLine="1243"/>
</Position11>
<Position12>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1269" TopLine="1243"/>
</Position12>
<Position13>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1272" TopLine="1243"/>
</Position13>
<Position14>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1273" TopLine="1243"/>
</Position14>
<Position15>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1275" TopLine="1245"/>
</Position15>
<Position16>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1278" TopLine="1248"/>
</Position16>
<Position17>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1279" TopLine="1249"/>
</Position17>
<Position18>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1280" TopLine="1250"/>
</Position18>
<Position19>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1281" TopLine="1251"/>
</Position19>
<Position20>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1283" TopLine="1253"/>
</Position20>
<Position21>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1285" TopLine="1255"/>
</Position21>
<Position22>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1286" TopLine="1256"/>
</Position22>
<Position23>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1287" TopLine="1257"/>
</Position23>
<Position24>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1289" TopLine="1259"/>
</Position24>
<Position25>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1293" TopLine="1263"/>
</Position25>
<Position26>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1294" TopLine="1264"/>
</Position26>
<Position27>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1296" TopLine="1266"/>
</Position27>
<Position28>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1299" TopLine="1269"/>
</Position28>
<Position29>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1302" TopLine="1272"/>
</Position29>
<Position30>
<Filename Value="/usr/local/share/lazarus/lcl/include/canvas.inc"/>
<Caret Line="1303" TopLine="1273"/>
</Position30>
</JumpHistory>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,223 @@
object Form1: TForm1
Left = 574
Height = 620
Top = 316
Width = 770
Caption = 'Form1'
ClientHeight = 620
ClientWidth = 770
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 570
Top = 50
Width = 770
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'CODE'
Width = 60
FieldName = 'CODE'
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 = 'DATE'
Width = 90
FieldName = 'DATE'
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 = 'NAME'
Width = 400
FieldName = 'NAME'
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.DrawFullLine = False
SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
SearchOptions.FromStart = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter]
Align = alClient
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = dsData
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
TabOrder = 0
end
object Panel1: TPanel
Left = 0
Height = 50
Top = 0
Width = 770
Align = alTop
Caption = 'Panel1'
ClientHeight = 50
ClientWidth = 770
TabOrder = 1
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 7
Height = 24
Top = 7
Width = 108
BorderSpacing.Around = 6
Caption = 'Col spanning'
OnChange = CheckBox1Change
TabOrder = 0
end
object Label1: TLabel
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 721
Height = 20
Top = 15
Width = 42
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
Caption = 'Label1'
ParentColor = False
end
end
object rxData: TRxMemoryData
FieldDefs = <
item
Name = 'CODE'
DataType = ftInteger
end
item
Name = 'DATE'
DataType = ftDateTime
end
item
Name = 'NAME'
DataType = ftString
Size = 150
end>
AfterScroll = rxDataAfterScroll
PacketRecords = 0
Left = 293
Top = 165
object rxDataCODE: TLongintField
FieldKind = fkData
FieldName = 'CODE'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataDATE: TDateTimeField
FieldKind = fkData
FieldName = 'DATE'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
DisplayFormat = 'dd.mm.yyyy'
end
object rxDataNAME: TStringField
FieldKind = fkData
FieldName = 'NAME'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 150
end
end
object dsData: TDataSource
DataSet = rxData
Left = 256
Top = 165
end
end

View File

@ -0,0 +1,84 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, rxdbgrid, rxmemds, Forms, Controls, Graphics,
Dialogs, ExtCtrls, StdCtrls, db;
type
{ TForm1 }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
dsData: TDataSource;
Label1: TLabel;
Panel1: TPanel;
rxDataCODE: TLongintField;
rxDataDATE: TDateTimeField;
rxDataNAME: TStringField;
RxDBGrid1: TRxDBGrid;
rxData: TRxMemoryData;
procedure CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rxDataAfterScroll(DataSet: TDataSet);
private
procedure RxDBGridMergeCellsEvent(Sender: TObject; ACol: Integer; Column: TRxColumn;
var ALeft, ARight: Integer);
public
end;
var
Form1: TForm1;
implementation
uses Grids;
{$R *.lfm}
{ TForm1 }
type
THackDataGrid = class(TRxDBGrid);
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
rxData.Open;
for i:=1 to 30 do
rxData.AppendRecord([i, Date - i, 'Line '+IntToStr(i)]);
rxData.First;
RxDBGrid1.OnMergeCells:=@RxDBGridMergeCellsEvent;
end;
procedure TForm1.rxDataAfterScroll(DataSet: TDataSet);
begin
Label1.Caption:=Format('Datalink.ActiveRecord=%d, Row = %d', [THackDataGrid(RxDBGrid1).Datalink.ActiveRecord, TDrawGrid(RxDBGrid1).Row]);
end;
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
if CheckBox1.Checked then
RxDBGrid1.OptionsRx:=RxDBGrid1.OptionsRx + [rdgColSpanning]
else
RxDBGrid1.OptionsRx:=RxDBGrid1.OptionsRx - [rdgColSpanning];
end;
procedure TForm1.RxDBGridMergeCellsEvent(Sender: TObject; ACol: Integer;
Column: TRxColumn; var ALeft, ARight: Integer);
begin
if rxDataCODE.AsInteger mod 10 = 1 then
begin
ALeft:=1;
ARight:=3;
end;
end;
end.

View File

@ -74,6 +74,8 @@ type
var Processed: boolean) of object;
TRxDBGridCalcRowHeight = procedure(Sender: TRxDBGrid; var ARowHegth:integer) of object;
TRxDBGridMergeCellsEvent = procedure (Sender: TObject; ACol{, ARow}: Integer; Column: TRxColumn;
var ALeft, {ATop,} ARight{, ABottom}: Integer) of object;
//Freeman35 added
TOnRxCalcFooterValues = procedure(Sender: TObject; Column: TRxColumn; var AValue : Variant) of object;
@ -106,7 +108,8 @@ type
rdgAllowToolMenu,
rdgCaseInsensitiveSort,
rdgWordWrap,
rdgDisableWordWrapTitles
rdgDisableWordWrapTitles,
rdgColSpanning
);
TOptionsRx = set of TOptionRx;
@ -719,6 +722,9 @@ type
FSortColumns: TRxDbGridColumnsSortList;
FSortingNow:Boolean;
FInProcessCalc: integer;
FOnMergeCells: TRxDBGridMergeCellsEvent;
FMergeLock: Integer;
//
FKeyStrokes: TRxDBGridKeyStrokes;
FOnGetCellProps: TGetCellPropsEvent;
@ -911,6 +917,11 @@ type
procedure DoEditorShow; override;
procedure CheckNewCachedSizes(var AGCache:TGridDataCache); override;
procedure CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
function IsMerged(ACol{, ARow}: Integer): Boolean; overload;
function IsMerged(ACol{, ARow}: Integer; out ALeft, {ATop, }ARight{, ABottom}: Integer): Boolean; overload;
procedure PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); override;
property Editor;
public
constructor Create(AOwner: TComponent); override;
@ -1085,6 +1096,7 @@ type
property OnCreateLookup: TCreateLookup read F_CreateLookup write F_CreateLookup;
property OnDisplayLookup: TDisplayLookup read F_DisplayLookup write F_DisplayLookup;
property OnMergeCells:TRxDBGridMergeCellsEvent read FOnMergeCells write FOnMergeCells;
end;
{ TRxDBGridAbstractTools }
@ -1123,9 +1135,9 @@ procedure RegisterRxDBGridSortEngine(RxDBGridSortEngineClass: TRxDBGridSortEngin
implementation
uses Math, rxdconst, rxstrutils, strutils, rxdbgrid_findunit, rxdbgrid_columsunit,
RxDBGrid_PopUpFilterUnit,
rxlookup, rxtooledit, LCLProc, Clipbrd, rxfilterby, rxsortby, variants, LazUTF8;
uses Math, rxdconst, rxstrutils, rxutils, strutils, rxdbgrid_findunit,
rxdbgrid_columsunit, RxDBGrid_PopUpFilterUnit, rxlookup, rxtooledit, LCLProc,
Clipbrd, rxfilterby, rxsortby, variants, LazUTF8;
{$R rxdbgrid.res}
@ -3191,7 +3203,7 @@ end;
procedure TRxDBGrid.AdjustEditorBounds(NewCol, NewRow: Integer);
begin
inherited AdjustEditorBounds(NewCol, NewRow);
// inherited AdjustEditorBounds(NewCol, NewRow);
if EditorMode then
begin
DoSetColEdtBtn;
@ -4304,7 +4316,8 @@ var
S: string;
F: TField;
C: TRxColumn;
j, DataCol: integer;
j, DataCol, L, R: integer;
TS, TS1: TTextStyle;
begin
if Assigned(OnDrawColumnCell) and not (CsDesigning in ComponentState) then
begin
@ -4313,6 +4326,16 @@ begin
end
else
begin
TS:=Canvas.TextStyle;
if rdgColSpanning in OptionsRx then
if IsMerged(aCol, L, R) then
begin
aCol:=L;
TS1:=Canvas.TextStyle;
TS1.Clipping:=false;
Canvas.TextStyle:=TS1;
end;
F := GetFieldFromGridColumn(aCol);
C := ColumnFromGridColumn(aCol) as TRxColumn;
if Assigned(C) and Assigned(C.FOnDrawColumnCell) then
@ -4339,12 +4362,16 @@ begin
end
else
S := '';
S:='11';
if (rdgWordWrap in FOptionsRx) and Assigned(C) and (C.WordWrap) then
WriteTextHeader(Canvas, aRect, S, C.Alignment)
else
DrawCellText(aCol, aRow, aRect, aState, S);
end;
end;
Canvas.TextStyle:=TS;
end;
end;
@ -4363,6 +4390,10 @@ begin
if not ((gdFixed in aState) or ((aCol = 0) and (dgIndicator in Options)) or
((aRow = 0) and (dgTitles in Options))) then
begin
if rdgColSpanning in OptionsRx then
CalcCellExtent(acol, arow, aRect);
PrepareCanvas(aCol, aRow, aState);
if FGroupItems.Active and Assigned(FGroupItemDrawCur) then
@ -6190,6 +6221,16 @@ begin
end;
end;
end; }
if rdgColSpanning in OptionsRx then
begin
if IsMerged(Col) then
begin
CalcCellExtent(Col, Row, R);
Editor.SetBounds(R.Left, R.Top, R.Right-R.Left-1, R.Bottom-R.Top-1);
end;
end;
DoSetColEdtBtn;
end;
@ -6206,6 +6247,59 @@ begin
end;
procedure TRxDBGrid.CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
var
L, T, R, B: Integer;
begin
if IsMerged(ACol, {ARow, }L{, T}, R{, B}) then
begin
ARect.TopLeft := CellRect(L, ARow).TopLeft;
ARect.BottomRight := CellRect(R, ARow).BottomRight;
{ ARect.Left := CellRect(L, ARow).Left;
ARect.Right := CellRect(R, ARow).Right;}
end;
end;
function TRxDBGrid.IsMerged(ACol{, ARow}: Integer): Boolean;
var
L, T, R, B: Integer;
begin
Result := IsMerged(ACol, {ARow,} L, {T,} R{, B});
end;
function TRxDBGrid.IsMerged(ACol{, ARow}: Integer; out ALeft{, ATop}, ARight{,
ABottom}: Integer): Boolean;
var
FColumn: TRxColumn;
begin
Result := false;
if not (rdgColSpanning in OptionsRx) then exit;
if not Assigned(FOnMergeCells) then exit;
inc(FMergeLock);
ALeft := ACol;
ARight := ACol;
FColumn:=TRxColumn(ColumnFromGridColumn(ACol));
FOnMergeCells(Self, ACol, {ARow,} FColumn, ALeft, {ATop, }ARight{, ABottom});
if ALeft > ARight then
SwapValues(ALeft, ARight);
Result := (ALeft <> ARight) {or (ATop <> ABottom)};
dec(FMergeLock);
end;
procedure TRxDBGrid.PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState);
var
L, R, RR: Integer;
begin
if (rdgColSpanning in OptionsRx) then
if ((Row - FixedRows) = Datalink.ActiveRecord) and IsMerged(ACol, L, R) and (aCol >= L) and (aCol <= R) then
AState := AState + [gdSelected, gdFocused];
inherited PrepareCanvas(aCol, aRow, AState);
end;
procedure TRxDBGrid.GetOnCreateLookup;
begin
if Assigned(F_CreateLookup) then

View File

@ -15,7 +15,7 @@
"/>
<License Value="LGPL"/>
<Version Minor="3" Build="6"/>
<Files Count="8">
<Files Count="9">
<Item1>
<Filename Value="rxtools/rxcrc.pas"/>
<UnitName Value="rxCRC"/>
@ -47,6 +47,10 @@
<Filename Value="rxtools/rxstrutils.pas"/>
<UnitName Value="rxstrutils"/>
</Item8>
<Item9>
<Filename Value="rxtools/rxutils.pas"/>
<UnitName Value="rxutils"/>
</Item9>
</Files>
<LazDoc Paths="docs;/usr/local/share/lazarus/components/rxnew/docs"/>
<i18n>

View File

@ -9,7 +9,7 @@ interface
uses
rxCRC, rxConfigValues, rxconst, rxdateutil, rxdconst, rxFileUtils,
rxstrutils, LazarusPackageIntf;
rxstrutils, rxutils, LazarusPackageIntf;
implementation