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

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

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

101
components/tvplanit/examples/datastores/bufdataset/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 = 34
@ -47,8 +47,8 @@ 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
@ -64,8 +64,25 @@ 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 = 5
Width = 107
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Delete resource'
TabOrder = 3
OnClick = BtnDeleteResClick
end
end
object PageControl1: TPageControl
@ -86,18 +103,13 @@ object Form1: TForm1
Height = 624
Top = 0
Width = 301
PopupMenu = VpDayView1.default
DataStore = VpBufDSDataStore1
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
@ -109,17 +121,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
@ -137,31 +142,24 @@ object Form1: TForm1
Height = 378
Top = 0
Width = 386
PopupMenu = VpWeekView1.default
DataStore = VpBufDSDataStore1
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
@ -169,34 +167,22 @@ object Form1: TForm1
Height = 241
Top = 383
Width = 386
PopupMenu = VpMonthView1.default
DataStore = VpBufDSDataStore1
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
@ -213,31 +199,18 @@ object Form1: TForm1
Height = 624
Top = 0
Width = 275
PopupMenu = VpTaskList1.default
DataStore = VpBufDSDataStore1
ControlLink = VpControlLink1
Color = clWindow
Font.Height = -12
ParentFont = False
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
@ -270,18 +243,12 @@ object Form1: TForm1
Height = 624
Top = 0
Width = 932
PopupMenu = VpContactGrid1.default
DataStore = VpBufDSDataStore1
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
@ -297,7 +264,7 @@ object Form1: TForm1
Top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.12'
Version = 'v1.8.0'
DataStore = VpBufDSDataStore1
Options = []
Placement.Position = mpCenter
@ -309,33 +276,19 @@ object Form1: TForm1
Top = 335
end
object VpBufDSDataStore1: TVpBufDSDataStore
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
AutoCreate = True
DayBuffer = 31
UseAutoIncFields = False
Left = 136
Top = 192

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

@ -14,6 +14,7 @@ type
{ TForm1 }
TForm1 = class(TForm)
BtnDeleteRes: TButton;
BtnNewRes: TButton;
BtnEditRes: TButton;
PageControl1: TPageControl;
@ -34,6 +35,7 @@ type
VpResourceEditDialog1: TVpResourceEditDialog;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnDeleteResClick(Sender: TObject);
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -70,6 +72,22 @@ begin
VpResourceEditDialog1.Execute;
end;
// Deletes the selected resource and associated events, contacts and tasks
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;
// Load the last resource.
procedure TForm1.FormCreate(Sender: TObject);
var

107
components/tvplanit/examples/datastores/fb/unit1.lfm
View File

@ -6,9 +6,9 @@ object Form1: TForm1
Caption = 'Form1'
ClientHeight = 686
ClientWidth = 895
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '2.3.0.0'
object Panel1: TPanel
Left = 0
Height = 33
@ -22,9 +22,10 @@ object Form1: TForm1
TabOrder = 0
object VpResourceCombo1: TVpResourceCombo
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 4
Height = 23
Top = 5
Top = 4
Width = 208
DataStore = VpFirebirdDatastore1
Style = csDropDownList
@ -35,6 +36,7 @@ object Form1: TForm1
object BtnNewRes: TButton
AnchorSideLeft.Control = VpResourceCombo1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 216
Height = 25
Top = 4
@ -44,12 +46,13 @@ 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
Left = 318
Height = 25
Top = 4
@ -59,8 +62,24 @@ 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
Left = 416
Height = 25
Top = 4
Width = 107
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Delete resource'
TabOrder = 3
OnClick = BtnDeleteResClick
end
end
object PageControl1: TPageControl
@ -81,16 +100,11 @@ object Form1: TForm1
Height = 625
Top = 0
Width = 283
PopupMenu = VpDayView1.default
DataStore = VpFirebirdDatastore1
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
@ -101,17 +115,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 = 288
@ -129,26 +136,19 @@ object Form1: TForm1
Height = 379
Top = 0
Width = 339
PopupMenu = VpWeekView1.default
DataStore = VpFirebirdDatastore1
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
@ -156,30 +156,18 @@ object Form1: TForm1
Height = 241
Top = 384
Width = 339
PopupMenu = VpMonthView1.default
DataStore = VpFirebirdDatastore1
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
@ -196,28 +184,15 @@ object Form1: TForm1
Height = 625
Top = 0
Width = 255
PopupMenu = VpTaskList1.default
DataStore = VpFirebirdDatastore1
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 = 627
@ -250,18 +225,12 @@ object Form1: TForm1
Height = 625
Top = 0
Width = 847
PopupMenu = VpContactGrid1.default
DataStore = VpFirebirdDatastore1
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
@ -277,7 +246,7 @@ object Form1: TForm1
Top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.12'
Version = 'v1.8.0'
DataStore = VpFirebirdDatastore1
Options = []
Placement.Position = mpCenter
@ -296,34 +265,20 @@ object Form1: TForm1
Top = 120
end
object VpFirebirdDatastore1: TVpFirebirdDatastore
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
Connection = IBConnection1
AutoConnect = False
AutoCreate = False
DayBuffer = 31
Left = 136
Top = 200
end

17
components/tvplanit/examples/datastores/fb/unit1.pas
View File

