pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8950 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-12 13:53:23 +00:00
parent 45a8be0a99
commit 85f217b38e
3 changed files with 90 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
components/tvplanit/examples/datastores/xml/unit1.lfm
View File

@ -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

18
components/tvplanit/examples/datastores/xml/unit1.pas
View File

@ -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

48
components/tvplanit/source/vpxmlds.pas
View File

@ -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;