lazarus-ccr/components/tvplanit/source/vpcontactgridpainter.pas

unit VpContactGridPainter;

{$I vp.inc}

interface

uses
  LCLType, LCLIntf, SysUtils,
  Types, Classes, Graphics,
  VpConst, VPBase, VpData, VpBasePainter, VpContactGrid;

type
  TVpContactGridPainter = class(TVpBasePainter)
  private
    FContactGrid: TVpContactGrid;
    FLabelWidth: Integer;
    FScaledTextMargin: Integer;
    FAnchorMargin: Integer;
    FTextColWidth: Integer;

    // local variables of the original TVpContactGrid method
//    PhoneLblWidth: Integer;
    StartContact: Integer;
    RealColumnWidth: Integer;
    RealColor: TColor;
    SizingBarColor: TColor;
    BevelDarkShadow: TColor;
    BevelShadow: TColor;
    BevelHighlight: TColor;
    BevelFace: TColor;
    RealBarColor: TColor;
    RealContactHeadAttrColor: TColor;

    function CalcHeaderRect(ABitmap: TBitmap): TRect;
    function CalcInitialAnchor(ABitmap: TBitmap): TPoint;
    function CalcLabelWidth(ABitmap: TBitmap): Integer;
    procedure CalcNextColumnAnchor(ABitmap: TBitmap; const AWholeRect: TRect;
      var Anchor: TPoint);
    function GetTextColWidth(ABitmap: TBitmap): Integer;
    function NewColumnNeeded(AWholeRect: TRect; Anchor: TPoint): Boolean;
    function NewPageNeeded(Anchor: TPoint): Boolean;

  protected
    procedure Clear;
    procedure DrawBorders;
    procedure DrawContactHeader(ABitmap: TBitmap; AContact: TVpContact;
      const ARect: TRect);
    procedure DrawContactRow(ABitmap: TBitmap; AText, ALabel: String;
      var AWholeRect, ATextRect: TRect);
    function DrawContactRows(ABitmap: TBitmap; AContact: TVpContact;
      var Anchor: TPoint; var AWholeRect: TRect; var ACol, ARecsInCol: Integer;
      var AContactRec: TVpContactRec): Boolean;
    procedure DrawContacts;
    procedure DrawVerticalBars;
    procedure FixFontHeights;
    procedure InitColors;
    procedure PaintContactBitmap(ABitmap: TBitmap; AContact: TVpContact;
      Anchor: TPoint; AWholeRect: TRect);
    procedure SetMeasurements; override;

  public
    constructor Create(AContactGrid: TVpContactGrid; ARenderCanvas: TCanvas);
    procedure RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle;
      AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer;
      AUseGran: TVpGranularity; ADisplayOnly: Boolean); override;
  end;


implementation

uses
  VpCanvasUtils, VpMisc, VpSR;

type
  TVpContactGridOpener = class(TVpContactGrid);

constructor TVpContactGridPainter.Create(AContactGrid: TVpContactGrid;
  ARenderCanvas: TCanvas);
begin
  inherited Create(ARenderCanvas);
  FContactGrid := AContactGrid;
end;

{ Calculates the bounding rectangle for the contact header. }
function TVpContactGridPainter.CalcHeaderRect(ABitmap: TBitmap): TRect;
var
  textHeight: Integer;
  margin, half_margin: Integer;
begin
  ABitmap.Canvas.Font.Assign(FContactGrid.ContactHeadAttributes.Font);
  ABitmap.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch;
  {$IF VP_LCL_SCALING = 0}
  ABitmap.Canvas.Font.Size := ScaleY(ABitmap.Canvas.Font.Size, DesignTimeDPI);
  {$ENDIF}

  textHeight := ABitmap.Canvas.TextHeight(VpProductName);
  margin := FScaledTextMargin;
  half_margin := FScaledTextMargin div 2;

  case Angle of
    ra0:
      Result := Rect(0, 0, ABitmap.Width, textHeight + half_margin);
    ra90:
      Result := Rect(ABitmap.Width - textHeight - half_margin, 0, ABitmap.Width, ABitmap.Height);
    ra180:
      Result := Rect(margin, ABitmap.Height - textheight - margin, ABitmap.Width, ABitmap.Height - half_margin);
    ra270:
      Result := Rect(0, margin, 3 * half_margin + textHeight, ABitmap.Height);
  end;
end;

