diff --git a/components/tvplanit/source/vpcontactgridpainter.pas b/components/tvplanit/source/vpcontactgridpainter.pas index 10701ca37..6ca9f8f92 100644 --- a/components/tvplanit/source/vpcontactgridpainter.pas +++ b/components/tvplanit/source/vpcontactgridpainter.pas @@ -4,7 +4,7 @@ unit VpContactGridPainter; interface -uses lazlogger, +uses LCLType, LCLIntf, SysUtils, Types, Classes, Graphics, VpConst, VPBase, VpData, VpBasePainter, VpContactGrid; @@ -29,14 +29,19 @@ type RealContactHeadAttrColor: TColor; protected + function CalcHeaderRect(ABitmap: TBitmap): TRect; procedure Clear; procedure DrawBorders; - procedure DrawContactLine(ABitmap: TBitmap; AText, ALabel: String; + procedure DrawContactHeader(ABitmap: TBitmap; AContact: TVpContact; + const ARect: TRect); + procedure DrawContactRow(ABitmap: TBitmap; AText, ALabel: String; var AWholeRect, ATextRect: TRect); procedure DrawContacts; procedure DrawVerticalBars; procedure FixFontHeights; procedure InitColors; + procedure PaintContactBitmap(ABitmap: TBitmap; AContact: TVpContact; + Anchor: TPoint; AWholeRect: TRect); procedure SetMeasurements; override; public @@ -62,15 +67,43 @@ begin 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; + procedure TVpContactGridPainter.Clear; var I: Integer; begin - { clear Client Area } + // Clear client area RenderCanvas.Brush.Color := RealColor; RenderCanvas.FillRect(RenderIn); - { clear the vertical bar array } + // Clear the vertical bar array for I := 0 to pred(MaxColumns) do begin with TVpContactGridOpener(FContactGrid) do begin if cgBarArray[I].Index = -1 then @@ -80,10 +113,10 @@ begin end; end; - { initialize the contact array at runtime } + // Initialize the contact array at runtime if not (csDesigning in FContactGrid.ComponentState) and (FContactGrid.DataStore <> nil) - and (FContactGrid.DataStore.Resource <> nil) - then + 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 @@ -101,6 +134,7 @@ begin Phone5Rect := Rect(-1, -1, -1, -1); end; end; + end; end; procedure TVpContactGridPainter.DrawBorders; @@ -115,7 +149,84 @@ begin end; end; -procedure TVpContactGridPainter.DrawContactLine(ABitmap: TBitmap; +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; @@ -205,21 +316,20 @@ begin ); 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, W: Integer; + I, W: Integer; Str: string; TmpBmp: TBitmap; - TmpCon: TVpContact; + contact: TVpContact; Col, RecsInCol: Integer; - HeadRect: TRect; WholeRect: TRect; - TmpBmpRect: TRect; TextColWidth: Integer; - TextXOffset: Integer; - TextYOffset: Integer; oldCol1RecCount: Integer; + HeadRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); 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); @@ -229,13 +339,9 @@ var 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; anchorMargin: Integer; px2, px4: Integer; // Scaled 2, 4 pixels - px3: Integer; // 3 pixels scaled for high-dpi begin // If the component is sufficiently small then no sense in painting it if (FContactGrid.Height < 20) then @@ -253,18 +359,10 @@ begin oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount; TVpContactGridOpener(FContactGrid).FVisibleContacts := 0; TVpContactGridOpener(FContactGrid).cgCol1RecCount := 0; - TextXOffset := 0; - TextYOffset := 0; px2 := Round(2 * Scale); px4 := Round(4 * Scale); - {$IF VP_LCL_SCALING > 0} - px3 := FContactGrid.Scale96ToFont(3); - {$ELSE} - px3 := ScaleY(3, DesigntimeDPI); - {$IFEND} - - // Create a temporary bitmap for painting the items + // Create a temporary bitmap for painting the contact items TmpBmp := TBitmap.Create; try if (Angle = ra0) or (Angle = ra180) then begin @@ -276,13 +374,15 @@ begin TmpBmp.Width := RealHeight - FScaledTextMargin * 2; TextColWidth := TmpBmp.Height; end; - TmpBmpRect := Rect(0, 0, TmpBmp.Width, TmpBmp.Height); + + // Calculate the header rectangle. It is the same for all contacts. + HeadRect := CalcHeaderRect(TmpBmp); + TmpBmp.Canvas.Font.Assign(FContactGrid.Font); TmpBmp.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch; {$IF VP_LCL_SCALING = 0} TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI); {$ENDIF} - baseTextHeight := TmpBmp.Canvas.TextHeight(VpProductName); // Calculate max phone label width PhoneLblWidth := TmpBmp.Canvas.TextWidth(RSEmail); @@ -293,7 +393,7 @@ begin PhoneLblWidth := w; end; - // Set the anchor starting point + // Set the anchor starting point for the very first (top/left) contact anchorMargin := px2 + FScaledTextMargin * 2; case Angle of ra0, ra90: @@ -311,163 +411,66 @@ begin Col := 1; 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; + contact := FContactGrid.DataStore.Resource.Contacts.GetContact(I); + if (contact <> nil) then begin + TVpContactGridOpener(FContactGrid).cgContactArray[I].Contact := contact; // 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); - TmpBmp.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch; - {$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(0, 0); - HeadRect.BottomRight := Point( - TmpBmp.Width, - HeadRect.Top + baseTextHeight + FScaledTextMargin div 2 - ); - WholeRect.BottomRight := HeadRect.BottomRight; - end; - ra90: // TO DO: CHECK CORRECT USAGE OF TextMargin HERE !!!!!!!!! - begin - HeadRect.TopLeft := Point( - TmpBmpRect.Right - FScaledTextMargin - baseTextHeight + FScaledTextMargin 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( - FScaledTextMargin, - TmpBmpRect.Bottom - baseTextHeight - FScaledTextMargin - ); - HeadRect.BottomRight := Point( - TmpBmp.Width, - TmpBmp.Height - FScaledTextMargin div 2 - ); - WholeRect.TopLeft := HeadRect.TopLeft; - end; - ra270: - begin - WholeRect.TopLeft := Point(0, 0); - HeadRect.TopLeft := Point(0, FScaledTextMargin); - HeadRect.BottomRight := Point( - FScaledTextMargin + baseTextHeight + FScaledTextMargin div 2, - TmpBmp.Height - ); - WholeRect.BottomRight := HeadRect.BottomRight; - end; - end; + // Start building the WholeRect + WholeRect := HeadRect; + if Angle = ra180 then + WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height); - { paint the header cell's background } - TmpBmp.Canvas.Brush.Color := RealContactHeadAttrColor; - TmpBmp.Canvas.FillRect(HeadRect); + // Draw the contact header + DrawContactHeader(TmpBmp, contact, 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) - FScaledTextMargin div 2; - TextYOffset := FScaledTextMargin div 3; - end; - ra180: - begin - TextXOffset := WidthOf(HeadRect) - FScaledTextMargin; - TextYOffset := HeightOf(HeadRect) - FScaledTextMargin div 3; - end; - ra270: - begin - TextXOffset := FScaledTextMargin div 2; - TextYOffset := HeightOf(HeadRect) - FScaledTextMargin 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 - FScaledTextMargin); - - TPSTextOutAtPoint( - TmpBmp.Canvas, - Angle, - TmpBmpRect, - HeadRect.Left + FScaledTextMargin div 2 + TextXOffset, - HeadRect.Top + FScaledTextMargin div 3 + TextYOffset, - Str - ); - - { restore font and colors } + // Set font and colors for the contact data TmpBmp.Canvas.Font.Assign(FContactGrid.Font); TmpBmp.Canvas.Font.PixelsPerInch := RenderCanvas.Font.PixelsPerInch; {$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); + // Draw company + DrawContactRow(TmpBmp, contact.Company, '', WholeRect, CompanyRect); - { do address... } - DrawContactLine(TmpBmp, TmpCon.Address1, '', WholeRect, AddrRect); + // Draw address + DrawContactRow(TmpBmp, contact.Address1, '', WholeRect, AddrRect); - { do City, State, Zip } - Str := AssembleCSZ(TmpCon, 1, FContactGrid.GetCityStateZipFormat); - DrawContactLine(TmpBmp, Str, '', WholeRect, CSZRect); + // Draw city, state, zip + Str := AssembleCSZ(contact, 1, FContactGrid.GetCityStateZipFormat); + DrawContactRow(TmpBmp, Str, '', WholeRect, CSZRect); - { do Phone1 } - Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType1)) + ': '; - DrawContactLine(TmpBmp, TmpCon.Phone1, Str, WholeRect, Phone1Rect); + // Draw phone1 + Str := PhoneLabel(TVpPhoneType(contact.PhoneType1)) + ': '; + DrawContactRow(TmpBmp, contact.Phone1, Str, WholeRect, Phone1Rect); - { do Phone2 } - Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType2)) + ': '; - DrawContactLine(TmpBmp, TmpCon.Phone2, Str, WholeRect, Phone2Rect); + // Draw phone2 + Str := PhoneLabel(TVpPhoneType(contact.PhoneType2)) + ': '; + DrawContactRow(TmpBmp, contact.Phone2, Str, WholeRect, Phone2Rect); - { do Phone3 } - Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType3)) + ': '; - DrawContactLine(TmpBmp, TmpCon.Phone3, Str, WholeRect, Phone3Rect); + // Draw phone3 + Str := PhoneLabel(TVpPhoneType(contact.PhoneType3)) + ': '; + DrawContactRow(TmpBmp, contact.Phone3, Str, WholeRect, Phone3Rect); - { do Phone4 } - Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType4)) + ': '; - DrawContactLine(TmpBmp, TmpCon.Phone4, Str, WholeRect, Phone4Rect); + // Draw phone4 + Str := PhoneLabel(TVpPhoneType(contact.PhoneType4)) + ': '; + DrawContactRow(TmpBmp, contact.Phone4, Str, WholeRect, Phone4Rect); - { do Phone5 } - Str := PhoneLabel(TVpPhoneType(TmpCon.PhoneType5)) + ': '; - DrawContactLine(TmpBmp, TmpCon.Phone5, Str, WholeRect, Phone5Rect); + // Draw phone5 + Str := PhoneLabel(TVpPhoneType(contact.PhoneType5)) + ': '; + DrawContactRow(TmpBmp, contact.Phone5, Str, WholeRect, Phone5Rect); - { do EMail } - Str := TVpContactGridOpener(FContactGrid).GetDisplayEMailValue(TmpCon); - DrawContactLine(TmpBmp, Str, RSEmail + ': ', WholeRect, EMailRect); + // Draw EMail + Str := TVpContactGridOpener(FContactGrid).GetDisplayEMailValue(contact); + DrawContactRow(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 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: @@ -522,7 +525,7 @@ begin end; end; - { add a little spacing between records } + // Add some spacing between records case Angle of ra0 : WholeRect.Bottom := WholeRect.Bottom + FScaledTextMargin * 2; ra90 : WholeRect.Left := WholeRect.Left - FScaledTextMargin * 2; @@ -530,7 +533,7 @@ begin ra270 : WholeRect.Right := WholeRect.Right + FScaledTextMargin * 2; end; - { Update Array Rects } + // Update array rects with TVpContactGridOpener(FContactGrid) do begin cgContactArray[I].WholeRect := MoveRect(WholeRect, Anchor); cgContactArray[I].HeaderRect := MoveRect(HeadRect, Anchor); @@ -545,46 +548,10 @@ begin 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 - HeightOf(WholeRect) + 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 + WidthOf(WholeRect), - Anchor.Y + RenderIn.Top + HeightOf(WholeRect) - ); - end; + // Draw the contact bitmap on the rendering canvas + PaintContactBitmap(TmpBmp, contact, Anchor, WholeRect); - //debugln(['wholerect: ', wholerect.left, ' ', wholerect.top, ' ', wholerect.right, ' ', wholerect.bottom]); - //debugLn(['scaledtextmargin: ', fscaledtextmargin]); - - RenderCanvas.CopyRect(R, TmpBmp.Canvas, WholeRect); - - // Draw focus rect around selected record - if FContactGrid.Focused and (TmpCon = FContactGrid.ActiveContact) then begin - with TVpContactGridOpener(FContactGrid).cgContactArray[I] do begin - R := WholeRect; - InflateRect(R, px3, 0); - OffsetRect(R, 0, -px3); - RenderCanvas.DrawFocusRect(R); - end; - end; - - { slide anchor down for the next record } + // 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); @@ -601,7 +568,7 @@ begin with TVpContactGridOpener(FContactGrid) do if (Anchor.X > RenderIn.Right) and (I < DataStore.Resource.Contacts.Count) then begin - { we have filled in the visible area } + // We have filled in the visible area FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; @@ -613,7 +580,7 @@ begin with TVpContactGridOpener(FContactGrid) do if (Anchor.Y > RenderIn.Bottom) and (I < contactCount) then begin - { we have filled in the visible area } + // We have filled in the visible area FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; @@ -625,7 +592,7 @@ begin with TVpContactGridOpener(FContactGrid) do begin if (Anchor.X < RenderIn.Left) and (I < contactCount) then begin - { we have filled in the visible area } + // We have filled in the visible area FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; @@ -637,7 +604,7 @@ begin with TVpContactGridOpener(FContactGrid) do begin if (Anchor.Y < RenderIn.Top) and (I < contactCount) then begin - { we have filled in the visible area } + // We have filled in the visible area FContactsAfter := contactCount - I; FVisibleContacts := contactCount - StartContact - FContactsAfter; Break; @@ -676,8 +643,6 @@ begin //scaledPenWidth := round(1 * Scale); px2 := round(2 * Scale); - debugln([Realcolumnwidth]); - // Draw vertical bars. RenderCanvas.Pen.Color := RealBarColor; RenderCanvas.Pen.Style := psSolid; @@ -781,6 +746,59 @@ begin 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);