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

1
components/tvplanit/source/vpdata.pas
View File

@ -718,6 +718,7 @@ type
property UserField9: string read FUserField9 write FUserField9;
end;
function CompareEvents(Item1, Item2: Pointer): Integer;
function CompareEventsByTimeOnly(Item1, Item2: Pointer): Integer;

8
components/tvplanit/source/vpdayview.pas
View File

@ -369,6 +369,7 @@ type
{ Popup }
function GetPopupMenu: TPopupMenu; override;
procedure InitializeDefaultPopup;
procedure PopupAddEvent(Sender: TObject);
procedure PopupImportICalFile(Sender: TObject);
procedure PopupExportICalFile(Sender: TObject);
@ -387,7 +388,6 @@ type
procedure PopupPrevYear(Sender: TObject);
procedure PopupCustomDate(Sender: TObject);
procedure PopupPickResourceGroupEvent(Sender: TObject);
procedure InitializeDefaultPopup;
{ internal methods }
function dvCalcRowHeight(Scale: Extended; UseGran: TVpGranularity): Integer;
@ -2233,12 +2233,14 @@ end;
function TVpDayView.EditEventAtCoord(APoint: TPoint): Boolean;
var
I: Integer;
I, n: Integer;
begin
result := false;
if ReadOnly then
Exit;
for I := 0 to pred(Length(dvEventArray)) do begin
n := Length(dvEventArray);
for I := 0 to n - 1 do begin
FActiveEvent := nil; // wp: shouldn't these be set also if ReadOnly is true?
dvActiveEventRec := Rect(0, 0, 0, 0);
dvActiveIconRec := Rect(0, 0, 0, 0);

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.

62
components/tvplanit/source/vpganttviewpainter.pas
View File

@ -28,6 +28,7 @@ type
protected
procedure Clear;
procedure DrawActiveDay;
procedure DrawBorders;
procedure DrawColHeader;
procedure DrawEvents;
@ -52,9 +53,6 @@ uses
DateUtils,
VpConst, VpMisc, VpCanvasUtils, VpData;
type
TVpGanttViewOpener = class(TVpGanttView);
constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView;
ARenderCanvas: TCanvas);
begin
@ -68,6 +66,44 @@ begin
RenderCanvas.FillRect(RenderIn);
end;
procedure TVpGanttViewPainter.DrawActiveDay;
var
R: TRect;
dayRec: TVpGanttDayRec;
eventRec: TVpGanttEventRec;
dx, dy: Integer;
bs: TBrushStyle;
pw: Integer;
begin
with FGanttView do
begin
if (ActiveRow < 0) or (ActiveRow >= RowCount) then
exit;
if (ActiveCol < 0) or (ActiveCol >= ColCount) then
exit;
dayRec := DayRecords[ActiveCol];
eventRec := EventRecords[ActiveRow];
dx := LeftCol * ColWidth;
dy := TopRow * RowHeight;
end;
R := Rect(
dayRec.Rect.Left, eventRec.EventRect.Top, dayRec.Rect.Right, eventRec.EventRect.Bottom
);
OffsetRect(R, -dx, -dy);
pw := RenderCanvas.Pen.Width;
bs := RenderCanvas.Brush.Style;
RenderCanvas.Pen.Width := 3;
RenderCanvas.Pen.Color := clBlack;
RenderCanvas.Brush.Style := bsClear;
TPSRectangle(RenderCanvas, Angle, RenderIn, R);
RenderCanvas.Pen.Width := pw;
RenderCanvas.Brush.Style := bs;
end;
procedure TVpGanttViewPainter.DrawBorders;
var
R: TRect;
@ -248,10 +284,20 @@ var
cat: TVpCategoryInfo;
R: TRect;
dx, dy: Integer;
top_margin, bottom_margin: Integer;
begin
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dy := FGanttView.TopRow * FGanttView.RowHeight;
if FGanttView.DrawingStyle = ds3D then
begin
top_margin := 1;
bottom_margin := 2;
end else
begin
top_margin := 2;
bottom_margin := 1;
end;
RenderCanvas.Font.Assign(FEventFont);
for i := 0 to FGanttView.NumEvents-1 do
begin
@ -259,8 +305,8 @@ begin
event := eventRec.Event;
R := eventRec.EventRect;
OffsetRect(R, -dx, -dy);
inc(R.Top, 2);
dec(R.Bottom, 1); // 1 less than top due to grid linewidth.
inc(R.Top, top_margin);
dec(R.Bottom, bottom_margin);
if R.Top < FGanttView.TotalColHeaderHeight then
Continue;
if R.Left < FGanttView.FixedColWidth then
@ -297,8 +343,9 @@ begin
if FGanttView.DrawingStyle = ds3D then dec(y0);
RenderCanvas.Line(x1, y0, x2, y0);
numEvents := FGanttView.NumEvents;
y0 := 0;
if FGanttView.DrawingStyle = ds3D then dec(y0);
numEvents := FGanttView.NumEvents;
for i := 0 to numEvents - 1 do
begin
eventRec := FGanttView.EventRecords[i];
@ -459,6 +506,9 @@ begin
{ draw events }
DrawEvents;
{ Draw active day rectangle }
DrawActiveDay;
{ Draw the borders }
DrawBorders;