TvPlanIt: Fix leaving orphan events, tasks and contacts in a json datastore when a resource is deleted.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8951 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/datastores/json/unit1.lfm

@@ -6,8 +6,8 @@ object Form1: TForm1
   Caption = 'Form1'
   ClientHeight = 686
   ClientWidth = 980
+  LCLVersion = '3.99.0.0'
   OnCreate = FormCreate
-  LCLVersion = '2.3.0.0'
   object Panel1: TPanel
     Left = 0
     Height = 33
@@ -21,6 +21,8 @@ object Form1: TForm1
     TabOrder = 0
     object VpResourceCombo1: TVpResourceCombo
       AnchorSideLeft.Control = Panel1
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
       Left = 4
       Height = 23
       Top = 5
@@ -34,6 +36,8 @@ object Form1: TForm1
     object BtnNewRes: TButton
       AnchorSideLeft.Control = VpResourceCombo1
       AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
       Left = 216
       Height = 25
       Top = 4
@@ -43,12 +47,14 @@ object Form1: TForm1
       BorderSpacing.Top = 4
       BorderSpacing.Bottom = 4
       Caption = 'New resource'
-      OnClick = BtnNewResClick
       TabOrder = 1
+      OnClick = BtnNewResClick
     end
     object BtnEditRes: TButton
       AnchorSideLeft.Control = BtnNewRes
       AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
       Left = 318
       Height = 25
       Top = 4
@@ -58,8 +64,22 @@ object Form1: TForm1
       BorderSpacing.Top = 4
       BorderSpacing.Bottom = 4
       Caption = 'Edit resource'
-      OnClick = BtnEditResClick
       TabOrder = 2
+      OnClick = BtnEditResClick
+    end
+    object BtnDeleteRes: TButton
+      AnchorSideLeft.Control = BtnEditRes
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 412
+      Height = 25
+      Top = 4
+      Width = 107
+      AutoSize = True
+      Caption = 'Delete resource'
+      TabOrder = 3
+      OnClick = BtnDeleteResClick
     end
   end
   object PageControl1: TPageControl
@@ -80,18 +100,13 @@ object Form1: TForm1
         Height = 625
         Top = 0
         Width = 301
+        PopupMenu = VpDayView1.default
         DataStore = VpJSONDataStore1
         ControlLink = VpControlLink1
-        Color = clWindow
         Font.Height = -12
         ParentFont = False
         Align = alLeft
-        ReadOnly = False
-        TabStop = True
         TabOrder = 0
-        AllDayEventAttributes.BackgroundColor = clBtnShadow
-        AllDayEventAttributes.EventBorderColor = cl3DDkShadow
-        AllDayEventAttributes.EventBackgroundColor = clBtnFace
         AllDayEventAttributes.Font.Height = -12
         AllowDragAndDrop = True
         ShowEventTimes = False
@@ -103,17 +118,10 @@ object Form1: TForm1
         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
@@ -131,31 +139,24 @@ object Form1: TForm1
           Height = 379
           Top = 0
           Width = 386
+          PopupMenu = VpWeekView1.default
           DataStore = VpJSONDataStore1
           ControlLink = VpControlLink1
-          Color = clWindow
           Font.Height = -12
           ParentFont = False
           AllDayEventAttributes.BackgroundColor = clWindow
           AllDayEventAttributes.EventBorderColor = clGray
-          AllDayEventAttributes.EventBackgroundColor = clBtnFace
           AllDayEventAttributes.Font.Height = -12
           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
           EventFont.Height = -12
           HeadAttributes.Font.Height = -12
-          HeadAttributes.Color = clBtnFace
           LineColor = clGray
-          TimeFormat = tf12Hour
-          ShowEventTime = True
           WeekStartsOn = dtMonday
           Align = alClient
-          TabStop = True
           TabOrder = 0
         end
         object VpMonthView1: TVpMonthView
