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

tvplanit/TVpGanttView: Double-click. Fix scrolling when size is changed.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8425 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-29 18:34:35 +00:00
parent ab7800349c
commit 89b96e9392
2 changed files with 79 additions and 267 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -151,6 +151,7 @@ type
function GetDateTimeAtCoord(X: Integer): TDateTime; function GetDateTimeAtCoord(X: Integer): TDateTime;
function GetEventAtCoord(X, Y: Integer): TVpEvent; function GetEventAtCoord(X, Y: Integer): TVpEvent;
function GetRowAtCoord(Y: Integer): Integer; function GetRowAtCoord(Y: Integer): Integer;
function GetRowOfEvent(AEvent: TVpEvent): Integer;
procedure GetEventDateRange; procedure GetEventDateRange;
procedure Hookup; procedure Hookup;
procedure Populate; procedure Populate;
@ -159,50 +160,34 @@ type
procedure PopulateMonthRecords; procedure PopulateMonthRecords;
procedure ScrollDateIntoView(ADate: TDateTime); procedure ScrollDateIntoView(ADate: TDateTime);
procedure ScrollHorizontal(ANumCols: Integer); procedure ScrollHorizontal(ANumCols: Integer);
procedure ScrollRowIntoView(ARow: Integer);
procedure ScrollVertical(ANumRows: Integer); procedure ScrollVertical(ANumRows: Integer);
procedure SetHScrollPos; procedure SetHScrollPos;
procedure SetVScrollPos; procedure SetVScrollPos;
procedure SpawnEventEditDialog(IsNewEvent: Boolean); 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 UpdatePopupMenu;
{
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 } { inherited methods }
procedure CreateParams(var AParams: TCreateParams); override; procedure CreateParams(var AParams: TCreateParams); override;
procedure DblClick; override; procedure DblClick; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure DoOnResize; override;
class function GetControlClassDefaultSize: TSize; override; class function GetControlClassDefaultSize: TSize; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Loaded; override; procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override; procedure Paint; override;
procedure Resize; override;
procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
{ Popup }
function GetPopupMenu: TPopupMenu; override;
procedure InitializeDefaultPopup;
procedure PopupAddEvent(Sender: TObject);
procedure PopupDeleteEvent(Sender: TObject);
procedure PopupEditEvent(Sender: TObject);
procedure UpdatePopupMenu;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -387,7 +372,7 @@ end;
constructor TVpGanttView.Create(AOwner: TComponent); constructor TVpGanttView.Create(AOwner: TComponent);
begin begin
inherited; inherited;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; ControlStyle := [csCaptureMouse, csOpaque, csClickEvents, csDoubleClicks];
FInLinkHandler := false; FInLinkHandler := false;
FLoaded := false; FLoaded := false;
@ -407,11 +392,10 @@ begin
FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self); FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self);
FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self); FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self);
FDrawingStyle := ds3d;
FDateFormat[0] := DEFAULT_DAYFORMAT; FDateFormat[0] := DEFAULT_DAYFORMAT;
FDateFormat[1] := DEFAULT_MONTHFORMAT; FDateFormat[1] := DEFAULT_MONTHFORMAT;
FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT; FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT;
FDrawingStyle := ds3d;
FScrollBars := ssBoth; FScrollBars := ssBoth;
// Popup menu // Popup menu
@ -508,7 +492,7 @@ begin
begin begin
startTime := trunc(dt); startTime := trunc(dt);
endTime := startTime + 1.0; endTime := startTime + 1.0;
FActiveEvent := Datastore.Resource.Schedule.AddEvent( ActiveEvent := Datastore.Resource.Schedule.AddEvent(
Datastore.GetNextID(EventsTableName), Datastore.GetNextID(EventsTableName),
startTime, startTime,
endTime endTime
@ -603,6 +587,28 @@ begin
end; end;
end; end;
procedure TVpGanttView.DoOnResize;
var
emptyRows, emptyCols: Integer;
begin
inherited;
if (FRowHeight > 0) and (Length(FEventRecords) > 0) then
begin
VisibleRows := CalcVisibleRows(ClientHeight);
emptyRows := VisibleRows - (Length(FEventRecords) - FTopRow);
if emptyRows > 0 then
ScrollVertical(-emptyRows);
VisibleCols := CalcVisibleCols(ClientWidth);
emptyCols := VisibleCols - (Length(FDayRecords) - FLeftCol);
if emptyCols > 0 then
ScrollHorizontal(-emptyCols);
end;
Invalidate;
end;
function TVpGanttView.GetColAtCoord(X: Integer): Integer; function TVpGanttView.GetColAtCoord(X: Integer): Integer;
begin begin
Result := (X - FixedColWidth) div FColWidth + FLeftCol; Result := (X - FixedColWidth) div FColWidth + FLeftCol;
@ -737,6 +743,19 @@ begin
Result := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow; Result := (Y - FTotalColHeaderHeight) div FRowHeight + FTopRow;
end; 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 { If the component is being dropped on a form at designtime, then
automatically hook up to the first datastore component found. } automatically hook up to the first datastore component found. }
procedure TVpGanttView.HookUp; procedure TVpGanttView.HookUp;
@ -969,8 +988,11 @@ begin
FEventRecords[i].Caption := event.Description; FEventRecords[i].Caption := event.Description;
FEventRecords[i].HeadRect := Rect(xh1, y1, xh2, y2); FEventRecords[i].HeadRect := Rect(xh1, y1, xh2, y2);
FEventRecords[i].EventRect := Rect(xe1, y1, xe2, y2); FEventRecords[i].EventRect := Rect(xe1, y1, xe2, y2);
if event = FActiveEvent then
FActiveRow := i;
y1 := y2; y1 := y2;
end; end;
finally finally
list.Free; list.Free;
end; end;
@ -1027,12 +1049,6 @@ begin
end; end;
end; end;
procedure TVpGanttView.Resize;
begin
inherited;
Invalidate;
end;
procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime); procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
begin begin
if (FStartDate = 0) or (FStartDate = NO_DATE) then if (FStartDate = 0) or (FStartDate = NO_DATE) then
@ -1040,10 +1056,9 @@ begin
if ADate < FStartDate then if ADate < FStartDate then
begin begin
FStartDate := trunc(FStartDate); FStartDate := trunc(ADate);
FColCount := GetNumDays; FColCount := GetNumDays;
SetLeftCol(0); SetLeftCol(-MaxInt);
Invalidate;
end else end else
if ADate > FEndDate then if ADate > FEndDate then
begin begin
@ -1067,6 +1082,12 @@ begin
Invalidate; Invalidate;
end; 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); procedure TVpGanttView.ScrollVertical(ANumRows: Integer);
begin begin
SetTopRow(FTopRow + ANumRows); SetTopRow(FTopRow + ANumRows);
@ -1082,6 +1103,7 @@ begin
Populate; Populate;
ScrollDateIntoView(FActiveDate); ScrollDateIntoView(FActiveDate);
FActiveCol := trunc(FActiveDate) - trunc(FStartDate);
Invalidate; Invalidate;
if (not FInLinkHandler) and (ControlLink <> nil) then if (not FInLinkHandler) and (ControlLink <> nil) then
@ -1095,7 +1117,11 @@ begin
begin begin
FActiveEvent := AValue; FActiveEvent := AValue;
if FActiveEvent <> nil then if FActiveEvent <> nil then
begin
FActiveRow := GetRowOfEvent(FActiveEvent);
ScrollRowIntoView(FActiveRow);
SetActiveDate(FActiveEvent.StartTime); SetActiveDate(FActiveEvent.StartTime);
end;
UpdatePopupMenu; UpdatePopupMenu;
end; end;
end; end;
@ -1275,7 +1301,14 @@ begin
if AllowIt then begin if AllowIt then begin
FActiveEvent.Changed := true; FActiveEvent.Changed := true;
DataStore.PostEvents; DataStore.PostEvents;
SetActiveDate(trunc(FActiveEvent.StartTime));
// 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 if IsNewEvent and Assigned(FOnAddEvent) then
FOnAddEvent(self, FActiveEvent); FOnAddEvent(self, FActiveEvent);
if not IsNewEvent and Assigned(FOnModifyEvent) then if not IsNewEvent and Assigned(FOnModifyEvent) then
@ -1292,12 +1325,6 @@ end;
procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll); procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll);
begin begin
{ for simplicity, bail out of editing while scrolling. }
// EndEdit(Self);
// wp: Next line should never happen after EndEdit...
// if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then Exit;
case Msg.ScrollCode of case Msg.ScrollCode of
SB_LINELEFT : ScrollHorizontal(-1); SB_LINELEFT : ScrollHorizontal(-1);
SB_LINERIGHT : ScrollHorizontal(1); SB_LINERIGHT : ScrollHorizontal(1);
@ -1309,12 +1336,6 @@ end;
procedure TVpGanttView.WMVScroll(var Msg: TLMVScroll); procedure TVpGanttView.WMVScroll(var Msg: TLMVScroll);
begin begin
{ for simplicity, bail out of editing while scrolling. }
// EndEdit(Self);
// wp: Next line should never happen after EndEdit...
// if (dvInPlaceEditor <> nil) and dvInplaceEditor.Visible then Exit;
case Msg.ScrollCode of case Msg.ScrollCode of
SB_LINEUP : ScrollVertical(-1); SB_LINEUP : ScrollVertical(-1);
SB_LINEDOWN : ScrollVertical(1); SB_LINEDOWN : ScrollVertical(1);
@ -1346,7 +1367,6 @@ end;
procedure TVpGanttView.InitializeDefaultPopup; procedure TVpGanttView.InitializeDefaultPopup;
var var
NewItem: TVpMenuItem; NewItem: TVpMenuItem;
NewSubItem: TVpMenuItem;
canEdit: Boolean; canEdit: Boolean;
begin begin
canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit; canEdit := (FActiveEvent <> nil) and FActiveEvent.CanEdit;
@ -1377,164 +1397,6 @@ begin
NewItem.Tag := 1; NewItem.Tag := 1;
FDefaultPopup.Items.Add(NewItem); FDefaultPopup.Items.Add(NewItem);
end; 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; end;
procedure TVpGanttView.PopupAddEvent(Sender: TObject); procedure TVpGanttView.PopupAddEvent(Sender: TObject);
@ -1560,53 +1422,6 @@ begin
// Edit this new event // Edit this new event
SpawnEventEditDialog(True); SpawnEventEditDialog(True);
end; 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); procedure TVpGanttView.PopupDeleteEvent(Sender: TObject);
begin begin
@ -1626,11 +1441,6 @@ begin
// edit this event // edit this event
SpawnEventEditDialog(false); SpawnEventEditDialog(false);
end; end;
{
procedure TVpGanttView.PopupToday(Sender: TObject);
begin
SetActiveDate(Now);
end; }
procedure TVpGanttView.UpdatePopupMenu; procedure TVpGanttView.UpdatePopupMenu;
var var

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

