tvplanit: Add property ShowDetails to resource groups in order to control the level of detail visible for overlayed events.

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

components/tvplanit/examples/fulldemo/demomain.pas

@@ -413,11 +413,18 @@ var
 begin
   datastore := VpControlLink1.Datastore;
   grp := datastore.Resources.AddResourceGroup([1, 2], NAME_OF_GROUP);
-  grp.ReadOnly := true;
   grp.Pattern := opDiagCross;
+
+  // Optionally uncomment these lines to get not-default behavior:
+  //grp.ReadOnly := false;
+  //grp.ShowDetails := [odResource, odEventDescription, odEventCategory];
+
+  // Assign the resource group to the active resource of the datastore.
  if datastore.Resource <> nil then
-    datastore.Resource.Group := grp else
+    datastore.Resource.Group := grp
+  else
     datastore.Resource.Group := nil;
+
  // Important: This is not called internally so far!
   datastore.RefreshEvents;  // or: datastore.UpdateGroupEvents;
 end;
@@ -449,6 +456,8 @@ begin
     CategoryColorMap.Category0.BackgroundColor := clSkyBlue;
     CategoryColorMap.Category0.Color := clNavy;
     CategoryColorMap.Category0.Description := 'Appointment';
+//    CategoryColorMap.Category0.Bitmap.Transparent := true;  // <-- not working
+    CategoryColorMap.Category0.Bitmap.LoadFromResourceName(HINSTANCE, 'VPUPARROW');
     CategoryColorMap.Category1.BackgroundColor := 13290239;
     CategoryColorMap.Category1.Color := clRed;
     CategoryColorMap.Category1.Description := 'Urgent';

components/tvplanit/languages/vpsr.de.po

@@ -729,6 +729,10 @@ msgstr "Außerhalb des zulässigen Bereichs"
 msgid "OVERDUE!"
 msgstr "ABGELAUFEN!"
 
+#: vpsr.rsoverlayedevent
+msgid "overlayed"
+msgstr ""
+
 #: vpsr.rsownernotwinctrl
 msgid "Owner must be a TWinControl descendent"
 msgstr "Owner muss von TWinControl abstammen"
@@ -1494,3 +1498,4 @@ msgstr "Unbekannte Achsen-Spezifikation: %s"
 #: vpsr.sxmldecnotatbeg
 msgid "The XML declaration must appear before the first element"
 msgstr "Die XML-Deklaration muss vor dem ersten Element erscheinen."
+

components/tvplanit/languages/vpsr.fr.po

@@ -735,6 +735,10 @@ msgstr "Hors de portée"
 msgid "OVERDUE!"
 msgstr "EN RETARD!"
 
+#: vpsr.rsoverlayedevent
+msgid "overlayed"
+msgstr ""
+
 #: vpsr.rsownernotwinctrl
 msgid "Owner must be a TWinControl descendent"
 msgstr "Le propriétaire doit être un descendant de TWinControl"

components/tvplanit/languages/vpsr.nl.po

@@ -729,6 +729,10 @@ msgstr "Buiten geldig bereik"
 msgid "OVERDUE!"
 msgstr "OVER TIJD!"
 
+#: vpsr.rsoverlayedevent
+msgid "overlayed"
+msgstr ""
+
 #: vpsr.rsownernotwinctrl
 msgid "Owner must be a TWinControl descendent"
 msgstr "Owner moet van TWinControl afstammen"

components/tvplanit/languages/vpsr.po

@@ -719,6 +719,10 @@ msgstr ""
 msgid "OVERDUE!"
 msgstr ""
 
+#: vpsr.rsoverlayedevent
+msgid "overlayed"
+msgstr ""
+
 #: vpsr.rsownernotwinctrl
 msgid "Owner must be a TWinControl descendent"
 msgstr ""

components/tvplanit/languages/vpsr.ru.po

@@ -729,6 +729,10 @@ msgstr "За пределами диапазона"
 msgid "OVERDUE!"
 msgstr "ПРОСРОЧЕНО!"
 
+#: vpsr.rsoverlayedevent
+msgid "overlayed"
+msgstr ""
+
 #: vpsr.rsownernotwinctrl
 msgid "Owner must be a TWinControl descendent"
 msgstr ""

components/tvplanit/source/vpbase.pas

