pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit/TvpGanttView: Operational popup menu. Highlight active date. Sort events by time.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8424 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-29 15:09:38 +00:00
parent 6fdf379467
commit ab7800349c
4 changed files with 210 additions and 113 deletions
Download Patch File Download Diff File Expand all files Collapse all files

252
components/tvplanit/source/vpganttview.pas
View File

@@ -71,6 +71,8 @@ type
TVpGanttView = class(TVpLinkableControl)
private
FActiveCol: Integer; // Selected column
FActiveRow: Integer; // Selected row
FActiveEvent: TVpEvent; // Selected event
FActiveDate: TDateTime; // Selected date
FStartDate: TDateTime; // Date of the first event
@@ -110,6 +112,7 @@ type
FExternalPopup: TPopupMenu;
FOnAddEvent: TVpOnAddNewEvent;
FOnDeletingEvent: TVpOnDeletingEvent;
FOnModifyEvent: TVpOnModifyEvent;
FOwnerEditEvent: TVpEditEvent;
@@ -123,6 +126,7 @@ type
function IsStoredColWidth: Boolean;
function IsStoredDateFormat(AIndex: Integer): Boolean;
procedure SetActiveDate(AValue: TDateTime);
procedure SetActiveEvent(AValue: TVpEvent);
procedure SetColor(Value: TColor); reintroduce;
procedure SetColWidth(AValue: Integer);
procedure SetDateFormat(AIndex: Integer; AValue: String);
@@ -143,14 +147,17 @@ type
{ internal methods }
procedure CalcColHeaderHeight;
procedure CalcRowHeight;
function GetColAtCoord(X: Integer): Integer;
function GetDateTimeAtCoord(X: Integer): TDateTime;
function GetEventAtCoord(X, Y: Integer): TVpEvent;
function GetRowAtCoord(Y: Integer): Integer;
procedure GetEventDateRange;
procedure Hookup;
procedure Populate;
procedure PopulateDayRecords;
procedure PopulateEventRecords;
procedure PopulateMonthRecords;
procedure ScrollDateIntoView(ADate: TDateTime);
procedure ScrollHorizontal(ANumCols: Integer);
procedure ScrollVertical(ANumRows: Integer);
procedure SetHScrollPos;
@@ -165,7 +172,8 @@ type
// procedure PopupExportICalFile(Sender: TObject);
procedure PopupDeleteEvent(Sender: TObject);
procedure PopupEditEvent(Sender: TObject);
procedure PopupToday(Sender: TObject);
// procedure PopupToday(Sender: TObject);
procedure UpdatePopupMenu;
{
procedure PopupTomorrow(Sender: TObject);
procedure PopupYesterday(Sender: TObject);
@@ -212,8 +220,10 @@ type
function CalcVisibleCols(AWidth: Integer): Integer;
function CalcVisibleRows(AHeight: Integer): Integer;
property ActiveEvent: TVpEvent read FActiveEvent write FActiveEvent;
property ActiveCol: Integer read FActiveCol;
property ActiveEvent: TVpEvent read FActiveEvent write SetActiveEvent;
property ActiveDate: TDateTime read FActiveDate write SetActiveDate;
property ActiveRow: Integer read FActiveRow;
property StartDate: TDateTime read FStartDate write FStartDate;
property EndDate: TDateTime read FEndDate write FEndDate;
property ColCount: Integer read FColCount write FColCount;
@@ -235,6 +245,7 @@ type
property NumDays: Integer read GetNumDays;
property NumEvents: Integer read GetNumEvents;
property NumMonths: Integer read GetNumMonths;
published
// inherited properties
property Align;
@@ -258,6 +269,7 @@ type
property OnClick;
// new events
property OnAddEvent: TVpOnAddNewEvent read FOnAddEvent write FOnAddEvent;
property OnDeletingEvent: TVpOnDeletingEvent read FOnDeletingEvent write FOnDeletingEvent;
property OnModifyEvent: TVpOnModifyEvent read FOnModifyEvent write FOnModifyEvent;
property OwnerEditEvent: TVpEditEvent read FOwnerEditEvent write FOwnerEditEvent;
end;
@@ -380,6 +392,7 @@ begin
FInLinkHandler := false;
FLoaded := false;
FPainting := false;
FMouseDown := false;
SetActiveDate(Now);
FStartDate := FActiveDate;
@@ -401,19 +414,19 @@ begin
FScrollBars := ssBoth;
// popup menu
// 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);
end;
destructor TVpGanttView.Destroy;
begin
FDefaultPopup.Free;
FRowHeaderAttributes.Free;
FColHeaderAttributes.Free;
inherited;
@@ -541,9 +554,6 @@ begin
Exit;
if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then
exit;
(*
dvClickTimer.Enabled := false;
EndEdit(self);
DoIt := not Verify;
@@ -563,7 +573,6 @@ begin
Invalidate;
end;
end;
*)
end;
function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
@@ -594,6 +603,11 @@ begin
end;
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
@@ -602,10 +616,12 @@ begin
end;
function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime;
var
days: double;
begin
Result := (X - FixedColWidth) / FColWidth + FLeftCol;
if (Result >= 0) and (Result < NumDays) then
Result := Result + FStartDate
days := (X - FixedColWidth) / FColWidth + FLeftCol;
if (days >= 0) and (days < NumDays) then
Result := FStartDate + days
else
Result := NO_DATE;
end;
@@ -630,7 +646,7 @@ begin
dt := GetDateTimeAtCoord(X);
if dt = -1 then
exit;
idx := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
idx := GetRowAtCoord(Y);
if (idx >= 0) and (idx < NumEvents) then
begin
eventRec := FEventRecords[idx];
@@ -716,6 +732,11 @@ begin
Result := 0;
end;
function TVpGanttView.GetRowAtCoord(Y: Integer): Integer;
begin
Result := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
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;
@@ -749,6 +770,7 @@ procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState);
var
PopupPoint : TPoint;
begin
inherited;
case Key of
VK_DELETE : ; //DeleteActiveEvent(true);
VK_RIGHT : if Shift = [ssShift] then
@@ -826,7 +848,7 @@ begin
FInLinkHandler := true;
try
case NotificationType of
neDateChange : ActiveDate := Value;
neDateChange : SetActiveDate(Value);
neDataStoreChange : Invalidate;
neInvalidate : Invalidate;
end;
@@ -849,47 +871,14 @@ var
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;
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.Paint;
@@ -937,44 +926,53 @@ end;
procedure TVpGanttView.PopulateEventRecords;
var
eventRec: TVpGanttEventRec;
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;
xh1 := 0;
xh2 := FixedColWidth;
y1 := FTotalColHeaderHeight;
totalWidth := GetNumDays * ColWidth;
eventRec := Default(TVpGanttEventRec);
for i := 0 to High(FEventRecords) do
begin
event := Datastore.Resource.Schedule.GetEvent(i);
if event.AllDayEvent then
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
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;
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);
y1 := y2;
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);
y1 := y2;
finally
list.Free;
end;
end;
@@ -1035,6 +1033,34 @@ begin
Invalidate;
end;
procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
begin
if (FStartDate = 0) or (FStartDate = NO_DATE) then
exit;
if ADate < FStartDate then
begin
FStartDate := trunc(FStartDate);
FColCount := GetNumDays;
SetLeftCol(0);
Invalidate;
end else
if ADate > FEndDate then
begin
FEndDate := trunc(ADate);
FColCount := GetNumDays;
SetLeftCol(MaxInt);
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);
@@ -1049,19 +1075,13 @@ end;
procedure TVpGanttView.SetActiveDate(AValue: TDateTime);
begin
if FActiveDate <> AValue then begin
FActiveDate := AValue;
(*
if (AValue < wvStartDate) or (Value >= wvStartDate + 7) then
wvStartDate := Trunc(GetStartOfWeek(Value, FWeekStartsOn));
if wvStartDate > Value then
wvStartDate := wvStartDate - 7;
*)
if FActiveDate <> trunc(AValue) then begin
FActiveDate := trunc(AValue);
if FLoaded then
Populate;
ScrollDateIntoView(FActiveDate);
Invalidate;
if (not FInLinkHandler) and (ControlLink <> nil) then
@@ -1069,6 +1089,17 @@ begin
end;
end;
procedure TVpGanttView.SetActiveEvent(AValue: TVpEvent);
begin
if FActiveEvent <> AValue then
begin
FActiveEvent := AValue;
if FActiveEvent <> nil then
SetActiveDate(FActiveEvent.StartTime);
UpdatePopupMenu;
end;
end;
procedure TVpGanttView.SetColor(Value: TColor);
begin
if FColor <> Value then begin
@@ -1244,6 +1275,7 @@ begin
if AllowIt then begin
FActiveEvent.Changed := true;
DataStore.PostEvents;
SetActiveDate(trunc(FActiveEvent.StartTime));
if IsNewEvent and Assigned(FOnAddEvent) then
FOnAddEvent(self, FActiveEvent);
if not IsNewEvent and Assigned(FOnModifyEvent) then
@@ -1252,11 +1284,7 @@ begin
if IsNewEvent then begin
FActiveEvent.Deleted := true;
DataStore.PostEvents;
FActiveEvent := nil;
{
dvActiveEventRec := Rect(0, 0, 0, 0);
dvActiveIconRec := Rect(0, 0, 0, 0);
}
SetActiveEvent(nil);
end;
end;
Invalidate;
@@ -1370,6 +1398,7 @@ begin
FDefaultPopup.Items.Add(NewItem);
end;
*)
{
NewItem := TVpMenuItem.Create(Self); // ----
NewItem.Kind := mikSeparator;
FDefaultPopup.Items.Add(NewItem);
@@ -1501,6 +1530,7 @@ begin
end;
*)
end;
}
(*
if (Datastore <> nil) and (Datastore.Resource <> nil) then
AddResourceGroupMenu(FDefaultPopup.Items, Datastore.Resource, PopupPickResourceGroupEvent);
@@ -1509,26 +1539,26 @@ end;
procedure TVpGanttView.PopupAddEvent(Sender: TObject);
var
StartTime: TDateTime;
EndTime: TDateTime;
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;
// 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
);
Repaint;
FActiveEvent.AllDayEvent := true;
{ edit this new event }
dvSpawnEventEditDialog(True);
*)
// Edit this new event
SpawnEventEditDialog(True);
end;
(*
procedure TVpGanttView.PopupExportICalFile(Sender: TObject);
@@ -1596,10 +1626,24 @@ begin
// edit this event
SpawnEventEditDialog(false);
end;
{
procedure TVpGanttView.PopupToday(Sender: TObject);
begin
SetActiveDate(Now);
end; }
procedure TVpGanttView.UpdatePopupMenu;
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.