function TVpContactGridPainter.CalcInitialAnchor(ABitmap: TBitmap): TPoint;
begin
  case Angle of
    ra0, ra90:
      Result := Point(FAnchorMargin, FAnchorMargin);
    ra180:
      Result := Point(WidthOf(RenderIn) - ABitmap.Width - FAnchorMargin, ABitmap.Height - FAnchorMargin);
    ra270:
      Result := Point(FAnchorMargin, HeightOf(RenderIn) - ABitmap.Height - FAnchorMargin);
  end;
end;

{ Calculates the width of the longest label in each row of the contact display. }
function TVpContactGridPainter.CalcLabelWidth(ABitmap: TBitmap): Integer;
var
  s: String;
  i, w: Integer;
begin
  ABitmap.Canvas.Font.Assign(FContactGrid.Font);
  ABitmap.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch;
  {$IF VP_LCL_SCALING = 0}
  ABitmap.Canvas.Font.Size := ScaleY(ABitmap.Canvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  Result := ABitmap.Canvas.TextWidth(RSEmail);
  for i := 0 to 7 do begin
    s := PhoneLabel(TVpPhoneType(i)) + ': ';
    w := ABitmap.Canvas.TextWidth(s);
    if w > Result then
      Result := w;
  end;
end;

{ Calculates the anchor for the next column. AWholeRect is the rectangle of
  the last contact drawn in the previous column. }
procedure TVpContactGridPainter.CalcNextColumnAnchor(ABitmap: TBitmap;
  const AWholeRect: TRect; var Anchor: TPoint);
var
  colDist: Integer;
begin
  colDist := FContactGrid.BarWidth + 1 + FScaledTextMargin * 3;  // wp: why?
  case Angle of
    ra0:
      Anchor := Point(Anchor.x + AWholeRect.Right + colDist, FAnchorMargin);
    ra90:
      Anchor := Point(FAnchorMargin, Anchor.y + AWholeRect.Bottom + colDist);
    ra180:
      Anchor := Point(Anchor.x - (AWholeRect.Right + colDist), ABitmap.Height - FAnchorMargin);
    ra270:
      Anchor := Point(FAnchorMargin, Anchor.y - (AWholeRect.Bottom + colDist));
  end;
end;

procedure TVpContactGridPainter.Clear;
var
  I: Integer;
begin
  // Clear client area
  RenderCanvas.Brush.Color := RealColor;
  RenderCanvas.FillRect(RenderIn);

  // Clear the vertical bar array
  for I := 0 to pred(MaxColumns) do begin
    with TVpContactGridOpener(FContactGrid) do begin
      if cgBarArray[I].Index = -1 then
        Break;
      cgBarArray[I].Rec := Rect(-1, -1, -1, -1);
      cgBarArray[I].Index := -1;
    end;
  end;

  // Initialize the contact array at runtime
  if not (csDesigning in FContactGrid.ComponentState) and (FContactGrid.DataStore <> nil)
     and (FContactGrid.DataStore.Resource <> nil) then
  begin
    with TVpContactGridOpener(FContactGrid) do begin
      SetLength(cgContactArray, DataStore.Resource.Contacts.Count);
      for I := 0 to pred(Length(cgContactArray)) do
        with cgContactArray[I] do begin
          Index       := -1;
          Contact     := nil;
          WholeRect   := Rect(-1, -1, -1, -1);
          HeaderRect  := Rect(-1, -1, -1, -1);
          AddressRect := Rect(-1, -1, -1, -1);
          CSZRect     := Rect(-1, -1, -1, -1);
          Phone1Rect  := Rect(-1, -1, -1, -1);
          Phone2Rect  := Rect(-1, -1, -1, -1);
          Phone3Rect  := Rect(-1, -1, -1, -1);
          Phone4Rect  := Rect(-1, -1, -1, -1);
          Phone5Rect  := Rect(-1, -1, -1, -1);
        end;
    end;
  end;
end;

procedure TVpContactGridPainter.DrawBorders;
var
  R: TRect;
begin
  R := TPSRotateRectangle(Angle, RenderIn, Rect(RealLeft, RealTop, RealRight - 1, RealBottom - 1));
  case FContactGrid.DrawingStyle of
    dsNoBorder: ;
    dsFlat: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow);
    ds3D: DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight);
  end;
end;

procedure TVpContactGridPainter.DrawContactHeader(ABitmap: TBitmap;
  AContact: TVpContact; const ARect: TRect);
var
  textXOffset, textYOffset: Integer;
  maxTextWidth: Integer;
  s: String;
