pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/components/tvplanit/source/vpganttview.pas

1923 lines
52 KiB
ObjectPascal
Raw Blame History

unit VpGanttView;
{$mode objfpc}{$H+}
interface
uses
LCLType, LCLIntf, LMessages,
Classes, SysUtils, Graphics, Types, Controls, StdCtrls, Menus, Forms,
VpConst, VpMisc, VpBase, VpBaseDS, VpData;
type
TVpGanttViewOption = (
gvoActiveDate, gvoHorizGrid, gvoVertGrid, gvoWeekends, gvoHolidays
);
TVpGanttViewOptions = set of TVpGanttViewOption;
TVpGanttSpecialDayMode = (sdmColumn, sdmHeader);
const
DEFAULT_GANTTVIEWOPTIONS = [
gvoActiveDate, gvoHorizGrid, gvoVertGrid, gvoWeekends, gvoHolidays
];
type
TVpGanttView = class;
TVpGanttEventRec = record
Event: TVpEvent;
Caption: String;
HeadRect: TRect;
EventRect: TRect;
end;
TVpGanttDayRec = record
Date: TDateTime;
Rect: TRect;
end;
TVpGanttMonthRec = record
Date: TDateTime;
Rect: TRect;
end;
TVpGanttHeaderAttributes = class(TPersistent)
private
FGanttView: TVpGanttView;
FColor: TColor;
procedure SetColor(AValue: TColor);
protected
procedure UpdateGanttView;
public
constructor Create(AOwner: TVpGanttView); virtual;
published
property Color: TColor read FColor write SetColor default DEFAULT_HEADERCOLOR;
end;
TVpGanttRowHeaderAttributes = class(TVpGanttHeaderAttributes)
private
FEventFont: TVpFont;
procedure SetEventFont(AValue: TVpFont);
protected
public
constructor Create(AOwner: TVpGanttView); override;
destructor Destroy; override;
published
property EventFont: TVpFont read FEventFont write SetEventFont;
end;
TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes)
private
FDayFont: TVpFont;
FMonthFont: TVpFont;
procedure SetDayFont(AValue: TVpFont);
procedure SetMonthFont(AValue: TVpFont);
public
constructor Create(AOwner: TVpGanttView); override;
destructor Destroy; override;
published
property DayFont: TVpFont read FDayFont write SetDayFont;
property MonthFont: TVpFont read FMonthFont write SetMonthFont;
end;
TVpGanttView = class(TVpLinkableControl)
private
FActiveCol: Integer; // Selected column
FActiveRow: Integer; // Selected row
FActiveEvent: TVpEvent; // Selected event
FActiveDate: TDateTime; // Selected date
FFirstDate: TDateTime; // Date of the first event in the resource
FLastDate: TDateTime; // Date of the last event in the resource
FStartDate: TDateTime; // Date of the first event to be displayed/printed
FEndDate: TDateTime; // Date of the last event to be displayed/printed
FLeftCol: Integer; // Index of the left-most day column
FTopRow: Integer; // Index of the top-most event row
FVisibleCols: Integer;
FVisibleRows: Integer;
FRowCount: Integer;
FColCount: Integer;
FScrollBars: TScrollStyle;
FInLinkHandler: Boolean;
FLoaded: Boolean;
FPainting: Boolean;
FMouseDown: Boolean;
FMouseDownPoint: TPoint;
FColWidth: Integer;
FFixedColWidth: Integer;
FRowHeight: Integer;
FMonthColHeaderHeight: Integer;
FDayColHeaderHeight: Integer;
FTotalColHeaderHeight: Integer;
FTextMargin: Integer;
FColor: TColor;
FHolidayColor: TColor;
FLineColor: TColor;
FWeekendColor: TColor;
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;
FOnHoliday: TVpHolidayEvent;
FOnModifyEvent: TVpOnModifyEvent;
FOwnerEditEvent: TVpEditEvent;
function GetDateFormat(AIndex: Integer): String;
function GetDayRec(AIndex: Integer): TVpGanttDayRec;
function GetEventRec(AIndex: Integer): TVpGanttEventRec;
function GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
function GetNumDays: Integer;
function GetNumEvents: Integer;
function GetNumMonths: Integer;
function IsStoredColWidth: Boolean;
function IsStoredDateFormat(AIndex: Integer): Boolean;
procedure SetActiveCol(AValue: Integer);
procedure SetActiveDate(AValue: TDateTime);
procedure SetActiveEvent(AValue: TVpEvent);
procedure SetActiveRow(AValue: Integer);
procedure SetColor(Value: TColor); reintroduce;
procedure SetColWidth(AValue: Integer);
procedure SetDateFormat(AIndex: Integer; AValue: String);
procedure SetDrawingStyle(AValue: TVpDrawingStyle);
procedure SetFixedColWidth(AValue: Integer);
procedure SetHolidayColor(AValue: TColor);
procedure SetLeftCol(AValue: Integer);
procedure SetLineColor(AValue: TColor);
procedure SetOptions(AValue: TVpGanttViewOptions);
procedure SetPopupMenu(AValue: TPopupMenu);
procedure SetSpecialDayMode(AValue: TVpGanttSpecialDayMode);
procedure SetTextMargin(AValue: Integer);
procedure SetTopRow(AValue: Integer);
procedure SetWeekendColor(AValue: TColor);
protected
// Needed by the painter
FEventRecords: array of TVpGanttEventRec;
FDayRecords: array of TVpGanttDayRec;
FMonthRecords: array of TVpGanttMonthRec;
{ internal methods }
procedure CalcColHeaderHeight;
procedure CalcRowHeight;
function GetColAtCoord(X: Integer): Integer;
function GetDateOfCol(ACol: Integer): TDateTime;
function GetDateTimeAtCoord(X: Integer): TDateTime;
function GetEventAtCoord(X, Y: Integer): TVpEvent;
function GetEventOfRow(ARow: Integer): TVpEvent;
function GetRowAtCoord(Y: Integer): Integer;
function GetRowOfEvent(AEvent: TVpEvent): Integer;
procedure GetEventDateRange;
function IsEventOnDate(AEvent: TVpEvent; ADate: TDateTime): Boolean;
procedure Hookup;
procedure Populate;
procedure PopulateDayRecords;
procedure PopulateEventRecords;
procedure PopulateMonthRecords;
procedure ScrollDateIntoView(ADate: TDateTime);
procedure ScrollHorizontal(ANumCols: Integer);
procedure ScrollRowIntoView(ARow: Integer);
procedure ScrollVertical(ANumRows: Integer);
procedure SetHScrollPos;
procedure SetVScrollPos;
procedure SpawnEventEditDialog(IsNewEvent: Boolean);
{ inherited methods }
procedure CreateParams(var AParams: TCreateParams); override;
procedure DblClick; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure DoOnResize; override;
class function GetControlClassDefaultSize: TSize; override;
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;
{ LCL scaling }
{$IF VP_LCL_SCALING <> 0}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$IFEND}
{ 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;
procedure PopupAddEvent(Sender: TObject);
procedure PopupDeleteEvent(Sender: TObject);
procedure PopupEditEvent(Sender: TObject);
procedure UpdatePopupMenuState;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function BuildEventString(AEvent: TVpEvent; UseAsHint: Boolean): String;
procedure DeleteActiveEvent(Prompt: Boolean);
function GetControlType: TVpItemType; override;
procedure Init;
function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
procedure LoadLanguage;
procedure LinkHandler(Sender: TComponent;
NotificationType: TVpNotificationType; const Value: Variant); override;
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity;
DisplayOnly: Boolean); override;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSE}
{$IF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double); override;
{$ENDIF}
{$ENDIF}
// Methods to be called by painter
function CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer;
function CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer;
property ActiveCol: Integer read FActiveCol write SetActiveCol;
property ActiveEvent: TVpEvent read FActiveEvent write SetActiveEvent;
property ActiveDate: TDateTime read FActiveDate write SetActiveDate;
property ActiveRow: Integer read FActiveRow write SetActiveRow;
property FirstDate: TDateTime read FFirstDate;
property LastDate: TDateTime read FLastDate;
property StartDate: TDateTime read FStartDate write FStartDate;
property EndDate: TDateTime read FEndDate write FEndDate;
property ColCount: Integer read FColCount write FColCount;
property RowCount: Integer read FRowCount write FRowCount;
property VisibleCols: Integer read FVisibleCols write FVisibleCols;
property VisibleRows: Integer read FVisibleRows write FVisibleRows;
property LeftCol: Integer read FLeftCol write SetLeftCol;
property TopRow: Integer read FTopRow write SetTopRow;
property RowHeight: Integer read FRowHeight;
property DayColHeaderHeight: Integer read FDayColHeaderHeight;
property MonthColHeaderHeight: Integer read FMonthColHeaderHeight;
property TotalColHeaderHeight: Integer read FTotalColHeaderHeight;
property DayRecords[AIndex: Integer]: TVpGanttDayRec read GetDayRec;
property EventRecords[AIndex: Integer]: TVpGanttEventRec read GetEventRec;
property MonthRecords[AIndex: Integer]: TVpGanttMonthRec read GetMonthRec;
property NumDays: Integer read GetNumDays;
property NumEvents: Integer read GetNumEvents;
property NumMonths: Integer read GetNumMonths;
published
// inherited properties
property Align;
property Anchors;
property BorderSpacing;
property ReadOnly;
// new properties
property ColHeaderAttributes: TVpGanttColHeaderAttributes read FColHeaderAttributes write FColHeaderAttributes;
property Color: TColor read FColor write SetColor default DEFAULT_COLOR;
property ColWidth: Integer read FColWidth write SetColWidth stored IsStoredColWidth;
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;
property MonthFormat_short: String index 2 read GetDateFormat write SetDateFormat stored IsStoredDateFormat;
property Options: TVpGanttViewOptions read FOptions write SetOptions default DEFAULT_GANTTVIEWOPTIONS;
property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
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;
// new events
property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
property OnDeletingEvent: TVpOnDeletingEvent read FOnDeletingEvent write FOnDeletingEvent;
property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday;
property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
property OwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
end;
implementation
uses
DateUtils, Math, Dialogs,
VpSR, VpGanttViewPainter, VpEvntEditDlg;
const
DEFAULT_DAYFORMAT = 'd';
DEFAULT_MONTHFORMAT = 'mmmm yyyy';
DEFAULT_MONTHFORMAT_SHORT = 'mmm yyyy';
DEFAULT_COLWIDTH = 20;
{******************************************************************************}
{ TVpGanttHeaderAttributes }
{******************************************************************************}
constructor TVpGanttHeaderAttributes.Create(AOwner: TVpGanttView);
begin
inherited Create;
FGanttView := AOwner;
FColor := DEFAULT_HEADERCOLOR;
end;
procedure TVpGanttHeaderAttributes.SetColor(AValue: TColor);
begin
if FColor <> AValue then
begin
FColor := AValue;
UpdateGanttView;
end;
end;
procedure TVpGanttHeaderAttributes.UpdateGanttView;
begin
if Assigned(FGanttView) then
FGanttView.Invalidate;
end;
{******************************************************************************}
{ TVpGanttRowHeaderAttributes }
{******************************************************************************}
constructor TVpGanttRowHeaderAttributes.Create(AOwner: TVpGanttView);
begin
inherited Create(AOwner);
FEventFont := TVpFont.Create(AOwner);
end;
destructor TVpGanttRowHeaderAttributes.Destroy;
begin
FEventFont.Free;
inherited;
end;
procedure TVpGanttRowHeaderAttributes.SetEventFont(AValue: TVpFont);
begin
if FEventFont <> AValue then
begin
FEventFont := AValue;
FEventFont.Owner := FGanttView;
UpdateGanttView;
end;
end;
{******************************************************************************}
{ TVpGanttColHeaderAttributes }
{******************************************************************************}
constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView);
begin
inherited Create(AOwner);
FDayFont := TVpFont.Create(AOwner);
FMonthFont := TVpFont.Create(AOwner);
end;
destructor TVpGanttColHeaderAttributes.Destroy;
begin
FDayFont.Free;
FMonthFont.Free;
inherited;
end;
procedure TVpGanttColHeaderAttributes.SetDayFont(AValue: TVpFont);
begin
if FDayFont <> AValue then
begin
FDayFont := AValue;
FDayFont.Owner := FGanttView;
UpdateGanttView;
end;
end;
procedure TVpGanttColHeaderAttributes.SetMonthFont(AValue: TVpFont);
begin
if FMonthFont <> AValue then
begin
FMonthFont := AValue;
FMonthFont.Owner := FGanttView;
UpdateGanttView;
end;
end;
{******************************************************************************}
{ TVpGanttView }
{******************************************************************************}
constructor TVpGanttView.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := [csCaptureMouse, csOpaque, csClickEvents, csDoubleClicks];
FInLinkHandler := false;
FLoaded := false;
FPainting := false;
FMouseDown := false;
SetActiveDate(Now);
FColWidth := DEFAULT_COLWIDTH;
FFixedColWidth := 120;
FTextMargin := 2;
FColor := DEFAULT_COLOR;
FLineColor := DEFAULT_LINECOLOR;
FWeekendColor := WEEKEND_COLOR;
FHolidayColor := HOLIDAY_COLOR;
FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self);
FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self);
FDateFormat[0] := DEFAULT_DAYFORMAT;
FDateFormat[1] := DEFAULT_MONTHFORMAT;
FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT;
FDrawingStyle := ds3d;
FScrollBars := ssBoth;
FOptions := DEFAULT_GANTTVIEWOPTIONS;
// Popup menu
FDefaultPopup := TPopupMenu.Create(Self);
FDefaultPopup.Name := 'default';
InitializeDefaultPopup;
Self.PopupMenu := FDefaultPopup;
// Initial size of the control
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, CX, CY);
Hookup;
end;
destructor TVpGanttView.Destroy;
begin
FRowHeaderAttributes.Free;
FColHeaderAttributes.Free;
inherited;
end;
function TVpGanttView.BuildEventString(AEvent: TVpEvent;
UseAsHint: Boolean): String;
const
DATE_FORMAT = 'ddddd';
var
timeFmt: 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;
h: Integer;
begin
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.MonthFont);
FMonthColHeaderHeight := h + 2 * FTextMargin;
// A typical date string to measure the text height (line breaks in DayFormat allowed)
s := FormatDateTime(DayFormat, EncodeDate(2000, 12, 28));
h := GetCanvasTextHeight(Canvas, FColHeaderAttributes.DayFont, s);
FDayColHeaderHeight := h + FTextMargin;
FTotalColHeaderHeight := FMonthColHeaderHeight + FDayColHeaderHeight;
end;
procedure TVpGanttView.CalcRowHeight;
var
h: Integer;
begin
h := GetCanvasTextHeight(Canvas, FRowHeaderAttributes.EventFont);
FRowHeight := h + 2 * FTextMargin;
end;
function TVpGanttView.CalcVisibleCols(AWidth, AFixedColWidth, AColWidth: Integer): Integer;
var
d: Integer = 0; // Result of div
m: Integer = 0; // Result of mod
begin
if AColWidth <> 0 then
begin
DivMod(AWidth - AFixedColWidth, AColWidth, d, m);
if (m = 0) and (d > 1) then dec(d);
Result := d;
end else
Result := 0;
end;
function TVpGanttView.CalcVisibleRows(AHeight, AHeaderHeight, ARowHeight: Integer): Integer;
var
d: Integer = 0; // Result of div
m: Integer = 0; // Result of mod
begin
if ARowHeight <> 0 then
begin
DivMod(AHeight - AHeaderHeight, ARowHeight, d, m);
if (m = 0) and (d > 1) then dec(d);
Result := d;
end else
Result := 0;
end;
procedure TVpGanttView.CreateParams(var AParams: TCreateParams);
begin
inherited CreateParams(AParams);
with AParams do
begin
Style := Style or WS_TABSTOP;
if FScrollBars in [ssVertical, ssBoth, ssAutoVertical, ssAutoBoth] then
Style := Style or WS_VSCROLL;
if FScrollBars in [ssHorizontal, ssBoth, ssAutoHorizontal, ssAutoBoth] then
Style := Style or WS_HSCROLL;
end;
end;
procedure TVpGanttView.DblClick;
var
dt, startTime, endTime: TDateTime;
begin
inherited;
// dvClickTimer.Enabled := false;
FMouseDown := false;
//FDragging := false;
// If the mouse was pressed down in the client area, then select the cell.
if not Focused then
SetFocus;
if ReadOnly then
begin
FMouseDownPoint := Point(0, 0);
exit;
end;
FActiveEvent := GetEventAtCoord(FMouseDownPoint.X, FMouseDownPoint.Y);
if (FActiveEvent <> nil) then
SpawnEventEditDialog(False)
else
begin
dt := GetDateTimeAtCoord(FMouseDownPoint.X);
if dt <> NO_DATE then
begin
startTime := trunc(dt);
endTime := startTime + 1.0;
ActiveEvent := Datastore.Resource.Schedule.AddEvent(
Datastore.GetNextID(EventsTableName),
startTime,
endTime
);
SpawnEventEditDialog(True);
end;
end;
FMouseDownPoint := Point(0, 0);
(*
if (Msg.XPos > dvRowHeadWidth - 9) and (Msg.YPos > dvColHeadHeight) then
begin
{ The mouse click landed inside the client area }
dvSetActiveRowByCoord(Point(Msg.XPos, Msg.YPos), True);
{ See if we hit an active event }
if (FActiveEvent <> nil) and (not ReadOnly) then begin
{ edit this event }
dvSpawnEventEditDialog(False);
end else if not ReadOnly then begin
if not CheckCreateResource then
Exit;
if (DataStore = nil) or (DataStore.Resource = nil) then
Exit;
{ otherwise, we must want to create a new event }
StartTime := trunc(FDisplayDate + ActiveCol)
+ dvLineMatrix[ActiveCol, ActiveRow].Time;
EndTime := StartTime + dvTimeIncSize * FRowLinesStep;
FActiveEvent := DataStore.Resource.Schedule.AddEvent(
DataStore.GetNextID(EventsTableName), StartTime, EndTime);
{ edit this new event }
dvSpawnEventEditDialog(True);
end;
end;
*)
end;
procedure TVpGanttView.DeleteActiveEvent(Prompt: Boolean);
var
DoIt: Boolean;
begin
if ReadOnly then
Exit;
if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then
exit;
DoIt := not Prompt;
if FActiveEvent <> nil then begin
if Assigned(FOnDeletingEvent) then
begin
DoIt := true;
FOnDeletingEvent(self, FActiveEvent, DoIt);
end else
if Prompt then
DoIt := (MessageDlg(RSConfirmDeleteEvent + LineEnding2 + RSPermanent,
mtConfirmation, [mbYes, mbNo], 0) = mrYes);
if DoIt then begin
FActiveEvent.Deleted := true;
DataStore.PostEvents;
Invalidate;
end;
end;
end;
{$IF VP_LCL_SCALING <> 0}
procedure TVpGanttView.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
ColWidth := round(ColWidth * AXProportion);
FixedColWidth := round(FixedColWidth * AXProportion);
TextMargin := round(TextMargin * AXProportion);
end;
end;
{$IFEND}
function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelDown(Shift, MousePos);
if not Result then begin
if Shift = [] then
ScrollVertical(1)
else if Shift = [ssCtrl] then
ScrollHorizontal(1)
else
exit;
Result := True;
end;
end;
function TVpGanttView.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelUp(Shift, MousePos);
if not Result then begin
if Shift = [] then
ScrollVertical(-1)
else if Shift = [ssCtrl] then
ScrollHorizontal(-1)
else
exit;
Result := True;
end;
end;
procedure TVpGanttView.DoOnResize;
var
emptyRows, emptyCols: Integer;
begin
inherited;
if (FRowHeight > 0) and (Length(FEventRecords) > 0) then
begin
VisibleRows := CalcVisibleRows(ClientHeight, FTotalColHeaderHeight, FRowHeight);
emptyRows := VisibleRows - (Length(FEventRecords) - FTopRow);
if emptyRows > 0 then
ScrollVertical(-emptyRows);
VisibleCols := CalcVisibleCols(ClientWidth, FFixedColWidth, FColWidth);
emptyCols := VisibleCols - (Length(FDayRecords) - FLeftCol);
if emptyCols > 0 then
ScrollHorizontal(-emptyCols);
end;
Invalidate;
end;
function TVpGanttView.GetColAtCoord(X: Integer): Integer;
begin
Result := (X - FixedColWidth) div FColWidth + FLeftCol;
end;
{ Defines the initial size of the control. }
class function TVpGanttView.GetControlClassDefaultSize: TSize;
begin
Result.CX := 300;
Result.CY := 200;
end;
function TVpGanttView.GetControlType: TVpItemType;
begin
Result := itGanttView;
end;
function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime;
begin
Result := FStartDate + ACol;
end;
function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime;
var
days: double;
begin
days := (X - FixedColWidth) / FColWidth + FLeftCol;
if (days >= 0) and (days < NumDays) then
Result := FStartDate + days
else
Result := NO_DATE;
end;
function TVpGanttView.GetDateFormat(AIndex: Integer): String;
begin
Result := FDateFormat[AIndex];
end;
function TVpGanttView.GetDayRec(AIndex: Integer): TVpGanttDayRec;
begin
Result := FDayRecords[AIndex];
end;
function TVpGanttView.GetEventAtCoord(X, Y: Integer): TVpEvent;
var
idx: Integer;
eventRec: TVpGanttEventRec;
dt: TDateTime;
begin
Result := nil;
dt := GetDateTimeAtCoord(X);
if (dt = -1) or (FRowHeight = 0) then
exit;
idx := GetRowAtCoord(Y);
if (idx >= 0) and (idx < NumEvents) then
begin
eventRec := FEventRecords[idx];
Result := eventRec.Event;
if Result.AllDayEvent then
begin
if (dt < trunc(Result.StartTime)) or (dt > trunc(Result.EndTime) + 1) then
Result := nil;
end else
if (dt < Result.StartTime) or (dt > Result.EndTime) then
Result := nil;
end;
end;
{ Determines the date when the earliest event starts, and the date when the
latest event ends.
Stores them in the internal variables FStartdate and FEndDate. }
procedure TVpGanttView.GetEventDateRange;
var
i: Integer;
event: TVpEvent;
d: TDateTime;
begin
if (Datastore = nil) or (Datastore.Resource = nil) or (Datastore.Resource.Schedule.EventCount = 0) then
begin
FFirstDate := NO_DATE;
FLastDate := NO_DATE;
end else
begin
event := Datastore.Resource.Schedule.GetEvent(0);
FFirstDate := trunc(event.StartTime);
FLastDate := -99999;
for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
begin
event := Datastore.Resource.Schedule.GetEvent(i);
d := trunc(event.EndTime);
if d > FLastDate then FLastDate := d;
end;
end;
if FStartDate = 0 then
FStartDate := FFirstDate;
if FEndDate = 0 then
FEndDate := FLastDate;
end;
function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent;
begin
Result := EventRecords[ARow].Event;
end;
function TVpGanttView.GetEventRec(AIndex: Integer): TVpGanttEventRec;
begin
Result := FEventRecords[AIndex];
end;
function TVpGanttView.GetMonthRec(AIndex: Integer): TVpGanttMonthRec;
begin
Result := FMonthRecords[AIndex];
end;
{ Determines the number days between the first and last Gantt event. This is
the number of day columns in the view. }
function TVpGanttView.GetNumDays: Integer;
begin
if (FStartDate <> NO_DATE) then
Result := trunc(FEndDate) - trunc(FStartDate) + 1
else
Result := 0;
end;
{ Determines the number of events (= rows) to be displayed in the GanttView. }
function TVpGanttView.GetNumEvents: Integer;
begin
if (Datastore <> nil) and (Datastore.Resource <> nil) then
Result := Datastore.Resource.Schedule.EventCount
else
Result := 0;
end;
{ Determines the number of months (complete or partial) between the first and
last Gantt event. }
function TVpGanttView.GetNumMonths: Integer;
var
dm1, dm2: Integer;
y1, m1, d1: Word;
y2, m2, d2: Word;
begin
if (FStartDate <> NO_DATE) then
begin
DecodeDate(FStartDate, y1, m1, d1);
DecodeDate(FEndDate, y2, m2, d2);
if (y1 = y2) then
Result := m2 - m1 + 1
else
Result := 13 - m1 + m2 + (y2 - y1 - 1)*12;
end else
Result := 0;
end;
function TVpGanttView.GetRowAtCoord(Y: Integer): Integer;
begin
Result := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
end;
function TVpGanttView.GetRowOfEvent(AEvent: TVpEvent): Integer;
var
i: Integer;
begin
for i := 0 to High(FEventRecords) do
if FEventRecords[i].Event = AEvent then
begin
Result := i;
exit;
end;
Result := -1;
end;
{ If the component is being dropped on a form at designtime, then
automatically hook up to the first datastore component found. }
procedure TVpGanttView.HookUp;
var
I: Integer;
begin
if csDesigning in ComponentState then
for I := 0 to pred(Owner.ComponentCount) do begin
if (Owner.Components[I] is TVpCustomDataStore) then begin
DataStore := TVpCustomDataStore(Owner.Components[I]);
Exit;
end;
end;
end;
procedure TVpGanttView.Init;
begin
CalcRowHeight;
CalcColHeaderHeight;
GetEventDateRange;
FColCount := GetNumDays;
FRowCount := GetNumEvents;
PopulateDayRecords;
PopulateMonthRecords;
PopulateEventRecords;
end;
function TVpGanttView.IsEventOnDate(AEvent: TVpEvent; ADate: TDateTime): Boolean;
var
tEv1, tEv2: TDateTime;
begin
if AEvent <> nil then
begin
tEv1 := trunc(AEvent.StartTime);
tEv2 := trunc(AEvent.EndTime);
Result := (tEv1 <= ADate) and (tEv2 >= ADate);
end else
Result := false;
end;
function TVpGanttView.IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
begin
AHolidayName := '';
if Assigned(FOnHoliday) then
FOnHoliday(Self, ADate, AHolidayName);
Result := AHolidayName <> '';
end;
procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState);
procedure ScrollCols(ADelta: Integer);
begin
SetActiveCol(FActiveCol + ADelta);
if FActiveCol <= FLeftCol then
ScrollHorizontal(FActiveCol - FLeftCol)
else
if FActiveCol >= FLeftCol + FVisibleCols then
ScrollHorizontal(FActiveCol - (FLeftCol + FVisibleCols) + 1);
end;
procedure ScrollRows(ADelta: Integer);
begin
SetActiveRow(FActiveRow + ADelta);
if FActiveRow <= FTopRow then
ScrollVertical(FActiveRow - FTopRow)
else
if FActiveRow >= FTopRow + FVisibleRows then
ScrollVertical(FActiveRow - (FTopRow + FVisibleRows) + 1);
end;
var
P: TPoint;
begin
inherited;
case Key of
VK_LEFT:
ScrollCols(-1);
VK_RIGHT:
ScrollCols(1);
VK_DOWN:
ScrollRows(1);
VK_UP:
ScrollRows(-1);
VK_HOME:
if Shift = [ssCtrl] then
begin
ActiveCol := 0;
FLeftCol := 0;
end else
if Shift = [ssCtrl, ssShift] then
begin
ActiveCol := 0;
ActiveRow := 0;
FLeftCol := 0;
FTopRow := 0;
end else
if Shift = [] then
ScrollCols(-FVisibleCols);
VK_END:
if Shift = [ssCtrl] then
begin
ActiveCol := ColCount-1;
ScrollHorizontal(FLeftCol + FVisibleCols);
end else
if Shift = [ssCtrl, ssShift] then
begin
ActiveCol := ColCount-1;
ActiveRow := RowCount-1;
FLeftCol := ColCount - FVisibleCols;
FTopRow := RowCount - FVisibleRows;
end else
ScrollCols(FVisibleCols);
VK_NEXT:
if Shift = [ssCtrl] then // ctrl + page down
begin
ActiveRow := RowCount - 1;
ScrollRows(MaxInt);
end else
ScrollRows(FVisibleRows); // page down
VK_PRIOR:
if Shift = [ssCtrl] then // ctrl + page up
begin
ActiveRow := 0;
ScrollRows(-MaxInt);
end else
ScrollRows(-FVisibleRows); // page up
VK_F10, VK_APPS:
if (ssShift in Shift) then
begin
P := GetClientOrigin;
P.X := P.X + FDayRecords[FActiveCol].Rect.Right;
P.Y := P.Y + FDayRecords[FActiveCol].Rect.Top;
PopupMenu.Popup(P.X + 10, P.Y + 10);
end;
VK_RETURN:
PopupEditEvent(Self);
VK_INSERT:
PopupAddEvent(Self);
VK_DELETE:
DeleteActiveEvent(true);
else
exit;
end;
Invalidate;
Key := 0;
end;
function TVpGanttView.IsStoredColWidth: Boolean;
begin
Result := FColWidth <> DEFAULT_COLWIDTH;
end;
function TVpGanttView.IsStoredDateFormat(AIndex: Integer): Boolean;
begin
case AIndex of
0: Result := FDateFormat[0] <> DEFAULT_DAYFORMAT;
1: Result := FDateFormat[1] <> DEFAULT_MONTHFORMAT;
2: Result := FDateFormat[2] <> DEFAULT_MONTHFORMAT_SHORT;
end;
end;
procedure TVpGanttView.LoadLanguage;
var
item: TMenuItem;
begin
for item in FDefaultPopup.Items do
if item is TVpMenuItem then
TVpMenuItem(item).Translate;
end;
procedure TVpGanttView.LinkHandler(Sender: TComponent;
NotificationType: TVpNotificationType; const Value: Variant);
begin
FInLinkHandler := true;
try
case NotificationType of
neDateChange : SetActiveDate(Value);
neDataStoreChange : Invalidate;
neInvalidate : Invalidate;
end;
finally
FInLinkHandler := false;
end;
end;
procedure TVpGanttView.Loaded;
begin
inherited;
FLoaded := true;
Populate;
end;
procedure TVpGanttView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
dt: TDateTime;
begin
inherited MouseDown(Button, Shift, X, Y);
if not Focused then
SetFocus;
FMouseDownPoint := Point(X, Y);
FActiveCol := GetColAtCoord(X);
FActiveRow := GetRowAtCoord(Y);
SetActiveEvent(GetEventAtCoord(X, Y));
dt := GetDateTimeAtCoord(X);
if dt <> NO_DATE then
SetActiveDate(dt);
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(
Canvas, // Paint Canvas
Rect(0, 0, Width, Height), // Paint Rectangle
ra0, // Rotation angle: none
1, // Scale
FStartDate, // Date
-1, // Start At
-1, // End At
gr30Min, // Granularity
False // Display Only
);
SetVScrollPos;
SetHScrollPos;
end;
procedure TVpGanttView.Populate;
begin
if DataStore <> nil then
DataStore.Date := FActiveDate;
end;
// Populates the array of TVpGanttRec records containing the date of each day
// cell and the *unscrolled* cell rectangle coordinates.
procedure TVpGanttView.PopulateDayRecords;
var
i: Integer;
x1, y1, x2, y2: Integer;
begin
SetLength(FDayRecords, GetNumDays);
x1 := FixedColWidth;
y1 := FMonthColHeaderHeight;
y2 := FTotalColHeaderHeight;
for i := 0 to High(FDayRecords) do
begin
x2 := x1 + ColWidth;
FDayRecords[i].Rect := Rect(x1, y1, x2, y2);
FDayRecords[i].Date := FStartDate + i;
x1 := x2;
end;
end;
procedure TVpGanttView.PopulateEventRecords;
var
event: TVpEvent;
i: Integer;
xh1, xh2, y1, xe1, xe2, y2: Integer;
t1, t2: TDateTime;
totalWidth: Integer;
list: TFPList;
begin
SetLength(FEventRecords, GetNumEvents);
if (Datastore = nil) or (DataStore.Resource = nil) then
exit;
list := TFPList.Create;
try
// Sort events by date/time
for i := 0 to Datastore.Resource.Schedule.EventCount-1 do
list.Add(Datastore.Resource.Schedule.GetEvent(i));
list.Sort(@CompareEvents);
xh1 := 0;
xh2 := FixedColWidth;
y1 := FTotalColHeaderHeight;
totalWidth := GetNumDays * ColWidth;
for i := 0 to High(FEventRecords) do
begin
event := TVpEvent(list[i]);
if event.AllDayEvent then
begin
t1 := trunc(event.StartTime);
t2 := trunc(event.EndTime) + 1;
if frac(event.EndTime) = 0 then t2 := t2 + 1;
end else
begin
t1 := event.StartTime;
t2 := event.EndTime;
end;
y2 := y1 + FRowHeight;
xe1 := round((t1 - FStartDate) / numDays * totalWidth) + FixedColWidth;
xe2 := round((t2 - FStartDate) / numDays * totalWidth) + FixedColWidth;
if xe1 = xe2 then xe2 := xe1 + 1;
FEventRecords[i].Event := event;
FEventRecords[i].Caption := event.Description;
FEventRecords[i].HeadRect := Rect(xh1, y1, xh2, y2);
FEventRecords[i].EventRect := Rect(xe1, y1, xe2, y2);
if event = FActiveEvent then
FActiveRow := i;
y1 := y2;
end;
finally
list.Free;
end;
end;
procedure TVpGanttView.PopulateMonthRecords;
var
i, n: Integer;
x1, y1, x2, y2: Integer;
dm: TDateTime;
ndays: Integer;
begin
n := GetNumMonths;
SetLength(FMonthRecords, n);
if (Datastore = nil) or (Datastore.Resource = nil) then
exit;
x1 := FixedColWidth;
y1 := 0;
y2 := FTotalColHeaderHeight;
if n > 1 then
begin
dm := FStartDate;
for i := 0 to n - 1 do
begin
if i = 0 then begin
nDays := DaysInMonth(dm) - DayOf(dm) + 1;
dm := StartOfTheMonth(dm);
end else
if i = n-1 then
nDays := DayOf(FEndDate)
else
nDays := DaysInMonth(dm);
if dm + nDays > FEndDate then
nDays := trunc(FEndDate) - trunc(dm) + 1;
x2 := x1 + nDays * ColWidth;
FMonthRecords[i].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[i].Date := dm;
dm := IncMonth(dm, 1);
x1 := x2;
end;
end else
begin
nDays := DayOf(FEndDate) - DayOf(FStartDate) + 1;
x2 := x1 + nDays * ColWidth;
FMonthRecords[0].Rect := Rect(x1, y1, x2, y2);
FMonthRecords[0].Date := FStartDate;
end;
end;
procedure TVpGanttView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean);
var
painter: TVpGanttViewPainter;
begin
FPainting := true;
painter := TVpGanttViewPainter.Create(Self, RenderCanvas);
try
painter.RenderToCanvas(RenderIn, Angle, Scale, RenderDate, StartLine,
StopLine, UseGran, DisplayOnly);
finally
painter.Free;
FPainting := false;
end;
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI);
DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI);
DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI);
end;
procedure TVpGanttView.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin
inherited;
DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion);
DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion);
DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpGantView.ScaleFontsPPI(const AProportion: Double);
begin
inherited;
DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion);
DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion);
DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion);
end;
{$ENDIF}
procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
begin
if (FStartDate = 0) or (FStartDate = NO_DATE) then
exit;
if ADate < FStartDate then
begin
FStartDate := trunc(ADate);
FColCount := GetNumDays;
SetLeftCol(-MaxInt);
end else
if ADate > FEndDate then
begin
FEndDate := trunc(ADate);
FColCount := GetNumDays;
SetLeftCol(FColCount - 1 - FVisibleCols);
end else
if ADate < FStartDate + FLeftCol then
SetLeftCol(trunc(ADate) - trunc(FStartDate))
else
if ADate > FStartDate + VisibleCols then
SetLeftCol(trunc(ADate) - VisibleCols)
else
exit;
Invalidate;
end;
procedure TVpGanttView.ScrollHorizontal(ANumCols: Integer);
begin
SetLeftCol(FLeftCol + ANumCols);
Invalidate;
end;
procedure TVpGanttView.ScrollRowIntoView(ARow: Integer);
begin
if (ARow < TopRow) or (ARow >= TopRow + FVisibleRows) then
SetTopRow(ARow - FVisibleRows div 2)
end;
procedure TVpGanttView.ScrollVertical(ANumRows: Integer);
begin
SetTopRow(FTopRow + ANumRows);
Invalidate;
end;
procedure TVpGanttView.SetActiveCol(AValue: Integer);
var
R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
eventRect, dayRect: TRect;
dt: TDateTime;
event: TVpEvent;
begin
if AValue <= 0 then
FActiveCol := 0
else if AValue >= ColCount then
FActiveCol := ColCount - 1
else
FActiveCol := AValue;
dt := DayRecords[FActiveCol].Date;
dayRect := DayRecords[FActiveCol].Rect;
event := EventRecords[FActiveRow].Event;
eventRect := EventRecords[FActiveRow].EventRect;
dayRect.Top := eventRect.Top;
dayRect.Bottom := eventRect.Bottom;
if IntersectRect(R, dayRect, eventRect) then
SetActiveEvent(event)
else
SetActiveEvent(nil);
SetActiveDate(dt);
end;
procedure TVpGanttView.SetActiveDate(AValue: TDateTime);
begin
if FActiveDate <> trunc(AValue) then begin
FActiveDate := trunc(AValue);
if FLoaded then
Populate;
ScrollDateIntoView(FActiveDate);
FActiveCol := trunc(FActiveDate) - trunc(FStartDate);
Invalidate;
if (not FInLinkHandler) and (ControlLink <> nil) then
ControlLink.Notify(self, neDateChange, FActiveDate);
end;
end;
procedure TVpGanttView.SetActiveEvent(AValue: TVpEvent);
begin
if FActiveEvent <> AValue then
begin
FActiveEvent := AValue;
if FActiveEvent <> nil then
begin
FActiveRow := GetRowOfEvent(FActiveEvent);
ScrollRowIntoView(FActiveRow);
end;
end;
UpdatePopupMenuState;
end;
procedure TVpGanttView.SetActiveRow(AValue: Integer);
var
R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
eventRect, dayRect: TRect;
event: TVpEvent;
dt: TDateTime;
begin
if AValue < 0 then
FActiveRow := 0
else if AValue >= RowCount then
FActiveRow := RowCount - 1
else
FActiveRow := AValue;
event := EventRecords[FActiveRow].Event;
eventRect := EventRecords[FActiveRow].EventRect;
dt := DayRecords[FActiveCol].Date;
dayRect := DayRecords[FActiveCol].Rect;
dayRect.Top := eventRect.Top;
dayRect.Bottom := eventRect.Bottom;
if IntersectRect(R, dayRect, eventRect) then
SetActiveEvent(event)
else
SetActiveEvent(nil);
SetActiveDate(dt);
end;
procedure TVpGanttView.SetColor(Value: TColor);
begin
if FColor <> Value then begin
FColor := Value;
Invalidate;
end;
end;
procedure TVpGanttView.SetColWidth(AValue: Integer);
begin
if FColWidth <> AValue then
begin
FColWidth := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetDateFormat(AIndex: Integer; AValue: String);
begin
if FDateFormat[AIndex] <> AValue then
begin
FDateFormat[AIndex] := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetDrawingStyle(AValue: TVpDrawingStyle);
begin
if FDrawingStyle <> AValue then
begin
FDrawingStyle := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetFixedColWidth(AValue: Integer);
begin
if FFixedColWidth <> AValue then
begin
FFixedColWidth := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetHolidayColor(AValue: TColor);
begin
if FHolidayColor <> AValue then
begin
FHolidayColor := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetHScrollPos;
var
scrollInfo: TScrollInfo;
begin
if not HandleAllocated then
Exit;
with scrollInfo do
begin
cbSize := SizeOf(scrollInfo);
fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
nMin := 0;
nMax := FColCount;
if FVisibleCols >= FColCount then
nPage := nMax
else
nPage := FVisibleCols;
if FLeftCol = pred(ColCount) - VisibleCols then
nPos := ColCount
else
nPos := FLeftCol;
nTrackPos := nPos;
end;
SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
end;
procedure TVpGanttView.SetLeftCol(AValue: Integer);
begin
if AValue <> FLeftCol then begin
if AValue + FVisibleCols >= FColCount then begin
FLeftCol := FColCount - FVisibleCols;
if FLeftCol < 0 then
FLeftCol := 0;
// Prevent the control from hanging at the right
if (AValue < FLeftCol) and (AValue > 0) then
FLeftCol := AValue;
end
else if AValue < 0 then
FLeftCol := 0
else
FLeftCol := AValue;
Invalidate;
SetHScrollPos;
end;
end;
procedure TVpGanttView.SetLineColor(AValue: TColor);
begin
if FLineColor <> AValue then begin
FLineColor := AValue;
Repaint;
end;
end;
procedure TVpGanttView.SetOptions(AValue: TVpGanttViewOptions);
begin
if FOptions <> AValue then
begin
FOptions := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetSpecialDayMode(AValue: TVpGanttSpecialDayMode);
begin
if FSpecialDayMode <> AValue then
begin
FSpecialDayMode := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetTextMargin(AValue: Integer);
begin
if FTextMargin <> AValue then
begin
FTextMargin := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SetTopRow(AValue: Integer);
begin
if AValue <> FTopRow then begin
if AValue + FVisibleRows >= RowCount then begin
FTopRow := FRowCount - FVisibleRows;
if FTopRow < 0 then
FTopRow := 0;
// Prevent the control from hanging at the bottom
if (AValue < FTopRow) and (AValue > 0) then
FTopRow := AValue;
end
else if AValue < 0 then
FTopRow := 0
else
FTopRow:= AValue;
Invalidate;
SetVScrollPos;
end;
end;
procedure TVpGanttView.SetVScrollPos;
var
scrollInfo: TScrollInfo;
begin
if not HandleAllocated then
Exit;
with scrollInfo do
begin
cbSize := SizeOf(scrollInfo);
fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
nMin := 0;
nMax := FRowCount;
if FVisibleRows >= FRowCount then
nPage := nMax
else
nPage := FVisibleRows;
if FTopRow = pred(RowCount) - VisibleRows then
nPos := FRowCount
else
nPos := FTopRow;
nTrackPos := nPos;
end;
SetScrollInfo(Handle, SB_VERT, scrollInfo, True);
end;
procedure TVpGanttView.SetWeekendColor(AValue: TColor);
begin
if FWeekendColor <> AValue then
begin
FWeekendColor := AValue;
Invalidate;
end;
end;
procedure TVpGanttView.SpawnEventEditDialog(IsNewEvent: Boolean);
var
AllowIt: Boolean;
EventDlg : TVpEventEditDialog;
begin
if (DataStore = nil) or (DataStore.Resource = nil) or ReadOnly then
Exit;
AllowIt := false;
if Assigned(FOwnerEditEvent) then
FOwnerEditEvent(self, FActiveEvent, IsNewEvent, DataStore.Resource, AllowIt)
else begin
EventDlg := TVpEventEditDialog.Create(nil);
try
EventDlg.DataStore := DataStore;
AllowIt := EventDlg.Execute(FActiveEvent);
finally
EventDlg.Free;
end;
end;
if AllowIt then begin
FActiveEvent.Changed := true;
DataStore.PostEvents;
// The new or edited event may be at a different position in the grid.
// --> Re-read the events to sort them, find the new active row/col and
// scroll them into view
PopulateEventRecords;
SetActiveDate(FActiveEvent.StartTime);
ScrollRowIntoView(FActiveRow);
if IsNewEvent and Assigned(FOnAddEvent) then
FOnAddEvent(self, FActiveEvent);
if not IsNewEvent and Assigned(FOnModifyEvent) then
FOnModifyEvent(self, FActiveEvent);
end else begin
if IsNewEvent then begin
FActiveEvent.Deleted := true;
DataStore.PostEvents;
SetActiveEvent(nil);
end;
end;
Invalidate;
end;
procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll);
begin
case Msg.ScrollCode of
SB_LINELEFT : ScrollHorizontal(-1);
SB_LINERIGHT : ScrollHorizontal(1);
SB_PAGELEFT : ScrollHorizontal(-FVisibleCols);
SB_PAGERIGHT : ScrollHorizontal(FVisibleCols);
SB_THUMBPOSITION, SB_THUMBTRACK : SetLeftCol(Msg.Pos);
end;
end;
procedure TVpGanttView.WMVScroll(var Msg: TLMVScroll);
begin
case Msg.ScrollCode of
SB_LINEUP : ScrollVertical(-1);
SB_LINEDOWN : ScrollVertical(1);
SB_PAGEUP : ScrollVertical(-FVisibleRows);
SB_PAGEDOWN : ScrollVertical(FVisibleRows);
SB_THUMBPOSITION, SB_THUMBTRACK : SetTopRow(Msg.Pos);
end;
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;
begin
if FExternalPopup = nil then
Result := FDefaultPopup
else
Result := FExternalPopup;
end;
procedure TVpGanttView.SetPopupMenu(AValue: TPopupMenu);
begin
if (AValue = nil) or (AValue = FDefaultPopup) then
FExternalPopup := nil
else
FExternalPopup := AValue;
end;
procedure TVpGanttView.InitializeDefaultPopup;
var
NewItem: TVpMenuItem;
canEdit: Boolean;
begin
canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit;
FDefaultPopup.Items.Clear;
if RSPopupAddEvent <> '' then begin // Add
NewItem := TVpMenuItem.Create(Self);
NewItem.Kind := mikAddEvent;
NewItem.OnClick := @PopupAddEvent;
NewItem.Tag := 0;
FDefaultPopup.Items.Add(NewItem);
end;
if RSPopupEditEvent <> '' then begin // Edit
NewItem := TVpMenuItem.Create(Self);
NewItem.Kind := mikEditEvent;
NewItem.Enabled := canEdit;
NewItem.OnClick := @PopupEditEvent;
NewItem.Tag := 1;
FDefaultPopup.Items.Add(NewItem);
end;
if RSPopupDeleteEvent <> '' then begin // Delete
NewItem := TVpMenuItem.Create(Self);
NewItem.Kind := mikDeleteEvent;
NewItem.Enabled := canEdit;
NewItem.OnClick := @PopupDeleteEvent;
NewItem.Tag := 1;
FDefaultPopup.Items.Add(NewItem);
end;
end;
procedure TVpGanttView.PopupAddEvent(Sender: TObject);
var
startTime: TDateTime;
endTime: TDateTime;
begin
if ReadOnly or (not CheckCreateResource) or
(not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
then
Exit;
// Create the new event as an all-day event for the clicked day.
startTime := trunc(FActiveDate);
endTime := startTime + 1 - OneMilliSecond;
FActiveEvent := DataStore.Resource.Schedule.AddEvent(
DataStore.GetNextID(EventsTableName),
StartTime,
EndTime
);
FActiveEvent.AllDayEvent := true;
// Edit this new event
SpawnEventEditDialog(True);
end;
procedure TVpGanttView.PopupDeleteEvent(Sender: TObject);
begin
if ReadOnly then
Exit;
Invalidate;
if FActiveEvent <> nil then
DeleteActiveEvent(True);
end;
procedure TVpGanttView.PopupEditEvent(Sender: TObject);
begin
if ReadOnly then
Exit;
Invalidate;
if FActiveEvent <> nil then
// edit this event
SpawnEventEditDialog(false);
end;
procedure TVpGanttView.UpdatePopupMenuState;
var
i: Integer;
begin
if Assigned(FActiveEvent) then
begin
for i := 0 to FDefaultPopup.Items.Count - 1 do
FDefaultPopup.Items[i].Enabled := True;
end else
for i := 0 to FDefaultPopup.Items.Count - 1 do
if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then
FDefaultPopup.Items[i].Enabled := False;
end;
end.
Reference in New Issue View Git Blame Copy Permalink