diff --git a/components/tvplanit/examples/datastores/fb/project1.lpi b/components/tvplanit/examples/datastores/fb/project1.lpi
new file mode 100644
index 000000000..2d81d24bd
--- /dev/null
+++ b/components/tvplanit/examples/datastores/fb/project1.lpi
@@ -0,0 +1,84 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/tvplanit/examples/datastores/fb/project1.lpr b/components/tvplanit/examples/datastores/fb/project1.lpr
new file mode 100644
index 000000000..cbaf9b146
--- /dev/null
+++ b/components/tvplanit/examples/datastores/fb/project1.lpr
@@ -0,0 +1,20 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, Unit1, laz_visualplanit;
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/tvplanit/examples/datastores/fb/readme.txt b/components/tvplanit/examples/datastores/fb/readme.txt
new file mode 100644
index 000000000..fa019e022
--- /dev/null
+++ b/components/tvplanit/examples/datastores/fb/readme.txt
@@ -0,0 +1,7 @@
+This demo shows how a Firebird database can be used for VisualPlanIt. It
+takes advantage of the prebuilt TVpFirefordDatastore.
+
+NOTE:
+The project creates a new database on the fly. For reasons unknown at the moment,
+an exception is raised here if started from the IDE. This does not happen any
+more once the database exists.
diff --git a/components/tvplanit/examples/datastores/fb/unit1.lfm b/components/tvplanit/examples/datastores/fb/unit1.lfm
new file mode 100644
index 000000000..141e4755a
--- /dev/null
+++ b/components/tvplanit/examples/datastores/fb/unit1.lfm
@@ -0,0 +1,333 @@
+object Form1: TForm1
+ Left = 225
+ Height = 686
+ Top = 155
+ Width = 980
+ Caption = 'Form1'
+ ClientHeight = 686
+ ClientWidth = 980
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ LCLVersion = '1.7'
+ object Panel1: TPanel
+ Left = 0
+ Height = 34
+ Top = 0
+ Width = 980
+ Align = alTop
+ BevelOuter = bvNone
+ ClientHeight = 34
+ ClientWidth = 980
+ TabOrder = 0
+ object VpResourceCombo1: TVpResourceCombo
+ Left = 8
+ Height = 23
+ Top = 5
+ Width = 208
+ DataStore = VpFirebirdDatastore1
+ Style = csDropDownList
+ end
+ object BtnNewRes: TButton
+ Left = 222
+ Height = 25
+ Top = 4
+ Width = 99
+ Caption = 'New resource'
+ OnClick = BtnNewResClick
+ TabOrder = 1
+ end
+ object BtnEditRes: TButton
+ Left = 328
+ Height = 25
+ Top = 4
+ Width = 96
+ Caption = 'Edit resource'
+ OnClick = BtnEditResClick
+ TabOrder = 2
+ end
+ end
+ object PageControl1: TPageControl
+ Left = 0
+ Height = 652
+ Top = 34
+ Width = 980
+ ActivePage = TabSheet1
+ Align = alClient
+ TabIndex = 0
+ TabOrder = 1
+ object TabSheet1: TTabSheet
+ Caption = 'Events and tasks'
+ ClientHeight = 624
+ ClientWidth = 972
+ object VpDayView1: TVpDayView
+ Left = 0
+ Height = 624
+ Top = 0
+ Width = 301
+ DataStore = VpFirebirdDatastore1
+ ControlLink = VpControlLink1
+ Color = clWindow
+ Align = alLeft
+ ReadOnly = False
+ TabStop = True
+ TabOrder = 0
+ AllDayEventAttributes.BackgroundColor = clBtnShadow
+ AllDayEventAttributes.EventBorderColor = cl3DDkShadow
+ AllDayEventAttributes.EventBackgroundColor = clBtnFace
+ ShowEventTimes = False
+ DrawingStyle = dsFlat
+ TimeSlotColors.Active = clWhite
+ TimeSlotColors.Inactive = 8454143
+ TimeSlotColors.Holiday = 16744703
+ TimeSlotColors.Weekday = clWhite
+ TimeSlotColors.Weekend = 16777088
+ TimeSlotColors.ActiveRange.RangeBegin = h_00
+ TimeSlotColors.ActiveRange.RangeEnd = h_00
+ HeadAttributes.Font.Height = -13
+ HeadAttributes.Color = clBtnFace
+ RowHeadAttributes.HourFont.Height = -24
+ RowHeadAttributes.MinuteFont.Height = -12
+ RowHeadAttributes.Color = clBtnFace
+ ShowResourceName = True
+ LineColor = clGray
+ GutterWidth = 7
+ DateLabelFormat = 'dddd, mmmm dd, yyyy'
+ Granularity = gr30Min
+ DefaultTopHour = h_07
+ TimeFormat = tf12Hour
+ end
+ object Panel2: TPanel
+ Left = 306
+ Height = 624
+ Top = 0
+ Width = 386
+ Align = alLeft
+ BevelOuter = bvNone
+ Caption = 'Panel2'
+ ClientHeight = 624
+ ClientWidth = 386
+ TabOrder = 1
+ object VpWeekView1: TVpWeekView
+ Left = 0
+ Height = 378
+ Top = 0
+ Width = 386
+ DataStore = VpFirebirdDatastore1
+ ControlLink = VpControlLink1
+ Color = clWindow
+ AllDayEventAttributes.BackgroundColor = clWindow
+ AllDayEventAttributes.EventBorderColor = clGray
+ AllDayEventAttributes.EventBackgroundColor = clBtnFace
+ DateLabelFormat = 'dddd, mmmm dd, yyyy'
+ DayHeadAttributes.Color = clBtnFace
+ DayHeadAttributes.DateFormat = 'dddd mmmm, dd'
+ DayHeadAttributes.Font.Height = -13
+ DayHeadAttributes.Font.Name = 'Tahoma'
+ DayHeadAttributes.Bordered = True
+ DrawingStyle = dsFlat
+ HeadAttributes.Color = clBtnFace
+ LineColor = clGray
+ TimeFormat = tf12Hour
+ ShowEventTime = True
+ WeekStartsOn = dtMonday
+ Align = alClient
+ TabStop = True
+ TabOrder = 0
+ end
+ object VpMonthView1: TVpMonthView
+ Left = 0
+ Height = 241
+ Top = 383
+ Width = 386
+ DataStore = VpFirebirdDatastore1
+ ControlLink = VpControlLink1
+ Color = clWindow
+ Align = alBottom
+ TabStop = True
+ TabOrder = 1
+ KBNavigation = True
+ DateLabelFormat = 'mmmm yyyy'
+ DayHeadAttributes.Color = clBtnFace
+ DayHeadAttributes.Font.Height = -13
+ DayHeadAttributes.Font.Name = 'Tahoma'
+ DayNameStyle = dsShort
+ DrawingStyle = dsFlat
+ EventDayStyle = []
+ HeadAttributes.Color = clBtnFace
+ LineColor = clGray
+ TimeFormat = tf12Hour
+ TodayAttributes.Color = clSilver
+ TodayAttributes.BorderPen.Color = clRed
+ TodayAttributes.BorderPen.Width = 3
+ OffDayColor = clSilver
+ SelectedDayColor = clRed
+ ShowEvents = True
+ ShowEventTime = False
+ WeekStartsOn = dtSunday
+ end
+ object Splitter2: TSplitter
+ Cursor = crVSplit
+ Left = 0
+ Height = 5
+ Top = 378
+ Width = 386
+ Align = alBottom
+ ResizeAnchor = akBottom
+ end
+ end
+ object VpTaskList1: TVpTaskList
+ Left = 697
+ Height = 624
+ Top = 0
+ Width = 275
+ DataStore = VpFirebirdDatastore1
+ ControlLink = VpControlLink1
+ Color = clWindow
+ Align = alClient
+ TabStop = True
+ TabOrder = 2
+ ReadOnly = False
+ DisplayOptions.CheckBGColor = clWindow
+ DisplayOptions.CheckColor = cl3DDkShadow
+ DisplayOptions.CheckStyle = csCheck
+ DisplayOptions.DueDateFormat = 'dd.MM.yyyy'
+ DisplayOptions.ShowCompletedTasks = False
+ DisplayOptions.ShowAll = False
+ DisplayOptions.ShowDueDate = True
+ DisplayOptions.OverdueColor = clRed
+ DisplayOptions.NormalColor = clBlack
+ DisplayOptions.CompletedColor = clGray
+ LineColor = clGray
+ MaxVisibleTasks = 250
+ TaskHeadAttributes.Color = clSilver
+ DrawingStyle = dsFlat
+ ShowResourceName = True
+ end
+ object Splitter1: TSplitter
+ Left = 692
+ Height = 624
+ Top = 0
+ Width = 5
+ end
+ object Splitter3: TSplitter
+ Left = 301
+ Height = 624
+ Top = 0
+ Width = 5
+ end
+ end
+ object TabSheet2: TTabSheet
+ Caption = 'Contacts'
+ ClientHeight = 594
+ ClientWidth = 928
+ object VpContactButtonBar1: TVpContactButtonBar
+ Left = 0
+ Height = 594
+ Top = 0
+ Width = 40
+ DrawingStyle = dsFlat
+ RadioStyle = False
+ Align = alLeft
+ end
+ object VpContactGrid1: TVpContactGrid
+ Left = 40
+ Height = 594
+ Top = 0
+ Width = 888
+ DataStore = VpFirebirdDatastore1
+ ControlLink = VpControlLink1
+ Color = clWindow
+ Align = alClient
+ TabStop = True
+ TabOrder = 1
+ AllowInPlaceEditing = True
+ BarWidth = 3
+ BarColor = clSilver
+ ColumnWidth = 200
+ ContactHeadAttributes.Color = clSilver
+ ContactHeadAttributes.Bordered = True
+ DrawingStyle = dsFlat
+ end
+ end
+ end
+ object VpControlLink1: TVpControlLink
+ DataStore = VpFirebirdDatastore1
+ Printer.BottomMargin = 0
+ Printer.DayStart = h_08
+ Printer.DayEnd = h_05
+ Printer.Granularity = gr30Min
+ Printer.LeftMargin = 0
+ Printer.MarginUnits = imAbsolutePixel
+ Printer.PrintFormats = <>
+ Printer.RightMargin = 0
+ Printer.TopMargin = 0
+ left = 136
+ top = 264
+ end
+ object VpResourceEditDialog1: TVpResourceEditDialog
+ Version = 'v1.04'
+ DataStore = VpFirebirdDatastore1
+ Options = []
+ Placement.Position = mpCenter
+ Placement.Top = 10
+ Placement.Left = 10
+ Placement.Height = 250
+ Placement.Width = 400
+ left = 136
+ top = 335
+ end
+ object SQLTransaction1: TSQLTransaction
+ Active = False
+ Action = caCommit
+ Database = IBConnection1
+ Options = []
+ left = 256
+ top = 120
+ end
+ object VpFirebirdDatastore1: TVpFirebirdDatastore
+ CategoryColorMap.Category0.Color = clNavy
+ CategoryColorMap.Category0.Description = 'Category 0'
+ CategoryColorMap.Category1.Color = clRed
+ CategoryColorMap.Category1.Description = 'Category 1'
+ CategoryColorMap.Category2.Color = clYellow
+ CategoryColorMap.Category2.Description = 'Category 2'
+ CategoryColorMap.Category3.Color = clLime
+ CategoryColorMap.Category3.Description = 'Category 3'
+ CategoryColorMap.Category4.Color = clPurple
+ CategoryColorMap.Category4.Description = 'Category 4'
+ CategoryColorMap.Category5.Color = clTeal
+ CategoryColorMap.Category5.Description = 'Category 5'
+ CategoryColorMap.Category6.Color = clFuchsia
+ CategoryColorMap.Category6.Description = 'Category 6'
+ CategoryColorMap.Category7.Color = clOlive
+ CategoryColorMap.Category7.Description = 'Category 7'
+ CategoryColorMap.Category8.Color = clAqua
+ CategoryColorMap.Category8.Description = 'Category 8'
+ CategoryColorMap.Category9.Color = clMaroon
+ CategoryColorMap.Category9.Description = 'Category 9'
+ EnableEventTimer = True
+ PlayEventSounds = True
+ Connection = IBConnection1
+ AutoConnect = False
+ AutoCreate = True
+ DayBuffer = 31
+ left = 136
+ top = 200
+ end
+ object IBConnection1: TIBConnection
+ Connected = False
+ LoginPrompt = False
+ KeepConnection = True
+ Transaction = SQLTransaction1
+ Options = []
+ left = 136
+ top = 120
+ end
+ object SQLQuery1: TSQLQuery
+ FieldDefs = <>
+ Options = []
+ Params = <>
+ left = 149
+ top = 511
+ end
+end
diff --git a/components/tvplanit/examples/datastores/fb/unit1.pas b/components/tvplanit/examples/datastores/fb/unit1.pas
new file mode 100644
index 000000000..3a119f0fe
--- /dev/null
+++ b/components/tvplanit/examples/datastores/fb/unit1.pas
@@ -0,0 +1,116 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+ StdCtrls, ComCtrls, sqldb, IBConnection,
+ VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpContactGrid,
+ VpMonthView, VpResEditDlg, VpContactButtons, VpData, VpFBDS;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ BtnNewRes: TButton;
+ BtnEditRes: TButton;
+ IBConnection1: TIBConnection;
+ PageControl1: TPageControl;
+ Panel1: TPanel;
+ Panel2: TPanel;
+ Splitter1: TSplitter;
+ Splitter2: TSplitter;
+ Splitter3: TSplitter;
+ SQLQuery1: TSQLQuery;
+ SQLTransaction1: TSQLTransaction;
+ TabSheet1: TTabSheet;
+ TabSheet2: TTabSheet;
+ VpContactButtonBar1: TVpContactButtonBar;
+ VpContactGrid1: TVpContactGrid;
+ VpControlLink1: TVpControlLink;
+ VpDayView1: TVpDayView;
+ VpFirebirdDatastore1: TVpFirebirdDatastore;
+ VpMonthView1: TVpMonthView;
+ VpResourceCombo1: TVpResourceCombo;
+ VpResourceEditDialog1: TVpResourceEditDialog;
+ VpTaskList1: TVpTaskList;
+ VpWeekView1: TVpWeekView;
+ procedure BtnNewResClick(Sender: TObject);
+ procedure BtnEditResClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ LazFileUtils;
+
+const
+ DBFILENAME = 'data.fdb';
+
+{ TForm1 }
+
+// Adds a new resource
+procedure TForm1.BtnNewResClick(Sender: TObject);
+begin
+ VpResourceEditDialog1.AddNewResource;
+end;
+
+// Edits the currently selected resource
+procedure TForm1.BtnEditResClick(Sender: TObject);
+begin
+ // Open the resource editor dialog, everything is done here.
+ VpResourceEditDialog1.Execute;
+end;
+
+// Setting up the database connection and the datastore. Preselect a resource
+// in the resource combo.
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ try
+ IBConnection1.DatabaseName := AppendPathDelim(Application.Location) + DBFILENAME;
+ IBConnection1.Username := 'SYSDBA';
+ IBConnection1.Password := 'masterkey';
+
+// SQLTransaction1.Action := caCommitRetaining;
+
+ VpFirebirdDatastore1.Connection := IBConnection1;
+ VpFirebirdDatastore1.AutoCreate := true;
+ VpFirebirdDatastore1.CreateTables;
+
+
+ VpFirebirdDatastore1.Connected := true;
+
+ if VpFirebirdDatastore1.Resources.Count > 0 then
+ VpFirebirdDatastore1.ResourceID := VpFirebirdDatastore1.Resources.Items[0].ResourceID;
+
+ except
+ on E:Exception do
+ begin
+ MessageDlg('ERROR with Firebird installation:' + LineEnding + E.Message,
+ mtError, [mbOK], 0);
+ Close;
+ end;
+ end;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+ SQLTransaction1.Commit;
+end;
+
+end.
+
diff --git a/components/tvplanit/source/laz_visualplanit.lpk b/components/tvplanit/source/laz_visualplanit.lpk
index 6d0c441c2..b38c27405 100644
--- a/components/tvplanit/source/laz_visualplanit.lpk
+++ b/components/tvplanit/source/laz_visualplanit.lpk
@@ -30,7 +30,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S
Contributor(s): "/>
-
+
@@ -332,6 +332,10 @@ Contributor(s): "/>
+
+
+
+
diff --git a/components/tvplanit/source/vpfbds.pas b/components/tvplanit/source/vpfbds.pas
new file mode 100644
index 000000000..7e8acc7c4
--- /dev/null
+++ b/components/tvplanit/source/vpfbds.pas
@@ -0,0 +1,529 @@
+{$I vp.inc}
+
+{ A datastore for a Firebird database accessed via SQLDB }
+
+unit VpFBDS;
+
+interface
+
+uses
+ SysUtils, Classes, DB,
+ VpBaseDS, VpDBDS,
+ IBConnection, sqldb;
+
+type
+ TVpFirebirdDatastore = class(TVpCustomDBDatastore)
+ private
+ FConnection: TIBConnection;
+ FContactsTable: TSQLQuery;
+ FEventsTable: TSQLQuery;
+ FResourceTable: TSQLQuery;
+ FTasksTable: TSQLQuery;
+ FConnectLock: Integer;
+ procedure SetConnection(const AValue: TIBConnection);
+
+ protected
+ procedure CreateAllTables(dbIsNew: Boolean);
+ procedure CreateTable(const ATableName: String);
+ function GetContactsTable: TDataset; override;
+ function GetEventsTable: TDataset; override;
+ function GetResourceTable: TDataset; override;
+ function GetTasksTable: TDataset; override;
+ procedure Loaded; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure OpenTables;
+ procedure SetConnected(const AValue: Boolean); override;
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure CreateTables;
+ function GetNextID(TableName: string): integer; override;
+ procedure PostEvents; override;
+ procedure PostContacts; override;
+ procedure PostTasks; override;
+ procedure PostResources; override;
+
+ property ResourceTable;
+ property EventsTable;
+ property ContactsTable;
+ property TasksTable;
+
+ published
+ property Connection: TIBConnection read FConnection write SetConnection;
+
+ // inherited
+ property AutoConnect;
+ property AutoCreate;
+ property DayBuffer;
+ end;
+
+
+implementation
+
+uses
+ LazFileUtils,
+ VpConst, VpException, VpMisc, VpData;
+
+{ TVpIBDatastore }
+
+constructor TVpFirebirdDatastore.Create(AOwner: TComponent);
+begin
+ inherited;
+
+ FContactsTable := TSQLQuery.Create(self);
+ FContactsTable.SQL.Add('SELECT * FROM Contacts');
+
+ FEventsTable := TSQLQuery.Create(Self);
+ FEventsTable.SQL.Add('SELECT * FROM Events');
+
+ FResourceTable := TSQLQuery.Create(self);
+ FResourceTable.SQL.Add(
+ 'SELECT * '+
+ 'FROM Resources'
+ );
+ {
+ FResourceTable.InsertSQL.Add(
+ 'INSERT INTO Resources (' +
+ 'ResourceID, Description, Notes, ResourceActive, ' +
+ 'UserField0, UserField1, UserField2, UserField3, UserField4, ' +
+ 'UserField5, UserField6, UserField7, UserField8, UserField9) ' +
+ 'VALUES(' +
+ ':ResourceID, :Description, :Notes, :ResourceActive, ' +
+ ':UserField0, :UserField1, :UserField2, :UserField3, :UserField4, ' +
+ ':UserField5, :UserField6, :UserField7, :UserField8, :UserField9);'
+ );
+ }
+ FTasksTable := TSQLQuery.Create(self);
+ FTasksTable.SQL.Add('SELECT * FROM Tasks');
+end;
+
+procedure TVpFirebirdDatastore.CreateAllTables(dbIsNew: Boolean);
+var
+ tableNames: TStringList;
+ needCommit: Boolean;
+begin
+ needCommit := false;
+ if dbIsNew then begin
+ CreateTable(ContactsTableName);
+ CreateTable(EventsTableName);
+ CreateTable(ResourceTableName);
+ CreateTable(TasksTableName);
+ needCommit := true;
+ end else
+ begin
+ tablenames := TStringList.Create;
+ try
+ tablenames.CaseSensitive := false;
+ FConnection.GetTableNames(tablenames);
+
+ if tablenames.IndexOf(ContactsTableName) = -1 then begin
+ CreateTable(ContactsTableName);
+ needCommit := true;
+ end;
+
+ if tablenames.IndexOf(EventsTableName) = -1 then begin
+ CreateTable(EventsTableName);
+ needCommit := true;
+ end;
+
+ if tablenames.IndexOf(ResourceTableName) = -1 then begin
+ CreateTable(ResourceTableName);
+ needCommit := true;
+ end;
+
+ if tablenames.IndexOf(TasksTableName) = -1 then begin
+ CreateTable(TasksTableName);
+ needCommit := true;
+ end;
+ finally
+ tablenames.Free;
+ end;
+ end;
+
+ if needCommit then
+ FConnection.Transaction.Commit;
+end;
+
+// Connection and tables are active afterwards!
+procedure TVpFirebirdDatastore.CreateTables;
+var
+ wasConnected: Boolean;
+ isNew: Boolean;
+begin
+ isNew := false;
+ wasConnected := FConnection.Connected;
+ if not FileExistsUTF8(FConnection.DatabaseName) then begin
+ FConnection.Connected := false;
+ FConnection.CreateDB;
+ isNew := true;
+ end;
+ FConnection.Connected := true;
+ CreateAllTables(isNew);
+ SetConnected(wasConnected or AutoConnect);
+end;
+
+{ Note: Firebird with version < 3 does not support AutoInc fields.
+ Use a generator and trigger to create AutoInc values:
+ http://www.firebirdfaq.org/faq29/ }
+procedure TVpFirebirdDatastore.CreateTable(const ATableName: String);
+begin
+ if ATableName = ContactsTableName then begin
+ FConnection.ExecuteDirect(
+ 'CREATE TABLE Contacts (' +
+ 'RecordID INTEGER NOT NULL PRIMARY KEY, '+
+ 'ResourceID INTEGER NOT NULL, ' +
+ 'FirstName VARCHAR(50), '+
+ 'LastName VARCHAR(50), '+
+ 'Birthdate DATE, '+
+ 'Anniversary DATE, '+
+ 'Title VARCHAR(50), '+
+ 'Company VARCHAR(50), '+
+ 'Job_Position VARCHAR(30), '+
+ 'Address VARCHAR(100), '+
+ 'City VARCHAR(50), '+
+ 'State VARCHAR(25), '+
+ 'Zip VARCHAR(10), '+
+ 'Country VARCHAR(25), '+
+ 'Notes VARCHAR(1024), '+
+ 'Phone1 VARCHAR(25), '+
+ 'Phone2 VARCHAR(25), '+
+ 'Phone3 VARCHAR(25), '+
+ 'Phone4 VARCHAR(25), '+
+ 'Phone5 VARCHAR(25), '+
+ 'PhoneType1 INTEGER, '+
+ 'PhoneType2 INTEGER, '+
+ 'PhoneType3 INTEGER, '+
+ 'PhoneType4 INTEGER, '+
+ 'PhoneType5 INTEGER, '+
+ 'Category INTEGER, '+
+ 'EMail VARCHAR (100), '+
+ 'Custom1 VARCHAR (100), '+
+ 'Custom2 VARCHAR (100), '+
+ 'Custom3 VARCHAR (100), '+
+ 'Custom4 VARCHAR (100), '+
+ 'UserField0 VARCHAR(100), '+
+ 'UserField1 VARCHAR(100), '+
+ 'UserField2 VARCHAR(100), '+
+ 'UserField3 VARCHAR(100), '+
+ 'UserField4 VARCHAR(100), '+
+ 'UserField5 VARCHAR(100), '+
+ 'UserField6 VARCHAR(100), '+
+ 'UserField7 VARCHAR(100), '+
+ 'UserField8 VARCHAR(100), '+
+ 'UserField9 VARCHAR(100) )'
+ );
+ FConnection.ExecuteDirect(
+ 'CREATE UNIQUE INDEX Contacts_RecordID_idx ON Contacts (RecordID);');
+ FConnection.ExecuteDirect(
+ 'CREATE INDEX Contacts_ResourceID_idx ON Contacts (ResourceID);');
+
+ FConnection.ExecuteDirect(
+ 'CREATE GENERATOR Contacts_AUTOINC; ');
+ FConnection.ExecuteDirect(
+ 'SET GENERATOR Contacts_AUTOINC TO 0; ');
+ FConnection.ExecuteDirect(
+ 'CREATE TRIGGER C_AUTOINC_TRG FOR Contacts ' +
+ 'ACTIVE BEFORE INSERT POSITION 0 ' +
+ 'AS ' +
+ 'BEGIN ' +
+ 'NEW.RecordID = GEN_ID(Contacts_AUTOINC, 1); ' +
+ 'END '
+ );
+ end else
+ if ATableName = EventsTableName then begin
+ FConnection.ExecuteDirect(
+ 'CREATE TABLE Events (' +
+ 'RecordID INTEGER NOT NULL PRIMARY KEY, ' +
+ 'ResourceID INTEGER NOT NULL, ' +
+ 'StartTime TIMESTAMP NOT NULL, ' +
+ 'EndTime TIMESTAMP NOT NULL, ' +
+ 'Description VARCHAR (255), ' +
+ 'Location VARCHAR (255), ' +
+ 'Notes VARCHAR (1024), ' +
+ 'Category INTEGER, ' +
+ 'AllDayEvent CHAR(1), ' +
+ 'DingPath VARCHAR (255), ' +
+ 'AlarmSet CHAR(1), ' +
+ 'AlarmAdvance INTEGER, ' +
+ 'AlarmAdvanceType INTEGER, ' +
+ 'SnoozeTime TIMESTAMP, ' +
+ 'RepeatCode INTEGER, ' +
+ 'RepeatRangeEnd TIMESTAMP, ' +
+ 'CustomInterval INTEGER, ' +
+ 'UserField0 VARCHAR(100), '+
+ 'UserField1 VARCHAR(100), '+
+ 'UserField2 VARCHAR(100), '+
+ 'UserField3 VARCHAR(100), '+
+ 'UserField4 VARCHAR(100), '+
+ 'UserField5 VARCHAR(100), '+
+ 'UserField6 VARCHAR(100), '+
+ 'UserField7 VARCHAR(100), '+
+ 'UserField8 VARCHAR(100), '+
+ 'UserField9 VARCHAR(100) )'
+ );
+ FConnection.ExecuteDirect(
+ 'CREATE UNIQUE INDEX Events_RecordID_idx ON Events (RecordID);');
+ FConnection.ExecuteDirect(
+ 'CREATE INDEX Events_ResourceID_idx ON Events (ResourceID);');
+ FConnection.ExecuteDirect(
+ 'CREATE INDEX Events_StartTime_idx ON Events (StartTime);');
+ FConnection.ExecuteDirect(
+ 'CREATE INDEX Events_EndTime_idx ON Events (EndTime);');
+
+ FConnection.ExecuteDirect(
+ 'CREATE GENERATOR Events_AUTOINC; ');
+ FConnection.ExecuteDirect(
+ 'SET GENERATOR Events_AUTOINC TO 0; ');
+ FConnection.ExecuteDirect(
+ 'CREATE TRIGGER E_AUTOINC_TRG FOR Events ' +
+ 'ACTIVE BEFORE INSERT POSITION 0 ' +
+ 'AS ' +
+ 'BEGIN ' +
+ 'NEW.RecordID = GEN_ID(Events_AUTOINC, 1); ' +
+ 'END '
+ );
+ end else
+ if ATableName = ResourceTableName then begin
+ FConnection.ExecuteDirect(
+ 'CREATE TABLE Resources (' +
+ 'ResourceID INTEGER NOT NULL PRIMARY KEY, '+
+ 'Description VARCHAR (255), ' +
+ 'Notes VARCHAR (1024), ' +
+ 'ImageIndex INTEGER, ' +
+ 'ResourceActive CHAR(1), ' +
+ 'UserField0 VARCHAR(100), '+
+ 'UserField1 VARCHAR(100), '+
+ 'UserField2 VARCHAR(100), '+
+ 'UserField3 VARCHAR(100), '+
+ 'UserField4 VARCHAR(100), '+
+ 'UserField5 VARCHAR(100), '+
+ 'UserField6 VARCHAR(100), '+
+ 'UserField7 VARCHAR(100), '+
+ 'UserField8 VARCHAR(100), '+
+ 'UserField9 VARCHAR(100) )'
+ );
+ FConnection.ExecuteDirect(
+ 'CREATE UNIQUE INDEX Resources_ResourceID_idx ON Resources (ResourceID);');
+
+ FConnection.ExecuteDirect(
+ 'CREATE GENERATOR Resources_AUTOINC; ');
+ FConnection.ExecuteDirect(
+ 'SET GENERATOR Resources_AUTOINC TO 0; ');
+ FConnection.ExecuteDirect(
+ 'CREATE TRIGGER R_AUTOINC_TRG FOR Resources ' +
+ 'ACTIVE BEFORE INSERT POSITION 0 ' +
+ 'AS ' +
+ 'BEGIN ' +
+ 'NEW.ResourceID = GEN_ID(Resources_AUTOINC, 1); ' +
+ 'END '
+ );
+ end else
+ if ATableName = TasksTableName then begin
+ FConnection.ExecuteDirect(
+ 'CREATE TABLE Tasks (' +
+ 'RecordID INTEGER NOT NULL PRIMARY KEY, ' +
+ 'ResourceID INTEGER NOT NULL, ' +
+ 'Complete CHAR(1), ' +
+ 'Description VARCHAR(255), ' +
+ 'Details VARCHAR(1024), ' +
+ 'CreatedOn TIMESTAMP, ' +
+ 'Priority INTEGER, ' +
+ 'Category INTEGER, ' +
+ 'CompletedOn TIMESTAMP, ' +
+ 'DueDate TIMESTAMP, ' +
+ 'UserField0 VARCHAR(100), '+
+ 'UserField1 VARCHAR(100), '+
+ 'UserField2 VARCHAR(100), '+
+ 'UserField3 VARCHAR(100), '+
+ 'UserField4 VARCHAR(100), '+
+ 'UserField5 VARCHAR(100), '+
+ 'UserField6 VARCHAR(100), '+
+ 'UserField7 VARCHAR(100), '+
+ 'UserField8 VARCHAR(100), '+
+ 'UserField9 VARCHAR(100) )'
+ );
+ FConnection.ExecuteDirect(
+ 'CREATE UNIQUE INDEX Tasks_RecordID_idx ON Tasks (RecordID);');
+ FConnection.ExecuteDirect(
+ 'CREATE INDEX Tasks_ResourceID_idx ON Tasks (ResourceID);');
+
+ FConnection.ExecuteDirect(
+ 'CREATE GENERATOR Tasks_AUTOINC; ');
+ FConnection.ExecuteDirect(
+ 'SET GENERATOR Tasks_AUTOINC TO 0; ');
+ FConnection.ExecuteDirect(
+ 'CREATE TRIGGER T_AUTOINC_TRG FOR Tasks ' +
+ 'ACTIVE BEFORE INSERT POSITION 0 ' +
+ 'AS ' +
+ 'BEGIN ' +
+ 'NEW.RecordID = GEN_ID(Tasks_AUTOINC, 1); ' +
+ 'END '
+ );
+ end;
+end;
+
+function TVpFirebirdDatastore.GetContactsTable: TDataset;
+begin
+ Result := FContactsTable;
+end;
+
+function TVpFirebirdDatastore.GetEventsTable: TDataset;
+begin
+ Result := FEventsTable;
+end;
+
+function TVpFirebirdDataStore.GetNextID(TableName: string): integer;
+begin
+ Unused(TableName);
+ { This is not needed in the Firebird datastore as these tables use a
+ generator and trigger for autoincrement fields.
+ http://www.firebirdfaq.org/faq29/ }
+ Result := -1;
+end;
+
+function TVpFirebirdDatastore.GetResourceTable : TDataset;
+begin
+ Result := FResourceTable;
+end;
+
+function TVpFirebirdDatastore.GetTasksTable : TDataset;
+begin
+ Result := FTasksTable;
+end;
+
+procedure TVpFirebirdDatastore.Loaded;
+begin
+ inherited;
+ if not (csDesigning in ComponentState) then
+ Connected := AutoConnect and (AutoCreate or FileExists(FConnection.DatabaseName));
+end;
+
+procedure TVpFirebirdDatastore.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (Operation = opRemove) and (AComponent = FConnection) then
+ FConnection := nil;
+end;
+
+{ Note: Set the property Required of the PrimaryKey field to false. Otherwise
+ Firebird will complain about this field not being specified when posting. }
+procedure TVpFirebirdDatastore.OpenTables;
+begin
+ if FContactsTable.Transaction = nil then
+ FContactsTable.Transaction := FConnection.Transaction;
+ FContactsTable.Open;
+ FContactsTable.Fields[0].Required := false;
+
+ if FEventsTable.Transaction = nil then
+ FEventsTable.Transaction := FConnection.Transaction;
+ FEventsTable.Open;
+ FEventsTable.Fields[0].Required := false;
+
+ if FResourceTable.Transaction = nil then
+ FResourceTable.Transaction := FConnection.Transaction;
+ FResourceTable.Open;
+ FResourceTable.Fields[0].Required := false;
+
+ if FTasksTable.Transaction = nil then
+ FTasksTable.Transaction := FConnection.Transaction;
+ FTasksTable.Open;
+ FTasksTable.Fields[0].Required := false;
+end;
+
+procedure TVpFirebirdDatastore.PostContacts;
+begin
+ inherited;
+ FContactsTable.ApplyUpdates;
+end;
+
+procedure TVpFirebirdDatastore.PostEvents;
+begin
+ inherited;
+ FEventsTable.ApplyUpdates;
+end;
+
+procedure TVpFirebirdDatastore.PostResources;
+begin
+ inherited;
+ FResourceTable.ApplyUpdates;
+end;
+
+procedure TVpFirebirdDatastore.PostTasks;
+begin
+ inherited;
+ FTasksTable.ApplyUpdates;
+end;
+
+procedure TVpFirebirdDatastore.SetConnected(const AValue: Boolean);
+begin
+ if (AValue = Connected) or (FConnection = nil) or (FConnectLock > 0) then
+ exit;
+
+ inc(FConnectLock);
+ if AValue and AutoCreate then
+ CreateTables;
+ FConnection.Connected := AValue;
+ if FConnection.Connected then
+ OpenTables;
+
+ inherited SetConnected(AValue);
+
+ if FConnection.Connected then
+ Load;
+ dec(FConnectLock);
+end;
+(*
+begin
+ if (FConnection = nil) or (FConnection.Transaction = nil) then
+ exit;
+
+ if AValue = FConnection.Connected then
+ exit;
+
+ if AValue and AutoCreate then
+ CreateTables;
+
+ FConnection.Connected := AValue;
+ if AValue then
+ begin
+ FConnection.Transaction.Active := true;
+ OpenTables;
+ end;
+
+ inherited SetConnected(AValue);
+
+ if FConnection.Connected then
+ Load;
+end; *)
+
+
+procedure TVpFirebirdDatastore.SetConnection(const AValue: TIBConnection);
+var
+ wasConnected: Boolean;
+begin
+ if AValue = FConnection then
+ exit;
+
+ // To do: clear planit lists...
+ if FConnection <> nil then begin
+ wasConnected := FConnection.Connected;
+ Connected := false;
+ end;
+ FConnection := AValue;
+
+ FContactsTable.Database := FConnection;
+ FContactsTable.Transaction := FConnection.Transaction;
+
+ FEventsTable.Database := FConnection;
+ FEventsTable.Transaction := FConnection.Transaction;
+
+ FResourceTable.Database := FConnection;
+ FResourceTable.Transaction := FConnection.Transaction;
+
+ FTasksTable.Database := FConnection;
+ FTasksTable.Transaction := FConnection.Transaction;
+ if wasConnected then Connected := true;
+end;
+
+end.
diff --git a/components/tvplanit/source/vpreg.pas b/components/tvplanit/source/vpreg.pas
index 5b0e6731d..e84d9ea5f 100644
--- a/components/tvplanit/source/vpreg.pas
+++ b/components/tvplanit/source/vpreg.pas
@@ -166,6 +166,7 @@ uses
VpIniDS, { IniFile datastore }
VpXmlDS, { XML file datastore }
VpBufDS, { Datastore for TBufDataset }
+ VpFBDS, { Datastore for Firebird database }
VpSqlite3DS, { Datastore for sqlite3 }
// VpSdfDS { Datastore for TSdfDataset }
// VpDbfDS, { Datastore for dbase files }
@@ -629,6 +630,7 @@ begin
TVpXmlDatastore,
TVpBufDSDatastore,
TVpSqlite3Datastore,
+ TVpFirebirdDatastore,
//TVpSdfDatastore, // to do (maybe)...
//TVpDbfDatastore, // to do...
{$ENDIF}
diff --git a/components/tvplanit/source/vpreg.res b/components/tvplanit/source/vpreg.res
index ae0498ed8..b3673c59b 100644
Binary files a/components/tvplanit/source/vpreg.res and b/components/tvplanit/source/vpreg.res differ
diff --git a/components/tvplanit/source/vpsqlite3ds.pas b/components/tvplanit/source/vpsqlite3ds.pas
index ec64154ec..f5ae680df 100644
--- a/components/tvplanit/source/vpsqlite3ds.pas
+++ b/components/tvplanit/source/vpsqlite3ds.pas
@@ -65,7 +65,8 @@ uses
LazFileUtils,
VpConst, VpMisc;
-{ TVpZeosDatastore }
+
+{ TVpSqlite3Datastore }
constructor TVpSqlite3Datastore.Create(AOwner: TComponent);
begin