begin
  // Paint the header cell's background
  ABitmap.Canvas.Brush.Color := RealContactHeadAttrColor;
  ABitmap.Canvas.Brush.Style := bsSolid;
  ABitmap.Canvas.FillRect(ARect);

  // Paint the header cell's border
  if FContactGrid.ContactHeadAttributes.Bordered and (FContactGrid.DrawingStyle <> dsNoBorder)
  then begin
    ABitmap.Canvas.Pen.Color := BevelDarkShadow;
    ABitmap.Canvas.Pen.Style := psSolid;
    ABitmap.Canvas.Rectangle(ARect);
  end;

  // Paint the header cell's text
  case Angle of
    ra0:
      begin
        textXOffset := 0;
        textYOffset := 0;
        maxTextWidth := WidthOf(ARect);
      end;
    ra90:
      begin
        textXOffset := WidthOf(ARect) - FScaledTextMargin div 2;
        textYOffset := FScaledTextMargin div 3;
        maxTextWidth := HeightOf(ARect);
      end;
    ra180:
      begin
        textXOffset := WidthOf(ARect) - FScaledTextMargin;
        textYOffset := HeightOf(ARect) - FScaledTextMargin div 3;
        maxTextWidth := WidthOf(ARect);
      end;
    ra270:
      begin
        textXOffset := FScaledTextMargin div 2;
        textYOffset := HeightOf(ARect) - FScaledTextMargin div 3;
        maxTextWidth := HeightOf(ARect);
      end;
  end;

  // Set the header font
  ABitmap.Canvas.Font.Assign(FContactGrid.ContactHeadAttributes.Font);
  ABitmap.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch;
  {$IF VP_LCL_SCALING = 0}
  ABitmap.Canvas.Font.Size := ScaleY(ABitmap.Canvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  if FContactGrid.Focused and (AContact = FContactGrid.ActiveContact) then
    ABitmap.Canvas.Font.Style := [fsBold];

  // Assemble the header string...
  s := AssembleName(AContact);
  s := GetDisplayString(ABitmap.Canvas, s, 2, maxTextWidth - FScaledTextMargin);

  // ... and draw it using the header font.
  TPSTextOutAtPoint(
    ABitmap.Canvas,
    Angle,
    Rect(0, 0, ABitmap.Width, ABitmap.Height),
    ARect.Left + FScaledTextMargin div 2 + TextXOffset,
    ARect.Top + FScaledTextMargin div 3 + TextYOffset,
    s
  );
end;

{ Draw a row of the contact data: AText and its label ALabel.
  The row is at the bottom of the previously drawn rows.
  ATextRect returns the rectangle occupied by this row.
  AWholeRect is the rectangle occupied by the entire contact data including
  this row. }
procedure TVpContactGridPainter.DrawContactRow(ABitmap: TBitmap;
  AText, ALabel: String; var AWholeRect, ATextRect: TRect);
var
  txtheight: Integer;
  txtColWidth: Integer;
  txtPt: TPoint;
begin
  if AText = '' then begin
    ATextRect := Rect(0, 0, 0, 0);
    exit;
  end;

  txtHeight := ABitmap.Canvas.TextHeight(VpProductName) + FScaledTextMargin div 2;

  case Angle of
    ra0:
      begin
        ATextRect := Rect(FScaledTextMargin, AWholeRect.Bottom, AWholeRect.Right, AWholeRect.Bottom + txtHeight);
        AWholeRect.Bottom := ATextRect.Bottom;
        txtColWidth := ABitmap.Width;
        txtPt := ATextRect.TopLeft;
      end;
    ra90:
      begin
        ATextRect := Rect(AWholeRect.Left - txtHeight - 1, FScaledTextMargin, AWholeRect.Left - 1, AWholeRect.Bottom);
        AWholeRect.Left := ATextRect.Left;
        txtColWidth := ABitmap.Height;
        txtPt := Point(ATextRect.Right, ATextRect.Top);
      end;
    ra180:
      begin
        ATextRect := Rect(AWholeRect.Left, AWholeRect.Top - txtHeight, AWholeRect.Right - FScaledTextMargin, AWholeRect.Top);
        AWholeRect.Top := ATextRect.Top;
        txtColWidth := ABitmap.Width;
        txtPt := Point(ATextRect.Right, ATextRect.Bottom);
      end;
    ra270:
      begin
        ATextRect := Rect(AWholeRect.Right + 1, AWholeRect.Top, AWholeRect.Right + txtHeight + 1, AWholeRect.Bottom - FScaledTextMargin);
        txtPt := Point(ATextRect.Left, ATextRect.Bottom);
        AWholeRect.Right := ATextRect.Right;
        txtColWidth := ABitmap.Height;
      end;
  end;  // case Angle...

  AText := GetDisplayString(ABitmap.Canvas, AText, 2, txtColWidth - FScaledTextMargin * 2);

  if ALabel <> '' then begin
    ABitmap.Canvas.TextOut(txtPt.X, txtPt.Y, ALabel);
    case Angle of
      ra0:
        begin
          inc(ATextRect.Left, FLabelWidth);
          txtPt.X := ATextRect.Left;
        end;
      ra90:
        begin
          inc(ATextRect.Top, FLabelWidth);
          txtPt.Y := ATextRect.Top;
        end;
      ra180:
        begin
          dec(ATextRect.Right, FLabelWidth);
          txtPt.X := ATextRect.Right;
        end;
      ra270:
        begin
          dec(ATextRect.Bottom, FLabelWidth);
          txtPt.Y := ATextRect.Bottom;
        end;
    end;
  end;
  ABitmap.Canvas.TextOut(txtPt.X, txtPt.Y, AText);
end;

{ Draws selected data for the specified contact on the auxiliary bitmap.
  Anchor ...... position at which the data will appear on the rendering canvas.
  AWholeRect .. rectangle covered by the data rows (header included). It is
                relative to the auxiliary bitmap and expanded at exit by the
                height of the row.
  ACol ........ Column counter, advances when a new column is started
  ARecsInCol .. Counter for the records in the first column
  AContactRec . Record storing mostly the rectangles of the data elements to
                facilitate handling of clicks in the ContactGrid.
  Result ...... normally true. But when the size of the rendering canvas is
                exceeded becomes false to indicate an error condition. }
function TVpContactGridPainter.DrawContactRows(ABitmap: TBitmap;
  AContact: TVpContact; var Anchor: TPoint; var AWholeRect: TRect;
  var ACol, ARecsInCol: Integer; var AContactRec: TVpContactRec): Boolean;
var
  s: String;
  spacing: Integer;
  newCol: Boolean;
begin
  Result := true;

  // Set font and colors for the contact data
  ABitmap.Canvas.Font.Assign(FContactGrid.Font);
  ABitmap.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch;
  {$IF VP_LCL_SCALING = 0}
  ABitmap.Canvas.Font.Size := ScaleY(ABitmap.Canvas.Font.Size, DesignTimeDPI);
  {$ENDIF}
  ABitmap.Canvas.Brush.Color := RealColor;
  case Angle of
    ra0   : ABitmap.Canvas.Font.Orientation := 0;
    ra90  : ABitmap.Canvas.Font.Orientation := 2700;
    ra180 : ABitmap.Canvas.Font.Orientation := 1800;
    ra270 : ABitmap.Canvas.Font.Orientation := 900;
  end;

  // Draw company
  DrawContactRow(ABitmap, AContact.Company, '', AWholeRect, AContactRec.CompanyRect);

  // Draw address
  DrawContactRow(ABitmap, AContact.Address1, '', AWholeRect, AContactRec.AddressRect);

  // Draw city, state, zip
  s := AssembleCSZ(AContact, 1, FContactGrid.GetCityStateZipFormat);
  DrawContactRow(ABitmap, s, '', AWholeRect, AContactRec.CSZRect);

  // Draw phone1
  s := PhoneLabel(TVpPhoneType(AContact.PhoneType1)) + ': ';
  DrawContactRow(ABitmap, AContact.Phone1, s, AWholeRect, AContactRec.Phone1Rect);

  // Draw phone2
  s := PhoneLabel(TVpPhoneType(AContact.PhoneType2)) + ': ';
  DrawContactRow(ABitmap, AContact.Phone2, s, AWholeRect, AContactRec.Phone2Rect);

  // Draw phone3
  s := PhoneLabel(TVpPhoneType(AContact.PhoneType3)) + ': ';
  DrawContactRow(ABitmap, AContact.Phone3, s, AWholeRect, AContactRec.Phone3Rect);

  // Draw phone4
  s := PhoneLabel(TVpPhoneType(AContact.PhoneType4)) + ': ';
  DrawContactRow(ABitmap, AContact.Phone4, s, AWholeRect, AContactRec.Phone4Rect);

  // Draw phone5
  s := PhoneLabel(TVpPhoneType(AContact.PhoneType5)) + ': ';
  DrawContactRow(ABitmap, AContact.Phone5, s, AWholeRect, AContactRec.Phone5Rect);

  // Draw EMail
  s := FContactGrid.DisplayEMailValue[AContact];
  DrawContactRow(ABitmap, s, RSEmail + ': ', AWholeRect, AContactRec.EMailRect);

  // If this record is too big to fit in the remaining area of this column,
  // then slide over to the top of the next column }
  newCol := (ARecsInCol > 0) and NewColumnNeeded(AWholeRect, Anchor);

  if newCol then
  begin
    CalcNextColumnAnchor(ABitmap, AWholeRect, Anchor);
    if NewPageNeeded(Anchor) then
    begin
      // Return value FALSE signals that a new page must be started in the
      // next rendering iteration.
      Result := false;
      exit;
    end;

    // New columns Increment the column counter. Store the counter of records
    // in the 1st column and reset it for the new column.
    if ACol = 1 then
      FContactGrid.Col1RecCount := ARecsInCol;
    Inc(ACol);
    ARecsInCol := 0;
  end else
    // Still the same column: Increment the counter of records per column
    // (Is evaluated only when we are drawing the first column).
    inc(ARecsInCol);

  // Add some spacing between records
  spacing := FScaledTextMargin * 2;
  case Angle of
    ra0   : AWholeRect.Bottom := AWholeRect.Bottom + spacing;
    ra90  : AWholeRect.Left := AWholeRect.Left - spacing;
    ra180 : AWholeRect.Top := AWholeRect.Top - spacing;
    ra270 : AWholeRect.Right := AWholeRect.Right + spacing;
  end;

  // Move data rectangles to the position at which they will appear on
  // the render canvas.
  OffsetRect(AContactRec.AddressRect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.CSZRect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.CompanyRect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.EMailRect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.Phone1Rect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.Phone2Rect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.Phone3Rect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.Phone4Rect, Anchor.X, Anchor.Y);
  OffsetRect(AContactRec.Phone5Rect, Anchor.X, Anchor.Y);
end;

{ Draws all contacts. To simplify the layout each contact is drawn first into
  a temporary bitmap which is later copied to the rendering canvas. }
procedure TVpContactGridPainter.DrawContacts;
var
  Anchor: TPoint;
  I, J: Integer;
  TmpBmp: TBitmap;
  contact: TVpContact;
  Col, RecsInCol: Integer;
  WholeRect: TRect;
  oldCol1RecCount: Integer;
  CR: TVpContactRec;
  HeadRect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
  contactCount: Integer;
  newPage: Boolean;
  px4: Integer;     // Scaled 4 pixels
begin
  // If the component is sufficiently small then no sense in painting it
  if (FContactGrid.Height < 20) then
    Exit;

  // Don't paint contacts at designtime or if the data connection is invalid
  if (csDesigning in FContactGrid.ComponentState) or
     (FContactGrid.DataStore = nil) or
     (FContactGrid.DataStore.Resource = nil)
  then
    Exit;

  // Some initializations
  contactCount := FContactGrid.DataStore.Resource.Contacts.Count;
  oldCol1RecCount := FContactGrid.Col1RecCount;
  FContactGrid.VisibleContacts := 0;
  FContactGrid.Col1RecCount := 0;
  px4 := Round(4 * Scale);
  CR := Default(TVpContactRec);

  // Create a temporary bitmap for painting the contact items
  TmpBmp := TBitmap.Create;
  try
    if (Angle = ra0) or (Angle = ra180) then begin
      TmpBmp.Width  := RealColumnWidth - FScaledTextMargin * 4 + px4;
      TmpBmp.Height := RealHeight - FScaledTextMargin * 2;
    end else begin
      TmpBmp.Height := RealColumnWidth - FScaledTextMargin * 4 + px4;
      TmpBmp.Width  := RealHeight - FScaledTextMargin * 2;
    end;

    // Get the net width of each contact column (without spacers)
    FTextColWidth := GetTextColWidth(TmpBmp);

    // Calculate max label width
    FLabelWidth := CalcLabelWidth(TmpBmp);

    // Calculate the header rectangle. It is the same for all contacts.
    HeadRect := CalcHeaderRect(TmpBmp);

    // Set the anchor starting point for the very first (top/left) contact
    Anchor := CalcInitialAnchor(TmpBmp);

    // Sort the records
    FContactGrid.DataStore.Resource.Contacts.Sort;

    // Iterate over all contacts
    Col := 1;
    RecsInCol := 0;

    for I := StartContact to pred(contactCount) do begin
      J := I;  // Do not use the loop index outside a for loop!
      contact := FContactGrid.DataStore.Resource.Contacts.GetContact(I);
      if contact = nil then
        Continue;

      // Clear bmp canvas
      TmpBmp.Canvas.Brush.Color := RealColor;
      TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height));

      // Draw the contact header
      DrawContactHeader(TmpBmp, contact, HeadRect);

      // Draw the contact data
      WholeRect := HeadRect;
      if DrawContactRows(TmpBmp, contact, Anchor, WholeRect, Col, RecsInCol, CR) then
      begin
        newPage := false;
        CR.Index := I;
        CR.Contact := contact;
        CR.ColIndex := Col - 1;
        // Move rectangles in ContactGridRec to final position on rendering canvas.
        // Note:  The other rects already have been moved in DrawContactRows().
        CR.WholeRect := MoveRect(WholeRect, Anchor);
        CR.HeaderRect := MoveRect(HeadRect, Anchor);
        TVpContactGridOpener(FContactGrid).cgContactArray[I] := CR;

        // Draw the contact bitmap on the rendering canvas
        PaintContactBitmap(TmpBmp, contact, Anchor, WholeRect);

        // Slide anchor down for the next record
        case Angle of
          ra0   : Anchor.Y := Anchor.Y + WholeRect.Bottom;
          ra90  : Anchor.X := Anchor.X + WidthOf(WholeRect);
          ra180 : Anchor.Y := Anchor.Y - HeightOf(WholeRect);
          ra270 : Anchor.X := Anchor.X + WholeRect.Right;
        end;
      end else
      begin
        // New page required.
        newPage := true;
        break;
      end;
    end; // for I := StartCont to ...
  finally
    TmpBmp.Free;
  end;

  if newPage then
  begin
    FContactGrid.ContactsAfter := contactCount - J;
    TVpContactGridOpener(FContactGrid).FLastPrintLine := J;
  end else
  begin
    // All contacts printed
    FContactGrid.ContactsAfter := 0;
    TVpContactGridOpener(FContactGrid).FLastPrintLine := -2;  // -2 = no more data available
  end;
  FContactGrid.VisibleContacts := contactCount - StartContact - FContactGrid.ContactsAfter;
  FContactGrid.ColCount := Col;

  if (oldCol1RecCount > 0) and (FContactGrid.Col1RecCount = 0) then
    FContactGrid.Col1RecCount := oldCol1RecCount;
