pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Fix scaling when printing contacts to printer.

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

49
components/tvplanit/source/vpcontactgrid.pas
View File

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

238
components/tvplanit/source/vpcontactgridpainter.pas
View File

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

1
components/tvplanit/source/vpganttview.pas
View File

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

3
components/tvplanit/source/vpprtfmt.pas
View File

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