RxFPC: work on RxDBVerticalGrid

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6007 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2017-08-23 12:37:42 +00:00
parent c5008e534b
commit 0c2657a4d7
4 changed files with 418 additions and 198 deletions

View File

@ -3,7 +3,7 @@
<ProjectSession> <ProjectSession>
<Version Value="10"/> <Version Value="10"/>
<BuildModes Active="Default"/> <BuildModes Active="Default"/>
<Units Count="54"> <Units Count="59">
<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="26"/> <UsageCount Value="31"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="unit1.pas"/> <Filename Value="unit1.pas"/>
@ -21,9 +21,9 @@
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/> <UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/> <IsVisibleTab Value="True"/>
<TopLine Value="49"/> <TopLine Value="61"/>
<CursorPos X="12" Y="70"/> <CursorPos X="20" Y="79"/>
<UsageCount Value="26"/> <UsageCount Value="31"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<LoadedDesigner Value="True"/> <LoadedDesigner Value="True"/>
</Unit1> </Unit1>
@ -36,38 +36,34 @@
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="../../rxdb/rxdbgrid.pas"/> <Filename Value="../../rxdb/rxdbgrid.pas"/>
<EditorIndex Value="2"/> <EditorIndex Value="-1"/>
<TopLine Value="6568"/> <TopLine Value="948"/>
<CursorPos Y="6593"/> <CursorPos Y="979"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="../../../../lcl/grids.pas"/> <Filename Value="../../../../lcl/grids.pas"/>
<UnitName Value="Grids"/> <UnitName Value="Grids"/>
<EditorIndex Value="6"/> <EditorIndex Value="-1"/>
<TopLine Value="3746"/> <TopLine Value="4489"/>
<CursorPos X="12" Y="3762"/> <CursorPos Y="4493"/>
<UsageCount Value="12"/> <UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="../../../../lcl/dbgrids.pas"/> <Filename Value="../../../../lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/> <UnitName Value="DBGrids"/>
<EditorIndex Value="3"/> <EditorIndex Value="-1"/>
<TopLine Value="3867"/> <TopLine Value="3172"/>
<CursorPos Y="3886"/> <CursorPos X="3" Y="3172"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="../../../../lcl/controls.pp"/> <Filename Value="../../../../lcl/controls.pp"/>
<UnitName Value="Controls"/> <UnitName Value="Controls"/>
<EditorIndex Value="5"/> <EditorIndex Value="-1"/>
<TopLine Value="1668"/> <TopLine Value="1668"/>
<CursorPos X="14" Y="1686"/> <CursorPos X="14" Y="1686"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="../../../../lcl/graphics.pp"/> <Filename Value="../../../../lcl/graphics.pp"/>
@ -178,14 +174,13 @@
</Unit21> </Unit21>
<Unit22> <Unit22>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/> <Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<EditorIndex Value="4"/> <EditorIndex Value="-1"/>
<TopLine Value="1065"/> <TopLine Value="1180"/>
<CursorPos X="3" Y="1088"/> <CursorPos X="39" Y="1213"/>
<UsageCount Value="13"/> <UsageCount Value="15"/>
<Bookmarks Count="1"> <Bookmarks Count="1">
<Item0 X="38" Y="810" ID="1"/> <Item0 X="38" Y="894" ID="1"/>
</Bookmarks> </Bookmarks>
<Loaded Value="True"/>
</Unit22> </Unit22>
<Unit23> <Unit23>
<Filename Value="../../rx.inc"/> <Filename Value="../../rx.inc"/>
@ -287,9 +282,9 @@
<Unit37> <Unit37>
<Filename Value="../../rxdb/rxdbutils.pas"/> <Filename Value="../../rxdb/rxdbutils.pas"/>
<EditorIndex Value="-1"/> <EditorIndex Value="-1"/>
<TopLine Value="147"/> <TopLine Value="27"/>
<CursorPos X="45" Y="166"/> <CursorPos X="50" Y="39"/>
<UsageCount Value="10"/> <UsageCount Value="12"/>
</Unit37> </Unit37>
<Unit38> <Unit38>
<Filename Value="../../rxdb/rxpopupunit.pas"/> <Filename Value="../../rxdb/rxpopupunit.pas"/>
@ -380,9 +375,9 @@
<Unit50> <Unit50>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/> <Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<EditorIndex Value="-1"/> <EditorIndex Value="-1"/>
<TopLine Value="1774"/> <TopLine Value="76"/>
<CursorPos X="15" Y="1794"/> <CursorPos X="5" Y="107"/>
<UsageCount Value="11"/> <UsageCount Value="13"/>
</Unit50> </Unit50>
<Unit51> <Unit51>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/datasource.inc"/> <Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/datasource.inc"/>
@ -400,134 +395,53 @@
</Unit52> </Unit52>
<Unit53> <Unit53>
<Filename Value="/home/install/source/fpcsrc/rtl/objpas/sysutils/dati.inc"/> <Filename Value="/home/install/source/fpcsrc/rtl/objpas/sysutils/dati.inc"/>
<EditorIndex Value="1"/> <EditorIndex Value="-1"/>
<TopLine Value="504"/> <TopLine Value="504"/>
<CursorPos X="18" Y="516"/> <CursorPos X="18" Y="516"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit53> </Unit53>
<Unit54>
<Filename Value="../../../../lcl/stdctrls.pp"/>
<UnitName Value="StdCtrls"/>
<EditorIndex Value="-1"/>
<CursorPos X="14" Y="18"/>
<UsageCount Value="11"/>
</Unit54>
<Unit55>
<Filename Value="../../../../lcl/themes.pas"/>
<UnitName Value="Themes"/>
<EditorIndex Value="-1"/>
<TopLine Value="16"/>
<CursorPos X="12" Y="42"/>
<UsageCount Value="11"/>
</Unit55>
<Unit56>
<Filename Value="../../../../lcl/lcltype.pp"/>
<UnitName Value="LCLType"/>
<EditorIndex Value="-1"/>
<CursorPos X="13" Y="31"/>
<UsageCount Value="11"/>
</Unit56>
<Unit57>
<Filename Value="../../../../lcl/forms.pp"/>
<UnitName Value="Forms"/>
<EditorIndex Value="-1"/>
<TopLine Value="1801"/>
<CursorPos X="3" Y="1820"/>
<UsageCount Value="10"/>
</Unit57>
<Unit58>
<Filename Value="../../rxtools/rxdconst.pas"/>
<EditorIndex Value="-1"/>
<CursorPos X="14" Y="32"/>
<UsageCount Value="10"/>
</Unit58>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="1">
<Position1> <Position1>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/> <Filename Value="unit1.pas"/>
<Caret Line="355" TopLine="333"/> <Caret Line="79" Column="4" TopLine="60"/>
</Position1> </Position1>
<Position2>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="333" TopLine="314"/>
</Position2>
<Position3>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="334" TopLine="314"/>
</Position3>
<Position4>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="825" TopLine="806"/>
</Position4>
<Position5>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="826" TopLine="806"/>
</Position5>
<Position6>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="832" TopLine="806"/>
</Position6>
<Position7>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="221" Column="15" TopLine="202"/>
</Position7>
<Position8>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="60" Column="28" TopLine="39"/>
</Position8>
<Position9>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="380" Column="3" TopLine="378"/>
</Position9>
<Position10>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="264" Column="15" TopLine="246"/>
</Position10>
<Position11>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="1141" Column="14" TopLine="1135"/>
</Position11>
<Position12>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="387" TopLine="368"/>
</Position12>
<Position13>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="384" Column="20" TopLine="368"/>
</Position13>
<Position14>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="260" Column="15" TopLine="245"/>
</Position14>
<Position15>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="1054" Column="3" TopLine="1050"/>
</Position15>
<Position16>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="259" Column="15" TopLine="241"/>
</Position16>
<Position17>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="1042" Column="18" TopLine="1018"/>
</Position17>
<Position18>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="261" Column="15" TopLine="240"/>
</Position18>
<Position19>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="1070" Column="3" TopLine="1065"/>
</Position19>
<Position20>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="1098" Column="15" TopLine="1079"/>
</Position20>
<Position21>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="3809" TopLine="3784"/>
</Position21>
<Position22>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="3782" Column="19" TopLine="3764"/>
</Position22>
<Position23>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="3810" Column="21" TopLine="3777"/>
</Position23>
<Position24>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="3816" Column="21" TopLine="3781"/>
</Position24>
<Position25>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="1078" Column="7" TopLine="1065"/>
</Position25>
<Position26>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="1081" Column="80" TopLine="1065"/>
</Position26>
<Position27>
<Filename Value="../../../../lcl/grids.pas"/>
<Caret Line="3821" TopLine="3781"/>
</Position27>
<Position28>
<Filename Value="unit1.pas"/>
<Caret Line="70" Column="12" TopLine="49"/>
</Position28>
<Position29>
<Filename Value="unit1.pas"/>
<Caret Line="69" Column="12" TopLine="48"/>
</Position29>
<Position30>
<Filename Value="unit1.pas"/>
<Caret Line="70" Column="12" TopLine="49"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectSession> </ProjectSession>
<Debugging> <Debugging>