end;

procedure TVpContactGridPainter.DrawVerticalBars;
var
  BarPos, BarCount, I: Integer;
  scaledExtraBarWidth: Integer;
  px2: Integer;   // scaled 2 pixels
begin
  // If the component is sufficiently small then no sense in painting it.
  if (FContactGrid.Height < 20) then
    exit;

  scaledExtraBarWidth := round(ExtraBarWidth * Scale);
  //scaledPenWidth := round(1 * Scale);
  px2 := round(2 * Scale);

  // Draw vertical bars.
  RenderCanvas.Pen.Color := RealBarColor;
  RenderCanvas.Pen.Style := psSolid;
  RenderCanvas.Pen.Width := 1; //scaledPenWidth;
  BarPos := RealLeft + px2 + RealColumnWidth + scaledExtraBarWidth;
  BarCount := 0;
  while (BarPos < RealRight) and (BarCount < Pred(MaxColumns)) do begin
    TVpContactGridOpener(FContactGrid).cgBarArray[BarCount].Rec := Rect(
      BarPos - scaledExtraBarWidth,
      RealTop,
      BarPos + scaledExtraBarWidth + FContactGrid.BarWidth,
      RealBottom
    );

    TVpContactGridOpener(FContactGrid).cgBarArray[BarCount].Index := BarCount;
    for I := 1 to FContactGrid.BarWidth do begin
      TPSMoveTo(RenderCanvas, Angle, RenderIn, BarPos, RealTop + px2 + FScaledTextMargin * 2);
      TPSLineTo(RenderCanvas, Angle, RenderIn, BarPos, RealBottom - FScaledTextMargin * 2);
      Inc(BarPos);
    end;
    Inc(BarPos, RealColumnWidth);
    Inc(BarCount);
  end;

  // If the columns are being resized, then draw the temporary resizing bars.
  if TVpContactGridOpener(FContactGrid).cgGridState = gsColSizing then begin
    // Clear sizing bar array
    for I := 0 to pred(MaxColumns) do
      with TVpContactGridOpener(FContactGrid) do begin
        if cgResizeBarArray[I].Index = -1 then
          Break;
        cgResizeBarArray[I].Rec := Rect(-1, -1, -1, -1);
        cgResizeBarArray[I].Index := -1;
      end;
    // Draw sizing bars
    RenderCanvas.Pen.Color := SizingBarColor;
    RenderCanvas.Pen.Style := psDash;
    BarPos := RealLeft + px2 + TVpContactGridOpener(FContactGrid).cgNewColWidth + ExtraBarWidth;
    BarCount := 0;
    while (BarPos < FContactGrid.Width) and (BarCount < pred(MaxColumns)) do begin
      TVpContactGridOpener(FContactGrid).cgResizeBarArray[BarCount].Index := BarCount;
      TVpContactGridOpener(FContactGrid).cgResizeBarArray[BarCount].Rec := Rect(
        BarPos - ExtraBarWidth,
        RealTop,
        BarPos - ExtraBarWidth + FContactGrid.BarWidth,
        RealBottom
      );
      for I := 1 to FContactGrid.BarWidth do begin
        TPSMoveTo(
          RenderCanvas, Angle, RenderIn,
          RealLeft + BarPos,
          RealTop + px2 + FScaledTextMargin * 2
        );
        TPSLineTo(
          RenderCanvas, Angle, RenderIn,
          RealLeft + BarPos,
          RealBottom - FScaledTextMargin * 2
        );
        Inc(BarPos);
      end;
      Inc(BarPos, TVpContactGridOpener(FContactGrid).cgNewColWidth);
      Inc(BarCount);
    end;
    RenderCanvas.Pen.Style := psSolid;
  end;
