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

tvplanit: Fix layout of ContactGrid in case of rotated print formats

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8530 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-09 13:59:56 +00:00
parent 2c1fbdc6a6
commit 60fac597bf
2 changed files with 43 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,7 +27,6 @@
{* ***** END LICENSE BLOCK ***** *}
{$I vp.inc}
{$DEFINE DEBUG_CONTACTGRID}
unit VpContactGrid;
@ -36,7 +35,6 @@ interface
uses
{$IFDEF LCL}
LMessages, LCLProc, LCLType, LCLIntf,
{$IFDEF DEBUG_CONTACTGRID}LazLogger,{$ENDIF}
{$ELSE}
Windows, Messages,
{$ENDIF}
@ -1996,10 +1994,6 @@ begin
else
nPos := FContactsBefore;
nTrackPos := nPos;
{$IFDEF DEBUG_CONTACTGRID}
DebugLn(['[TVpContactGrid.SetHScrollPos] VisibleContacts=', FVisibleContacts, ' ContactsBefore=', FContactsBefore]);
{$ENDIF}
end;
SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
end;

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

@ -4,7 +4,7 @@ unit VpContactGridPainter;
interface
uses lazlogger,
uses
LCLType, LCLIntf, SysUtils,
Types, Classes, Graphics,
VpConst, VPBase, VpData, VpBasePainter, VpContactGrid;
@ -297,49 +297,41 @@ procedure TVpContactGridPainter.DrawContactRow(ABitmap: TBitmap;
var
txtheight: Integer;
txtColWidth: Integer;
txtPt: TPoint;
begin
if AText = '' then begin
ATextRect := Rect(0, 0, 0, 0);
exit;
end;
txtHeight := ABitmap.Canvas.TextHeight(VpProductName);
txtHeight := ABitmap.Canvas.TextHeight(VpProductName) + FScaledTextMargin div 2;
case Angle of
ra0:
begin
ATextRect.Left := FScaledTextMargin;
ATextRect.Top := AWholeRect.Bottom + FScaledTextMargin div 2;
ATextRect.Right := ABitmap.Width;
ATextRect.Bottom := ATextRect.Top + txtHeight + FScaledTextMargin div 2;
ATextRect := Rect(FScaledTextMargin, AWholeRect.Bottom, AWholeRect.Right, AWholeRect.Bottom + txtHeight);
AWholeRect.Bottom := ATextRect.Bottom;
txtColWidth := ABitmap.Width;
txtPt := ATextRect.TopLeft;
end;
ra90:
begin
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;
ATextRect := Rect(AWholeRect.Left - txtHeight - 1, FScaledTextMargin, AWholeRect.Left - 1, AWholeRect.Bottom);
AWholeRect.Left := ATextRect.Left;
txtColWidth := ABitmap.Height;
txtPt := Point(ATextRect.Right, ATextRect.Top);
end;
ra180:
begin
ATextRect.Left := AWholeRect.Right - FScaledTextMargin * 2; // Shouldn't this be "div 2" ?
//ATextRect.Top := AWholeRect.Top - txtHeight - FScaledTextMargin;
ATextRect.Top := AWholeRect.Top - txtHeight; // + FScaledTextMargin div 2;
ATextRect.Right := AWholeRect.Left + FScaledTextMargin;
ATextRect.Bottom := AWholeRect.Top - FScaledTextMargin div 2;
ATextRect := Rect(AWholeRect.Left, AWholeRect.Top - txtHeight, AWholeRect.Right - FScaledTextMargin, AWholeRect.Top);
AWholeRect.Top := ATextRect.Top;
txtColWidth := ABitmap.Width;
txtPt := Point(ATextRect.Right, ATextRect.Bottom);
end;
ra270:
begin
ATextRect.Left := AWholeRect.Right;
ATextRect.Top := AWholeRect.Bottom - FScaledTextMargin;
ATextRect.Right := AWholeRect.Right + txtHeight + FScaledTextMargin div 2;
ATextRect.Bottom := AWholeRect.Top + FScaledTextMargin div 2;
ATextRect := Rect(AWholeRect.Right + 1, AWholeRect.Top, AWholeRect.Right + txtHeight + 1, AWholeRect.Bottom - FScaledTextMargin);
txtPt := Point(ATextRect.Left, ATextRect.Bottom);
AWholeRect.Right := ATextRect.Right;
txtColWidth := ABitmap.Height;
end;
@ -348,39 +340,31 @@ begin
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 + FScaledTextMargin,
ATextRect.Top + FScaledTextMargin div 2,
ALabel
);
with ATextRect do
case Angle of
ra0 : TopLeft := Point(Left + FLabelWidth, Top + FScaledTextMargin div 2);
ra90 : TopLeft := Point(Top + FLabelWidth, Left + FScaledTextMargin);
ra180 : TopLeft := Point(Left - FLabelWidth, top + FScaledTextMargin div 2);
ra270 : TopLeft := Point(Left + FScaledTextMargin div 2, Top - FLabelWidth);
end;
TPSTextOutAtPoint(
ABitmap.Canvas,
Angle,
Rect(0, 0, ABitmap.Width, ABitmap.Height),
ATextRect.Left,
ATextRect.Top,
AText
);
end else
TPSTextOutAtPoint(
ABitmap.Canvas,
Angle,
Rect(0, 0, ABitmap.Width, ABitmap.Height),
ATextRect.Left + FScaledTextMargin,
ATextRect.Top + FScaledTextMargin div 2,
AText
);
ABitmap.Canvas.TextOut(txtPt.X, txtPt.Y, ALabel);
case Angle of
ra0:
begin
inc(ATextRect.Left, FLabelWidth);
txtPt.X := ATextRect.Left;
end;
ra90:
begin
inc(ATextRect.Top, FLabelWidth);
txtPt.Y := ATextRect.Top;
end;
ra180:
begin
dec(ATextRect.Right, FLabelWidth);
txtPt.X := ATextRect.Right;
end;
ra270:
begin
dec(ATextRect.Bottom, FLabelWidth);
txtPt.Y := ATextRect.Bottom;
end;
end;
end;
ABitmap.Canvas.TextOut(txtPt.X, txtPt.Y, AText);
end;
{ Draws selected data for the specified contact on the auxiliary bitmap.
@ -410,7 +394,13 @@ begin
{$IF VP_LCL_SCALING = 0}
ABitmap.Canvas.Font.Size := ScaleY(ABitmap.Canvas.Font.Size, DesignTimeDPI);
{$ENDIF}
Abitmap.Canvas.Brush.Color := RealColor;
ABitmap.Canvas.Brush.Color := RealColor;
case Angle of
ra0 : ABitmap.Canvas.Font.Orientation := 0;
ra90 : ABitmap.Canvas.Font.Orientation := 2700;
ra180 : ABitmap.Canvas.Font.Orientation := 1800;
ra270 : ABitmap.Canvas.Font.Orientation := 900;
end;
// Draw company
DrawContactRow(ABitmap, AContact.Company, '', AWholeRect, AContactRec.CompanyRect);
@ -575,8 +565,6 @@ begin
// Draw the contact data
WholeRect := HeadRect;
if Angle = ra180 then
WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
if DrawContactRows(TmpBmp, contact, Anchor, WholeRect, Col, RecsInCol, CR) then
begin
newPage := false;