You've already forked lazarus-ccr
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:
@ -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;
|
||||
|
||||
|
@ -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.
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
Reference in New Issue
Block a user