From 85f217b38efc8b9cac6aabc664b9e3be67084b46 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 12 Oct 2023 13:53:23 +0000 Subject: [PATCH] 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 --- .../examples/datastores/xml/unit1.lfm | 101 ++++++------------ .../examples/datastores/xml/unit1.pas | 18 ++++ components/tvplanit/source/vpxmlds.pas | 48 +++++++-- 3 files changed, 90 insertions(+), 77 deletions(-) diff --git a/components/tvplanit/examples/datastores/xml/unit1.lfm b/components/tvplanit/examples/datastores/xml/unit1.lfm index 56ddb62a5..960cb5b05 100644 --- a/components/tvplanit/examples/datastores/xml/unit1.lfm +++ b/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 diff --git a/components/tvplanit/examples/datastores/xml/unit1.pas b/components/tvplanit/examples/datastores/xml/unit1.pas index e8d15ac27..ce991dd27 100644 --- a/components/tvplanit/examples/datastores/xml/unit1.pas +++ b/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 diff --git a/components/tvplanit/source/vpxmlds.pas b/components/tvplanit/source/vpxmlds.pas index ffd8ee057..11e86e061 100644 --- a/components/tvplanit/source/vpxmlds.pas +++ b/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; - node, resnode, child, txt: TDOMNode; + i, n: Integer; + node, resroot, resnode, child, txt: TDOMNode; res: TVpResource; begin - node := ADoc.CreateElement('Resources'); - TDOMElement(node).SetAttribute('Count', IntToStr(Resources.Count)); - AParentNode.AppendChild(node); + resRoot := ADoc.CreateElement('Resources'); + AParentNode.AppendChild(resRoot); + 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;