@@ -202,8 +202,8 @@ type
     FDescription: string;
     FIndex: Integer;
     FBitmap: TBitmap;
-    procedure SetBackgroundColor (const v : TColor);
+    procedure SetBackgroundColor(const v: TColor);
-    procedure SetBitmap (v : TBitmap);
+    procedure SetBitmap(v: TBitmap);
     procedure SetColor(Value: TColor);
     procedure SetDescription(Value: string);
   public
@@ -212,7 +212,7 @@ type
   published
     property BackgroundColor: TColor
       read FBackgroundColor write SetBackgroundColor default clWindow;
-    property Bitmap : TBitmap read FBitmap write SetBitmap;
+    property Bitmap: TBitmap read FBitmap write SetBitmap;
     property Color: TColor read FColor write SetColor;
     property Description: string read FDescription write SetDescription;
     property CategoryIndex: Integer read FCategoryIndex;

components/tvplanit/source/vpbaseds.pas

@@ -210,6 +210,7 @@ type
     FAutoConnect       : Boolean;
     FLoading           : Boolean;
     FCategoryColorMap  : TVpCategoryColorMap;
+    FHiddenCategories  : TVpCategoryInfo;
     FResources         : TVpResources;
     FTimeRange         : TVpTimeRange;
     FActiveDate        : TDateTime;
@@ -298,6 +299,8 @@ type
   published
     property CategoryColorMap: TVpCategoryColorMap
       read FCategoryColorMap write FCategoryColorMap;
+    property HiddenCategories: TVpCategoryInfo
+      read FHiddenCategories write FHiddenCategories;
     property DefaultEventSound: string
       read FDefaultEventSound write FDefaultEventSound;
     property EnableEventTimer: Boolean
@@ -434,7 +437,14 @@ begin
   FAutoCreate := true;
   FResources := TVpResources.Create(Self);
   FTimeRange := TVpTimeRange.Create(Self);
+
   FCategoryColorMap := TVpCategoryColorMap.Create;
+  FHiddenCategories := TVpCategoryInfo.Create;
+  with FHiddenCategories do begin
+    BackgroundColor := clSilver;
+    Color := clGray;
+  end;
+
   FActiveDate := Now;
   FDayBuffer := 31;  {One full month before and after the current date. }
   FTimeRange.StartTime := Now - FDayBuffer;
@@ -453,7 +463,6 @@ begin
     dsAlertTimer.Interval := 500;
   end;
 
-
   { If the DataStore is being dropped onto a form for the first time... }
   if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
     LinkToControls(Owner);
@@ -476,6 +485,7 @@ begin
   FResources.Free;
   FTimeRange.Free;
   FCategoryColorMap.Free;
+  FHiddenCategories.Free;
 
   if dsAlertTimer <> nil then
     dsAlertTimer.Free;

components/tvplanit/source/vpdata.pas

@@ -60,8 +60,12 @@ type
 
   TVpContactSort = (csLastFirst, csFirstLast);
 
-  TVpOverlayPattern = (opHorizontal=2, opVertical, opFDiagonal,
+  TVpOverlayPattern = (opSolid, opClear, opHorizontal, opVertical,
-                       opBDiagonal, opCross, opDiagCross);
+                       opFDiagonal, opBDiagonal, opCross, opDiagCross);
+
+  TVpOverlayDetail = (odResource, odEventDescription, odEventCategory);
+  TVpOverlayDetails = set of TVpOverlayDetail;
+
 
   { forward declarations }
   TVpResource = class;
@@ -191,9 +195,11 @@ type
     FIDs: Array of Integer;
     FReadOnly: Boolean;
     FPattern: TVpOverlayPattern;
+    FShowDetails: TVpOverlayDetails;
     function GetCount: integer;
     function GetItem(AIndex: Integer): TVpResource;
     procedure SetPattern(AValue: TVpOverlayPattern);
+    procedure SetShowDetails(AValue: TVpOverlayDetails);
   public
     constructor Create(AOwner: TVpResources; AResourceID: Integer; ACaption: String);
     destructor Destroy; override;
@@ -205,9 +211,10 @@ type
     property Caption: String read FCaption;
     property Count: Integer read GetCount;
     property Items[AIndex: Integer]: TVpResource read GetItem; default;
