paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5152 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-09-11 13:35:19 +00:00
parent ad82eacee5
commit cd23d554eb
12 changed files with 191 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/tvplanit/examples/fulldemo/demomain.pas
View File

@ -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';

5
components/tvplanit/languages/vpsr.de.po
View File

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

4
components/tvplanit/languages/vpsr.fr.po
View File

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

4
components/tvplanit/languages/vpsr.nl.po
View File

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

4
components/tvplanit/languages/vpsr.po
View File

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

4
components/tvplanit/languages/vpsr.ru.po
View File

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

28
components/tvplanit/source/vpbase.pas
View File

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

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

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

22
components/tvplanit/source/vpdata.pas
View File

@ -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 }

121
components/tvplanit/source/vpdayviewpainter.pas
View File

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

1
components/tvplanit/source/vpsr.inc
View File

@ -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?';

42
components/tvplanit/source/vpweekviewpainter.pas
View File

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