TvPlanIt: Deletion of a resource deletes also the associated events, contacts and tasks. Tested with all database datastores. Update datastore sample projects.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8947 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-10-10 22:24:46 +00:00
parent f54a1641df
commit f0d8344fee
19 changed files with 611 additions and 692 deletions

View File

@@ -66,6 +66,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>

View File

@@ -6,66 +6,81 @@ 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
Height = 34
Top = 0
Width = 980
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 33
ClientHeight = 34
ClientWidth = 980
TabOrder = 0
object VpResourceCombo1: TVpResourceCombo
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 4
Height = 23
Top = 5
Top = 6
Width = 208
DataStore = VpZeosDatastore1
Style = csDropDownList
Borderspacing.Left = 4
Borderspacing.Top = 4
Borderspacing.Bottom = 4
Borderspacing.Around = 4
end
object BtnNewRes: TButton
AnchorSideLeft.Control = VpResourceCombo1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 216
Height = 25
Top = 4
Top = 5
Width = 98
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
BorderSpacing.Around = 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
Top = 5
Width = 94
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
BorderSpacing.Around = 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 = 5
Width = 107
AutoSize = True
BorderSpacing.Around = 4
Caption = 'Delete resource'
TabOrder = 3
OnClick = BtnDeleteResClick
end
end
object PageControl1: TPageControl
Left = 0
Height = 653
Top = 33
Height = 652
Top = 34
Width = 980
ActivePage = TabSheet1
Align = alClient
@@ -73,23 +88,18 @@ object Form1: TForm1
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Events and tasks'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 972
object VpDayView1: TVpDayView
Left = 0
Height = 625
Height = 624
Top = 0
Width = 301
PopupMenu = VpDayView1.default
DataStore = VpZeosDatastore1
ControlLink = VpControlLink1
Color = clWindow
Align = alLeft
ReadOnly = False
TabStop = True
TabOrder = 0
AllDayEventAttributes.BackgroundColor = clBtnShadow
AllDayEventAttributes.EventBorderColor = cl3DDkShadow
AllDayEventAttributes.EventBackgroundColor = clBtnFace
AllowDragAndDrop = True
ShowEventTimes = False
DrawingStyle = dsFlat
@@ -100,91 +110,65 @@ 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
Height = 625
Height = 624
Top = 0
Width = 386
Align = alLeft
BevelOuter = bvNone
Caption = 'Panel2'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 386
TabOrder = 1
object VpWeekView1: TVpWeekView
Left = 0
Height = 379
Height = 378
Top = 0
Width = 386
PopupMenu = VpWeekView1.default
DataStore = VpZeosDatastore1
ControlLink = VpControlLink1
Color = clWindow
AllDayEventAttributes.BackgroundColor = clWindow
AllDayEventAttributes.EventBorderColor = clGray
AllDayEventAttributes.EventBackgroundColor = clBtnFace
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
HeadAttributes.Color = clBtnFace
LineColor = clGray
TimeFormat = tf12Hour
ShowEventTime = True
WeekStartsOn = dtMonday
Align = alClient
TabStop = True
TabOrder = 0
end
object VpMonthView1: TVpMonthView
Left = 0
Height = 241
Top = 384
Top = 383
Width = 386
PopupMenu = VpMonthView1.default
DataStore = VpZeosDatastore1
ControlLink = VpControlLink1
Color = clWindow
Align = alBottom
TabStop = True
TabOrder = 1
DateLabelFormat = 'mmmm yyyy'
DayHeadAttributes.Font.Height = -13
DayHeadAttributes.Font.Name = 'Tahoma'
DayHeadAttributes.Color = clBtnFace
DayNameStyle = dsShort
DrawingStyle = dsFlat
EventDayStyle = []
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
Left = 0
Height = 5
Top = 379
Top = 378
Width = 386
Align = alBottom
ResizeAnchor = akBottom
@@ -192,52 +176,39 @@ object Form1: TForm1
end
object VpTaskList1: TVpTaskList
Left = 697
Height = 625
Height = 624
Top = 0
Width = 275
PopupMenu = VpTaskList1.default
DataStore = VpZeosDatastore1
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
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
DrawingStyle = dsFlat
ShowResourceName = True
LineColor = clGray
TaskHeadAttributes.Color = clSilver
end
object Splitter1: TSplitter
Left = 692
Height = 625
Height = 624
Top = 0
Width = 5
end
object Splitter3: TSplitter
Left = 301
Height = 625
Height = 624
Top = 0
Width = 5
end
end
object TabSheet2: TTabSheet
Caption = 'Contacts'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 972
object VpContactButtonBar1: TVpContactButtonBar
Left = 0
Height = 625
Height = 624
Top = 0
Width = 40
DrawingStyle = dsFlat
@@ -246,27 +217,22 @@ object Form1: TForm1
end
object VpContactGrid1: TVpContactGrid
Left = 40
Height = 625
Height = 624
Top = 0
Width = 932
PopupMenu = VpContactGrid1.default
DataStore = VpZeosDatastore1
ControlLink = VpControlLink1
Color = clWindow
Align = alClient
TabStop = True
TabOrder = 1
AllowInPlaceEditing = True
BarWidth = 3
BarColor = clSilver
ColumnWidth = 200
ContactHeadAttributes.Color = clSilver
ContactHeadAttributes.Bordered = True
DrawingStyle = dsFlat
end
end
end
object ZConnection1: TZConnection
ControlsCodePage = cCP_UTF8
AutoEncodeStrings = True
Properties.Strings = (
'AutoEncodeStrings='
)
@@ -275,32 +241,19 @@ object Form1: TForm1
Top = 136
end
object VpZeosDatastore1: TVpZeosDatastore
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
AutoCreate = True
Daybuffer = 31
Left = 136
Top = 200
end
@@ -315,7 +268,7 @@ object Form1: TForm1
Top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.12'
Version = 'v1.8.0'
DataStore = VpZeosDatastore1
Options = []
Placement.Position = mpCenter

