You've already forked lazarus-ccr
tvplanit/TVpGanttView: Select date by click, initial code for dbl-click (not working yet).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8423 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -387,7 +387,7 @@ type
|
||||
DisplayOnly: Boolean); virtual; abstract;
|
||||
procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
|
||||
const Value: Variant); virtual; abstract;
|
||||
property ReadOnly: Boolean read FReadOnly write FReadOnly;
|
||||
property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
|
||||
published
|
||||
property PopupMenu;
|
||||
property DataStore: TVpCustomDataStore read FDataStore write SetDataStore;
|
||||
|
||||
@ -387,7 +387,6 @@ type
|
||||
procedure PopupPrevYear(Sender: TObject);
|
||||
procedure PopupCustomDate(Sender: TObject);
|
||||
procedure PopupPickResourceGroupEvent(Sender: TObject);
|
||||
procedure PopupDropdownEvent(Sender: TObject);
|
||||
procedure InitializeDefaultPopup;
|
||||
|
||||
{ internal methods }
|
||||
@ -1501,11 +1500,6 @@ begin
|
||||
Datastore.UpdateGroupEvents;
|
||||
end;
|
||||
|
||||
procedure TVpDayView.PopupDropDownEvent(Sender: TObject);
|
||||
begin
|
||||
InitializeDefaultPopup;
|
||||
end;
|
||||
|
||||
procedure TVpDayView.Loaded;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
LCLType, LCLIntf, LMessages,
|
||||
Classes, SysUtils, Graphics, Types, Controls, StdCtrls,
|
||||
Classes, SysUtils, Graphics, Types, Controls, StdCtrls, Menus,
|
||||
VpConst, VpMisc, VpBase, VpBaseDS, VpData;
|
||||
|
||||
type
|
||||
@ -71,7 +71,8 @@ type
|
||||
|
||||
TVpGanttView = class(TVpLinkableControl)
|
||||
private
|
||||
FDate: TDateTime; // Selected date
|
||||
FActiveEvent: TVpEvent; // Selected event
|
||||
FActiveDate: TDateTime; // Selected date
|
||||
FStartDate: TDateTime; // Date of the first event
|
||||
FEndDate: TDateTime; // Date of the last event
|
||||
|
||||
@ -86,6 +87,8 @@ type
|
||||
FInLinkHandler: Boolean;
|
||||
FLoaded: Boolean;
|
||||
FPainting: Boolean;
|
||||
FMouseDown: Boolean;
|
||||
FMouseDownPoint: TPoint;
|
||||
|
||||
FColWidth: Integer;
|
||||
FFixedColWidth: Integer;
|
||||
@ -101,8 +104,14 @@ type
|
||||
FColHeaderAttributes: TVpGanttColHeaderAttributes;
|
||||
FRowHeaderAttributes: TVpGanttRowHeaderAttributes;
|
||||
|
||||
FDrawingStyle: TVpDrawingStyle;
|
||||
FDateFormat: array[0..2] of String;
|
||||
FDrawingStyle: TVpDrawingStyle;
|
||||
FDefaultPopup: TPopupMenu;
|
||||
FExternalPopup: TPopupMenu;
|
||||
|
||||
FOnAddEvent: TVpOnAddNewEvent;
|
||||
FOnModifyEvent: TVpOnModifyEvent;
|
||||
FOwnerEditEvent: TVpEditEvent;
|
||||
|
||||
function GetDateFormat(AIndex: Integer): String;
|
||||
function GetDayRec(AIndex: Integer): TVpGanttDayRec;
|
||||
@ -113,14 +122,15 @@ type
|
||||
function GetNumMonths: Integer;
|
||||
function IsStoredColWidth: Boolean;
|
||||
function IsStoredDateFormat(AIndex: Integer): Boolean;
|
||||
procedure SetActiveDate(AValue: TDateTime);
|
||||
procedure SetColor(Value: TColor); reintroduce;
|
||||
procedure SetColWidth(AValue: Integer);
|
||||
procedure SetDate(AValue: TDateTime);
|
||||
procedure SetDateFormat(AIndex: Integer; AValue: String);
|
||||
procedure SetDrawingStyle(AValue: TVpDrawingStyle);
|
||||
procedure SetFixedColWidth(AValue: Integer);
|
||||
procedure SetLeftCol(AValue: Integer);
|
||||
procedure SetLineColor(AValue: TColor);
|
||||
procedure SetPopupMenu(AValue: TPopupMenu);
|
||||
procedure SetTextMargin(AValue: Integer);
|
||||
procedure SetTopRow(AValue: Integer);
|
||||
|
||||
@ -133,6 +143,8 @@ type
|
||||
{ internal methods }
|
||||
procedure CalcColHeaderHeight;
|
||||
procedure CalcRowHeight;
|
||||
function GetDateTimeAtCoord(X: Integer): TDateTime;
|
||||
function GetEventAtCoord(X, Y: Integer): TVpEvent;
|
||||
procedure GetEventDateRange;
|
||||
procedure Hookup;
|
||||
procedure Populate;
|
||||
@ -143,14 +155,41 @@ type
|
||||
procedure ScrollVertical(ANumRows: Integer);
|
||||
procedure SetHScrollPos;
|
||||
procedure SetVScrollPos;
|
||||
procedure SpawnEventEditDialog(IsNewEvent: Boolean);
|
||||
|
||||
{ Popup }
|
||||
function GetPopupMenu: TPopupMenu; override;
|
||||
procedure InitializeDefaultPopup;
|
||||
procedure PopupAddEvent(Sender: TObject);
|
||||
// procedure PopupImportICalFile(Sender: TObject);
|
||||
// procedure PopupExportICalFile(Sender: TObject);
|
||||
procedure PopupDeleteEvent(Sender: TObject);
|
||||
procedure PopupEditEvent(Sender: TObject);
|
||||
procedure PopupToday(Sender: TObject);
|
||||
{
|
||||
procedure PopupTomorrow(Sender: TObject);
|
||||
procedure PopupYesterday(Sender: TObject);
|
||||
procedure PopupNextDay(Sender: TObject);
|
||||
procedure PopupPrevDay(Sender: TObject);
|
||||
procedure PopupNextWeek(Sender: TObject);
|
||||
procedure PopupPrevWeek(Sender: TObject);
|
||||
procedure PopupNextMonth(Sender: TObject);
|
||||
procedure PopupPrevMonth(Sender: TObject);
|
||||
procedure PopupNextYear(Sender: TObject);
|
||||
procedure PopupPrevYear(Sender: TObject);
|
||||
procedure PopupCustomDate(Sender: TObject);
|
||||
procedure PopupPickResourceGroupEvent(Sender: TObject);
|
||||
}
|
||||
|
||||
{ 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;
|
||||
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 Paint; override;
|
||||
procedure Resize; override;
|
||||
procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
|
||||
@ -159,7 +198,9 @@ type
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure DeleteActiveEvent(Verify: Boolean);
|
||||
procedure Init;
|
||||
procedure LoadLanguage;
|
||||
procedure LinkHandler(Sender: TComponent;
|
||||
NotificationType: TVpNotificationType; const Value: Variant); override;
|
||||
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
|
||||
@ -171,7 +212,8 @@ type
|
||||
function CalcVisibleCols(AWidth: Integer): Integer;
|
||||
function CalcVisibleRows(AHeight: Integer): Integer;
|
||||
|
||||
property Date: TDateTime read FDate write SetDate;
|
||||
property ActiveEvent: TVpEvent read FActiveEvent write FActiveEvent;
|
||||
property ActiveDate: TDateTime read FActiveDate write SetActiveDate;
|
||||
property StartDate: TDateTime read FStartDate write FStartDate;
|
||||
property EndDate: TDateTime read FEndDate write FEndDate;
|
||||
property ColCount: Integer read FColCount write FColCount;
|
||||
@ -194,10 +236,12 @@ type
|
||||
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;
|
||||
@ -207,16 +251,22 @@ type
|
||||
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 PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
|
||||
property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes;
|
||||
property TextMargin: Integer read FTextMargin write SetTextMargin default 2;
|
||||
|
||||
// inherited events
|
||||
property OnClick;
|
||||
// new events
|
||||
property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
|
||||
property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
|
||||
property OwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DateUtils, Math,
|
||||
VpGanttViewPainter;
|
||||
DateUtils, Math, Dialogs,
|
||||
VpSR, VpGanttViewPainter, VpEvntEditDlg;
|
||||
|
||||
const
|
||||
DEFAULT_DAYFORMAT = 'd';
|
||||
@ -331,8 +381,8 @@ begin
|
||||
FLoaded := false;
|
||||
FPainting := false;
|
||||
|
||||
SetDate(Now);
|
||||
FStartDate := FDate;
|
||||
SetActiveDate(Now);
|
||||
FStartDate := FActiveDate;
|
||||
|
||||
FColWidth := DEFAULT_COLWIDTH;
|
||||
FFixedColWidth := 120;
|
||||
@ -351,12 +401,19 @@ begin
|
||||
|
||||
FScrollBars := ssBoth;
|
||||
|
||||
// popup menu
|
||||
FDefaultPopup := TPopupMenu.Create(Self);
|
||||
FDefaultPopup.Name := 'default';
|
||||
InitializeDefaultPopup;
|
||||
Self.PopupMenu := FDefaultPopup;
|
||||
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, CX, CY);
|
||||
end;
|
||||
|
||||
destructor TVpGanttView.Destroy;
|
||||
begin
|
||||
FDefaultPopup.Free;
|
||||
FRowHeaderAttributes.Free;
|
||||
FColHeaderAttributes.Free;
|
||||
inherited;
|
||||
@ -409,6 +466,106 @@ begin
|
||||
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;
|
||||
FActiveEvent := 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(Verify: Boolean);
|
||||
var
|
||||
DoIt: Boolean;
|
||||
begin
|
||||
if ReadOnly then
|
||||
Exit;
|
||||
if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then
|
||||
exit;
|
||||
(*
|
||||
dvClickTimer.Enabled := false;
|
||||
EndEdit(self);
|
||||
|
||||
DoIt := not Verify;
|
||||
|
||||
if FActiveEvent <> nil then begin
|
||||
if Assigned(FOnDeletingEvent) then
|
||||
begin
|
||||
DoIt := true;
|
||||
FOnDeletingEvent(self, FActiveEvent, DoIt);
|
||||
end else
|
||||
if Verify then
|
||||
DoIt := (MessageDlg(RSConfirmDeleteEvent + LineEnding2 + RSPermanent,
|
||||
mtConfirmation, [mbYes, mbNo], 0) = mrYes);
|
||||
|
||||
if DoIt then begin
|
||||
FActiveEvent.Deleted := true;
|
||||
DataStore.PostEvents;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
|
||||
function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
|
||||
begin
|
||||
Result := inherited DoMouseWheelDown(Shift, MousePos);
|
||||
@ -444,6 +601,15 @@ begin
|
||||
Result.CY := 200;
|
||||
end;
|
||||
|
||||
function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime;
|
||||
begin
|
||||
Result := (X - FixedColWidth) / FColWidth + FLeftCol;
|
||||
if (Result >= 0) and (Result < NumDays) then
|
||||
Result := Result + FStartDate
|
||||
else
|
||||
Result := NO_DATE;
|
||||
end;
|
||||
|
||||
function TVpGanttView.GetDateFormat(AIndex: Integer): String;
|
||||
begin
|
||||
Result := FDateFormat[AIndex];
|
||||
@ -454,6 +620,31 @@ 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 then
|
||||
exit;
|
||||
idx := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
|
||||
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. }
|
||||
@ -613,13 +804,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpGanttView.LoadLanguage;
|
||||
var
|
||||
item: TMenuItem;
|
||||
begin
|
||||
{
|
||||
dvDayUpBtn.Hint := RSNextDay;
|
||||
dvDayDownBtn.Hint := RSPrevDay;
|
||||
dvTodayBtn.Hint := RSToday;
|
||||
dvWeekUpBtn.Hint := RSNextWeek;
|
||||
dvWeekDownBtn.Hint := RSPrevWeek;
|
||||
}
|
||||
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 : Date := Value;
|
||||
neDateChange : ActiveDate := Value;
|
||||
neDataStoreChange : Invalidate;
|
||||
neInvalidate : Invalidate;
|
||||
end;
|
||||
@ -635,6 +842,56 @@ begin
|
||||
Populate;
|
||||
end;
|
||||
|
||||
procedure TVpGanttView.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
var
|
||||
dt: TDateTime;
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
|
||||
if Button = mbLeft then
|
||||
begin
|
||||
FMouseDownPoint := Point(X, Y);
|
||||
FMouseDown := true;
|
||||
|
||||
{ if the mouse was pressed down in the client area, then select the cell. }
|
||||
if not Focused then
|
||||
SetFocus;
|
||||
|
||||
FActiveEvent := GetEventAtCoord(X, Y);
|
||||
dt := trunc(GetDateTimeAtCoord(X));
|
||||
if dt <> NO_DATE then
|
||||
SetActiveDate(dt);
|
||||
|
||||
if Assigned(OnClick) then
|
||||
OnClick(self);
|
||||
end
|
||||
else begin
|
||||
if not Focused then
|
||||
SetFocus;
|
||||
(*
|
||||
if (x > dvRowHeadWidth - 9) and (y > dvColHeadHeight) then
|
||||
begin
|
||||
{ The mouse click landed inside the client area }
|
||||
dvSetActiveColByCoord(Point(x, y));
|
||||
dvSetActiveRowByCoord(Point(x, y), True);
|
||||
end;
|
||||
|
||||
EditEventAtCoord(Point (x, y));
|
||||
dvClickTimer.Enabled := false;
|
||||
|
||||
if not Assigned(FActiveEvent) then
|
||||
for i := 0 to FDefaultPopup.Items.Count - 1 do begin
|
||||
if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then
|
||||
FDefaultPopup.Items[i].Enabled := False;
|
||||
end
|
||||
else
|
||||
for i := 0 to FDefaultPopup.Items.Count - 1 do
|
||||
FDefaultPopup.Items[i].Enabled := True;
|
||||
*)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpGanttView.Paint;
|
||||
begin
|
||||
RenderToCanvas(
|
||||
@ -655,7 +912,7 @@ end;
|
||||
procedure TVpGanttView.Populate;
|
||||
begin
|
||||
if DataStore <> nil then
|
||||
DataStore.Date := FDate;
|
||||
DataStore.Date := FActiveDate;
|
||||
end;
|
||||
|
||||
// Populates the array of TVpGanttRec records containing the date of each day
|
||||
@ -790,27 +1047,10 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TVpGanttView.SetColor(Value: TColor);
|
||||
procedure TVpGanttView.SetActiveDate(AValue: TDateTime);
|
||||
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.SetDate(AValue: TDateTime);
|
||||
begin
|
||||
if FDate <> AValue then begin
|
||||
FDate := AValue;
|
||||
if FActiveDate <> AValue then begin
|
||||
FActiveDate := AValue;
|
||||
(*
|
||||
if (AValue < wvStartDate) or (Value >= wvStartDate + 7) then
|
||||
wvStartDate := Trunc(GetStartOfWeek(Value, FWeekStartsOn));
|
||||
@ -825,7 +1065,24 @@ begin
|
||||
Invalidate;
|
||||
|
||||
if (not FInLinkHandler) and (ControlLink <> nil) then
|
||||
ControlLink.Notify(self, neDateChange, FDate);
|
||||
ControlLink.Notify(self, neDateChange, FActiveDate);
|
||||
end;
|
||||
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;
|
||||
|
||||
@ -963,6 +1220,48 @@ begin
|
||||
SetScrollInfo(Handle, SB_VERT, scrollInfo, True);
|
||||
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;
|
||||
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;
|
||||
FActiveEvent := nil;
|
||||
{
|
||||
dvActiveEventRec := Rect(0, 0, 0, 0);
|
||||
dvActiveIconRec := Rect(0, 0, 0, 0);
|
||||
}
|
||||
end;
|
||||
end;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll);
|
||||
begin
|
||||
{ for simplicity, bail out of editing while scrolling. }
|
||||
@ -997,5 +1296,311 @@ begin
|
||||
end;
|
||||
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;
|
||||
NewSubItem: 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;
|
||||
(*
|
||||
NewItem := TVpMenuItem.Create(Self); // ----
|
||||
NewItem.Kind := mikSeparator;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
|
||||
if RSPopupImportFromICal <> '' then begin
|
||||
NewItem := TVpMenuItem.Create(Self); // Import from iCal
|
||||
NewItem.Kind := mikImportEventFromICal;
|
||||
NewItem.OnClick := PopupImportICalFile;
|
||||
NewItem.Tag := 0;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
end;
|
||||
|
||||
if RSPopupExportToICal <> '' then begin // Export ical
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikExportEventToICal;
|
||||
NewItem.OnClick := PopupExportICalFile;
|
||||
NewItem.Tag := 1;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
end;
|
||||
*)
|
||||
NewItem := TVpMenuItem.Create(Self); // ----
|
||||
NewItem.Kind := mikSeparator;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
|
||||
if RSPopupChangeDate <> '' then begin // Change date
|
||||
NewItem := TVpMenuItem.Create(Self);
|
||||
NewItem.Kind := mikChangeDate;
|
||||
NewItem.Tag := 0;
|
||||
FDefaultPopup.Items.Add(NewItem);
|
||||
|
||||
if RSToday <> '' then begin // Today
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikToday;
|
||||
NewSubItem.OnClick := @PopupToday;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
(*
|
||||
NewSubItem := TVpMenuItem.Create(Self); // ---
|
||||
NewSubItem.Kind := mikSeparator;
|
||||
NewItem.Add(NewSubItem);
|
||||
|
||||
if RSYesterday <> '' then begin // Yesterday
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikYesterday;
|
||||
NewSubItem.OnClick := PopupYesterday;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
if RSTomorrow <> '' then begin // Tomorrow
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikTomorrow;
|
||||
NewSubItem.OnClick := PopupTomorrow;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
NewSubItem := TVpMenuItem.Create(Self); // --
|
||||
NewSubItem.Kind := mikSeparator;
|
||||
NewItem.Add(NewSubItem);
|
||||
|
||||
if RSNextDay <> '' then begin // Next day
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikNextDay;
|
||||
NewSubItem.OnClick := PopupNextDay;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
if RSPrevDay <> '' then begin // Prev day
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikPrevDay;
|
||||
NewSubItem.OnClick := PopupPrevDay;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
NewSubItem := TVpMenuItem.Create(Self); // ---
|
||||
NewSubItem.Kind := mikSeparator;
|
||||
NewItem.Add(NewSubItem);
|
||||
|
||||
if RSNextWeek <> '' then begin // Next week
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikNextWeek;
|
||||
NewSubItem.OnClick := PopupNextWeek;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
if RSPrevWeek <> '' then begin // Prev week
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikPrevWeek;
|
||||
NewSubItem.OnClick := PopupPrevWeek;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
NewSubItem := TVpMenuItem.Create(Self); // ---
|
||||
NewSubItem.Kind := mikSeparator;
|
||||
NewItem.Add(NewSubItem);
|
||||
|
||||
if RSNextMonth <> '' then begin // Next month
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikNextMonth;
|
||||
NewSubItem.OnClick := PopupNextMonth;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
if RSPrevMonth <> '' then begin // Prev Month
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikPrevMonth;
|
||||
NewSubItem.OnClick := PopupPrevMonth;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
NewSubItem := TVpMenuItem.Create(Self); // ---
|
||||
NewSubItem.Kind := mikSeparator;
|
||||
NewItem.Add(NewSubItem);
|
||||
|
||||
if RSNextYear <> '' then begin // Next year
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikNextYear;
|
||||
NewSubItem.OnClick := PopupNextYear;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
if RSPrevYear <> '' then begin // Prev year
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikPrevYear;
|
||||
NewSubItem.OnClick := PopupPrevYear;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
|
||||
NewSubItem := TVpMenuItem.Create(Self); // ---
|
||||
NewSubItem.Kind := mikSeparator;
|
||||
NewItem.Add(NewSubItem);
|
||||
|
||||
if RSCustomDate <> '' then begin // Custom date
|
||||
NewSubItem := TVpMenuItem.Create(Self);
|
||||
NewSubItem.Kind := mikCustomDate;
|
||||
NewSubItem.OnClick := PopupCustomDate;
|
||||
NewSubItem.Tag := 0;
|
||||
NewItem.Add(NewSubItem);
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
(*
|
||||
if (Datastore <> nil) and (Datastore.Resource <> nil) then
|
||||
AddResourceGroupMenu(FDefaultPopup.Items, Datastore.Resource, PopupPickResourceGroupEvent);
|
||||
*)
|
||||
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;
|
||||
(*
|
||||
StartTime := trunc(FDisplayDate + ActiveCol) + dvLineMatrix[ActiveCol, ActiveRow].Time;
|
||||
EndTime := StartTime + dvTimeIncSize * FRowLinesStep;
|
||||
FActiveEvent := DataStore.Resource.Schedule.AddEvent(
|
||||
DataStore.GetNextID(EventsTableName),
|
||||
StartTime,
|
||||
EndTime
|
||||
);
|
||||
Repaint;
|
||||
|
||||
{ edit this new event }
|
||||
dvSpawnEventEditDialog(True);
|
||||
*)
|
||||
end;
|
||||
(*
|
||||
procedure TVpGanttView.PopupExportICalFile(Sender: TObject);
|
||||
var
|
||||
dlg: TSaveDialog;
|
||||
begin
|
||||
if (not Assigned(Datastore)) or (not Assigned(Datastore.Resource)) or
|
||||
(FActiveEvent = nil)
|
||||
then
|
||||
exit;
|
||||
|
||||
dlg := TSaveDialog.Create(nil);
|
||||
try
|
||||
dlg.Title := RSSaveICalTitle;
|
||||
dlg.Filter := RSICalFilter;
|
||||
dlg.FileName := '';
|
||||
dlg.Options := dlg.Options - [ofAllowMultiSelect] + [ofOverwritePrompt];
|
||||
if dlg.Execute then
|
||||
ExportICalFile(dlg.FileName, [FActiveEvent]);
|
||||
finally
|
||||
dlg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TVpGanttView.PopupImportICalFile(Sender: TObject);
|
||||
var
|
||||
dlg: TOpenDialog;
|
||||
fn: String;
|
||||
begin
|
||||
if ReadOnly or (not CheckCreateResource) or
|
||||
(not Assigned(DataStore)) or (not Assigned(DataStore.Resource))
|
||||
then
|
||||
Exit;
|
||||
|
||||
dlg := TOpenDialog.Create(nil);
|
||||
try
|
||||
dlg.Title := RSLoadICalTitle;
|
||||
dlg.Filter := RSICalFilter;
|
||||
dlg.FileName := '';
|
||||
dlg.Options := dlg.Options + [ofAllowMultiSelect, ofFileMustExist];
|
||||
if dlg.Execute then begin
|
||||
for fn in dlg.Files do
|
||||
ImportICalFile(fn, dlg.Files.Count = 1);
|
||||
end;
|
||||
finally
|
||||
dlg.Free;
|
||||
end;
|
||||
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.PopupToday(Sender: TObject);
|
||||
begin
|
||||
SetActiveDate(Now);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user