unit VpContactGridPainter; {$I vp.inc} interface uses LCLType, LCLIntf, Types, Classes, Graphics, VpConst, VPBase, VpData, VpBasePainter, VpContactGrid; type TVpContactGridPainter = class(TVpBasePainter) private FContactGrid: TVpContactGrid; // 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; protected procedure Clear; procedure DrawBorders; procedure DrawContactLine(ABitmap: TBitmap; AText, ALabel: String; var AWholeRect, ATextRect: TRect); procedure DrawContacts; procedure DrawVerticalBars; procedure FixFontHeights; procedure InitColors; 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; 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 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; procedure TVpContactGridPainter.DrawBorders; var R: TRect; begin R := RenderIn; dec(R.Right, 1); dec(R.Bottom, 1); case FContactGrid.DrawingStyle of dsFlat: begin { Draw a simple border rectangle } DrawBevelRect(RenderCanvas, R, BevelShadow, BevelShadow); end; ds3d: begin { Draw a 3d bevel } DrawBevelRect(RenderCanvas, R, BevelShadow, BevelHighlight); InflateRect(R, -1, -1); DrawBevelRect(RenderCanvas, R, BevelDarkShadow, BevelFace); end; end; end; procedure TVpContactGridPainter.DrawContactLine(ABitmap: TBitmap; AText, ALabel: String; var AWholeRect, ATextRect: TRect); var txtheight: Integer; txtColWidth: Integer; begin if AText = '' then begin ATextRect := Rect(0, 0, 0, 0); exit; end; txtHeight := ABitmap.Canvas.TextHeight(VpProductName); case Angle of ra0: begin ATextRect.Left := TextMargin; ATextRect.Top := AWholeRect.Bottom + TextMargin div 2; ATextRect.Right := ABitmap.Width; ATextRect.Bottom := ATextRect.Top + txtHeight + TextMargin div 2; AWholeRect.Bottom := ATextRect.Bottom; txtColWidth := ABitmap.Width; end; ra90: begin ATextRect.Left := AWholeRect.Left - txtHeight + TextMargin div 2; ATextRect.Top := TextMargin; ATextRect.Right := AWholeRect.Left - TextMargin div 2; ATextRect.Bottom := AWholeRect.Bottom + TextMargin div 2; AWholeRect.Left := ATextRect.Left; txtColWidth := ABitmap.Height; end; ra180: begin ATextRect.Left := AWholeRect.Right - TextMargin * 2; // Shouldn't this be "div 2" ? ATextRect.Top := AWholeRect.Top - txtHeight - TextMargin; ATextRect.Right := AWholeRect.Left + TextMargin; ATextRect.Bottom := AWholeRect.Top - TextMargin div 2; AWholeRect.Top := ATextRect.Top; txtColWidth := ABitmap.Width; end; ra270: begin ATextRect.Left := AWholeRect.Right; ATextRect.Top := AWholeRect.Bottom - TextMargin; ATextRect.Right := AWholeRect.Right + txtHeight + TextMargin div 2; ATextRect.Bottom := AWholeRect.Top + TextMargin div 2; AWholeRect.Right := ATextRect.Right; txtColWidth := ABitmap.Height; end; end; // case Angle... AText := GetDisplayString(ABitmap.Canvas, AText, 2, txtColWidth - TextMargin * 2); if ALabel <> '' then begin TPSTextOutAtPoint( ABitmap.Canvas, Angle, Rect(0, 0, ABitmap.Width, ABitmap.Height), ATextRect.Left + TextMargin, ATextRect.Top + TextMargin div 2, ALabel ); with ATextRect do case Angle of ra0 : TopLeft := Point(Left + PhoneLblWidth, Top + TextMargin div 2); ra90 : TopLeft := Point(Top + PhoneLblWidth, Left + TextMargin); ra180 : TopLeft := Point(Left - PhoneLblWidth, top + TextMargin div 2); ra270 : TopLeft := Point(Left + TextMargin div 2, Top - PhoneLblWidth); end; TPSTextOutAtPoint( ABitmap.Canvas, Angle, Rect(0, 0, ABitmap.Width, ABitmap.Height), ATextRect.Left, ATextRect.Top, AText ); end else TPSTextOutAtPoint( ABitmap.Canvas, Angle, Rect(0, 0, ABitmap.Width, ABitmap.Height), ATextRect.Left + TextMargin, ATextRect.Top + TextMargin div 2, AText ); end; procedure TVpContactGridPainter.DrawContacts; var Anchor: TPoint; I, J: Integer; Str: string; TmpBmp: TBitmap; TmpCon: TVpContact; Col, RecsInCol: Integer; HeadRect: TRect; WholeRect: TRect; TmpBmpRect: TRect; TextColWidth: Integer; TextXOffset: Integer; TextYOffset: Integer; oldCol1RecCount: Integer; AddrRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); CSZRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); CompanyRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); EMailRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); Phone1Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); Phone2Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); Phone3Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); Phone4Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); Phone5Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); R: TRect; contactCount: Integer; baseTextHeight: Integer; maxTextWidth: Integer; 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 := TVpContactGridOpener(FContactGrid).cgCol1RecCount; TVpContactGridOpener(FContactGrid).FVisibleContacts := 0; TVpContactGridOpener(FContactGrid).cgCol1RecCount := 0; TextXOffset := 0; TextYOffset := 0; { create a temporary bitmap for painting the items } TmpBmp := TBitmap.Create; try if (Angle = ra0) or (Angle = ra180) then begin TmpBmp.Width := RealColumnWidth - TextMargin * 4 + 4; // wp:+4 TmpBmp.Height := RealHeight - TextMargin * 2; TextColWidth := TmpBmp.Width; end else begin TmpBmp.Height := RealColumnWidth - TextMargin * 4 + 4; // wp: +4 TmpBmp.Width := RealHeight - TextMargin * 2; TextColWidth := TmpBmp.Height; end; TmpBmpRect := Rect(0, 0, TmpBmp.Width, TmpBmp.Height); TmpBmp.Canvas.Font.Assign(FContactGrid.Font); {$IF VP_LCL_SCALING = 0} TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI); {$ENDIF} baseTextHeight := TmpBmp.Canvas.TextHeight(VpProductName); { Calculate Phone Lbl Width } PhoneLblWidth := TmpBmp.Canvas.TextWidth(RSEmail); for I := 0 to 7 do begin Str := PhoneLabel(TVpPhoneType(I)) + ': '; J := TmpBmp.Canvas.TextWidth(Str); if J > PhoneLblWidth then PhoneLblWidth := J; end; Col := 1; { clear the bitmap } TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height)); { sort the records } FContactGrid.DataStore.Resource.Contacts.Sort; // wp: why sort here? { Set the anchor starting point } case Angle of ra0: Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2); ra90: Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2); ra180: Anchor := Point( RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - TextMargin * 2, TmpBmp.Height - 2 - TextMargin * 2 ); ra270: Anchor := Point( 2 + TextMargin * 2, RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - TextMargin * 2 ); end; RecsInCol := 0; for I := StartContact to pred(contactCount) do begin TmpCon := FContactGrid.DataStore.Resource.Contacts.GetContact(I); if (TmpCon <> nil) then begin TVpContactGridOpener(FContactGrid).cgContactArray[I].Contact := TmpCon; { Clear bmp canvas } TmpBmp.Canvas.Brush.Color := RealColor; TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height)); { start building the WholeRect and build the HeaderRect} TmpBmp.Canvas.Pen.Color := BevelDarkShadow; TmpBmp.Canvas.Brush.Style := bsSolid; TmpBmp.Canvas.Font.Assign(FContactGrid.ContactHeadAttributes.Font); {$IF VP_LCL_SCALING = 0} TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI); {$ENDIF} if FContactGrid.Focused and (TmpCon = FContactGrid.ActiveContact) then TmpBmp.Canvas.Font.Style := [fsBold]; case Angle of ra0: begin WholeRect.TopLeft := Point(0, 0); // HeadRect.TopLeft := Point(TextMargin, TextMargin div 2); // HeadRect.TopLeft := Point(TextMargin, 0); HeadRect.TopLeft := Point(0, 0); HeadRect.BottomRight := Point( TmpBmp.Width, HeadRect.Top + baseTextHeight + TextMargin div 2 ); WholeRect.BottomRight := HeadRect.BottomRight; end; ra90: // TO DO: CHECK CORRECT USAGE OF TextMargin HERE !!!!!!!!! begin HeadRect.TopLeft := Point( TmpBmpRect.Right - TextMargin - baseTextHeight + TextMargin div 2, 0 ); HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height); WholeRect.TopLeft := HeadRect.TopLeft; WholeRect.BottomRight := HeadRect.BottomRight; end; ra180: begin WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height); HeadRect.TopLeft := Point( TextMargin, TmpBmpRect.Bottom - baseTextHeight - TextMargin ); HeadRect.BottomRight := Point( TmpBmp.Width, TmpBmp.Height - TextMargin div 2 ); WholeRect.TopLeft := HeadRect.TopLeft; end; ra270: begin WholeRect.TopLeft := Point(0, 0); HeadRect.TopLeft := Point(0, TextMargin); HeadRect.BottomRight := Point( TextMargin + baseTextHeight + TextMargin div 2, TmpBmp.Height ); WholeRect.BottomRight := HeadRect.BottomRight; end; end; { paint the header cell's background } TmpBmp.Canvas.Brush.Color := RealContactHeadAttrColor; TmpBmp.Canvas.FillRect(HeadRect); { paint the header cell's border } if FContactGrid.ContactHeadAttributes.Bordered and (FContactGrid.DrawingStyle <> dsNoBorder) then begin TmpBmp.Canvas.Pen.Style := psSolid; TmpBmp.Canvas.Rectangle(HeadRect); end; { paint the header cell's text } case Angle of ra90: begin TextXOffset := WidthOf(HeadRect) - TextMargin div 2; TextYOffset := TextMargin div 3; end; ra180: begin TextXOffset := WidthOf(HeadRect) - TextMargin; TextYOffset := HeightOf(HeadRect) - TextMargin div 3; end; ra270: begin TextXOffset := TextMargin div 2; TextYOffset := HeightOf(HeadRect) - TextMargin div 3; end; end; { assemble the header string } if (Angle in [ra0, ra180]) then maxTextWidth := WidthOf(HeadRect) else maxTextWidth := HeightOf(HeadRect); Str := AssembleName(TmpCon); Str := GetDisplayString(TmpBmp.Canvas, Str, 2, maxTextWidth - TextMargin); TPSTextOutAtPoint( TmpBmp.Canvas, Angle, TmpBmpRect, HeadRect.Left + TextMargin div 2 + TextXOffset, HeadRect.Top + TextMargin div 3 + TextYOffset, Str ); { restore font and colors } TmpBmp.Canvas.Font.Assign(FContactGrid.Font); {$IF VP_LCL_SCALING = 0} TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI); {$ENDIF} TmpBmp.Canvas.Brush.Color := RealColor; TmpBmp.Canvas.Pen.Color := BevelDarkShadow; TmpBmp.Canvas.Pen.Style := psSolid; { do Company } DrawContactLine(TmpBmp, TmpCon.Company, '', WholeRect, CompanyRect); { do address... } DrawContactLine(TmpBmp, TmpCon.Address1, '', WholeRect, AddrRect); { do City, State, Zip } Str := AssembleCSZ(TmpCon, 1, FContactGrid.GetCityStateZipFormat); DrawContactLine(TmpBmp, Str, '', WholeRect, CSZRect); { do Phone1 } Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType1)) + ': '; DrawContactLine(TmpBmp, TmpCon.Phone1, Str, WholeRect, Phone1Rect); { do Phone2 } Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType2)) + ': '; DrawContactLine(TmpBmp, TmpCon.Phone2, Str, WholeRect, Phone2Rect); { do Phone3 } Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType3)) + ': '; DrawContactLine(TmpBmp, TmpCon.Phone3, Str, WholeRect, Phone3Rect); { do Phone4 } Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType4)) + ': '; DrawContactLine(TmpBmp, TmpCon.Phone4, Str, WholeRect, Phone4Rect); { do Phone5 } Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType5)) + ': '; DrawContactLine(TmpBmp, TmpCon.Phone5, Str, WholeRect, Phone5Rect); { do EMail } Str := TVpContactGridOpener(FContactGrid).GetDisplayEMailValue(TmpCon); DrawContactLine(TmpBmp, Str, RSEmail + ': ', WholeRect, EMailRect); { if this record's too big to fit in the remaining area of this } { column, then slide over to the top of the next column } if RecsInCol > 0 then case Angle of ra0: if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - TextMargin * 3) then begin Anchor := Point( Anchor.x + WholeRect.Right + FContactGrid.BarWidth + 1 + TextMargin * 3, 2 + TextMargin * 2 ); if Col = 1 then TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol; Inc(Col); RecsInCol := 0; if DisplayOnly and (Anchor.X + TextColWidth >= RenderIn.Right) then Exit; end; ra90 : if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - TextMargin * 3) then begin Anchor.x := 2 + TextMargin * 2; Anchor.y := Anchor.y + WholeRect.Bottom + FContactGrid.BarWidth + 1 + TextMargin * 3; if Col = 1 then TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol; Inc(Col); RecsInCol := 0; if DisplayOnly and (Anchor.y + TextColWidth >= RenderIn.Bottom) then Exit; end; ra180 : if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + TextMargin * 3) then begin Anchor.x := Anchor.x - (WholeRect.Right + FContactGrid.BarWidth + 1 + TextMargin * 3); Anchor.y := TmpBmp.Height - 2 - TextMargin * 2; if Col = 1 then TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol; Inc(Col); RecsInCol := 0; if DisplayOnly and (Anchor.x + TextColWidth < RenderIn.Left) then Exit; end; ra270 : if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - TextMargin * 3) then begin Anchor.x := 2 + TextMargin * 2; Anchor.y := Anchor.y - (WholeRect.Bottom + FContactGrid.BarWidth + 1 + TextMargin * 3); if Col = 1 then TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol; Inc(Col); RecsInCol := 0; if DisplayOnly and (Anchor.y + TextColWidth <= RenderIn.Top) then Exit; end; end; { add a little spacing between records } case Angle of ra0 : WholeRect.Bottom := WholeRect.Bottom + TextMargin * 2; ra90 : WholeRect.Left := WholeRect.Left - TextMargin * 2; ra180 : WholeRect.Top := WholeRect.Top - TextMargin * 2; ra270 : WholeRect.Right := WholeRect.Right + TextMargin * 2; end; { Update Array Rects } with TVpContactGridOpener(FContactGrid) do begin cgContactArray[I].WholeRect := MoveRect(WholeRect, Anchor); cgContactArray[I].HeaderRect := MoveRect(HeadRect, Anchor); cgContactArray[I].AddressRect := MoveRect(AddrRect, Anchor); cgContactArray[I].CSZRect := MoveRect(CSZRect, Anchor); cgContactArray[I].CompanyRect := MoveRect(CompanyRect, Anchor); cgContactArray[I].EMailRect := MoveRect(EMailRect, Anchor); cgContactArray[I].Phone1Rect := MoveRect(Phone1Rect, Anchor); cgContactArray[I].Phone2Rect := MoveRect(Phone2Rect, Anchor); cgContactArray[I].Phone3Rect := MoveRect(Phone3Rect, Anchor); cgContactArray[I].Phone4Rect := MoveRect(Phone4Rect, Anchor); cgContactArray[I].Phone5Rect := MoveRect(Phone5Rect, Anchor); end; { move the drawn record from the bitmap to the component canvas } case Angle of ra0 : R := Rect(Anchor.X + WholeRect.Left + RenderIn.Left, Anchor.Y + WholeRect.Top + RenderIn.Top, Anchor.X + TmpBmp.Width + RenderIn.Left, Anchor.Y + WholeRect.Bottom + RenderIn.Top); ra90 : R := Rect(WholeRect.Left + RenderIn.Left - Anchor.X, Anchor.Y + WholeRect.Top + RenderIn.Top, WholeRect.Right + RenderIn.Left - Anchor.X, Anchor.Y + WholeRect.Bottom + RenderIn.Top); ra180 : R := Rect(Anchor.X + WholeRect.Left + RenderIn.Left, Anchor.Y - (WholeRect.Bottom - WholeRect.Top) + RenderIn.Top, Anchor.X + TmpBmp.Width + RenderIn.Left, Anchor.Y + RenderIn.Top); ra270 : R := Rect(Anchor.X + RenderIn.Left, Anchor.Y + RenderIn.Top, Anchor.X + RenderIn.Left + (WholeRect.Right - WholeRect.Left), Anchor.Y + RenderIn.Top + (WholeRect.Bottom - WholeRect.Top)); end; RenderCanvas.CopyRect(R, TmpBmp.Canvas, WholeRect); { draw focusrect around selected record } if FContactGrid.Focused and (TmpCon = FContactGrid.ActiveContact) then begin with TVpContactGridOpener(FContactGrid).cgContactArray[I] do begin R := WholeRect; InflateRect(R, 3, 0); OffsetRect(R, 0, -3); RenderCanvas.DrawFocusRect(R); end; end; { slide anchor down for the next record } case Angle of ra0 : Anchor.Y := Anchor.Y + WholeRect.Bottom; ra90 : Anchor.X := Anchor.X + (WholeRect.Right - WholeRect.Left); ra180 : Anchor.Y := Anchor.Y - (WholeRect.Bottom - WholeRect.Top); ra270 : Anchor.X := Anchor.X + WholeRect.Right; end; Inc(RecsInCol); end; // for I := StartCont to ... if not DisplayOnly then case Angle of ra0 : with TVpContactGridOpener(FContactGrid) do if (Anchor.X > RenderIn.Right) and (I < DataStore.Resource.Contacts.Count) then begin { we have filled in the visible area } FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; end else begin FContactsAfter := 0; FVisibleContacts := contactCount - StartContact; end; ra90 : with TVpContactGridOpener(FContactGrid) do if (Anchor.Y > RenderIn.Bottom) and (I < contactCount) then begin { we have filled in the visible area } FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; end else begin FContactsAfter := 0; FVisibleContacts := contactCount - StartContact; end; ra180 : with TVpContactGridOpener(FContactGrid) do begin if (Anchor.X < RenderIn.Left) and (I < contactCount) then begin { we have filled in the visible area } FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; end else FContactsAfter := 0; FVisibleContacts := contactCount - StartContact; end; ra270 : with TVpContactGridOpener(FContactGrid) do begin if (Anchor.Y < RenderIn.Top) and (I < contactCount) then begin { we have filled in the visible area } FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; end else FContactsAfter := 0; FVisibleContacts := contactCount - StartContact; end; end; end; finally TmpBmp.Free; end; with TVpContactGridOpener(FContactGrid) do begin if FContactsAfter = 0 then FLastPrintLine := -2 else FLastPrintLine := FContactsAfter; if (oldCol1RecCount > 0) and (cgCol1RecCount = 0) then cgCol1RecCount := oldCol1RecCount; end; end; procedure TVpContactGridPainter.DrawVerticalBars; var BarPos, BarCount, I: Integer; begin { if the component is sufficiently small then no sense in painting it } if (FContactGrid.Height < 20) then exit; { draw vertical bars } RenderCanvas.Pen.Color := RealBarColor; RenderCanvas.Pen.Style := psSolid; BarPos := RealLeft + 2 + RealColumnWidth + ExtraBarWidth; BarCount := 0; while (BarPos < RealRight) and (BarCount < Pred(MaxColumns)) do begin TVpContactGridOpener(FContactGrid).cgBarArray[BarCount].Rec := Rect( BarPos - ExtraBarWidth, RealTop, BarPos + ExtraBarWidth + FContactGrid.BarWidth, RealBottom ); TVpContactGridOpener(FContactGrid).cgBarArray[BarCount].Index := BarCount; for I := 1 to FContactGrid.BarWidth do begin TPSMoveTo(RenderCanvas, Angle, RenderIn, BarPos, RealTop + 2 + TextMargin * 2); TPSLineTo(RenderCanvas, Angle, RenderIn, BarPos, RealBottom - TextMargin * 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 + 2 + 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 + 2 + TextMargin * 2 ); TPSLineTo( RenderCanvas, Angle, RenderIn, RealLeft + BarPos, RealBottom - TextMargin * 2 ); Inc(BarPos); end; Inc(BarPos, TVpContactGridOpener(FContactGrid).cgNewColWidth); Inc(BarCount); end; RenderCanvas.Pen.Style := psSolid; end; end; procedure TVpContactGridPainter.FixFontHeights; begin {$IF VP_LCL_SCALING = 0} with FContactGrid do begin ContactHeadAttributes.Font.Height := GetRealFontHeight(ContactHeadAttributes.Font); Font.Height := GetRealFontHeight(Font); end; {$ENDIF} 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; procedure TVpContactGridPainter.RenderToCanvas(ARenderIn: TRect; AAngle: TVpRotationAngle; AScale: Extended; ARenderDate: TDateTime; AStartLine, AStopLine: Integer; AUseGran: TVpGranularity; ADisplayOnly: Boolean); var nc: Integer; 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 := TVpContactGridOpener(FContactGrid).FContactsBefore else StartContact := StartLine; SetMeasurements; nc := FContactGrid.PrintNumColumns; if DisplayOnly and (nc > 0) then RealColumnWidth := (RealWidth - (2 + ExtraBarWidth) * (nc - 1)) div nc else RealColumnWidth := FContactGrid.ColumnWidth; { clear the control } Clear; { draw the contacts } if StartLine <> -2 then DrawContacts; { draw the vertical bars } DrawVerticalBars; { draw the borders } DrawBorders; TVpContactGridOpener(FContactGrid).SetHScrollPos; finally SelectClipRgn(RenderCanvas.Handle, 0); DeleteObject(Rgn); end; { reinstate canvas settings } RestorePenBrush; end; end.