@@ -163,34 +164,22 @@ object Form1: TForm1
           Height = 241
           Top = 384
           Width = 386
+          PopupMenu = VpMonthView1.default
           DataStore = VpJSONDataStore1
           ControlLink = VpControlLink1
-          Color = clWindow
           Font.Height = -12
           ParentFont = False
           Align = alBottom
-          TabStop = True
           TabOrder = 1
-          DateLabelFormat = 'mmmm yyyy'
           DayHeadAttributes.Font.Height = -13
           DayHeadAttributes.Font.Name = 'Tahoma'
-          DayHeadAttributes.Color = clBtnFace
-          DayNameStyle = dsShort
           DayNumberFont.Height = -12
           DrawingStyle = dsFlat
-          EventDayStyle = []
           EventFont.Height = -12
-          HeadAttributes.Color = clBtnFace
-          KBNavigation = True
           OffDayColor = clSilver
-          SelectedDayColor = clRed
-          ShowEvents = True
-          ShowEventTime = False
-          TimeFormat = tf12Hour
           TodayAttributes.Color = clSilver
           TodayAttributes.BorderPen.Color = clRed
           TodayAttributes.BorderPen.Width = 3
-          WeekStartsOn = dtSunday
         end
         object Splitter2: TSplitter
           Cursor = crVSplit
@@ -207,29 +196,16 @@ object Form1: TForm1
         Height = 625
         Top = 0
         Width = 275
+        PopupMenu = VpTaskList1.default
         DataStore = VpJSONDataStore1
         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
+        DrawingStyle = dsFlat
         LineColor = clGray
-        MaxVisibleTasks = 250
         TaskHeadAttributes.Color = clSilver
         TaskHeadAttributes.Font.Height = -12
-        DrawingStyle = dsFlat
-        ShowResourceName = True
       end
       object Splitter1: TSplitter
         Left = 692
@@ -262,21 +238,15 @@ object Form1: TForm1
         Height = 625
         Top = 0
         Width = 932
+        PopupMenu = VpContactGrid1.default
         DataStore = VpJSONDataStore1
         ControlLink = VpControlLink1
-        Color = clWindow
         Font.Height = -12
         ParentFont = False
         Align = alClient
-        TabStop = True
         TabOrder = 1
-        AllowInPlaceEditing = True
-        BarWidth = 3
-        BarColor = clSilver
         ColumnWidth = 200
-        ContactHeadAttributes.Color = clSilver
         ContactHeadAttributes.Font.Height = -12
-        ContactHeadAttributes.Bordered = True
         DrawingStyle = dsFlat
       end
     end
@@ -292,7 +262,7 @@ object Form1: TForm1
     Top = 264
   end
   object VpResourceEditDialog1: TVpResourceEditDialog
-    Version = 'v1.12'
+    Version = 'v1.8.0'
     DataStore = VpJSONDataStore1
     Options = []
     Placement.Position = mpCenter
@@ -308,30 +278,18 @@ object Form1: TForm1
     Top = 527
   end
   object VpJSONDataStore1: TVpJSONDataStore
-    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'
     HiddenCategories.BackgroundColor = clSilver
     HiddenCategories.Color = clGray
-    EnableEventTimer = True
-    PlayEventSounds = True
     OnDisconnect = VpJSONDataStore1Disconnect
     FileName = 'data.json'
     Left = 136

components/tvplanit/examples/datastores/json/unit1.pas

@@ -21,6 +21,7 @@ type
   TForm1 = class(TForm)
     BtnNewRes: TButton;
     BtnEditRes: TButton;
+    BtnDeleteRes: TButton;
     PageControl1: TPageControl;
     Panel1: TPanel;
     Panel2: TPanel;
@@ -40,6 +41,7 @@ type
     VpResourceEditDialog1: TVpResourceEditDialog;
     VpTaskList1: TVpTaskList;
     VpWeekView1: TVpWeekView;
