You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -0,0 +1,88 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="project1"/>
|
||||||
|
<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>
|
||||||
@ -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.
|
||||||
|
|
||||||
104
components/tvplanit/examples/datastores/flex/access/readme.txt
Normal file
104
components/tvplanit/examples/datastores/flex/access/readme.txt
Normal file
@ -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.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -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>
|
||||||
@ -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.
|
||||||
|
|
||||||
@ -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
|
||||||
@ -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.
|
||||||
|
|
||||||
1474
components/tvplanit/examples/datastores/flex/access/unit1.lfm
Normal file
1474
components/tvplanit/examples/datastores/flex/access/unit1.lfm
Normal file
File diff suppressed because it is too large
Load Diff
202
components/tvplanit/examples/datastores/flex/access/unit1.pas
Normal file
202
components/tvplanit/examples/datastores/flex/access/unit1.pas
Normal file
@ -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.
|
||||||
|
|
||||||
@ -1110,6 +1110,7 @@ procedure TVpFlexDataStore.PostEvents;
|
|||||||
var
|
var
|
||||||
J: Integer;
|
J: Integer;
|
||||||
Event: TVpEvent;
|
Event: TVpEvent;
|
||||||
|
F: TField;
|
||||||
{FieldName}
|
{FieldName}
|
||||||
FN: string;
|
FN: string;
|
||||||
begin
|
begin
|
||||||
@ -1125,6 +1126,7 @@ begin
|
|||||||
|
|
||||||
// FN := GetFieldName(FEventMappings, 'ResourceID');
|
// FN := GetFieldName(FEventMappings, 'ResourceID');
|
||||||
FN := GetFieldName(FResourceMappings, 'ResourceID');
|
FN := GetFieldName(FResourceMappings, 'ResourceID');
|
||||||
|
|
||||||
if (FN <> '') and FResourceDataSrc.DataSet.Locate(FN, Resource.ResourceID, [])
|
if (FN <> '') and FResourceDataSrc.DataSet.Locate(FN, Resource.ResourceID, [])
|
||||||
then begin
|
then begin
|
||||||
SetFilterCriteria(FEventsDataSrc.DataSet, False, Resource.ResourceID, 0, 0);
|
SetFilterCriteria(FEventsDataSrc.DataSet, False, Resource.ResourceID, 0, 0);
|
||||||
@ -1153,8 +1155,11 @@ begin
|
|||||||
try
|
try
|
||||||
{ if a particular descendant datastore uses autoincrementing }
|
{ 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
|
if (Event.RecordID <> -1) then begin
|
||||||
EventsTable.FieldByName(FN).AsInteger := Event.RecordID;
|
F := EventsTable.FieldByName(FN);
|
||||||
|
if not F.ReadOnly then
|
||||||
|
F.AsInteger := Event.RecordID;
|
||||||
|
end;
|
||||||
|
|
||||||
FN := GetFieldName(FEventMappings, 'StartTime');
|
FN := GetFieldName(FEventMappings, 'StartTime');
|
||||||
if FN <> '' then
|
if FN <> '' then
|
||||||
@ -1289,6 +1294,7 @@ begin
|
|||||||
if Event.RecordID = -1 then
|
if Event.RecordID = -1 then
|
||||||
Event.RecordID := EventsTable.FieldByName('RecordID').AsInteger;
|
Event.RecordID := EventsTable.FieldByName('RecordID').AsInteger;
|
||||||
*)
|
*)
|
||||||
|
|
||||||
Event.Changed := false;
|
Event.Changed := false;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1307,6 +1313,7 @@ procedure TVpFlexDataStore.PostContacts;
|
|||||||
var
|
var
|
||||||
I: Integer;
|
I: Integer;
|
||||||
Contact: TVpContact;
|
Contact: TVpContact;
|
||||||
|
F: TField;
|
||||||
{FieldName}
|
{FieldName}
|
||||||
FN : string;
|
FN : string;
|
||||||
begin
|
begin
|
||||||
@ -1344,8 +1351,11 @@ begin
|
|||||||
{ field set the RecordID to -1 by default. If the RecordID is }
|
{ field set the RecordID to -1 by default. If the RecordID is }
|
||||||
{ -1 then this is a new record and we shouldn't overwrite }
|
{ -1 then this is a new record and we shouldn't overwrite }
|
||||||
{ RecordID with a bogus value }
|
{ RecordID with a bogus value }
|
||||||
if Contact.RecordID > -1 then
|
if Contact.RecordID > -1 then begin
|
||||||
ContactsTable.FieldByName(FN).AsInteger := Contact.RecordID;
|
F := ContactsTable.FieldByName(FN);
|
||||||
|
if not F.ReadOnly then
|
||||||
|
F.AsInteger := Contact.RecordID;
|
||||||
|
end;
|
||||||
|
|
||||||
FN := GetFieldName(FContactMappings, 'ResourceID');
|
FN := GetFieldName(FContactMappings, 'ResourceID');
|
||||||
if FN <> '' then
|
if FN <> '' then
|
||||||
@ -1540,6 +1550,7 @@ procedure TVpFlexDataStore.PostTasks;
|
|||||||
var
|
var
|
||||||
I: Integer;
|
I: Integer;
|
||||||
Task: TVpTask;
|
Task: TVpTask;
|
||||||
|
F: TField;
|
||||||
{FieldName}
|
{FieldName}
|
||||||
FN: string;
|
FN: string;
|
||||||
begin
|
begin
|
||||||
@ -1588,8 +1599,11 @@ begin
|
|||||||
{ field set the RecordID to -1 by default. If the RecordID is }
|
{ field set the RecordID to -1 by default. If the RecordID is }
|
||||||
{ -1 then this is a new record and we shouldn't overwrite }
|
{ -1 then this is a new record and we shouldn't overwrite }
|
||||||
{ RecordID with a bogus value }
|
{ RecordID with a bogus value }
|
||||||
if Task.RecordID > -1 then
|
if Task.RecordID > -1 then begin
|
||||||
FieldByName(FN).AsInteger := Task.RecordID;
|
F := FieldByName(FN);
|
||||||
|
if not F.ReadOnly then
|
||||||
|
F.AsInteger := Task.RecordID;
|
||||||
|
end;
|
||||||
|
|
||||||
FN := GetFieldName(FTaskMappings, 'ResourceID');
|
FN := GetFieldName(FTaskMappings, 'ResourceID');
|
||||||
if FN <> '' then
|
if FN <> '' then
|
||||||
@ -1699,6 +1713,7 @@ var
|
|||||||
Res: TVpResource;
|
Res: TVpResource;
|
||||||
{FieldName}
|
{FieldName}
|
||||||
FN: string;
|
FN: string;
|
||||||
|
isactive: Boolean;
|
||||||
begin
|
begin
|
||||||
Loading := true;
|
Loading := true;
|
||||||
try
|
try
|
||||||
@ -1740,7 +1755,7 @@ begin
|
|||||||
Append;
|
Append;
|
||||||
|
|
||||||
try
|
try
|
||||||
if Res.ResourceID > -1 then
|
if (Res.ResourceID > -1) and not FieldByName(FN).ReadOnly then
|
||||||
FieldByName(FN).AsInteger := Res.ResourceID;
|
FieldByName(FN).AsInteger := Res.ResourceID;
|
||||||
|
|
||||||
FN := GetFieldName(FResourceMappings, 'Description');
|
FN := GetFieldName(FResourceMappings, 'Description');
|
||||||
@ -1797,7 +1812,9 @@ begin
|
|||||||
if FN <> '' then
|
if FN <> '' then
|
||||||
FieldByName(FN).AsString := Res.UserField9;
|
FieldByName(FN).AsString := Res.UserField9;
|
||||||
|
|
||||||
|
isactive := Active;
|
||||||
Post;
|
Post;
|
||||||
|
isactive := Active;
|
||||||
except
|
except
|
||||||
Cancel;
|
Cancel;
|
||||||
raise EDBPostError.Create;
|
raise EDBPostError.Create;
|
||||||
|
|||||||
Reference in New Issue
Block a user