View File

@ -10,8 +10,8 @@ object Form1: TForm1
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object RxDBVerticalGrid1: TRxDBVerticalGrid object RxDBVerticalGrid1: TRxDBVerticalGrid
Left = 440 Left = 440
Height = 304 Height = 336
Top = 360 Top = 328
Width = 728 Width = 728
Color = clWindow Color = clWindow
DataCoumn.Title.Alignment = taCenter DataCoumn.Title.Alignment = taCenter
@ -26,6 +26,14 @@ object Form1: TForm1
LabelCoumn.Width = 120 LabelCoumn.Width = 120
Options = [rxvgColumnTitle] Options = [rxvgColumnTitle]
Rows = < Rows = <
item
Alignment = taCenter
FieldName = 'VIP'
RowTitle.Caption = 'VIP-клиент'
WordWrap = False
RowHeight = 27
ReadOnly = False
end
item item
FieldName = 'tb_client_inn' FieldName = 'tb_client_inn'
RowTitle.Caption = 'ИНН' RowTitle.Caption = 'ИНН'
@ -50,17 +58,9 @@ object Form1: TForm1
ReadOnly = False ReadOnly = False
PopupMenu = PopupMenu2 PopupMenu = PopupMenu2
end end
item
FieldName = 'create_user_date'
RowTitle.Caption = 'Дата создания'
Color = clWhite
WordWrap = False
RowHeight = 27
ReadOnly = False
end
item item
Alignment = taCenter Alignment = taCenter
FieldName = 'tb_client_ogrn' FieldName = 'TB_CLIENT_EMAIL'
RowTitle.Caption = 'ОГРН' RowTitle.Caption = 'ОГРН'
WordWrap = False WordWrap = False
RowHeight = 27 RowHeight = 27
@ -68,10 +68,10 @@ object Form1: TForm1
PopupMenu = PopupMenu3 PopupMenu = PopupMenu3
end end
item item
FieldName = 'create_user_name' FieldName = 'TB_CLIENT_EMAIL'
RowTitle.Caption = 'Описание' RowTitle.Caption = 'E-Mail'
WordWrap = False WordWrap = False
RowHeight = 50 RowHeight = 27
ReadOnly = False ReadOnly = False
end end
item item
@ -81,22 +81,48 @@ object Form1: TForm1
WordWrap = False WordWrap = False
RowHeight = 27 RowHeight = 27
ReadOnly = False ReadOnly = False
end
item
FieldName = 'CREATE_USER_NAME'
RowTitle.Caption = 'Автор'
WordWrap = False
RowHeight = 27
ReadOnly = False
end
item
FieldName = 'create_user_date'
RowTitle.Caption = 'Дата создания'
Color = clWhite
WordWrap = False
RowHeight = 27
ReadOnly = False
end
item
FieldName = 'TB_CLEINT_TYPE'
RowTitle.Caption = 'Тип клиента'
KeyList.Strings = (
'1'
'2'
'3'
'4'
'5'
)
PickList.Strings = (
'Группа "А"'
'Группа "Б"'
'Группа "В"'
'Группа "Г"'
)
WordWrap = False
RowHeight = 27
ReadOnly = False
end> end>
RowHeights = ( TitleStyle = tsNative
27
27
27
27
27
27
50
27
)
end end
object RxDBGrid1: TRxDBGrid object RxDBGrid1: TRxDBGrid
Left = 40 Left = 40
Height = 222 Height = 312
Top = 72 Top = 8
Width = 1080 Width = 1080
ColumnDefValues.BlobText = '(данные)' ColumnDefValues.BlobText = '(данные)'
TitleButtons = False TitleButtons = False
@ -128,6 +154,19 @@ object Form1: TForm1
Filter.ItemIndex = -1 Filter.ItemIndex = -1
Footers = <> Footers = <>
end end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'VIP'
FieldName = 'VIP'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Пусто)'
Filter.AllValue = '(Все значения)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item item
Title.Alignment = taCenter Title.Alignment = taCenter
Title.Orientation = toHorizontal Title.Orientation = toHorizontal
@ -383,6 +422,10 @@ object Form1: TForm1
Precision = -1 Precision = -1
Size = 50 Size = 50
end end
item
Name = 'VIP'
DataType = ftBoolean
end
item item
Name = 'CREATE_USER_NAME' Name = 'CREATE_USER_NAME'
DataType = ftString DataType = ftString
@ -393,6 +436,10 @@ object Form1: TForm1
Name = 'CREATE_USER_DATE' Name = 'CREATE_USER_DATE'
DataType = ftDateTime DataType = ftDateTime
Precision = -1 Precision = -1
end
item
Name = 'TB_CLEINT_TYPE'
DataType = ftInteger
end> end>
PacketRecords = 0 PacketRecords = 0
Left = 176 Left = 176
@ -454,10 +501,20 @@ object Form1: TForm1
Required = False Required = False
Size = 50 Size = 50
end end
object rxDataVIP: TBooleanField
FieldKind = fkData
FieldName = 'VIP'
Index = 6
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
DisplayValues = 'True;False'
end
object rxDataCREATE_USER_NAME: TStringField object rxDataCREATE_USER_NAME: TStringField
FieldKind = fkData FieldKind = fkData
FieldName = 'CREATE_USER_NAME' FieldName = 'CREATE_USER_NAME'
Index = 6 Index = 7
LookupCache = False LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere] ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False ReadOnly = False
@ -467,7 +524,16 @@ object Form1: TForm1
object rxDataCREATE_USER_DATE: TDateTimeField object rxDataCREATE_USER_DATE: TDateTimeField
FieldKind = fkData FieldKind = fkData
FieldName = 'CREATE_USER_DATE' FieldName = 'CREATE_USER_DATE'
Index = 7 Index = 8
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object rxDataTB_CLEINT_TYPE: TLongintField
FieldKind = fkData
FieldName = 'TB_CLEINT_TYPE'
Index = 9
LookupCache = False LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere] ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False ReadOnly = False