@ -17,6 +17,7 @@ type
TForm1 = class(TForm)
BtnNewRes: TButton;
BtnEditRes: TButton;
BtnDeleteRes: TButton;
IBConnection1: TIBConnection;
PageControl1: TPageControl;
Panel1: TPanel;
@ -38,6 +39,7 @@ type
VpResourceEditDialog1: TVpResourceEditDialog;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnDeleteResClick(Sender: TObject);
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -69,6 +71,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

157
components/tvplanit/examples/datastores/flex/access/unit1.lfm
View File

@ -6,25 +6,27 @@ object Form1: TForm1
Caption = 'VpFlexDatastore demo (MS Access via ODBC)'
ClientHeight = 686
ClientWidth = 980
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
OnDestroy = FormDestroy
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 = VpFlexDataStore1
Style = csDropDownList
@ -35,38 +37,59 @@ object Form1: TForm1
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
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
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.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 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
@ -75,23 +98,18 @@ object Form1: TForm1
OnChange = PageControl1Change
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 = VpFlexDataStore1
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
@ -102,81 +120,56 @@ 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 = VpFlexDataStore1
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 = VpFlexDataStore1
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
@ -186,7 +179,7 @@ object Form1: TForm1
Cursor = crVSplit
Left = 0
Height = 5
Top = 379
Top = 378
Width = 386
Align = alBottom
ResizeAnchor = akBottom
@ -194,52 +187,40 @@ object Form1: TForm1
end
object VpTaskList1: TVpTaskList
Left = 697
Height = 625
Height = 624
Top = 0
Width = 275
PopupMenu = VpTaskList1.default
DataStore = VpFlexDataStore1
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 = True
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
@ -248,27 +229,21 @@ object Form1: TForm1
end
object VpContactGrid1: TVpContactGrid
Left = 40
Height = 625
Height = 624
Top = 0
Width = 932
PopupMenu = VpContactGrid1.default
DataStore = VpFlexDataStore1
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
object TabSheet3: TTabSheet
Caption = 'Grids'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 972
object TabControl1: TTabControl
AnchorSideLeft.Control = TabSheet3
@ -279,7 +254,7 @@ object Form1: TForm1
AnchorSideBottom.Control = TabSheet3
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 576
Height = 575
Top = 41
Width = 956
OnChange = TabControl1Change
@ -295,7 +270,7 @@ object Form1: TForm1
TabOrder = 0
object Grid: TDBGrid
Left = 2
Height = 551
Height = 550
Top = 23
Width = 952
Align = alClient
@ -338,8 +313,8 @@ object Form1: TForm1
Width = 120
BorderSpacing.Left = 8
Caption = 'Apply to planner'
OnClick = BtnApplyToPlannerClick
TabOrder = 2
OnClick = BtnApplyToPlannerClick
end
end
end
@ -354,7 +329,7 @@ object Form1: TForm1
Top = 168
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.12'
Version = 'v1.8.0'
DataStore = VpFlexDataStore1
Options = []
Placement.Position = mpCenter
@ -366,38 +341,22 @@ object Form1: TForm1
Top = 232
end
object VpFlexDataStore1: TVpFlexDataStore
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 = False
AutoCreate = True
DayBuffer = 31
DataSources.ResourceDataSource = DsResources
DataSources.EventsDataSource = DsEvents
DataSources.ContactsDataSource = DsContacts
DataSources.TasksDataSource = DsTasks
ResourceID = 0
OnCreateTable = VpFlexDataStore1CreateTable
Left = 136
Top = 101

18
components/tvplanit/examples/datastores/flex/access/unit1.pas
View File

@ -19,6 +19,7 @@ type
{ TForm1 }
TForm1 = class(TForm)
BtnDeleteRes: TButton;
BtnNewRes: TButton;
BtnEditRes: TButton;
BtnApplyToPlanner: TButton;
@ -62,6 +63,7 @@ type
VpResourceEditDialog1: TVpResourceEditDialog;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnDeleteResClick(Sender: TObject);
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure BtnApplyToPlannerClick(Sender: TObject);
@ -118,6 +120,22 @@ begin
VpResourceEditDialog1.Execute;
end;
// Deletes the selected resource and associated events, contacts and tasks
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;
procedure TForm1.BtnApplyToPlannerClick(Sender: TObject);
var
resID: Integer;

142
components/tvplanit/examples/datastores/flex/sqlite3/unit1.lfm
View File