end;

procedure TVpContactGridPainter.FixFontHeights;
begin
  with FContactGrid do begin
   {$IF VP_LCL_SCALING = 0}
    ContactHeadAttributes.Font.Height := GetRealFontHeight(ContactHeadAttributes.Font);
    Font.Height := GetRealFontHeight(Font);
   {$ELSE}
    ContactHeadAttributes.Font.Height := FixFontHeight(ContactHeadAttributes.Font);
    Font.Height := FixFontHeight(Font);
   {$ENDIF}
  end;
end;

function TVpContactGridPainter.GetTextColWidth(ABitmap: TBitmap): Integer;
begin
  case Angle of
    ra0, ra180: Result := ABitmap.Width;
    ra90, ra270: Result := ABitmap.Height;
  end;
end;

procedure TVpContactGridPainter.InitColors;
begin
  if DisplayOnly then begin
    RealColor := clWhite;
    SizingBarColor := clBlack;
    BevelDarkShadow := clBlack;
    BevelShadow := clBlack;
    BevelHighlight := clBlack;
    BevelFace := clBlack;
    RealBarColor := clBlack;
    RealContactHeadAttrColor := clSilver;
  end else begin
    RealColor := FContactGrid.Color;
    SizingBarColor := clBlack;
    BevelDarkShadow := cl3dDkShadow;
    BevelShadow := clBtnShadow;
    BevelHighlight := clBtnHighlight;
    BevelFace := clBtnFace;
    RealBarColor := FContactGrid.BarColor;
    RealContactHeadAttrColor := FContactGrid.ContactHeadAttributes.Color;
  end;
