diff --git a/components/tvplanit/examples/fulldemo/demomain.pas b/components/tvplanit/examples/fulldemo/demomain.pas index 53e3580c7..33bb1cf5b 100644 --- a/components/tvplanit/examples/fulldemo/demomain.pas +++ b/components/tvplanit/examples/fulldemo/demomain.pas @@ -413,12 +413,19 @@ var begin datastore := VpControlLink1.Datastore; grp := datastore.Resources.AddResourceGroup([1, 2], NAME_OF_GROUP); - grp.ReadOnly := true; grp.Pattern := opDiagCross; - if datastore.Resource <> nil then - datastore.Resource.Group := grp else + + // 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 := nil; - // Important: This is not called internally so far! + + // 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'; diff --git a/components/tvplanit/languages/vpsr.de.po b/components/tvplanit/languages/vpsr.de.po index 59c49585e..e2e431b15 100644 --- a/components/tvplanit/languages/vpsr.de.po +++ b/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." + diff --git a/components/tvplanit/languages/vpsr.fr.po b/components/tvplanit/languages/vpsr.fr.po index 3f8ea5d9f..920cb0db0 100644 --- a/components/tvplanit/languages/vpsr.fr.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.nl.po b/components/tvplanit/languages/vpsr.nl.po index e2355393b..89407f4e6 100644 --- a/components/tvplanit/languages/vpsr.nl.po +++ b/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" diff --git a/components/tvplanit/languages/vpsr.po b/components/tvplanit/languages/vpsr.po index cd88548f3..5cdedd935 100644 --- a/components/tvplanit/languages/vpsr.po +++ b/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 "" diff --git a/components/tvplanit/languages/vpsr.ru.po b/components/tvplanit/languages/vpsr.ru.po index cb8287203..258f8c241 100644 --- a/components/tvplanit/languages/vpsr.ru.po +++ b/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 "" diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index e90323507..178247714 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/components/tvplanit/source/vpbase.pas @@ -166,25 +166,25 @@ type property AfterExit: TNotifyEvent read FAfterExit write FAfterExit; property OnMouseWheel: TVpMouseWheelEvent read FOnMouseWheel write FOnMouseWheel; - public + public constructor Create (AOwner : TComponent); override; published property Version: string read GetVersion write SetVersion stored False; {$IFNDEF LCL} - {$IFDEF VERSION6} - property BevelEdges; - property BevelInner; - property BevelOuter; - property BevelKind; - property BevelWidth; + {$IFDEF VERSION6} + property BevelEdges; + property BevelInner; + property BevelOuter; + property BevelKind; + property BevelWidth; {$ENDIF} {$ENDIF} - { The Hint property is published in TControl, but the ShowHint } - { property is left public. odd. } - { surfacing here will make it published in all our descendants } - property ShowHint; + { The Hint property is published in TControl, but the ShowHint } + { property is left public. odd. } + { surfacing here will make it published in all our descendants } + property ShowHint; end; TVpPersistent = class(TPersistent) @@ -202,8 +202,8 @@ type FDescription: string; FIndex: Integer; FBitmap: TBitmap; - procedure SetBackgroundColor (const v : TColor); - procedure SetBitmap (v : TBitmap); + procedure SetBackgroundColor(const v: TColor); + 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; diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas index a9e431504..2defa0d61 100644 --- a/components/tvplanit/source/vpbaseds.pas +++ b/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; diff --git a/components/tvplanit/source/vpdata.pas b/components/tvplanit/source/vpdata.pas index 6e2d24fab..9ae1bf995 100644 --- a/components/tvplanit/source/vpdata.pas +++ b/components/tvplanit/source/vpdata.pas @@ -60,8 +60,12 @@ type TVpContactSort = (csLastFirst, csFirstLast); - TVpOverlayPattern = (opHorizontal=2, opVertical, opFDiagonal, - opBDiagonal, opCross, opDiagCross); + TVpOverlayPattern = (opSolid, opClear, opHorizontal, opVertical, + 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 } diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index 8ef30c46d..78bd2bc76 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/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; - const AEventRect, AIconRect: TRect): String; +function TVpDayViewPainter.BuildEventString(AEvent: TVpEvent): String; var maxW: Integer; timeFmt: String; res: TVpResource; + grp: TVpResourceGroup; + isOverlayed: Boolean; begin - if FDayView.ShowEventTimes then begin - timeFmt := IfThen(FDayView.TimeFormat = tf24Hour, 'h:nn', 'h:nnam/pm'); - Result := Format('%s - %s: %s', [ - FormatDateTime(timeFmt, AEvent.StartTime), - FormatDateTime(timeFmt, AEvent.EndTime), - AEvent.Description - ]); - end else - Result := AEvent.Description; + Result := ''; - if AEvent.IsOverlayed then begin - res := FDayView.Datastore.Resources.GetResource(AEvent.ResourceID); - if res <> nil then - Result := Format('[%s] %s', [res.Description, 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 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); + 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 := Result + Format('%s - %s: %s', [ + FormatDateTime(timeFmt, AEvent.StartTime), + FormatDateTime(timeFmt, AEvent.EndTime), + AEvent.Description + ]); + end else + Result := Result + AEvent.Description; 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 } - EventCategory := FDayView.Datastore.CategoryColorMap.GetCategory(AEvent.Category); + 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); - EventELine := GetEndLine(EventETime, UseGran); //FDayView.Granularity); + EventSLine := GetStartLine(EventSTime, UseGran); + 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 - RenderCanvas.Brush.Color := WindowColor; - if AEvent.IsOverlayed then - RenderCanvas.Brush.Style := OverlayPatternToBrushStyle(AEvent.GetResource.Group.Pattern); + end; + if EventIsOverlayed then begin + 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 } - EventString := BuildEventString(AEvent, EventRect, IconRect); + { Build the event string } + 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 Event.Category < 10 then begin + if Assigned(FDayView.DataStore) then + 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; diff --git a/components/tvplanit/source/vpsr.inc b/components/tvplanit/source/vpsr.inc index 375b7017f..d0e44b16f 100644 --- a/components/tvplanit/source/vpsr.inc +++ b/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?'; diff --git a/components/tvplanit/source/vpweekviewpainter.pas b/components/tvplanit/source/vpweekviewpainter.pas index 07e0fa32f..5a42f8623 100644 --- a/components/tvplanit/source/vpweekviewpainter.pas +++ b/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 - begin - 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; + grp := FWeekView.Datastore.Resource.Group; + isOverlayed := AEvent.IsOverlayed; - if AEvent.IsOverlayed then + if isOverlayed then begin - res := FWeekView.Datastore.Resources.GetResource(AEvent.ResourceID); - if res <> nil then - Result := Format('[%s] %s', [res.Description, Result]); + if (grp <> nil) and (odResource in grp.ShowDetails) then + begin + res := FWeekView.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 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;