From 698d59733364de838764996420af67c6e48ebb09 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 3 Jul 2016 22:56:59 +0000 Subject: [PATCH] tvplanit: New property UseAutoIncFields for TVpBufDSDatasource. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4906 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/bufdsdatastore/unit1.lfm | 16 ++++ components/tvplanit/source/vpbufds.pas | 76 +++++++++++++++++-- components/tvplanit/source/vpdbds.pas | 5 +- 3 files changed, 87 insertions(+), 10 deletions(-) diff --git a/components/tvplanit/examples/bufdsdatastore/unit1.lfm b/components/tvplanit/examples/bufdsdatastore/unit1.lfm index e7c20498d..4f4853c4c 100644 --- a/components/tvplanit/examples/bufdsdatastore/unit1.lfm +++ b/components/tvplanit/examples/bufdsdatastore/unit1.lfm @@ -66,6 +66,8 @@ object Form1: TForm1 DataStore = VpBufDSDataStore1 ControlLink = VpControlLink1 Color = clWindow + Font.Height = -12 + ParentFont = False Align = alLeft ReadOnly = False TabStop = True @@ -73,6 +75,7 @@ object Form1: TForm1 AllDayEventAttributes.BackgroundColor = clBtnShadow AllDayEventAttributes.EventBorderColor = cl3DDkShadow AllDayEventAttributes.EventBackgroundColor = clBtnFace + AllDayEventAttributes.Font.Height = -12 ShowEventTimes = False DrawingStyle = dsFlat TimeSlotColors.Active = clWhite @@ -114,9 +117,12 @@ object Form1: TForm1 DataStore = VpBufDSDataStore1 ControlLink = VpControlLink1 Color = clWindow + Font.Height = -12 + ParentFont = False AllDayEventAttributes.BackgroundColor = clWindow AllDayEventAttributes.EventBorderColor = clGray AllDayEventAttributes.EventBackgroundColor = clBtnFace + AllDayEventAttributes.Font.Height = -12 DateLabelFormat = 'dddd, mmmm dd, yyyy' DayHeadAttributes.Color = clBtnFace DayHeadAttributes.DateFormat = 'dddd mmmm, dd' @@ -124,6 +130,8 @@ object Form1: TForm1 DayHeadAttributes.Font.Name = 'Tahoma' DayHeadAttributes.Bordered = True DrawingStyle = dsFlat + EventFont.Height = -12 + HeadAttributes.Font.Height = -12 HeadAttributes.Color = clBtnFace LineColor = clGray TimeFormat = tf12Hour @@ -141,6 +149,8 @@ object Form1: TForm1 DataStore = VpBufDSDataStore1 ControlLink = VpControlLink1 Color = clWindow + Font.Height = -12 + ParentFont = False Align = alBottom TabStop = True TabOrder = 1 @@ -150,8 +160,10 @@ object Form1: TForm1 DayHeadAttributes.Font.Height = -13 DayHeadAttributes.Font.Name = 'Tahoma' DayNameStyle = dsShort + DayNumberFont.Height = -12 DrawingStyle = dsFlat EventDayStyle = [] + EventFont.Height = -12 LineColor = clGray TimeFormat = tf12Hour OffDayColor = clSilver @@ -178,6 +190,8 @@ object Form1: TForm1 DataStore = VpBufDSDataStore1 ControlLink = VpControlLink1 Color = clWindow + Font.Height = -12 + ParentFont = False Align = alClient TabStop = True TabOrder = 2 @@ -195,6 +209,7 @@ object Form1: TForm1 LineColor = clGray MaxVisibleTasks = 250 TaskHeadAttributes.Color = clSilver + TaskHeadAttributes.Font.Height = -12 DrawingStyle = dsFlat ShowResourceName = True end @@ -296,6 +311,7 @@ object Form1: TForm1 PlayEventSounds = True AutoConnect = True AutoCreate = True + UseAutoIncFields = False left = 136 top = 192 end diff --git a/components/tvplanit/source/vpbufds.pas b/components/tvplanit/source/vpbufds.pas index 089c15499..950caa701 100644 --- a/components/tvplanit/source/vpbufds.pas +++ b/components/tvplanit/source/vpbufds.pas @@ -18,7 +18,9 @@ type FContactsTable: TBufDataset; FTasksTable: TBufDataset; FDirectory: String; + FUseAutoInc: Boolean; procedure SetDirectory(AValue: String); + procedure SetUseAutoInc(AValue: Boolean); protected { ancestor property getters } @@ -28,7 +30,6 @@ type function GetTasksTable: TDataset; override; { ancestor methods } - function GetNextID(TableName: string): integer; override; procedure Loaded; override; procedure SetConnected(const Value: boolean); override; @@ -36,11 +37,13 @@ type procedure CloseTables; procedure CreateTable(ATableName: String); procedure OpenTables; + function UniqueID(AValue: Integer): Boolean; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure CreateTables; + function GetNextID(TableName: string): Integer; override; property ResourceTable; property EventsTable; @@ -51,6 +54,7 @@ type property Directory: String read FDirectory write SetDirectory; property AutoConnect; property AutoCreate; + property UseAutoIncFields: Boolean read FUseAutoInc write SetUseAutoInc default true; end; @@ -58,7 +62,7 @@ implementation uses LazFileUtils, - VpConst, VpBaseDS; + VpConst, VpBaseDS, VpData; const TABLE_EXT = '.db'; @@ -70,6 +74,7 @@ begin FEventsTable := TBufDataset.Create(nil); FContactsTable := TBufDataset.Create(nil); FTasksTable := TBufDataset.Create(nil); + FUseAutoInc := true; end; destructor TVpBufDSDatastore.Destroy; @@ -122,7 +127,8 @@ begin if not FileExists(table.FileName) then begin CreateFieldDefs(ATableName, table.FieldDefs); - table.FieldDefs[0].DataType := ftAutoInc; + if FUseAutoInc then + table.FieldDefs[0].DataType := ftAutoInc; table.CreateDataset; end; table.IndexDefs.Clear; @@ -153,11 +159,18 @@ begin Result := FContactsTable; end; -function TVpBufDSDataStore.GetNextID(TableName: string): integer; +function TVpBufDSDatastore.GetNextID(TableName: string): Integer; begin - { This is not needed in the BufDataset datastore as these tables use - autoincrement fields. } - result := -1; + if FUseAutoInc then + { This is not needed in the BufDataset datastore as these tables use + autoincrement fields. } + Result := -1 + else + { If autoincrement fields are not wanted the ID values are created from + random numbers. } + repeat + Result := Random(High(Integer)); + until UniqueID(Result) and (Result <> -1); end; function TVpBufDSDatastore.GetTasksTable : TDataset; @@ -208,5 +221,54 @@ begin FDirectory := AValue; end; +procedure TVpBufDSDatastore.SetUseAutoInc(AValue: Boolean); +var + dir: String; + table: TBufDataset; +begin + if AValue = FUseAutoInc then + exit; + + if ComponentState = [] then begin + if FDirectory = '' then + dir := ExtractFilePath(ParamStr(0)) else + dir := IncludeTrailingPathDelimiter(FDirectory); + dir := ExpandFileName(dir); + if DirectoryExistsUTF8(dir) then + begin + if FileExists(dir + ResourceTableName + TABLE_EXT) or + FileExists(dir + EventsTableName + TABLE_EXT) or + FileExists(dir + ContactsTableName + TABLE_EXT) or + FileExists(dir + TasksTableName + TABLE_EXT) + then + raise Exception.Create('You cannot change the property "UseAutoIncFields" after creation of the tables.'); + end; + end; + + FUseAutoInc := AValue; +end; + +function TVpBufDSDatastore.UniqueID(AValue: Integer): Boolean; +var + i, j: Integer; + res: TVpResource; +begin + Result := false; + for i:=0 to Resources.Count-1 do begin + res := Resources.Items[i]; + if res.ResourceID = AValue then + exit; + for j:=0 to res.Contacts.Count-1 do + if res.Contacts.GetContact(j).RecordID = AValue then + exit; + for j:=0 to res.Tasks.Count-1 do + if res.Tasks.GetTask(j).RecordID = AValue then + exit; + for j:=0 to res.Schedule.EventCount-1 do + if res.Schedule.GetEvent(j).RecordID = AValue then + exit; + end; + Result := true; +end; end. diff --git a/components/tvplanit/source/vpdbds.pas b/components/tvplanit/source/vpdbds.pas index 2fd277a9a..592936a39 100644 --- a/components/tvplanit/source/vpdbds.pas +++ b/components/tvplanit/source/vpdbds.pas @@ -1372,7 +1372,7 @@ begin end; try { if a particular descendant datastore uses autoincrementing } - { RecordID fields, then don't overwrite them here. } + { RecordID fields, then don't overwrite them here. } if Event.RecordID <> -1 then EventsTable.FieldByName('RecordID').AsInteger := Event.RecordID; @@ -1473,8 +1473,7 @@ begin { this event already exists in the database so update it } TasksTable.Edit else - { this record doesn't exist in the database, so } - { it's a new event } + { this record doesn't exist in the database, so it's a new event } TasksTable.Append; try TasksTable.FieldByName('ResourceID').AsInteger := Resource.ResourceID;