pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Add hint support to MonthView.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5155 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-09-11 21:43:26 +00:00
parent cf011258e6
commit 274284fc51
9 changed files with 202 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -43,6 +43,10 @@ msgstr "Fre"
msgid "&Reminder"
msgstr "E&rinnerung"
#: vpsr.rsallday
msgid "All day"
msgstr ""
#: vpsr.rsalldayevent
msgid "&All Day Event"
msgstr "G&anztägiges Ereignis"

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

@ -49,6 +49,10 @@ msgstr "Ven"
msgid "&Reminder"
msgstr "&Rappel"
#: vpsr.rsallday
msgid "All day"
msgstr ""
#: vpsr.rsalldayevent
msgid "&All Day Event"
msgstr "&Événement d'une journée"

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

@ -43,6 +43,10 @@ msgstr "Vr"
msgid "&Reminder"
msgstr "He&rinnering"
#: vpsr.rsallday
msgid "All day"
msgstr ""
#: vpsr.rsalldayevent
msgid "&All Day Event"
msgstr "Hele D&ag Gebeurtenis"

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

@ -33,6 +33,10 @@ msgstr ""
msgid "&Reminder"
msgstr ""
#: vpsr.rsallday
msgid "All day"
msgstr ""
#: vpsr.rsalldayevent
msgid "&All Day Event"
msgstr ""

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

@ -43,6 +43,10 @@ msgstr "Пт."
msgid "&Reminder"
msgstr "Напоминание"
#: vpsr.rsallday
msgid "All day"
msgstr ""
#: vpsr.rsalldayevent
msgid "&All Day Event"
msgstr "Событие на весь день"

194
components/tvplanit/source/vpmonthview.pas
View File

