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>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="54">
<Units Count="59">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
@ -11,7 +11,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="26"/>
<UsageCount Value="31"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
@ -21,9 +21,9 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="49"/>
<CursorPos X="12" Y="70"/>
<UsageCount Value="26"/>
<TopLine Value="61"/>
<CursorPos X="20" Y="79"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -36,38 +36,34 @@
</Unit2>
<Unit3>
<Filename Value="../../rxdb/rxdbgrid.pas"/>
<EditorIndex Value="2"/>
<TopLine Value="6568"/>
<CursorPos Y="6593"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="948"/>
<CursorPos Y="979"/>
<UsageCount Value="15"/>
</Unit3>
<Unit4>
<Filename Value="../../../../lcl/grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="6"/>
<TopLine Value="3746"/>
<CursorPos X="12" Y="3762"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="4489"/>
<CursorPos Y="4493"/>
<UsageCount Value="14"/>
</Unit4>
<Unit5>
<Filename Value="../../../../lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<EditorIndex Value="3"/>
<TopLine Value="3867"/>
<CursorPos Y="3886"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="3172"/>
<CursorPos X="3" Y="3172"/>
<UsageCount Value="15"/>
</Unit5>
<Unit6>
<Filename Value="../../../../lcl/controls.pp"/>
<UnitName Value="Controls"/>
<EditorIndex Value="5"/>
<EditorIndex Value="-1"/>
<TopLine Value="1668"/>
<CursorPos X="14" Y="1686"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
<UsageCount Value="12"/>
</Unit6>
<Unit7>
<Filename Value="../../../../lcl/graphics.pp"/>
@ -178,14 +174,13 @@
</Unit21>
<Unit22>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<EditorIndex Value="4"/>
<TopLine Value="1065"/>
<CursorPos X="3" Y="1088"/>
<UsageCount Value="13"/>
<EditorIndex Value="-1"/>
<TopLine Value="1180"/>
<CursorPos X="39" Y="1213"/>
<UsageCount Value="15"/>
<Bookmarks Count="1">
<Item0 X="38" Y="810" ID="1"/>
<Item0 X="38" Y="894" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit22>
<Unit23>
<Filename Value="../../rx.inc"/>
@ -287,9 +282,9 @@
<Unit37>
<Filename Value="../../rxdb/rxdbutils.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="147"/>
<CursorPos X="45" Y="166"/>
<UsageCount Value="10"/>
<TopLine Value="27"/>
<CursorPos X="50" Y="39"/>
<UsageCount Value="12"/>
</Unit37>
<Unit38>
<Filename Value="../../rxdb/rxpopupunit.pas"/>
@ -380,9 +375,9 @@
<Unit50>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="1774"/>
<CursorPos X="15" Y="1794"/>
<UsageCount Value="11"/>
<TopLine Value="76"/>
<CursorPos X="5" Y="107"/>
<UsageCount Value="13"/>
</Unit50>
<Unit51>
<Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/datasource.inc"/>
@ -400,134 +395,53 @@
</Unit52>
<Unit53>
<Filename Value="/home/install/source/fpcsrc/rtl/objpas/sysutils/dati.inc"/>
<EditorIndex Value="1"/>
<EditorIndex Value="-1"/>
<TopLine Value="504"/>
<CursorPos X="18" Y="516"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</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>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="1">
<Position1>
<Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
<Caret Line="355" TopLine="333"/>
<Filename Value="unit1.pas"/>
<Caret Line="79" Column="4" TopLine="60"/>
</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>
</ProjectSession>
<Debugging>

View File

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

View File

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

View File

