RxFPC:add new event - RxDBGrid.OnMergeCells (based on lazarus demo examples/gridexamples/merged_cells)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5933 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2017-06-13 08:58:24 +00:00
parent 478b727aef
commit 918d5faa64
5 changed files with 265 additions and 190 deletions

View File

@ -3,7 +3,7 @@
<ProjectSession> <ProjectSession>
<Version Value="10"/> <Version Value="10"/>
<BuildModes Active="Default"/> <BuildModes Active="Default"/>
<Units Count="17"> <Units Count="20">
<Unit0> <Unit0>
<Filename Value="project1.lpr"/> <Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -11,7 +11,7 @@
<WindowIndex Value="-1"/> <WindowIndex Value="-1"/>
<TopLine Value="-1"/> <TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/> <CursorPos X="-1" Y="-1"/>
<UsageCount Value="21"/> <UsageCount Value="24"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
@ -20,40 +20,40 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/> <UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="43"/> <TopLine Value="43"/>
<CursorPos X="24" Y="57"/> <CursorPos Y="46"/>
<UsageCount Value="21"/> <UsageCount Value="24"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<LoadedDesigner Value="True"/> <LoadedDesigner Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<TopLine Value="5457"/> <TopLine Value="1106"/>
<CursorPos Y="5473"/> <CursorPos Y="1142"/>
<UsageCount Value="10"/> <UsageCount Value="11"/>
<Bookmarks Count="1"> <Bookmarks Count="1">
<Item0 X="7" Y="4336" ID="1"/> <Item0 X="54" Y="6391" ID="1"/>
</Bookmarks> </Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../../../lcl/grids.pas"/>
<UnitName Value="Grids"/> <UnitName Value="Grids"/>
<EditorIndex Value="6"/> <EditorIndex Value="5"/>
<TopLine Value="8814"/> <TopLine Value="116"/>
<CursorPos Y="8835"/> <CursorPos X="3" Y="134"/>
<UsageCount Value="10"/> <UsageCount Value="11"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../../../lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/> <UnitName Value="DBGrids"/>
<IsVisibleTab Value="True"/> <EditorIndex Value="4"/>
<EditorIndex Value="5"/> <TopLine Value="475"/>
<TopLine Value="2113"/> <CursorPos X="14" Y="491"/>
<CursorPos X="3" Y="2117"/> <UsageCount Value="11"/>
<UsageCount Value="10"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
@ -72,16 +72,16 @@
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="../../../rxtools/rxutils.pas"/> <Filename Value="../../../rxtools/rxutils.pas"/>
<EditorIndex Value="3"/> <EditorIndex Value="2"/>
<TopLine Value="64"/> <TopLine Value="64"/>
<CursorPos X="2" Y="91"/> <CursorPos X="2" Y="91"/>
<UsageCount Value="10"/> <UsageCount Value="11"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="../../../rxtools/rxstrutils.pas"/> <Filename Value="../../../rxtools/rxstrutils.pas"/>
<EditorIndex Value="4"/> <EditorIndex Value="3"/>
<UsageCount Value="10"/> <UsageCount Value="11"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit8> </Unit8>
<Unit9> <Unit9>
@ -107,11 +107,10 @@
</Unit11> </Unit11>
<Unit12> <Unit12>
<Filename Value="../../../../../lcl/include/wincontrol.inc"/> <Filename Value="../../../../../lcl/include/wincontrol.inc"/>
<EditorIndex Value="2"/> <EditorIndex Value="-1"/>
<TopLine Value="8050"/> <TopLine Value="8050"/>
<CursorPos Y="8080"/> <CursorPos Y="8080"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="../../../../../lcl/lclproc.pas"/> <Filename Value="../../../../../lcl/lclproc.pas"/>
@ -130,152 +129,178 @@
</Unit14> </Unit14>
<Unit15> <Unit15>
<Filename Value="../../../../../lcl/include/canvas.inc"/> <Filename Value="../../../../../lcl/include/canvas.inc"/>
<EditorIndex Value="8"/> <EditorIndex Value="-1"/>
<TopLine Value="1273"/> <TopLine Value="1195"/>
<CursorPos Y="1303"/> <CursorPos Y="1212"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="../../../../../lcl/graphics.pp"/> <Filename Value="../../../../../lcl/graphics.pp"/>
<UnitName Value="Graphics"/> <UnitName Value="Graphics"/>
<EditorIndex Value="7"/> <EditorIndex Value="-1"/>
<TopLine Value="1193"/> <TopLine Value="1193"/>
<CursorPos X="15" Y="1210"/> <CursorPos X="15" Y="1210"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit16> </Unit16>
<Unit17>
<Filename Value="/home/install/source/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="72"/>
<CursorPos X="30" Y="91"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="../../../../../lcl/include/winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="197"/>
<CursorPos Y="216"/>
<UsageCount Value="10"/>
</Unit18>
<Unit19>
<Filename Value="../../../../../lcl/interfaces/gtk2/gtk2winapi.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="2377"/>
<CursorPos X="3" Y="2395"/>
<UsageCount Value="10"/>
</Unit19>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="30" HistoryIndex="29">
<Position1> <Position1>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="506" Column="19" TopLine="476"/> <Caret Line="4412" Column="7" TopLine="4378"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="3596" Column="37" TopLine="3565"/> <Caret Line="4371" Column="28" TopLine="4356"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="3603" Column="34" TopLine="3572"/> <Caret Line="5219" Column="3" TopLine="5197"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="6300" TopLine="6278"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="506" Column="28" TopLine="476"/> <Caret Line="6305" Column="22" TopLine="6290"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="3596" Column="37" TopLine="3565"/> <Caret Line="6308" Column="34" TopLine="6288"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="3603" Column="34" TopLine="3572"/> <Caret Line="6340" Column="3" TopLine="6318"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="6339" Column="22" TopLine="6318"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="506" Column="28" TopLine="476"/> <Caret Line="6355" Column="22" TopLine="6334"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="3596" Column="37" TopLine="3565"/> <Caret Line="6370" Column="19" TopLine="6350"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="8140" Column="15" TopLine="8109"/> <Caret Line="6371" Column="24" TopLine="6353"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="8829" Column="31" TopLine="8804"/> <Caret Line="1104" Column="14" TopLine="1089"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="6305" Column="5" TopLine="6296"/> <Caret Line="64" Column="55" TopLine="40"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="926" Column="72" TopLine="907"/> <Caret Line="81" Column="49" TopLine="52"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="6334" Column="9" TopLine="6300"/> <Caret Line="90" Column="9" TopLine="56"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="6313" Column="38" TopLine="6300"/> <Caret Line="71" Column="5" TopLine="55"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="6329" TopLine="6300"/> <Caret Line="72" TopLine="55"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="8825" TopLine="8805"/> <Caret Line="4368" Column="45" TopLine="4338"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="8826" TopLine="8814"/> <Caret Line="4374" TopLine="4345"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="8827" TopLine="8814"/> <Caret Line="76" Column="37" TopLine="55"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="8828" TopLine="8814"/> <Caret Line="4406" TopLine="4387"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="../../../rxdb/rxdbgrid.pas"/>
<Caret Line="8829" TopLine="8814"/> <Caret Line="1142" TopLine="1118"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="8830" TopLine="8814"/> <Caret Line="79" Column="35" TopLine="54"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="../../../../../lcl/grids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="8835" TopLine="8814"/> <Caret Line="105" Column="28" TopLine="71"/>
</Position24> </Position24>
<Position25> <Position25>
<Filename Value="../../../rxdb/rxdbgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="5473" TopLine="5457"/> <Caret Line="34" Column="44" TopLine="33"/>
</Position25> </Position25>
<Position26> <Position26>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="506" Column="15" TopLine="488"/> <Caret Line="104" TopLine="70"/>
</Position26> </Position26>
<Position27> <Position27>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="3598" Column="3" TopLine="3595"/> <Caret Line="101" TopLine="71"/>
</Position27> </Position27>
<Position28> <Position28>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="386" Column="15" TopLine="368"/> <Caret Line="35" Column="3" TopLine="8"/>
</Position28> </Position28>
<Position29> <Position29>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="2019" Column="3" TopLine="2014"/> <Caret Line="47" TopLine="44"/>
</Position29> </Position29>
<Position30> <Position30>
<Filename Value="../../../../../lcl/dbgrids.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="391" Column="15" TopLine="373"/> <Caret Line="46" TopLine="43"/>
</Position30> </Position30>
</JumpHistory> </JumpHistory>
</ProjectSession> </ProjectSession>
<Debugging> <Debugging>
<BreakPoints Count="1"> <Watches Count="4">
<Item1> <Item1>
<Kind Value="bpkSource"/> <Expression Value="fRect"/>
<WatchScope Value="wpsLocal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="../../../rxdb/rxdbgrid.pas"/>
<Line Value="6328"/>
</Item1> </Item1>
</BreakPoints> <Item2>
<Expression Value="ARect"/>
</Item2>
<Item3>
<Expression Value="X"/>
</Item3>
<Item4>
<Expression Value="Y"/>
</Item4>
</Watches>
</Debugging> </Debugging>
</CONFIG> </CONFIG>

