You've already forked lazarus-ccr
tvplanit: Support hints in TVpGanttView
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8436 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -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;
|
||||
|
||||
Reference in New Issue
Block a user