+    property Pattern: TVpOverlayPattern read FPattern write SetPattern;
     property ResourceID: Integer read FResourceID;
     property ReadOnly: boolean read FReadOnly write FReadOnly;
-    property Pattern: TVpOverlayPattern read FPattern write SetPattern;
+    property ShowDetails: TVpOverlayDetails read FShowDetails write SetShowDetails;
   end;
 
   TVpSchedule = class
@@ -1001,6 +1008,7 @@ begin
   FCaption := ACaption;
   FPattern := opBDiagonal;
   FReadOnly := true;
+  FShowDetails := [odResource];
   Clear;
 end;
 
@@ -1098,8 +1106,16 @@ begin
   if FPattern = AValue then
     exit;
   FPattern := AValue;
+  // to do: repaint the controls
 end;
 
+procedure TVpResourceGroup.SetShowDetails(AValue: TVpOverlayDetails);
+begin
+  if FShowDetails = AValue then
+    exit;
+  FShowDetails := AValue;
+  // To do: repaint the controls
+end;
 
 (*****************************************************************************)
 { TVpEvent }

components/tvplanit/source/vpdayviewpainter.pas

@@ -76,7 +76,7 @@ type
     OldFont: TFont;
 
   protected
-    function BuildEventString(AEvent: TVpEvent; const AEventRect, AIconRect: TRect): String;
+    function BuildEventString(AEvent: TVpEvent): String;
     procedure CalcRowHeadRect(out ARect: TRect);
     function CalcRowHeadWidth: Integer;
     function CountOverlappingEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer;
@@ -128,7 +128,7 @@ implementation
 
 uses
   StrUtils, Math, LazUtf8,
-  VpCanvasUtils, VpMisc;
+  VpSR, VpCanvasUtils, VpMisc;
 
 const
   ICON_MARGIN = 4;
@@ -145,35 +145,41 @@ begin
   FDayView := ADayView;
 end;
 
-function TVpDayViewPainter.BuildEventString(AEvent: TVpEvent;
+function TVpDayViewPainter.BuildEventString(AEvent: TVpEvent): String;
-  const AEventRect, AIconRect: TRect): String;
 var
   maxW: Integer;
   timeFmt: String;
   res: TVpResource;
+  grp: TVpResourceGroup;
+  isOverlayed: Boolean;
 begin
+  Result := '';
+
+  grp := FDayView.Datastore.Resource.Group;
+  isOverlayed := AEvent.IsOverlayed;
+
+  if isOverlayed then begin
+    if (grp <> nil) and (odResource in grp.ShowDetails) then begin
+      res := FDayView.Datastore.Resources.GetResource(AEvent.ResourceID);
+      if res <> nil then
+        Result := '[' + res.Description + '] ';
+    end else
+      Result := '[' + RSOverlayedEvent + '] ';
+  end;
+
+  if (not isOverlayed) or ((grp <> nil) and (odEventDescription in grp.ShowDetails)) then
+  begin
+    if Result <> '' then
+      Result := Result + ' ';
     if FDayView.ShowEventTimes then begin
       timeFmt := IfThen(FDayView.TimeFormat = tf24Hour, 'h:nn', 'h:nnam/pm');
