diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 3acbc4f30..d6ddfb1ad 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -5,7 +5,7 @@ unit VpGanttView; interface uses - Classes, SysUtils, Graphics, Types, + LCLType, LCLIntf, LMessages, Classes, SysUtils, Graphics, Types, StdCtrls, VpConst, VpBase, VpBaseDS, VpData; type @@ -75,6 +75,14 @@ type FEndDate: TDateTime; // Date of the last event FLeftDate: TDateTime; // Date of the left-most event (after scrolling > FStartDate) + FLeftCol: Integer; // Index of the left-most day column + FTopRow: Integer; // Index of the top-most event row + FVisibleCols: Integer; + FVisibleRows: Integer; + FRowCount: Integer; + FColCount: Integer; + FScrollBars: TScrollStyle; + FInLinkHandler: Boolean; FLoaded: Boolean; FPainting: Boolean; @@ -100,7 +108,9 @@ type procedure SetDateFormat(AIndex: Integer; AValue: String); procedure SetDrawingStyle(AValue: TVpDrawingStyle); procedure SetFixedColWidth(AValue: Integer); - procedure SetLineColor(Value: TColor); + procedure SetLeftCol(AValue: Integer); + procedure SetLineColor(AValue: TColor); + procedure SetTopRow(AValue: Integer); protected // Needed by the painter @@ -111,12 +121,22 @@ type { internal methods } procedure Hookup; procedure Populate; + procedure ScrollHorizontal(ANumCols: Integer); + procedure ScrollVertical(ANumRows: Integer); + procedure SetHScrollPos; + procedure SetVScrollPos; { inherited methods } + procedure CreateParams(var AParams: TCreateParams); override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; class function GetControlClassDefaultSize: TSize; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Loaded; override; procedure Paint; override; procedure Resize; override; + procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; + procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; public constructor Create(AOwner: TComponent); override; @@ -131,6 +151,12 @@ type property Date: TDateTime read FDate write SetDate; property StartDate: TDateTime read FStartDate write FStartDate; property EndDate: TDateTime read FEndDate write FEndDate; + property ColCount: Integer read FColCount write FColCount; + property RowCount: Integer read FRowCount write FRowCount; + property VisibleCols: Integer read FVisibleCols write FVisibleCols; + property VisibleRows: Integer read FVisibleRows write FVisibleRows; + property LeftCol: Integer read FLeftCol write SetLeftCol; + property TopRow: Integer read FTopRow write SetTopRow; published property Align; @@ -284,6 +310,8 @@ begin FDateFormat[1] := DEFAULT_MONTHFORMAT; FDateFormat[2] := DEFAULT_MONTHFORMAT_SHORT; + FScrollBars := ssBoth; + with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); end; @@ -295,6 +323,47 @@ begin inherited; end; +procedure TVpGanttView.CreateParams(var AParams: TCreateParams); +begin + inherited CreateParams(AParams); + with AParams do + begin + Style := Style or WS_TABSTOP; + if FScrollBars in [ssVertical, ssBoth, ssAutoVertical, ssAutoBoth] then + Style := Style or WS_VSCROLL; + if FScrollBars in [ssHorizontal, ssBoth, ssAutoHorizontal, ssAutoBoth] then + Style := Style or WS_HSCROLL; + end; +end; + +function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + Result := inherited DoMouseWheelDown(Shift, MousePos); + if not Result then begin + if Shift = [] then + ScrollVertical(1) + else if Shift = [ssCtrl] then + ScrollHorizontal(1) + else + exit; + Result := True; + end; +end; + +function TVpGanttView.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + Result := inherited DoMouseWheelUp(Shift, MousePos); + if not Result then begin + if Shift = [] then + ScrollVertical(-1) + else if Shift = [ssCtrl] then + ScrollHorizontal(-1) + else + exit; + Result := True; + end; +end; + class function TVpGanttView.GetControlClassDefaultSize: TSize; begin Result.CX := 300; @@ -321,6 +390,51 @@ begin end; end; +procedure TVpGanttView.KeyDown(var Key: Word; Shift: TShiftState); +var + PopupPoint : TPoint; +begin + 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); + end; + VK_APPS: + if not Assigned (PopupMenu) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); + end; + *) + end; +end; + function TVpGanttView.IsStoredColWidth: Boolean; begin Result := FColWidth <> DEFAULT_COLWIDTH; @@ -376,6 +490,8 @@ begin gr30Min, // Granularity False // Display Only ); + SetVScrollPos; + SetHScrollPos; end; procedure TVpGanttView.RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; @@ -401,6 +517,18 @@ begin Invalidate; end; +procedure TVpGanttView.ScrollHorizontal(ANumCols: Integer); +begin + FLeftCol := FLeftCol + ANumCols; + Invalidate; +end; + +procedure TVpGanttView.ScrollVertical(ANumRows: Integer); +begin + TopRow := FTopRow + ANumRows; + Invalidate; +end; + procedure TVpGanttView.SetColor(Value: TColor); begin if FColor <> Value then begin @@ -467,13 +595,137 @@ begin end; end; -procedure TVpGanttView.SetLineColor(Value: TColor); +procedure TVpGanttView.SetLeftCol(AValue: Integer); begin - if FLineColor <> Value then begin - FLineColor := Value; + if AValue <> FLeftCol then begin + if AValue + FVisibleCols > FColCount then begin + FLeftCol := FColCount - FVisibleCols - 1; + if FLeftCol < 0 then + FLeftCol := 0; + // Prevent the control from hanging at the right + if (AValue < FLeftCol) and (AValue > 0) then + FLeftCol := AValue; + end + else if AValue < 0 then + FLeftCol := 0 + else + FLeftCol := AValue; + Invalidate; + SetHScrollPos; + end; +end; + +procedure TVpGanttView.SetLineColor(AValue: TColor); +begin + if FLineColor <> AValue then begin + FLineColor := AValue; Repaint; end; end; +procedure TVpGanttView.SetHScrollPos; +var + SI: TScrollInfo; +begin + if not HandleAllocated then + Exit; + with SI do + begin + cbSize := SizeOf(SI); + fMask := SIF_RANGE or SIF_PAGE or SIF_POS; + nMin := 0; + nMax := FColCount; + if FVisibleCols >= FColCount then + nPage := nMax + else + nPage := FVisibleCols; + if FLeftCol = pred(ColCount) - VisibleCols then + nPos := ColCount + else + nPos := FLeftCol; + nTrackPos := nPos; + end; + SetScrollInfo(Handle, SB_HORZ, SI, True); +end; + +procedure TVpGanttView.SetTopRow(AValue: Integer); +begin + if AValue <> FTopRow then begin + if AValue + FVisibleRows > RowCount then begin + FTopRow := FRowCount - FVisibleRows - 1; + if FTopRow < 0 then + FTopRow := 0; + // Prevent the control from hanging at the bottom + if (AValue < FTopRow) and (AValue > 0) then + FTopRow := AValue; + end + else if AValue < 0 then + FTopRow := 0 + else + FTopRow:= AValue; + Invalidate; + SetVScrollPos; + end; +end; + +procedure TVpGanttView.SetVScrollPos; +var + SI: TScrollInfo; +begin + if not HandleAllocated then + Exit; + with SI do + begin + cbSize := SizeOf(SI); + fMask := SIF_RANGE or SIF_PAGE or SIF_POS; + nMin := 0; + nMax := FRowCount; + if FVisibleRows >= FRowCount then + nPage := nMax + else + nPage := FVisibleRows; + if FTopRow = pred(RowCount) - VisibleRows then + nPos := RowCount + else + nPos := FTopRow; + nTrackPos := nPos; + end; + SetScrollInfo(Handle, SB_VERT, SI, True); +end; + +procedure TVpGanttView.WMHScroll(var Msg: TLMHScroll); +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 + SB_LINELEFT : ScrollHorizontal(-1); + SB_LINERIGHT : ScrollHorizontal(1); + SB_PAGELEFT : ScrollHorizontal(-FVisibleCols); + SB_PAGERIGHT : ScrollHorizontal(FVisibleCols); + SB_THUMBPOSITION, SB_THUMBTRACK : FLeftCol := Msg.Pos; + end; +end; + +procedure TVpGanttView.WMVScroll(var Msg: TLMVScroll); +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 + SB_LINEUP : ScrollVertical(-1); + SB_LINEDOWN : ScrollVertical(1); + SB_PAGEUP : ScrollVertical(-FVisibleRows); + SB_PAGEDOWN : ScrollVertical(FVisibleRows); + SB_THUMBPOSITION, SB_THUMBTRACK : FTopRow := Msg.Pos; + end; +end; + end. diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas index ffe8bfdd5..cff893310 100644 --- a/components/tvplanit/source/vpganttviewpainter.pas +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -78,7 +78,8 @@ var dt: TDateTime; begin if ADate1 > ADate2 then - raise Exception.Create('[TVpGanttViewPainter.CountMonts] Dates not in order.'); + exit; +// raise Exception.Create('[TVpGanttViewPainter.CountMonts] Dates not in order.'); Result := 0; dt := ADate1; @@ -135,6 +136,7 @@ var dayRec: TVpGanttDayRec; str: String; strLen, strH: Integer; + dx: Integer; begin RenderCanvas.Brush.Color := RealColHeadAttrColor; RenderCanvas.Pen.Color := RealLineColor; @@ -169,12 +171,16 @@ begin TPSLineTo(RenderCanvas, Angle, RenderIn, RealRight, R.Bottom); end; + dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth; + // Draw month rectangles and month captions for i := 0 to High(TVpGanttViewOpener(FGanttView).FMonthRecords) do begin monthRec := TVpGanttViewOpener(FGanttView).FMonthRecords[i]; R := monthRec.Rect; - OffsetRect(R, FGanttView.FixedColWidth, 0); + OffsetRect(R, dx , 0); + if R.Left < FGanttView.FixedColWidth then + R.Left := FGanttView.FixedColWidth; if FGanttView.DrawingStyle = ds3D then begin R1 := R; @@ -215,7 +221,9 @@ begin for dayRec in TVpGanttViewOpener(FGanttView).FDayRecords do begin R := dayRec.Rect; - OffsetRect(R, FGanttView.FixedColWidth, 0); + OffsetRect(R, dx, 0); + if R.Left < FGanttView.FixedColWidth then + Continue; if (DayOf(dayRec.Date) <> DaysInMonth(dayRec.Date)) then begin if FGanttView.DrawingStyle = ds3D then @@ -246,7 +254,10 @@ var event: TVpEvent; cat: TVpCategoryInfo; R: TRect; + dx, dy: Integer; begin + dx := FGanttView.FixedColWidth - FGanttView.LeftCol * FGanttView.ColWidth; + dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight; for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do begin eventRec := TVpGanttViewOpener(FGanttView).FEventRecords[i]; @@ -256,8 +267,10 @@ begin RenderCanvas.Brush.Color := cat.BackgroundColor; R := eventRec.EventRect; if R.Left = R.Right then R.Right := R.Left + 1; - OffsetRect(R, FGanttView.FixedColWidth, FColHeadHeightTotal); + OffsetRect(R, dx, dy); InflateRect(R, 0, -2); + if (R.Top < FColHeadHeightTotal) or (R.Left < FGanttView.FixedColWidth) then + Continue; TPSRectangle(RenderCanvas, Angle, RenderIn, R); end; end; @@ -322,6 +335,7 @@ var strH: Integer; str: String; i: Integer; + dy: Integer; begin RenderCanvas.Brush.Color := RealRowHeadAttrColor; @@ -347,11 +361,14 @@ begin RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont); strH := RenderCanvas.TextHeight('Tg'); RenderCanvas.Pen.Color := RealLineColor; + dy := FColHeadHeightTotal - FGanttView.TopRow * FRowHeight; for i := 0 to High(TVpGanttViewOpener(FGanttView).FEventRecords) do begin str := TVpGanttViewOpener(FGanttView).FEventRecords[i].Caption; R := TVpGanttViewOpener(FGanttView).FEventRecords[i].HeadRect; - OffsetRect(R, 0, FColHeadHeightTotal); + OffsetRect(R, 0, dy); + if R.Top < FColHeadHeightTotal then + Continue; if FGanttView.DrawingStyle = ds3D then begin R.BottomRight := R.BottomRight - Point(1, 1); @@ -490,6 +507,8 @@ begin SetLength(TVpGanttViewOpener(FGanttView).FEventRecords, 0); SetLength(TVpGanttViewOpener(FGanttView).FDayRecords, 0); SetLength(TVpGanttViewOpener(FGanttView).FMonthRecords, 0); + FGanttView.VisibleRows := 0; + FGanttView.VisibleCols := 0; end else begin eventCount := FGanttView.Datastore.Resource.Schedule.EventCount; @@ -516,6 +535,7 @@ begin lastDay := trunc(t2); end; lastDay := lastDay + 1; + FGanttView.StartDate := firstDay; FGanttView.EndDate := lastDay; @@ -597,6 +617,11 @@ begin dt := IncMonth(dt, 1); x1 := x2; end; + + FGanttView.VisibleCols := (RealRight - RealLeft + FGanttView.FixedColWidth) div FGanttView.ColWidth; + FGanttView.VisibleRows := (RealBottom - RealTop + FColHeadHeightTotal) div FRowHeight; + FGanttView.RowCount := eventCount; + FGanttView.ColCount := numdays; end; end;