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
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:
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 🙂
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!
You must be logged in to post a comment.