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

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