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

@@ -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_LEFT:
-    VK_RIGHT  : if Shift = [ssShift] then
+      ScrollCols(-1);
-                  ScrollHorizontal(FVisibleCols)
+    VK_RIGHT:
-                else if Shift = [] then
+      ScrollCols(1);
-                  ScrollHorizontal(1);
+    VK_DOWN:
-    VK_LEFT   : if Shift = [ssShift] then
+      ScrollRows(1);
-                  ScrollHorizontal(-FVisibleCols)
+    VK_UP:
-                else if Shift = [] then
+      ScrollRows(-1);
-                  ScrollHorizontal(-1);
+    VK_HOME:
-    VK_UP     : if Shift = [ssShift] then
+      if Shift = [ssCtrl] then
-                  ScrollVertical(-FVisibleRows)
+      begin
-                else if Shift = [] then
+        ActiveCol := 0;
-                  ScrollVertical(-1);
+        FLeftCol := 0;
-    VK_DOWN   : if Shift = [ssShift] then
+      end else
-                  ScrollVertical(FVisibleRows)
+      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_RETURN:
+      PopupEditEvent(Self);
+    VK_INSERT:
+      PopupAddEvent(Self);
+    VK_DELETE:
+      DeleteActiveEvent(true);
     else
-                  ScrollVertical(1);
+      exit;
-    (*
-    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);
-      end;
-    VK_APPS:
-      if not Assigned (PopupMenu) then begin
-        PopupPoint := GetClientOrigin;
-        FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
-      end;
-      *)
   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

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;