diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index d64f926c8..92635ab33 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -9,7 +9,7 @@ object MainForm: TMainForm Menu = MainMenu1 OnCloseQuery = FormCloseQuery OnCreate = FormCreate - LCLVersion = '2.1.0.0' + LCLVersion = '2.3.0.0' object Panel1: TPanel Left = 125 Height = 576 @@ -49,7 +49,6 @@ object MainForm: TMainForm Font.Color = clWhite Font.Height = -24 Font.Style = [fsBold] - ParentColor = False ParentFont = False end end @@ -58,7 +57,7 @@ object MainForm: TMainForm Height = 528 Top = 48 Width = 834 - PageIndex = 0 + PageIndex = 3 Align = alClient TabOrder = 1 TabStop = True @@ -224,7 +223,6 @@ object MainForm: TMainForm BorderSpacing.Top = 4 BorderSpacing.Bottom = 4 Caption = 'Visible days' - ParentColor = False end object DaysTrackBar: TTrackBar AnchorSideLeft.Control = LblVisibleDays @@ -286,7 +284,6 @@ object MainForm: TMainForm BorderSpacing.Top = 4 BorderSpacing.Bottom = 4 Caption = 'Granularity' - ParentColor = False end end end @@ -349,7 +346,7 @@ object MainForm: TMainForm Left = 4 Height = 19 Top = 4 - Width = 63 + Width = 61 BorderSpacing.Left = 4 BorderSpacing.Top = 4 BorderSpacing.Bottom = 4 @@ -362,10 +359,10 @@ object MainForm: TMainForm object RbHideCompletedTasks: TRadioButton AnchorSideLeft.Control = RbAllTasks AnchorSideLeft.Side = asrBottom - Left = 99 + Left = 97 Height = 19 Top = 4 - Width = 134 + Width = 132 BorderSpacing.Left = 32 BorderSpacing.Top = 4 BorderSpacing.Bottom = 4 @@ -442,9 +439,10 @@ object MainForm: TMainForm object BtnDeleteRes: TButton AnchorSideLeft.Control = BtnEditRes AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = BtnNewRes Left = 128 Height = 25 - Top = 64 + Top = 82 Width = 59 AutoSize = True BorderSpacing.Left = 8 @@ -455,9 +453,10 @@ object MainForm: TMainForm object BtnEditRes: TButton AnchorSideLeft.Control = BtnNewRes AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = BtnNewRes Left = 74 Height = 25 - Top = 64 + Top = 82 Width = 46 AutoSize = True BorderSpacing.Left = 8 @@ -466,21 +465,68 @@ object MainForm: TMainForm TabOrder = 1 end object BtnNewRes: TButton + AnchorSideLeft.Control = VpResourceCombo + AnchorSideTop.Control = VpResourceCombo + AnchorSideTop.Side = asrBottom Left = 16 Height = 25 - Top = 64 + Top = 82 Width = 50 AutoSize = True + BorderSpacing.Top = 16 Caption = 'New' OnClick = BtnNewResClick TabOrder = 2 end - object VpResourceCombo1: TVpResourceCombo + object VpResourceCombo: TVpResourceCombo + AnchorSideLeft.Control = Resources + AnchorSideTop.Control = lblResources + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom Left = 16 Height = 23 - Top = 24 + Top = 43 Width = 323 + Anchors = [akTop, akLeft, akRight] Style = csDropDownList + Borderspacing.Left = 16 + Borderspacing.Top = 4 + end + object lbOtherResources: TCheckListBox + AnchorSideLeft.Control = BtnNewRes + AnchorSideTop.Control = lblOtherResources + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VpResourceCombo + Left = 16 + Height = 186 + Top = 150 + Width = 323 + BorderSpacing.Top = 4 + ItemHeight = 0 + OnClickCheck = lbOtherResourcesClickCheck + TabOrder = 4 + end + object lblOtherResources: TLabel + AnchorSideLeft.Control = VpResourceCombo + AnchorSideTop.Control = BtnNewRes + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 15 + Top = 131 + Width = 299 + BorderSpacing.Top = 24 + Caption = 'Check the resource to be overlaid to the current resource' + end + object lblResources: TLabel + AnchorSideLeft.Control = Resources + AnchorSideTop.Control = Resources + Left = 16 + Height = 15 + Top = 24 + Width = 265 + BorderSpacing.Left = 16 + BorderSpacing.Top = 24 + Caption = 'Resources (the selected resource will be displayed)' end end object Settings: TPage @@ -495,7 +541,6 @@ object MainForm: TMainForm Anchors = [akTop, akRight] BorderSpacing.Right = 8 Caption = 'Language' - ParentColor = False end object CbLanguages: TComboBox AnchorSideTop.Control = Settings @@ -535,7 +580,6 @@ object MainForm: TMainForm Anchors = [akTop, akRight] BorderSpacing.Right = 8 Caption = 'Drawing style:' - ParentColor = False end object CbAddressBuilder: TComboBox AnchorSideLeft.Control = CbLanguages @@ -570,7 +614,6 @@ object MainForm: TMainForm Anchors = [akTop, akRight] BorderSpacing.Right = 8 Caption = 'Address builder' - ParentColor = False end object CbAllowInplaceEditing: TCheckBox AnchorSideLeft.Control = CbLanguages @@ -580,7 +623,7 @@ object MainForm: TMainForm Left = 316 Height = 19 Top = 26 - Width = 131 + Width = 129 BorderSpacing.Left = 32 Caption = 'Allow inplace editing' Checked = True @@ -613,7 +656,6 @@ object MainForm: TMainForm Anchors = [akTop, akRight] BorderSpacing.Right = 8 Caption = 'First day of week' - ParentColor = False end object CbTimeFormat: TComboBox AnchorSideLeft.Control = CbLanguages @@ -633,14 +675,13 @@ object MainForm: TMainForm AnchorSideTop.Control = CbTimeFormat AnchorSideTop.Side = asrCenter AnchorSideRight.Control = CbTimeFormat - Left = 38 + Left = 39 Height = 15 Top = 63 - Width = 66 + Width = 65 Anchors = [akTop, akRight] BorderSpacing.Right = 8 Caption = 'Time format' - ParentColor = False end object CbAllowDragAndDrop: TCheckBox AnchorSideLeft.Control = CbAllowInplaceEditing @@ -649,7 +690,7 @@ object MainForm: TMainForm Left = 316 Height = 19 Top = 61 - Width = 179 + Width = 177 Caption = 'Allow drag and drop of events' OnChange = CbAllowDragAndDropChange TabOrder = 6 @@ -661,7 +702,7 @@ object MainForm: TMainForm Left = 316 Height = 19 Top = 100 - Width = 161 + Width = 158 Caption = 'Transparent drag and drop' OnChange = CbDragDropTransparentChange TabOrder = 7 @@ -673,7 +714,7 @@ object MainForm: TMainForm Left = 316 Height = 19 Top = 139 - Width = 176 + Width = 174 Caption = 'Show event and contact hints' Checked = True OnChange = CbShowEventHintsChange diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index aae01c68c..b9b2f1cd1 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/components/tvplanit/examples/fulldemo/demomain.pas @@ -10,9 +10,9 @@ uses {$ENDIF} Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, LCLTranslator, Menus, Types, LCLVersion, - VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid, - VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData, - VpPrtPrvDlg, VpPrtFmtDlg, VpBase; + CheckLst, VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid, + VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData, VpPrtPrvDlg, + VpPrtFmtDlg, VpBase; type @@ -32,6 +32,9 @@ type CbAllowDragAndDrop: TCheckBox; CbDragDropTransparent: TCheckBox; CbShowEventHints: TCheckBox; + lblOtherResources: TLabel; + lblResources: TLabel; + lbOtherResources: TCheckListBox; Img: TImage; ImageList1: TImageList; LblDrawingStyle: TLabel; @@ -83,7 +86,7 @@ type VpNavBar1: TVpNavBar; VpPrintFormatEditDialog1: TVpPrintFormatEditDialog; VpPrintPreviewDialog1: TVpPrintPreviewDialog; - VpResourceCombo1: TVpResourceCombo; + VpResourceCombo: TVpResourceCombo; VpResourceEditDialog1: TVpResourceEditDialog; VpTaskList1: TVpTaskList; VpWeekView1: TVpWeekView; @@ -104,6 +107,7 @@ type procedure DaysTrackBarChange(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); + procedure lbOtherResourcesClickCheck(Sender: TObject); procedure MnuAboutClick(Sender: TObject); procedure MnuEditPrintFormatsClick(Sender: TObject); procedure MnuLoadPrintFormatsClick(Sender: TObject); @@ -128,10 +132,12 @@ type FVisibleDays: Integer; FResID: Integer; FLanguageDir: String; + procedure ConnectHandler(Sender: TObject); procedure CreateResourceGroup; function GetlanguageDir: String; procedure PopulateLanguages; procedure PositionControls; + procedure ResourceChangeHandler(Sender: TObject; AResource: TVpResource); procedure SetActiveView(AValue: Integer); procedure SetLanguage(ALang: String); overload; procedure SetLanguage(AIndex: Integer); overload; @@ -144,6 +150,7 @@ type procedure ShowResources; procedure ShowSettings; procedure ShowTasks; + procedure UpdateOtherResourcesList; procedure ReadIni; procedure WriteIni; @@ -353,8 +360,10 @@ begin exit; if MessageDlg(Format(RSConfirmDeleteRes, [res.Description]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then + begin VpControlLink1.Datastore.PurgeResource(res); -// VpControlLink1.Datastore.Resources.RemoveResource(res); + UpdateOtherResourcesList; + end; end; // Edits the currently selected resource @@ -368,6 +377,7 @@ end; procedure TMainForm.BtnNewResClick(Sender: TObject); begin VpResourceEditDialog1.AddNewResource; + UpdateOtherResourcesList; end; procedure TMainForm.Cb3DChange(Sender: TObject); @@ -458,6 +468,11 @@ begin VpMonthView1.TimeFormat := TVpTimeFormat(CbTimeFormat.ItemIndex); end; +procedure TMainForm.ConnectHandler(Sender: TObject); +begin + UpdateOtherResourcesList; +end; + // Creates a resource group at runtime procedure TMainForm.CreateResourceGroup; const @@ -532,19 +547,40 @@ begin MediaFolder := AppendPathDelim(SysUtils.GetEnvironmentVariable('SYSTEMROOT')) + 'media'; {$ENDIF} + OnConnect := @ConnectHandler; + OnResourceChange := @ResourceChangeHandler; if (Resources.Count > 0) then begin if FResID = -1 then Resource := Resources.Items[0] else ResourceID := FResID; - - CreateResourceGroup; end; + end; Caption := Application.Title; end; +procedure TMainForm.lbOtherResourcesClickCheck(Sender: TObject); +var + i, n: Integer; + resArray: TVpResourceArray; +begin + // Collect resources checked for overlaying in an array + SetLength(resArray, lbOtherResources.Items.Count); + n := 0; + for i := 0 to lbOtherResources.Items.Count-1 do + if lbOtherResources.Checked[i] then + begin + resArray[n] := TVpResource(lbOtherResources.Items.Objects[i]); + inc(n); + end; + SetLength(resArray, n); + + // Overlay the checked resources to the currently active resource + VpControlLink1.DataStore.Resource.OverlayResources(resArray); +end; + function TMainForm.GetLanguageDir: String; begin if FLanguageDir = '' then @@ -850,6 +886,24 @@ begin end; end; +procedure TMainForm.ResourceChangeHandler(Sender: TObject; AResource: TVpResource); +var + res: TVpResource; + i, j: Integer; +begin + lbOtherResources.Clear; + for i := 0 to VpControlLink1.DataStore.Resources.Count-1 do + begin + res := VpControlLink1.Datastore.Resources.Items[i]; + if res <> AResource then + begin + j := lbOtherResources.Items.AddObject(res.Description, res); + if AResource.Group <> nil then + lbOtherResources.Checked[j] := AResource.Group.IndexOfID(AResource.ResourceID) <> -1; + end; + end; +end; + procedure TMainForm.WriteIni; var ini: TCustomIniFile; @@ -1110,6 +1164,12 @@ begin ImageList1.GetBitmap(1, Img.Picture.Bitmap); end; +procedure TMainForm.UpdateOtherResourcesList; +begin + lblOtherResources.Visible := VpControlLink1.Datastore.Resources.Count > 0; + lbOtherResources.Visible := VpControlLink1.Datastore.Resources.Count > 0; +end; + procedure TMainForm.VpBufDSDataStore1PlaySound(Sender: TObject; const AWavFile: String; AMode: TVpPlaySoundMode); begin diff --git a/components/tvplanit/languages/demo.de.po b/components/tvplanit/languages/demo.de.po index 2f28b46e7..68a2aa20c 100644 --- a/components/tvplanit/languages/demo.de.po +++ b/components/tvplanit/languages/demo.de.po @@ -206,6 +206,16 @@ msgstr "" msgid "Language" msgstr "" +#: tmainform.lblotherresources.caption +msgctxt "tmainform.lblotherresources.caption" +msgid "Check the resource to be overlaid to the current resource" +msgstr "" + +#: tmainform.lblresources.caption +msgctxt "tmainform.lblresources.caption" +msgid "Resources (the selected resource will be displayed)" +msgstr "" + #: tmainform.lbltimeformat.caption msgid "Time format" msgstr "" diff --git a/components/tvplanit/languages/demo.fi.po b/components/tvplanit/languages/demo.fi.po index 7a6a72e51..63106682e 100644 --- a/components/tvplanit/languages/demo.fi.po +++ b/components/tvplanit/languages/demo.fi.po @@ -196,6 +196,16 @@ msgstr "" msgid "Language" msgstr "" +#: tmainform.lblotherresources.caption +msgctxt "tmainform.lblotherresources.caption" +msgid "Check the resource to be overlaid to the current resource" +msgstr "" + +#: tmainform.lblresources.caption +msgctxt "tmainform.lblresources.caption" +msgid "Resources (the selected resource will be displayed)" +msgstr "" + #: tmainform.lbltimeformat.caption msgid "Time format" msgstr "" diff --git a/components/tvplanit/languages/demo.nl.po b/components/tvplanit/languages/demo.nl.po index 952646c25..417c8fa16 100644 --- a/components/tvplanit/languages/demo.nl.po +++ b/components/tvplanit/languages/demo.nl.po @@ -195,6 +195,16 @@ msgstr "" msgid "Language" msgstr "" +#: tmainform.lblotherresources.caption +msgctxt "tmainform.lblotherresources.caption" +msgid "Check the resource to be overlaid to the current resource" +msgstr "" + +#: tmainform.lblresources.caption +msgctxt "tmainform.lblresources.caption" +msgid "Resources (the selected resource will be displayed)" +msgstr "" + #: tmainform.lbltimeformat.caption msgid "Time format" msgstr "" diff --git a/components/tvplanit/languages/demo.ru.po b/components/tvplanit/languages/demo.ru.po index e9d7baf1c..e5ae499f8 100644 --- a/components/tvplanit/languages/demo.ru.po +++ b/components/tvplanit/languages/demo.ru.po @@ -205,6 +205,16 @@ msgstr "" msgid "Language" msgstr "" +#: tmainform.lblotherresources.caption +msgctxt "tmainform.lblotherresources.caption" +msgid "Check the resource to be overlaid to the current resource" +msgstr "" + +#: tmainform.lblresources.caption +msgctxt "tmainform.lblresources.caption" +msgid "Resources (the selected resource will be displayed)" +msgstr "" + #: tmainform.lbltimeformat.caption msgid "Time format" msgstr "" diff --git a/components/tvplanit/source/vpdata.pas b/components/tvplanit/source/vpdata.pas index 937cd1d59..a13dc04a2 100644 --- a/components/tvplanit/source/vpdata.pas +++ b/components/tvplanit/source/vpdata.pas @@ -68,6 +68,7 @@ type { forward declarations } TVpResource = class; TVpResourceGroup = class; + TVpResourceArray = array of TVpResource; TVpTasks = class; TVpSchedule = class; TVpEvent = class; @@ -150,6 +151,8 @@ type constructor Create(Owner: TVpResources); destructor Destroy; override; procedure GetResourceGroups(AList: TList); + function OverlayResources(const AResources: TVpResourceArray; + ACaption: String = ''): TVpResourceGroup; property Loading: Boolean read FLoading write FLoading; property Changed: Boolean read FChanged write SetChanged; property Deleted: Boolean read FDeleted write SetDeleted; @@ -1012,6 +1015,48 @@ begin end; end; +{ Overlays the resources listed in the array AResources and creates a + resource group named according to ACaption (or, if ACaption is empty, the + comma-separated list of the individual resource names). + If a resource group if this name already exists its contained resources are + replaced by the new ones. + When the array is empty, the overlay group with this caption is cleared. } +function TVpResource.OverlayResources(const AResources: TVpResourceArray; + ACaption: String = ''): TVpResourceGroup; +var + grp: TVpResourceGroup; + i: Integer; +begin + // Use resource descriptions if ACaption is not specified or empty. + if ACaption = '' then + begin + ACaption := FDescription; + for i := Low(AResources) to High(AResources) do + if AResources[i] <> nil then + ACaption := ACaption + ', ' + AResources[i].Description; + end; + + // Enforce unique group name + grp := FOwner.FindResourceGroupByName(ACaption); + if grp = nil then + begin + grp := TVpResourceGroup.Create(FOwner, FResourceID, ACaption); + FOwner.FResourceGroups.Add(grp); + end else + grp.Clear; // Make sure that the group is empty before overlaying resources + + // Add resources to group + for i := Low(AResources) to High(AResources) do + grp.AddID(AResources[i].ResourceID); + + FGroup := grp; + Result := grp; + + // Repaint the events + TVpCustomDatastore(FOwner.FOwner).RefreshEvents; +end; + + procedure TVpResource.SetContacts(const Value: TVpContacts); begin FContacts := Value; @@ -1093,7 +1138,7 @@ begin FCaption := ACaption; FPattern := opBDiagonal; FReadOnly := true; - FShowDetails := [odResource]; + FShowDetails := [odResource, odEventDescription]; Clear; end; diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index a65976b17..e73cf77ec 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/components/tvplanit/source/vpdayview.pas @@ -927,7 +927,7 @@ begin exit; grp := Datastore.Resource.Group; - showDetails := (grp <> nil) and (odEventDescription in grp.ShowDetails); + showDetails := (grp <> nil) and (grp.ShowDetails <> []); isOverlayed := AEvent.IsOverlayed; timefmt := GetTimeFormatStr(TimeFormat);