diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index 46580fdd1..612ab0eeb 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/components/tvplanit/source/vpdayviewpainter.pas @@ -1816,11 +1816,11 @@ begin end; end; +{ DisplayOnly is poorly-named. It is false during screen output in the form, + it is true during printing and in print preview } procedure TVpDayViewPainter.RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean); -{wp: DisplayOnly is poorly-named. It is false during screen output in the form, - it is true during printing and in print preview } begin inherited; diff --git a/components/tvplanit/source/vpganttview.pas b/components/tvplanit/source/vpganttview.pas index 17f7173a0..011325fed 100644 --- a/components/tvplanit/source/vpganttview.pas +++ b/components/tvplanit/source/vpganttview.pas @@ -5,18 +5,80 @@ unit VpGanttView; interface uses - Classes, SysUtils, Graphics, - VpBase, VpBaseDS, VpData; + Classes, SysUtils, Graphics, Types, + VpConst, VpBase, VpBaseDS, VpData; type + TVpGanttView = class; + + TVpGanttHeaderAttributes = class(TPersistent) + private + FGanttView: TVpGanttView; + FColor: TColor; + procedure SetColor(AValue: TColor); + protected + procedure FontChanged(Sender: TObject); + procedure UpdateGanttView; + public + constructor Create(AOwner: TVpGanttView); virtual; + published + property Color: TColor read FColor write SetColor default clBtnFace; + end; + + TVpGanttRowHeaderAttributes = class(TVpGanttHeaderAttributes) + private + FEventFont: TFont; + procedure SetEventFont(AValue: TFont); + protected + public + constructor Create(AOwner: TVpGanttView); override; + destructor Destroy; override; + published + property EventFont: TFont read FEventFont write SetEventFont; + end; + + TVpGanttColHeaderAttributes = class(TVpGanttHeaderAttributes) + private + FDayFont: TFont; + FMonthFont: TFont; + procedure SetDayFont(AValue: TFont); + procedure SetMonthFont(AValue: TFont); + public + constructor Create(AOwner: TVpGanttView); override; + destructor Destroy; override; + published + property DayFont: TFont read FDayFont write SetDayFont; + property MonthFont: TFont read FMonthFont write SetMonthFont; + end; + TVpGanttView = class(TVpLinkableControl) private - FDate: TDateTime; + FDate: TDateTime; // Selected date + FStartDate: TDateTime; // Date of the first event + FEndDate: TDateTime; // Date of the last event + FLeftDate: TDateTime; // Date of the left-most event (after scrolling > FStartDate) + FInLinkHandler: Boolean; FLoaded: Boolean; FPainting: Boolean; - FStartDate: TDateTime; + + FColWidth: Integer; + FFixedColWidth: Integer; + + FColor: TColor; + FLineColor: TColor; + + FColHeaderAttributes: TVpGanttColHeaderAttributes; + FRowHeaderAttributes: TVpGanttRowHeaderAttributes; + + FDrawingStyle: TVpDrawingStyle; + + procedure SetColor(Value: TColor); reintroduce; + procedure SetColWidth(AValue: Integer); procedure SetDate(AValue: TDateTime); + procedure SetDrawingStyle(AValue: TVpDrawingStyle); + procedure SetFixedColWidth(AValue: Integer); + procedure SetLineColor(Value: TColor); protected { internal methods } @@ -24,11 +86,13 @@ type procedure Populate; { inherited methods } + class function GetControlClassDefaultSize: TSize; override; procedure Loaded; override; procedure Paint; override; public constructor Create(AOwner: TComponent); override; + destructor Destroy; override; procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); override; procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; @@ -39,6 +103,13 @@ type property Date: TDateTime read FDate write SetDate; published + property ColHeaderAttributes: TVpGanttColHeaderAttributes read FColHeaderAttributes write FColHeaderAttributes; + property Color: TColor read FColor write SetColor default DEFAULT_COLOR; + property ColWidth: Integer read FColWidth write SetColWidth default 32; + property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d; + property FixedColWidth: Integer read FFixedColWidth write SetFixedColWidth default 120; + property LineColor: TColor read FLineColor write SetLineColor default DEFAULT_LINECOLOR; + property RowHeaderAttributes: TVpGanttRowHeaderAttributes read FRowHeaderAttributes write FRowHeaderAttributes; end; @@ -47,6 +118,104 @@ implementation uses VpGanttViewPainter; +{******************************************************************************} +{ TVpGanttHeaderAttributes } +{******************************************************************************} +constructor TVpGanttHeaderAttributes.Create(AOwner: TVpGanttView); +begin + inherited Create; + FGanttView := AOwner; + FColor := clBtnFace; +end; + +procedure TVpGanttHeaderAttributes.FontChanged(Sender: TObject); +begin + UpdateGanttView; +end; + +procedure TVpGanttHeaderAttributes.SetColor(AValue: TColor); +begin + if FColor <> AValue then + begin + FColor := AValue; + UpdateGanttView; + end; +end; + +procedure TVpGanttHeaderAttributes.UpdateGanttView; +begin + if Assigned(FGanttView) then + FGanttView.Invalidate; +end; + + +{******************************************************************************} +{ TVpGanttRowHeaderAttributes } +{******************************************************************************} +constructor TVpGanttRowHeaderAttributes.Create(AOwner: TVpGanttView); +begin + inherited Create(AOwner); + FEventFont := TFont.Create; + FEventFont.OnChange := @FontChanged; +end; + +destructor TVpGanttRowHeaderAttributes.Destroy; +begin + FEventFont.Free; + inherited; +end; + +procedure TVpGanttRowHeaderAttributes.SetEventFont(AValue: TFont); +begin + if FEventFont <> AValue then + begin + FEventFont := AValue; + UpdateGanttView; + end; +end; + + +{******************************************************************************} +{ TVpGanttColHeaderAttributes } +{******************************************************************************} +constructor TVpGanttColHeaderAttributes.Create(AOwner: TVpGanttView); +begin + inherited Create(AOwner); + FDayFont := TFont.Create; + FDayFont.OnChange := @FontChanged; + FMonthFont := TFont.Create; + FMonthFont.OnChange := @FontChanged; +end; + +destructor TVpGanttColHeaderAttributes.Destroy; +begin + FDayFont.Free; + FMonthFont.Free; + inherited; +end; + +procedure TVpGanttColHeaderAttributes.SetDayFont(AValue: TFont); +begin + if FDayFont <> AValue then + begin + FDayFont := AValue; + UpdateGanttView; + end; +end; + +procedure TVpGanttColHeaderAttributes.SetMonthFont(AValue: TFont); +begin + if FMonthFont <> AValue then + begin + FMonthFont := AValue; + UpdateGanttView; + end; +end; + + +{******************************************************************************} +{ TVpGanttView } +{******************************************************************************} constructor TVpGanttView.Create(AOwner: TComponent); begin inherited; @@ -57,6 +226,33 @@ begin SetDate(Now); FStartDate := FDate; + + FColWidth := 32; + FFixedColWidth := 120; + + FColor := DEFAULT_COLOR; + FLineColor := DEFAULT_LINECOLOR; + + FRowHeaderAttributes := TVpGanttRowHeaderAttributes.Create(self); + FColHeaderAttributes := TVpGanttColHeaderAttributes.Create(self); + + FDrawingStyle := ds3d; + + with GetControlClassDefaultSize do + SetInitialBounds(0, 0, CX, CY); +end; + +destructor TVpGanttView.Destroy; +begin + FRowHeaderAttributes.Free; + FColHeaderAttributes.Free; + inherited; +end; + +class function TVpGanttView.GetControlClassDefaultSize: TSize; +begin + Result.CX := 300; + Result.CY := 200; end; { If the component is being dropped on a form at designtime, then @@ -134,6 +330,23 @@ begin end; end; +procedure TVpGanttView.SetColor(Value: TColor); +begin + if FColor <> Value then begin + FColor := Value; + Invalidate; + end; +end; + +procedure TVpGanttView.SetColWidth(AValue: Integer); +begin + if FColWidth <> AValue then + begin + FColWidth := AValue; + Invalidate; + end; +end; + procedure TVpGanttView.SetDate(AValue: TDateTime); begin if FDate <> AValue then begin @@ -156,5 +369,30 @@ begin end; end; +procedure TVpGanttView.SetDrawingStyle(AValue: TVpDrawingStyle); +begin + if FDrawingStyle <> AValue then begin + FDrawingStyle := AValue; + Invalidate; + end; +end; + +procedure TVpGanttView.SetFixedColWidth(AValue: Integer); +begin + if FFixedColWidth <> AValue then + begin + FFixedColWidth := AValue; + Invalidate; + end; +end; + +procedure TVpGanttView.SetLineColor(Value: TColor); +begin + if FLineColor <> Value then begin + FLineColor := Value; + Repaint; + end; +end; + end. diff --git a/components/tvplanit/source/vpganttviewpainter.pas b/components/tvplanit/source/vpganttviewpainter.pas new file mode 100644 index 000000000..0a2afc8c9 --- /dev/null +++ b/components/tvplanit/source/vpganttviewpainter.pas @@ -0,0 +1,281 @@ +unit VpGanttViewPainter; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, LCLType, LCLIntf, Types, + VpBase, VpBasePainter, VpGanttView; + +type + TVpGanttViewPainter = class(TVpBasePainter) + private + FGanttView: TVpGanttView; + + BevelHighlight: TColor; + BevelShadow: TColor; + BevelDarkShadow: TColor; + BevelFace: TColor; + RealColHeadAttrColor: TColor; + RealColor: TColor; + RealLineColor: TColor; + RealRowHeadAttrColor: TColor; + + FColHeadRowHeight: Integer; + FRowHeight: Integer; + + protected + procedure Clear; + procedure DrawBorders; + procedure DrawColHeader; + procedure DrawGrid; + procedure DrawRowHeader; + procedure FixFontHeights; + procedure InitColors; + procedure SetMeasurements; override; + + public + constructor Create(AGanttView: TVpGanttView; ARenderCanvas: TCanvas); + procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; + AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; + AUseGran: TVpGranularity; ADisplayOnly: Boolean); override; + + end; + + +implementation + +uses + Grids, + VpMisc, VpCanvasUtils; + +constructor TVpGanttViewPainter.Create(AGanttView: TVpGanttView; + ARenderCanvas: TCanvas); +begin + inherited Create(ARenderCanvas); + FGanttView := AGanttView; +end; + +procedure TVpGanttViewPainter.Clear; +begin + RenderCanvas.Brush.Color := RealColor; + RenderCanvas.FillRect(RenderIn); +end; + +procedure TVpGanttViewPainter.DrawBorders; +var + R: TRect; +begin + R := Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1); + + case FGanttView.DrawingStyle of + dsFlat: // Draw a simple rectangular border + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, R), + BevelShadow, + BevelShadow + ); + ds3D: // Draw a 3d bevel + begin + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, R), + BevelShadow, + BevelHighlight + ); + InflateRect(R, -1, -1); + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, R), + BevelDarkShadow, + BevelFace + ); + end; + end; +end; + +procedure TVpGanttViewPainter.DrawColHeader; +var + headRect: TRect; +begin + RenderCanvas.Brush.Color := RealColHeadAttrColor; + + if FGanttView.DrawingStyle = ds3d then begin + // Draw a 3d bevel + headRect.Left := RealLeft + 2; + headRect.Top := RealTop + 2; + headRect.Right := RealLeft + FGanttView.FixedColWidth; // RealRight - 3; + headRect.Bottom := RealTop + FColHeadRowHeight; + TPSFillRect(RenderCanvas, Angle, RenderIn, headRect); + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, headRect), + BevelHighlight, + BevelDarkShadow + ); + headRect.Left := headRect.Right + 1; + headRect.Right := RealRight - 3; + TPSFillRect(RenderCanvas, Angle, RenderIn, headRect); + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, headRect), + BevelHighlight, + BevelDarkShadow + ); + end else begin + // Draw simple border rectangle + headRect := Rect(RealLeft, RealTop, RealRight, RealTop + FColHeadRowHeight-1); + TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect); + RenderCanvas.Pen.Color := RealLineColor; + RenderCanvas.Line(headRect.Left, headRect.Bottom, headRect.Right, headRect.Bottom); + headRect.Left := headRect.Left + FGanttView.FixedColWidth; + RenderCanvas.Line(headRect.Left, headRect.Top, headRect.Left, headRect.Bottom); + end; +end; + +procedure TVpGanttViewPainter.DrawGrid; +var + x1, x2, y1, y2: Integer; +begin + exit; + RenderCanvas.Pen.Color := RealLineColor; + + x1 := RenderIn.Left; + x2 := RenderIn.Right; + y1 := RenderIn.Top + FColHeadRowHeight; + y2 := y1; + RenderCanvas.Line(x1, y1, x2, y2); + + x1 := RenderIn.Left + FGanttView.FixedColWidth; + x2 := x1; + y1 := RenderIn.Top; + y2 := RenderIn.Bottom; + RenderCanvas.Line(x1, y1, x2, y2); +end; + +procedure TVpGanttViewPainter.DrawRowHeader; +var + headRect: TRect; +begin + RenderCanvas.Brush.Color := RealRowHeadAttrColor; + + if FGanttView.DrawingStyle = ds3d then begin + // Draw a 3d bevel + headRect.Left := RealLeft + 2; + headRect.Top := RealTop + FColHeadRowHeight + 1; + headRect.Right := RealLeft + FGanttView.FixedColWidth; + headRect.Bottom := RealBottom - 3; + TPSFillRect(RenderCanvas, Angle, RenderIn, headRect); + DrawBevelRect( + RenderCanvas, + TPSRotateRectangle(Angle, RenderIn, headRect), + BevelHighlight, + BevelDarkShadow + ); + end else begin + // Draw simple border rectangle + headRect := Rect(RealLeft, RealTop + FColHeadRowHeight, RealLeft + FGanttView.FixedColWidth, RealBottom); + TPSFillRect(RenderCanvas, Angle, RenderIn, HeadRect); + RenderCanvas.Pen.Color := RealLineColor; + RenderCanvas.Line(headRect.Right, headRect.Top, headrect.Right, headRect.Bottom); + end; +end; + +procedure TVpGanttViewPainter.FixFontHeights; +begin + with FGanttView do begin + ColHeaderAttributes.DayFont.Height := GetRealFontHeight(ColHeaderAttributes.DayFont); + ColHeaderAttributes.MonthFont.Height := GetRealFontHeight(ColHeaderAttributes.MonthFont); + RowHeaderAttributes.EventFont.Height := GetRealFontHeight(RowHeaderAttributes.EventFont); + end; +end; + +procedure TVpGanttViewPainter.InitColors; +begin + if DisplayOnly then begin + BevelShadow := clBlack; + BevelDarkShadow := clBlack; + BevelFace := clBlack; + RealColHeadAttrColor := clSilver; + RealRowHeadAttrColor := clSilver; + RealColor := clWhite; + RealLineColor := clSilver; + end else + begin + BevelHighlight := clBtnHighlight; + BevelShadow := clBtnShadow; + BevelDarkShadow := cl3DDkShadow; + BevelFace := clBtnFace; + RealColHeadAttrColor := ColorToRGB(FGanttView.ColHeaderAttributes.Color); + RealRowHeadAttrColor := ColorToRGB(FGanttView.RowHeaderAttributes.Color); + RealColor := ColorToRGB(FGanttView.Color); + RealLineColor := ColorToRGB(FGanttView.LineColor); + end; +end; + +procedure TVpGanttViewPainter.RenderToCanvas(ARenderIn: TRect; + AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; + AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; + ADisplayOnly: Boolean); +begin + inherited; + + InitColors; + SavePenBrush; + InitPenBrush; + if ADisplayOnly then + FixFontHeights; + + Rgn := CreateRectRgn(RenderIn.Left, RenderIn.Top, RenderIn.Right, RenderIn.Bottom); + try + SelectClipRgn(RenderCanvas.Handle, Rgn); + + { Clear client area } + Clear; + + { Measure the row heights } + SetMeasurements; + + { Draw headers } + DrawColHeader; + DrawRowHeader; + + { Draw grid } + DrawGrid; + + { draw days } + //DrawDays; + + { Draw the borders } + DrawBorders; + + finally + SelectClipRgn(RenderCanvas.Handle, 0); + DeleteObject(Rgn); + end; + + { Restore canvas settings} + RestorePenBrush; + + //RenderCanvas.Textout(0, 0, FormatDateTime('c', ARenderDate)); + //RenderCanvas.TextOut(0, 20, FormatDateTime('c', FGanttView.Date)); +end; + +procedure TVpGanttViewPainter.SetMeasurements; +begin + inherited; + + RenderCanvas.Font.Assign(FGanttView.RowHeaderAttributes.EventFont); + FRowHeight := RenderCanvas.TextHeight('Tg') + 2 * varCellPadding; + + RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.MonthFont); + FColHeadRowHeight := RenderCanvas.TextHeight('Tg') + 2 * varCellPadding; + + RenderCanvas.Font.Assign(FGanttView.ColHeaderAttributes.DayFont); + FColHeadRowHeight := FColHeadRowHeight + RenderCanvas.TextHeight('Tg') + varCellPadding; +end; + +end. +