tvplanit: add demo for sqlite3datastore (based on SQLDB)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4769 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-18 19:02:42 +00:00
parent 6dc495dea2
commit aafafb3e26
5 changed files with 545 additions and 29 deletions

View File

@ -0,0 +1,93 @@
<?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="6">
<Item1>
<PackageName Value="SQLDBLaz"/>
</Item1>
<Item2>
<PackageName Value="laz_visualplanit_sqlite3"/>
</Item2>
<Item3>
<PackageName Value="laz_visualplanit_zeos"/>
</Item3>
<Item4>
<PackageName Value="laz_visualplanit"/>
</Item4>
<Item5>
<PackageName Value="zcomponent"/>
</Item5>
<Item6>
<PackageName Value="LCL"/>
</Item6>
</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)"/>
<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>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, laz_visualplanit, zcomponent
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,321 @@
object Form1: TForm1
Left = 225
Height = 686
Top = 155
Width = 980
Caption = 'Form1'
ClientHeight = 686
ClientWidth = 980
OnCreate = FormCreate
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 = VpSqlite3Datastore1
Style = csDropDownList
end
object BtnNewRes: TButton
Left = 222
Height = 25
Top = 4
Width = 99
Caption = 'New resource'
OnClick = BtnNewResClick
TabOrder = 1
end
object BtnEditRes: TButton
Left = 328
Height = 25
Top = 4
Width = 96
Caption = 'Edit resource'
OnClick = BtnEditResClick
TabOrder = 2
end
end
object PageControl1: TPageControl
Left = 0
Height = 652
Top = 34
Width = 980
ActivePage = TabSheet1
Align = alClient
TabIndex = 0
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Events and tasks'
ClientHeight = 624
ClientWidth = 972
object VpDayView1: TVpDayView
Left = 0
Height = 624
Top = 0
Width = 301
DataStore = VpSqlite3Datastore1
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 = VpSqlite3Datastore1
ControlLink = VpControlLink1
Color = clWindow
AllDayEventAttributes.BackgroundColor = clWindow
AllDayEventAttributes.EventBorderColor = clGray
AllDayEventAttributes.EventBackgroundColor = clBtnFace
Align = alClient
TabStop = True
TabOrder = 0
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
end
object VpMonthView1: TVpMonthView
Left = 0
Height = 241
Top = 383
Width = 386
DataStore = VpSqlite3Datastore1
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 = []
LineColor = clGray
TimeFormat = tf12Hour
OffDayColor = clSilver
SelectedDayColor = clRed
ShowEvents = True
ShowEventTime = False
WeekStartsOn = dtSunday
end
object Splitter2: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 378
Width = 386
Align = alBottom
ResizeAnchor = akBottom
end
end
object VpTaskList1: TVpTaskList
Left = 697
Height = 624
Top = 0
Width = 275
DataStore = VpSqlite3Datastore1
ControlLink = VpControlLink1
Color = clWindow
Align = alClient
TabStop = True
TabOrder = 2
ReadOnly = False
DisplayOptions.CheckBGColor = clWindow
DisplayOptions.CheckColor = cl3DDkShadow
DisplayOptions.CheckStyle = csCheck
DisplayOptions.DueDateFormat = 'dd.MM.yyyy'
DisplayOptions.ShowCompletedTasks = False
DisplayOptions.ShowAll = False
DisplayOptions.ShowDueDate = True
DisplayOptions.OverdueColor = clRed
DisplayOptions.NormalColor = clBlack
DisplayOptions.CompletedColor = clGray
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
DrawingStyle = dsFlat
ShowResourceName = True
end
object Splitter1: TSplitter
Left = 692
Height = 624
Top = 0
Width = 5
end
object Splitter3: TSplitter
Left = 301
Height = 624
Top = 0
Width = 5
end
end
object TabSheet2: TTabSheet
Caption = 'Contacts'
ClientHeight = 594
ClientWidth = 928
object VpContactButtonBar1: TVpContactButtonBar
Left = 0
Height = 594
Top = 0
Width = 40
DrawingStyle = dsFlat
RadioStyle = False
Align = alLeft
end
object VpContactGrid1: TVpContactGrid
Left = 40
Height = 594
Top = 0
Width = 888
DataStore = VpSqlite3Datastore1
ControlLink = VpControlLink1
Color = clWindow
Align = alClient
TabStop = True
TabOrder = 1
AllowInPlaceEditing = True
BarWidth = 3
BarColor = clSilver
ColumnWidth = 200
ContactHeadAttributes.Color = clSilver
ContactHeadAttributes.Bordered = True
DrawingStyle = dsFlat
end
end
end
object VpControlLink1: TVpControlLink
DataStore = VpSqlite3Datastore1
Printer.BottomMargin = 0
Printer.DayStart = h_08
Printer.DayEnd = h_05
Printer.Granularity = gr30Min
Printer.LeftMargin = 0
Printer.MarginUnits = imAbsolutePixel
Printer.PrintFormats = <>
Printer.RightMargin = 0
Printer.TopMargin = 0
left = 136
top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.04'
DataStore = VpSqlite3Datastore1
Options = []
Placement.Position = mpCenter
Placement.Top = 10
Placement.Left = 10
Placement.Height = 250
Placement.Width = 400
left = 136
top = 335
end
object VpSqlite3Datastore1: TVpSqlite3Datastore
CategoryColorMap.Category0.Color = clNavy
CategoryColorMap.Category0.Description = 'Category 0'
CategoryColorMap.Category1.Color = clRed
CategoryColorMap.Category1.Description = 'Category 1'
CategoryColorMap.Category2.Color = clYellow
CategoryColorMap.Category2.Description = 'Category 2'
CategoryColorMap.Category3.Color = clLime
CategoryColorMap.Category3.Description = 'Category 3'
CategoryColorMap.Category4.Color = clPurple
CategoryColorMap.Category4.Description = 'Category 4'
CategoryColorMap.Category5.Color = clTeal
CategoryColorMap.Category5.Description = 'Category 5'
CategoryColorMap.Category6.Color = clFuchsia
CategoryColorMap.Category6.Description = 'Category 6'
CategoryColorMap.Category7.Color = clOlive
CategoryColorMap.Category7.Description = 'Category 7'
CategoryColorMap.Category8.Color = clAqua
CategoryColorMap.Category8.Description = 'Category 8'
CategoryColorMap.Category9.Color = clMaroon
CategoryColorMap.Category9.Description = 'Category 9'
EnableEventTimer = True
PlayEventSounds = True
Connection = SQLite3Connection1
AutoConnect = False
AutoCreate = False
Connected = False
left = 136
top = 192
end
object SQLite3Connection1: TSQLite3Connection
Connected = False
LoginPrompt = False
KeepConnection = False
Transaction = SQLTransaction1
Options = []
left = 136
top = 120
end
object SQLTransaction1: TSQLTransaction
Active = False
Action = caCommit
Database = SQLite3Connection1
Options = []
left = 256
top = 120
end
end