View File

@ -18,6 +18,7 @@ object Form1: TForm1
AutoSort = True AutoSort = True
Columns = < Columns = <
item item
Alignment = taCenter
Title.Alignment = taCenter Title.Alignment = taCenter
Title.Orientation = toHorizontal Title.Orientation = toHorizontal
Title.Caption = 'CODE' Title.Caption = 'CODE'
@ -30,6 +31,8 @@ object Form1: TForm1
Filter.EmptyFont.Style = [fsItalic] Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1 Filter.ItemIndex = -1
Footers = <> Footers = <>
WordWrap = True
OnDrawColumnCell = RxDBGrid1Columns0DrawColumnCell
end end
item item
Title.Alignment = taCenter Title.Alignment = taCenter
@ -128,6 +131,7 @@ object Form1: TForm1
DataSource = dsData DataSource = dsData
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit] Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
TabOrder = 0 TabOrder = 0
OnMergeCells = RxDBGrid1MergeCells
end end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
@ -135,7 +139,6 @@ object Form1: TForm1
Top = 0 Top = 0
Width = 770 Width = 770
Align = alTop Align = alTop
Caption = 'Panel1'
ClientHeight = 50 ClientHeight = 50
ClientWidth = 770 ClientWidth = 770
TabOrder = 1 TabOrder = 1
@ -151,20 +154,6 @@ object Form1: TForm1
OnChange = CheckBox1Change OnChange = CheckBox1Change
TabOrder = 0 TabOrder = 0
end 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 end
object rxData: TRxMemoryData object rxData: TRxMemoryData
FieldDefs = < FieldDefs = <
@ -181,7 +170,6 @@ object Form1: TForm1
DataType = ftString DataType = ftString
Size = 150 Size = 150
end> end>
AfterScroll = rxDataAfterScroll
PacketRecords = 0 PacketRecords = 0
Left = 293 Left = 293
Top = 165 Top = 165