end;

{ Determines whether the contact rectange AWholeRect execeeds the page height
  and a new column should be started. }
function TVpContactGridPainter.NewColumnNeeded(AWholeRect: TRect;
  Anchor: TPoint): Boolean;
var
  bottomMargin: Integer;
begin
  bottomMargin := FScaledTextMargin * 2;
  case Angle of
    ra0:
      Result := (RenderIn.Top + Anchor.y + AWholeRect.Bottom >= RenderIn.Bottom - bottomMargin);
    ra90:
      Result := (Anchor.x + RenderIn.Left + WidthOf(AWholeRect) > RenderIn.Right - bottomMargin);
    ra180:
      Result := (Anchor.y + RenderIn.Top - HeightOf(AWholeRect) <= RenderIn.Top + bottomMargin);
    ra270:
      Result := (Anchor.x + RenderIn.Left + WidthOf(AWholeRect) >= RenderIn.Right - bottomMargin);
  end;
end;

{ Determines whether the new anchor is outside the current page. }
function TVpContactGridPainter.NewPageNeeded(Anchor: TPoint): Boolean;
begin
  case Angle of
    ra0:
      Result := (Anchor.X + FTextColWidth >= RenderIn.Right);
    ra90:
      Result := (Anchor.y + FTextColWidth >= RenderIn.Bottom);
    ra180:
      Result := (Anchor.x + FTextColWidth < RenderIn.Left);
    ra270:
      Result := (Anchor.y + FTextColWidth <= RenderIn.Top);
  end;