@ -6,25 +6,27 @@ object Form1: TForm1
Caption = 'Form1'
ClientHeight = 686
ClientWidth = 910
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '2.3.0.0'
object Panel1: TPanel
Left = 0
Height = 33
Height = 34
Top = 0
Width = 910
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 33
ClientHeight = 34
ClientWidth = 910
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 = VpFlexDataStore1
Style = csDropDownList
@ -35,6 +37,7 @@ object Form1: TForm1
object BtnNewRes: TButton
AnchorSideLeft.Control = VpResourceCombo1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 216
Height = 25
Top = 4
@ -44,12 +47,13 @@ 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
Left = 318
Height = 25
Top = 4
@ -59,14 +63,31 @@ 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 = 5
Width = 107
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Delete resource'
TabOrder = 3
OnClick = BtnDeleteResClick
end
end
object PageControl1: TPageControl
Left = 0
Height = 653
Top = 33
Height = 652
Top = 34
Width = 910
ActivePage = TabSheet1
Align = alClient
@ -74,23 +95,18 @@ object Form1: TForm1
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Events and tasks'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 902
object VpDayView1: TVpDayView
Left = 0
Height = 625
Height = 624
Top = 0
Width = 283
PopupMenu = VpDayView1.default
DataStore = VpFlexDataStore1
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
@ -101,81 +117,56 @@ 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 = 288
Height = 625
Height = 624
Top = 0
Width = 363
Align = alLeft
BevelOuter = bvNone
Caption = 'Panel2'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 363
TabOrder = 1
object VpWeekView1: TVpWeekView
Left = 0
Height = 379
Height = 378
Top = 0
Width = 363
PopupMenu = VpWeekView1.default
DataStore = VpFlexDataStore1
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 = 363
PopupMenu = VpMonthView1.default
DataStore = VpFlexDataStore1
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
@ -185,7 +176,7 @@ object Form1: TForm1
Cursor = crVSplit
Left = 0
Height = 5
Top = 379
Top = 378
Width = 363
Align = alBottom
ResizeAnchor = akBottom
@ -193,52 +184,40 @@ object Form1: TForm1
end
object VpTaskList1: TVpTaskList
Left = 656
Height = 625
Height = 624
Top = 0
Width = 246
PopupMenu = VpTaskList1.default
DataStore = VpFlexDataStore1
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 = True
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 = 651
Height = 625
Height = 624
Top = 0
Width = 5
end
object Splitter3: TSplitter
Left = 283
Height = 625
Height = 624
Top = 0
Width = 5
end
end
object TabSheet2: TTabSheet
Caption = 'Contacts'
ClientHeight = 625
ClientHeight = 624
ClientWidth = 902
object VpContactButtonBar1: TVpContactButtonBar
Left = 0
Height = 625
Height = 624
Top = 0
Width = 40
DrawingStyle = dsFlat
@ -247,21 +226,15 @@ object Form1: TForm1
end
object VpContactGrid1: TVpContactGrid
Left = 40
Height = 625
Height = 624
Top = 0
Width = 862
PopupMenu = VpContactGrid1.default
DataStore = VpFlexDataStore1
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
@ -277,7 +250,7 @@ object Form1: TForm1
Top = 168
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.12'
Version = 'v1.8.0'
DataStore = VpFlexDataStore1
Options = []
Placement.Position = mpCenter
@ -289,38 +262,23 @@ object Form1: TForm1
Top = 232
end
object VpFlexDataStore1: TVpFlexDataStore
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 = False
AutoCreate = False
DayBuffer = 31
DataSources.ResourceDataSource = DsResources
DataSources.EventsDataSource = DsEvents
DataSources.ContactsDataSource = DsContacts
DataSources.TasksDataSource = DsTasks
ResourceID = 0
Left = 136
Top = 101
ResourceFieldMappings = (

18
components/tvplanit/examples/datastores/flex/sqlite3/unit1.pas
View File

@ -16,6 +16,7 @@ type
{ TForm1 }
TForm1 = class(TForm)
BtnDeleteRes: TButton;
BtnNewRes: TButton;
BtnEditRes: TButton;
DsTasks: TDataSource;
@ -46,6 +47,7 @@ type
VpResourceEditDialog1: TVpResourceEditDialog;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnDeleteResClick(Sender: TObject);
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
@ -88,6 +90,22 @@ begin
VpResourceEditDialog1.AddNewResource;
end;
// Deletes the selected resource and associated events, contacts and tasks
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

190
components/tvplanit/examples/datastores/sqlite3/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.1.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,13 @@ 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
Left = 318
Height = 25
Top = 4
@ -58,8 +62,24 @@ 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
Left = 416
Height = 25
Top = 4
Width = 107
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Delete resource'
TabOrder = 3
OnClick = BtnDeleteResClick
end
end
object PageControl1: TPageControl
@ -74,23 +94,18 @@ object Form1: TForm1
OnChange = PageControl1Change
object TabSheet1: TTabSheet
Caption = 'Events and tasks'
ClientHeight = 624
ClientHeight = 625
ClientWidth = 972
object VpDayView1: TVpDayView
Left = 0
Height = 624
Height = 625
Top = 0
Width = 301
PopupMenu = VpDayView1.default
DataStore = VpSqlite3Datastore1
ControlLink = VpControlLink1
Color = clWindow
Align = alLeft
ReadOnly = False
TabStop = True
TabOrder = 0
AllDayEventAttributes.BackgroundColor = clBtnShadow
AllDayEventAttributes.EventBorderColor = cl3DDkShadow
AllDayEventAttributes.EventBackgroundColor = clBtnFace
ShowEventTimes = False
DrawingStyle = dsFlat
TimeSlotColors.Active = clWhite
@ -100,91 +115,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 = 624
Height = 625
Top = 0
Width = 386
Align = alLeft
BevelOuter = bvNone
Caption = 'Panel2'
ClientHeight = 624
ClientHeight = 625
ClientWidth = 386
TabOrder = 1
object VpWeekView1: TVpWeekView
Left = 0
Height = 378
Height = 379
Top = 0
Width = 386
PopupMenu = VpWeekView1.default
DataStore = VpSqlite3Datastore1
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 = 383
Top = 384
Width = 386
PopupMenu = VpMonthView1.default
DataStore = VpSqlite3Datastore1
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 = 378
Top = 379
Width = 386
Align = alBottom
ResizeAnchor = akBottom
@ -192,41 +181,28 @@ object Form1: TForm1
end
object VpTaskList1: TVpTaskList
Left = 697
Height = 624
Height = 625
Top = 0
Width = 275
PopupMenu = VpTaskList1.default
DataStore = VpSqlite3Datastore1
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 = 624
Height = 625
Top = 0
Width = 5
end
object Splitter3: TSplitter
Left = 301
Height = 624
Height = 625
Top = 0
Width = 5
end
@ -243,7 +219,6 @@ object Form1: TForm1
ContactGrid = VpContactGrid1
DrawingStyle = dsFlat
OnContactNotFound = VpContactButtonBar1ContactNotFound
RadioStyle = True
Align = alLeft
end
object VpContactGrid1: TVpContactGrid
@ -251,18 +226,12 @@ object Form1: TForm1
Height = 625
Top = 0
Width = 932
PopupMenu = VpContactGrid1.default
DataStore = VpSqlite3Datastore1
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
@ -303,8 +272,8 @@ object Form1: TForm1
AutoSize = True
BorderSpacing.Left = 8
Caption = 'Apply to planner'
OnClick = BtnApplyToPlannerClick
TabOrder = 1
OnClick = BtnApplyToPlannerClick
end
object TabControl1: TTabControl
AnchorSideLeft.Control = TabSheet3
@ -345,20 +314,16 @@ object Form1: TForm1
end
object VpControlLink1: TVpControlLink
DataStore = VpSqlite3Datastore1
Printer.BottomMargin = 0
Printer.DayStart = h_08
Printer.DayEnd = h_05
Printer.Granularity = gr30Min
Printer.LeftMargin = 0
Printer.MarginUnits = imAbsolutePixel
Printer.PrintFormats = <>
Printer.RightMargin = 0
Printer.TopMargin = 0
left = 136
top = 264
Left = 136
Top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.12'
Version = 'v1.8.0'
DataStore = VpSqlite3Datastore1
Options = []
Placement.Position = mpCenter
@ -366,55 +331,42 @@ object Form1: TForm1
Placement.Left = 10
Placement.Height = 250
Placement.Width = 400
left = 136
top = 335
Left = 136
Top = 335
end
object VpSqlite3Datastore1: TVpSqlite3Datastore
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
Connection = SQLite3Connection1
AutoConnect = False
AutoCreate = False
DayBuffer = 31
left = 136
top = 192
Left = 136
Top = 192
end
object SQLite3Connection1: TSQLite3Connection
Connected = False
LoginPrompt = False
KeepConnection = False
Transaction = SQLTransaction1
left = 136
top = 120
AlwaysUseBigint = False
Left = 136
Top = 120
end
object SQLTransaction1: TSQLTransaction
Active = False
Action = caCommitRetaining
Database = SQLite3Connection1
left = 256
top = 120
Left = 256
Top = 120
end
object QryAllResources: TSQLQuery
PacketRecords = -1
@ -517,10 +469,11 @@ object Form1: TForm1
)
Options = [sqoKeepOpenOnCommit, sqoAutoCommit]
Params = <>
Macros = <>
UpdateMode = upWhereAll
UsePrimaryKeyAsKey = False
left = 560
top = 160
Left = 560
Top = 160
end
object QryAllContacts: TSQLQuery
PacketRecords = -1
@ -712,10 +665,11 @@ object Form1: TForm1
)
Options = [sqoKeepOpenOnCommit]
Params = <>
Macros = <>
UpdateMode = upWhereAll
UsePrimaryKeyAsKey = False
left = 560
top = 214
Left = 560
Top = 214
end
object QryAllEvents: TSQLQuery
PacketRecords = -1
@ -730,10 +684,11 @@ object Form1: TForm1
)
Options = [sqoKeepOpenOnCommit, sqoAutoApplyUpdates]
Params = <>
Macros = <>
UpdateMode = upWhereAll
UsePrimaryKeyAsKey = False
left = 560
top = 274
Left = 560
Top = 274
end
object QryAllTasks: TSQLQuery
PacketRecords = -1
@ -748,29 +703,30 @@ object Form1: TForm1
)
Options = [sqoKeepOpenOnCommit, sqoAutoCommit]
Params = <>
Macros = <>
UpdateMode = upWhereAll
UsePrimaryKeyAsKey = False
left = 560
top = 341
Left = 560
Top = 341
end
object DsAllResources: TDataSource
DataSet = QryAllResources
left = 656
top = 160
Left = 656
Top = 160
end
object DsAllContacts: TDataSource
DataSet = QryAllContacts
left = 659
top = 214
Left = 659
Top = 214
end
object DsAllEvents: TDataSource
DataSet = QryAllEvents
left = 654
top = 274
Left = 654
Top = 274
end
object DsAllTasks: TDataSource
DataSet = QryAllTasks
left = 656
top = 341
Left = 656
Top = 341
end
end

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