View File

@ -0,0 +1,103 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, VpBaseDS, VpDayView, VpWeekView, VpTaskList,
VpContactGrid, VpMonthView, VpResEditDlg, VpContactButtons, VpSQLite3DS,
sqlite3conn, sqldb;
type
{ TForm1 }
TForm1 = class(TForm)
BtnNewRes: TButton;
BtnEditRes: TButton;
PageControl1: TPageControl;
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
Splitter2: TSplitter;
Splitter3: TSplitter;
SQLite3Connection1: TSQLite3Connection;
SQLTransaction1: TSQLTransaction;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
VpContactButtonBar1: TVpContactButtonBar;
VpContactGrid1: TVpContactGrid;
VpControlLink1: TVpControlLink;
VpDayView1: TVpDayView;
VpMonthView1: TVpMonthView;
VpResourceCombo1: TVpResourceCombo;
VpResourceEditDialog1: TVpResourceEditDialog;
VpSqlite3Datastore1: TVpSqlite3Datastore;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
LazFileUtils;
const
DBFILENAME = 'data.db';
{ TForm1 }
// Adds a new resource
procedure TForm1.BtnNewResClick(Sender: TObject);
begin
VpResourceEditDialog1.AddNewResource;
end;
// Edits the currently selected resource
procedure TForm1.BtnEditResClick(Sender: TObject);
begin
// Open the resource editor dialog, everything is done here.
VpResourceEditDialog1.Execute;
end;
// Setting up the database connection and the datastore. Preselect a resource
// in the resource combo.
procedure TForm1.FormCreate(Sender: TObject);
begin
try
SQLite3Connection1.DatabaseName := AppendPathDelim(Application.Location) + DBFILENAME;
SQLTransaction1.Action := caCommit;
VpSqlite3Datastore1.Connection := SQLite3Connection1;
VpSqlite3Datastore1.AutoCreate := true;
VpSqlite3Datastore1.Connected := true;
if VpSqlite3Datastore1.Resources.Count > 0 then
VpSqlite3Datastore1.ResourceID := VpSqlite3Datastore1.Resources.Items[0].ResourceID;
except
on E:Exception do
begin
MessageDlg('sqlite3.dll not found. Copy it to the exe folder and restart the program.',
mtError, [mbOK], 0);
Close;
end;
end;
end;
end.

