Dataset for Smart Mobile Studio – Update
Yesterday I posted a preliminary dataset class for Smart Mobile Studio which is perfect for client-side HTML5 development. I have since spent a couple of hours more working on the unit, and here is the update. Still a few tweaks here and there, but in general it’s now usable, stable and persistent (!). This was a very interesting and rewarding task 🙂
Some of the updates since my last post:
- Schema is now defined in FieldDef classes (just like Delphi)
- Calculated (read: generated) fields are now supported
- Autoinc field class added
- GUID field class added
- Field-Definition IO in JSON format is in place
- Dataset can now load and save to JSON format as well
- Added Append() method for inserting record at the end of a dataset
- Altered Insert() method, allowing for insertion at any position (except -1 [BOF] and Count+1 [EOF]).
- Added MoveTo() method for absolute navigation
- Further abstracted architecture
- Exception handling in place
- More events (and more to come)
- Cleaned up source and re-factored quite a few procs
About the GUID calculated field
Javascript doesnt support GUID’s directly. There is no CreateGUID() or GUIDToString() provided by the browser. But thankfully the modern RFC for GUID generation allows for random numbers. So the GUID field is simply an auto-generated GUID string. If you for some reason want to avoid integer autoinc identifiers – but need unique field values (non editable) then TGUIDField is your class.
Note: In retrospect it makes sense to rename these fields to “generated fields”, since calculated fields are event based and user-definable. But I am still in the prototype stage when it comes to this code, so bear with me while I finish it.
How to use it
The dataset follows the ordinary BOF/EOF style navigation. Meaning that BOF (beginning of file) is at position -1 rather than zero, while EOF (end of file) is Count+1. The record pointer self-adjusts if you attempt an insert at these points. Where EOF results in an append, while insert(BOF) adds a record at the top of the dataset (position zero).
Other than that, it’s fairly straight shooting.
If you are going to have a global dataset in your Smart Pascal app’s, the best place to create it is in the project source – as a part of your project’s TApplication instance. All Smart Pascal applications have a unique TApplication object (not static like under Delphi), so this is the perfect place to initialize the dataset instance. Then you can typecast from any form to reach it (e.g: TApplication(application).Dataset).
Speed
It’s not going to make Bill Gates lose sleep any time soon, but I was surprised at how fast it works. This has more to do with the fact that it functions more like an array of variants, where each variant represents a JSON object (array of named values) than anything else. 1000 Inserts of the example below takes less than 1 second. It’s hard to measure it since it hardly makes a dent in the tick-counter.
So all in all it’s perfectly suited for Smart Mobile Studio projects. And when you compile with phonegap it’s even faster since the latest Cordova extensions for iOS boosts array operations considerably.
Procedure TForm1.TestDataset; var mDataset: TW3CustomDataset; x:Integer; mId: Integer; begin mDataset:=TW3CustomDataset.Create; try mDataset.FieldDefs.add('id',ftAutoInc); mDataset.FieldDefs.add('key',ftGUID); mDataset.FieldDefs.add('name',ftString); mDataset.createDataset; for x:=1 to 50 do Begin mDataset.Append; mId:=mDataset.Fields.FieldByName('id').asInteger; mDataset.Fields.FieldByName('name').asString:='Data field #' + IntToStr(mId); mDataset.post; end; showmessage(mDataset.saveToString); finally mDataset.free; end; end;
unit w3dataset; //############################################################################# // // Unit: w3dataset.pas // Author: Jon Lennart Aasenden // Copyright: Jon Lennart Aasenden, all rights reserved // // Description: // ============ // Implements a small and fast in-memory dataset. Supports all the basic // dataset operations (including autoinc field type) but no SQL and // as of writing, no filtering scheme or regEx support. // // // Cipher Diaz of QUARTEX // //############################################################################# interface uses W3System; {.$DEFINE USE_DEVCODE} type (* Forward declaration *) TW3CustomDatasetField = Class; TW3BooleanField = Class; TW3IntegerField = Class; TW3FloatField = Class; TW3StringField = Class; TW3DatasetFields = Class; TW3CustomDataset = Class; TW3FieldDef = Class; TW3FieldDefs = Class; (* Exception classes *) EW3FieldDefs = Class(EW3Exception); EW3DatasetField = Class(EW3Exception); EW3Dataset = Class(EW3Exception); TW3DatasetPacket = Variant; TW3DatasetFieldType = ( ftUnknown, ftBoolean, ftInteger, ftFloat, ftString, ftDateTime, ftAutoInc, // Calculated ftGUID // Calculated ); TW3DatasetState =(dsIdle,dsInsert,dsEdit); IDatasetFieldsAccess = Interface Procedure ResetValues; Procedure setReadOnly(const aValue:Boolean); end; IFieldDefAccess = interface Procedure SetReadOnly(Const aValue:Boolean); function getFieldIdentifier:String; end; TW3GUID = Class public class function CreateGUID:String; end; TW3CustomDatasetField = Class(TObject) private FName: String; FKind: TW3DatasetFieldType; FReadOnly: Boolean; FValue: Variant; FParent: TW3DatasetFields; Procedure setAsDateTime(const aValue:TDateTime); function getAsDateTime:TDateTime; protected Procedure Calculate;virtual; function getCalculated:Boolean;virtual; function getValue:Variant;virtual; procedure setValue(const aValue:variant);virtual; procedure setName (const aValue:String); procedure setKind (const aKind:TW3DatasetFieldType); Procedure setReadOnly(const aValue:Boolean); public Property Parent:TW3DatasetFields read FParent; Property Kind:TW3DatasetFieldType read FKind; Property Name:String read FName write setName; Property Data:Variant read getValue write setValue; Property Calculated:Boolean read getCalculated; Property AsString:String read (TVariant.AsString(FValue)) write (FValue:=Value); Property AsInteger:Integer read (TVariant.asInteger(FValue)) write (FValue:=Value); Property AsBoolean:Boolean read (TVariant.AsBool(FValue)) write (FValue:=Value); Property AsFloat:Float read (TVariant.asFloat(FValue)) write (FValue:=Value); Property AsDateTime:TDateTime read getAsDateTime write setAsDateTime; Constructor Create(const aParent:TW3DatasetFields);virtual; End; TW3AutoIncField = Class(TW3CustomDatasetField) private FCalc: Integer; protected Procedure Calculate;override; function getCalculated:Boolean;override; public Property Value:Integer read (TVariant.AsInteger(Inherited getValue)); End; TW3GUIDField = Class(TW3CustomDatasetField) protected Procedure Calculate;override; function getCalculated:Boolean;override; public Property Value:String read (TVariant.asString(Inherited getValue)); End; TW3BooleanField = Class(TW3CustomDatasetField) public Property Value:Boolean read (TVariant.AsBool(Inherited getValue)) write (inherited setValue(Value)); End; TW3IntegerField = Class(TW3CustomDatasetField) public Property Value:Integer read (TVariant.AsInteger(Inherited getValue)) write (inherited setValue(Value)); end; TW3FloatField = Class(TW3CustomDatasetField) public Property Value:Float read (TVariant.AsFloat(Inherited getValue)) write (inherited setValue(Value)); end; TW3StringField = Class(TW3CustomDatasetField) public Property Value:String read (TVariant.AsString(Inherited getValue)) write (inherited setValue(Value)); end; TW3DateTimeField = Class(TW3CustomDatasetField) protected function getValue:TDateTime;reintroduce; procedure setValue(const aValue:TDateTime);reintroduce; public Property Value:TDateTime read getValue write setValue; End; TW3DatasetFields = Class(TObject,IDatasetFieldsAccess) private FFields: Array of TW3CustomDatasetField; protected (* IMPLEMENTS:: IDatasetFieldsAccess *) Procedure ResetValues; Procedure setReadOnly(const aValue:Boolean); public Property Count:Integer read (FFields.count); Property Items[index:Integer]:TW3CustomDatasetField read (FFields[index]); function DataExport:TW3DatasetPacket;virtual; Procedure DataImport(const aValue:TW3DatasetPacket);virtual; function IndexOf(aName:String):Integer; function Add(aName:String; const aKind:TW3DatasetFieldType):TW3CustomDatasetField; Procedure DeleteByName(aName:String); Procedure Delete(const aIndex:Integer); Procedure Clear; function FieldByName(aName:String):TW3CustomDatasetField; Destructor Destroy;Override; End; TW3FieldDef = Class(Tobject) private FDatatype: TW3DatasetFieldType; FName: String; FReadOnly: Boolean; FParent: TW3FieldDefs; Procedure setType(const aValue:TW3DatasetFieldType); Procedure setName(const aName:String); protected Procedure setReadOnly(const aValue:Boolean); public Property Name:String read FName write setName; Property Datatype:TW3DatasetFieldType read FDatatype write setType; Constructor Create(Const aParent:TW3FieldDefs);virtual; End; TW3FieldDefs = Class(TObject,IFieldDefAccess) private FFields: Array of TW3FieldDef; FId: Integer; FReadOnly: Boolean; protected function getFieldIdentifier:String;virtual; Procedure SetReadOnly(Const aValue:Boolean); public Property ReadOnly:Boolean read FReadOnly; Property Fields[index:Integer]:TW3FieldDef read (FFields[index]);default; Property Count:Integer read (FFields.Count); function Add(aName:String; const aDataType:TW3DatasetFieldType):TW3FieldDef; function FieldByName(aName:String):TW3FieldDef; Function IndexOf(aName:String):Integer; Procedure Delete(const aIndex:Integer);overload; procedure Delete(const aItem:TW3FieldDef);overload; function SaveToString:String; Procedure LoadFromString(const aText:String); function toString:String;virtual; Procedure Clear; Destructor Destroy;Override; End; TDatasetStateChangeEvent = Procedure (sender:TObject;const aState:TW3DatasetState); TDatasetPositionChangeEvent = procedure (sender:TObject;aOldPos,aNewPos:Integer); TDatasetRecordDeleteEvent = Procedure (sender:TObject;const aRecNo:Integer); TW3CustomDataset = Class(TObject) private FFields: TW3DatasetFields; FDefs: TW3FieldDefs; FCache: Array of TW3DatasetPacket; FState: TW3DatasetState; FActive: Boolean; FDestroying:Boolean; FOnCreated: TNotifyEvent; FOnClosed: TNotifyEvent; FOnState: TDatasetStateChangeEvent; FOnPos: TDatasetPositionChangeEvent; FOnDelete: TDatasetRecordDeleteEvent; FDsIndex: Integer; Procedure UpdateCalculatedFields; procedure setActive(const aValue:Boolean); Procedure setPosition(const aNewPosition:Integer); protected Procedure DoBeforeDatasetCreated;virtual; Procedure DoAfterDatasetCreated;virtual; Procedure DoBeforeDatasetClosed;virtual; Procedure DoAfterDatasetClosed;virtual; function getRecCount:Integer;virtual; function getRecNo:Integer;virtual; function getEOF:Boolean;virtual; function getBOF:Boolean;virtual; procedure getPacketToFields;virtual; Procedure setPacketFromFields;virtual; procedure setState(const aState:TW3DatasetState); public Property Active:Boolean read FActive write setActive; Property State:TW3DatasetState read FState; Property Fields:TW3DatasetFields read FFields; Property FieldDefs:TW3FieldDefs read FDefs; Property EOF:Boolean read getEOF; Property BOF:Boolean read getBOF; Property Count:Integer read getRecCount; Property RecNo:Integer read getRecNo; // Save and Load to JSON format function SaveToString:String; Procedure LoadFromString(Const aText:String); Procedure Append; //Add record LAST always procedure Insert; //Add record at position Procedure Delete; //Delete record at position Procedure Post; //Complete insertion or update procedure Edit; //Edit record at position Procedure Next; //Navigate 1 step forward Procedure Back; //Navigate 1 step back Procedure First; //Navigate to first record Procedure Last; //Navigate to last record Procedure MoveTo(const aRecNo:Integer); //Navigate directly Procedure CreateDataset; Procedure Close; Procedure Cancel; class function Version:String; Constructor Create;virtual; Destructor Destroy;Override; published Property OnRecordDeleted:TDatasetRecordDeleteEvent read FOnDelete write FOnDelete; Property OnDatasetCreated:TNotifyEvent read FOnCreated write FOnCreated; Property OnDatasetClosed:TNotifyevent read FOnClosed write FOnClosed; Property OnStateChanged:TDatasetStateChangeEvent read FOnState write FOnState; Property OnPositionChanged:TDatasetPositionChangeEvent read FOnPos write FOnPos; end; {$IFDEF USE_DEVCODE} TW3MemoryDataset = class(TW3CustomDataset) private FCache: Array of TW3DatasetPacket; protected procedure getPacketToFields;override; Procedure setPacketFromFields;override; function getRecCount:Integer;override; Procedure DoBeforeDatasetClosed;override; End; {$ENDIF} TW3DataSource = Class(TObject) end; implementation const CNT_DATASET_MAJOR = 0; CNT_DATASET_MINOR = 1; resourcestring CNT_DATASET_FIELD_READONLY = 'Failed to alter value, field is read-only error'; CNT_DATASET_NOT_ACTIVE = 'Operation failed, dataset is not active error'; CNT_DATASET_INVALID_STATE = 'Invalid state for operation error'; CNT_DATASET_FIELD_UNKNOWN = 'Failed to match field class for datatype error'; CNT_DATASET_FIELDEF_LIVE = 'Field definition cannot be altered in a live dataset error'; //############################################################################# // Internal records used for storage etc. //############################################################################# type TW3FieldDefData = Record fdName: String; fdDatatype: TW3DatasetFieldType; End; TW3FieldDefHeader = Record ddMagic: Integer; ddDefs: Array of TW3FieldDefData; End; TW3DatasetHeader = Record dhMagic: Integer; dhCount: Integer; dhFieldDefs: String; dhData: String; End; //############################################################################# // TW3GUID //############################################################################# // http://www.ietf.org/rfc/rfc4122.txt class function TW3GUID.CreateGUID:String; Begin asm var s = []; var hexDigits = "0123456789abcdef"; for (var i = 0; i < 36; i++) { s[i] = hexDigits.substr(Math.floor(Math.random() * 0x10), 1); } s[14] = "4"; s[19] = hexDigits.substr((s[19] & 0x3) | 0x8, 1); s[8] = s[13] = s[18] = s[23] = "-"; @result = s.join(""); end; result:=uppercase(result); end; //############################################################################# // TW3MemoryDataset //############################################################################# {$IFDEF USE_DEVCODE} procedure TW3MemoryDataset.getPacketToFields; Begin if (RecNo>=0) and (RecNo<FCache.Length) then Fields.DataImport(FCache[RecNo]); end; Procedure TW3MemoryDataset.setPacketFromFields; Begin if (RecNo>=0) and (RecNo<FCache.Length) then FCache[RecNo]:=Fields.DataExport; end; function TW3MemoryDataset.getRecCount:Integer; Begin result:=FCache.Count; end; Procedure TW3MemoryDataset.DoBeforeDatasetClosed; Begin FCache.Clear; inherited; end; {$ENDIF} //############################################################################# // TW3FieldDefs //############################################################################# Destructor TW3FieldDefs.Destroy; begin if FFields.Count>0 then Clear; inherited; end; Procedure TW3FieldDefs.clear; var x: Integer; begin if FFields.Count>0 then Begin try for x:=FFields.low to FFields.high do FFields[x].free; finally FFields.clear; end; end; end; function TW3FieldDefs.getFieldIdentifier:String; Begin repeat inc(FId); result:='Field' + FId.toString; until IndexOf(result)<0; end; Procedure TW3FieldDefs.SetReadOnly(Const aValue:Boolean); var mItem: TW3FieldDef; Begin FReadOnly:=aValue; if FFields.length>0 then for mItem in FFields do mItem.setReadOnly(aValue); end; function TW3FieldDefs.Add(aName:String; const aDataType:TW3DatasetFieldType):TW3FieldDef; Begin result:=NIL; if not FReadOnly then begin aName:=trim(lowercase(aName)); if aName.length>0 then Begin if indexOf(aName)<0 then Begin result:=TW3FieldDef.Create(self); result.name:=aName; result.datatype:=aDataType; FFields.add(result); end else raise EW3FieldDefs.Create('A field with that name already exists error'); end else raise EW3FieldDefs.create('Failed to add field definition, invalid name error'); end else raise EW3FieldDefs.create(CNT_DATASET_FIELDEF_LIVE); end; function TW3FieldDefs.FieldByName(aName:String):TW3FieldDef; var x: Integer; Begin result:=NIL; if FFields.Length>0 then begin aName:=lowercase(trim(aName)); if length(aName)>0 then begin for x:=FFields.low to FFields.high do Begin if aName = lowercase(FFields[x].name) then begin result:=FFields[x]; break; end; end; end; end; end; Function TW3FieldDefs.IndexOf(aName:String):Integer; var x: Integer; Begin result:=-1; if FFields.Length>0 then begin aName:=lowercase(trim(aName)); if length(aName)>0 then begin for x:=FFields.low to FFields.high do Begin if aName = lowercase(FFields[x].name) then begin result:=x; break; end; end; end; end; end; Procedure TW3FieldDefs.Delete(const aIndex:Integer); Begin if not FReadOnly then begin If (aIndex>=0) and (aIndex<FFields.length) then Begin FFields[aIndex].free; FFields.Delete(aIndex,1); end; end else raise EW3FieldDefs.create(CNT_DATASET_FIELDEF_LIVE); end; procedure TW3FieldDefs.Delete(const aItem:TW3FieldDef); Begin if aItem<>NIL then Delete(IndexOf(aItem.Name)) else raise EW3FieldDefs.create('Delete operation failed, reference was NIL error'); end; function TW3FieldDefs.SaveToString:String; var x: Integer; mHead: TW3FieldDefHeader; Begin mHead.ddMagic:=$BABE; if FFields.Count>0 then Begin mHead.ddDefs.SetLength(FFields.Count); for x:=FFields.low to FFields.high do Begin mHead.ddDefs[x].fdDatatype:=FFields[x].dataType; mHead.ddDefs[x].fdName:=FFields[x].Name; end; end; asm @result = JSON.stringify(@mHead); end; end; Procedure TW3FieldDefs.LoadFromString(Const aText:String); var mHead: TW3FieldDefHeader; x: Integer; Begin Clear; try asm @mHead = JSON.parse(@aText); end; except On e: exception do Raise EW3FieldDefs.CreateFmt ('Failed to load field-definitions, system threw exception: %s',[e.message]); end; if mHead.ddMagic=$BABE then Begin if mHead.ddDefs.count>0 then begin for x:=mHead.ddDefs.low to mHead.ddDefs.high do Add(mHead.ddDefs[x].fdName,mHead.ddDefs[x].fdDatatype); end; end else Raise EW3FieldDefs.Create('Failed to load field-definitions, invalid header signature error'); end; function TW3FieldDefs.toString:String; var x: Integer; Begin if FFields.Count>0 then Begin for x:=FFields.low to FFields.high do Begin result+='Name=' + '"' + FFields[x].Name + '"' + ' Datatype='; case FFields[x].Datatype of ftUnknown: result+='Unknown'; ftBoolean: result+='Boolean'; ftInteger: result+='Integer'; ftFloat: result+='Float'; ftString: result+='String'; ftDateTime: result+='DateTime'; ftAutoInc: result+='AutoInc'; ftGUID: result+='GUID'; end; result:=result + #13; end; end; end; //############################################################################# // TW3FieldDef //############################################################################# Constructor TW3FieldDef.Create(Const aParent:TW3FieldDefs); Begin inherited Create; if aParent<>NIL then begin FParent:=aParent; FName:=(FParent as IFieldDefAccess).getFieldIdentifier; end; end; Procedure TW3FieldDef.setReadOnly(const aValue:Boolean); Begin FReadOnly:=aValue; end; Procedure TW3FieldDef.setType(const aValue:TW3DatasetFieldType); begin if not FReadOnly then FDatatype:=aValue; end; Procedure TW3FieldDef.setName(const aName:String); Begin if not FReadOnly then Begin FName:=aName; end; end; //############################################################################# // TW3CustomDataset //############################################################################# Constructor TW3CustomDataset.Create; Begin inherited Create; FFields:=TW3DatasetFields.Create; FDefs:=TW3FieldDefs.Create; FState:=dsIdle; FDestroying:=False; FDsIndex:=-1; end; Destructor TW3CustomDataset.Destroy; Begin FDestroying:=true; if FActive then Close; FFields.free; FDefs.free; inherited; end; Class function TW3CustomDataset.Version:String; Begin result:=IntToStr(CNT_DATASET_MAJOR) + '.' + IntToStr(CNT_DATASET_MINOR); end; Function TW3CustomDataset.saveToString:String; var mHead: TW3DatasetHeader; Begin if FActive then Begin try (* Setup the header *) mHead.dhMagic:=$CAFE; mHead.dhCount:=getRecCount; (* Serialize and store field-defs *) mHead.dhFieldDefs:=EncodeURI(FDefs.SaveToString); (* Serialize and store dataset records *) asm (@mHead).dhData = JSON.stringify((@self).FCache); end; (* Now serialize and return text representation of data structure *) asm @result = JSON.stringify(@mHead); end; except on e: exception do raise EW3Dataset.CreateFmt ('Failed to store dataset, system threw exception: %s',[e.message]); end; end; end; Procedure TW3CustomDataset.LoadFromString(Const aText:String); var mHead: TW3DatasetHeader; Begin (* If the dataset is active, close it down *) if FActive then Close; (* Check source string *) if aText.Length>0 then Begin (* Attempt to de-serialize JSON data *) try asm @mHead = JSON.parse(@aText); end; except on e: exception do Raise EW3Dataset.CreateFmt ('Failed to load dataset, system threw exception: %s',[e.message]); end; (* Verify header *) if mHead.dhMagic=$CAFE then Begin (* Load DEFS if any *) if mHead.dhFieldDefs.Length>0 then FDefs.LoadFromString(DecodeURI(mHead.dhFieldDefs)); (* Any actual rows? ok, try to load them *) if mHead.dhCount>0 then Begin try asm (@self).FCache = JSON.parse((@mHead).dhData); end; except on e: exception do Raise EW3Dataset.CreateFmt ('Failed to load dataset, system threw exception: %s',[e.message]); end; end; end else Raise EW3Dataset.Create('Failed to load dataset, invalid header signature error'); end else Raise EW3Dataset.Create('Failed to load dataset, string was empty error'); end; Procedure TW3CustomDataset.CreateDataset; Procedure SetupFields; var x: Integer; begin for x:=0 to FDefs.Count-1 do FFields.add(FDefs[x].Name,FDefs[x].Datatype); end; Begin if not FActive then Begin if FDefs.Count>0 then Begin (* Clear any fields if the user has added some. All fields are created from filed-defs *) FFields.Clear; DoBeforeDatasetCreated; try FActive:=True; setState(dsIdle); setPosition(-1); (* Import table schema to field construct *) SetupFields; (* Lock fields & defs, read/write access to defined structure only. No alteration while the dataset is "live" *) (FFields as IDatasetFieldsAccess).setReadOnly(true); (FDefs as IFieldDefAccess).setReadOnly(true); finally DoAfterDatasetCreated; end; end else Raise EW3Dataset.Create('No field definitions for dataset error'); end; end; Procedure TW3CustomDataset.Close; begin if FActive then Begin DoBeforeDatasetClosed; try try FFields.Clear; FCache.Clear; finally FActive:=False; FState:=dsIdle; FDsIndex:=-1; (FFields as IDatasetFieldsAccess).resetValues; (FFields as IDatasetFieldsAccess).setReadOnly(False); (FDefs as IFieldDefAccess).setReadOnly(False); end; finally DoAfterDatasetClosed; end; end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; procedure TW3CustomDataset.setState(const aState:TW3DatasetState); Begin FState:=aState; if assigned(FOnState) then FOnState(self,aState); end; Procedure TW3CustomDataset.getPacketToFields; Begin if (FdsIndex>=0) and (FdsIndex<FCache.Length) then FFields.DataImport(FCache[FdsIndex]); end; Procedure TW3CustomDataset.setPacketFromFields; Begin if (FdsIndex>=0) and (FdsIndex<FCache.Length) then FCache[FDsIndex]:=FFields.DataExport; end; Procedure TW3CustomDataset.setPosition(const aNewPosition:Integer); var mOld: Integer; Begin if aNewPosition<>FdsIndex then begin mOld:=FdsIndex; FDsIndex:=aNewPosition; if not (FState=dsInsert) then Begin if (FdsIndex>=0) and (FdsIndex<getRecCount) then getPacketToFields; end; if assigned(FOnPos) then FOnPos(self,mOld,aNewPosition); end; end; procedure TW3CustomDataset.setActive(const aValue:Boolean); Begin if aValue<>FActive then begin Case aValue of true: CreateDataset; false: Close; end; end; end; Procedure TW3CustomDataset.UpdateCalculatedFields; var x: Integer; Begin for x:=0 to FFields.Count-1 do if FFields.Items[x].calculated then FFields.items[x].Calculate; end; Procedure TW3CustomDataset.Append; Begin if FActive then Begin if FState=dsIdle then Begin //Actual items + 1 self.setPosition(FCache.Count); //Last; setState(dsInsert); (FFields as IDatasetFieldsAccess).resetValues; UpdateCalculatedFields; end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; procedure TW3CustomDataset.Insert; Begin if FActive then Begin if FState=dsIdle then Begin if (RecNo<0) then setPosition(FCache.Count); setState(dsInsert); (FFields as IDatasetFieldsAccess).resetValues; UpdateCalculatedFields; end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; procedure TW3CustomDataset.Edit; Begin if FActive then Begin if FState=dsIdle then Begin if FCache.Length>0 then Begin if (FdsIndex=-1) then self.setPosition(0) else if (FdsIndex=FCache.length) then setPosition(FCache.length-1); setState(dsEdit); UpdateCalculatedFields; end; end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.Delete; Begin if FActive then Begin if FState=dsIdle then begin if Count>0 then Begin if (FdsIndex>=0) and (FdsIndex<FCache.count) then Begin (* Signal satan that his work is done *) if assigned(FOnDelete) then FOnDelete(self,FdsIndex); (* Delete record *) FCache.Delete(FdsIndex,1); (* Misaligned recno? Backtrack. This will fall back to -1, which is BOF, when the last record is deleted *) if FdsIndex>=FCache.Count then FdsIndex:=FCache.Count-1; end else raise EW3Dataset.CreateFmt('Delete failed, misaligned RecNo [%s]',[FdsIndex]); end else Raise EW3Dataset.Create('Delete failed, dataset is empty error'); end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.Cancel; Begin if FActive then begin if (FState=dsInsert) or (FState=dsEdit) then begin setState(dsIdle); (FFields as IDatasetFieldsAccess).resetValues; end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.Post; var mDummy: TW3DatasetPacket; Begin if FActive then Begin Case FState of dsInsert: Begin (* Grow the internal cache *) if FdsIndex=getRecCount then Begin (* Insert at end of Dataset (a.k.a "Append") *) FCache.Add(mDummy); FdsIndex:=FCache.Length-1; end else (* insert "directly" at position *) FCache.Insert(FDsIndex,mDummy); (* Write data to record pointer *) setPacketFromFields; (* position record PTR on last record *) //setPosition(FCache.Count-1); (* set state to idle *) setState(dsIdle); end; dsEdit: begin setPacketFromFields; setState(dsIdle); end; else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end; end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.First; var mpos: Integer; Begin if FActive then begin if FState=dsIdle then Begin if getRecCount>0 then mPos:=0 else mpos:=-1; setPosition(mPos); end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.Last; var mpos: Integer; Begin if FActive then begin if FState=dsIdle then Begin if getRecCount>0 then mPos:=getRecCount-1 else mpos:=-1; setPosition(mPos); end else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.Next; Begin if FActive then Begin if FState=dsIdle then setPosition(TInteger.EnsureRange(FDsIndex+1,-1,getRecCount)) else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.Back; Begin if FActive then Begin if FState=dsIdle then setPosition(TInteger.EnsureRange(FDsIndex+1,-1,getRecCount)) else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.MoveTo(const aRecNo:Integer); Begin if FActive then Begin if FState=dsIdle then setPosition(TInteger.EnsureRange(aRecNo,0,getRecCount-1)) else raise EW3Dataset.Create(CNT_DATASET_INVALID_STATE); end else raise EW3Dataset.Create(CNT_DATASET_NOT_ACTIVE); end; Procedure TW3CustomDataset.DoBeforeDatasetCreated; Begin end; Procedure TW3CustomDataset.DoAfterDatasetCreated; Begin if assigned(FOnCreated) then Begin if not FDestroying then FOnCreated(self); end; end; Procedure TW3CustomDataset.DoBeforeDatasetClosed; Begin end; Procedure TW3CustomDataset.DoAfterDatasetClosed; Begin if assigned(FOnClosed) then Begin if not FDestroying then FOnClosed(self); end; end; function TW3CustomDataset.getRecCount:Integer; Begin result:=FCache.Count; end; function TW3CustomDataset.getRecNo:Integer; Begin if FActive then result:=FDsIndex else result:=-1; end; function TW3CustomDataset.getEOF:Boolean; Begin if FActive then result:=FDsIndex>=getRecCount else result:=True; end; function TW3CustomDataset.getBOF:Boolean; Begin if FActive then result:=FDsIndex<=0 else result:=True; end; //############################################################################# // TW3DatasetFields //############################################################################# Destructor TW3DatasetFields.Destroy; Begin Clear; inherited; end; Procedure TW3DatasetFields.setReadOnly(const aValue:Boolean); var x: Integer; begin if FFields.Length>0 then Begin for x:=FFields.Low to FFields.High do FFields[x].setReadOnly(aValue); end; end; Procedure TW3DatasetFields.ResetValues; var mItem: TW3CustomDatasetField; Begin if FFields.Length>0 then Begin for mItem in FFields do mItem.setValue(null); end; end; Procedure TW3DatasetFields.Clear; var x: Integer; Begin if FFields.Count>0 then Begin try for x:=FFields.Low to FFields.High do FFields[x].free; finally FFields.Clear; end; end; end; Procedure TW3DatasetFields.DeleteByName(aName:String); var mIndex: Integer; Begin mIndex:=IndexOf(aName); if mIndex>=0 then Begin FFields[mIndex].free; FFields.Delete(mIndex,1); end; end; Procedure TW3DatasetFields.Delete(const aIndex:Integer); Begin if (aIndex>=0) and (aIndex<FFields.Count) then Begin FFields[aIndex].free; FFields.Delete(aIndex,1); end; end; function TW3DatasetFields.Add(aName:String; const aKind:TW3DatasetFieldType):TW3CustomDatasetField; Begin result:=NIL; aName:=lowercase(trim(aName)); if aName.Length>0 then Begin if IndexOf(aName)=-1 then Begin case aKind of ftBoolean: result:=TW3BooleanField.Create(self); ftInteger: result:=TW3IntegerField.Create(self); ftFloat: result:=TW3FloatField.Create(self); ftString: result:=TW3StringField.Create(self); ftDateTime: result:=TW3DateTimeField.Create(self); ftAutoInc: result:=TW3AutoIncField.Create(self); ftGUID: result:=TW3GUIDField.Create(self); else result:=NIL; end; if result<>NIL then Begin result.Name:=aName; FFields.add(result); end else Raise EW3DatasetField.Create(CNT_DATASET_FIELD_UNKNOWN); end; end; end; function TW3DatasetFields.DataExport:TW3DatasetPacket; var x: Integer; mField:TW3CustomDatasetField; Begin result:=TVariant.CreateObject; if FFields.count>0 then Begin for mField in FFields do result[mField.Name]:=mField.getValue; end; end; Procedure TW3DatasetFields.DataImport(const aValue:TW3DatasetPacket); var mField:TW3CustomDatasetField; Begin if FFields.count>0 then Begin for mField in FFields do mField.setvalue(aValue[mField.Name]); end; end; function TW3DatasetFields.IndexOf(aName:String):Integer; var x: Integer; Begin result:=-1; aName:=lowercase(trim(aName)); if aName.Length>0 then Begin for x:=FFields.Low to FFIelds.High do Begin If FFIelds[x].Name=aName then Begin result:=x; break; end; end; end; end; function TW3DatasetFields.FieldByName(aName:String):TW3CustomDatasetField; var x: Integer; Begin result:=NIL; aName:=lowercase(trim(aName)); if aName.Length>0 then Begin for x:=FFields.Low to FFields.High do Begin If FFields[x].Name=aName then Begin result:=FFields[x]; break; end; end; end; end; //############################################################################# // TW3GUIDField //############################################################################# function TW3GUIDField.getCalculated:Boolean; Begin result:=true; end; Procedure TW3GUIDField.Calculate; Begin inherited setValue(uppercase(TW3GUID.createGUID)); end; //############################################################################# // TW3AutoIncField //############################################################################# function TW3AutoIncField.getCalculated:Boolean; Begin result:=true; end; Procedure TW3AutoIncField.Calculate; Begin inc(FCalc); inherited setValue(FCalc); end; //############################################################################# // TW3DateTimeField //############################################################################# function TW3DateTimeField.getValue:TDateTime; Begin result:=inherited getValue; end; procedure TW3DateTimeField.setValue(const aValue:TDateTime); Begin inherited setValue(aValue); end; //############################################################################# // TW3CustomDatasetField //############################################################################# Constructor TW3CustomDatasetField.Create(const aParent:TW3DatasetFields); Begin inherited Create; FParent:=aParent; FKind:=ftUnknown; FName:='Field' + IntToStr( w3_GetUniqueNumber ); end; Procedure TW3CustomDatasetField.setAsDateTime(const aValue:TDateTime); Begin FValue:=aValue; end; function TW3CustomDatasetField.getAsDateTime:TDateTime; Begin result:=FValue; end; Procedure TW3CustomDatasetField.Calculate; Begin end; function TW3CustomDatasetField.getCalculated:Boolean; Begin result:=False; end; function TW3CustomDatasetField.getValue:Variant; Begin result:=FValue; end; procedure TW3CustomDatasetField.setValue(const aValue:variant); Begin FValue:=aValue; end; procedure TW3CustomDatasetField.setName(const aValue:String); Begin if not FReadOnly then FName:=lowercase(trim(aValue)) else Raise EW3DatasetField.Create(CNT_DATASET_FIELD_READONLY); end; procedure TW3CustomDatasetField.setKind(const aKind:TW3DatasetFieldType); Begin if not FReadOnly then FKind:=aKind else Raise EW3DatasetField.Create(CNT_DATASET_FIELD_READONLY); end; Procedure TW3CustomDatasetField.setReadOnly(const aValue:Boolean); Begin FReadOnly:=aValue; end; end.
Recent
The vatican vault
- December 2022
- October 2022
- January 2022
- October 2021
- March 2021
- November 2020
- September 2020
- July 2020
- June 2020
- April 2020
- March 2020
- February 2020
- January 2020
- November 2019
- October 2019
- September 2019
- August 2019
- July 2019
- June 2019
- May 2019
- April 2019
- March 2019
- February 2019
- January 2019
- December 2018
- November 2018
- October 2018
- September 2018
- August 2018
- July 2018
- June 2018
- May 2018
- April 2018
- March 2018
- February 2018
- January 2018
- December 2017
- November 2017
- October 2017
- August 2017
- July 2017
- June 2017
- May 2017
- April 2017
- March 2017
- February 2017
- January 2017
- December 2016
- November 2016
- October 2016
- September 2016
- August 2016
- July 2016
- June 2016
- May 2016
- April 2016
- March 2016
- January 2016
- December 2015
- November 2015
- October 2015
- September 2015
- August 2015
- June 2015
- May 2015
- April 2015
- March 2015
- February 2015
- January 2015
- December 2014
- November 2014
- October 2014
- September 2014
- August 2014
- July 2014
- June 2014
- May 2014
- April 2014
- March 2014
- February 2014
- January 2014
- December 2013
- November 2013
- October 2013
- September 2013
- August 2013
- July 2013
- June 2013
- May 2013
- February 2013
- August 2012
- June 2012
- May 2012
- April 2012
You must be logged in to post a comment.