View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, rxdbgrid, rxmemds, Forms, Controls, Graphics, Classes, SysUtils, FileUtil, rxdbgrid, rxmemds, Forms, Controls, Graphics,
Dialogs, ExtCtrls, StdCtrls, db; Dialogs, ExtCtrls, StdCtrls, db, Grids, DBGrids;
type type
@ -15,7 +15,6 @@ type
TForm1 = class(TForm) TForm1 = class(TForm)
CheckBox1: TCheckBox; CheckBox1: TCheckBox;
dsData: TDataSource; dsData: TDataSource;
Label1: TLabel;
Panel1: TPanel; Panel1: TPanel;
rxDataCODE: TLongintField; rxDataCODE: TLongintField;
rxDataDATE: TDateTimeField; rxDataDATE: TDateTimeField;
@ -24,10 +23,13 @@ type
rxData: TRxMemoryData; rxData: TRxMemoryData;
procedure CheckBox1Change(Sender: TObject); procedure CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure rxDataAfterScroll(DataSet: TDataSet); procedure RxDBGrid1Columns0DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
procedure RxDBGrid1MergeCells(Sender: TObject; ACol: Integer; var ALeft,
ARight: Integer; var ADisplayColumn: TRxColumn);
private private
procedure RxDBGridMergeCellsEvent(Sender: TObject; ACol: Integer; Column: TRxColumn;
var ALeft, ARight: Integer);
public public
end; end;
@ -36,15 +38,11 @@ var
Form1: TForm1; Form1: TForm1;
implementation implementation
uses Grids;
{$R *.lfm} {$R *.lfm}
{ TForm1 } { TForm1 }
type
THackDataGrid = class(TRxDBGrid);
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
var var
i: Integer; i: Integer;
@ -55,13 +53,32 @@ begin
rxData.AppendRecord([i, Date - i, 'Line '+IntToStr(i)]); rxData.AppendRecord([i, Date - i, 'Line '+IntToStr(i)]);
rxData.First; rxData.First;
rxData.EnableControls; rxData.EnableControls;
RxDBGrid1.OnMergeCells:=@RxDBGridMergeCellsEvent;
end; end;
procedure TForm1.rxDataAfterScroll(DataSet: TDataSet); procedure TForm1.RxDBGrid1Columns0DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
S: String;
FAl: TAlignment;
begin begin
Label1.Caption:=Format('Datalink.ActiveRecord=%d, Row = %d', [THackDataGrid(RxDBGrid1).Datalink.ActiveRecord, TDrawGrid(RxDBGrid1).Row]); S:=rxDataCODE.DisplayText;
if CheckBox1.Checked and (rxDataCODE.AsInteger mod 10 = 1) then
FAl:=taCenter
else
FAl:=taRightJustify;
WriteTextHeader(RxDBGrid1.Canvas, Rect, S, FAl)
end;
procedure TForm1.RxDBGrid1MergeCells(Sender: TObject; ACol: Integer; var ALeft,
ARight: Integer; var ADisplayColumn: TRxColumn);
begin
if rxDataCODE.AsInteger mod 10 = 1 then
begin
ALeft:=1;
ARight:=3;
{ if rxDataCODE.AsInteger > 10 then
AColumn:=RxDBGrid1.ColumnByFieldName('DATE');}
end;
end; end;
procedure TForm1.CheckBox1Change(Sender: TObject); procedure TForm1.CheckBox1Change(Sender: TObject);
@ -72,15 +89,5 @@ begin
RxDBGrid1.OptionsRx:=RxDBGrid1.OptionsRx - [rdgColSpanning]; RxDBGrid1.OptionsRx:=RxDBGrid1.OptionsRx - [rdgColSpanning];
end; 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. end.