View File

@ -84,10 +84,14 @@ end;
// Connection and tables are active afterwards!
procedure TVpSqlite3Datastore.CreateTables;
var
wasConnected: Boolean;
begin
if FileExists(FConnection.DatabaseName) then
exit;
wasConnected := FConnection.Connected;
FConnection.Close;
if FContactsTable.Transaction = nil then
@ -99,38 +103,12 @@ begin
if FTasksTable.Transaction = nil then
FTasksTable.Transaction := FConnection.Transaction;
FConnection.Connected := true;
FConnection.Transaction.Active := true;
// Per the SQLite Documentation (edited for clarity):
// The pragma user_version is used to set or get the value of the user-version.
// The user-version is a big-endian 32-bit signed integer stored in the database header at offset 60.
// The user-version is not used internally by SQLite. It may be used by applications for any purpose.
// http://www.sqlite.org/pragma.html#pragma_schema_version
// FConnection.ExecuteDirect('PRAGMA user_version = ' + IntToStr(USER_VERSION) + ';');
// Per the SQLite Documentation:
// The application_id PRAGMA is used to query or set the 32-bit unsigned big-endian
// "Application ID" integer located at offset 68 into the database header.
// Applications that use SQLite as their application file-format should set the
// Application ID integer to a unique integer so that utilities such as file(1) can
// determine the specific file type rather than just reporting "SQLite3 Database".
// A list of assigned application IDs can be seen by consulting the magic.txt file
// in the SQLite source repository.
// http://www.sqlite.org/pragma.html#pragma_application_id
// FConnection.ExecuteDirect('PRAGMA application_id = ' + IntToStr(APPLICATION_ID) + ';');
CreateTable(ContactsTableName);
CreateTable(EventsTableName);
CreateTable(ResourceTableName);
CreateTable(TasksTableName);
FConnection.Transaction.Commit;
FConnection.Connected := false;
Connected := AutoConnect;
//OpenTables;
SetConnected(wasConnected or AutoConnect);
end;
procedure TVpSqlite3Datastore.CreateTable(const ATableName: String);
@ -318,7 +296,7 @@ procedure TVpSqlite3Datastore.Loaded;
begin
inherited;
if not (csDesigning in ComponentState) then
Connected := AutoConnect;
Connected := AutoConnect and (AutoCreate or FileExists(FConnection.DatabaseName));
end;
procedure TVpSqlite3Datastore.Notification(AComponent: TComponent;
@ -377,7 +355,7 @@ begin
if (FConnection = nil) or (FConnection.Transaction = nil) then
exit;
if AValue = Connected then
if AValue = FConnection.Connected then
exit;
if AValue and AutoCreate then