TW3Dataset, Smart Data and what you can do
In my previous post, I have requested some input from users about what they would like in the future of SMS. The question of the hour being what features or architecture would you guys like to have regarding databases and data-bound controls?
In this short post I want to write some words about what is already in Smart Mobile Studio and what you can do right now. I have also added the source code for a CSS3 powered DB grid (98% finished) that you can play with. So plenty of things in the pipeline for Smart Mobile Studio. Right, let’s get cracking and have a look at whats on the menu!
TW3Dataset
TClientDataset, not a lightweight
Delphi has one component which is completely and utterly unappreciated; and that is TClientDataset. This really is a fantastic piece of code (really, hear me out). First, it was written to be completely datatype agnostic and stores raw values as variants. That in itself is a monumental achievement considering that Delphi’s variants are binary compatible with Microsoft COM variants (read: sluggish, slow, and a proverbial assault on the CPU stack). Secondly, it makes use of variant-arrays to pack columns into a portable, single variant record. The author should be given a medal for not commiting suicide while creating that component. And this is just scratching the surface of TClientDataset, it really is awesome once you get the hang of it. It can act as a stand-alone, in memory only, table. It can act as a intermediate local data cache, keeping track of record changes, tagging, reverts and everything under the sun – before pushing it to a master data provider. So you can locally work with a database on the other side of the world, caching up changes and then push the whole changeset in one go.
TClientDataset is so confusing and had so much potential that Cary Jensen sat down and wrote a full 350 page book on the subject. A lot of Delphi and FreePascal developers just laugh when they hear someone mention TClientDataset, but that component is a gem if you know how to use it properly.
What about Smart?
Smart Mobile Studio ships with wrappers for WebSQL only. IndexDB will be included in the next update, but I seriously advice against using it unless you are going to package your final product with PhoneGap. Both WebSQL and IndexDB represents an onslaught of callback events, to the point of being useless in anything but JavaScript.
Only experienced and advanced Smart developers will be able to master these beasts. I have done my best to simplify their use, but I must admit I hardly ever use these myself. WebSQL is “OK” to use when you package your app with Phonegap; that takes away the 5Mb limitation and extends the procedure execution time — but other than that, all my large apps use TW3Dataset for storage.
Right. Let’s sum up what Smart Mobile Studio has to offer right now when it comes to databases and data transportation:
WebSQL
WebSQL is a small and compact SQL database. Most browsers include SQLite and simply expose that through JavaScript. In Smart Mobile Studio WebSQL is encapsulated as classes and actions in the unit SmartCL.DbSQL.pas. While WebSQL is by far the best HTML5 database, please note that it’s been marked as deprecated (meaning: it will be phased out and removed in the future). Also, it has a limitation of 5-10 megabytes per database. WebSQL is excellent if you use PhoneGap to package your final product (and you know your way around JavaScript to begin with). Phonegap removes the storage limitation and also extends the JSVM execution limitation (a procedure call must return within 2 seconds), allowing you to operate with large and complex queries.
DataSnap
Datasnap is a Delphi technology for exposing databases and RPC (remote procedure call) services to the world. Datasnap clients can call datasnap servers to obtain data, invoke methods and so on. Datasnap is an excellent way of re-using your Delphi back-end services with HTML5 or mobile applications. Smart Mobile Studio supports DataSnap out of the box, so if your company has existing datasnap databases available, your Smart applications can connect and make use of them.
It must however be mentioned that third party solutions like Mormoth offer much better performance and stability than Datasnap. Mormoth also supports Smart Mobile Studio.
Remobjects SDK
While not really a DB framework, Smart Mobile Studio can connect and invoke RO services. This opens up for some very exciting possibilities, and pushing data over an RPC framework is not hard to do. It’s also a great way to re-cycle existing RO based native services with your HTML5 or mobile applications. Smart Mobile Studio can import RO service libraries and generate Smart Pascal client interfaces for you.
TW3Dataset
This is a single table database engine written in Smart Pascal itself. It has no support for SQL or filtering (as of writing) but also no limitation on size. File storage under JSVM is however limited to the same 5-10 megabyte restriction as WebSQL, but the limitations mentioned are removed by PhoneGap. Since PhoneGap is what you want to use in getting your product onto AppStore, Google Play or Android Marketplace, the storage limitation has no real impact.
Working with TW3Dataset
Tw3Dataset was designed to be Smart Mobile Studio’s version of TClientDataset for Delphi (read: inspired but less complex) and it will no doubt grow as we establish our DB framework in 2016. You can use it to keep track of local data changes, but you have to reserve a field for that information yourself. TW3Dataset is simply a small, in memory, to the point dataset which is perfect for applications that doesnt generate huge amounts of data. It should also remain as small and compact as possible because it acts as a building-block for more complex components.
Why is this useful? Well consider this as an example: Developer Express, a great company offering a wide variety of components, sell components that mimic and implement Microsoft Outlook. You have the calendar, the day planner, the vertical scrolling menu system, the freestyle note editing; DevEx have more or less reverse engineered the visual components that make up Microsoft Outlook. The downside? Well, with such a complex, inter-connected component set, the information it generates and depends on is equally complex! So DevEx allows you to store the data directly to an existing database. They also provide a drop-in solution, in-memory tables that are created and maintained by the components for you. This is a perfect situation where a TW3Dataset would be handy to use. Rather than exposing a ton of storage events, so many that it overwhelms the developer — the components can deal with all of that and just give you a handy way of loading and saving that data.
This is the idea behind TW3Dataset. It was designed not to be complex, support SQL or any advanced features. It should be simple so people can use it to create large and complex components that can export and import data in a uniform way.
Creating a table
Before we create a table, we first have to define what the table looks like. This is done by populating the field-definitions property. TW3Dataset supports generated fields, so you can have both AutoInc and GUID fields which are generated automatically. When you have populated the field-definistions, we simply call CreateDataset() to establish the table.
var
LDataset: TW3Dataset;
LDataset.FieldDefs.Add('id',ftAutoInc);
LDataset.fieldDefs.Add('firstname',ftString);
LDataset.fieldDefs.Add('lastname',ftString);
LDataset.fieldDefs.add('text',ftString);
LDataset.CreateDataset;
Adding records
Adding records to the dataset is straight forward and more or less identical to how you would do it under Delphi. You have both append and insert operations. Let’s use Append for this example:
var
x: Integer;
LDataset: TW3Dataset;
LDataset.FieldDefs.Add('id',ftAutoInc);
LDataset.fieldDefs.Add('firstname',ftString);
LDataset.fieldDefs.Add('lastname',ftString);
LDataset.fieldDefs.add('text',ftString);
LDataset.CreateDataset;
for x:=1 to 10 do
begin
LDataset.Append;
LDataset.Fields.FieldByName('firstname').AsString := 'John';
LDataset.Fields.FieldByName('firstname').AsString := 'Doe';
LDataset.Fields.FieldByName('text').AsString:='This is #' + x.toString;
LDataset.Post;
end;
As you can see from the code above, calling the Append() method sets the dataset in insert mode. This means it allocates the memory needed to hold the record, generates the automatic values (ID autoinc in this case) and allows access to the fields object. If you try to alter values without being in Insert or Edit mode, an exception is raised. This is standard for most languages so nothing new here. The Post() method commits the record buffer to the table, storing it in memory.
Navigating the data
Navigation is done via First, Last, Next, Back methods. You can also check for eof-of-file and beginning-of-file via traditional BOF and EOF properties. So let’s traverse the dataset we just created and dump the output to the console!
var
x: Integer;
LDataset: TW3Dataset;
LDataset.FieldDefs.Add('id',ftAutoInc);
LDataset.fieldDefs.Add('firstname',ftString);
LDataset.fieldDefs.Add('lastname',ftString);
LDataset.fieldDefs.add('text',ftString);
LDataset.CreateDataset;
for x:=1 to 10 do
begin
LDataset.Append;
LDataset.Fields.FieldByName('firstname').AsString := 'John';
LDataset.Fields.FieldByName('firstname').AsString := 'Doe';
LDataset.Fields.FieldByName('text').AsString:='This is #' + x.toString;
LDataset.Post;
end;
LDataset.first;
while not lDataset.EOF do
begin
var id := LDataset.fields.fieldbyname('id').asString;
var txt := LDataset.fields.fieldbyname('text').asString;
writeln(id + ' ' + txt);
LDataset.Next;
end;
And here is the output in the console:
The output is as expected in the console
Loading and saving
TW3Dataset allows you to save your data to a normal string or a stream. You may remember that in our last update we added TStream support as well as the possebility to allocate and work with raw memory? Well, TW3Dataset makes storage very simple. Since it exports ordinary JSON in text format, you can also use TW3Dataset as an intermediate format. It’s small enough (depending on the number of records) to be pushed to a server, and also a convenient format for retrieving X number of records from a server.
For storing datasets locally, in the browser or on your phone, just use TLocalStorage and stuff the data there. Just be aware of the limitation your browser impose on you when not running under PhoneGap (max 5-10 megabyte, the limit toggles between these depending on browser type and build number).
function SaveToString:String; Procedure LoadFromString(Const aText:String); Procedure SaveToStream(const Stream:TStream);virtual; Procedure LoadFromStream(const Stream:TStream);virtual;
Grids
This has been somewhat missing in Smart Mobile Studio. Like mentioned in my previous article, we are still working on a “final” framework for databases under Smart, and a grid cannot really be created before you have some data it can bind to. But, I have actually a grid that may be of interest. It’s actually been lying around my PC since june 2015. I’m going to publish the source for this on Github later, and you can use that until we finalize the DB framework.
It makes full use of HTML5 hardware scrolling, effects and more. It’s also heavily adaptable, so you can use CSS3 animations on rows – or transform rows into something else (like clicking a row and having the row transform into an editor). It’s pretty neat! But I still need to clean it up a bit. And there is a handfull of features that must be added to the RTL before it can be used by everyone. Here is a picture of it. It doesnt capture the CSS3 animations or the animated column-dragging, but its pretty neat 🙂
A MS-Phone Skinned grid and header control
If you want to play around with the source, here you go:
unit smartCL.dbgrid;
interface
uses
System.Types,
system.types.convert,
System.colors,
SmartCL.system,
SmartCL.Components,
SmartCL.Controls.Label,
SmartCL.Fonts,
SmartCL.Borders,
SmartCL.Controls.ScrollBar;
type
TEdgeSenseControl = partial class(TW3Label);
TGridRowContainer = partial class(TW3CustomControl);
TCustomGrid = partial class(TW3CustomControl);
TEdgeRegions = (scLeft,scTop,scRight,scBottom,scNone);
TEdgeSenseEdges = set of TEdgeRegions;
(* TEdgeSenseControl:
This control checks its own edges and changes mouse cursor
accordingly. The edges to check is defined by the SenseEdges
pascal SET. Use setSenseEdges() to define what edges to
check for.
The active edge (hovered by the mouse-pointer) is reflected
in ActiveEdge
To get the X/Y offset of the pointer inside an edge zone,
call getActiveEdgeOffset()
Edge sensebility can be disabled and enabled with
DisableSense() and EnableSense(). *)
TEdgeSenseControl = partial Class(TW3Label)
const
CNT_LEFT = 0;
CNT_TOP = 1;
CNT_RIGHT = 2;
CNT_BOTTOM = 3;
CNT_SIZE = 10;
private
FEdges: TEdgeSenseEdges;
FRects: Array[0..3] of TRect;
FEdgeId: Integer;
FSense: Boolean;
procedure CheckCorners(const x,y:Integer);
procedure UpdateCursor;
protected
procedure DisableSense;
procedure EnableSense;
function getActiveEdge:TEdgeRegions;
function getActiveEdgeOffset(x,y:Integer):TPoint;
protected
Property ActiveEdge:TEdgeRegions read getActiveEdge;
Property SenseEdges:TEdgeSenseEdges read FEdges;
Procedure setSenseEdges(const Value:TEdgeSenseEdges);virtual;
procedure MouseMove(shiftState:TShiftState;x,y:Integer);override;
procedure MouseEnter(shiftState:TShiftState;x,y:Integer);override;
procedure MouseExit(shiftState:TShiftState;x,y:Integer);override;
procedure Resize;override;
protected
procedure InitializeObject;Override;
end;
(* TGridHeaderColumn:
This control inherits from TEdgeSenseControl, but adds actual
size functionality. All column-header controls can be sized
horizontally only.
Where the ancestor control adds sensitivity to mouse-hovering
over the edges, this control responds to mouse-press
while over an edge (start size operation), and will
adjust itself according to the user's movements *)
TGridHeaderColumn = Class(TEdgeSenseControl)
private
FSizing: Boolean;
FMoving: Boolean;
FStartX: Integer;
FStartY: Integer;
FNowX: Integer;
FBaseWidth: Integer;
function getGrid:TCustomGrid;
protected
procedure MouseDown(button:TMouseButton;
shiftState:TShiftState;x,y:Integer);override;
procedure MouseUp(button:TMouseButton;
shiftState:TShiftState;x,y:Integer);override;
procedure MouseMove(shiftState:TShiftState;x,y:Integer);override;
procedure InitializeObject;Override;
public
end;
IGridHeader = interface
procedure ColumnReSizeBegins(const column:TGridHeaderColumn);
procedure ColumnReSizeEnds(const column:TGridHeaderColumn);
procedure ColumnMoveBegins(Const column:TGridHeaderColumn);
procedure ColumnMoveEnds(const column:TGridHeaderColumn);
procedure ColumnSized(const column:TGridHeaderColumn);
Procedure ColumnMoved(const Column:TGridHeaderColumn);
end;
TGridHeaderEvent = procedure (Sender:TObject;
Column:TGridHeaderColumn);
TGridHeaderColumnAddEvent = TGridHeaderEvent;
TGridHeaderColumnSizedEvent = procedure (sender:TObject;
Column:TGridHeaderColumn;
OldSize:TPoint);
TGridHeaderColumnMovedEvent = TGridHeaderEvent;
TGridHeaderColumnMoveBeginsEvent = TGridHeaderEvent;
TGridHeaderColumnMoveEndsEvent = TGridHeaderEvent;
TGridHeaderColumnSizeBeginsEvent = TGridHeaderEvent;
TGridHeaderColumnSizeEndsEvent = TGridHeaderEvent;
(* TGridHeader:
This is the container control for TGridHeaderColumn instances.
It implements a simple interface for updating during a
resize of a column.
It also modifies TW3Component->RegisterChild to only allow
TGridHeaderColumn instances to register. If you try to create
other types of controls with TGridHeader as parent, it will
result in an exception *)
TGridHeader = Class(TW3CustomControl,IGridHeader)
private
FOldSize: Tpoint;
FItems: Array of TGridHeaderColumn;
FOnAdded: TGridHeaderColumnAddEvent;
FOnSized: TGridHeaderColumnSizedEvent;
FOnMoved: TGridHeaderColumnMovedEvent;
FOnMoveBegins:TGridHeaderColumnMoveBeginsEvent;
FOnMoveEnds:TGridHeaderColumnMoveEndsEvent;
FOnSizeBegins:TGridHeaderColumnSizeBeginsEvent;
FOnSizeEnds:TGridHeaderColumnSizeEndsEvent;
protected
procedure ChildAdded(aChild: TW3Component);override;
procedure ChildRemoved(aChild: TW3Component);override;
procedure RegisterChild(aChild: TW3Component);override;
protected
procedure ColumnSized(const column:TGridHeaderColumn);
procedure ColumnReSizeBegins(const column:TGridHeaderColumn);
procedure ColumnReSizeEnds(const column:TGridHeaderColumn);
procedure ColumnMoveBegins(Const column:TGridHeaderColumn);
procedure ColumnMoveEnds(const column:TGridHeaderColumn);
Procedure ColumnMoved(const Column:TGridHeaderColumn);
procedure Resize;Override;
Procedure StyleTagObject;override;
public
property Identifier:Integer;
Property Columns[index:Integer]:TGridHeaderColumn
read ( FItems[index] );
Property Count:Integer read ( FItems.length );
function Add:TGridHeaderColumn;overload;
function Add(Caption:String):TGridHeaderColumn;overload;
Procedure Adjust;
procedure Clear;
procedure UpdateIdentifier;
procedure FinalizeObject;Override;
published
Property OnColumnAdded:TGridHeaderColumnAddEvent
read FOnAdded write FOnAdded;
Property OnColumnSized:TGridHeaderColumnSizedEvent
read FOnSized write FOnSized;
Property OnColumnMoved:TGridHeaderColumnMovedEvent
read FOnMoved write FOnMoved;
Property OnMoveOperationBegins:TGridHeaderColumnMoveBeginsEvent
read FOnMoveBegins write FOnMoveBegins;
Property OnMoveOperationEnds:TGridHeaderColumnMoveEndsEvent
read FOnMoveEnds write FOnMoveEnds;
Property OnSizeOperationBegins:TGridHeaderColumnSizeBeginsEvent
read FOnSizeBegins write FOnSizeBegins;
Property OnSizeOperationEnds:TGridHeaderColumnSizeEndsEvent
read FOnSizeEnds write FOnSizeEnds;
end;
TGridVerticalScrollbar = Class(TW3VerticalScrollbar)
end;
TGridDataItem = class(TW3CustomControl)
public
Property ColumnItem:TGridHeaderColumn;
end;
(* This class represents a single column in a row.
It is created as a child of TW3GridDataRow. *)
TGridDataColumn = Class(TGridDataItem)
protected
procedure InitializeObject;Override;
end;
(* This class represents the left-most edit cursor *)
TGridEditorColumn = Class(TGridDataItem)
end;
IGridDataRow = Interface
Procedure Populate;
end;
TW3GridDataRow = Class(TGridDataItem,IGridDataRow)
private
FSelected: Boolean;
FEditCol: TGridEditorColumn;
Procedure Populate;
protected
function getGrid:TCustomGrid;
procedure setSelected(Const Value:Boolean);
procedure Resize;Override;
procedure InitializeObject;Override;
procedure FinalizeObject;Override;
protected
procedure MouseDown(button:TMouseButton;
shiftState:TShiftState;x,y:Integer);override;
public
Property Parent:TGridRowContainer read (TGridRowContainer(inherited Parent));
Property Index:Integer;
Property Identifier:Integer;
Property Column[index:Integer]:TGridDataColumn
read ( TGridDataColumn(getChildObject(index)) );
Property Count:Integer read ( getChildCount );
Property Selected:Boolean read FSelected write setSelected;
procedure UpdateIdentifier;
procedure Update;
end;
TGridRowInfo = Record
DOM: TW3GridDataRow;
end;
(* TGridRowContainer
=================
This is a container control which is created as a direct child
element on the grid. All rows are created inside this container, and
when scrolling occurs - it's actually this container which we target
for scrolling *)
TGridRowContainer = Class(TW3CustomControl)
public
Property Parent:TCustomGrid read (TCustomGrid(inherited Parent));
Property Count:Integer read ( inherited getChildCount );
Property Rows[index:Integer]:TW3GridDataRow read
( TW3GridDataRow( inherited getChildObject(index) ) );default;
end;
TGridOptions = class(TW3OwnedObject)
private
FScrollDelay: Integer;
protected
procedure setScrollDelay(Value:Integer);virtual;
public
Property Owner:TCustomGrid read (TCustomGrid(inherited Owner));
Property AllowSelect:Boolean;
property AllowColSize:Boolean;
Property AllowColMove:Boolean;
Property RowSelect:Boolean;
Property ShowEditCol:Boolean;
Property ScrollDelay:Integer read FScrollDelay write setScrollDelay;
end;
IGridStyler = Interface
procedure StyleRow(Const Index:Integer;
Const Row:TW3GridDataRow);
procedure StyleColumn(const Index:Integer;
const Col:TGridDataColumn);
procedure StyleClientArea(const control:TGridRowContainer);
procedure StyleNonClientArea(const control:TCustomGrid);
Procedure RowSelected(const Index:Integer;
const Row:TW3GridDataRow);
procedure RowUnselected(const Row:TW3GridDataRow);
procedure ColumnSelected(const index:Integer;
const Column:TGridDataColumn);
procedure ColumnUnSelected(Column:TGridDataColumn);
end;
TGridStyler = Class(TObject,IGridStyler)
protected
procedure StyleRow(Const Index:Integer;
Const Row:TW3GridDataRow);virtual;
procedure StyleColumn(const Index:Integer;
const Col:TGridDataColumn);virtual;
procedure StyleClientArea(const control:TGridRowContainer);virtual;
procedure StyleNonClientArea(const control:TCustomGrid);virtual;
Procedure RowSelected(const Index:Integer;
const Row:TW3GridDataRow);virtual;
procedure RowUnselected(const Row:TW3GridDataRow);virtual;
procedure ColumnSelected(const index:Integer;
const Column:TGridDataColumn);virtual;
procedure ColumnUnSelected(Column:TGridDataColumn);virtual;
end;
TGridTools = Class(TW3CustomControl)
end;
TCustomGrid = Class(TW3CustomControl)
const
CNT_CREATE_DELAY = 100;
private
FRowInfo: Array of TGridRowInfo; // LUT for items
FExInfo: Array of Integer; // LUT for items with custom height
FStack: Array of Integer;
FHeader: TGridHeader;
FRowSize: Integer = 24;
FContainer: TGridRowContainer;
FTools: TGridTools;
FVScroll: TGridVerticalScrollbar;
FOptions: TGridOptions;
procedure HandleScroll(Sender:TObject);
procedure ProcessStack;
protected
procedure HandleHeaderColumnMoved
(Sender:TObject;Column:TGridHeaderColumn);virtual;
procedure HandleHeaderColumnSized(Sender:TObject;Column:TGridHeaderColumn;
OldSize:TPoint);virtual;
protected
function getPageSize:Integer;
procedure setGeneralRowHeight(const Value:Integer);virtual;
function getContentHeight:Integer;
function getTopItemIndex:Integer;
function getOffsetForItem(Const RowIndex:Integer):Integer;
Procedure Render;
protected
procedure Resize;override;
procedure InitializeObject;override;
procedure FinalizeObject;Override;
public
Property Options:TGridOptions read FOptions;
Property RowHeight:Integer read FRowSize write setGeneralRowHeight;
Property Header:TGridHeader read FHeader;
procedure ShowTools;
function IndexOfRow(Const Row:TW3GridDataRow):Integer;
function Add(const Index:Integer):TW3GridDataRow;
procedure Allocate(Rows:Integer);
procedure Clear;
end;
implementation
uses system.memory,
system.streams,
system.dateutils,
system.types.convert;
//############################################################################
// TGridStyler
//############################################################################
procedure TGridStyler.StyleRow(Const Index:Integer;
Const Row:TW3GridDataRow);
begin
case index mod 2 of
0: Row.background.fromColor(clRed);
1: row.background.fromColor(clWhite);
end;
end;
procedure TGridStyler.StyleColumn(const Index:Integer;
const Col:TGridDataColumn);
begin
end;
procedure TGridStyler.StyleClientArea(const control:TGridRowContainer);
begin
end;
procedure TGridStyler.StyleNonClientArea(const control:TCustomGrid);
begin
end;
Procedure TGridStyler.RowSelected(const Index:Integer;
const Row:TW3GridDataRow);
begin
end;
procedure TGridStyler.RowUnselected(const Row:TW3GridDataRow);
begin
end;
procedure TGridStyler.ColumnSelected(const index:Integer;
const Column:TGridDataColumn);
begin
end;
procedure TGridStyler.ColumnUnSelected(Column:TGridDataColumn);
begin
end;
//############################################################################
// TW3GridDataRow
//############################################################################
procedure TGridDataColumn.InitializeObject;
begin
inherited;
self.Font.Size:=12;
self.Font.Color:=clWhite;
end;
//############################################################################
// TW3GridDataRow
//############################################################################
procedure TW3GridDataRow.InitializeObject;
begin
inherited;
(Handle)['onmousedown'] := @CBMouseDown;
end;
procedure TW3GridDataRow.FinalizeObject;
begin
if FEditCol<>NIL then
FEditCol.free;
inherited;
end;
procedure TW3GridDataRow.MouseDown(button:TMouseButton;
shiftState:TShiftState;x,y:Integer);
begin
inherited MouseDown(Button,ShiftState,x,y);
if assigned(parent)
and assigned(parent.parent) then
begin
parent.parent.showTools;
end;
Selected:=not Selected;
end;
procedure TW3GridDataRow.Update;
begin
Beginupdate;
AddToComponentState([csSized]);
EndUpdate;
end;
procedure TW3GridDataRow.UpdateIdentifier;
var
x: Integer;
begin
Identifier:=0;
for x:=0 to self.Count-1 do
Identifier:=Identifier + ((Column[x].Width + Column[x].left) shl x);
end;
function TW3GridDataRow.getGrid:TCustomGrid;
begin
result:=NIL;
if (parent<>NIL)
and (parent.parent<>NIL) then
result:=TCustomGrid(parent.parent);
end;
procedure TW3GridDataRow.Resize;
var
x: integer;
begin
inherited;
if FEditCol<>NIL then
Begin
FEditCol.setBounds(0,0,Height,Height);
end;
for x:=0 to Count-1 do
begin
var mItem:=self.Column[x];
if mItem.ColumnItem<>NIL then
begin
(* mItem.fxScaleTo
(
mItem.ColumnItem.Left,
0,
mItem.ColumnItem.Width,
clientHeight,
0.2
); *)
mItem.SetBounds
(
mItem.ColumnItem.Left,
0,
mItem.ColumnItem.Width,
clientHeight
);
end;
end;
end;
Procedure TW3GridDataRow.Populate;
var
x: Integer;
function RandomColor:TColor;
begin
result:=RGBToColor
(
round( Random * 255 ),
round( random * 255 ),
round( random * 255 )
);
end;
begin
if Parent<>NIL then
begin
var mGrid:=self.getGrid;
if mGrid<>NIL then
begin
(* Create edit-cursor column? *)
if mGrid.Options<>NIL then
Begin
if mGrid.Options.ShowEditCol then
FEditCol:=TGridEditorColumn.Create(self);
end;
var rowColor := clNone;
if index>=0 then
begin
if Index mod 2=1 then
StyleClass:='RowOdd' else
StyleClass:='RowEven';
if index mod 2=1 then
RowColor:=RGBToColor(33,33,33) else
rowcolor:=RGBToColor(0,0,0);
end;
(* Now create columns based on header *)
for x:=0 to mgrid.header.count-1 do
Begin
var mItem:=TGridDataColumn.Create(self);
mItem.ColumnItem:=mGrid.Header.Columns[x];
if x in [0,2] then
mItem.Background.fromColor(RGBToColor(55,55,55));
end;
//handle.style['background-color']:=ColorToWebStr(rowColor);
background.FromColor(rowColor);
(* Update identifier, used by the grid to know
if a row needs a resize or have a different layout
from the main-form *)
UpdateIdentifier;
end;
end;
end;
procedure TW3GridDataRow.setSelected(Const Value:Boolean);
begin
if value<>FSelected then
begin
FSelected:=Value;
case Value of
True: CSSClasses.Add("RowSelected");
false: CSSClasses.RemoveByName("RowSelected");
end;
end;
end;
//############################################################################
// TGridOptions
//############################################################################
procedure TGridOptions.setScrollDelay(Value:Integer);
begin
value:=TInteger.EnsureRange(Value,0,100);
if value<>FScrollDelay then
begin
FScrollDelay:=Value;
end;
end;
//############################################################################
// TCustomGrid
//############################################################################
procedure TCustomGrid.InitializeObject;
begin
inherited;
FOptions:=TGridOptions.Create(self);
FHeader:=TGridHeader.Create(self);
FVScroll:=TGridVerticalScrollbar.Create(self);
FVScroll.OnChanged:=HandleScroll;
FVScroll.Enabled:=False;
FVScroll.width:=24;
FVScroll.Background.FromColor(clWhite);
FContainer:=TGridRowContainer.Create(self);
FContainer.Background.FromColor(clGreen);
FHeader.OnColumnMoved:=HandleHeaderColumnMoved;
FHeader.OnColumnSized:=HandleHeaderColumnSized;
end;
procedure TCustomGrid.FinalizeObject;
begin
FContainer.free;
FVScroll.free;
FHeader.clear;
FHeader.free;
FOptions.free;
inherited;
end;
procedure TCustomGrid.HandleHeaderColumnSized
(Sender:TObject;Column:TGridHeaderColumn;OldSize:TPoint);
begin
Header.UpdateIdentifier;
Render;
end;
procedure TCustomGrid.HandleHeaderColumnMoved
(Sender:TObject;Column:TGridHeaderColumn);
var
x: Integer;
begin
var mIndex:=getTopItemIndex;
var mPage:=self.getPageSize;
Header.UpdateIdentifier;
//Render;
for x:=0 to mPage-1 do
begin
var mRow:=FRowInfo[mIndex + x].DOM;
if (mRow<>NIL) then
begin
mRow.BeginUpdate;
mRow.addToComponentState([csSized]);
mRow.EndUpdate;
end;
end;
end;
procedure TCustomGrid.setGeneralRowHeight(const Value:Integer);
begin
FRowSize:=TInteger.EnsureRange(Value,12,128);
end;
procedure TCustomGrid.Clear;
var
x: Integer;
begin
try
for x:=0 to self.FRowInfo.length-1 do
begin
if FRowInfo[x].DOM<>NIL then
FRowInfo[x].DOM.free;
end;
finally
FRowInfo.Clear;
end;
end;
function TCustomGrid.getTopItemIndex:Integer;
begin
result:=FVScroll.Position;
end;
function TCustomGrid.getOffsetForItem(Const RowIndex:Integer):Integer;
begin
result:=RowIndex * FRowSize;
end;
function TCustomGrid.getPageSize:Integer;
Begin
result:=FContainer.ClientHeight div FRowSize;
end;
function TCustomGrid.getContentHeight:Integer;
var
x: Integer;
begin
result:=(FRowInfo.Length-FExInfo.length) * FRowSize;
for x:=0 to FExInfo.length-1 do
inc(result,FRowInfo[x].DOM.height);
end;
procedure TCustomGrid.ProcessStack;
var
mItem: TW3GridDataRow;
mIndex: Integer;
Begin
if FStack.Count>0 then
begin
(* We leave the number on the stack, that way we dont end
up creating duplicates, which would drain memory line insane *)
mIndex:=FStack.Peek;
try
if FRowInfo[mIndex].DOM=NIL then
Begin
mItem:=Add(mIndex);
FRowInfo[mIndex].DOM:=mItem;
mItem.Column[0].InnerHTML:=IntToStr(mIndex);
mItem.SetBounds
(
0,
getOffsetForItem(mIndex),
clientwidth - self.FVScroll.width,
FRowSize
);
end;
finally
FStack.Pop;
end;
if FStack.count>0 then
ProcessStack;
end;
end;
Procedure TCustomGrid.Render;
var
x: Integer;
mTopIndex: Integer;
mPageItems: Integer;
mObj:TW3GridDataRow;
begin
mTopIndex:=getTopItemIndex;
mPageItems:=FContainer.Height div FRowSize;
for x:=0 to mPageItems-1 do
begin
var mIndex:= x + mTopIndex;
(* Get allocated row object *)
mObj:=FRowInfo[mIndex].DOM;
(* No allocated row? Push to stack, late create *)
if mObj=NIL then
begin
if FStack.IndexOf(mIndex)=-1 then
FStack.Push(mIndex);
end else
begin
(* Is the row identifier different from the header layout? *)
if mObj.Identifier<>FHeader.Identifier then
begin
mObj.UpdateIdentifier;
mObj.update;
end;
end;
end;
if FStack.Length>0 then
ProcessStack;
end;
procedure TCustomGrid.Allocate(Rows:Integer);
begin
if FRowInfo.length>0 then
Clear;
if Rows>0 then
begin
FRowInfo.Clear;
FRowInfo.SetLength(Rows);
writeln("Allocating " + rows.tostring + " rows");
FVScroll.Enabled:=true;
FVScroll.Total:=Rows;
FVScroll.Position:=0;
FVScroll.PageSize:=getPageSize;
FVScroll.Visible:=true;
w3_requestAnimationFrame(Render);
end;
end;
function TCustomGrid.IndexOfRow(Const Row:TW3GridDataRow):Integer;
var
x: Integer;
begin
result:=-1;
for x:=0 to FRowInfo.Length do
begin
if FRowInfo[x].DOM = Row then
Begin
result:=x;
break;
end;
end;
end;
procedure TCustomGrid.ShowTools;
var
mHeight: integer;
mTargetPos: integer;
mTestPos: Integer;
begin
if not (csDestroying in ComponentState) then
begin
if FRowInfo.Length>0 then
begin
mTargetPos:=(ClientHeight - FHeader.Height) div 2;
mTestPos :=FHeader.top + FHeader.height + 10;
mHeight:=(ClientHeight-FHeader.height) div 2;
if FContainer.top>=mTestPos then
FContainer.fxScaleTo(0,FHeader.height,FContainer.Width,clientHeight-Fheader.Height,0.3,
procedure ()
begin
FVScroll.PageSize:=getPageSize;
end)
else
FContainer.fxScaleTo(0,mHeight,FContainer.width,FContainer.height ,0.4,
procedure ()
begin
FContainer.height := (ClientHeight -mHeight) - 20;
FVScroll.PageSize:=getPageSize;
end);
end;
end;
end;
function TCustomGrid.Add(const Index:Integer):TW3GridDataRow;
Begin
result:=TW3GridDataRow.Create(FContainer);
result.setBounds(
0,
Header.BoundsRect.bottom + getContentHeight,
FContainer.clientwidth,
FRowSize);
result.Index:=Index;
result.BeginUpdate;
try
(result as IGridDataRow).populate;
except
on e: exception do
begin
result.free;
result:=NIL;
exit;
end;
end;
result.AddToComponentState([csSized]);
result.EndUpdate;
end;
procedure TCustomGrid.HandleScroll(Sender:TObject);
begin
if (csReady in ComponentState) then
Begin
FContainer.ScrollInfo.ScrollTo(0,FVScroll.Position * FRowSize);
if FOptions.ScrollDelay=0 then
Render else
w3_setTimeout(Render,FOptions.ScrollDelay);
end;
end;
procedure TCustomGrid.Resize;
var
mScaledHeight: Integer;
begin
inherited;
If Handle.Valid
and handle.ready then
begin
FHeader.SetBounds(0,0,clientwidth,32);
FVScroll.setBounds(
clientwidth-FVScroll.width,
FHeader.height,
FVScroll.width,
clientheight - Fheader.height);
//mScaledHeight:=mScaledHeight * FRowSize;
//end else
mScaledHeight:=clientHeight - (FHeader.Height);
FContainer.setBounds(0,FHeader.height,
clientWidth-FVScroll.width,
mScaledHeight);
end;
end;
//############################################################################
// TGridHeader
//############################################################################
procedure TGridHeader.FinalizeObject;
begin
inherited;
end;
Procedure TGridHeader.styleTagObject;
Begin
inherited;
end;
procedure TGridHeader.Resize;
var
wd: Integer;
x: Integer;
dx: Integer;
cnt: Integer;
begin
cnt:=Count;
if cnt>0 then
begin
if handle.valid
and handle.ready then
begin
dx:=0;
wd:=clientWidth div cnt;
for x:=0 to cnt-1 do
begin
wd:=Columns[x].width;
Columns[x].setBounds(dx,0,wd,clientHeight);
inc(dx,wd);
end;
end;
end;
end;
procedure TGridHeader.RegisterChild(aChild: TW3Component);
begin
if (aChild<>NIL) then
begin
if (aChild is TGridHeaderColumn) then
inherited RegisterChild(aChild) else
Raise Exception.Create
('Only column controls can be added to a grid header');
end;
end;
procedure TGridHeader.ChildAdded(aChild: TW3Component);
begin
inherited ChildAdded(aChild);
FItems.Add(TGridHeaderColumn(aChild));
if not (csDestroying in ComponentState)
and not (csLoading in ComponentState) then
Resize;
end;
procedure TGridHeader.ChildRemoved(aChild: TW3Component);
var
mIndex: Integer;
begin
inherited ChildRemoved(aChild);
mIndex:=FItems.IndexOf(TGridHeaderColumn(aChild));
if mIndex>=0 then
FItems.delete(mIndex,1);
if not (csDestroying in ComponentState)
and not (csLoading in ComponentState) then
Resize;
end;
procedure TGridHeader.ColumnReSizeBegins(const column:TGridHeaderColumn);
begin
FOldSize:=TPoint.Create(Column.Width,Column.Height);
if assigned(FOnSizeBegins) then
FOnSizeBegins(self,Column);
end;
procedure TGridHeader.ColumnReSizeEnds(const column:TGridHeaderColumn);
begin
if assigned(FOnSized) then
FOnSized(self,Column,
FOldSize);
if assigned(FOnSizeEnds) then
FOnSizeEnds(self,Column);
end;
procedure TGridHeader.ColumnMoveBegins(Const column:TGridHeaderColumn);
begin
if assigned(FOnMoveBegins) then
FOnMoveBegins(self,Column);
end;
procedure TGridHeader.ColumnMoveEnds(const column:TGridHeaderColumn);
begin
if assigned(FOnMoveEnds) then
FOnMoveEnds(self,Column);
end;
Procedure TGridHeader.ColumnMoved(const Column:TGridHeaderColumn);
function GetChildrenSortedByXPos: Array of TGridHeaderColumn;
var
mCount: Integer;
x: Integer;
mAltered: Boolean;
mObj: TGridHeaderColumn;
mLast: TGridHeaderColumn;
mCurrent: TGridHeaderColumn;
begin
mCount := GetChildCount;
if mCount>0 then
begin
(* populate list *)
for x := 0 to mCount - 1 do
begin
mObj := Columns[x];
if (mObj is TGridHeaderColumn) then
Result.add(mObj);
end;
(* sort by X-pos *)
if Result.Count>1 then
begin
repeat
mAltered := False;
for x := 1 to mCount - 1 do
begin
mLast := TGridHeaderColumn(Result[x - 1]);
mCurrent := TGridHeaderColumn(Result[x]);
if
mCurrent.left + (mCurrent.width div 2)
<
mLast.left + (mLast.width div 2) then
begin
Result.Swap(x - 1,x);
mAltered := True;
end;
end;
until mAltered=False;
end;
end;
end;
begin
var mItems := GetChildrenSortedByXPos;
var x:=0;
var dx:=0;
var mWaits:=mItems.count;
for x:=0 to mItems.count-1 do
begin
mItems[x].fxMoveTo(dx,mItems[x].Top,0.3, procedure ()
begin
dec(mWaits);
if mWaits=0 then
begin
if assigned(FOnMoved) then
FOnMoved(self,Column);
end;
end);
inc(dx,mItems[x].width);
end;
FItems:=mItems;
end;
procedure TGridHeader.ColumnSized(const column:TGridHeaderColumn);
begin
w3_requestAnimationFrame(Resize);
end;
Procedure TGridHeader.Adjust;
begin
Resize;
end;
procedure TGridHeader.Clear;
procedure doClear;
var
x: Integer;
mItem: TGridHeaderColumn;
begin
for x:=0 to getChildCount-1 do
Begin
if (getChildObject(x) is TGridHeaderColumn) then
Begin
mItem:=TGridHeaderColumn(getChildObject(x));
mItem.free;
end;
end;
end;
begin
if not (csDestroying in ComponentState) then
begin
BeginUpdate;
try
doClear;
finally
addToComponentState([csSized]);
endUpdate;
UpdateIdentifier;
end;
end else
doClear;
end;
procedure TGridHeader.UpdateIdentifier;
var
x: Integer;
begin
(* Calculate new identifier *)
Identifier:=0;
for x:=0 to FItems.Length-1 do
Identifier:=Identifier + ((Columns[x].Width + Columns[x].left) shl x);
end;
function TGridHeader.Add:TGridHeaderColumn;
begin
beginupdate;
result:=TGridHeaderColumn.Create(self);
result.width:=100;
result.height:=clientHeight;
addToComponentState([csSized]);
endupdate;
UpdateIdentifier;
w3_setTimeOut( procedure ()
begin
if assigned(FOnAdded) then
FOnAdded(self,result);
end,
10);
end;
function TGridHeader.Add(Caption:String):TGridHeaderColumn;
begin
beginupdate;
result:=TGridHeaderColumn.Create(self);
result.width:=100;
result.height:=clientHeight;
result.caption:=Caption;
addToComponentState([csSized]);
endupdate;
UpdateIdentifier;
w3_setTimeOut( procedure ()
begin
if assigned(FOnAdded) then
FOnAdded(self,result);
end,
10);
end;
//############################################################################
// TGridHeaderColumn
//############################################################################
procedure TGridHeaderColumn.InitializeObject;
begin
inherited;
(* Manually initialize event handlers *)
(Handle)['onmousedown'] := @CBMouseDown;
(Handle)['onmouseup'] := @CBMouseUp;
setSenseEdges([scRight]);
Caption:='Column';
font.Name:="verdana";
font.size:=12;
font.color:=clWhite;
end;
procedure TGridHeaderColumn.MouseDown(button:TMouseButton;
shiftState:TShiftState;x,y:Integer);
begin
inherited MouseDown(button,shiftstate,x,y);
if (ActiveEdge in [scLeft,scRight]) then
begin
DisableSense;
setCapture;
FSizing:=True;
FStartX:=x;
FBaseWidth:=Width;
(Parent as IGridHeader).ColumnReSizeBegins(self);
end else
Begin
if clientRect.ContainsPos(x,y) then
Begin
FMoving:=True;
DisableSense;
setCapture;
FStartX:=x;
FStartY:=y;
w3_setStyle(Handle,'cursor','move');
(Parent as IGridHeader).ColumnMoveBegins(self);
end;
end;
end;
procedure TGridHeaderColumn.MouseMove(shiftState:TShiftState;x,y:Integer);
var
dx: Integer;
begin
inherited MouseMove(ShiftState,x,y);
if FSizing then
begin
FNowX:=x;
dx:=FNowX - FStartX ;
SetWidth(FBaseWidth + dx);
(TGridHeader(parent) as IGridHeader).ColumnSized(self);
end;
if FMoving then
begin
left:=self.ClientToScreen( TPoint.Create(x - FStartX,top) ).x;
end;
end;
function TGridHeaderColumn.getGrid:TCustomGrid;
begin
result:=NIL;
if Parent<>NIL then
Begin
if Parent.parent<>NIL then
result:=TCustomGrid(parent.Parent);
end;
end;
procedure TGridHeaderColumn.MouseUp(button:TMouseButton;
shiftState:TShiftState;x,y:Integer);
begin
inherited MouseUp(button,shiftstate,x,y);
if FSizing then
Begin
FSizing:=False;
ReleaseCapture;
EnableSense;
(Parent as IGridHeader).ColumnSized(self);
(Parent as IGridHeader).ColumnReSizeEnds(self);
end;
if FMoving then
begin
FMoving:=false;
ReleaseCapture;
EnableSense;
w3_setStyle(Handle,'cursor','default');
(Parent as IGridHeader).ColumnMoved(self);
end;
end;
//############################################################################
// TEdgeSenseControl
//############################################################################
Procedure TEdgeSenseControl.initializeObject;
Begin
inherited;
FEdges:=[scLeft,scTop,scRight,scBottom];
(* Manually hook up events *)
(Handle)['onmousemove'] := @CBMouseMove;
(Handle)['onmouseover'] := @CBMouseEnter;
(Handle)['onmouseout'] := @CBMouseExit;
FSense:=True;
AlignText:=TTextAlign.taCenter;
end;
Procedure TEdgeSenseControl.setSenseEdges(const Value:TEdgeSenseEdges);
begin
if (scLeft in Value) then Include(FEdges,scLeft) else Exclude(FEdges,scLeft);
if (scTop in Value) then include(FEdges,scTop) else Exclude(FEdges,scTop);
if (scRight in Value) then Include(FEdges,scRight) else
Exclude(FEdges,scRight);
if (scBottom in Value) then include(FEdges,scBottom) else
Exclude(FEdges,scBottom);
end;
procedure TEdgeSenseControl.Resize;
begin
inherited;
FRects[0]:=TRect.CreateSized(0,CNT_SIZE,CNT_SIZE,ClientHeight-CNT_SIZE);
FRects[1]:=TRect.CreateSized(0,0,ClientWidth,CNT_SIZE);
FRects[2]:=TRect.CreateSized(ClientWidth-CNT_SIZE,CNT_SIZE,Clientwidth,ClientHeight-CNT_SIZE);
FRects[3]:=TRect.CreateSized(0,ClientHeight-CNT_SIZE,ClientWidth,CNT_SIZE);
end;
procedure TEdgeSenseControl.CheckCorners(const x,y:Integer);
var
mItem:TRect;
mIndex: Integer;
begin
FEdgeId:=-1;
for mItem in FRects do
begin
if mItem.ContainsPos(x,y) then
begin
FEdgeId:=mIndex;
break;
end;
inc(mIndex);
end;
end;
function TEdgeSenseControl.getActiveEdgeOffset(x,y:Integer):TPoint;
begin
if FEdgeId>=0 then
result:=TPoint.Create
( x - FRects[FEdgeId].Left,
y - FRects[FEdgeId].Top
);
end;
function TEdgeSenseControl.getActiveEdge:TEdgeRegions;
begin
if (FEdgeId>=0) and (FEdgeId<=3) then
result:=TEdgeRegions(FEdgeid) else
result:=scNone;
end;
procedure TEdgeSenseControl.UpdateCursor;
const
CN_LEFT = 0;
CN_TOP = 1;
CN_RIGHT = 2;
CN_BOTTOM = 3;
var
mCursor: string;
procedure doDefault;
begin
if mCursor<>'default' then
w3_setStyle(Handle,'cursor','default');
end;
begin
mCursor:=w3_getStyleAsStr(Handle,'cursor').LowerCase;
case FEdgeId of
CN_LEFT:
Begin
if (scLeft in FEdges) then
begin
if mCursor<>'col-resize' then
w3_setStyle(Handle,'cursor','col-resize');
end else
doDefault;
end;
CN_RIGHT:
Begin
if (scRight in FEdges) then
begin
if mCursor<>'col-resize' then
w3_setStyle(Handle,'cursor','col-resize');
end else
doDefault;
end;
CN_TOP:
begin
if (scTop in FEdges) then
begin
if mCursor<>'row-resize' then
w3_setStyle(Handle,'cursor','row-resize');
end else
doDefault;
end;
CN_BOTTOM:
begin
if (scBottom in FEdges) then
begin
if mCursor<>'row-resize' then
w3_setStyle(Handle,'cursor','row-resize');
end else
doDefault;
end;
else
doDefault;
end;
end;
procedure TEdgeSenseControl.DisableSense;
begin
FSense:=False;
end;
procedure TEdgeSenseControl.EnableSense;
begin
FSense:=True;
end;
procedure TEdgeSenseControl.MouseMove(shiftState:TShiftState;x,y:Integer);
begin
if FSense then
begin
CheckCorners(x,y);
UpdateCursor;
end;
inherited MouseMove(ShiftState,x,y);
end;
procedure TEdgeSenseControl.MouseEnter(shiftState:TShiftState;x,y:Integer);
begin
if FSense then
begin
CheckCorners(x,y);
UpdateCursor;
end;
inherited MouseEnter(ShiftState,x,y);
end;
procedure TEdgeSenseControl.MouseExit(shiftState:TShiftState;x,y:Integer);
begin
if FSense then
Begin
CheckCorners(x,y);
UpdateCursor;
end;
inherited MouseExit(ShiftState,x,y);
end;
end.
Notes on the grid
The reason the grid is able to deal with hundreds of rows quickly, is because i use a stack technique. A row is only allocated once it steps into view, or is assigned data.
You are more than welcome to play around with it. Just keep in mind that its experimental at this stage, and the final version will no doubt be more polished.
Well, hope you got inspired! Enjoy, and merry xmas!