@ -38,7 +38,7 @@ uses
{$ELSE}
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls,
Classes, Graphics, Controls, ComCtrls, ExtCtrls, Forms,
VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus;
type
@ -139,30 +139,22 @@ type
FDate: TDateTime;
FDefaultPopup: TPopupMenu;
FRightClickChangeDate: Boolean;
FHintWindow: THintWindow;
FMouseDate: TDateTime;
{ event variables }
FOwnerDrawCells: TVpOwnerDrawDayEvent;
FOnEventClick: TVpOnEventClick;
FOnEventDblClick: TVpOnEventClick;
{ internal variables }
// mvDayNumberHeight : Integer;
// mvEventTextHeight : Integer;
mvLoaded: Boolean;
// mvInLinkHandler : Boolean;
// mvRowHeight : Integer;
// mvLineHeight : Integer;
// mvColWidth : Integer;
mvDayHeadHeight: Integer;
mvSpinButtons: TUpDown;
mvEventArray: TVpEventArray;
mvMonthDayArray: TVpMonthdayArray;
mvActiveEvent: TVpEvent;
mvActiveEventRec: TRect;
// mvEventList : TList;
// mvCreatingEditor : Boolean;
// mvPainting : Boolean;
// mvVScrollDelta : Integer;
// mvHotPoint : TPoint;
// mvVisibleEvents : Integer;
{ property methods }
procedure SetDrawingStyle(Value: TVpDrawingStyle);
@ -182,6 +174,7 @@ type
procedure SetDate(Value: TDateTime);
procedure SetRightClickChangeDate(const v: Boolean);
procedure SetWeekStartsOn(Value: TVpDayType);
{ internal methods }
procedure mvHookUp;
procedure mvPenChanged(Sender: TObject);
@ -201,10 +194,16 @@ type
procedure WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMLButtonDblClick(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
{$ENDIF}
{ - renamed from EditEventAtCoord and re-written}
function SelectEventAtCoord(Point: TPoint): Boolean;
procedure mvSetDateByCoord(Point: TPoint);
procedure mvSetDateByCoord(APoint: TPoint);
function GetDateAtCoord(APoint: TPoint): TDateTime;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
{ message handlers }
{$IFNDEF LCL}
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
@ -217,6 +216,12 @@ type
procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
procedure WMRButtonDown(var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
{$ENDIF}
{ Hints }
procedure ShowHintWindow(APoint: TPoint; ADate: TDateTime);
procedure HideHintWindow;
{ Popup menu }
procedure PopupToday(Sender: TObject);
procedure PopupNextMonth(Sender: TObject);
procedure PopupPrevMonth(Sender: TObject);
@ -226,6 +231,8 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function BuildEventString(AEvent: TVpEvent;
AShowEventTime, AStartTimeOnly: Boolean): String;
procedure LoadLanguage;
procedure Invalidate; override;
procedure LinkHandler(Sender: TComponent;
@ -277,7 +284,8 @@ type
implementation
uses
SysUtils, LazUTF8, Forms, Dialogs, VpMonthViewPainter;
SysUtils, LazUTF8, Dialogs, StrUtils,
VpMonthViewPainter;
(*****************************************************************************)
@ -480,6 +488,53 @@ begin
inherited;
end;
function TVpMonthView.BuildEventString(AEvent: TVpEvent;
AShowEventTime, AStartTimeOnly: Boolean): String;
var
timefmt: String;
timeStr: String;
descrStr: String;
grp: TVpResourceGroup;
res: TVpResource;
begin
Result := '';
if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then
exit;
timeStr := '';
descrStr := '';
if AShowEventTime then
begin
if AEvent.AllDayEvent then
timeStr := RSAllDay
else begin
timefmt := IfThen(TimeFormat = tf24Hour, 'hh:nn', 'hh:nn AM/PM');
timeStr := FormatDateTime(timefmt, AEvent.StartTime);
if not AStartTimeOnly then
timeStr := timeStr + ' - ' + FormatDateTime(timeFmt, AEvent.EndTime);
end;
end;
if AEvent.IsOverlayed then
begin
res := Datastore.Resources.GetResource(AEvent.ResourceID);
grp := Datastore.Resource.Group;
if (grp <> nil) then
descrStr := Format('[%s]%s', [
IfThen(odResource in grp.ShowDetails, res.Description, res.Description),
IfThen(odEventDescription in grp.ShowDetails, ' ' + AEvent.Description)
]);
end else
descrStr := AEvent.Description;
if (timeStr <> '') and (descrStr <> '') then
Result := timeStr + ': ' + descrStr
else if (timeStr <> '') then
Result := timeStr
else
Result := descrStr;
end;
procedure TVpMonthView.LoadLanguage;
begin
FDefaultPopup.Items.Clear;
@ -855,6 +910,63 @@ begin
end;
{=====}
procedure TVpMonthView.ShowHintWindow(APoint: TPoint; ADate: TDateTime);
const
MaxWidth = 400;
var
txt, s: String;
i: Integer;
event: TVpEvent;
list: TList;
R: TRect;
begin
if (ADate = 0) or ((Datastore = nil) or (Datastore.Resource = nil)) then
begin
HideHintWindow;
exit;
end;
// Collect all events of this day and add them separated by line feeds to
// the hint string (txt).
txt := '';
list := TList.Create;
try
Datastore.Resource.Schedule.EventsByDate(ADate, List);
for i:=0 to list.Count-1 do begin
event := TVpEvent(list[i]);
s := BuildEventString(event, true, false);
txt := IfThen(txt = '', s, txt + LineEnding + s);
end;
finally
list.Free;
end;
// If we have any events then we put the current date at the top.
if txt <> '' then begin
txt := FormatDateTime('dddddd', ADate) + LineEnding + LineEnding + txt;
if ADate = SysUtils.Date then
txt := RSToday + LineEnding + txt;
end;
if (txt <> '') and not (csDesigning in ComponentState) then
begin
// Build and show the hint window
if FHintWindow = nil then
FHintWindow := THintWindow.Create(nil);
APoint := ClientToScreen(APoint);
R := FHintWindow.CalcHintRect(MaxWidth, txt, nil);
OffsetRect(R, APoint.X - WidthOf(R), APoint.Y);
FHintWindow.ActivateHint(R, txt);
end else
// Hide the hint window
HideHintWindow;
end;
procedure TVpMonthView.HideHintWindow;
begin
FreeAndNil(FHintWindow);
end;
procedure TVpMonthView.InitializeDefaultPopup;
var
NewItem : TMenuItem;
@ -863,7 +975,7 @@ begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSToday;
NewItem.OnClick := PopupToday;
FDefaultPopup.Items.Add (NewItem);
FDefaultPopup.Items.Add(NewItem);
end;
NewItem := TMenuItem.Create(Self);
@ -874,14 +986,14 @@ begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSNextMonth;
NewItem.OnClick := PopupNextMonth;
FDefaultPopup.Items.Add (NewItem);
FDefaultPopup.Items.Add(NewItem);
end;
if RSPrevMonth <> '' then begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPrevMonth;
NewItem.OnClick := PopupPrevMonth;
FDefaultPopup.Items.Add (NewItem);
FDefaultPopup.Items.Add(NewItem);
end;
NewItem := TMenuItem.Create(Self);
@ -892,14 +1004,14 @@ begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSNextYear;
NewItem.OnClick := PopupNextYear;
FDefaultPopup.Items.Add (NewItem);
FDefaultPopup.Items.Add(NewItem);
end;
if RSPrevYear <> '' then begin
NewItem := TMenuItem.Create(Self);
NewItem.Caption := RSPrevYear;
NewItem.OnClick := PopupPrevYear;
FDefaultPopup.Items.Add (NewItem);
FDefaultPopup.Items.Add(NewItem);
end;
end;
{=====}
@ -970,16 +1082,29 @@ begin
end;
{=====}
procedure TVpMonthView.mvSetDateByCoord(Point: TPoint);
procedure TVpMonthView.mvSetDateByCoord(APoint: TPoint);
var
I: Integer;
begin
for I := 0 to pred(Length(mvMonthdayArray)) do
if PointInRect(Point, mvMonthdayArray[I].Rec) then begin
if PointInRect(APoint, mvMonthdayArray[I].Rec) then begin
Date := mvMonthdayArray[I].Date;
break;
end;
end;
function TVpMonthView.GetDateAtCoord(APoint: TPoint): TDateTime;
var
i: Integer;
begin
for i:=0 to High(mvMonthDayArray) do
if PointInRect(APoint, mvMonthDayArray[i].Rec) then begin
Result := mvMonthDayArray[i].Date;
exit;
end;
Result := 0;
end;
{=====}
procedure TVpMonthView.KeyDown(var Key: Word; Shift: TShiftState);
@ -1054,7 +1179,30 @@ begin
end;
end;
end;
{=====}
procedure TVpMonthView.MouseEnter;
begin
FMouseDate := 0;
end;
procedure TVpMonthView.MouseLeave;
begin
HideHintWindow;
end;
procedure TVpMonthView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
day: TDateTime;
begin
inherited MouseMove(Shift, X, Y);
day := GetDateAtCoord(Point(X, Y));
if FMouseDate <> day then begin
Application.CancelHint;
ShowHintWindow(Point(X, Y), day);
FMouseDate := day;
end;
end;
procedure TVpMonthView.SetRightClickChangeDate(const v: Boolean);
begin
if v <> FRightClickChangeDate then

15
components/tvplanit/source/vpmonthviewpainter.pas
View File

@ -59,7 +59,7 @@ type
implementation
uses
LazUtf8,
LazUtf8, StrUtils,
VpCanvasUtils, VpMisc;
type
@ -650,17 +650,8 @@ begin
else
TextRect.Right := TextRect.Left + mvColWidth;
{ format the display text }
if FMonthView.ShowEventTime then begin
if (FMonthView.TimeFormat = tf24Hour) then
Str := FormatDateTime('hh:nn',
TVpEvent(EventList.List^[j]).StartTime)
else
Str := FormatDateTime('hh:nn AM/PM',
TVpEvent(EventList.List^[j]).StartTime);
Str := Str + ' - ' + TVpEvent(EventList.List^[j]).Description;
end else
Str := TVpEvent(EventList.List^[j]).Description;
{ Construct the display text }
Str := FMonthView.BuildEventString(TVpEvent(EventList[j]), FMonthView.ShowEventTime, true);
{ set the event font }
RenderCanvas.Font.Assign(FMonthView.EventFont);

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

@ -139,6 +139,8 @@ resourcestring
RSPrevMonth = 'Previous month';
RSPrevYear = 'Previous year';
RSAllDay = 'All day';
{WARNINGS}
RSPermanent = 'This operation cannot be undone!';

9
components/tvplanit/source/vpweekview.pas
View File

@ -943,9 +943,12 @@ begin
if txt <> '' then
txt := txt + LineEnding;
txt := txt + Format('%s - %s', [
FormatDateTime('hh:nn', AEvent.StartTime),
FormatDateTime('hh:nn', AEvent.EndTime)]);
if AEvent.AllDayEvent then
txt := txt + 'All day'
else
txt := txt + Format('%s - %s', [
FormatDateTime('hh:nn', AEvent.StartTime),
FormatDateTime('hh:nn', AEvent.EndTime)]);
if showDetails then begin
txt := txt + LineEnding + LineEnding + 'Event:' + LineEnding + AEvent.Description;