View File

@@ -5,23 +5,25 @@ unit Unit1;
// Activate ONE of the following defines for the database system to be used:
{.$DEFINE sqlite3}
{.$DEFINE firebird3}
{$DEFINE postgresql}
{$DEFINE firebird3}
{.$DEFINE postgresql}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls,
VpBaseDS, VpZeosDs, VpDayView, VpWeekView, VpTaskList, VpContactGrid,
VpMonthView, VpResEditDlg, VpContactButtons,
ZConnection, ZDbcIntfs;
ZConnection, ZDbcIntfs,
VpData, VpBaseDS, VpZeosDs,
VpDayView, VpWeekView, VpMonthView, VpTaskList, VpContactGrid,
VpResEditDlg, VpContactButtons;
type
{ TForm1 }
TForm1 = class(TForm)
BtnDeleteRes: TButton;
BtnNewRes: TButton;
BtnEditRes: TButton;
PageControl1: TPageControl;
@@ -43,6 +45,7 @@ type
VpWeekView1: TVpWeekView;
VpZeosDatastore1: TVpZeosDatastore;
ZConnection1: TZConnection;
procedure BtnDeleteResClick(Sender: TObject);
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -81,6 +84,21 @@ begin
VpResourceEditDialog1.AddNewResource;
end;
procedure TForm1.BtnDeleteResClick(Sender: TObject);
var
res: TVpResource;
begin
res := VpControlLink1.Datastore.Resource;
if res = nil then
exit;
if MessageDlg(Format('Do you really want to delete resource "%s"? This will also delete its events, tasks and contacts.',
[res.Description]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
VpControlLink1.Datastore.DeleteResource(res);
end;
end;
// Edits the currently selected resource
procedure TForm1.BtnEditResClick(Sender: TObject);
begin