From 3de78ed971b10e53c4b2a1c813db91200f4024eb Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 29 Aug 2022 21:25:03 +0000 Subject: [PATCH] tvplanit/TvpGanttView: Keyboard handling. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8426 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpganttview.pas | 250 ++++++++++++++---- .../tvplanit/source/vpganttviewpainter.pas | 15 +- 2 files changed, 209 insertions(+), 56 deletions(-) diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 65fe44c47..96a358bb3 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -110,6 +110,7 @@ type FDrawingStyle: TVpDrawingStyle; FDefaultPopup: TPopupMenu; FExternalPopup: TPopupMenu; + FShowActiveDate: Boolean; FOnAddEvent: TVpOnAddNewEvent; FOnDeletingEvent: TVpOnDeletingEvent; @@ -125,8 +126,10 @@ type 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); @@ -135,6 +138,7 @@ type procedure SetLeftCol(AValue: Integer); procedure SetLineColor(AValue: TColor); procedure SetPopupMenu(AValue: TPopupMenu); + procedure SetShowActiveDate(AValue: Boolean); procedure SetTextMargin(AValue: Integer); procedure SetTopRow(AValue: Integer); @@ -148,11 +152,14 @@ type 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; @@ -191,7 +198,7 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure DeleteActiveEvent(Verify: Boolean); + procedure DeleteActiveEvent(Prompt: Boolean); procedure Init; procedure LoadLanguage; procedure LinkHandler(Sender: TComponent; @@ -205,10 +212,10 @@ type function CalcVisibleCols(AWidth: Integer): Integer; function CalcVisibleRows(AHeight: Integer): Integer; - property ActiveCol: Integer read FActiveCol; + 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; + property ActiveRow: Integer read FActiveRow write SetActiveRow; property StartDate: TDateTime read FStartDate write FStartDate; property EndDate: TDateTime read FEndDate write FEndDate; property ColCount: Integer read FColCount write FColCount; @@ -249,6 +256,7 @@ type 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 ShowActiveDate: Boolean read FShowActiveDate write SetShowActiveDate default true; property TextMargin: Integer read FTextMargin write SetTextMargin default 2; // inherited events property OnClick; @@ -381,6 +389,7 @@ begin SetActiveDate(Now); FStartDate := FActiveDate; + FShowActiveDate := true; FColWidth := DEFAULT_COLWIDTH; FFixedColWidth := 120; @@ -530,7 +539,7 @@ begin *) end; -procedure TVpGanttView.DeleteActiveEvent(Verify: Boolean); +procedure TVpGanttView.DeleteActiveEvent(Prompt: Boolean); var DoIt: Boolean; begin @@ -539,7 +548,7 @@ begin if (FActiveEvent <> nil) and (not FActiveEvent.CanEdit) then exit; - DoIt := not Verify; + DoIt := not Prompt; if FActiveEvent <> nil then begin if Assigned(FOnDeletingEvent) then @@ -547,7 +556,7 @@ begin DoIt := true; FOnDeletingEvent(self, FActiveEvent, DoIt); end else - if Verify then + if Prompt then DoIt := (MessageDlg(RSConfirmDeleteEvent + LineEnding2 + RSPermanent, mtConfirmation, [mbYes, mbNo], 0) = mrYes); @@ -621,6 +630,11 @@ begin Result.CY := 200; end; +function TVpGanttView.GetDateOfCol(ACol: Integer): TDateTime; +begin + Result := FStartDate + ACol; +end; + function TVpGanttView.GetDateTimeAtCoord(X: Integer): TDateTime; var days: double; @@ -694,6 +708,11 @@ begin end; end; +function TVpGanttView.GetEventOfRow(ARow: Integer): TVpEvent; +begin + Result := EventRecords[ARow].Event; +end; + function TVpGanttView.GetEventRec(AIndex: Integer): TVpGanttEventRec; begin Result := FEventRecords[AIndex]; @@ -785,50 +804,116 @@ begin PopulateEventRecords; end; -procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState); +function TVpGanttView.IsEventOnDate(AEvent: TVpEvent; ADate: TDateTime): Boolean; var - PopupPoint : TPoint; + 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; + +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_DELETE : ; //DeleteActiveEvent(true); - VK_RIGHT : if Shift = [ssShift] then - ScrollHorizontal(FVisibleCols) - else if Shift = [] then - ScrollHorizontal(1); - VK_LEFT : if Shift = [ssShift] then - ScrollHorizontal(-FVisibleCols) - else if Shift = [] then - ScrollHorizontal(-1); - VK_UP : if Shift = [ssShift] then - ScrollVertical(-FVisibleRows) - else if Shift = [] then - ScrollVertical(-1); - VK_DOWN : if Shift = [ssShift] then - ScrollVertical(FVisibleRows) - else - ScrollVertical(1); - (* - VK_INSERT : PopupAddEvent(Self); -{$IFNDEF LCL} - VK_TAB : - if ssShift in Shift then - Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False)) - else - Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True)); -{$ENDIF} - VK_F10: - if (ssShift in Shift) and not Assigned(PopupMenu) then begin - PopupPoint := GetClientOrigin; - FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); + 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_APPS: - if not Assigned (PopupMenu) then begin - PopupPoint := GetClientOrigin; - FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.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; @@ -849,13 +934,6 @@ 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; @@ -890,6 +968,9 @@ var begin inherited MouseDown(Button, Shift, X, Y); + if not Focused then + SetFocus; + FMouseDownPoint := Point(X, Y); FActiveCol := GetColAtCoord(X); FActiveRow := GetRowAtCoord(Y); @@ -1094,6 +1175,35 @@ begin Invalidate; end; +procedure TVpGanttView.SetActiveCol(AValue: Integer); +var + R, 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 @@ -1120,12 +1230,39 @@ begin begin FActiveRow := GetRowOfEvent(FActiveEvent); ScrollRowIntoView(FActiveRow); - SetActiveDate(FActiveEvent.StartTime); end; UpdatePopupMenu; end; end; +procedure TVpGanttView.SetActiveRow(AValue: Integer); +var + R, 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 @@ -1223,6 +1360,15 @@ begin SetScrollInfo(Handle, SB_HORZ, scrollInfo, True); end; +procedure TVpGanttView.SetShowActiveDate(AValue: Boolean); +begin + if FShowActiveDate <> AValue then + begin + FShowActiveDate := AValue; + Invalidate; + end; +end; + procedure TVpGanttView.SetTextMargin(AValue: Integer); begin if FTextMargin <> AValue then diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index fc6a33252..446bf7668 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -28,7 +28,7 @@ type protected procedure Clear; - procedure DrawActiveDay; + procedure DrawActiveDate; procedure DrawBorders; procedure DrawColHeader; procedure DrawEvents; @@ -66,7 +66,7 @@ begin RenderCanvas.FillRect(RenderIn); end; -procedure TVpGanttViewPainter.DrawActiveDay; +procedure TVpGanttViewPainter.DrawActiveDate; var R: TRect; dayRec: TVpGanttDayRec; @@ -94,10 +94,16 @@ begin ); OffsetRect(R, -dx, -dy); + if R.Top < FGanttView.TotalColHeaderHeight then + exit; + pw := RenderCanvas.Pen.Width; bs := RenderCanvas.Brush.Style; RenderCanvas.Pen.Width := 3; - RenderCanvas.Pen.Color := clBlack; + if FGanttView.Focused then + RenderCanvas.Pen.Color := clBlack + else + RenderCanvas.Pen.Color := clGray; RenderCanvas.Brush.Style := bsClear; TPSRectangle(RenderCanvas, Angle, RenderIn, R); RenderCanvas.Pen.Width := pw; @@ -509,7 +515,8 @@ begin DrawEvents; { Draw active day rectangle } - DrawActiveDay; + if FGanttView.ShowActiveDate then + DrawActiveDate; { Draw the borders } DrawBorders;