tvplanit: Fix scaling when printing contacts to printer.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8521 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-07 17:45:28 +00:00
parent 8210ffc6af
commit 469cf2e19e
4 changed files with 169 additions and 122 deletions

View File

@ -117,6 +117,7 @@ type
FExternalPopup: TPopupMenu;
FHintMode: TVpHintMode;
FPendingDatastore: TVpCustomDatastore;
// FRowHeight: Integer;
FTextMargin: Integer;
procedure InternalSetDatastore(const Value: TVpCustomDatastore);
procedure SetPopupMenu(AValue: TPopupMenu);
@ -157,7 +158,6 @@ type
cgClickPoint : TPoint;
cgClickTimer : TTimer;
cgLoaded : Boolean;
cgRowHeight : Integer;
cgInPlaceEditor : TVpCGInPlaceEdit;
cgCreatingEditor : Boolean;
cgPainting : Boolean;
@ -180,7 +180,7 @@ type
procedure SetDataStore(const Value: TVpCustomDataStore); override;
{ internal methods }
procedure cgCalcRowHeight;
// procedure cgCalcRowHeight;
procedure cgEditInPlace(Sender: TObject);
procedure cgHookUp;
function ContactIsVisible(AIndex: Integer): Boolean;
@ -279,6 +279,9 @@ type
property ActiveContact: TVpContact read FActiveContact;
property ContactIndex: Integer read FContactIndex write SetContactIndex;
// Unscaled some dimensions
// property RowHeight: Integer read FRowHeight;
published
property Align;
property Anchors;
@ -903,24 +906,38 @@ begin
Invalidate;
end;
end;
(*
{ Calculates row height based on the largest of the header font and the
standard client font, using a sample character string. }
procedure TVpContactGrid.cgCalcRowHeight;
var
SaveFont: TFont;
Temp: Integer;
//savedFont: TFont;
h: Integer;
begin
{ Calculates row height based on the largest of the RowHead's Minute font,
the standard client font, and a sample character string. }
SaveFont := Canvas.Font;
FRowHeight := GetCanvasTextHeight(Canvas, FContactHeadAttr.Font, TallShortChars);
h := GetCanvasTextHeight(Canvas, Font, TallShortChars);
if h > FRowHeight then
FRowHeight := h;
FRowHeight := FRowHeight + FTextMargin * 2;
{
savedFont := Canvas.Font;
Canvas.Font.Assign(FContactHeadAttr.Font);
cgRowHeight := Canvas.TextHeight(TallShortChars);
Canvas.Font.Assign(SaveFont);
Temp := Canvas.TextHeight(TallShortChars);
if Temp > cgRowHeight then
cgRowHeight := Temp;
cgRowHeight := cgRowHeight + TextMargin * 2;
Canvas.Font.Assign(SaveFont);
FRowHeight := Canvas.TextHeight(TallShortChars);
Canvas.Font.Assign(savedFont);
tmp := Canvas.TextHeight(TallShortChars);
if tmp > FRowHeight then
FRowHeight := tmp;
FRowHeight := FRowHeight + TextMargin * 2;
Canvas.Font.Assign(savedFont);
}
end;
*)
procedure TVpContactGrid.SetDrawingStyle(const Value: TVpDrawingStyle);
begin
@ -1000,7 +1017,7 @@ end;
procedure TVpContactGrid.CreateWnd;
begin
inherited;
cgCalcRowHeight;
// cgCalcRowHeight;
SetHScrollPos;
end;

View File

