From cf011258e614a7ef1bcc2e486680ca0405de8dc6 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 11 Sep 2016 17:53:51 +0000 Subject: [PATCH] tvplanit: Show hints for events in weekview. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5154 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/fulldemo/demomain.lfm | 2 + components/tvplanit/source/vpmisc.pas | 8 ++ components/tvplanit/source/vpweekview.pas | 128 +++++++++++++++++- 3 files changed, 135 insertions(+), 3 deletions(-) diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 539f9a5ba..f7552abfd 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -271,10 +271,12 @@ object MainForm: TMainForm Height = 528 Top = 0 Width = 496 + ShowHint = True ControlLink = VpControlLink1 Color = clWindow Font.Height = -12 ParentFont = False + ParentShowHint = False AllDayEventAttributes.BackgroundColor = clWindow AllDayEventAttributes.EventBorderColor = clGray AllDayEventAttributes.EventBackgroundColor = clBtnFace diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 7d7842155..0f20c5fd7 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -140,6 +140,7 @@ function GetRealFontHeight(AFont: TFont): Integer; function DecodeLineEndings(const AText: String): String; function EncodeLineEndings(const AText: String): String; +function StripLastLineEnding(const AText: String): String; procedure AddResourceGroupMenu(AMenu: TMenuItem; AResource: TVpResource; AEventHandler: TNotifyEvent); @@ -695,6 +696,13 @@ begin Result := StringReplace(AText, LineEnding, '\n', [rfReplaceAll]); end; +function StripLastLineEnding(const AText: String): String; +begin + Result := AText; + while (Length(Result) > 0) and (Result[Length(Result)] in [#10, #13]) do + Delete(Result, Length(Result), 1); +end; + procedure AddResourceGroupMenu(AMenu: TMenuItem; AResource: TVpResource; AEventHandler: TNotifyEvent); var diff --git a/components/tvplanit/source/vpweekview.pas b/components/tvplanit/source/vpweekview.pas index f26e052aa..0f080170e 100644 --- a/components/tvplanit/source/vpweekview.pas +++ b/components/tvplanit/source/vpweekview.pas @@ -52,7 +52,7 @@ uses {$ELSE} Windows, Messages, {$ENDIF} - Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, + Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Forms, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus, VpDayView; @@ -140,6 +140,8 @@ type FAllowInplaceEdit: Boolean; FAllowDragAndDrop: Boolean; FDragDropTransparent: Boolean; + FMouseEvent: TVpEvent; + FHintWindow: THintWindow; { event variables } FBeforeEdit: TVpBeforeEditEvent; FAfterEdit: TVpAfterEditEvent; @@ -201,6 +203,8 @@ type procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; function EventAtCoord(Pt: TPoint): Boolean; + function GetEventAtCoord(Pt: TPoint): TVpEvent; + function GetEventRect(AEvent: TVpEvent): TRect; procedure wvSetDateByCoord(Point: TPoint); procedure EditEvent; procedure EndEdit(Sender: TObject); @@ -215,6 +219,10 @@ type procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; + { hints } + procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); + procedure HideHintWindow; + { message handlers } {$IFNDEF LCL} procedure WMSize(var Msg: TWMSize); message WM_SIZE; @@ -282,7 +290,7 @@ type implementation uses - SysUtils, LazUTF8, Forms, Dialogs, VpEvntEditDlg, VpWeekViewPainter; + SysUtils, LazUTF8, Dialogs, VpEvntEditDlg, VpWeekViewPainter; (*****************************************************************************) { TVpTGInPlaceEdit } @@ -899,7 +907,81 @@ begin end; end; end; -{=====} + +{ Hints } + +procedure TVpWeekView.ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); +const + MaxWidth = 400; +var + txt, s: String; + grp: TVpResourceGroup; + showDetails: Boolean; + res: TVpResource; + R, REv: TRect; +begin + if (AEvent = nil) or + ((Datastore = nil) or (Datastore.Resource = nil)) then + begin + HideHintWindow; + exit; + end; + + if AEvent.IsOverlayed then begin + grp := Datastore.Resource.Group; + showDetails := (odEventDescription in grp.ShowDetails); + if (odResource in grp.ShowDetails) then begin + res := Datastore.Resources.GetResource(AEvent.ResourceID); + txt := 'Overlayed resource: ' + res.Description; + end else + txt := 'Overlayed resource'; + end else begin + showDetails := true; + txt := ''; + end; + + if txt <> '' then + txt := txt + LineEnding; + + 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; + if (AEvent.Notes <> '') then begin + s := WrapText(AEvent.Notes, MaxWidth); + s := StripLastLineEnding(s); + txt := txt + LineEnding + LineEnding + 'Notes:' + LineEnding + s; + end; + if AEvent.Location <> '' then + txt := txt + LineEnding + LineEnding + 'Location:' + LineEnding + AEvent.Location; + end; + + if (txt <> '') and + not ((wvInPlaceEditor <> nil) and wvInplaceEditor.Visible) and + not (csDesigning in ComponentState) then + begin + if FHintWindow = nil then + FHintWindow := THintWindow.Create(nil); + REv := GetEventRect(AEvent); + REv.TopLeft := ClientToScreen(REv.TopLeft); + REv.BottomRight := ClientToScreen(REv.BottomRight); + APoint := ClientToScreen(APoint); + R := FHintWindow.CalcHintRect(MaxWidth, txt, nil); + OffsetRect(R, APoint.X - WidthOf(R), REv.Bottom); + FHintWindow.ActivateHint(R, txt); + end else + HideHintWindow; +end; + +procedure TVpWeekView.HideHintWindow; +begin + FreeAndNil(FHintWindow); +end; + + +{ Popup menu } procedure TVpWeekView.InitializeDefaultPopup; var @@ -1247,6 +1329,37 @@ begin wvActiveEventRec.Right := 0; wvActiveEventRec.Left := 0; end; + +function TVpWeekView.GetEventAtCoord(Pt: TPoint): TVpEvent; +var + i: Integer; +begin + for i:=0 to High(wvEventArray) do begin + // We've hit the end of visible events without finding a match + if wvEventArray[i].Event = nil then + Break; + + // Point falls inside this event's rectangle + if PointInRect(Pt, wvEventArray[i].Rec) then + begin + Result := wvEventArray[i].Event; + Exit; + end; + end; + Result := nil; +end; + +function TVpWeekView.GetEventRect(AEvent: TVpEvent): TRect; +var + i: Integer; +begin + for i:=0 to High(wvEventArray) do + if wvEventArray[i].Event = AEvent then begin + Result := wvEventArray[i].Rec; + exit; + end; +end; + {=====} { This is the timer event which spawns an in-place editor. @@ -1473,6 +1586,8 @@ begin end; procedure TVpWeekView.MouseMove(Shift: TShiftState; X, Y: Integer); +var + event: TVpEvent; begin inherited MouseMove(Shift, X, Y); if (FActiveEvent <> nil) and (not ReadOnly) then begin @@ -1485,6 +1600,13 @@ begin BeginDrag(true); end; end; + + event := GetEventAtCoord(Point(X, Y)); + if FMouseEvent <> event then begin + Application.CancelHint; + ShowHintWindow(Point(X, Y), event); + FMouseEvent := event; + end; end; procedure TVpWeekView.MouseUp(Button: TMouseButton; Shift: TShiftState;