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

tvplanit: Improving LCL scaling.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-02 17:38:26 +00:00
parent f60702ccb7
commit 30acf7208e
30 changed files with 448 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -126,71 +126,73 @@ 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 := TextMargin;
ATextRect.Top := AWholeRect.Bottom + TextMargin div 2;
ATextRect.Left := txtMargin;
ATextRect.Top := AWholeRect.Bottom + txtMargin div 2;
ATextRect.Right := ABitmap.Width;
ATextRect.Bottom := ATextRect.Top + txtHeight + TextMargin div 2;
ATextRect.Bottom := ATextRect.Top + txtHeight + txtMargin div 2;
AWholeRect.Bottom := ATextRect.Bottom;
txtColWidth := ABitmap.Width;
end;
ra90:
begin
ATextRect.Left := AWholeRect.Left - txtHeight + TextMargin div 2;
ATextRect.Top := TextMargin;
ATextRect.Right := AWholeRect.Left - TextMargin div 2;
ATextRect.Bottom := AWholeRect.Bottom + TextMargin div 2;
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;
AWholeRect.Left := ATextRect.Left;
txtColWidth := ABitmap.Height;
end;
ra180:
begin
ATextRect.Left := AWholeRect.Right - TextMargin * 2; // Shouldn't this be "div 2" ?
ATextRect.Top := AWholeRect.Top - txtHeight - TextMargin;
ATextRect.Right := AWholeRect.Left + TextMargin;
ATextRect.Bottom := AWholeRect.Top - TextMargin div 2;
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;
AWholeRect.Top := ATextRect.Top;
txtColWidth := ABitmap.Width;
end;
ra270:
begin
ATextRect.Left := AWholeRect.Right;
ATextRect.Top := AWholeRect.Bottom - TextMargin;
ATextRect.Right := AWholeRect.Right + txtHeight + TextMargin div 2;
ATextRect.Bottom := AWholeRect.Top + TextMargin div 2;
ATextRect.Top := AWholeRect.Bottom - txtMargin;
ATextRect.Right := AWholeRect.Right + txtHeight + txtMargin div 2;
ATextRect.Bottom := AWholeRect.Top + txtMargin div 2;
AWholeRect.Right := ATextRect.Right;
txtColWidth := ABitmap.Height;
end;
end; // case Angle...
AText := GetDisplayString(ABitmap.Canvas, AText, 2, txtColWidth - TextMargin * 2);
AText := GetDisplayString(ABitmap.Canvas, AText, 2, txtColWidth - txtMargin * 2);
if ALabel <> '' then begin
TPSTextOutAtPoint(
ABitmap.Canvas,
Angle,
Rect(0, 0, ABitmap.Width, ABitmap.Height),
ATextRect.Left + TextMargin,
ATextRect.Top + TextMargin div 2,
ATextRect.Left + txtMargin,
ATextRect.Top + txtMargin div 2,
ALabel
);
with ATextRect do
case Angle of
ra0 : TopLeft := Point(Left + PhoneLblWidth, Top + TextMargin div 2);
ra90 : TopLeft := Point(Top + PhoneLblWidth, Left + TextMargin);
ra180 : TopLeft := Point(Left - PhoneLblWidth, top + TextMargin div 2);
ra270 : TopLeft := Point(Left + TextMargin div 2, Top - PhoneLblWidth);
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);
end;
TPSTextOutAtPoint(
ABitmap.Canvas,
@ -205,8 +207,8 @@ begin
ABitmap.Canvas,
Angle,
Rect(0, 0, ABitmap.Width, ABitmap.Height),
ATextRect.Left + TextMargin,
ATextRect.Top + TextMargin div 2,
ATextRect.Left + txtMargin,
ATextRect.Top + txtMargin div 2,
AText
);
end;
@ -239,6 +241,7 @@ var
contactCount: Integer;
baseTextHeight: Integer;
maxTextWidth: Integer;
txtMargin: Integer;
begin
{ if the component is sufficiently small then no sense in painting it }
if (FContactGrid.Height < 20) then exit;
@ -258,16 +261,18 @@ begin
TextXOffset := 0;
TextYOffset := 0;
txtMargin := FContactGrid.TextMargin;
{ create a temporary bitmap for painting the items }
TmpBmp := TBitmap.Create;
try
if (Angle = ra0) or (Angle = ra180) then begin
TmpBmp.Width := RealColumnWidth - TextMargin * 4 + 4; // wp:+4
TmpBmp.Height := RealHeight - TextMargin * 2;
TmpBmp.Width := RealColumnWidth - txtMargin * 4 + 4; // wp:+4
TmpBmp.Height := RealHeight - txtMargin * 2;
TextColWidth := TmpBmp.Width;
end else begin
TmpBmp.Height := RealColumnWidth - TextMargin * 4 + 4; // wp: +4
TmpBmp.Width := RealHeight - TextMargin * 2;
TmpBmp.Height := RealColumnWidth - txtMargin * 4 + 4; // wp: +4
TmpBmp.Width := RealHeight - txtMargin * 2;
TextColWidth := TmpBmp.Height;
end;
TmpBmpRect := Rect(0, 0, TmpBmp.Width, TmpBmp.Height);
@ -297,18 +302,18 @@ begin
{ Set the anchor starting point }
case Angle of
ra0:
Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2);
Anchor := Point(2 + txtMargin * 2, 2 + txtMargin * 2);
ra90:
Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2);
Anchor := Point(2 + txtMargin * 2, 2 + txtMargin * 2);
ra180:
Anchor := Point(
RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - TextMargin * 2,
TmpBmp.Height - 2 - TextMargin * 2
RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - txtMargin * 2,
TmpBmp.Height - 2 - txtMargin * 2
);
ra270:
Anchor := Point(
2 + TextMargin * 2,
RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - TextMargin * 2
2 + txtMargin * 2,
RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - txtMargin * 2
);
end;
RecsInCol := 0;
@ -340,14 +345,14 @@ begin
HeadRect.TopLeft := Point(0, 0);
HeadRect.BottomRight := Point(
TmpBmp.Width,
HeadRect.Top + baseTextHeight + TextMargin div 2
HeadRect.Top + baseTextHeight + txtMargin div 2
);
WholeRect.BottomRight := HeadRect.BottomRight;
end;
ra90: // TO DO: CHECK CORRECT USAGE OF TextMargin HERE !!!!!!!!!
begin
HeadRect.TopLeft := Point(
TmpBmpRect.Right - TextMargin - baseTextHeight + TextMargin div 2,
TmpBmpRect.Right - txtMargin - baseTextHeight + txtMargin div 2,
0
);
HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height);
@ -358,21 +363,21 @@ begin
begin
WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
HeadRect.TopLeft := Point(
TextMargin,
TmpBmpRect.Bottom - baseTextHeight - TextMargin
txtMargin,
TmpBmpRect.Bottom - baseTextHeight - txtMargin
);
HeadRect.BottomRight := Point(
TmpBmp.Width,
TmpBmp.Height - TextMargin div 2
TmpBmp.Height - txtMargin div 2
);
WholeRect.TopLeft := HeadRect.TopLeft;
end;
ra270:
begin
WholeRect.TopLeft := Point(0, 0);
HeadRect.TopLeft := Point(0, TextMargin);
HeadRect.TopLeft := Point(0, txtMargin);
HeadRect.BottomRight := Point(
TextMargin + baseTextHeight + TextMargin div 2,
txtMargin + baseTextHeight + txtMargin div 2,
TmpBmp.Height
);
WholeRect.BottomRight := HeadRect.BottomRight;
@ -394,18 +399,18 @@ begin
case Angle of
ra90:
begin
TextXOffset := WidthOf(HeadRect) - TextMargin div 2;
TextYOffset := TextMargin div 3;
TextXOffset := WidthOf(HeadRect) - txtMargin div 2;
TextYOffset := txtMargin div 3;
end;
ra180:
begin
TextXOffset := WidthOf(HeadRect) - TextMargin;
TextYOffset := HeightOf(HeadRect) - TextMargin div 3;
TextXOffset := WidthOf(HeadRect) - txtMargin;
TextYOffset := HeightOf(HeadRect) - txtMargin div 3;
end;
ra270:
begin
TextXOffset := TextMargin div 2;
TextYOffset := HeightOf(HeadRect) - TextMargin div 3;
TextXOffset := txtMargin div 2;
TextYOffset := HeightOf(HeadRect) - txtMargin div 3;
end;
end;
@ -415,14 +420,14 @@ begin
else
maxTextWidth := HeightOf(HeadRect);
Str := AssembleName(TmpCon);
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, maxTextWidth - TextMargin);
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, maxTextWidth - txtMargin);
TPSTextOutAtPoint(
TmpBmp.Canvas,
Angle,
TmpBmpRect,
HeadRect.Left + TextMargin div 2 + TextXOffset,
HeadRect.Top + TextMargin div 3 + TextYOffset,
HeadRect.Left + txtMargin div 2 + TextXOffset,
HeadRect.Top + txtMargin div 3 + TextYOffset,
Str
);
@ -474,11 +479,11 @@ begin
if RecsInCol > 0 then
case Angle of
ra0:
if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - TextMargin * 3) then
if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - txtMargin * 3) then
begin
Anchor := Point(
Anchor.x + WholeRect.Right + FContactGrid.BarWidth + 1 + TextMargin * 3,
2 + TextMargin * 2
Anchor.x + WholeRect.Right + FContactGrid.BarWidth + 1 + txtMargin * 3,
2 + txtMargin * 2
);
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
@ -488,10 +493,10 @@ begin
Exit;
end;
ra90 :
if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - TextMargin * 3) then
if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - txtMargin * 3) then
begin
Anchor.x := 2 + TextMargin * 2;
Anchor.y := Anchor.y + WholeRect.Bottom + FContactGrid.BarWidth + 1 + TextMargin * 3;
Anchor.x := 2 + txtMargin * 2;
Anchor.y := Anchor.y + WholeRect.Bottom + FContactGrid.BarWidth + 1 + txtMargin * 3;
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
Inc(Col);
@ -500,10 +505,10 @@ begin
Exit;
end;
ra180 :
if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + TextMargin * 3) then
if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + txtMargin * 3) then
begin
Anchor.x := Anchor.x - (WholeRect.Right + FContactGrid.BarWidth + 1 + TextMargin * 3);
Anchor.y := TmpBmp.Height - 2 - TextMargin * 2;
Anchor.x := Anchor.x - (WholeRect.Right + FContactGrid.BarWidth + 1 + txtMargin * 3);
Anchor.y := TmpBmp.Height - 2 - txtMargin * 2;
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
Inc(Col);
@ -512,10 +517,10 @@ begin
Exit;
end;
ra270 :
if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - TextMargin * 3) then
if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - txtMargin * 3) then
begin
Anchor.x := 2 + TextMargin * 2;
Anchor.y := Anchor.y - (WholeRect.Bottom + FContactGrid.BarWidth + 1 + TextMargin * 3);
Anchor.x := 2 + txtMargin * 2;
Anchor.y := Anchor.y - (WholeRect.Bottom + FContactGrid.BarWidth + 1 + txtMargin * 3);
if Col = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
Inc(Col);
@ -527,10 +532,10 @@ begin
{ add a little spacing between records }
case Angle of
ra0 : WholeRect.Bottom := WholeRect.Bottom + TextMargin * 2;
ra90 : WholeRect.Left := WholeRect.Left - TextMargin * 2;
ra180 : WholeRect.Top := WholeRect.Top - TextMargin * 2;
ra270 : WholeRect.Right := WholeRect.Right + TextMargin * 2;
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;
end;
{ Update Array Rects }
@ -679,8 +684,8 @@ begin
TVpContactGridOpener(FContactGrid).cgBarArray[BarCount].Index := BarCount;
for I := 1 to FContactGrid.BarWidth do begin
TPSMoveTo(RenderCanvas, Angle, RenderIn, BarPos, RealTop + 2 + TextMargin * 2);
TPSLineTo(RenderCanvas, Angle, RenderIn, BarPos, RealBottom - TextMargin * 2);
TPSMoveTo(RenderCanvas, Angle, RenderIn, BarPos, RealTop + 2 + FContactGrid.TextMargin * 2);
TPSLineTo(RenderCanvas, Angle, RenderIn, BarPos, RealBottom - FContactGrid.TextMargin * 2);
Inc(BarPos);
end;
Inc(BarPos, RealColumnWidth);
@ -714,12 +719,12 @@ begin
TPSMoveTo(
RenderCanvas, Angle, RenderIn,
RealLeft + BarPos,
RealTop + 2 + TextMargin * 2
RealTop + 2 + FContactGrid.TextMargin * 2
);
TPSLineTo(
RenderCanvas, Angle, RenderIn,
RealLeft + BarPos,
RealBottom - TextMargin * 2
RealBottom - FContactGrid.TextMargin * 2
);
Inc(BarPos);
end;
@ -732,12 +737,15 @@ end;
procedure TVpContactGridPainter.FixFontHeights;
begin
{$IF VP_LCL_SCALING = 0}
with FContactGrid do begin
{$IF VP_LCL_SCALING = 0}
ContactHeadAttributes.Font.Height := GetRealFontHeight(ContactHeadAttributes.Font);
Font.Height := GetRealFontHeight(Font);
{$ELSE}
ContactHeadAttributes.Font.Height := FixFontHeight(ContactHeadAttributes.Font);
Font.Height := FixFontHeight(Font);
{$ENDIF}
end;
{$ENDIF}
end;
procedure TVpContactGridPainter.InitColors;