end;

{ Copy the drawn contact record from the bitmap to the rendering canvas. }
procedure TVpContactGridPainter.PaintContactBitmap(ABitmap: TBitmap;
  AContact: TVpContact; Anchor: TPoint; AWholeRect: TRect);
const
  FOCUS_RECT_DISTANCE = 3;
var
  R: TRect;
  dist: Integer;
begin
  // Calculate the destination rectangle on the rendering canvas.
  case Angle of
    ra0:
      R := Rect(Anchor.X + AWholeRect.Left + RenderIn.Left,
             Anchor.Y + AWholeRect.Top + RenderIn.Top,
             Anchor.X + ABitmap.Width + RenderIn.Left,
             Anchor.Y + AWholeRect.Bottom + RenderIn.Top
           );
    ra90:
      R := Rect(AWholeRect.Left + RenderIn.Left - Anchor.X,
             Anchor.Y + AWholeRect.Top + RenderIn.Top,
             AWholeRect.Right + RenderIn.Left - Anchor.X,
             Anchor.Y + AWholeRect.Bottom + RenderIn.Top
            );
    ra180:
      R := Rect(Anchor.X + AWholeRect.Left + RenderIn.Left,
             Anchor.Y - HeightOf(AWholeRect) + RenderIn.Top,
             Anchor.X + ABitmap.Width + RenderIn.Left,
             Anchor.Y + RenderIn.Top
           );
    ra270:
      R := Rect(Anchor.X + RenderIn.Left,
             Anchor.Y + RenderIn.Top,
             Anchor.X + RenderIn.Left + WidthOf(AWholeRect),
             Anchor.Y + RenderIn.Top + HeightOf(AWholeRect)
           );
  end;

  // Copy the auxiliary contact bitmap from AWholeRect to R into the
  // rendering canvas.
  RenderCanvas.CopyRect(R, ABitmap.Canvas, AWholeRect);

  // Draw focus rect around selected record (not in printing mode)
  if not DisplayOnly and
     FContactGrid.Focused and
     (AContact = FContactGrid.ActiveContact) then
  begin
    {$IF VP_LCL_SCALING > 0}
    dist := FContactGrid.Scale96ToFont(FOCUS_RECT_DISTANCE);
    {$ELSE}
    dist := ScaleY(FOCUS_RECT_DISTANCE, DesigntimeDPI);
    {$IFEND}
    InflateRect(R, dist, 0);
    OffsetRect(R, 0, -dist);
    RenderCanvas.DrawFocusRect(R);
  end;
