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

components/tvplanit/source/vpganttview.pas

@@ -5,18 +5,80 @@ unit VpGanttView;
 interface
 
 uses
-  Classes, SysUtils, Graphics,
+  Classes, SysUtils, Graphics, Types,
-  VpBase, VpBaseDS, VpData;
+  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.
 

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