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

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

components/tvplanit/examples/datastores/xml/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,7 @@ object Form1: TForm1
     object BtnNewRes: TButton
       AnchorSideLeft.Control = VpResourceCombo1
       AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
       Left = 216
       Height = 25
       Top = 4
@@ -43,12 +46,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 +63,23 @@ 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 = 416
+      Height = 25
+      Top = 4
+      Width = 107
+      AutoSize = True
+      BorderSpacing.Left = 4
+      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 = VpXmlDatastore1
         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 = VpXmlDatastore1
           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 = VpXmlDatastore1
           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 = VpXmlDatastore1
         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
@@ -263,21 +239,16 @@ object Form1: TForm1
         Height = 625
         Top = 0
         Width = 932
+        PopupMenu = VpContactGrid1.default
         DataStore = VpXmlDatastore1
         ControlLink = VpControlLink1
-        Color = clWindow
         Font.Height = -12
         ParentFont = False
         Align = alClient
-        TabStop = True
         TabOrder = 1
         AllowInPlaceEditing = False
-        BarWidth = 3
-        BarColor = clSilver
         ColumnWidth = 200
-        ContactHeadAttributes.Color = clSilver
         ContactHeadAttributes.Font.Height = -12
-        ContactHeadAttributes.Bordered = True
         DrawingStyle = dsFlat
       end
     end
@@ -293,7 +264,7 @@ object Form1: TForm1
     Top = 264
   end
   object VpResourceEditDialog1: TVpResourceEditDialog
-    Version = 'v1.12'
+    Version = 'v1.8.0'
     DataStore = VpXmlDatastore1
     Options = []
     Placement.Position = mpCenter
@@ -309,30 +280,18 @@ object Form1: TForm1
     Top = 527
   end
   object VpXmlDatastore1: TVpXmlDatastore
-    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
     AutoConnect = True
     FileName = 'data.xml'
     Left = 136

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

@@ -17,6 +17,7 @@ type
   TForm1 = class(TForm)
     BtnNewRes: TButton;
     BtnEditRes: TButton;
+    BtnDeleteRes: TButton;
     PageControl1: TPageControl;
     Panel1: TPanel;
     Panel2: TPanel;
@@ -36,6 +37,7 @@ type
     VpTaskList1: TVpTaskList;
     VpWeekView1: TVpWeekView;
     VpXmlDatastore1: TVpXmlDatastore;
+    procedure BtnDeleteResClick(Sender: TObject);
     procedure BtnNewResClick(Sender: TObject);
     procedure BtnEditResClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -65,6 +67,22 @@ begin
   VpResourceEditDialog1.AddNewResource;
 end;
 
+procedure TForm1.BtnDeleteResClick(Sender: TObject);
+var
+  res: TVpResource;
+begin
+  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
 procedure TForm1.BtnEditResClick(Sender: TObject);
 begin

components/tvplanit/source/vpxmlds.pas

@@ -28,6 +28,10 @@ type
     function CreateStoreNode(ADoc: TDOMDocument): TDOMNode;
     function FindStoreNode(ADoc: TDOMDocument): TDOMNode;
 
+    procedure InternalPurgeContacts(Res: TVpResource); override;
+    procedure InternalPurgeEvents(Res: TVpResource); override;
+    procedure InternalPurgeTasks(Res: TVpResource); override;
+
     procedure ReadContact(ANode: TDOMNode; AContacts: TVpContacts);
     procedure ReadContacts(ANode: TDOMNode; AContacts: TVpContacts);
     procedure ReadEvent(ANode: TDOMNode; ASchedule: TVpSchedule);
@@ -64,6 +68,8 @@ type
     procedure PostResources; override;
     procedure PostTasks; override;
 
+    procedure PurgeResource(Res: TVpResource); override;
+
   published
     property AutoConnect default false;
     property FileName: String read FFileName write SetFileName;
@@ -396,6 +402,21 @@ begin
   until UniqueID(Result) and (Result <> -1);
 end;
 
+procedure TVpXmlDataStore.InternalPurgeContacts(Res: TVpResource);
+begin
+  Res.Contacts.ClearContacts;
+end;
+
+procedure TVpXmlDataStore.InternalPurgeEvents(Res: TVpResource);
+begin
+  Res.Schedule.ClearEvents;
+end;
+
+procedure TVpXmlDataStore.InternalPurgeTasks(Res: TVpResource);
+begin
+  Res.Tasks.ClearTasks;
+end;
+
 procedure TVpXmlDatastore.Loaded;
 begin
   inherited;
@@ -537,6 +558,15 @@ begin
   RefreshTasks;
 end;
 
+procedure TVpXmlDataStore.PurgeResource(Res: TVpResource);
+begin
+  PurgeEvents(Res);
+  PurgeContacts(Res);
+  PurgeTasks(Res);
+  Res.Deleted := true;
+  inherited PurgeResource(Res);
+end;
+
 procedure TVpXmlDatastore.ReadFromXml;
 var
   doc: TXMLDocument;
@@ -1457,23 +1487,27 @@ end;
 
 procedure TVpXmlDatastore.WriteResources(ADoc: TDOMDocument; AParentNode: TDOMNode);
 var
-  i: Integer;
+  i, n: Integer;
-  node, resnode, child, txt: TDOMNode;
+  node, resroot, resnode, child, txt: TDOMNode;
   res: TVpResource;
 begin
-  node := ADoc.CreateElement('Resources');
+  resRoot := ADoc.CreateElement('Resources');
-  TDOMElement(node).SetAttribute('Count', IntToStr(Resources.Count));
+  AParentNode.AppendChild(resRoot);
-  AParentNode.AppendChild(node);
 
+  n := 0;   // Counter of "Resource" nodes
   for i:=0 to Resources.Count-1 do begin
     res := Resources.Items[i];
+    if res.Deleted then
+      Continue;
+
+    inc(n);
 
     resNode := ADoc.CreateElement('Resource');
     with TDOMElement(resNode) do begin
       SetAttribute('ResourceID', IntToStr(res.ResourceID));
       SetAttribute('ResourceActive', BoolToStr(res.ResourceActive, strTRUE, strFALSE));
     end;
-    node.AppendChild(resnode);
+    resRoot.AppendChild(resnode);
 
     if res.Description <> '' then begin
       child := ADoc.CreateElement('Description');
@@ -1563,6 +1597,8 @@ begin
     WriteEvents(ADoc, resnode, res);
     WriteTasks(ADoc, resNode, res);
   end;
+
+  TDOMElement(resRoot).SetAttribute('Count', IntToStr(n));
 end;
 
 procedure TVpXmlDatastore.WriteTask(ADoc: TDOMDocument; ATaskNode: TDOMNode;