+    procedure BtnDeleteResClick(Sender: TObject);
     procedure BtnNewResClick(Sender: TObject);
     procedure BtnEditResClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -64,10 +66,21 @@ uses
 
 { TForm1 }
 
-// Adds a new resource
+// Deletes the currently selected resource
-procedure TForm1.BtnNewResClick(Sender: TObject);
+procedure TForm1.BtnDeleteResClick(Sender: TObject);
+var
+  res: TVpResource;
 begin
-  VpResourceEditDialog1.AddNewResource;
+  res := VpControlLink1.Datastore.Resource;
+  if res = nil then
+    exit;
+
+  if MessageDlg('Do you really want to delete the resource "' + res.Description + '"?',
+    mtConfirmation, [mbYes, mbNo], 0) <> mrYes
+  then
+    exit;
+
+  VpControlLink1.Datastore.DeleteResource(res);
 end;
 
 // Edits the currently selected resource
@@ -77,6 +90,12 @@ begin
   VpResourceEditDialog1.Execute;
 end;
 
+// Adds a new resource
+procedure TForm1.BtnNewResClick(Sender: TObject);
+begin
+  VpResourceEditDialog1.AddNewResource;
+end;
+
 // Load the last resource.
 procedure TForm1.FormCreate(Sender: TObject);
 var

components/tvplanit/examples/datastores/xml/unit1.pas

@@ -38,8 +38,8 @@ type
     VpWeekView1: TVpWeekView;
     VpXmlDatastore1: TVpXmlDatastore;
     procedure BtnDeleteResClick(Sender: TObject);
-    procedure BtnNewResClick(Sender: TObject);
     procedure BtnEditResClick(Sender: TObject);
+    procedure BtnNewResClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
   private
     { private declarations }
@@ -67,6 +67,7 @@ begin
   VpResourceEditDialog1.AddNewResource;
 end;
 
+// Deletes the currently selected resource
 procedure TForm1.BtnDeleteResClick(Sender: TObject);
 var
   res: TVpResource;

components/tvplanit/source/vpjsonds.pas

@@ -28,6 +28,9 @@ type
 
   protected
     { ancestor methods }
+    procedure InternalPurgeContacts(Res: TVpResource); override;
+    procedure InternalPurgeEvents(Res: TVpResource); override;
+    procedure InternalPurgeTasks(Res: TVpResource); override;
     procedure Loaded; override;
     procedure SetConnected(const Value: boolean); override;
 
@@ -68,6 +71,8 @@ type
     procedure PostTasks; override;
     procedure PostResources; override;
 
+    procedure PurgeResource(Res: TVpResource); override;
+
     procedure SetResourceByName(Value: String); override;
 
   published
@@ -241,6 +246,21 @@ begin
   until UniqueID(Result) and (Result <> -1);
 end;
 
+procedure TVpJSONDataStore.InternalPurgeContacts(Res: TVpResource);
+begin
+  Res.Contacts.ClearContacts;
+end;
+
+procedure TVpJSONDataStore.InternalPurgeEvents(Res: TVpResource);
+begin
+  Res.Schedule.ClearEvents;
+end;
+
+procedure TVpJSONDataStore.InternalPurgeTasks(Res: TVpResource);
+begin
+  Res.Tasks.ClearTasks;
+end;
+
 function TVpJSONDatastore.JSONToContact(AObj: TJSONObject;
   AResource: TVpResource): TVpContact;
 var
@@ -497,6 +517,15 @@ begin
   RefreshTasks;
 end;
 
+procedure TVpJSONDataStore.PurgeResource(Res: TVpResource);
+begin
+  PurgeEvents(Res);
+  PurgeContacts(Res);
+  PurgeTasks(Res);
+  Res.Deleted := true;
+  inherited PurgeResource(Res);
+end;
+
 procedure TVpJSONDatastore.ReadJSON;
 begin
   case FStoreType of