View File

@ -35,11 +35,13 @@ type
rxDataCREATE_USER_DATE: TDateTimeField; rxDataCREATE_USER_DATE: TDateTimeField;
rxDataCREATE_USER_NAME: TStringField; rxDataCREATE_USER_NAME: TStringField;
rxDataTB_CLEINT_CODE: TLongintField; rxDataTB_CLEINT_CODE: TLongintField;
rxDataTB_CLEINT_TYPE: TLongintField;
rxDataTB_CLIENT_EMAIL: TStringField; rxDataTB_CLIENT_EMAIL: TStringField;
rxDataTB_CLIENT_ID: TLongintField; rxDataTB_CLIENT_ID: TLongintField;
rxDataTB_CLIENT_INN: TStringField; rxDataTB_CLIENT_INN: TStringField;
rxDataTB_CLIENT_NAME: TStringField; rxDataTB_CLIENT_NAME: TStringField;
rxDataTB_CLIENT_PHONE: TStringField; rxDataTB_CLIENT_PHONE: TStringField;
rxDataVIP: TBooleanField;
RxDBGrid1: TRxDBGrid; RxDBGrid1: TRxDBGrid;
RxDBVerticalGrid1: TRxDBVerticalGrid; RxDBVerticalGrid1: TRxDBVerticalGrid;
rxData: TRxMemoryData; rxData: TRxMemoryData;
@ -81,16 +83,17 @@ end;
procedure TForm1.FillDataBase; procedure TForm1.FillDataBase;
begin begin
rxData.Open; rxData.Open;
rxData.AppendRecord([1, 1, '01000100101', 'JSC "BOOT"', 'test@email.com', '5(555)-557-88-77', 'alexs', now]); rxData.AppendRecord([1, 1, '01000100101', 'JSC "BOOT"', 'test1@email.com', '5(555)-557-88-77', true, 'alexs', now, 1]);
rxData.AppendRecord([2, 2, '02000100101', 'Wikimedia Foundation, Inc.', 'test@email.com', '5(555)-557-88-77', '1', now]); rxData.AppendRecord([2, 2, '02000100101', 'Wikimedia Foundation, Inc.', 'test2@email.com', '5(555)-557-88-77', false, 'boss', now, 2]);
rxData.AppendRecord([3, 3, '03000100101', 'LLC Pilot ', 'test@email.com', '5(555)-557-88-77', '2', now]); rxData.AppendRecord([3, 3, '03000100101', 'LLC Pilot ', 'test3@email.com', '5(555)-557-88-77', true, 'master', now, 3]);
rxData.AppendRecord([4, 4, '04000100101', 'Pilot, OOO', 'test@email.com', '5(555)-557-88-77', '3', now]); rxData.AppendRecord([4, 4, '04000100101', 'Pilot, OOO', 'test4@email.com', '5(555)-557-88-77', true, 'onegin', now, 1]);
rxData.AppendRecord([5, 5, '05000100101', 'JSC "MS"', 'test@email.com', '5(555)-557-88-77', '4', now]); rxData.AppendRecord([5, 5, '05000100101', 'JSC "MS"', 'test5@email.com', '5(555)-557-88-77', true, 'alfred', now, 1]);
rxData.AppendRecord([6, 11, '06000100101', 'JSC "AA"', 'test@email.com', '5(555)-557-88-77', '5', now]); rxData.AppendRecord([6, 11, '06000100101', 'JSC "AA"', 'test6@email.com', '5(555)-557-88-77', true, 'anna', now, 1]);
rxData.AppendRecord([7, 12, '07000100101', 'JSC "BBBB"', 'test@email.com', '5(555)-557-88-77', '6', now]); rxData.AppendRecord([7, 12, '07000100101', 'JSC "BBBB"', 'test7@email.com', '5(555)-557-88-77', true, 'tux', now, 1]);
rxData.AppendRecord([8, 13, '08000100101', 'JSC "CCCC"', 'test@email.com', '5(555)-557-88-77', '7', now]); rxData.AppendRecord([8, 13, '08000100101', 'JSC "CCCC"', 'test8@email.com', '5(555)-557-88-77', true, 'x-man', now, 4]);
rxData.AppendRecord([9, 14, '09000100101', 'JSC "DDD"', 'test@email.com', '5(555)-557-88-77', '8', now]); rxData.AppendRecord([9, 14, '09000100101', 'JSC "DDD"', 'test9@email.com', '5(555)-557-88-77', true, 'arny', now, 1]);
rxData.AppendRecord([10, 15, '101000200101', 'JSC "EEEE"', 'test@email.com', '5(555)-557-88-77', '9', now]); rxData.AppendRecord([10, 15, '101000200101', 'JSC "EEEE"', 'test10@email.com', '5(555)-557-88-77', true, 'andy', now, 1]);
rxData.First;
end; end;
end. end.