@ -36,7 +36,7 @@ unit rxdbverticalgrid;
interface
uses
Classes, SysUtils, Grids, Graphics, Controls, DB, Menus;
Classes, SysUtils, Types, Grids, Graphics, Controls, DB, Menus;
type
TRxDBVerticalGridOption = (rxvgColumnTitle);
@ -64,6 +64,21 @@ type
procedure UpdateData; override;
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 = class(TPersistent)
@ -118,6 +133,8 @@ type
FAlignment: ^TAlignment;
FPopupMenu: TPopupMenu;
FRowHeight: PInteger;
FValueChecked: PChar;
FValueUnchecked: PChar;
FFieldName: String;
FDisplayFormat : String;
@ -145,10 +162,14 @@ type
function GetKeyList: TStrings;
function GetPickList: TStrings;
function GetRowHeight: Integer;
function GetValueChecked: string;
function GetValueUnchecked: string;
function IsAlignmentStored: Boolean;
function IsColorStored: Boolean;
function IsDisplayFormatStored: Boolean;
function IsFontStored: Boolean;
function IsValueCheckedStored: Boolean;
function IsValueUncheckedStored: Boolean;
procedure SetAlignment(AValue: TAlignment);
procedure SetButtonStyle(AValue: TColumnButtonStyle);
procedure SetColor(AValue: TColor);
@ -170,8 +191,12 @@ type
procedure KeyListChanged(Sender: TObject);
procedure SetStaticText(AValue: string);
procedure SetStyle(AValue: TRxDBVerticalGridRowStyle);
procedure SetValueChecked(AValue: string);
procedure SetValueUnchecked(AValue: string);
procedure SetWordWrap(AValue: Boolean);
protected
function GetDefaultValueChecked: string; virtual;
function GetDefaultValueUnchecked: string; virtual;
function GetDisplayName: string; override;
function GetDefaultAlignment : TAlignment; virtual;
function GetDefaultRowHeight : integer;
@ -179,6 +204,7 @@ type
function GetDefaultDisplayFormat: string;
property IsDefaultFont: boolean read FIsDefaultFont;
function GetDefaultColor: TColor; virtual;
function EditorStyle:TColumnButtonStyle;
//property GroupName:string read FGroupName write SetGroupName;
public
constructor Create(ACollection: TCollection); override;
@ -206,6 +232,8 @@ type
property RowHeight : Integer read GetRowHeight write SetRowHeight;
property ReadOnly : Boolean read FReadOnly write SetReadOnly;
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;
{ TRxDBVerticalGridRows }
@ -241,6 +269,7 @@ type
TRxCustomDBVerticalGrid = class(TCustomGrid)
private
FDataLink: TRxDBVerticalGridDataLink;
FGridDefValues: TRxDBVerticalGridDefValues;
FOptions: TRxDBVerticalGridOptions;
FReadOnly: Boolean;
FRows: TRxDBVerticalGridRows;
@ -250,6 +279,7 @@ type
function GetLabelCoumn: TGridColumn;
procedure SetDataCoumn(AValue: TGridColumn);
procedure SetDataSource(AValue: TDataSource);
procedure SetGridDefValues(AValue: TRxDBVerticalGridDefValues);
procedure SetLabelCoumn(AValue: TGridColumn);
procedure SetOptions(AValue: TRxDBVerticalGridOptions);
procedure SetRows(AValue: TRxDBVerticalGridRows);
@ -258,6 +288,8 @@ type
protected
procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); override;
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 Notification(AComponent: TComponent; Operation: TOperation); 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 LabelCoumn:TGridColumn read GetLabelCoumn write SetLabelCoumn;
property DataCoumn:TGridColumn read GetDataCoumn write SetDataCoumn;
property GridDefValues:TRxDBVerticalGridDefValues read FGridDefValues write SetGridDefValues;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -289,6 +322,7 @@ type
property BorderStyle;
property CellHintPriority;
property Color;
property GridDefValues;
property DataCoumn;
property DataSource;
property DefaultRowHeight;
@ -304,7 +338,31 @@ type
end;
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 }
@ -633,6 +691,22 @@ begin
result := FRowHeight^;
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;
begin
result := FAlignment <> nil;
@ -678,6 +752,16 @@ begin
result := not FisDefaultFont;
end;
function TRxDBVerticalGridRow.IsValueCheckedStored: Boolean;
begin
result := FValueChecked <> nil;
end;
function TRxDBVerticalGridRow.IsValueUncheckedStored: Boolean;
begin
Result := FValueUnchecked <> nil;
end;
procedure TRxDBVerticalGridRow.SetAlignment(AValue: TAlignment);
begin
if FAlignment = nil then
@ -869,12 +953,50 @@ begin
RowChanged;
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);
begin
if FWordWrap=AValue then Exit;
FWordWrap:=AValue;
end;
function TRxDBVerticalGridRow.GetDefaultValueChecked: string;
begin
result := '1';
end;
function TRxDBVerticalGridRow.GetDefaultValueUnchecked: string;
begin
result := '0';
end;
function TRxDBVerticalGridRow.GetDisplayName: string;
begin
if RowTitle.Caption<>'' then
@ -926,6 +1048,15 @@ begin
result := clWindow
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);
begin
inherited Create(ACollection);
@ -952,6 +1083,8 @@ begin
if Assigned(FColor) then Dispose(FColor);
if Assigned(FAlignment) then Dispose(FAlignment);
if Assigned(FRowHeight) then Dispose(FRowHeight);
if Assigned(FValueChecked) then StrDispose(FValueChecked);
if Assigned(FValueUnchecked) then StrDispose(FValueUnchecked);
inherited Destroy;
end;
@ -979,6 +1112,7 @@ begin
FButtonStyle:=TRxDBVerticalGridRow(Source).ButtonStyle;
Alignment:=TRxDBVerticalGridRow(Source).Alignment;
RowTitle:=TRxDBVerticalGridRow(Source).RowTitle;
Color:=TRxDBVerticalGridRow(Source).Color;
FImageList:=TRxDBVerticalGridRow(Source).FImageList;
KeyList:=TRxDBVerticalGridRow(Source).KeyList;
@ -986,8 +1120,10 @@ begin
FWordWrap:=TRxDBVerticalGridRow(Source).WordWrap;
RowHeight:=TRxDBVerticalGridRow(Source).RowHeight;
ReadOnly:=TRxDBVerticalGridRow(Source).ReadOnly;
// PopupMenu:=TRxDBVerticalGridRow(Source).PopupMenu;
PopupMenu:=TRxDBVerticalGridRow(Source).PopupMenu;
Style:=TRxDBVerticalGridRow(Source).Style;
Font:=TRxDBVerticalGridRow(Source).Font;
FStaticText:=TRxDBVerticalGridRow(Source).StaticText;
end;
end;
@ -1050,11 +1186,32 @@ end;
procedure TRxCustomDBVerticalGrid.DrawDataCell(aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState; AGridRow: TRxDBVerticalGridRow);
var
S: String;
J: Integer;
begin
if AGridRow.Style = rxvrData then
begin
if AGridRow.EditorStyle = cbsCheckboxColumn then
DrawCheckboxBitmaps(aRect, AGridRow)
else
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
else
if AGridRow.Style = rxvrStaticText then
@ -1062,6 +1219,77 @@ begin
WriteTextHeader(Canvas, aRect, AGridRow.StaticText, AGridRow.Alignment);
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;
aState: TGridDrawState);
var
@ -1210,6 +1438,13 @@ begin
// UpdateActive;
end;
procedure TRxCustomDBVerticalGrid.SetGridDefValues(
AValue: TRxDBVerticalGridDefValues);
begin
if FGridDefValues=AValue then Exit;
FGridDefValues:=AValue;
end;
procedure TRxCustomDBVerticalGrid.SetLabelCoumn(AValue: TGridColumn);
begin
Columns[0].Assign(AValue);
@ -1220,6 +1455,7 @@ begin
inherited Create(AOwner);
FDataLink:=TRxDBVerticalGridDataLink.Create(Self);
FRows:=TRxDBVerticalGridRows.Create(Self, TRxDBVerticalGridRow);
FGridDefValues:=TRxDBVerticalGridDefValues.Create(Self);
//ColCount:=2;
FixedCols:=0;
@ -1239,6 +1475,7 @@ destructor TRxCustomDBVerticalGrid.Destroy;
begin
FreeAndNil(FRows);
FreeAndNil(FDataLink);
FreeAndNil(FGridDefValues);
inherited Destroy;
end;