@ -4,8 +4,8 @@ unit VpContactGridPainter;
interface
uses
LCLType, LCLIntf,
uses lazlogger,
LCLType, LCLIntf, SysUtils,
Types, Classes, Graphics,
VpConst, VPBase, VpData, VpBasePainter, VpContactGrid;
@ -13,6 +13,9 @@ type
TVpContactGridPainter = class(TVpBasePainter)
private
FContactGrid: TVpContactGrid;
// FScaledRowHeight: Integer;
FScaledTextMargin: Integer;
// local variables of the original TVpContactGrid method
PhoneLblWidth: Integer;
StartContact: Integer;
@ -35,6 +38,7 @@ type
procedure DrawVerticalBars;
procedure FixFontHeights;
procedure InitColors;
procedure SetMeasurements; override;
public
constructor Create(AContactGrid: TVpContactGrid; ARenderCanvas: TCanvas);
@ -117,73 +121,71 @@ procedure TVpContactGridPainter.DrawContactLine(ABitmap: TBitmap;
var
txtheight: Integer;
txtColWidth: Integer;
txtMargin: Integer;
begin
if AText = '' then begin
ATextRect := Rect(0, 0, 0, 0);
exit;
end;
txtMargin := FContactGrid.TextMargin;
txtHeight := ABitmap.Canvas.TextHeight(VpProductName);
case Angle of
ra0:
begin
ATextRect.Left := txtMargin;
ATextRect.Top := AWholeRect.Bottom + txtMargin div 2;
ATextRect.Left := FScaledTextMargin;
ATextRect.Top := AWholeRect.Bottom + FScaledTextMargin div 2;
ATextRect.Right := ABitmap.Width;
ATextRect.Bottom := ATextRect.Top + txtHeight + txtMargin div 2;
ATextRect.Bottom := ATextRect.Top + txtHeight + FScaledTextMargin div 2;
AWholeRect.Bottom := ATextRect.Bottom;
txtColWidth := ABitmap.Width;
end;
ra90:
begin
ATextRect.Left := AWholeRect.Left - txtHeight + txtMargin div 2;
ATextRect.Top := txtMargin;
ATextRect.Right := AWholeRect.Left - txtMargin div 2;
ATextRect.Bottom := AWholeRect.Bottom + txtMargin div 2;
ATextRect.Left := AWholeRect.Left - txtHeight + FScaledTextMargin div 2;
ATextRect.Top := FScaledTextMargin;
ATextRect.Right := AWholeRect.Left - FScaledTextMargin div 2;
ATextRect.Bottom := AWholeRect.Bottom + FScaledTextMargin div 2;
AWholeRect.Left := ATextRect.Left;
txtColWidth := ABitmap.Height;
end;
ra180:
begin
ATextRect.Left := AWholeRect.Right - txtMargin * 2; // Shouldn't this be "div 2" ?
ATextRect.Top := AWholeRect.Top - txtHeight - txtMargin;
ATextRect.Right := AWholeRect.Left + txtMargin;
ATextRect.Bottom := AWholeRect.Top - txtMargin div 2;
ATextRect.Left := AWholeRect.Right - FScaledTextMargin * 2; // Shouldn't this be "div 2" ?
ATextRect.Top := AWholeRect.Top - txtHeight - FScaledTextMargin;
ATextRect.Right := AWholeRect.Left + FScaledTextMargin;
ATextRect.Bottom := AWholeRect.Top - FScaledTextMargin div 2;
AWholeRect.Top := ATextRect.Top;
txtColWidth := ABitmap.Width;
end;
ra270:
begin
ATextRect.Left := AWholeRect.Right;
ATextRect.Top := AWholeRect.Bottom - txtMargin;
ATextRect.Right := AWholeRect.Right + txtHeight + txtMargin div 2;
ATextRect.Bottom := AWholeRect.Top + txtMargin div 2;
ATextRect.Top := AWholeRect.Bottom - FScaledTextMargin;
ATextRect.Right := AWholeRect.Right + txtHeight + FScaledTextMargin div 2;
ATextRect.Bottom := AWholeRect.Top + FScaledTextMargin div 2;
AWholeRect.Right := ATextRect.Right;
txtColWidth := ABitmap.Height;
end;
end; // case Angle...
AText := GetDisplayString(ABitmap.Canvas, AText, 2, txtColWidth - txtMargin * 2);
AText := GetDisplayString(ABitmap.Canvas, AText, 2, txtColWidth - FScaledTextMargin * 2);
if ALabel <> '' then begin
TPSTextOutAtPoint(
ABitmap.Canvas,
Angle,
Rect(0, 0, ABitmap.Width, ABitmap.Height),
ATextRect.Left + txtMargin,
ATextRect.Top + txtMargin div 2,
ATextRect.Left + FScaledTextMargin,
ATextRect.Top + FScaledTextMargin div 2,
ALabel
);
with ATextRect do
case Angle of
ra0 : TopLeft := Point(Left + PhoneLblWidth, Top + txtMargin div 2);
ra90 : TopLeft := Point(Top + PhoneLblWidth, Left + txtMargin);
ra180 : TopLeft := Point(Left - PhoneLblWidth, top + txtMargin div 2);
ra270 : TopLeft := Point(Left + txtMargin div 2, Top - PhoneLblWidth);
ra0 : TopLeft := Point(Left + PhoneLblWidth, Top + FScaledTextMargin div 2);
ra90 : TopLeft := Point(Top + PhoneLblWidth, Left + FScaledTextMargin);
ra180 : TopLeft := Point(Left - PhoneLblWidth, top + FScaledTextMargin div 2);
ra270 : TopLeft := Point(Left + FScaledTextMargin div 2, Top - PhoneLblWidth);
end;
TPSTextOutAtPoint(
ABitmap.Canvas,
@ -198,8 +200,8 @@ begin
ABitmap.Canvas,
Angle,
Rect(0, 0, ABitmap.Width, ABitmap.Height),
ATextRect.Left + txtMargin,
ATextRect.Top + txtMargin div 2,
ATextRect.Left + FScaledTextMargin,
ATextRect.Top + FScaledTextMargin div 2,
AText
);
end;
@ -207,7 +209,7 @@ end;
procedure TVpContactGridPainter.DrawContacts;
var
Anchor: TPoint;
I, J: Integer;
I, J, W: Integer;
Str: string;
TmpBmp: TBitmap;
TmpCon: TVpContact;
@ -232,89 +234,97 @@ var
contactCount: Integer;
baseTextHeight: Integer;
maxTextWidth: Integer;
txtMargin: Integer;
px2: Integer; // Scaled 2, 3, 4 pixels
px3: Integer;
px4: Integer;
begin
{ if the component is sufficiently small then no sense in painting it }
if (FContactGrid.Height < 20) then exit;
// 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 }
// 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 }
// Some initializations
contactCount := FContactGrid.DataStore.Resource.Contacts.Count;
oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount;
TVpContactGridOpener(FContactGrid).FVisibleContacts := 0;
TVpContactGridOpener(FContactGrid).cgCol1RecCount := 0;
TextXOffset := 0;
TextYOffset := 0;
px2 := Round(2 * Scale);
px3 := Round(3 * Scale);
px4 := Round(4 * Scale);
txtMargin := FContactGrid.TextMargin;
{ create a temporary bitmap for painting the items }
// Create a temporary bitmap for painting the items
TmpBmp := TBitmap.Create;
try
if (Angle = ra0) or (Angle = ra180) then begin
TmpBmp.Width := RealColumnWidth - txtMargin * 4 + 4; // wp:+4
TmpBmp.Height := RealHeight - txtMargin * 2;
TmpBmp.Width := RealColumnWidth - FScaledTextMargin * 4 + px4;
TmpBmp.Height := RealHeight - FScaledTextMargin * 2;
TextColWidth := TmpBmp.Width;
end else begin
TmpBmp.Height := RealColumnWidth - txtMargin * 4 + 4; // wp: +4
TmpBmp.Width := RealHeight - txtMargin * 2;
TmpBmp.Height := RealColumnWidth - FScaledTextMargin * 4 + px4;
TmpBmp.Width := RealHeight - FScaledTextMargin * 2;
TextColWidth := TmpBmp.Height;
end;
TmpBmpRect := Rect(0, 0, TmpBmp.Width, TmpBmp.Height);
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 Phone Lbl Width }
DebugLn('baseTextHeight: ' + IntToStr(baseTextHeight));
// Calculate max phone label 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;
w := TmpBmp.Canvas.TextWidth(Str);
if w > PhoneLblWidth then
PhoneLblWidth := w;
end;
Col := 1;
{ clear the bitmap }
// Clear the bitmap /// wp: this is done in the loop also?
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 }
// Set the anchor starting point
case Angle of
ra0:
Anchor := Point(2 + txtMargin * 2, 2 + txtMargin * 2);
Anchor := Point(2 + FScaledTextMargin * 2, px2 + FScaledTextMargin * 2);
ra90:
Anchor := Point(2 + txtMargin * 2, 2 + txtMargin * 2);
Anchor := Point(2 + FScaledTextMargin * 2, px2 + FScaledTextMargin * 2);
ra180:
Anchor := Point(
RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - txtMargin * 2,
TmpBmp.Height - 2 - txtMargin * 2
RenderIn.Right - RenderIn.Left - TmpBmp.Width - px2 - FScaledTextMargin * 2,
TmpBmp.Height - px2 - FScaledTextMargin * 2
);
ra270:
Anchor := Point(
2 + txtMargin * 2,
RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - txtMargin * 2
px2 + FScaledTextMargin * 2,
RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - px2 - FScaledTextMargin * 2
);
end;
RecsInCol := 0;
// Sort the records
FContactGrid.DataStore.Resource.Contacts.Sort;
// Iterate over all contacts
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 }
// Clear bmp canvas
TmpBmp.Canvas.Brush.Color := RealColor;
TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height));
@ -322,6 +332,7 @@ begin
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}
@ -331,19 +342,17 @@ begin
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 + txtMargin div 2
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 - txtMargin - baseTextHeight + txtMargin div 2,
TmpBmpRect.Right - FScaledTextMargin - baseTextHeight + FScaledTextMargin div 2,
0
);
HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height);
@ -354,21 +363,21 @@ begin
begin
WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
HeadRect.TopLeft := Point(
txtMargin,
TmpBmpRect.Bottom - baseTextHeight - txtMargin
FScaledTextMargin,
TmpBmpRect.Bottom - baseTextHeight - FScaledTextMargin
);
HeadRect.BottomRight := Point(
TmpBmp.Width,
TmpBmp.Height - txtMargin div 2
TmpBmp.Height - FScaledTextMargin div 2
);
WholeRect.TopLeft := HeadRect.TopLeft;
end;
ra270:
begin
WholeRect.TopLeft := Point(0, 0);
HeadRect.TopLeft := Point(0, txtMargin);
HeadRect.TopLeft := Point(0, FScaledTextMargin);
HeadRect.BottomRight := Point(
txtMargin + baseTextHeight + txtMargin div 2,
FScaledTextMargin + baseTextHeight + FScaledTextMargin div 2,
TmpBmp.Height
);
WholeRect.BottomRight := HeadRect.BottomRight;
@ -390,18 +399,18 @@ begin
case Angle of
ra90:
begin
TextXOffset := WidthOf(HeadRect) - txtMargin div 2;
TextYOffset := txtMargin div 3;
TextXOffset := WidthOf(HeadRect) - FScaledTextMargin div 2;
TextYOffset := FScaledTextMargin div 3;
end;
ra180:
begin
TextXOffset := WidthOf(HeadRect) - txtMargin;
TextYOffset := HeightOf(HeadRect) - txtMargin div 3;
TextXOffset := WidthOf(HeadRect) - FScaledTextMargin;
TextYOffset := HeightOf(HeadRect) - FScaledTextMargin div 3;
end;
ra270:
begin
TextXOffset := txtMargin div 2;
TextYOffset := HeightOf(HeadRect) - txtMargin div 3;
TextXOffset := FScaledTextMargin div 2;
TextYOffset := HeightOf(HeadRect) - FScaledTextMargin div 3;
end;
end;
@ -411,19 +420,20 @@ begin
else
maxTextWidth := HeightOf(HeadRect);
Str := AssembleName(TmpCon);
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, maxTextWidth - txtMargin);
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, maxTextWidth - FScaledTextMargin);
TPSTextOutAtPoint(
TmpBmp.Canvas,
Angle,
TmpBmpRect,
HeadRect.Left + txtMargin div 2 + TextXOffset,
HeadRect.Top + txtMargin div 3 + TextYOffset,
HeadRect.Left + FScaledTextMargin div 2 + TextXOffset,
HeadRect.Top + FScaledTextMargin div 3 + TextYOffset,
Str
);
{ restore font and colors }
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}
@ -470,11 +480,11 @@ begin
if RecsInCol > 0 then
case Angle of
ra0:
if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - txtMargin * 3) then
if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - FScaledTextMargin * 3) then
begin
Anchor := Point(
Anchor.x + WholeRect.Right + FContactGrid.BarWidth + 1 + txtMargin * 3,
2 + txtMargin * 2
Anchor.x + WholeRect.Right + FContactGrid.BarWidth + 1 + FScaledTextMargin * 3,
px2 + FScaledTextMargin * 2
);
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
@ -484,10 +494,10 @@ begin
Exit;
end;
ra90 :
if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - txtMargin * 3) then
if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - FScaledTextMargin * 3) then
begin
Anchor.x := 2 + txtMargin * 2;
Anchor.y := Anchor.y + WholeRect.Bottom + FContactGrid.BarWidth + 1 + txtMargin * 3;
Anchor.x := px2 + FScaledTextMargin * 2;
Anchor.y := Anchor.y + WholeRect.Bottom + FContactGrid.BarWidth + 1 + FScaledTextMargin * 3;
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
Inc(Col);
@ -496,10 +506,10 @@ begin
Exit;
end;
ra180 :
if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + txtMargin * 3) then
if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + FScaledTextMargin * 3) then
begin
Anchor.x := Anchor.x - (WholeRect.Right + FContactGrid.BarWidth + 1 + txtMargin * 3);
Anchor.y := TmpBmp.Height - 2 - txtMargin * 2;
Anchor.x := Anchor.x - (WholeRect.Right + FContactGrid.BarWidth + 1 + FScaledTextMargin * 3);
Anchor.y := TmpBmp.Height - px2 - FScaledTextMargin * 2;
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
Inc(Col);
@ -508,10 +518,10 @@ begin
Exit;
end;
ra270 :
if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - txtMargin * 3) then
if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - FScaledTextMargin * 3) then
begin
Anchor.x := 2 + txtMargin * 2;
Anchor.y := Anchor.y - (WholeRect.Bottom + FContactGrid.BarWidth + 1 + txtMargin * 3);
Anchor.x := px2 + FScaledTextMargin * 2;
Anchor.y := Anchor.y - (WholeRect.Bottom + FContactGrid.BarWidth + 1 + FScaledTextMargin * 3);
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
Inc(Col);
@ -523,10 +533,10 @@ begin
{ add a little spacing between records }
case Angle of
ra0 : WholeRect.Bottom := WholeRect.Bottom + txtMargin * 2;
ra90 : WholeRect.Left := WholeRect.Left - txtMargin * 2;
ra180 : WholeRect.Top := WholeRect.Top - txtMargin * 2;
ra270 : WholeRect.Right := WholeRect.Right + txtMargin * 2;
ra0 : WholeRect.Bottom := WholeRect.Bottom + FScaledTextMargin * 2;
ra90 : WholeRect.Left := WholeRect.Left - FScaledTextMargin * 2;
ra180 : WholeRect.Top := WholeRect.Top - FScaledTextMargin * 2;
ra270 : WholeRect.Right := WholeRect.Right + FScaledTextMargin * 2;
end;
{ Update Array Rects }
@ -569,8 +579,8 @@ begin
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);
InflateRect(R, px3, 0);
OffsetRect(R, 0, -px3);
RenderCanvas.DrawFocusRect(R);
end;
end;
@ -656,36 +666,45 @@ end;
procedure TVpContactGridPainter.DrawVerticalBars;
var
BarPos, BarCount, I: Integer;
scaledExtraBarWidth: Integer;
scaledPenWidth: 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;
// If the component is sufficiently small then no sense in painting it.
if (FContactGrid.Height < 20) then
exit;
{ draw vertical bars }
scaledExtraBarWidth := round(ExtraBarWidth * Scale);
scaledPenWidth := round(1 * Scale);
px2 := round(2 * Scale);
// Draw vertical bars.
RenderCanvas.Pen.Color := RealBarColor;
RenderCanvas.Pen.Style := psSolid;
BarPos := RealLeft + 2 + RealColumnWidth + ExtraBarWidth;
RenderCanvas.Pen.Width := scaledPenWidth;
BarPos := RealLeft + px2 + RealColumnWidth + scaledExtraBarWidth;
BarCount := 0;
while (BarPos < RealRight) and (BarCount < Pred(MaxColumns)) do begin
TVpContactGridOpener(FContactGrid).cgBarArray[BarCount].Rec := Rect(
BarPos - ExtraBarWidth,
BarPos - scaledExtraBarWidth,
RealTop,
BarPos + ExtraBarWidth + FContactGrid.BarWidth,
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 + 2 + FContactGrid.TextMargin * 2);
TPSLineTo(RenderCanvas, Angle, RenderIn, BarPos, RealBottom - FContactGrid.TextMargin * 2);
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 the columns are being resized, then draw the temporary resizing bars.
if TVpContactGridOpener(FContactGrid).cgGridState = gsColSizing then begin
{ clear sizing bar array }
// Clear sizing bar array
for I := 0 to pred(MaxColumns) do
with TVpContactGridOpener(FContactGrid) do begin
if cgResizeBarArray[I].Index = -1 then
@ -693,10 +712,10 @@ begin
cgResizeBarArray[I].Rec := Rect(-1, -1, -1, -1);
cgResizeBarArray[I].Index := -1;
end;
{ draw sizing bars }
// Draw sizing bars
RenderCanvas.Pen.Color := SizingBarColor;
RenderCanvas.Pen.Style := psDash;
BarPos := RealLeft + 2 + TVpContactGridOpener(FContactGrid).cgNewColWidth + ExtraBarWidth;
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;
@ -710,12 +729,12 @@ begin
TPSMoveTo(
RenderCanvas, Angle, RenderIn,
RealLeft + BarPos,
RealTop + 2 + FContactGrid.TextMargin * 2
RealTop + px2 + FScaledTextMargin * 2
);
TPSLineTo(
RenderCanvas, Angle, RenderIn,
RealLeft + BarPos,
RealBottom - FContactGrid.TextMargin * 2
RealBottom - FScaledTextMargin * 2
);
Inc(BarPos);
end;
@ -816,4 +835,11 @@ begin
RestorePenBrush;
end;
procedure TVpContactGridPainter.SetMeasurements;
begin
inherited;
// FScaledRowHeight := round(FContactGrid.RowHeight * Scale);
FScaledTextMargin := round(FContactGrid.TextMargin * Scale);
end;
end.

View File

@ -308,6 +308,7 @@ type
property LeftCol: Integer read FLeftCol write SetLeftCol;
property TopRow: Integer read FTopRow write SetTopRow;
// Unscaled dimensions
property RowHeight: Integer read FRowHeight;
property DayColHeaderHeight: Integer read FDayColHeaderHeight;
property MonthColHeaderHeight: Integer read FMonthColHeaderHeight;

View File

@ -2038,8 +2038,11 @@ begin
FLastTask := StartTask;
FLastContact := StartContact;
PaintToCanvasRect(ACanvas, ARect, ADate);
// Set the return arguments. They will be needed for printing the next page.
ADate := GetNextDate(ADate);
StartTask := FLastTask; // wp: added to enable switching pages in preview
StartContact := FLastContact;
LastPage := True;
if FHaveDate and (ADate < EndDate) then