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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8951 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-12 14:13:03 +00:00
parent 85f217b38e
commit ad75d24647
4 changed files with 83 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files

102
components/tvplanit/examples/datastores/json/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,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

25
components/tvplanit/examples/datastores/json/unit1.pas
View File

@ -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
procedure TForm1.BtnNewResClick(Sender: TObject);
// Deletes the currently selected resource
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

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

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

29
components/tvplanit/source/vpjsonds.pas
View File

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