-    Result := Format('%s - %s: %s', [
+      Result := Result + Format('%s - %s: %s', [
         FormatDateTime(timeFmt, AEvent.StartTime),
         FormatDateTime(timeFmt, AEvent.EndTime),
         AEvent.Description
       ]);
     end else
-    Result := AEvent.Description;
+      Result := Result + AEvent.Description;
-
-  if AEvent.IsOverlayed then begin
-    res := FDayView.Datastore.Resources.GetResource(AEvent.ResourceID);
-    if res <> nil then
-      Result := Format('[%s] %s', [res.Description, Result]);
-  end;
-
-  if FDayView.WrapStyle = wsNone then begin
-    { if the string is longer than the availble space then chop off the end
-      and place those little '...'s at the end }
-    maxW := AEventRect.Right - AIconRect.Right - FScaledGutterWidth - TextMargin;
-    if RenderCanvas.TextWidth(Result) > maxW then
-      Result := GetDisplayString(RenderCanvas, Result, 0, maxW);
   end;
 end;
 
@@ -788,6 +794,7 @@ procedure TVpDayViewPainter.DrawEvent(AEvent: TVpEvent; var AEventRec: TVpDvEven
 var
   EventCategory: TVpCategoryInfo;
   EventIsEditing: Boolean;
+  EventIsOverlayed: Boolean;
   EventSTime, EventETime: Double;
   EventDuration: Double;
   EventSLine, EventELine, EventLineCount: Integer;
@@ -796,9 +803,19 @@ var
   StartOffset, EndOffset: Double;
   EventString: String;
   tmpRect: TRect;
+  maxW: Integer;
+  grp: TVpResourceGroup;
 begin
   { Initialize, collect useful information needed later }
+  if Assigned(FDayView.Datastore) then
+  begin
     EventCategory := FDayView.Datastore.CategoryColorMap.GetCategory(AEvent.Category);
+    grp := FDayView.Datastore.Resource.Group;
+  end else begin
+    EventCategory := nil;
+    grp := nil;
+  end;
+  EventIsOverlayed := AEvent.IsOverlayed;
 
   with TVpDayViewOpener(FDayView) do
     if (dvInplaceEditor <> nil) and dvInplaceEditor.Visible then
@@ -812,8 +829,8 @@ begin
   AEventRec.RealEndTime := EventETime;
 
   { Find the lines on which this event starts and ends }
-  EventSLine := GetStartLine(EventSTime, UseGran); //FDayView.Granularity);
+  EventSLine := GetStartLine(EventSTime, UseGran);
-  EventELine := GetEndLine(EventETime, UseGran); //FDayView.Granularity);
+  EventELine := GetEndLine(EventETime, UseGran);
 
   { If the event doesn't occupy area that is currently visible, then skip it. }
   if (EventELine < StartLine) or (EventSLine > StartLine + RealVisibleLines + 1) then
@@ -829,22 +846,32 @@ begin
   PrepareEventRect(AEventRec.WidthDivisor, AEventRec.Level, EventRect);
 
   { Draw the event rectangle }
+  RenderCanvas.Brush.Color := WindowColor;
   if Assigned(FDayView.DataStore) then begin
     if EventIsEditing then
       RenderCanvas.Brush.Color := WindowColor
     else
+    if Assigned(EventCategory) then
       RenderCanvas.Brush.Color := EventCategory.BackgroundColor
-  end else
+  end;
-    RenderCanvas.Brush.Color := WindowColor;
+  if EventIsOverlayed then begin
-  if AEvent.IsOverlayed then
+    if (grp <> nil) and (not (odEventCategory in grp.ShowDetails)) then
+      RenderCanvas.Brush.Color := FDayView.Datastore.HiddenCategories.BackgroundColor
+    else
       RenderCanvas.Brush.Style := OverlayPatternToBrushStyle(AEvent.GetResource.Group.Pattern);
+  end;
   TPSFillRect(RenderCanvas, Angle, RenderIn, EventRect);
   RenderCanvas.Brush.Style := bsSolid;
 
   { Paint the little area to the left of the text the color corresponding to
     the event's category. These colors are used even when printing }
-  if Assigned(FDayView.DataStore) then
+  RenderCanvas.Brush.Color := clNavy;
+  if Assigned(FDayView.Datastore) then
+  begin
     RenderCanvas.Brush.Color := EventCategory.Color;
+    if EventIsOverlayed and (grp <> nil) and (not (odEventCategory in grp.ShowDetails)) then
+      RenderCanvas.Brush.Color := FDayView.Datastore.HiddenCategories.Color;
+  end;
 
   { find the pixel offset to use for determining where to start and }
   { stop drawing colored area according to the start time and end time of the event. }
@@ -914,10 +941,18 @@ begin
   if FDayView.IconAttributes.ShowInPrint then
     DrawIcons(IconRect);
 
-  { build the event string }
+  { Build the event string }
-  EventString := BuildEventString(AEvent, EventRect, IconRect);
+  EventString := BuildEventString(AEvent);
 
-  { draw the event string }
+  { If the string is longer than the availble space then chop off the end
+    and place those little '...'s at the end }
+  if FDayView.WrapStyle = wsNone then begin
+    maxW := EventRect.Right - IconRect.Right - FScaledGutterWidth - TextMargin;
+    if RenderCanvas.TextWidth(EventString) > maxW then
+      EventString := GetDisplayString(RenderCanvas, EventString, 0, maxW);
+  end;
+
+  { Draw the event string }
   DrawEventText(EventString, EventRect, IconRect, AEventRec.Level);
 
   { paint the borders around the event text area }
@@ -1587,6 +1622,8 @@ var
   cat: TVpCategoryInfo;
   w, h: Integer;
   R: TRect;
+  isOverlayed: Boolean;
+  grp: TVpResourceGroup;
 begin
   ShowAlarm := False;
   ShowRecurring := False;
@@ -1601,13 +1638,23 @@ begin
     ShowAlarm := (dvBmpAlarm.Width <> 0) and (dvBmpAlarm.Height <> 0);
   end;
 
-  if Event.RepeatCode <> rtNone then begin
+  if Event.RepeatCode <> rtNone then
+  begin
     dvBmpRecurring.Assign(FDayView.IconAttributes.RecurringBitmap);
     ShowRecurring := (dvBmpRecurring.Width <> 0) and (dvBmpRecurring.Height <> 0);
   end;
 
-  if Assigned(FDayView.DataStore) then begin
+  if Assigned(FDayView.DataStore) then
-    if Event.Category < 10 then begin
+  begin
+    isOverlayed := Event.IsOverlayed;
+    grp := FDayView.Datastore.Resource.Group;
+    if isOverlayed and (grp <> nil) and (not (odEventCategory in grp.ShowDetails)) then
+    begin
+      dvBmpCategory.Width := 0;
+      dvBmpCategory.Height := 0;
+    end else
+    if Event.Category < 10 then
+    begin
       cat := FDayView.Datastore.CategoryColorMap.GetCategory(Event.Category);
       w := cat.Bitmap.Width;
       h := cat.Bitmap.Height;

components/tvplanit/source/vpsr.inc

@@ -155,6 +155,7 @@ resourcestring
                               'Do you want to flip them?';
   RSCannotEditOverlayedEvent= 'Cannot edit this overlayed event.';
   RSNoOverlayedEvents       = 'none';
+  RSOverlayedEvent          = 'overlayed';
 
   {Task Specific}
   RSConfirmDeleteTask       = 'Delete this task from your list?';

components/tvplanit/source/vpweekviewpainter.pas

@@ -80,23 +80,37 @@ function TVpWeekViewPainter.BuildEventString(AEvent: TVpEvent;
 var
   timeFmt: String;
   res: TVpResource;
+  grp: TVpResourceGroup;
+  isOverlayed: Boolean;
 begin
-  if FWeekView.ShowEventTime then
+  grp := FWeekView.Datastore.Resource.Group;
-  begin
+  isOverlayed := AEvent.IsOverlayed;
-    timefmt := IfThen(FWeekView.TimeFormat = tf24Hour, 'hh:nn', 'hh:nn AM/PM');
-    Result := Format('%s - %s: ', [
-      FormatDateTime(timeFmt, AStartTime),
-      FormatDateTime(timeFmt, AEndTime)
-    ]);
-    Result := Result + ' ' + AEvent.Description;
-  end else
-    Result := AEvent.Description;
 
-  if AEvent.IsOverlayed then
+  if isOverlayed then
+  begin
+    if (grp <> nil) and (odResource in grp.ShowDetails) then
     begin
       res := FWeekView.Datastore.Resources.GetResource(AEvent.ResourceID);
       if res <> nil then
-      Result := Format('[%s] %s', [res.Description, Result]);
+        Result := '[' + res.Description + ']';
+    end else
+      Result := '[' + RSOverlayedEvent + ']';
+  end;
+
+  if (not isOverlayed) or ((grp <> nil) and (odEventDescription in grp.ShowDetails)) then
+  begin
+    if Result <> '' then
+      Result := Result + ' ';
+    if FWeekView.ShowEventTime then
+    begin
+      timefmt := IfThen(FWeekView.TimeFormat = tf24Hour, 'hh:nn', 'hh:nn AM/PM');
+      Result := Result + Format('%s - %s: %s', [
+        FormatDateTime(timeFmt, AStartTime),
+        FormatDateTime(timeFmt, AEndTime),
+        AEvent.Description
+      ]);
+    end else
+      Result := Result + AEvent.Description;
   end;
 end;