@ -15,6 +15,7 @@ type
{ TForm1 }
TForm1 = class(TForm)
BtnDeleteRes: TButton;
BtnNewRes: TButton;
BtnEditRes: TButton;
BtnApplyToPlanner: TButton;
@ -51,6 +52,7 @@ type
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
procedure BtnApplyToPlannerClick(Sender: TObject);
procedure BtnDeleteResClick(Sender: TObject);
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -105,6 +107,22 @@ begin
QryAllTasks.Open;
end;
// Deletes the selected resource and associated events, contacts and tasks
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;
// Adds a new resource
procedure TForm1.BtnNewResClick(Sender: TObject);
begin

3
components/tvplanit/examples/datastores/zeos/project1.lpi
View File

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

159
components/tvplanit/examples/datastores/zeos/unit1.lfm
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

28
components/tvplanit/examples/datastores/zeos/unit1.pas
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

32
components/tvplanit/source/addons/zeos/vpzeosds.pas
View File

@ -6,7 +6,7 @@ interface
uses
SysUtils, Classes, DB,
VpBaseDS, VpDBDS,
VpData, VpBaseDS, VpDBDS,
ZCompatibility, ZConnection, ZDataset;
type
@ -30,6 +30,9 @@ type
function GetEventsTable: TDataset; override;
function GetResourceTable: TDataset; override;
function GetTasksTable: TDataset; override;
procedure InternalPurgeContacts(Res: TVpResource); override;
procedure InternalPurgeEvents(Res: TVpResource); override;
procedure InternalPurgeTasks(Res: TVpResource); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetConnected(const AValue: Boolean); override;
@ -507,6 +510,33 @@ begin
Result := FTasksTable;
end;
{ Removes all contacts of the specified resource from the database. }
procedure TVpZeosDataStore.InternalPurgeContacts(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Contacts WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
{ Removes all events of the specified resource from the database. }
procedure TVpZeosDatastore.InternalPurgeEvents(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Events WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
{ Removes all tasks of the specified resource from the database. }
procedure TVpZeosDatastore.InternalPurgeTasks(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Tasks WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
procedure TVpZeosDatastore.Loaded;
begin
inherited;

52
components/tvplanit/source/vpbaseds.pas
View File

@ -277,6 +277,10 @@ type
procedure LinkToControls(AOwner: TComponent);
procedure UnlinkFromControls(AOwner: TComponent);
procedure InternalPurgeContacts(Res: TVpResource); virtual;
procedure InternalPurgeEvents(Res: TVpResource); virtual;
procedure InternalPurgeTasks(Res: TVpResource); virtual;
property AutoConnect: Boolean read FAutoConnect write SetAutoConnect default false;
property AutoCreate: Boolean read FAutoCreate write FAutoCreate default true;
@ -948,6 +952,24 @@ begin
NotifyDependents;
end;
procedure TVpCustomDataStore.InternalPurgeContacts(Res: TVpResource);
begin
// Must be overridden by descendants to remove the contacts of the given
// resource from the external storage
end;
procedure TVpCustomDataStore.InternalPurgeEvents(Res: TVpResource);
begin
// Must be overridden by descendants to remove the events of the given
// resource from the external storage
end;
procedure TVpCustomDataStore.InternalPurgeTasks(Res: TVpResource);
begin
// Must be overridden by descendants to remove the tasks of the given
// resource from the external storage
end;
procedure TVpCustomDataStore.PurgeResource(Res: TVpResource);
begin
Unused(Res);
@ -957,23 +979,35 @@ end;
procedure TVpCustomDataStore.PurgeEvents(Res: TVpResource);
begin
Res.Schedule.ClearEvents;
if not Loading then
NotifyDependents;
if Res <> nil then
begin
InternalPurgeEvents(Res);
Res.Schedule.ClearEvents;
if not Loading then
NotifyDependents;
end;
end;
procedure TVpCustomDataStore.PurgeContacts(Res: TVpResource);
begin
Res.Contacts.ClearContacts;
if not Loading then
NotifyDependents;
if Res <> nil then
begin
InternalPurgeContacts(Res);
Res.Contacts.ClearContacts;
if not Loading then
NotifyDependents;
end;
end;
procedure TVpCustomDataStore.PurgeTasks(Res: TVpResource);
begin
Res.Tasks.ClearTasks;
if not Loading then
NotifyDependents;
if Res <> nil then
begin
InternalPurgeTasks(Res);
Res.Tasks.ClearTasks;
if not Loading then
NotifyDependents;
end;
end;
procedure TVpCustomDatastore.UpdateGroupEvents;

71
components/tvplanit/source/vpdbds.pas
View File

@ -64,6 +64,10 @@ type
procedure SetReadOnly(const Value: boolean);
{ internal methods }
procedure InternalPurgeContacts(Res: TVpResource); override;
procedure InternalPurgeEvents(Res: TVpResource); override;
procedure InternalPurgeTasks(Res: TVpResource); override;
procedure LoadContact(AContact: TVpContact); virtual;
procedure LoadTask(ATask: TVpTask); virtual;
procedure SetFilterCriteria(ATable: TDataset; AUseDateTime: Boolean;
@ -96,9 +100,6 @@ type
procedure PostResources; override;
procedure PurgeResource(Res: TVpResource); override;
procedure PurgeEvents(Res: TVpResource); override;
procedure PurgeContacts(Res: TVpResource); override;
procedure PurgeTasks(Res: TVpResource); override;
procedure SetResourceByName(Value: string); override;
procedure CreateFieldDefs(const TableName: string; FieldDefs: TFieldDefs); virtual;
@ -1879,7 +1880,6 @@ begin
end;
end;
{ - Added}
procedure TVpCustomDBDataStore.PurgeResource(Res: TVpResource);
begin
Res.Deleted := true;
@ -1887,27 +1887,64 @@ begin
Load;
end;
procedure TVpCustomDBDataStore.PurgeEvents(Res: TVpResource);
{ Deletes all events from the database which are assigned to the specified
resource. Does this by iterating over the dataset.
Override if the descendant class provides a more efficient method. }
procedure TVpCustomDBDataStore.InternalPurgeEvents(Res: TVpResource);
var
resIDField: TField;
begin
{ Purging the events from the database is done by the descendant !!.01}
{ classes !!.01}
inherited;
Assert(Res <> nil);
EventsTable.Open;
EventsTable.First;
resIDField := EventsTable.FieldByName('ResourceID');
while not EventsTable.EOF do
begin
if resIDField.AsInteger = Res.ResourceID then
EventsTable.Delete
else
EventsTable.Next;
end;
end;
procedure TVpCustomDBDataStore.PurgeContacts(Res: TVpResource);
{ Deletes all contacts from the database which are assigned to the specified
resource. Does this by iterating over the dataset. Override if the descendant
class provides a more efficient method. }
procedure TVpCustomDBDataStore.InternalPurgeContacts(Res: TVpResource);
var
resIDField: TField;
begin
{ Purging the contacts from the database is done by the descendant !!.01}
{ classes !!.01}
inherited;
ContactsTable.Open;
ContactsTable.First;
resIDField := ContactsTable.FieldByName('ResourceID');
while not ContactsTable.EOF do
begin
if resIDField.AsInteger = Res.ResourceID then
ContactsTable.Delete
else
ContactsTable.Next;
end;
end;
procedure TVpCustomDBDataStore.PurgeTasks(Res: TVpResource);
{ Deletes all tasks from the database which are assigned to the specified
resource. Does this by iterating over the dataset. Override if the descendant
class provides a more efficient method. }
procedure TVpCustomDBDataStore.InternalPurgeTasks(Res: TVpResource);
var
resIDField: TField;
begin
{ Purging the tasks from the database is done by the descendant !!.01}
{ classes !!.01}
inherited;
TasksTable.Open;
TasksTable.First;
resIDField := TasksTable.FieldByName('ResourceID');
while not TasksTable.EOF do
begin
if resIDField.AsInteger = Res.ResourceID then
TasksTable.Delete
else
TasksTable.Next;
end;
end;
{ - End}
procedure TVpCustomDBDataStore.SetResourceByName(Value: string);
var

32
components/tvplanit/source/vpfbds.pas
View File

@ -8,7 +8,7 @@ interface
uses
SysUtils, Classes, DB, IBConnection, sqldb,
VpBaseDS, VpDBDS;
VpBaseDS, VpData, VpDBDS;
type
TVpFirebirdDatastore = class(TVpCustomDBDatastore)
@ -28,6 +28,9 @@ type
function GetEventsTable: TDataset; override;
function GetResourceTable: TDataset; override;
function GetTasksTable: TDataset; override;
procedure InternalPurgeContacts(Res: TVpResource); override;
procedure InternalPurgeEvents(Res: TVpResource); override;
procedure InternalPurgeTasks(Res: TVpResource); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure OpenTables;
@ -576,6 +579,33 @@ begin
FTasksTable.Refresh;
end;
{ Removes all contacts of the specified resource from the database. }
procedure TVpFirebirdDataStore.InternalPurgeContacts(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Contacts WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
{ Removes all events of the specified resource from the database. }
procedure TVpFirebirdDatastore.InternalPurgeEvents(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Events WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
{ Removes all tasks of the specified resource from the database. }
procedure TVpFirebirdDatastore.InternalPurgeTasks(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Tasks WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
procedure TVpFirebirdDatastore.SetConnected(const AValue: Boolean);
begin
if (AValue = Connected) or (FConnection = nil) or (FConnectLock > 0) then

108
components/tvplanit/source/vpflxds.pas
View File

@ -157,10 +157,6 @@ type
procedure PostContacts; override;
procedure PostTasks; override;
procedure PostResources; override;
procedure PurgeResource(Res: TVpResource); override;
procedure PurgeEvents(Res: TVpResource); override;
procedure PurgeContacts(Res: TVpResource); override;
procedure PurgeTasks(Res: TVpResource); override;
function GetFieldName(Mappings: TCollection; VPField: string): string;
function GetNextID(TableName: string): Integer; override;
@ -207,7 +203,8 @@ uses
{$IFDEF VERSION6} Variants, {$ELSE} FileCtrl, {$ENDIF} VpConst;
{*****************************************************************************}
{ TVpFieldMapping }
{ TVpFieldMapping }
(*****************************************************************************)
procedure TVpFieldMapping.Assign(Source: TPersistent);
begin
@ -219,7 +216,8 @@ begin
end;
(*****************************************************************************)
{ TVpFlexDataStore }
{ TVpFlexDataStore }
(*****************************************************************************)
constructor TVpFlexDataStore.Create(AOwner: TComponent);
begin
@ -232,7 +230,6 @@ begin
FConnected := false;
FResourceID := 0;
end;
{=====}
destructor TVpFlexDataStore.Destroy;
begin
@ -243,7 +240,6 @@ begin
FDataSources.Free;
inherited;
end;
{=====}
function TVpFlexDataStore.GetConnected: Boolean;
var
@ -263,7 +259,6 @@ begin
Result := AllAssigned and AllActive;
end;
{=====}
function TVpFlexDataStore.GetResourceTable : TDataset;
begin
@ -271,7 +266,6 @@ begin
if (FResourceDataSrc <> nil) and (FResourceDataSrc.DataSet <> nil) then
Result := FResourceDataSrc.DataSet;
end;
{=====}
function TVpFlexDataStore.GetEventsTable : TDataset;
begin
@ -279,7 +273,6 @@ begin
if (FEventsDataSrc <> nil) and (FEventsDataSrc.DataSet <> nil) then
Result := FEventsDataSrc.DataSet;
end;
{=====}
function TVpFlexDataStore.GetContactsTable : TDataset;
begin
@ -287,7 +280,6 @@ begin
if (FContactsDataSrc <> nil) and (FContactsDataSrc.DataSet <> nil) then
Result := FContactsDataSrc.DataSet;
end;
{=====}
function TVpFlexDataStore.GetTasksTable : TDataset;
begin
@ -295,7 +287,6 @@ begin
if (FTasksDataSrc <> nil) and (FTasksDataSrc.DataSet <> nil) then
Result := FTasksDataSrc.DataSet;
end;
{=====}
procedure TVpFlexDataStore.SetConnected(const Value: boolean);
var
@ -435,7 +426,6 @@ begin
inherited;
end;
{=====}
procedure TVpFlexDataStore.Load;
var
@ -539,7 +529,6 @@ begin
end;
NotifyDependents;
end;
{=====}
procedure TVpFlexDataStore.LoadEventsOfResource(AResID: Integer);
var
@ -685,7 +674,8 @@ begin
end; {with FEventsDataSrc.Dataset}
end; {if resource <> nil}
end;
(*
(*
procedure TVpFlexDataStore.LoadEvents;
var
Event: TVpEvent;
@ -828,7 +818,6 @@ begin
end; {with FEventsDataSrc.Dataset}
end; {if resource <> nil}
end;*)
{=====}
{ Loads the contact from the current cursor position of the contacts table }
procedure TVpFlexDatastore.LoadContact(AContact: TVpContact);
@ -1306,8 +1295,8 @@ begin
end; {with ContactsTable}
end; {if Resource <> nil}
end;
{=====}
*)
procedure TVpFlexDataStore.LoadTasks;
var
Task: TVpTask;
@ -1410,7 +1399,6 @@ begin
end;
end;
end;
{=====}
procedure TVpFlexDataStore.RefreshResource;
var
@ -1502,8 +1490,8 @@ begin
if not Loading then
NotifyDependents;
end;
{=====}
(*
(*
procedure TVpFlexDataStore.RefreshEvents;
begin
if Resource <> nil then begin
@ -1535,8 +1523,8 @@ begin
if not Loading then
NotifyDependents;
end;
{=====}
*)
procedure TVpFlexDataStore.PostEvents;
var
J: Integer;
@ -1738,7 +1726,6 @@ begin
if not Loading then
NotifyDependents;
end;
{=====}
procedure TVpFlexDataStore.PostContacts;
var
@ -2055,7 +2042,6 @@ begin
Resource.Contacts.Sort;
end;
end;
{=====}
procedure TVpFlexDataStore.PostTasks;
var
@ -2215,9 +2201,7 @@ begin
Resource.Tasks.Sort;
end;
end;
{=====}
{ - New}
procedure TVpFlexDataStore.PostResources;
var
I: Integer;
@ -2348,52 +2332,6 @@ begin
Loading := false;
end;
end;
{=====}
{ - New}
procedure TVpFlexDataStore.PurgeResource(Res: TVpResource);
begin
Res.Deleted := true;
PostResources;
Load;
end;
{=====}
{ - New}
procedure TVpFlexDataStore.PurgeEvents(Res: TVpResource);
var
I: integer;
begin
for I := 0 to pred(Res.Schedule.EventCount) do
TVpEvent(Res.Schedule.GetEvent(I)).Deleted := true;
PostEvents;
Res.Schedule.ClearEvents;
end;
{=====}
{ - New}
procedure TVpFlexDataStore.PurgeContacts(Res: TVpResource);
var
I: integer;
begin
for I := 0 to pred(Res.Contacts.Count) do
TVpContact(Res.Contacts.GetContact(I)).Deleted := true;
PostContacts;
Res.Contacts.ClearContacts;
end;
{=====}
{ - New}
procedure TVpFlexDataStore.PurgeTasks(Res: TVpResource);
var
I: integer;
begin
for I := 0 to pred(Res.Tasks.Count) do
TVpTask(Res.Tasks.GetTask(I)).Deleted := true;
PostTasks;
Res.Tasks.ClearTasks;
end;
{=====}
procedure TVpFlexDataStore.SetResourceDataSrc(Value: TDataSource);
begin
@ -2403,7 +2341,6 @@ begin
Load;
end;
end;
{=====}
procedure TVpFlexDataStore.SetEventsDataSrc(Value: TDataSource);
begin
@ -2413,7 +2350,6 @@ begin
Load;
end;
end;
{=====}
procedure TVpFlexDataStore.SetContactsDataSrc(Value: TDataSource);
begin
@ -2423,7 +2359,6 @@ begin
Load;
end;
end;
{=====}
procedure TVpFlexDataStore.SetTasksDataSrc(Value: TDataSource);
begin
@ -2433,7 +2368,6 @@ begin
Load;
end;
end;
{=====}
{ - New Field Mapping Streamers}
procedure TVpFlexDataStore.DefineProperties(Filer: TFiler);
@ -2448,7 +2382,6 @@ begin
Filer.DefineProperty('TaskFieldMappings', LoadTaskMapping,
StoreTaskMapping, FTaskMappings.Count > 0);
end;
{=====}
procedure TVpFlexDataStore.LoadResMapping(Reader: TReader);
var
@ -2463,7 +2396,6 @@ begin
end;
Reader.ReadListEnd;
end;
{=====}
procedure TVpFlexDataStore.StoreResMapping(Writer: TWriter);
var
@ -2478,7 +2410,6 @@ begin
end;
Writer.WriteListEnd;
end;
{=====}
procedure TVpFlexDataStore.LoadEventMapping(Reader: TReader);
var
@ -2493,7 +2424,6 @@ begin
end;
Reader.ReadListEnd;
end;
{=====}
procedure TVpFlexDataStore.StoreEventMapping(Writer: TWriter);
var
@ -2508,7 +2438,6 @@ begin
end;
Writer.WriteListEnd;
end;
{=====}
procedure TVpFlexDataStore.LoadContactMapping(Reader: TReader);
var
@ -2523,7 +2452,6 @@ begin
end;
Reader.ReadListEnd;
end;
{=====}
procedure TVpFlexDataStore.StoreContactMapping(Writer: TWriter);
var
@ -2538,7 +2466,6 @@ begin
end;
Writer.WriteListEnd;
end;
{=====}
procedure TVpFlexDataStore.LoadTaskMapping(Reader: TReader);
var
@ -2553,7 +2480,6 @@ begin
end;
Reader.ReadListEnd;
end;
{=====}
procedure TVpFlexDataStore.StoreTaskMapping(Writer: TWriter);
var
@ -2568,7 +2494,6 @@ begin
end;
Writer.WriteListEnd;
end;
{=====}
procedure TVpFlexDataStore.Loaded;
begin
@ -2576,7 +2501,6 @@ begin
if not (csDesigning in ComponentState) then
Connected := AutoConnect;
end;
{=====}
function TVpFlexDataStore.GetNextID(TableName: string): Integer;
begin
@ -2654,7 +2578,6 @@ begin
then
Result := '';
end;
{=====}
procedure TVpFlexDataStore.SetFilterCriteria(ATable: TDataset; AUseDateTime: Boolean;
AResourceID: Integer; AStartDateTime, aEndDateTime: TDateTime);
@ -2665,7 +2588,7 @@ begin
else
inherited;
end;
{=====}
{ TVpDataSources }
@ -2673,55 +2596,46 @@ constructor TVpDataSources.Create(Owner: TVpFlexDataStore);
begin
FOwner := Owner;
end;
{=====}
function TVpDataSources.GetContactsDataSrc: TDataSource;
begin
result := FOwner.ContactsDataSource;
end;
{=====}
function TVpDataSources.GetEventsDataSrc: TDataSource;
begin
result := FOwner.EventsDataSource;
end;
{=====}
function TVpDataSources.GetResourceDataSrc: TDataSource;
begin
result := FOwner.ResourceDataSource;
end;
{=====}
function TVpDataSources.GetTasksDataSrc: TDataSource;
begin
result := FOwner.TasksDataSource;
end;
{=====}
procedure TVpDataSources.SetContactsDataSrc(const Value: TDataSource);
begin
FOwner.ContactsDataSource := Value;
end;
{=====}
procedure TVpDataSources.SetEventsDataSrc(const Value: TDataSource);
begin
FOwner.EventsDataSource := Value;
end;
{=====}
procedure TVpDataSources.SetResourceDataSrc(const Value: TDataSource);
begin
FOwner.ResourceDataSource := Value;
end;
{=====}
procedure TVpDataSources.SetTasksDataSrc(const Value: TDataSource);
begin
FOwner.TasksDataSource := Value;
end;
{=====}
end.

32
components/tvplanit/source/vpsqlite3ds.pas
View File

@ -6,7 +6,7 @@ interface
uses
SysUtils, Classes, DB, sqlite3conn, sqldb,
VpBaseDS, VpDBDS;
VpData, VpBaseDS, VpDBDS;
type
@ -27,6 +27,9 @@ type
function GetEventsTable: TDataset; override;
function GetResourceTable: TDataset; override;
function GetTasksTable: TDataset; override;
procedure InternalPurgeContacts(Res: TVpResource); override;
procedure InternalPurgeEvents(Res: TVpResource); override;
procedure InternalPurgeTasks(Res: TVpResource); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure OpenTables;
@ -516,6 +519,33 @@ begin
Result := FTasksTable;
end;
{ Removes all contacts of the specified resource from the database. }
procedure TVpSqlite3DataStore.InternalPurgeContacts(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Contacts WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
{ Removes all events of the specified resource from the database. }
procedure TVpSqlite3Datastore.InternalPurgeEvents(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Events WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
{ Removes all tasks of the specified resource from the database. }
procedure TVpSqlite3Datastore.InternalPurgeTasks(Res: TVpResource);
var
sql: String;
begin
sql := Format('DELETE FROM Tasks WHERE ResourceID = %d', [Res.ResourceID]);
FConnection.ExecuteDirect(sql);
end;
procedure TVpSqlite3Datastore.Loaded;
begin
inherited;