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

tvplanit/TvpGanttView: Keyboard handling.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8426 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-08-29 21:25:03 +00:00
parent 89b96e9392
commit 3de78ed971
2 changed files with 209 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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

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

@ -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;