From 9333e53cb441c79bcce23ebf17a7c1749444fe18 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 25 Jul 2016 16:55:32 +0000 Subject: [PATCH] tvplanit: Add FlexDatastore example (using an Access database) with instructions in readme. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5030 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../datastores/flex/access/project1.lpi | 88 + .../datastores/flex/access/project1.lpr | 20 + .../datastores/flex/access/readme.txt | 104 ++ .../flex/access/tools/CreateAccessDB.lpi | 82 + .../flex/access/tools/CreateAccessDB.lpr | 21 + .../datastores/flex/access/tools/camain.lfm | 104 ++ .../datastores/flex/access/tools/camain.pas | 307 ++++ .../examples/datastores/flex/access/unit1.lfm | 1474 +++++++++++++++++ .../examples/datastores/flex/access/unit1.pas | 202 +++ components/tvplanit/source/vpdata.pas | 4 +- components/tvplanit/source/vpflxds.pas | 33 +- 11 files changed, 2429 insertions(+), 10 deletions(-) create mode 100644 components/tvplanit/examples/datastores/flex/access/project1.lpi create mode 100644 components/tvplanit/examples/datastores/flex/access/project1.lpr create mode 100644 components/tvplanit/examples/datastores/flex/access/readme.txt create mode 100644 components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpi create mode 100644 components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpr create mode 100644 components/tvplanit/examples/datastores/flex/access/tools/camain.lfm create mode 100644 components/tvplanit/examples/datastores/flex/access/tools/camain.pas create mode 100644 components/tvplanit/examples/datastores/flex/access/unit1.lfm create mode 100644 components/tvplanit/examples/datastores/flex/access/unit1.pas diff --git a/components/tvplanit/examples/datastores/flex/access/project1.lpi b/components/tvplanit/examples/datastores/flex/access/project1.lpi new file mode 100644 index 000000000..90a062a9b --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/project1.lpi @@ -0,0 +1,88 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + </General> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="4"> + <Item1> + <PackageName Value="SQLDBLaz"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + </Item2> + <Item3> + <PackageName Value="laz_visualplanit"/> + </Item3> + <Item4> + <PackageName Value="LCL"/> + </Item4> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="project1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="project1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);dbase"/> + <OtherUnitFiles Value="dbase"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/tvplanit/examples/datastores/flex/access/project1.lpr b/components/tvplanit/examples/datastores/flex/access/project1.lpr new file mode 100644 index 000000000..cbaf9b146 --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/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/flex/access/readme.txt b/components/tvplanit/examples/datastores/flex/access/readme.txt new file mode 100644 index 000000000..c5dd07b2f --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/readme.txt @@ -0,0 +1,104 @@ +This demo shows how a TVpFlexDatastore can link to an Access database using +ODBC. + + +Step-by-step instructions for creating a new application +-------------------------------------------------------- + +- If a suitable Access database is not available from somewhere else + create an empty Access database containing the VisualPlanit tables and fields. + The easiest way to do this is by means of the CreateAccessDB application in + the folder "tools". Use extension .mdb to create an old Access 97/2000 file, + or use extension .accdb for a new Access 2007+ file. + +- Create a new form. + +- Add a TVpFlexDatastore, a TVpControlLink and the visual planner components + needed. + +- Add an TODBConnection. Add a TSQLTransationSet + +- Set these properties of the ODBCConnection: + - "Driver" ---> "Microsoft Access Driver (*.mdb, *.accdb)" + - "Params" ---> Add "DBQ=full/path/to/access/file" + Note: Make sure to use the full path in Params, otherwise the fieldmapper + in one of the next steps will not find the database. + - "Transaction --> instance of the SQLTransaction. + +- Add four TSQLQuery components and set these properties + - "Database" ---> instance of the ODBCConnection + - "Options" --> add sqoAutoApplyUpdates, sqoAutoCommit and sqoKeepOpenOnCommit + - "UsePrimaryKeyAsKey" --> false (VERY IMPORTANT FOR ACCESS FILES!) + +- Enter these SQL for the queries where <tablename> must be replaced by + Resources, Contacts, Events and Tasks. + + SELECT * FROM <tablename> + +- For the Resources query add this UpdateSQL: + + UPDATE + Resources + SET + Description = :Description, + Notes = :Notes, + ResourceActive = :ResourceActive, + ImageIndex = :ImageIndex + WHERE + ResourceID = :ResourceID + +- Similarly, add UpdateSQL instructions for the Events, Contacts, and Tasks tables. + Make sure to include all database fields (except for the AutoInc fields). + See the demo application. + +- Add this text to the DeleteSQL property of the Resources SQLDataset + + DELETE * FROM Resources + WHERE ResourceID = :ResourceID. + +- This is the DeleteSQL needed for the Events dataset: + + DELETE * FROM Events + WHERE RecordID = :RecordID + +- Repeat accordingly with the Contacts and Rasks datasets. + +- Add four TDatasource components. Link each one of them to a TSQLDataset. + +- Link the datasource components to the matching Datasources of the + VpFlexDatastore. + +- In OnCreate of the form set + VpFlexDatastore.Connected := true + ODBConnection.Connected := true + SQLTransaction.Active := true + +- In OnDestroy set + ODBCConnection.Connected := false + +- Write an event handler for the datastore's OnSetFilterCriteria. Copy the + code used in the demo. In case of date-filtering it is important to use + the dbf syntax DTOS(dateField). + +- Double-click on the VpFlexDatastore in Form1 to open the field mapper. + +- Select "Resources" in the combobox. Click a database field in the left listbox + and click its corresponding planner field in the right listbox. Click add to + store this mapping. Repeat with all database fields. + +- Or, if all database fields have the same name as the corresponding planner + fields, simply click "Add all" to establish a mapping for all equally names + fields. + +- Note: the sample database does not support the User-defined fields of the + planner. Therefore, these fields will be left without a matching database + field. + +- Repeat with the Events, Contacts and Tasks tables. + +- Close the field mapper. + +- Done. + + + \ No newline at end of file diff --git a/components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpi b/components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpi new file mode 100644 index 000000000..3968e19d3 --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpi @@ -0,0 +1,82 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <PathDelim Value="\"/> + <General> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="CreateAccessDB"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="SQLDBLaz"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="CreateAccessDB.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\..\..\odbcdatastore\camain.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="caMain"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="CreateAccessDB"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpr b/components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpr new file mode 100644 index 000000000..2d790caa9 --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/tools/CreateAccessDB.lpr @@ -0,0 +1,21 @@ +program CreateAccessDB; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, caMain + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/tvplanit/examples/datastores/flex/access/tools/camain.lfm b/components/tvplanit/examples/datastores/flex/access/tools/camain.lfm new file mode 100644 index 000000000..d25cf0c8c --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/tools/camain.lfm @@ -0,0 +1,104 @@ +object Form1: TForm1 + Left = 262 + Height = 177 + Top = 155 + Width = 314 + Caption = 'Access database creator' + ClientHeight = 177 + ClientWidth = 314 + LCLVersion = '1.7' + object FileNameEdit: TFileNameEdit + Left = 16 + Height = 23 + Top = 16 + Width = 280 + FileName = '.\data.mdb' + Filter = 'Access database files (*.mdb; *.accdb)|*.mdb;*.accdb' + FilterIndex = 0 + HideDirectories = False + ButtonWidth = 23 + NumGlyphs = 1 + MaxLength = 0 + TabOrder = 0 + Text = '.\data.mdb' + end + object CbCreateVPFields: TCheckBox + Left = 16 + Height = 19 + Top = 80 + Width = 140 + Caption = 'Add VisualPlanIt tables' + Checked = True + State = cbChecked + TabOrder = 1 + end + object StatusBar1: TStatusBar + Left = 0 + Height = 23 + Top = 154 + Width = 314 + Panels = <> + end + object Label1: TLabel + Left = 16 + Height = 30 + Top = 44 + Width = 285 + Caption = 'Use extension .mdb for old Access 97/2000 file format,'#13#10'.accdb for new Access 2007+ file format.' + ParentColor = False + end + object Panel1: TPanel + Left = 0 + Height = 44 + Top = 110 + Width = 314 + Align = alBottom + Caption = 'Panel1' + ClientHeight = 44 + ClientWidth = 314 + TabOrder = 3 + object BtnCreateDB: TButton + Left = 120 + Height = 25 + Top = 10 + Width = 91 + Caption = 'Create DB' + OnClick = BtnCreateDBClick + TabOrder = 0 + end + object BtnClose: TButton + Left = 221 + Height = 25 + Top = 10 + Width = 75 + Caption = 'Close' + OnClick = BtnCloseClick + TabOrder = 1 + end + object Bevel1: TBevel + Left = 9 + Height = 3 + Top = 1 + Width = 296 + Align = alTop + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Shape = bsTopLine + end + end + object ODBCConnection1: TODBCConnection + Connected = False + LoginPrompt = False + KeepConnection = False + Transaction = SQLTransaction1 + Options = [] + left = 104 + end + object SQLTransaction1: TSQLTransaction + Active = False + Action = caCommit + Database = ODBCConnection1 + Options = [] + left = 216 + end +end diff --git a/components/tvplanit/examples/datastores/flex/access/tools/camain.pas b/components/tvplanit/examples/datastores/flex/access/tools/camain.pas new file mode 100644 index 000000000..3d6e2bad5 --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/tools/camain.pas @@ -0,0 +1,307 @@ +unit caMain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, odbcconn, sqldb, FileUtil, Forms, Controls, Graphics, + Dialogs, StdCtrls, EditBtn, ComCtrls, ExtCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Bevel1: TBevel; + BtnCreateDB: TButton; + BtnClose: TButton; + CbCreateVPFields: TCheckBox; + FileNameEdit: TFileNameEdit; + Label1: TLabel; + ODBCConnection1: TODBCConnection; + Panel1: TPanel; + SQLTransaction1: TSQLTransaction; + StatusBar1: TStatusBar; + procedure BtnCreateDBClick(Sender: TObject); + procedure BtnCloseClick(Sender: TObject); + private + function CreateAccessDatabase(DatabaseFile: string): boolean; + procedure CreateContactsTable; + procedure CreateEventsTable; + procedure CreateResourceTable; + procedure CreateTasksTable; + procedure StatusMsg(const AText: String); + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + LCLType, LazFileUtils; + +Const + ODBC_ADD_DSN = 1; + ODBC_CONFIG_DSN = 2; + ODBC_REMOVE_DSN = 3; + ODBC_ADD_SYS_DSN = 4; + ODBC_CONFIG_SYS_DSN = 5; + ODBC_REMOVE_SYS_DSN = 6; + ODBC_REMOVE_DEFAULT_DSN = 7; + +function SQLConfigDataSource(hwndParent: Integer; fRequest: Integer; + lpszDriverString: PChar; lpszAttributes: PChar): Integer; stdcall; external 'odbccp32.dll'; + +function SQLInstallerError(iError: integer; pfErrorCode: PInteger; + lpszErrorMsg: string; cbErrorMsgMax: integer; pcbErrorMsg: PInteger): integer; stdcall; external 'odbccp32.dll'; + + +{ TForm1 } + +procedure TForm1.BtnCreateDBClick(Sender: TObject); +var + fn: String; +begin + if FileNameEdit.FileName = '' then + exit; + fn := ExpandFileNameUTF8(FilenameEdit.FileName); + if FileExistsUTF8(fn) then + DeleteFileUTF8(fn); + + // Create empty database file + CreateAccessDatabase(fn); + StatusMsg('Database file created'); + + if CbCreateVPFields.Checked then begin + //connection + ODBCConnection1.Driver := 'Microsoft Access Driver (*.mdb, *.accdb)'; + ODBCConnection1.Params.Add('DBQ=' + fn); + ODBCConnection1.Params.Add('Locale Identifier=1031'); + ODBCConnection1.Params.Add('ExtendedAnsiSQL=1'); + ODBCConnection1.Params.Add('CHARSET=ansi'); + ODBCConnection1.Connected := True; + ODBCConnection1.KeepConnection := True; + + //transaction + SQLTransaction1.DataBase := ODBCConnection1; + SQLTransaction1.Action := caCommit; + SQLTransaction1.Active := True; + + // Create tables + CreateResourceTable; + CreateContactsTable; + CreateEventsTable; + CreateTasksTable; + + SQLTransaction1.Active := false; + ODBCConnection1.Connected := false; + + Statusbar1.SimpleText := 'All tables created.'; + end; +end; + +procedure TForm1.BtnCloseClick(Sender: TObject); +begin + Close; +end; + +function TForm1.CreateAccessDatabase(DatabaseFile: string): boolean; +var + dbType: string; + driver: string; + ErrorCode, ResizeErrorMessage: integer; + ErrorMessage: PChar; + retCode: integer; +begin + driver := 'Microsoft Access Driver (*.mdb, *.accdb)'; + + { With this driver, + CREATE_DB/CREATE_DBV12 will create an .accdb format database; + CREATE_DBV4 will create an mdb + http://stackoverflow.com/questions/9205633/how-do-i-specify-the-odbc-access-driver-format-when-creating-the-database + } + + case Lowercase(ExtractFileExt(DatabaseFile)) of + '', '.', '.mdb': + dbType := 'CREATE_DBV4="' + DatabaseFile + '"'; + '.accdb': + dbtype := 'CREATE_DBV12="' + DatabaseFile + '"'; + else + raise Exception.CreateFmt('File format "%s" not supported.', [ExtractFileExt(DatabaseFile)]); + end; + +// DBPChar := 'CREATE_DBV4="' + DatabaseFile + '"'; + retCode := SQLConfigDataSource(Hwnd(nil), ODBC_ADD_DSN, PChar(driver), PChar(dbType)); + if retCode <> 0 then + begin + //try alternate driver + driver := 'Microsoft Access Driver (*.mdb)'; + dbType := 'CREATE_DB="' + DatabaseFile + '"'; + retCode := SQLConfigDataSource(Hwnd(nil), ODBC_ADD_DSN, PChar(driver), PChar(dbType)); + end; + if retCode = 0 then + result := true + else + begin + result := false; + ErrorCode := 0; + ResizeErrorMessage := 0; + // todo: verify how the DLL is called - use pointers?; has not been tested. + GetMem(ErrorMessage, 512); + try + SQLInstallerError(1, @ErrorCode, ErrorMessage, SizeOf(ErrorMessage), @ResizeErrorMessage); + finally + FreeMem(ErrorMessage); + end; + raise Exception.CreateFmt('Error creating Access database: %s', [ErrorMessage]); + end; +end; + +procedure TForm1.CreateContactsTable; +begin + ODBCConnection1.ExecuteDirect( + 'CREATE TABLE Contacts ('+ + 'RecordID COUNTER, ' + + 'ResourceID INTEGER,' + + '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, '+ + '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) )' + ); + ODBCConnection1.ExecuteDirect( + 'CREATE UNIQUE INDEX piCRecordID ON Contacts(RecordID) WITH PRIMARY'); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX siCResourceID ON Contacts(ResourceID)'); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX siCName ON Contacts(LastName, FirstName)' ); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX siCCompany ON Contacts(Company)'); + StatusMsg('Table "Contacts" created.'); +end; + +procedure TForm1.CreateEventsTable; +begin + ODBCConnection1.ExecuteDirect( + 'CREATE TABLE Events ('+ + 'RecordID COUNTER, ' + + 'ResourceID INTEGER, '+ + 'StartTime DATETIME, '+ + 'EndTime DATETIME, '+ + 'Description VARCHAR(255), '+ + 'Location VARCHAR(255), '+ + 'Notes VARCHAR, ' + + 'Category INTEGER, '+ + 'AllDayEvent LOGICAL, '+ + 'DingPath VARCHAR(255), '+ + 'AlarmSet LOGICAL, '+ + 'AlarmAdvance INTEGER, '+ + 'AlarmAdvanceType INTEGER, '+ + 'SnoozeTime DATETIME, '+ + 'RepeatCode INTEGER, '+ + 'RepeatRangeEnd DATETIME, '+ + 'CustomInterval INTEGER)' + ); + ODBCConnection1.ExecuteDirect( + 'CREATE UNIQUE INDEX piERecordID ON Events(RecordID) WITH PRIMARY'); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX EResourceID ON Events(ResourceID)'); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX EStartTime ON Events(StartTime)'); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX EEndTime ON Events(EndTime)'); + + StatusMsg('Table "Events" created.'); +end; + +procedure TForm1.CreateResourceTable; +begin + ODBCConnection1.ExecuteDirect( + 'CREATE TABLE Resources ( '+ + 'ResourceID COUNTER, ' + + 'Description VARCHAR(255), '+ + 'Notes VARCHAR, '+ // 1024 --> - + 'ImageIndex INTEGER, '+ + 'ResourceActive LOGICAL, '+ // BOOL --> LOGICAL + '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) )' + ); + ODBCConnection1.ExecuteDirect( + 'CREATE UNIQUE INDEX piRResourceID ON Resources(ResourceID) WITH PRIMARY' + ); + StatusMsg('Table "Resources" created.'); +end; + +procedure TForm1.CreateTasksTable; +begin + ODBCConnection1.ExecuteDirect( + 'CREATE TABLE Tasks ('+ + 'RecordID COUNTER, ' + + 'ResourceID INTEGER, '+ + 'Complete LOGICAL, '+ + 'Description VARCHAR(255), '+ + 'Details VARCHAR, '+ + 'CreatedOn DATETIME, '+ + 'Priority INTEGER, '+ + 'Category INTEGER, '+ + 'CompletedOn DATETIME, '+ + 'DueDate DATETIME)' + ); + ODBCConnection1.ExecuteDirect( + 'CREATE UNIQUE INDEX piTRecordID ON Tasks(RecordID) WITH PRIMARY' + ); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX siTDueDate ON Tasks(DueDate)' + ); + ODBCConnection1.ExecuteDirect( + 'CREATE INDEX siTCompletedOn ON Tasks(CompletedOn)' + ); + StatusMsg('Table "Tasks" created.'); +end; + +procedure TForm1.StatusMsg(const AText: String); +begin + Statusbar1.SimpleText := AText; + Application.ProcessMessages; +end; + +end. + diff --git a/components/tvplanit/examples/datastores/flex/access/unit1.lfm b/components/tvplanit/examples/datastores/flex/access/unit1.lfm new file mode 100644 index 000000000..169b6933e --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/unit1.lfm @@ -0,0 +1,1474 @@ +object Form1: TForm1 + Left = 344 + Height = 686 + Top = 169 + 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 = VpFlexDataStore1 + 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 = TabSheet2 + Align = alClient + TabIndex = 1 + TabOrder = 1 + OnChange = PageControl1Change + object TabSheet1: TTabSheet + Caption = 'Events and tasks' + ClientHeight = 624 + ClientWidth = 972 + object VpDayView1: TVpDayView + Left = 0 + Height = 624 + Top = 0 + Width = 301 + DataStore = VpFlexDataStore1 + 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 = VpFlexDataStore1 + 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 = VpFlexDataStore1 + 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 = dtMonday + 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 = VpFlexDataStore1 + 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 = 624 + ClientWidth = 972 + object VpContactButtonBar1: TVpContactButtonBar + Left = 0 + Height = 624 + Top = 0 + Width = 40 + DrawingStyle = dsFlat + RadioStyle = False + Align = alLeft + end + object VpContactGrid1: TVpContactGrid + Left = 40 + Height = 624 + Top = 0 + Width = 932 + DataStore = VpFlexDataStore1 + 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 + object TabSheet3: TTabSheet + Caption = 'Grids' + ClientHeight = 624 + ClientWidth = 972 + object TabControl1: TTabControl + Left = 8 + Height = 577 + Top = 39 + Width = 960 + OnChange = TabControl1Change + TabIndex = 2 + Tabs.Strings = ( + 'Resources' + 'Contacts' + 'Events' + 'Tasks' + ) + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Around = 8 + TabOrder = 0 + object Grid: TDBGrid + Left = 2 + Height = 552 + Top = 23 + Width = 956 + Align = alClient + Color = clWindow + Columns = <> + DataSource = DsResources + TabOrder = 1 + end + end + object DBNavigator: TDBNavigator + Left = 8 + Height = 25 + Top = 8 + Width = 241 + BevelOuter = bvNone + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 100 + ClientHeight = 25 + ClientWidth = 241 + Options = [] + TabOrder = 1 + end + object Button1: TButton + Left = 264 + Height = 25 + Top = 8 + Width = 120 + Caption = 'Apply to planner' + OnClick = Button1Click + TabOrder = 2 + end + end + end + object VpControlLink1: TVpControlLink + DataStore = VpFlexDataStore1 + 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 = 168 + end + object VpResourceEditDialog1: TVpResourceEditDialog + Version = 'v1.04' + DataStore = VpFlexDataStore1 + Options = [] + Placement.Position = mpCenter + Placement.Top = 10 + Placement.Left = 10 + Placement.Height = 250 + Placement.Width = 400 + left = 136 + top = 232 + end + object VpFlexDataStore1: TVpFlexDataStore + 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 + AutoConnect = False + AutoCreate = True + DayBuffer = 31 + DataSources.ResourceDataSource = DsResources + DataSources.EventsDataSource = DsEvents + DataSources.ContactsDataSource = DsContacts + DataSources.TasksDataSource = DsTasks + ResourceID = 0 + OnSetFilterCriteria = VpFlexDataStore1SetFilterCriteria + left = 136 + top = 101 + ResourceFieldMappings = ( + 'ResourceID' + 'ResourceID' + 'Description' + 'Description' + 'Notes' + 'Notes' + 'ImageIndex' + 'ImageIndex' + 'ResourceActive' + 'ResourceActive' + 'UserField0' + 'UserField0' + 'UserField1' + 'UserField1' + 'UserField2' + 'UserField2' + 'UserField3' + 'UserField3' + 'UserField4' + 'UserField4' + 'UserField5' + 'UserField5' + 'UserField6' + 'UserField6' + 'UserField7' + 'UserField7' + 'UserField8' + 'UserField8' + 'UserField9' + 'UserField9' + ) + EventFieldMappings = ( + 'RecordID' + 'RecordID' + 'ResourceID' + 'ResourceID' + 'StartTime' + 'StartTime' + 'EndTime' + 'EndTime' + 'Description' + 'Description' + 'Location' + 'Location' + 'Notes' + 'Notes' + 'Category' + 'Category' + 'AllDayEvent' + 'AllDayEvent' + 'DingPath' + 'DingPath' + 'AlarmSet' + 'AlarmSet' + 'AlarmAdvance' + 'AlarmAdvance' + 'AlarmAdvanceType' + 'AlarmAdvanceType' + 'SnoozeTime' + 'SnoozeTime' + 'RepeatCode' + 'RepeatCode' + 'RepeatRangeEnd' + 'RepeatRangeEnd' + 'CustomInterval' + 'CustomInterval' + ) + ContactFieldMappings = ( + 'RecordID' + 'RecordID' + 'ResourceID' + 'ResourceID' + 'FirstName' + 'FirstName' + 'LastName' + 'LastName' + 'Birthdate' + 'Birthdate' + 'Anniversary' + 'Anniversary' + 'Title' + 'Title' + 'Company' + 'Company' + 'Job_Position' + 'Job_Position' + 'Address' + 'Address' + 'City' + 'City' + 'State' + 'State' + 'Zip' + 'Zip' + 'Country' + 'Country' + 'Notes' + 'Notes' + 'Phone1' + 'Phone1' + 'Phone2' + 'Phone2' + 'Phone3' + 'Phone3' + 'Phone4' + 'Phone4' + 'Phone5' + 'Phone5' + 'PhoneType1' + 'PhoneType1' + 'PhoneType2' + 'PhoneType2' + 'PhoneType3' + 'PhoneType3' + 'PhoneType4' + 'PhoneType4' + 'PhoneType5' + 'PhoneType5' + 'Category' + 'Category' + 'EMail' + 'EMail' + 'Custom1' + 'Custom1' + 'Custom2' + 'Custom2' + 'Custom3' + 'Custom3' + 'Custom4' + 'Custom4' + ) + TaskFieldMappings = ( + 'RecordID' + 'RecordID' + 'ResourceID' + 'ResourceID' + 'Complete' + 'Complete' + 'Description' + 'Description' + 'Details' + 'Details' + 'CreatedOn' + 'CreatedOn' + 'Priority' + 'Priority' + 'Category' + 'Category' + 'CompletedOn' + 'CompletedOn' + 'DueDate' + 'DueDate' + ) + end + object DsResources: TDataSource + DataSet = QryResources + left = 240 + top = 428 + end + object DsContacts: TDataSource + DataSet = QryContacts + left = 240 + top = 496 + end + object DsEvents: TDataSource + DataSet = QryEvents + left = 240 + top = 560 + end + object DsTasks: TDataSource + DataSet = QryTasks + left = 240 + top = 621 + end + object QryResources: TSQLQuery + PacketRecords = -1 + FieldDefs = < + item + Name = 'ResourceID' + Attributes = [faReadonly] + DataType = ftAutoInc + Precision = -1 + end + item + Name = 'Description' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Notes' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'ImageIndex' + DataType = ftInteger + Precision = -1 + end + item + Name = 'ResourceActive' + DataType = ftBoolean + Precision = -1 + end + item + Name = 'UserField0' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField1' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField2' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField3' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField4' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField5' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField6' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField7' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField8' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField9' + DataType = ftString + Precision = -1 + Size = 100 + end> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Resources' + ) + UpdateSQL.Strings = ( + 'UPDATE' + ' Resources' + 'SET' + ' Description = :Description,' + ' Notes = :Notes,' + ' ResourceActive = :ResourceActive,' + ' ImageIndex = :ImageIndex' + 'WHERE' + ' ResourceID = :ResourceID' + ) + DeleteSQL.Strings = ( + 'DELETE * FROM Resources' + 'WHERE ResourceID = :ResourceID' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 136 + top = 428 + end + object QryContacts: TSQLQuery + PacketRecords = -1 + FieldDefs = < + item + Name = 'RecordID' + Attributes = [faReadonly] + DataType = ftAutoInc + Precision = -1 + end + item + Name = 'ResourceID' + DataType = ftInteger + Precision = -1 + end + item + Name = 'FirstName' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'LastName' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'Birthdate' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'Anniversary' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'Title' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'Company' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'Job_Position' + DataType = ftString + Precision = -1 + Size = 30 + end + item + Name = 'Address' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'City' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'State' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Zip' + DataType = ftString + Precision = -1 + Size = 10 + end + item + Name = 'Country' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Notes' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Phone1' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone2' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone3' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone4' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone5' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'PhoneType1' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType2' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType3' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType4' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType5' + DataType = ftInteger + Precision = -1 + end + item + Name = 'Category' + DataType = ftInteger + Precision = -1 + end + item + Name = 'EMail' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom1' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom2' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom3' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom4' + DataType = ftString + Precision = -1 + Size = 100 + end> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Contacts' + ) + UpdateSQL.Strings = ( + 'UPDATE' + ' Contacts' + 'SET' + ' ResourceID = :ResourceID,' + ' FirstName = :FirstName,' + ' LastName = :LastName,' + ' Title = :Title,' + ' Company = :Company,' + ' Job_Position = :Job_Position,' + ' EMail = :EMail,' + ' Address = :Address,' + ' City = :City,' + ' State = :State,' + ' Zip = :Zip,' + ' Country = :Country,' + ' Notes = :Notes,' + ' Category = :Category,' + ' Phone1 = :Phone1,' + ' Phone2 = :Phone2,' + ' Phone3 = :Phone3,' + ' Phone4 = :Phone4,' + ' Phone5 = :Phone5,' + ' PhoneType1 = :PhoneType1,' + ' PhoneType2 = :PhoneType2,' + ' PhoneType3 = :PhoneType3,' + ' PhoneType4 = :PhoneType4,' + ' PhoneType5 = :PhoneType5,' + ' Custom1 = :Custom1,' + ' Custom2 = :Custom2,' + ' Custom3 = :Custom3,' + ' Custom4 = :Custom4' + 'WHERE' + ' RecordID = :RecordID' + ) + DeleteSQL.Strings = ( + 'DELETE * FROM Contacts' + 'WHERE RecordID = :RecordID' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 136 + top = 496 + end + object QryEvents: TSQLQuery + PacketRecords = -1 + FieldDefs = < + item + Name = 'RecordID' + Attributes = [faReadonly] + DataType = ftAutoInc + Precision = -1 + end + item + Name = 'ResourceID' + DataType = ftInteger + Precision = -1 + end + item + Name = 'StartTime' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'EndTime' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'Description' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Location' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Notes' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Category' + DataType = ftInteger + Precision = -1 + end + item + Name = 'AllDayEvent' + DataType = ftBoolean + Precision = -1 + end + item + Name = 'DingPath' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'AlarmSet' + DataType = ftBoolean + Precision = -1 + end + item + Name = 'AlarmAdvance' + DataType = ftInteger + Precision = -1 + end + item + Name = 'AlarmAdvanceType' + DataType = ftInteger + Precision = -1 + end + item + Name = 'SnoozeTime' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'RepeatCode' + DataType = ftInteger + Precision = -1 + end + item + Name = 'RepeatRangeEnd' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'CustomInterval' + DataType = ftInteger + Precision = -1 + end> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Events' + ) + UpdateSQL.Strings = ( + 'UPDATE' + ' Events' + 'SET' + ' ResourceID = :ResourceID,' + ' StartTime = :StartTime,' + ' EndTime = :EndTime,' + ' Description = :Description,' + ' Location = :Location,' + ' Notes = :Notes,' + ' SnoozeTime = :SnoozeTime,' + ' Category = :Category,' + ' DingPath = :DingPath,' + ' AllDayEvent = :AllDayEvent,' + ' AlarmSet = :AlarmSet,' + ' AlarmAdvance = :AlarmAdvance,' + ' AlarmAdvanceType = :AlarmAdvanceType,' + ' RepeatCode = :RepeatCode,' + ' RepeatRangeEnd = :RepeatRangeEnd,' + ' CustomInterval = :CustomInterval' + 'WHERE' + ' RecordID = :RecordID' + ) + DeleteSQL.Strings = ( + 'DELETE * FROM Events' + 'WHERE RecordID = :RecordID' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 136 + top = 560 + end + object QryTasks: TSQLQuery + PacketRecords = -1 + FieldDefs = < + item + Name = 'RecordID' + Attributes = [faReadonly] + DataType = ftAutoInc + Precision = -1 + end + item + Name = 'ResourceID' + DataType = ftInteger + Precision = -1 + end + item + Name = 'Complete' + DataType = ftBoolean + Precision = -1 + end + item + Name = 'Description' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Details' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'CreatedOn' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'Priority' + DataType = ftInteger + Precision = -1 + end + item + Name = 'Category' + DataType = ftInteger + Precision = -1 + end + item + Name = 'CompletedOn' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'DueDate' + DataType = ftDateTime + Precision = -1 + end> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Tasks' + ) + UpdateSQL.Strings = ( + 'UPDATE' + ' Tasks' + 'SET' + ' ResourceID = :ResourceID,' + ' Description = :Description,' + ' Details = :Details,' + ' Category = :Category,' + ' Priority = :Priority,' + ' Complete = :Complete,' + ' DueDate = :DueDate,' + ' CreatedOn = :CreatedOn,' + ' CompletedOn = :CompletedOn' + 'WHERE' + ' RecordID = :RecordID' + ) + DeleteSQL.Strings = ( + 'DELETE * FROM Tasks' + 'WHERE RecordID = :RecordID' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 136 + top = 621 + end + object ODBCConnection1: TODBCConnection + Connected = True + LoginPrompt = False + KeepConnection = True + Params.Strings = ( + 'DBQ=D:\Prog_Lazarus\svn\lazarus-ccr\components\tvplanit\examples\datastores\flex\access\data.mdb' + ) + Transaction = SQLTransaction1 + Options = [] + Driver = 'Microsoft Access Driver (*.mdb, *.accdb)' + left = 136 + top = 304 + end + object SQLTransaction1: TSQLTransaction + Active = True + Database = ODBCConnection1 + Options = [] + left = 136 + top = 368 + end + object QryAllResources: TSQLQuery + PacketRecords = -1 + FieldDefs = < + item + Name = 'ResourceID' + Attributes = [faReadonly] + DataType = ftAutoInc + Precision = -1 + end + item + Name = 'Description' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Notes' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'ImageIndex' + DataType = ftInteger + Precision = -1 + end + item + Name = 'ResourceActive' + DataType = ftBoolean + Precision = -1 + end + item + Name = 'UserField0' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField1' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField2' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField3' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField4' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField5' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField6' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField7' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField8' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'UserField9' + DataType = ftString + Precision = -1 + Size = 100 + end> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Resources' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 531 + top = 171 + end + object QryAllContacts: TSQLQuery + PacketRecords = -1 + FieldDefs = < + item + Name = 'RecordID' + Attributes = [faReadonly] + DataType = ftAutoInc + Precision = -1 + end + item + Name = 'ResourceID' + DataType = ftInteger + Precision = -1 + end + item + Name = 'FirstName' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'LastName' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'Birthdate' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'Anniversary' + DataType = ftDateTime + Precision = -1 + end + item + Name = 'Title' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'Company' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'Job_Position' + DataType = ftString + Precision = -1 + Size = 30 + end + item + Name = 'Address' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'City' + DataType = ftString + Precision = -1 + Size = 50 + end + item + Name = 'State' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Zip' + DataType = ftString + Precision = -1 + Size = 10 + end + item + Name = 'Country' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Notes' + DataType = ftString + Precision = -1 + Size = 255 + end + item + Name = 'Phone1' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone2' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone3' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone4' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'Phone5' + DataType = ftString + Precision = -1 + Size = 25 + end + item + Name = 'PhoneType1' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType2' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType3' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType4' + DataType = ftInteger + Precision = -1 + end + item + Name = 'PhoneType5' + DataType = ftInteger + Precision = -1 + end + item + Name = 'Category' + DataType = ftInteger + Precision = -1 + end + item + Name = 'EMail' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom1' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom2' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom3' + DataType = ftString + Precision = -1 + Size = 100 + end + item + Name = 'Custom4' + DataType = ftString + Precision = -1 + Size = 100 + end> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Contacts' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 531 + top = 225 + end + object QryAllEvents: TSQLQuery + PacketRecords = -1 + FieldDefs = <> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Events' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 531 + top = 285 + end + object QryAllTasks: TSQLQuery + PacketRecords = -1 + FieldDefs = <> + Database = ODBCConnection1 + Transaction = SQLTransaction1 + SQL.Strings = ( + 'SELECT * FROM Tasks' + ) + Options = [sqoKeepOpenOnCommit, sqoAutoCommit] + Params = <> + UsePrimaryKeyAsKey = False + left = 531 + top = 352 + end + object DsAllResources: TDataSource + DataSet = QryAllResources + left = 627 + top = 171 + end + object DsAllContacts: TDataSource + DataSet = QryAllContacts + left = 630 + top = 225 + end + object DsAllEvents: TDataSource + DataSet = QryAllEvents + left = 625 + top = 285 + end + object DsAllTasks: TDataSource + DataSet = QryAllTasks + left = 627 + top = 352 + end +end diff --git a/components/tvplanit/examples/datastores/flex/access/unit1.pas b/components/tvplanit/examples/datastores/flex/access/unit1.pas new file mode 100644 index 000000000..a24c89ad8 --- /dev/null +++ b/components/tvplanit/examples/datastores/flex/access/unit1.pas @@ -0,0 +1,202 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, + StdCtrls, ComCtrls, DBGrids, DbCtrls, VpBaseDS, VpDayView, VpWeekView, + VpTaskList, VpContactGrid, VpMonthView, VpResEditDlg, VpContactButtons, dbf, + db, sqldb, odbcconn, VpData, VpFlxDS; + +type + + { TForm1 } + + TForm1 = class(TForm) + BtnNewRes: TButton; + BtnEditRes: TButton; + Button1: TButton; + DsAllResources: TDataSource; + DsAllContacts: TDataSource; + DsAllEvents: TDataSource; + DsAllTasks: TDataSource; + Grid: TDBGrid; + DBNavigator: TDBNavigator; + DsTasks: TDataSource; + DsEvents: TDataSource; + DsContacts: TDataSource; + DsResources: TDataSource; + ODBCConnection1: TODBCConnection; + PageControl1: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + Splitter1: TSplitter; + Splitter2: TSplitter; + Splitter3: TSplitter; + QryResources: TSQLQuery; + QryContacts: TSQLQuery; + QryEvents: TSQLQuery; + QryTasks: TSQLQuery; + QryAllResources: TSQLQuery; + QryAllContacts: TSQLQuery; + QryAllEvents: TSQLQuery; + QryAllTasks: TSQLQuery; + SQLTransaction1: TSQLTransaction; + TabControl1: TTabControl; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + TabSheet3: TTabSheet; + VpContactButtonBar1: TVpContactButtonBar; + VpContactGrid1: TVpContactGrid; + VpControlLink1: TVpControlLink; + VpDayView1: TVpDayView; + VpFlexDataStore1: TVpFlexDataStore; + VpMonthView1: TVpMonthView; + VpResourceCombo1: TVpResourceCombo; + VpResourceEditDialog1: TVpResourceEditDialog; + VpTaskList1: TVpTaskList; + VpWeekView1: TVpWeekView; + procedure BtnNewResClick(Sender: TObject); + procedure BtnEditResClick(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure PageControl1Change(Sender: TObject); + procedure TabControl1Change(Sender: TObject); + procedure VpFlexDataStore1SetFilterCriteria(aTable: TDataset; + aUseDateTime: Boolean; aResourceID: Integer; aStartDateTime, + aEndDateTime: TDateTime); + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + dbf_Common, LazFileUtils; + +const + DB_DIR = 'data'; + +{ 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; + +procedure TForm1.Button1Click(Sender: TObject); +begin + VpFlexDatastore1.Load; +end; + +// Setting up the database connection and the datastore. Preselect a resource +// in the resource combo. +procedure TForm1.FormCreate(Sender: TObject); +begin + try + // Connection + ODBCConnection1.Driver := 'Microsoft Access Driver (*.mdb, *.accdb)'; + ODBCConnection1.Params.Add('DBQ=.\data.mdb'); + ODBCConnection1.Connected := true; + ODBCConnection1.KeepConnection := true; + + // Transaction + SQLTransaction1.DataBase := ODBCConnection1; +// SQLTransaction1.Action := caCommit; + SQLTransaction1.Active := True; + + // Connect the datastore. This opens the datasets and loads them into the store. + VpFlexDatastore1.Connected := true; + + // Pre-select the first resource item + if VpFlexDatastore1.Resources.Count > 0 then + VpFlexDatastore1.Resource := VpFlexDatastore1.Resources.Items[0]; + + // Open the additional datasets displayed in the grid + QryAllResources.Open; + QryAllContacts.Open; + QryAllEvents.Open; + QryAllTasks.Open; + + PageControl1.ActivePageIndex := 0; + + except + on E:Exception do + begin + MessageDlg('ERROR', mtError, [mbOK], 0); + Close; + end; + end; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + ODBCConnection1.Connected := false; +end; + +procedure TForm1.PageControl1Change(Sender: TObject); +begin + if PageControl1.PageIndex = 2 then TabControl1Change(nil); +end; + +procedure TForm1.TabControl1Change(Sender: TObject); +var + i: Integer; +begin + case TabControl1.TabIndex of + 0: Grid.Datasource := DsAllResources; + 1: Grid.Datasource := DsAllContacts; + 2: Grid.Datasource := DsAllEvents; + 3: Grid.Datasource := DsAllTasks; + end; + DBNavigator.Datasource := Grid.Datasource; + for i:=0 to Grid.Columns.Count-1 do + Grid.Columns[i].Width := 100;; +end; + +{ This event handler is used by the planner to filter those records from the + specified table which belong to the requested resource ID and are within + the requested time interval. + Note that SQLDB uses the DBF syntax for filtering dates, i.e. + - Convert DateTime field values to strings using DTOS() + - Date parameters must be formatted as yyyymmdd and quoted. + See: http://forum.lazarus.freepascal.org/index.php?topic=23077.0 } +procedure TForm1.VpFlexDataStore1SetFilterCriteria(ATable: TDataset; + AUseDateTime: Boolean; AResourceID: Integer; AStartDateTime, + AEndDateTime: TDateTime); +begin + if AUseDateTime then + ATable.Filter := Format( + '(ResourceID = %d) AND (' + + '((DTOS(StartTime) >= "%s") and (DTOS(EndTime) <= "%s")) OR ' + + '((RepeatCode > 0) and (DTOS(RepeatRangeEnd) >= "%s")) )', [ + AResourceID, + FormatDateTime('yyyymmdd', AStartDateTime), + FormatDateTime('yyyymmdd', AEndDateTime), + FormatDateTime('yyyymmdd', AStartDateTime) + ]) + else + ATable.Filter := Format('ResourceID = %d', [AResourceID]); + ATable.Filtered := true; +end; + +end. + diff --git a/components/tvplanit/source/vpdata.pas b/components/tvplanit/source/vpdata.pas index 9d1fca684..59e897b8e 100644 --- a/components/tvplanit/source/vpdata.pas +++ b/components/tvplanit/source/vpdata.pas @@ -797,8 +797,8 @@ end; procedure TVpResource.SetDescription(const Value: string); begin if Value <> FDescription then begin - if Assigned (Owner) then begin - if Owner.FindResourceByName (Value) <> nil then + if Assigned(Owner) then begin + if Owner.FindResourceByName(Value) <> nil then raise EDuplicateResource.Create; end; diff --git a/components/tvplanit/source/vpflxds.pas b/components/tvplanit/source/vpflxds.pas index f35c2a7a4..c535eb047 100644 --- a/components/tvplanit/source/vpflxds.pas +++ b/components/tvplanit/source/vpflxds.pas @@ -1110,6 +1110,7 @@ procedure TVpFlexDataStore.PostEvents; var J: Integer; Event: TVpEvent; + F: TField; {FieldName} FN: string; begin @@ -1125,6 +1126,7 @@ begin // FN := GetFieldName(FEventMappings, 'ResourceID'); FN := GetFieldName(FResourceMappings, 'ResourceID'); + if (FN <> '') and FResourceDataSrc.DataSet.Locate(FN, Resource.ResourceID, []) then begin SetFilterCriteria(FEventsDataSrc.DataSet, False, Resource.ResourceID, 0, 0); @@ -1153,8 +1155,11 @@ begin try { if a particular descendant datastore uses autoincrementing } { RecordID fields, then don't overwrite them here. } - if Event.RecordID <> -1 then - EventsTable.FieldByName(FN).AsInteger := Event.RecordID; + if (Event.RecordID <> -1) then begin + F := EventsTable.FieldByName(FN); + if not F.ReadOnly then + F.AsInteger := Event.RecordID; + end; FN := GetFieldName(FEventMappings, 'StartTime'); if FN <> '' then @@ -1289,13 +1294,14 @@ begin if Event.RecordID = -1 then Event.RecordID := EventsTable.FieldByName('RecordID').AsInteger; *) + Event.Changed := false; end; end; end; end; Resource.EventsDirty := false; - Resource.Schedule.Sort; + Resource.Schedule.Sort; end; end; if not Loading then @@ -1307,6 +1313,7 @@ procedure TVpFlexDataStore.PostContacts; var I: Integer; Contact: TVpContact; + F: TField; {FieldName} FN : string; begin @@ -1344,8 +1351,11 @@ begin { field set the RecordID to -1 by default. If the RecordID is } { -1 then this is a new record and we shouldn't overwrite } { RecordID with a bogus value } - if Contact.RecordID > -1 then - ContactsTable.FieldByName(FN).AsInteger := Contact.RecordID; + if Contact.RecordID > -1 then begin + F := ContactsTable.FieldByName(FN); + if not F.ReadOnly then + F.AsInteger := Contact.RecordID; + end; FN := GetFieldName(FContactMappings, 'ResourceID'); if FN <> '' then @@ -1540,6 +1550,7 @@ procedure TVpFlexDataStore.PostTasks; var I: Integer; Task: TVpTask; + F: TField; {FieldName} FN: string; begin @@ -1588,8 +1599,11 @@ begin { field set the RecordID to -1 by default. If the RecordID is } { -1 then this is a new record and we shouldn't overwrite } { RecordID with a bogus value } - if Task.RecordID > -1 then - FieldByName(FN).AsInteger := Task.RecordID; + if Task.RecordID > -1 then begin + F := FieldByName(FN); + if not F.ReadOnly then + F.AsInteger := Task.RecordID; + end; FN := GetFieldName(FTaskMappings, 'ResourceID'); if FN <> '' then @@ -1699,6 +1713,7 @@ var Res: TVpResource; {FieldName} FN: string; + isactive: Boolean; begin Loading := true; try @@ -1740,7 +1755,7 @@ begin Append; try - if Res.ResourceID > -1 then + if (Res.ResourceID > -1) and not FieldByName(FN).ReadOnly then FieldByName(FN).AsInteger := Res.ResourceID; FN := GetFieldName(FResourceMappings, 'Description'); @@ -1797,7 +1812,9 @@ begin if FN <> '' then FieldByName(FN).AsString := Res.UserField9; + isactive := Active; Post; + isactive := Active; except Cancel; raise EDBPostError.Create;