tvplanit: add TVpResource.OverlayResources as alternate method to add overlay groups. Update FullDemo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8168 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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

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,
+  CheckLst, VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid,
-  VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData,
+  VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData, VpPrtPrvDlg,
-  VpPrtPrvDlg, VpPrtFmtDlg, VpBase;
+  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

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

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

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

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

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;
 

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