tvplanit: Add missing vpganttviewpainter unit. Draw basic column and row header areas for TVpGanttView.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8417 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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.
+