From aafafb3e2618eda1aec326f9aa19d316ac879c1e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 18 Jun 2016 19:02:42 +0000 Subject: [PATCH] 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 --- .../examples/sqlite3datastore/project1.lpi | 93 +++++ .../examples/sqlite3datastore/project1.lpr | 21 ++ .../examples/sqlite3datastore/unit1.lfm | 321 ++++++++++++++++++ .../examples/sqlite3datastore/unit1.pas | 103 ++++++ components/tvplanit/source/vpsqlite3ds.pas | 36 +- 5 files changed, 545 insertions(+), 29 deletions(-) create mode 100644 components/tvplanit/examples/sqlite3datastore/project1.lpi create mode 100644 components/tvplanit/examples/sqlite3datastore/project1.lpr create mode 100644 components/tvplanit/examples/sqlite3datastore/unit1.lfm create mode 100644 components/tvplanit/examples/sqlite3datastore/unit1.pas diff --git a/components/tvplanit/examples/sqlite3datastore/project1.lpi b/components/tvplanit/examples/sqlite3datastore/project1.lpi new file mode 100644 index 000000000..d1c152c63 --- /dev/null +++ b/components/tvplanit/examples/sqlite3datastore/project1.lpi @@ -0,0 +1,93 @@ + + + + + + + + + + <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> diff --git a/components/tvplanit/examples/sqlite3datastore/project1.lpr b/components/tvplanit/examples/sqlite3datastore/project1.lpr new file mode 100644 index 000000000..ac5b2c34d --- /dev/null +++ b/components/tvplanit/examples/sqlite3datastore/project1.lpr @@ -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. + diff --git a/components/tvplanit/examples/sqlite3datastore/unit1.lfm b/components/tvplanit/examples/sqlite3datastore/unit1.lfm new file mode 100644 index 000000000..48a9a09ac --- /dev/null +++ b/components/tvplanit/examples/sqlite3datastore/unit1.lfm @@ -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 diff --git a/components/tvplanit/examples/sqlite3datastore/unit1.pas b/components/tvplanit/examples/sqlite3datastore/unit1.pas new file mode 100644 index 000000000..958787a7c --- /dev/null +++ b/components/tvplanit/examples/sqlite3datastore/unit1.pas @@ -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. + diff --git a/components/tvplanit/source/vpsqlite3ds.pas b/components/tvplanit/source/vpsqlite3ds.pas index 41128ba06..af1385c98 100644 --- a/components/tvplanit/source/vpsqlite3ds.pas +++ b/components/tvplanit/source/vpsqlite3ds.pas @@ -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