From 6d561ddb92489c86d8dc980350fb87d96bceb627 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 1 Sep 2022 12:12:52 +0000 Subject: [PATCH] tvplanit: Support hints in TVpGanttView git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8436 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpganttview.pas | 155 ++++++++++++++++++++- 1 file changed, 153 insertions(+), 2 deletions(-) diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 4ccb94e84..cdb88f66b 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -6,7 +6,7 @@ interface uses LCLType, LCLIntf, LMessages, - Classes, SysUtils, Graphics, Types, Controls, StdCtrls, Menus, + Classes, SysUtils, Graphics, Types, Controls, StdCtrls, Menus, Forms, VpConst, VpMisc, VpBase, VpBaseDS, VpData; type @@ -121,12 +121,16 @@ type FColHeaderAttributes: TVpGanttColHeaderAttributes; FRowHeaderAttributes: TVpGanttRowHeaderAttributes; + FComponentHint: TTranslateString; FDateFormat: array[0..2] of String; FDrawingStyle: TVpDrawingStyle; FDefaultPopup: TPopupMenu; FExternalPopup: TPopupMenu; + FHintMode: TVpHintMode; + FMouseEvent: TVpEvent; FOptions: TVpGanttViewOptions; FSpecialDayMode: TVpGanttSpecialDayMode; + FTimeFormat: TVpTimeFormat; FOnAddEvent: TVpOnAddNewEvent; FOnDeletingEvent: TVpOnDeletingEvent; @@ -203,10 +207,19 @@ type procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; + { Hints } + procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); + procedure HideHintWindow; + procedure SetHint(const AValue: TTranslateString); override; + procedure SetHintMode(const AValue: TVpHintMode); + { Popup } function GetPopupMenu: TPopupMenu; override; procedure InitializeDefaultPopup; @@ -218,6 +231,8 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + + function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String; procedure DeleteActiveEvent(Prompt: Boolean); procedure Init; function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean; @@ -272,6 +287,7 @@ type property DayFormat: String index 0 read GetDateFormat write SetDateFormat stored IsStoredDateFormat; property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120; + property HintMode: TVpHintMode read FHintMode write SetHintMode default hmPlannerHint; property HolidayColor: TColor read FHolidayColor write SetHolidayColor default HOLIDAY_COLOR; property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR; property MonthFormat: String index 1 read GetDateFormat write SetDateFormat stored IsStoredDateFormat; @@ -281,6 +297,7 @@ type property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes; property SpecialDayMode: TVpGanttSpecialDayMode read FSpecialDayMode write SetSpecialDayMode default sdmColumn; property TextMargin: Integer read FTextMargin write SetTextMargin default 2; + property TimeFormat: TVpTimeFormat read FTimeFormat write FTimeFormat default tf12Hour; property WeekendColor: TColor read FWeekendColor write SetWeekendColor default WEEKEND_COLOR; // inherited events property OnClick; @@ -453,6 +470,64 @@ begin inherited; end; +function TVpGanttView.BuildEventString(AEvent: TVpEvent; + UseAsHint: Boolean): String; +const + DATE_FORMAT = 'ddddd'; +var + timeFmt: String; + timeStr: String; + startDateStr, endDateStr: string; + s: String; +begin + Result := ''; + + if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then + exit; + + if UseAsHint then begin + { Usage as hint } + startDateStr := FormatDateTime(DATE_FORMAT, AEvent.StartTime); + if trunc(AEvent.StartTime) = trunc(AEvent.EndTime) then + endDateStr := '' + else + endDateStr := FormatDateTime(DATE_FORMAT, AEvent.EndTime); + + if AEvent.AllDayEvent then + begin + if endDateStr <> '' then endDateStr := ' - ' + endDateStr; + Result := startDateStr + endDatestr + LineEnding + RSAllDay; + end else + begin + timefmt := GetTimeFormatStr(TimeFormat); + startDateStr := startDateStr + ' ' + FormatDateTime(timeFmt, AEvent.StartTime) + ' - '; + if endDateStr <> '' then endDateStr := endDateStr + ' '; + endDateStr := endDateStr + FormatDateTime(timeFmt, AEvent.EndTime); + Result := startDateStr + endDateStr; + end; + + // Event description + Result := Result + LineEnding2 + + RSEvent + ':' + LineEnding + AEvent.Description; + + // Event notes + if (AEvent.Notes <> '') then begin + s := WrapText(AEvent.Notes, MAX_HINT_WIDTH); + s := StripLastLineEnding(s); + Result := Result + LineEnding2 + + RSNotes + ':' + LineEnding + s; + end; + + // Event location + if (AEvent.Location <> '') then + Result := Result + LineEnding2 + + RSLocation + ':' + LineEnding + AEvent.Location; + end + else + { Usage as cell text } + Result := ''; +end; + procedure TVpGanttView.CalcColHeaderHeight; var s: String; @@ -698,7 +773,7 @@ var begin Result := nil; dt := GetDateTimeAtCoord(X); - if dt = -1 then + if (dt = -1) or (FRowHeight = 0) then exit; idx := GetRowAtCoord(Y); if (idx >= 0) and (idx < NumEvents) then @@ -1023,6 +1098,35 @@ begin Invalidate; end; +procedure TVpGanttView.MouseEnter; +begin + FMouseEvent := nil; +end; + +procedure TVpGanttView.MouseLeave; +begin + HideHintWindow; +end; + + +procedure TVpGanttView.MouseMove(Shift: TShiftState; X, Y: Integer); +var + event: TVpEvent; +begin + inherited MouseMove(Shift, X, Y); + if ShowHint then + begin + event := GetEventAtCoord(X, Y); + if event = nil then + HideHintWindow + else + if FMouseEvent <> event then begin + ShowHintWindow(Point(X, Y), event); + FMouseEvent := event; + end; + end; +end; + procedure TVpGanttView.Paint; begin RenderToCanvas( @@ -1561,6 +1665,53 @@ begin end; +{ Hint support } + +procedure TVpGanttView.ShowHintWindow(APoint: TPoint; AEvent: TVpEvent); +var + txt: String; +begin + HideHintWindow; + case FHintMode of + hmPlannerHint: + begin + if (AEvent = nil) or (Datastore = nil) or (Datastore.Resource = nil) then + exit; + txt := BuildEventString(AEvent, true); + end; + hmComponentHint: + txt := FComponentHint; + end; + if (txt <> '') and not (csDesigning in ComponentState) then + begin + Hint := txt; + Application.Hint := Hint; + Application.ActivateHint(ClientToScreen(APoint), true); + end; +end; + +procedure TVpGanttView.HideHintWindow; +begin + Application.CancelHint; +end; + +procedure TVpGanttView.SetHint(const AValue: TTranslateString); +begin + inherited; + if FHintMode = hmComponentHint then + FComponentHint := AValue; +end; + +procedure TVpGanttView.SetHintMode(const AValue: TVpHintMode); +begin + if AValue = FHintMode then + exit; + FHintMode := AValue; + if FHintMode = hmPlannerHint then + FComponentHint := Hint; +end; + + { Popup menu } function TVpGanttView.GetPopupMenu: TPopupMenu;