end;

procedure TVpContactGridPainter.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);

    if StartLine = -1 then
      StartContact := FContactGrid.ContactsBefore
    else
      StartContact := StartLine;

    SetMeasurements;

    // Clear the control
    Clear;

    // Draw the contacts
    if StartLine <> -2 then  // Do not change. Paint calls it with StartLine = -1...
      DrawContacts;

    // Draw the vertical bars
    DrawVerticalBars;

    // Draw the borders
    DrawBorders;

    FContactGrid.UpdateScrollbar;

  finally
    SelectClipRgn(RenderCanvas.Handle, 0);
    DeleteObject(Rgn);
  end;

  // Restore canvas settings
  RestorePenBrush;
end;

procedure TVpContactGridPainter.SetMeasurements;
const
  MARGIN = 2;
var
  numCols: Integer;
begin
  inherited;
  FScaledTextMargin := round(FContactGrid.TextMargin * Scale);
  FAnchorMargin := round(Scale * MARGIN) {%H-}+ FScaledTextMargin * 2;

  numCols := FContactGrid.PrintNumColumns;
  if DisplayOnly and (numCols > 0) then
    RealColumnWidth := (RealWidth - round((2 + ExtraBarWidth) * Scale * (numCols - 1))) div numCols
  else
    RealColumnWidth := FContactGrid.ColumnWidth;
end;

end.