@ -329,9 +329,11 @@ var
begin begin
RenderCanvas.Pen.Color := RealLineColor; RenderCanvas.Pen.Color := RealLineColor;
dx := FGanttView.LeftCol * FGanttView.ColWidth;
dy := FGanttView.TopRow * FGanttView.RowHeight;
// Horizontal lines // Horizontal lines
x1 := RealLeft + FGanttView.FixedColWidth; x1 := RealLeft + FGanttView.FixedColWidth;
dx := FGanttView.LeftCol * FGanttView.ColWidth;
n := FGanttView.NumMonths; n := FGanttView.NumMonths;
if n > 0 then if n > 0 then
begin begin
@ -343,19 +345,19 @@ begin
if FGanttView.DrawingStyle = ds3D then dec(y0); if FGanttView.DrawingStyle = ds3D then dec(y0);
RenderCanvas.Line(x1, y0, x2, y0); RenderCanvas.Line(x1, y0, x2, y0);
y0 := 0; y0 := -dy;
if FGanttView.DrawingStyle = ds3D then dec(y0); if FGanttView.DrawingStyle = ds3D then dec(y0);
numEvents := FGanttView.NumEvents; numEvents := FGanttView.NumEvents;
for i := 0 to numEvents - 1 do for i := 0 to numEvents - 1 do
begin begin
eventRec := FGanttView.EventRecords[i]; eventRec := FGanttView.EventRecords[i];
y1 := y0 + eventRec.EventRect.Bottom; y1 := y0 + eventRec.EventRect.Bottom;
if y1 >= FGanttView.TotalColHeaderHeight then
RenderCanvas.Line(x1, y1, x2, y1); RenderCanvas.Line(x1, y1, x2, y1);
end; end;
// Vertical lines // Vertical lines
y1 := RealTop + FGanttView.TotalColHeaderHeight; y1 := RealTop + FGanttView.TotalColHeaderHeight;
dy := FGanttView.TopRow * FGanttView.RowHeight;
if numEvents > 0 then if numEvents > 0 then
begin begin
eventRec := FGanttView.EventRecords[numEvents-1]; eventRec := FGanttView.EventRecords[numEvents-1];