View File

@ -179,7 +179,9 @@ msgid "Error symbol in expression: '%s'"
msgstr "Error simbolo en expresión: '%s'" msgstr "Error simbolo en expresión: '%s'"
#: rxdconst.sexprnameerror #: rxdconst.sexprnameerror
msgid "Error in filed name" #, fuzzy
#| msgid "Error in filed name\" "
msgid "Error in filed name"
msgstr "Error en nombre del fichero" msgstr "Error en nombre del fichero"
#: rxdconst.sexprnorparen #: rxdconst.sexprnorparen

View File

@ -74,8 +74,8 @@ type
var Processed: boolean) of object; var Processed: boolean) of object;
TRxDBGridCalcRowHeight = procedure(Sender: TRxDBGrid; var ARowHegth:integer) of object; TRxDBGridCalcRowHeight = procedure(Sender: TRxDBGrid; var ARowHegth:integer) of object;
TRxDBGridMergeCellsEvent = procedure (Sender: TObject; ACol{, ARow}: Integer; Column: TRxColumn; TRxDBGridMergeCellsEvent = procedure (Sender: TObject; ACol : Integer;
var ALeft, {ATop,} ARight{, ABottom}: Integer) of object; var ALeft, ARight : Integer; var ADisplayColumn: TRxColumn) of object;
//Freeman35 added //Freeman35 added
TOnRxCalcFooterValues = procedure(Sender: TObject; Column: TRxColumn; var AValue : Variant) of object; TOnRxCalcFooterValues = procedure(Sender: TObject; Column: TRxColumn; var AValue : Variant) of object;
@ -918,8 +918,8 @@ type
procedure CheckNewCachedSizes(var AGCache:TGridDataCache); override; procedure CheckNewCachedSizes(var AGCache:TGridDataCache); override;
procedure CalcCellExtent(ACol, ARow: Integer; var ARect: TRect); procedure CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
function IsMerged(ACol{, ARow}: Integer): Boolean; overload; function IsMerged(ACol : Integer): Boolean; overload;
function IsMerged(ACol{, ARow}: Integer; out ALeft, {ATop, }ARight{, ABottom}: Integer): Boolean; overload; function IsMerged(ACol : Integer; out ALeft, ARight: Integer; out AColumn: TRxColumn): Boolean; overload;
function GetEditMask(aCol, aRow: Longint): string; override; function GetEditMask(aCol, aRow: Longint): string; override;
function GetEditText(aCol, aRow: Longint): string; override; function GetEditText(aCol, aRow: Longint): string; override;
@ -1138,6 +1138,8 @@ type
procedure RegisterRxDBGridSortEngine(RxDBGridSortEngineClass: TRxDBGridSortEngineClass; procedure RegisterRxDBGridSortEngine(RxDBGridSortEngineClass: TRxDBGridSortEngineClass;
DataSetClassName: string); DataSetClassName: string);
procedure WriteTextHeader(ACanvas: TCanvas; ARect: TRect; const Text: string; Alignment: TAlignment);
implementation implementation
uses Math, rxdconst, rxstrutils, rxutils, strutils, rxdbgrid_findunit, uses Math, rxdconst, rxstrutils, rxutils, strutils, rxdbgrid_findunit,
@ -2940,13 +2942,36 @@ const
DT_RIGHT or {DT_EXPANDTABS or }DT_NOPREFIX, DT_RIGHT or {DT_EXPANDTABS or }DT_NOPREFIX,
DT_CENTER or {DT_EXPANDTABS or }DT_NOPREFIX); DT_CENTER or {DT_EXPANDTABS or }DT_NOPREFIX);
procedure WriteTextHeader(ACanvas: TCanvas; ARect: TRect; const Text: string; procedure WriteTextHeader(ACanvas: TCanvas; ARect: TRect; const Text: string; Alignment: TAlignment);
Alignment: TAlignment);
var var
DrawRect: TRect; DrawRect: TRect;
W, CnvW: integer; W, CnvW: integer;
begin begin
DrawRect := Rect(ARect.Left + 1, ARect.Top + 1, ARect.Right, ARect.Bottom); (*
dec(ARect.Right, constCellPadding);
case Canvas.TextStyle.Alignment of
Classes.taLeftJustify: Inc(ARect.Left, constCellPadding);
Classes.taRightJustify: Dec(ARect.Right, 1);
end;
case Canvas.TextStyle.Layout of
tlTop: Inc(ARect.Top, constCellPadding);
tlBottom: Dec(ARect.Bottom, constCellPadding);
end;
if ARect.Right<ARect.Left then
ARect.Right:=ARect.Left;
if ARect.Left>ARect.Right then
ARect.Left:=ARect.Right;
if ARect.Bottom<ARect.Top then
ARect.Bottom:=ARect.Top;
if ARect.Top>ARect.Bottom then
ARect.Top:=ARect.Bottom;
if (ARect.Left<>ARect.Right) and (ARect.Top<>ARect.Bottom) then
*)
DrawRect := Rect(ARect.Left + constCellPadding, ARect.Top + constCellPadding, ARect.Right - constCellPadding, ARect.Bottom - constCellPadding);
CnvW := Max(DrawRect.Right - DrawRect.Left, 1); CnvW := Max(DrawRect.Right - DrawRect.Left, 1);
W := (ACanvas.TextWidth(Text) div CnvW) + 1; W := (ACanvas.TextWidth(Text) div CnvW) + 1;
@ -4322,27 +4347,36 @@ var
F: TField; F: TField;
C: TRxColumn; C: TRxColumn;
j, DataCol, L, R: integer; j, DataCol, L, R: integer;
TS, TS1: TTextStyle; FIsMerged: Boolean;
begin begin
FIsMerged:=false;
C:=nil;
F:=nil;
if rdgColSpanning in OptionsRx then
if IsMerged(aCol, L, R, C) then
begin
aCol:=L;
FIsMerged:=true;
end;
if Assigned(OnDrawColumnCell) and not (CsDesigning in ComponentState) then if Assigned(OnDrawColumnCell) and not (CsDesigning in ComponentState) then
begin begin
DataCol := ColumnIndexFromGridColumn(aCol); DataCol := ColumnIndexFromGridColumn(aCol);
OnDrawColumnCell(Self, aRect, DataCol, TColumn(ColumnFromGridColumn(aCol)), aState) if not Assigned(C) then
C:=TRxColumn(ColumnFromGridColumn(aCol));
OnDrawColumnCell(Self, aRect, DataCol, C, aState)
end end
else else
begin 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 not Assigned(C) then
C := ColumnFromGridColumn(aCol) as TRxColumn;
if Assigned(C) then
F:=C.Field;
if Assigned(C) and Assigned(C.FOnDrawColumnCell) then if Assigned(C) and Assigned(C.FOnDrawColumnCell) then
C.OnDrawColumnCell(Self, aRect, aCol, TColumn(ColumnFromGridColumn(aCol)), aState) C.OnDrawColumnCell(Self, aRect, aCol, TColumn(ColumnFromGridColumn(aCol)), aState)
else else
@ -4368,15 +4402,12 @@ begin
else else
S := ''; S := '';
// S:='11'; if ((rdgWordWrap in FOptionsRx) and Assigned(C) and (C.WordWrap)) or (FIsMerged) then
if (rdgWordWrap in FOptionsRx) and Assigned(C) and (C.WordWrap) then
WriteTextHeader(Canvas, aRect, S, C.Alignment) WriteTextHeader(Canvas, aRect, S, C.Alignment)
else else
DrawCellText(aCol, aRow, aRect, aState, S); DrawCellText(aCol, aRow, aRect, aState, S);
end; end;
end; end;
Canvas.TextStyle:=TS;
end; end;
end; end;
@ -4558,6 +4589,9 @@ end;
procedure TRxDBGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); procedure TRxDBGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect);
begin begin
CalcCellExtent(acol, arow, aRect);
CalcCellExtent(ACol, ARow, ARect);
if FGroupItems.Active and Assigned(FGroupItemDrawCur) then if FGroupItems.Active and Assigned(FGroupItemDrawCur) then
ARect.Bottom:=ARect.Bottom - DefaultRowHeight; ARect.Bottom:=ARect.Bottom - DefaultRowHeight;
inherited DrawFocusRect(aCol, aRow, ARect); inherited DrawFocusRect(aCol, aRow, ARect);
@ -5181,10 +5215,12 @@ var
S: string; S: string;
begin begin
if (rdgColSpanning in OptionsRx) then if (rdgColSpanning in OptionsRx) then
if IsMerged(aCol, L, R) then if IsMerged(aCol, L, R, C) then
aCol:=L; aCol:=L;
C := ColumnFromGridColumn(aCol) as TRxColumn; if not Assigned(C) then
C := ColumnFromGridColumn(aCol) as TRxColumn;
S := Value; S := Value;
if Assigned(C) and (C.KeyList.Count > 0) and (C.PickList.Count > 0) then if Assigned(C) and (C.KeyList.Count > 0) and (C.PickList.Count > 0) then
begin begin
@ -6259,83 +6295,100 @@ end;
procedure TRxDBGrid.CalcCellExtent(ACol, ARow: Integer; var ARect: TRect); procedure TRxDBGrid.CalcCellExtent(ACol, ARow: Integer; var ARect: TRect);
var var
L, T, R, B: Integer; L, T, R, B: Integer;
C: TRxColumn;
begin begin
if IsMerged(ACol, {ARow, }L{, T}, R{, B}) then if IsMerged(ACol, L, R, C) then
begin begin
ARect.TopLeft := CellRect(L, ARow).TopLeft; ARect.TopLeft := CellRect(L, ARow).TopLeft;
ARect.BottomRight := CellRect(R, ARow).BottomRight; ARect.BottomRight := CellRect(R, ARow).BottomRight;
{ ARect.Left := CellRect(L, ARow).Left;
ARect.Right := CellRect(R, ARow).Right;}
end; end;
end; end;
function TRxDBGrid.IsMerged(ACol{, ARow}: Integer): Boolean; function TRxDBGrid.IsMerged(ACol: Integer): Boolean;
var var
L, T, R, B: Integer; L, R: Integer;
C: TRxColumn;
begin begin
Result := IsMerged(ACol, {ARow,} L, {T,} R{, B}); Result := IsMerged(ACol, L, R, C);
end; end;
function TRxDBGrid.IsMerged(ACol{, ARow}: Integer; out ALeft{, ATop}, ARight{, function TRxDBGrid.IsMerged(ACol: Integer; out ALeft, ARight: Integer; out
ABottom}: Integer): Boolean; AColumn: TRxColumn): Boolean;
var
FColumn: TRxColumn;
begin begin
Result := false; Result := false;
if not (rdgColSpanning in OptionsRx) then exit; AColumn:=nil;
if not Assigned(FOnMergeCells) then exit;
inc(FMergeLock);
ALeft := ACol; ALeft := ACol;
ARight := ACol; ARight := ACol;
FColumn:=TRxColumn(ColumnFromGridColumn(ACol)); if (rdgColSpanning in OptionsRx) and Assigned(FOnMergeCells) then
begin
FOnMergeCells(Self, ACol, {ARow,} FColumn, ALeft, {ATop, }ARight{, ABottom}); inc(FMergeLock);
if ALeft > ARight then FOnMergeCells(Self, ACol, ALeft, ARight, AColumn);
SwapValues(ALeft, ARight); if ALeft > ARight then
SwapValues(ALeft, ARight);
Result := (ALeft <> ARight) {or (ATop <> ABottom)}; Result := (ALeft <> ARight);
dec(FMergeLock); dec(FMergeLock);
end;
end; end;
function TRxDBGrid.GetEditMask(aCol, aRow: Longint): string; function TRxDBGrid.GetEditMask(aCol, aRow: Longint): string;
var var
L, R: Integer; L, R: Integer;
C: TRxColumn;
begin begin
if (rdgColSpanning in OptionsRx) then if (rdgColSpanning in OptionsRx) then
if IsMerged(aCol, L, R) then if IsMerged(aCol, L, R, C) then
aCol:=L; begin
if Assigned(C) then
aCol:=C.Index
else
aCol:=L;
end;
Result:=inherited GetEditMask(aCol, aRow); Result:=inherited GetEditMask(aCol, aRow);
end; end;
function TRxDBGrid.GetEditText(aCol, aRow: Longint): string; function TRxDBGrid.GetEditText(aCol, aRow: Longint): string;
var var
R, L: Integer; R, L: Integer;
C: TRxColumn;
begin begin
if (rdgColSpanning in OptionsRx) then if (rdgColSpanning in OptionsRx) then
if IsMerged(aCol, L, R) then if IsMerged(aCol, L, R, C) then
aCol:=L; begin
if Assigned(C) then
aCol:=C.Index
else
aCol:=L;
end;
Result:=inherited GetEditText(aCol, aRow); Result:=inherited GetEditText(aCol, aRow);
end; end;
function TRxDBGrid.GetDefaultEditor(Column: Integer): TWinControl; function TRxDBGrid.GetDefaultEditor(Column: Integer): TWinControl;
var var
L, R: Integer; L, R: Integer;
C: TRxColumn;
begin begin
if (rdgColSpanning in OptionsRx) then if (rdgColSpanning in OptionsRx) then
if IsMerged(Column, L, R) then if IsMerged(Column, L, R, C) then
Column:=L; begin
if Assigned(C) then
Column:=C.Index
else
Column:=L;
end;
Result:=inherited GetDefaultEditor(Column); Result:=inherited GetDefaultEditor(Column);
end; end;
procedure TRxDBGrid.PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); procedure TRxDBGrid.PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState);
var var
L, R, RR: Integer; L, R, RR: Integer;
C: TRxColumn;
begin begin
if (rdgColSpanning in OptionsRx) then if (rdgColSpanning in OptionsRx) then
if ((Row - FixedRows) = Datalink.ActiveRecord) and IsMerged(ACol, L, R) and (aCol >= L) and (aCol <= R) then if not ((gdFixed in aState) and (aRow = 0)) then
AState := AState + [gdSelected, gdFocused]; if ((Row - FixedRows) = Datalink.ActiveRecord) and IsMerged(ACol, L, R, C) then
if (aCol >= L) and (aCol <= R) then
AState := AState + [gdSelected, gdFocused];
inherited PrepareCanvas(aCol, aRow, AState); inherited PrepareCanvas(aCol, aRow, AState);
end; end;