View File

@ -36,7 +36,7 @@ unit rxdbverticalgrid;
interface interface
uses uses
Classes, SysUtils, Grids, Graphics, Controls, DB, Menus; Classes, SysUtils, Types, Grids, Graphics, Controls, DB, Menus;
type type
TRxDBVerticalGridOption = (rxvgColumnTitle); TRxDBVerticalGridOption = (rxvgColumnTitle);
@ -64,6 +64,21 @@ type
procedure UpdateData; override; procedure UpdateData; override;
end; end;
{ TRxDBVerticalGridDefValues }
TRxDBVerticalGridDefValues = class(TPersistent)
private
FBlobText: string;
FOwner: TRxCustomDBVerticalGrid;
protected
procedure AssignTo(Dest: TPersistent); override;
public
constructor Create(AOwner: TRxCustomDBVerticalGrid);
destructor Destroy; override;
published
property BlobText:string read FBlobText write FBlobText;
end;
{ TRxDBVerticalGridRowTitle } { TRxDBVerticalGridRowTitle }
TRxDBVerticalGridRowTitle = class(TPersistent) TRxDBVerticalGridRowTitle = class(TPersistent)
@ -118,6 +133,8 @@ type
FAlignment: ^TAlignment; FAlignment: ^TAlignment;
FPopupMenu: TPopupMenu; FPopupMenu: TPopupMenu;
FRowHeight: PInteger; FRowHeight: PInteger;
FValueChecked: PChar;
FValueUnchecked: PChar;
FFieldName: String; FFieldName: String;
FDisplayFormat : String; FDisplayFormat : String;
@ -145,10 +162,14 @@ type
function GetKeyList: TStrings; function GetKeyList: TStrings;
function GetPickList: TStrings; function GetPickList: TStrings;
function GetRowHeight: Integer; function GetRowHeight: Integer;
function GetValueChecked: string;
function GetValueUnchecked: string;
function IsAlignmentStored: Boolean; function IsAlignmentStored: Boolean;
function IsColorStored: Boolean; function IsColorStored: Boolean;
function IsDisplayFormatStored: Boolean; function IsDisplayFormatStored: Boolean;
function IsFontStored: Boolean; function IsFontStored: Boolean;
function IsValueCheckedStored: Boolean;
function IsValueUncheckedStored: Boolean;
procedure SetAlignment(AValue: TAlignment); procedure SetAlignment(AValue: TAlignment);
procedure SetButtonStyle(AValue: TColumnButtonStyle); procedure SetButtonStyle(AValue: TColumnButtonStyle);
procedure SetColor(AValue: TColor); procedure SetColor(AValue: TColor);
@ -170,8 +191,12 @@ type
procedure KeyListChanged(Sender: TObject); procedure KeyListChanged(Sender: TObject);
procedure SetStaticText(AValue: string); procedure SetStaticText(AValue: string);
procedure SetStyle(AValue: TRxDBVerticalGridRowStyle); procedure SetStyle(AValue: TRxDBVerticalGridRowStyle);
procedure SetValueChecked(AValue: string);
procedure SetValueUnchecked(AValue: string);
procedure SetWordWrap(AValue: Boolean); procedure SetWordWrap(AValue: Boolean);
protected protected
function GetDefaultValueChecked: string; virtual;
function GetDefaultValueUnchecked: string; virtual;
function GetDisplayName: string; override; function GetDisplayName: string; override;
function GetDefaultAlignment : TAlignment; virtual; function GetDefaultAlignment : TAlignment; virtual;
function GetDefaultRowHeight : integer; function GetDefaultRowHeight : integer;
@ -179,6 +204,7 @@ type
function GetDefaultDisplayFormat: string; function GetDefaultDisplayFormat: string;
property IsDefaultFont: boolean read FIsDefaultFont; property IsDefaultFont: boolean read FIsDefaultFont;
function GetDefaultColor: TColor; virtual; function GetDefaultColor: TColor; virtual;
function EditorStyle:TColumnButtonStyle;
//property GroupName:string read FGroupName write SetGroupName; //property GroupName:string read FGroupName write SetGroupName;
public public
constructor Create(ACollection: TCollection); override; constructor Create(ACollection: TCollection); override;
@ -206,6 +232,8 @@ type
property RowHeight : Integer read GetRowHeight write SetRowHeight; property RowHeight : Integer read GetRowHeight write SetRowHeight;
property ReadOnly : Boolean read FReadOnly write SetReadOnly; property ReadOnly : Boolean read FReadOnly write SetReadOnly;
property PopupMenu : TPopupMenu read FPopupMenu write SetPopupMenu; property PopupMenu : TPopupMenu read FPopupMenu write SetPopupMenu;
property ValueChecked: string read GetValueChecked write SetValueChecked stored IsValueCheckedStored;
property ValueUnchecked: string read GetValueUnchecked write SetValueUnchecked stored IsValueUncheckedStored;
end; end;
{ TRxDBVerticalGridRows } { TRxDBVerticalGridRows }
@ -241,6 +269,7 @@ type
TRxCustomDBVerticalGrid = class(TCustomGrid) TRxCustomDBVerticalGrid = class(TCustomGrid)
private private
FDataLink: TRxDBVerticalGridDataLink; FDataLink: TRxDBVerticalGridDataLink;
FGridDefValues: TRxDBVerticalGridDefValues;
FOptions: TRxDBVerticalGridOptions; FOptions: TRxDBVerticalGridOptions;
FReadOnly: Boolean; FReadOnly: Boolean;
FRows: TRxDBVerticalGridRows; FRows: TRxDBVerticalGridRows;
@ -250,6 +279,7 @@ type
function GetLabelCoumn: TGridColumn; function GetLabelCoumn: TGridColumn;
procedure SetDataCoumn(AValue: TGridColumn); procedure SetDataCoumn(AValue: TGridColumn);
procedure SetDataSource(AValue: TDataSource); procedure SetDataSource(AValue: TDataSource);
procedure SetGridDefValues(AValue: TRxDBVerticalGridDefValues);
procedure SetLabelCoumn(AValue: TGridColumn); procedure SetLabelCoumn(AValue: TGridColumn);
procedure SetOptions(AValue: TRxDBVerticalGridOptions); procedure SetOptions(AValue: TRxDBVerticalGridOptions);
procedure SetRows(AValue: TRxDBVerticalGridRows); procedure SetRows(AValue: TRxDBVerticalGridRows);
@ -258,6 +288,8 @@ type
protected protected
procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); override; procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); override;
procedure DrawDataCell(aCol, aRow:Integer; aRect:TRect; aState:TGridDrawState; AGridRow: TRxDBVerticalGridRow); procedure DrawDataCell(aCol, aRow:Integer; aRect:TRect; aState:TGridDrawState; AGridRow: TRxDBVerticalGridRow);
procedure DrawCheckboxBitmaps(aRect: TRect; AGridRow: TRxDBVerticalGridRow);
procedure PrepareCanvas(aCol, aRow: Integer; aState:TGridDrawState); override; procedure PrepareCanvas(aCol, aRow: Integer; aState:TGridDrawState); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
@ -271,6 +303,7 @@ type
property ReadOnly: Boolean read FReadOnly write FReadOnly default false; property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
property LabelCoumn:TGridColumn read GetLabelCoumn write SetLabelCoumn; property LabelCoumn:TGridColumn read GetLabelCoumn write SetLabelCoumn;
property DataCoumn:TGridColumn read GetDataCoumn write SetDataCoumn; property DataCoumn:TGridColumn read GetDataCoumn write SetDataCoumn;
property GridDefValues:TRxDBVerticalGridDefValues read FGridDefValues write SetGridDefValues;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -289,6 +322,7 @@ type
property BorderStyle; property BorderStyle;
property CellHintPriority; property CellHintPriority;
property Color; property Color;
property GridDefValues;
property DataCoumn; property DataCoumn;
property DataSource; property DataSource;
property DefaultRowHeight; property DefaultRowHeight;
@ -304,7 +338,31 @@ type
end; end;
implementation implementation
uses rxlclutils; uses Forms, rxdconst, LCLType, rxlclutils, StdCtrls, Themes;
{ TRxDBVerticalGridDefValues }
procedure TRxDBVerticalGridDefValues.AssignTo(Dest: TPersistent);
begin
if Dest is TRxDBVerticalGridDefValues then
begin
TRxDBVerticalGridDefValues(Dest).FBlobText:=FBlobText;
end
else
inherited AssignTo(Dest);
end;
constructor TRxDBVerticalGridDefValues.Create(AOwner: TRxCustomDBVerticalGrid);
begin
inherited Create;
FOwner:=AOwner;
FBlobText:=sBlobText;
end;
destructor TRxDBVerticalGridDefValues.Destroy;
begin
inherited Destroy;
end;
{ TRxDBVerticalGridRowsEnumerator } { TRxDBVerticalGridRowsEnumerator }
@ -633,6 +691,22 @@ begin
result := FRowHeight^; result := FRowHeight^;
end; end;
function TRxDBVerticalGridRow.GetValueChecked: string;
begin
if FValueChecked = nil then
Result := GetDefaultValueChecked
else
Result := FValueChecked;
end;
function TRxDBVerticalGridRow.GetValueUnchecked: string;
begin
if FValueUnChecked = nil then
Result := GetDefaultValueUnChecked
else
Result := FValueUnChecked;
end;
function TRxDBVerticalGridRow.IsAlignmentStored: Boolean; function TRxDBVerticalGridRow.IsAlignmentStored: Boolean;
begin begin
result := FAlignment <> nil; result := FAlignment <> nil;
@ -678,6 +752,16 @@ begin
result := not FisDefaultFont; result := not FisDefaultFont;
end; end;
function TRxDBVerticalGridRow.IsValueCheckedStored: Boolean;
begin
result := FValueChecked <> nil;
end;
function TRxDBVerticalGridRow.IsValueUncheckedStored: Boolean;
begin
Result := FValueUnchecked <> nil;
end;
procedure TRxDBVerticalGridRow.SetAlignment(AValue: TAlignment); procedure TRxDBVerticalGridRow.SetAlignment(AValue: TAlignment);
begin begin
if FAlignment = nil then if FAlignment = nil then
@ -869,12 +953,50 @@ begin
RowChanged; RowChanged;
end; end;
procedure TRxDBVerticalGridRow.SetValueChecked(AValue: string);
begin
if (FValueChecked=nil) or (CompareText(AValue, FValueChecked)<>0) then
begin
if FValueChecked<>nil then
StrDispose(FValueChecked)
else
if CompareText(AValue, GetDefaultValueChecked)=0 then
exit;
FValueChecked := StrNew(PChar(AValue));
Changed(False);
end;
end;
procedure TRxDBVerticalGridRow.SetValueUnchecked(AValue: string);
begin
if (FValueUnchecked=nil) or (CompareText(AValue, FValueUnchecked)<>0) then
begin
if FValueUnchecked<>nil then
StrDispose(FValueUnchecked)
else
if CompareText(AValue, GetDefaultValueUnchecked)=0 then
exit;
FValueUnchecked := StrNew(PChar(AValue));
Changed(False);
end;
end;
procedure TRxDBVerticalGridRow.SetWordWrap(AValue: Boolean); procedure TRxDBVerticalGridRow.SetWordWrap(AValue: Boolean);
begin begin
if FWordWrap=AValue then Exit; if FWordWrap=AValue then Exit;
FWordWrap:=AValue; FWordWrap:=AValue;
end; end;
function TRxDBVerticalGridRow.GetDefaultValueChecked: string;
begin
result := '1';
end;
function TRxDBVerticalGridRow.GetDefaultValueUnchecked: string;
begin
result := '0';
end;
function TRxDBVerticalGridRow.GetDisplayName: string; function TRxDBVerticalGridRow.GetDisplayName: string;
begin begin
if RowTitle.Caption<>'' then if RowTitle.Caption<>'' then
@ -926,6 +1048,15 @@ begin
result := clWindow result := clWindow
end; end;
function TRxDBVerticalGridRow.EditorStyle: TColumnButtonStyle;
begin
Result:=FButtonStyle;
if (Result = cbsAuto) then
if Assigned(Field) then
if Field.DataType = ftBoolean then
Result:=cbsCheckboxColumn;
end;
constructor TRxDBVerticalGridRow.Create(ACollection: TCollection); constructor TRxDBVerticalGridRow.Create(ACollection: TCollection);
begin begin
inherited Create(ACollection); inherited Create(ACollection);
@ -952,6 +1083,8 @@ begin
if Assigned(FColor) then Dispose(FColor); if Assigned(FColor) then Dispose(FColor);
if Assigned(FAlignment) then Dispose(FAlignment); if Assigned(FAlignment) then Dispose(FAlignment);
if Assigned(FRowHeight) then Dispose(FRowHeight); if Assigned(FRowHeight) then Dispose(FRowHeight);
if Assigned(FValueChecked) then StrDispose(FValueChecked);
if Assigned(FValueUnchecked) then StrDispose(FValueUnchecked);
inherited Destroy; inherited Destroy;
end; end;
@ -979,6 +1112,7 @@ begin
FButtonStyle:=TRxDBVerticalGridRow(Source).ButtonStyle; FButtonStyle:=TRxDBVerticalGridRow(Source).ButtonStyle;
Alignment:=TRxDBVerticalGridRow(Source).Alignment; Alignment:=TRxDBVerticalGridRow(Source).Alignment;
RowTitle:=TRxDBVerticalGridRow(Source).RowTitle; RowTitle:=TRxDBVerticalGridRow(Source).RowTitle;
Color:=TRxDBVerticalGridRow(Source).Color;
FImageList:=TRxDBVerticalGridRow(Source).FImageList; FImageList:=TRxDBVerticalGridRow(Source).FImageList;
KeyList:=TRxDBVerticalGridRow(Source).KeyList; KeyList:=TRxDBVerticalGridRow(Source).KeyList;
@ -986,8 +1120,10 @@ begin
FWordWrap:=TRxDBVerticalGridRow(Source).WordWrap; FWordWrap:=TRxDBVerticalGridRow(Source).WordWrap;
RowHeight:=TRxDBVerticalGridRow(Source).RowHeight; RowHeight:=TRxDBVerticalGridRow(Source).RowHeight;
ReadOnly:=TRxDBVerticalGridRow(Source).ReadOnly; ReadOnly:=TRxDBVerticalGridRow(Source).ReadOnly;
// PopupMenu:=TRxDBVerticalGridRow(Source).PopupMenu; PopupMenu:=TRxDBVerticalGridRow(Source).PopupMenu;
Style:=TRxDBVerticalGridRow(Source).Style; Style:=TRxDBVerticalGridRow(Source).Style;
Font:=TRxDBVerticalGridRow(Source).Font;
FStaticText:=TRxDBVerticalGridRow(Source).StaticText;
end; end;
end; end;
@ -1050,11 +1186,32 @@ end;
procedure TRxCustomDBVerticalGrid.DrawDataCell(aCol, aRow: Integer; procedure TRxCustomDBVerticalGrid.DrawDataCell(aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState; AGridRow: TRxDBVerticalGridRow); aRect: TRect; aState: TGridDrawState; AGridRow: TRxDBVerticalGridRow);
var
S: String;
J: Integer;
begin begin
if AGridRow.Style = rxvrData then if AGridRow.Style = rxvrData then
begin begin
if AGridRow.EditorStyle = cbsCheckboxColumn then
DrawCheckboxBitmaps(aRect, AGridRow)
else
if Assigned(AGridRow.Field) then if Assigned(AGridRow.Field) then
WriteTextHeader(Canvas, aRect, AGridRow.Field.DisplayText, AGridRow.Alignment); begin
if AGridRow.Field.dataType <> ftBlob then
begin
S := AGridRow.Field.DisplayText;
if (AGridRow.KeyList.Count > 0) and (AGridRow.PickList.Count > 0) then
begin
J := AGridRow.KeyList.IndexOf(S);
if (J >= 0) and (J < AGridRow.PickList.Count) then
S := AGridRow.PickList[j];
end;
end
else
S := GridDefValues.FBlobText;
WriteTextHeader(Canvas, aRect, S, AGridRow.Alignment);
end;
end end
else else
if AGridRow.Style = rxvrStaticText then if AGridRow.Style = rxvrStaticText then
@ -1062,6 +1219,77 @@ begin
WriteTextHeader(Canvas, aRect, AGridRow.StaticText, AGridRow.Alignment); WriteTextHeader(Canvas, aRect, AGridRow.StaticText, AGridRow.Alignment);
end; end;
procedure TRxCustomDBVerticalGrid.DrawCheckboxBitmaps(aRect: TRect;
AGridRow: TRxDBVerticalGridRow);
const
arrtb:array[TCheckboxState] of TThemedButton =
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
var
AState: TCheckboxState;
aCol: Integer;
ChkBitmap: TBitmap;
XPos, YPos: Int64;
Details: TThemedElementDetails;
CSize: TSize;
PaintRect: TRect;
begin
if Assigned(AGridRow.Field) then
begin
if AGridRow.Field.DataType=ftBoolean then
begin
if AGridRow.Field.IsNull then AState := cbGrayed
else
if AGridRow.Field.AsBoolean then AState := cbChecked
else AState := cbUnChecked
end
else
if AGridRow.Field.AsString=AGridRow.ValueChecked then
AState := cbChecked
else
if AGridRow.Field.AsString=AGridRow.ValueUnChecked then
AState := cbUnChecked
else
AState := cbGrayed
end
else
AState := cbGrayed;
{
if assigned(OnUserCheckboxState) then
OnUserCheckboxState(Self, TColumn(ColumnFromGridColumn(aCol)), AState);
}
// DrawGridCheckboxBitmaps(1, 1{dummy}, ARect, AState);
if (TitleStyle=tsNative) {and not assigned(OnUserCheckboxBitmap)} then
begin
Details := ThemeServices.GetElementDetails(arrtb[AState]);
CSize := ThemeServices.GetDetailSize(Details);
CSize.cx := MulDiv(CSize.cx, Font.PixelsPerInch, Screen.PixelsPerInch);
CSize.cy := MulDiv(CSize.cy, Font.PixelsPerInch, Screen.PixelsPerInch);
case AGridRow.Alignment of
taCenter: PaintRect.Left := Trunc((aRect.Left + aRect.Right - CSize.cx)/2);
taLeftJustify: PaintRect.Left := ARect.Left + varCellPadding;
taRightJustify: PaintRect.Left := ARect.Right - CSize.Cx - varCellPadding - 1;
end;
PaintRect.Top := Trunc((aRect.Top + aRect.Bottom - CSize.cy)/2);
PaintRect := Bounds(PaintRect.Left, PaintRect.Top, CSize.cx, CSize.cy);
ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect, nil);
end
else
begin
ChkBitmap := GetImageForCheckBox(aCol, Row, AState);
if ChkBitmap<>nil then
begin
case AGridRow.Alignment of
taCenter: XPos := Trunc((aRect.Left+aRect.Right-ChkBitmap.Width)/2);
taLeftJustify: XPos := ARect.Left + varCellPadding;
taRightJustify: XPos := ARect.Right - ChkBitmap.Width - varCellPadding - 1;
end;
YPos := Trunc((aRect.Top+aRect.Bottom-ChkBitmap.Height)/2);
Canvas.Draw(XPos, YPos, ChkBitmap);
end;
end;
end;
procedure TRxCustomDBVerticalGrid.PrepareCanvas(aCol, aRow: Integer; procedure TRxCustomDBVerticalGrid.PrepareCanvas(aCol, aRow: Integer;
aState: TGridDrawState); aState: TGridDrawState);
var var
@ -1210,6 +1438,13 @@ begin
// UpdateActive; // UpdateActive;
end; end;
procedure TRxCustomDBVerticalGrid.SetGridDefValues(
AValue: TRxDBVerticalGridDefValues);
begin
if FGridDefValues=AValue then Exit;
FGridDefValues:=AValue;
end;
procedure TRxCustomDBVerticalGrid.SetLabelCoumn(AValue: TGridColumn); procedure TRxCustomDBVerticalGrid.SetLabelCoumn(AValue: TGridColumn);
begin begin
Columns[0].Assign(AValue); Columns[0].Assign(AValue);
@ -1220,6 +1455,7 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
FDataLink:=TRxDBVerticalGridDataLink.Create(Self); FDataLink:=TRxDBVerticalGridDataLink.Create(Self);
FRows:=TRxDBVerticalGridRows.Create(Self, TRxDBVerticalGridRow); FRows:=TRxDBVerticalGridRows.Create(Self, TRxDBVerticalGridRow);
FGridDefValues:=TRxDBVerticalGridDefValues.Create(Self);
//ColCount:=2; //ColCount:=2;
FixedCols:=0; FixedCols:=0;
@ -1239,6 +1475,7 @@ destructor TRxCustomDBVerticalGrid.Destroy;
begin begin
FreeAndNil(FRows); FreeAndNil(FRows);
FreeAndNil(FDataLink); FreeAndNil(FDataLink);
FreeAndNil(FGridDefValues);
inherited Destroy; inherited Destroy;
end; end;