diff --git a/components/tvplanit/examples/fulldemo/demo.lpi b/components/tvplanit/examples/fulldemo/demo.lpi
index c2ab30d71..b2b3eaf80 100644
--- a/components/tvplanit/examples/fulldemo/demo.lpi
+++ b/components/tvplanit/examples/fulldemo/demo.lpi
@@ -7,8 +7,12 @@
+
+
+
+
diff --git a/components/tvplanit/examples/fulldemo/demo.lpr b/components/tvplanit/examples/fulldemo/demo.lpr
index 7ea82f940..a35dfc511 100644
--- a/components/tvplanit/examples/fulldemo/demo.lpr
+++ b/components/tvplanit/examples/fulldemo/demo.lpr
@@ -13,6 +13,7 @@ uses
{$R *.res}
begin
+ Application.Scaled := True;
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TDemoDM, DemoDM);
diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm
index 71b41e9ee..08c664f42 100644
--- a/components/tvplanit/examples/fulldemo/demomain.lfm
+++ b/components/tvplanit/examples/fulldemo/demomain.lfm
@@ -9,7 +9,7 @@ object MainForm: TMainForm
Menu = MainMenu1
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
- LCLVersion = '1.6.4.0'
+ LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 125
Height = 576
@@ -58,7 +58,7 @@ object MainForm: TMainForm
Height = 528
Top = 48
Width = 834
- PageIndex = 0
+ PageIndex = 1
Align = alClient
TabOrder = 1
TabStop = True
@@ -381,7 +381,6 @@ object MainForm: TMainForm
Width = 834
ControlLink = VpControlLink1
Color = clWindow
- Font.Height = -12
ParentFont = False
Align = alClient
TabStop = True
@@ -400,7 +399,6 @@ object MainForm: TMainForm
LineColor = clGray
MaxVisibleTasks = 250
TaskHeadAttributes.Color = clSilver
- TaskHeadAttributes.Font.Height = -13
TaskHeadAttributes.Font.Style = [fsItalic]
DrawingStyle = ds3d
ShowResourceName = True
diff --git a/components/tvplanit/languages/demo.de.po b/components/tvplanit/languages/demo.de.po
index 69b42ca07..c9d79bac6 100644
--- a/components/tvplanit/languages/demo.de.po
+++ b/components/tvplanit/languages/demo.de.po
@@ -251,16 +251,6 @@ msgstr "Datei"
msgid "Help"
msgstr "Hilfe"
-#: tmainform.menuitem3.caption
-msgctxt "tmainform.menuitem3.caption"
-msgid "-"
-msgstr ""
-
-#: tmainform.menuitem4.caption
-msgctxt "tmainform.menuitem4.caption"
-msgid "-"
-msgstr ""
-
#: tmainform.mnuabout.caption
msgid "About Visual PlanIt"
msgstr "Über Visual PlanIt"
diff --git a/components/tvplanit/languages/demo.fi.po b/components/tvplanit/languages/demo.fi.po
index 261843be2..c0aa490ee 100644
--- a/components/tvplanit/languages/demo.fi.po
+++ b/components/tvplanit/languages/demo.fi.po
@@ -240,16 +240,6 @@ msgstr "Tiedosto"
msgid "Help"
msgstr "Ohje"
-#: tmainform.menuitem3.caption
-msgctxt "tmainform.menuitem3.caption"
-msgid "-"
-msgstr ""
-
-#: tmainform.menuitem4.caption
-msgctxt "tmainform.menuitem4.caption"
-msgid "-"
-msgstr ""
-
#: tmainform.mnuabout.caption
msgid "About Visual PlanIt"
msgstr "Tietoja Visual PlanIt:stä"
diff --git a/components/tvplanit/languages/demo.nl.po b/components/tvplanit/languages/demo.nl.po
index fdeafd4b8..8434b35b2 100644
--- a/components/tvplanit/languages/demo.nl.po
+++ b/components/tvplanit/languages/demo.nl.po
@@ -245,16 +245,6 @@ msgstr "Bestand"
msgid "Help"
msgstr "Help"
-#: tmainform.menuitem3.caption
-msgctxt "tmainform.menuitem3.caption"
-msgid "-"
-msgstr ""
-
-#: tmainform.menuitem4.caption
-msgctxt "tmainform.menuitem4.caption"
-msgid "-"
-msgstr ""
-
#: tmainform.mnuabout.caption
msgid "About Visual PlanIt"
msgstr "Over Visual PlanIt"
diff --git a/components/tvplanit/languages/demo.po b/components/tvplanit/languages/demo.po
index 7c0261176..c0e6df9f9 100644
--- a/components/tvplanit/languages/demo.po
+++ b/components/tvplanit/languages/demo.po
@@ -240,16 +240,6 @@ msgstr ""
msgid "Help"
msgstr ""
-#: tmainform.menuitem3.caption
-msgctxt "TMAINFORM.MENUITEM3.CAPTION"
-msgid "-"
-msgstr ""
-
-#: tmainform.menuitem4.caption
-msgctxt "tmainform.menuitem4.caption"
-msgid "-"
-msgstr ""
-
#: tmainform.mnuabout.caption
msgid "About Visual PlanIt"
msgstr ""
diff --git a/components/tvplanit/languages/demo.ru.po b/components/tvplanit/languages/demo.ru.po
index 1574cb7dd..2a66c13f5 100644
--- a/components/tvplanit/languages/demo.ru.po
+++ b/components/tvplanit/languages/demo.ru.po
@@ -254,16 +254,6 @@ msgstr "Файл"
msgid "Help"
msgstr "Справка"
-#: tmainform.menuitem3.caption
-msgctxt "tmainform.menuitem3.caption"
-msgid "-"
-msgstr ""
-
-#: tmainform.menuitem4.caption
-msgctxt "tmainform.menuitem4.caption"
-msgid "-"
-msgstr ""
-
#: tmainform.mnuabout.caption
msgid "About Visual PlanIt"
msgstr "О Visual PlanIt"
diff --git a/components/tvplanit/source/vpcalendar.pas b/components/tvplanit/source/vpcalendar.pas
index d1fad58b3..a5aef0131 100644
--- a/components/tvplanit/source/vpcalendar.pas
+++ b/components/tvplanit/source/vpcalendar.pas
@@ -40,7 +40,7 @@ uses
Windows, Messages,
{$ENDIF}
SysUtils, Buttons, Classes, Controls, Forms, Graphics, Menus,
- VpBase, VpSR, VpConst, VpMisc, VpBaseDS, VpCanvasUtils, VpException;
+ VpConst, VpBase, VpSR, VpMisc, VpBaseDS, VpCanvasUtils, VpException;
type
TVpCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive,
diff --git a/components/tvplanit/source/vpcalendarpainter.pas b/components/tvplanit/source/vpcalendarpainter.pas
index e3fc73a45..aacca10dc 100644
--- a/components/tvplanit/source/vpcalendarpainter.pas
+++ b/components/tvplanit/source/vpcalendarpainter.pas
@@ -54,7 +54,7 @@ implementation
uses
LCLProc, LazUtf8,
- VpCanvasUtils;
+ VpConst, VpCanvasUtils;
type
TVpCalendarOpener = class(TVpCustomCalendar);
@@ -380,7 +380,9 @@ begin
SetMeasurements;
RenderCanvas.Font.Assign(FCalendar.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
with TVpCalendarOpener(FCalendar) do
if (RealRight - RealLeft <> FLastRenderX) or
diff --git a/components/tvplanit/source/vpconst.pas b/components/tvplanit/source/vpconst.pas
index 0ddff6dc4..e0ea0d706 100644
--- a/components/tvplanit/source/vpconst.pas
+++ b/components/tvplanit/source/vpconst.pas
@@ -40,7 +40,7 @@ interface
uses
{$IFDEF LCL}
- Controls, LCLType, LCLProc,
+ Controls, LCLType, LCLProc, LCLVersion,
{$ELSE}
Windows,
{$ENDIF}
@@ -269,6 +269,16 @@ const
{ Hint support }
MAX_HINT_WIDTH = 400;
+{$IFDEF LCL}
+ {$IF LCL_FULLVERSION >= 1080000}
+ VP_LCL_SCALING = 1;
+ {$ELSE}
+ VP_LCL_SCALING = 0;
+ {$ENDIF}
+{$ELSE}
+ VL_LCL_SCALING := 0;
+{$ENDIF}
+
implementation
diff --git a/components/tvplanit/source/vpcontactgrid.pas b/components/tvplanit/source/vpcontactgrid.pas
index d4cd167ad..f1280ac9b 100644
--- a/components/tvplanit/source/vpcontactgrid.pas
+++ b/components/tvplanit/source/vpcontactgrid.pas
@@ -39,7 +39,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Forms, Menus,
- VpBase, VpBaseDS, VpMisc, VpData, VpConst, VpSR, VpCanvasUtils;
+ VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
const
MaxColumns = 100; { An arbitrary number representing the maximum number of }
@@ -195,6 +195,9 @@ type
procedure EditContact;
procedure EndEdit(Sender: TObject);
procedure InitializeDefaultPopup;
+ {$IF VP_LCL_SCALING = 1}
+ procedure ScaleFontsPPI(const AProportion: Double); override;
+ {$ENDIF}
{ message handlers }
{$IFNDEF LCL}
@@ -1765,6 +1768,13 @@ begin
end;
Invalidate;
end;
-{=====}
+
+{$IF VP_LCL_SCALING}
+procedure TVpContactGrid.ScaleFontsPPI(const AProportion: Double);
+begin
+ inherited;
+ DoScaleFontPPI(ContactHeadAttributes.Font, AProportion);
+end;
+{$ENDIF}
end.
diff --git a/components/tvplanit/source/vpcontactgridpainter.pas b/components/tvplanit/source/vpcontactgridpainter.pas
index f7226dcab..992ef1433 100644
--- a/components/tvplanit/source/vpcontactgridpainter.pas
+++ b/components/tvplanit/source/vpcontactgridpainter.pas
@@ -266,7 +266,9 @@ begin
end;
TmpBmpRect := Rect(0, 0, TmpBmp.Width, TmpBmp.Height);
TmpBmp.Canvas.Font.Assign(FContactGrid.Font);
+ {$IF VP_LCL_SCALING = 0}
TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
{ Calculate Phone Lbl Width }
PhoneLblWidth := TmpBmp.Canvas.TextWidth(RSEmail);
@@ -317,7 +319,9 @@ begin
TmpBmp.Canvas.Pen.Color := BevelDarkShadow;
TmpBmp.Canvas.Brush.Style := bsSolid;
TmpBmp.Canvas.Font.Assign(FContactGrid.ContactHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
case Angle of
ra0:
begin
@@ -415,7 +419,9 @@ begin
{ restore font and colors }
TmpBmp.Canvas.Font.Assign(FContactGrid.Font);
+ {$IF VP_LCL_SCALING = 0}
TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
TmpBmp.Canvas.Brush.Color := RealColor;
TmpBmp.Canvas.Pen.Color := BevelDarkShadow;
TmpBmp.Canvas.Pen.Style := psSolid;
@@ -702,970 +708,7 @@ begin
end;
end;
- (*
-var
- Anchor: TPoint;
- I, J: Integer;
- Str: string;
- TmpBmp: TBitmap;
- TmpCon: TVpContact;
- Col, RecsInCol: Integer;
- HeadRect, AddrRect, CSZRect, Phone1Rect, Phone2Rect, Phone3Rect: TRect;
- Phone4Rect, Phone5Rect, WholeRect, CompanyRect, EMailRect: TRect;
- TmpBmpRect: TRect;
- TextColWidth: Integer;
- TextXOffset: Integer;
- TextYOffset: Integer;
- oldCol1RecCount: Integer;
-begin
- with TVpContactGridOpener(FContactGrid) do begin
- oldCol1RecCount := cgCol1RecCount;
- FVisibleContacts := 0;
- cgCol1RecCount := 0;
- end;
- TextXOffset := 0;
- TextYOffset := 0;
- { 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 }
- if (csDesigning in FContactGrid.ComponentState) or
- (FContactGrid.DataStore = nil) or
- (FContactGrid.DataStore.Resource = nil) then
- Exit;
-
- { 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;
- TmpBmp.Height := RealHeight - TextMargin * 2;
- TextColWidth := TmpBmp.Width;
- end else begin
- TmpBmp.Height := RealColumnWidth - TextMargin * 4;
- TmpBmp.Width := RealHeight - TextMargin * 2;
- TextColWidth := TmpBmp.Height;
- end;
- TmpBmpRect := Rect(0, 0, TmpBmp.Width, TmpBmp.Height);
-
- TmpBmp.Canvas.Font.Assign(FContactGrid.Font);
-
- { Calculate Phone Lbl 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;
- end;
-
- Col := 1;
- { clear the bitmap }
- TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height));
-
- { sort the records }
- FContactGrid.DataStore.Resource.Contacts.Sort;
-
- { Set the anchor starting point }
- case Angle of
- ra0 :
- Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2);
- ra90 :
- Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2);
- ra180 :
- Anchor := Point(
- RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - TextMargin * 2,
- TmpBmp.Height - 2 - TextMargin * 2
- );
- ra270 :
- Anchor := Point(
- 2 + TextMargin * 2,
- RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - TextMargin * 2
- );
- end;
- RecsInCol := 0;
-
- for I := StartContact to pred(FContactGrid.DataStore.Resource.Contacts.Count) do begin
- TmpCon := FContactGrid.DataStore.Resource.Contacts.GetContact(I);
- if (TmpCon <> nil) then begin
- { Clear bmp canvas }
- TmpBmp.Canvas.Brush.Color := RealColor;
- TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height));
-
- TVpContactGridOpener(FContactGrid).cgContactArray[I].Contact := TmpCon;
-
- { start building the WholeRect and build the HeaderRect}
- TmpBmp.Canvas.Pen.Color := BevelDarkShadow;
- TmpBmp.Canvas.Brush.Style := bsSolid;
- TmpBmp.Canvas.Font.Assign(FContactGrid.ContactHeadAttributes.Font);
- case Angle of
- ra0:
- begin
- WholeRect.TopLeft := Point(0, 0);
- HeadRect.TopLeft := Point(TextMargin, 0);
- HeadRect.BottomRight := Point(
- TmpBmp.Width,
- HeadRect.Top + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2
- );
- WholeRect.BottomRight := HeadRect.BottomRight;
- end;
- ra90:
- begin
- HeadRect.TopLeft := Point(
- TmpBmpRect.Right - TextMargin - TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
- 0
- );
- HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height);
- WholeRect.TopLeft := HeadRect.TopLeft;
- WholeRect.BottomRight := HeadRect.BottomRight;
- end;
- ra180:
- begin
- WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
- HeadRect.TopLeft := Point(
- TextMargin,
- TmpBmpRect.Bottom - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin
- );
- HeadRect.BottomRight := Point(
- TmpBmp.Width,
- TmpBmp.Height - TextMargin div 2
- );
- WholeRect.TopLeft := HeadRect.TopLeft;
- end;
- ra270:
- begin
- WholeRect.TopLeft := Point(0, 0);
- HeadRect.TopLeft := Point(0, TextMargin);
- HeadRect.BottomRight := Point(
- TextMargin + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
- TmpBmp.Height
- );
- WholeRect.BottomRight := HeadRect.BottomRight;
- end;
- end;
- { assemble the header string }
- Str := AssembleName(TmpCon);
- { if the name isn't empty then paint all of the contact information }
- if Str > '' then begin
- { paint the header cell's background }
- if (Angle = ra0) or (Angle = ra180) then
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, WidthOf(HeadRect) - TextMargin)
- else
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, HeightOf(HeadRect) - TextMargin);
- TmpBmp.Canvas.Brush.Color := RealContactHeadAttrColor;
- TmpBmp.Canvas.FillRect(HeadRect);
- { paint the header cell's border }
- if FContactGrid.ContactHeadAttributes.Bordered then begin
- TmpBmp.Canvas.Pen.Style := psSolid;
- {$IFDEF VERSION5}
- TmpBmp.Canvas.Rectangle(HeadRect);
- {$ELSE}
- TmpBmp.Canvas.Rectangle(HeadRect.Left, HeadRect.Top, HeadRect.Right, HeadRect.Bottom);
- {$ENDIF}
- end;
- { paint the header cell's text }
- case Angle of
- ra90: begin
- TextXOffset := HeadRect.Right - HeadRect.Left - TextMargin div 2;
- TextYOffset := TextMargin div 3;
- end;
- ra180: begin
- TextXOffset := HeadRect.Right - HeadRect.Left - TextMargin;
- TextYOffset := HeadRect.Bottom - HeadRect.Top - TextMargin div 3;
- end;
- ra270: begin
- TextXOffset := TextMargin div 2;
- TextYOffset := HeadRect.Bottom - HeadRect.Top - TextMargin div 3;
- end;
- end;
- TPSTextOutAtPoint(
- TmpBmp.Canvas,
- Angle,
- TmpBmpRect,
- HeadRect.Left + (TextMargin div 2) + TextXOffset,
- HeadRect.Top + (TextMargin div 3) + TextYOffset,
- Str
- );
-
- { restore font and colors }
- TmpBmp.Canvas.Font.Assign(FContactGrid.Font);
- TmpBmp.Canvas.Brush.Color := RealColor;
- TmpBmp.Canvas.Pen.Color := BevelDarkShadow;
- TmpBmp.Canvas.Pen.Style := psSolid;
-
- { do Company }
- Str := TmpCon.Company;
- if Str <> '' then begin
- case Angle of
- ra0:
- begin
- CompanyRect.TopLeft := Point(
- TextMargin,
- WholeRect.Bottom + TextMargin div 2
- );
- CompanyRect.BottomRight := Point(
- TmpBmp.Width,
- CompanyRect.Top + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2
- );
- WholeRect.Bottom := CompanyRect.Bottom;
- end;
- ra90:
- begin
- CompanyRect.TopLeft := Point(
- WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
- TextMargin
- );
- CompanyRect.BottomRight := Point(
- WholeRect.Left - TextMargin div 2,
- WholeRect.Bottom + TextMargin div 2
- );
- WholeRect.Left := CompanyRect.Left;
- end;
- ra180:
- begin
- CompanyRect.TopLeft := Point(
- WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin
- );
- CompanyRect.BottomRight := Point(
- WholeRect.Left + TextMargin,
- WholeRect.Top - TextMargin div 2
- );
- WholeRect.Top := CompanyRect.Top;
- end;
- ra270:
- begin
- CompanyRect.TopLeft := Point(
- WholeRect.Right,
- WholeRect.Bottom - TextMargin
- );
- CompanyRect.BottomRight := Point(
- WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
- WholeRect.Top + TextMargin div 2
- );
- WholeRect.Right := CompanyRect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - TextMargin * 2);
- TPSTextOutAtPoint(
- TmpBmp.Canvas,
- Angle,
- TmpBmpRect,
- CompanyRect.Left + TextMargin,
- CompanyRect.Top + (TextMargin div 2),
- Str
- );
- end;
-
- { do address... }
- if TmpCon.Address <> '' then begin
- case Angle of
- ra0 : begin
- AddrRect.TopLeft := Point (TextMargin,
- WholeRect.Bottom + (TextMargin div 2));
- AddrRect.BottomRight := Point (TmpBmp.Width,
- AddrRect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := AddrRect.Bottom;
- Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2,
- WidthOf(AddrRect) - TextMargin);
- end;
- ra90 : begin
- AddrRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- AddrRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := AddrRect.Left;
- Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2,
- HeightOf (AddrRect) - TextMargin);
- end;
- ra180 : begin
- AddrRect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- AddrRect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := AddrRect.Top;
- Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2,
- WidthOf(AddrRect) - TextMargin);
- end;
- ra270 : begin
- AddrRect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- AddrRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := AddrRect.Right;
- Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2,
- TextColWidth - TextMargin * 2);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- AddrRect.Left + TextMargin,
- AddrRect.Top + (TextMargin div 2), Str);
- end;
-
- { do City, State, Zip }
- Str := TmpCon.City;
- if Str <> '' then
- Str := Str + ', ' + TmpCon.State
- else
- Str := TmpCon.State;
- if Str <> '' then
- Str := Str + ' ' + TmpCon.Zip
- else
- Str := TmpCon.Zip;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- CSZRect.TopLeft := Point(TextMargin, WholeRect.Bottom
- + (TextMargin div 2));
- CSZRect.BottomRight := Point(TmpBmp.Width, CSZRect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := CSZRect.Bottom;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - TextMargin * 2);
- end;
- ra90 : begin
- CSZRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- CSZRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Bottom := CSZRect.Bottom;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - TextMargin * 2);
- WholeRect.Left := CSZRect.Left;
- end;
- ra180 : begin
- CSZRect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - (TextMargin div 2));
- CSZRect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := CSZRect.Top;
- end;
- ra270 : begin
- CSZRect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- CSZRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := CSZRect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - TextMargin * 2);
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- CSZRect.Left + TextMargin,
- CSZRect.Top + (TextMargin div 2), Str);
- end;
-
- { do Phone1 }
- Str := TmpCon.Phone1;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- Phone1Rect.TopLeft :=
- Point (TextMargin,
- WholeRect.Bottom + (TextMargin div 2));
- Phone1Rect.BottomRight :=
- Point (TmpBmp.Width,
- Phone1Rect.Top +
- TmpBmp.Canvas.TextHeight (VpProductName) +
- (TextMargin div 2));
- WholeRect.Bottom := Phone1Rect.Bottom;
- Str := GetDisplayString (TmpBmp.Canvas, Str, 2,
- TextColWidth - (TextMargin * 2) -
- PhoneLblWidth);
- end;
- ra90 : begin
- Phone1Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- Phone1Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := Phone1Rect.Left;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- end;
- ra180 : begin
- Phone1Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- Phone1Rect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := Phone1Rect.Top;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- end;
- ra270 : begin
- Phone1Rect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- Phone1Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := Phone1Rect.Right;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone1Rect.Left + TextMargin,
- Phone1Rect.Top + (TextMargin div 2),
- PhoneLabel(TVpPhoneType(TmpCon.PhoneType1)) + ': ');
- case Angle of
- ra0 : begin
- Phone1Rect.Left := Phone1Rect.Left + PhoneLblWidth;
- Phone1Rect.Top := Phone1Rect.Top + (TextMargin div 2);
- end;
- ra90 : begin
- Phone1Rect.Top := Phone1Rect.Top + PhoneLblWidth;
- Phone1Rect.Left := Phone1Rect.Left + (TextMargin);
- end;
- ra180 : begin
- Phone1Rect.Left := Phone1Rect.Left - PhoneLblWidth;
- Phone1Rect.Top := Phone1Rect.Top + (TextMargin div 2);
- end;
- ra270 : begin
- Phone1Rect.Top := Phone1Rect.Top - PhoneLblWidth;
- Phone1Rect.Left := Phone1Rect.Left + (TextMargin div 2);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone1Rect.Left,
- Phone1Rect.Top, Str);
- end;
-
- { do Phone2 }
- Str := TmpCon.Phone2;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- Phone2Rect.TopLeft := Point(TextMargin, WholeRect.Bottom
- + (TextMargin div 2));
- Phone2Rect.BottomRight := Point(TmpBmp.Width, Phone2Rect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := Phone2Rect.Bottom;
- end;
- ra90 : begin
- Phone2Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- Phone2Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := Phone2Rect.Left;
- end;
- ra180 : begin
- Phone2Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- Phone2Rect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := Phone2Rect.Top;
- end;
- ra270 : begin
- Phone2Rect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- Phone2Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := Phone2Rect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone2Rect.Left + TextMargin,
- Phone2Rect.Top + (TextMargin div 2),
- PhoneLabel(TVpPhoneType(TmpCon.PhoneType2)) + ': ');
- case Angle of
- ra0 : begin
- Phone2Rect.Left := Phone2Rect.Left + PhoneLblWidth;
- Phone2Rect.Top := Phone2Rect.Top + (TextMargin div 2);
- end;
- ra90 : begin
- Phone2Rect.Top := Phone2Rect.Top + PhoneLblWidth;
- Phone2Rect.Left := Phone2Rect.Left + (TextMargin);
- end;
- ra180 : begin
- Phone2Rect.Left := Phone2Rect.Left - PhoneLblWidth;
- Phone2Rect.Top := Phone2Rect.Top + (TextMargin div 2);
- end;
- ra270 : begin
- Phone2Rect.Top := Phone2Rect.Top - PhoneLblWidth;
- Phone2Rect.Left := Phone2Rect.Left + (TextMargin div 2);
- end;
- end;
-
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone2Rect.Left,
- Phone2Rect.Top, Str);
- end;
-
- { do Phone3 }
- Str := TmpCon.Phone3;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- Phone3Rect.TopLeft := Point(TextMargin, WholeRect.Bottom
- + (TextMargin div 2));
- Phone3Rect.BottomRight := Point(TmpBmp.Width, Phone3Rect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := Phone3Rect.Bottom;
- end;
- ra90 : begin
- Phone3Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- Phone3Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := Phone3Rect.Left;
- end;
- ra180 : begin
- Phone3Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- Phone3Rect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := Phone3Rect.Top;
- end;
- ra270 : begin
- Phone3Rect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- Phone3Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := Phone3Rect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone3Rect.Left + TextMargin,
- Phone3Rect.Top + (TextMargin div 2),
- PhoneLabel(TVpPhoneType(TmpCon.PhoneType3)) + ': ');
- case Angle of
- ra0 : begin
- Phone3Rect.Left := Phone3Rect.Left + PhoneLblWidth;
- Phone3Rect.Top := Phone3Rect.Top + (TextMargin div 2);
- end;
- ra90 : begin
- Phone3Rect.Top := Phone3Rect.Top + PhoneLblWidth;
- Phone3Rect.Left := Phone3Rect.Left + (TextMargin);
- end;
- ra180 : begin
- Phone3Rect.Left := Phone3Rect.Left - PhoneLblWidth;
- Phone3Rect.Top := Phone3Rect.Top + (TextMargin div 2);
- end;
- ra270 : begin
- Phone3Rect.Top := Phone3Rect.Top - PhoneLblWidth;
- Phone3Rect.Left := Phone3Rect.Left + (TextMargin div 2);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone3Rect.Left,
- Phone3Rect.Top, Str);
- end;
-
- { do Phone4 }
- Str := TmpCon.Phone4;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- Phone4Rect.TopLeft := Point(TextMargin, WholeRect.Bottom
- + (TextMargin div 2));
- Phone4Rect.BottomRight := Point(TmpBmp.Width, Phone4Rect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := Phone4Rect.Bottom;
- end;
- ra90 : begin
- Phone4Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- Phone4Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := Phone4Rect.Left;
- end;
- ra180 : begin
- Phone4Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- Phone4Rect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := Phone4Rect.Top;
- end;
- ra270 : begin
- Phone4Rect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- Phone4Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := Phone4Rect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone4Rect.Left + TextMargin,
- Phone4Rect.Top + (TextMargin div 2),
- PhoneLabel(TVpPhoneType(TmpCon.PhoneType4)) + ': ');
- case Angle of
- ra0 : begin
- Phone4Rect.Left := Phone4Rect.Left + PhoneLblWidth;
- Phone4Rect.Top := Phone4Rect.Top + (TextMargin div 2);
- end;
- ra90 : begin
- Phone4Rect.Top := Phone4Rect.Top + PhoneLblWidth;
- Phone4Rect.Left := Phone4Rect.Left + (TextMargin {div 2});
- end;
- ra180 : begin
- Phone4Rect.Left := Phone4Rect.Left - PhoneLblWidth;
- Phone4Rect.Top := Phone4Rect.Top + (TextMargin div 2);
- end;
- ra270 : begin
- Phone4Rect.Top := Phone4Rect.Top - PhoneLblWidth;
- Phone4Rect.Left := Phone4Rect.Left + (TextMargin div 2);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone4Rect.Left,
- Phone4Rect.Top, Str);
- end;
-
- { do Phone5 }
- Str := TmpCon.Phone5;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- Phone5Rect.TopLeft := Point(TextMargin, WholeRect.Bottom
- + (TextMargin div 2));
- Phone5Rect.BottomRight := Point(TmpBmp.Width, Phone5Rect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := Phone5Rect.Bottom;
- end;
- ra90 : begin
- Phone5Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- Phone5Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := Phone5Rect.Left;
- end;
- ra180 : begin
- Phone5Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- Phone5Rect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := Phone5Rect.Top;
- end;
- ra270 : begin
- Phone5Rect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- Phone5Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := Phone5Rect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone5Rect.Left + TextMargin,
- Phone5Rect.Top + (TextMargin div 2),
- PhoneLabel(TVpPhoneType(TmpCon.PhoneType5)) + ': ');
- case Angle of
- ra0 : begin
- Phone5Rect.Left := Phone5Rect.Left + PhoneLblWidth;
- Phone5Rect.Top := Phone5Rect.Top + (TextMargin div 2);
- end;
- ra90 : begin
- Phone5Rect.Top := Phone5Rect.Top+ PhoneLblWidth;
- Phone5Rect.Left := Phone5Rect.Left + (TextMargin);
- end;
- ra180 : begin
- Phone5Rect.Left := Phone5Rect.Left - PhoneLblWidth;
- Phone5Rect.Top := Phone5Rect.Top + (TextMargin div 2);
- end;
- ra270 : begin
- Phone5Rect.Top := Phone5Rect.Top - PhoneLblWidth;
- Phone5Rect.Left := Phone5Rect.Left + (TextMargin div 2);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- Phone5Rect.Left,
- Phone5Rect.Top, Str);
- end;
-
- { do EMail }
- Str := TmpCon.EMail;
- if Str <> '' then begin
- case Angle of
- ra0 : begin
- EMailRect.TopLeft := Point(TextMargin, WholeRect.Bottom
- + (TextMargin div 2));
- EMailRect.BottomRight := Point(TmpBmp.Width, EMailRect.Top +
- TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2));
- WholeRect.Bottom := EMailRect.Bottom;
- end;
- ra90 : begin
- EMailRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- TextMargin);
- EMailRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2),
- WholeRect.Bottom + (TextMargin div 2));
- WholeRect.Left := EMailRect.Left;
- end;
- ra180 : begin
- EMailRect.TopLeft := Point (WholeRect.Right - TextMargin * 2,
- WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin);
- EMailRect.BottomRight := Point (WholeRect.Left + TextMargin,
- WholeRect.Top - (TextMargin div 2));
- WholeRect.Top := EMailRect.Top;
- end;
- ra270 : begin
- EMailRect.TopLeft := Point (WholeRect.Right,
- WholeRect.Bottom - TextMargin);
- EMailRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2),
- WholeRect.Top + (TextMargin div 2));
- WholeRect.Right := EMailRect.Right;
- end;
- end;
- Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth
- - (TextMargin * 2) - PhoneLblWidth);
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- EMailRect.Left + TextMargin,
- EMailRect.Top + (TextMargin div 2), RSEmail + ': ');
- case Angle of
- ra0 : begin
- EMailRect.Left := EMailRect.Left + PhoneLblWidth;
- EmailRect.Top := EMailRect.Top + (TextMargin div 2);
- end;
- ra90 : begin
- EMailRect.Top := EMailRect.Top + PhoneLblWidth;
- EmailRect.Left := EMailRect.Left + TextMargin;
- end;
- ra180 : begin
- EMailRect.Left := EMailRect.Left - PhoneLblWidth;
- EmailRect.Top := EMailRect.Top + (TextMargin div 2);
- end;
- ra270 : begin
- EMailRect.Top := EMailRect.Top - PhoneLblWidth;
- EMailRect.Left := EMailRect.Left + (TextMargin div 2);
- end;
- end;
- TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect,
- EMailRect.Left,
- EMailRect.Top, Str);
- end;
-
- { if this record's too big to fit in the remaining area of this }
- { column, then slide over to the top of the next column }
- case Angle of
- ra0 : begin
- if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - TextMargin * 3) and
- (RecsInCol > 0)
- then begin
- Anchor := Point(
- Anchor.x + WholeRect.Right + TVpContactGridOpener(FContactGrid).FBarWidth + 1 + TextMargin * 3,
- 2 + TextMargin * 2
- );
- if Col = 1 then
- TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
- Inc(Col);
- RecsInCol := 0;
- if DisplayOnly and (Anchor.X + TextColWidth >= RenderIn.Right) then
- Exit;
- end;
- end;
- ra90 : begin
- if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - TextMargin * 3) and
- (RecsInCol > 0)
- then begin
- Anchor.x := 2 + TextMargin * 2;
- Anchor.y := Anchor.y + WholeRect.Bottom + TVpContactGridOpener(FContactGrid).FBarWidth + 1 + TextMargin * 3;
- if Col = 1 then
- TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
- Inc(Col);
- RecsInCol := 0;
- if DisplayOnly and (Anchor.y + TextColWidth >= RenderIn.Bottom) then
- Exit;
- end;
- end;
- ra180 : begin
- if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + TextMargin * 3) and
- (RecsInCol > 0) then
- begin
- Anchor.x := Anchor.x - (WholeRect.Right + TVpContactGridOpener(FContactGrid).FBarWidth + 1 + TextMargin * 3);
- Anchor.y := TmpBmp.Height - 2 - TextMargin * 2;
- if Col = 1 then
- TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
- Inc(Col);
- RecsInCol := 0;
- if DisplayOnly and (Anchor.x + TextColWidth < RenderIn.Left) then
- Exit;
- end;
- end;
- ra270 : begin
- if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - TextMargin * 3) and
- (RecsInCol > 0) then
- begin
- Anchor.x := 2 + TextMargin * 2;
- Anchor.y := Anchor.y - (WholeRect.Bottom + TVpContactGridOpener(FContactGrid).FBarWidth + 1 + TextMargin * 3);
- if Col = 1 then
- TVpContactGridOpener(FContactGrid).cgCol1RecCount := RecsInCol;
- Inc(Col);
- RecsInCol := 0;
- if DisplayOnly and (Anchor.y + TextColWidth <= RenderIn.Top) then
- Exit;
- end;
- end;
- end;
-
- { 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;
- end;
-
- { Update Array Rects }
- with TVpContactGridOpener(FContactGrid) do begin
- cgContactArray[I].WholeRect.TopLeft := Point(Anchor.X, Anchor.Y + WholeRect.Top);
- cgContactArray[I].WholeRect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + WholeRect.Bottom);
-
- cgContactArray[I].HeaderRect.TopLeft := Point(Anchor.X, Anchor.Y + HeadRect.Top);
- cgContactArray[I].HeaderRect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + HeadRect.Bottom);
-
- cgContactArray[I].AddressRect.TopLeft := Point(Anchor.X, Anchor.Y + AddrRect.Top);
- cgContactArray[I].AddressRect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + AddrRect.Bottom);
-
- cgContactArray[I].CSZRect.TopLeft := Point(Anchor.X, Anchor.Y + CSZRect.Top);
- cgContactArray[I].CSZRect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + CSZRect.Bottom);
-
- cgContactArray[I].CompanyRect.TopLeft := Point(Anchor.X, Anchor.Y + CompanyRect.Top);
- cgContactArray[I].CompanyRect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + CompanyRect.Bottom);
-
- cgContactArray[I].EMailRect.TopLeft := Point(Anchor.X + EMailRect.Left, Anchor.Y + EMailRect.Top);
- cgContactArray[I].EMailRect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + EMailRect.Bottom);
-
- cgContactArray[I].Phone1Rect.TopLeft := Point(Anchor.X + Phone1Rect.Left, Anchor.Y + Phone1Rect.Top);
- cgContactArray[I].Phone1Rect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + Phone1Rect.Bottom);
-
- cgContactArray[I].Phone2Rect.TopLeft := Point(Anchor.X + Phone2Rect.Left, Anchor.Y + Phone2Rect.Top);
- cgContactArray[I].Phone2Rect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + Phone2Rect.Bottom);
-
- cgContactArray[I].Phone3Rect.TopLeft := Point(Anchor.X + Phone3Rect.Left, Anchor.Y + Phone3Rect.Top);
- cgContactArray[I].Phone3Rect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + Phone3Rect.Bottom);
-
- cgContactArray[I].Phone4Rect.TopLeft := Point(Anchor.X + Phone4Rect.Left, Anchor.Y + Phone4Rect.Top);
- cgContactArray[I].Phone4Rect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + Phone4Rect.Bottom);
-
- cgContactArray[I].Phone5Rect.TopLeft := Point(Anchor.X + Phone5Rect.Left, Anchor.Y + Phone5Rect.Top);
- cgContactArray[I].Phone5Rect.BottomRight := Point(Anchor.X + TmpBmp.Width, Anchor.Y + Phone5Rect.Bottom);
- end;
-
- { move the drawn record from the bitmap to the component canvas }
-
- case Angle of
- ra0 :
- RenderCanvas.CopyRect (Rect (Anchor.X + WholeRect.Left + RenderIn.Left,
- Anchor.Y + WholeRect.Top + RenderIn.Top,
- Anchor.X + TmpBmp.Width + RenderIn.Left,
- Anchor.Y + WholeRect.Bottom + RenderIn.Top),
- TmpBmp.Canvas, WholeRect);
- ra90 :
- RenderCanvas.CopyRect (Rect (WholeRect.Left + RenderIn.Left - Anchor.X,
- Anchor.Y + WholeRect.Top + RenderIn.Top,
- WholeRect.Right + RenderIn.Left - Anchor.X,
- Anchor.Y + WholeRect.Bottom + RenderIn.Top),
- TmpBmp.Canvas,
- Rect (WholeRect.Left,
- WholeRect.Top,
- WholeRect.Right,
- WholeRect.Bottom));
-
- ra180 :
- RenderCanvas.CopyRect (Rect (Anchor.X + WholeRect.Left + RenderIn.Left,
- Anchor.Y - (WholeRect.Bottom - WholeRect.Top) + RenderIn.Top,
- Anchor.X + TmpBmp.Width + RenderIn.Left,
- Anchor.Y + RenderIn.Top),
- TmpBmp.Canvas, WholeRect);
-
- ra270 :
- RenderCanvas.CopyRect (Rect (Anchor.X + RenderIn.Left,
- Anchor.Y + RenderIn.Top,
- Anchor.X + RenderIn.Left + (WholeRect.Right - WholeRect.Left),
- Anchor.Y + RenderIn.Top + (WholeRect.Bottom - WholeRect.Top)),
- TmpBmp.Canvas, WholeRect);
- end;
-
- { draw focusrect around selected record }
- if FContactGrid.Focused and (TmpCon = FContactGrid.ActiveContact) then begin
- with TVpContactGridOpener(FContactGrid).cgContactArray[I] do
- RenderCanvas.DrawFocusRect(Rect(WholeRect.Left, WholeRect.Top - 3,
- WholeRect.Right + TextMargin, WholeRect.Bottom - 2));
- end;
-
- { slide anchor down for the next record }
- case Angle of
- ra0 : Anchor.Y := Anchor.Y + WholeRect.Bottom;
- ra90 : Anchor.X := Anchor.X + WidthOf(WholeRect);
- ra180 : Anchor.Y := Anchor.Y - HeightOf(WholeRect);
- ra270 : Anchor.X := Anchor.X + WholeRect.Right;
- end;
- Inc(RecsInCol);
- end;
- end;
-
- if not DisplayOnly then
- case Angle of
- ra0:
- with TVpContactGridOpener(FContactGrid) do
- if (Anchor.X > RenderIn.Right) and (I < DataStore.Resource.Contacts.Count) then
- begin
- { we have filled in the visible area }
- FContactsAfter := DataStore.Resource.Contacts.Count - I;
- FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
- Break;
- end else begin
- FContactsAfter := 0;
- FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
- end;
- ra90:
- with TVpContactGridOpener(FContactGrid) do
- if (Anchor.Y > RenderIn.Bottom) and (I < DataStore.Resource.Contacts.Count) then begin
- { we have filled in the visible area }
- FContactsAfter := DataStore.Resource.Contacts.Count - I;
- FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
- Break;
- end else begin
- FContactsAfter := 0;
- FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
- end;
- ra180:
- with TVpContactGridOpener(FContactGrid) do
- if (Anchor.X < RenderIn.Left) and (I < DataStore.Resource.Contacts.Count) then
- begin
- { we have filled in the visible area }
- FContactsAfter := FContactGrid.DataStore.Resource.Contacts.Count - I;
- FVisibleContacts := FContactGrid.DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
- Break;
- end
- else begin
- FContactsAfter := 0;
- FVisibleContacts := FContactGrid.DataStore.Resource.Contacts.Count - StartContact;
- end;
- ra270:
- with TVpContactGridOpener(FContactGrid) do
- if (Anchor.Y < RenderIn.Top) and (I < DataStore.Resource.Contacts.Count) then
- begin
- { we have filled in the visible area }
- FContactsAfter := DataStore.Resource.Contacts.Count - I;
- FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
- Break;
- end else begin
- FContactsAfter := 0;
- FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
- end;
- end;
- end; // for I := StartContact ...
- finally
- TmpBmp.Free;
- end;
-
- with TVpContactGridOpener(FContactGrid) do begin
- if FContactsAfter = 0 then
- FLastPrintLine := -2
- else
- FLastPrintLine := FContactsAfter;
-
- if (oldCol1RecCount > 0) and (cgCol1RecCount = 0) then
- cgCol1RecCount := oldCol1RecCount;
- end;
-end;
- *)
procedure TVpContactGridPainter.DrawVerticalBars;
var
BarPos, BarCount, I: Integer;
@@ -1719,12 +762,16 @@ begin
RealBottom
);
for I := 1 to FContactGrid.BarWidth do begin
- TPSMoveTo (RenderCanvas, Angle, RenderIn,
- RealLeft + BarPos,
- RealTop + 2 + TextMargin * 2);
- TPSLineTo (RenderCanvas, Angle, RenderIn,
- RealLeft + BarPos,
- RealBottom - TextMargin * 2);
+ TPSMoveTo(
+ RenderCanvas, Angle, RenderIn,
+ RealLeft + BarPos,
+ RealTop + 2 + TextMargin * 2
+ );
+ TPSLineTo(
+ RenderCanvas, Angle, RenderIn,
+ RealLeft + BarPos,
+ RealBottom - TextMargin * 2
+ );
Inc(BarPos);
end;
Inc(BarPos, TVpContactGridOpener(FContactGrid).cgNewColWidth);
@@ -1736,10 +783,12 @@ end;
procedure TVpContactGridPainter.FixFontHeights;
begin
+ {$IF VP_LCL_SCALING = 0}
with FContactGrid do begin
ContactHeadAttributes.Font.Height := GetRealFontHeight(ContactHeadAttributes.Font);
Font.Height := GetRealFontHeight(Font);
end;
+ {$ENDIF}
end;
procedure TVpContactGridPainter.InitColors;
diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas
index e7703ae0d..0e93173e0 100644
--- a/components/tvplanit/source/vpdayview.pas
+++ b/components/tvplanit/source/vpdayview.pas
@@ -64,7 +64,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Buttons, Forms, Menus,
- VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils;
+ VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
type
TVpLineRec = packed record
@@ -387,6 +387,9 @@ type
procedure EndEdit(Sender: TObject);
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure SetTimeIntervals(UseGran: TVpGranularity);
+ {$IF VP_LCL_SCALING = 1}
+ procedure ScaleFontsPPI(const AProportion: Double); override;
+ {$ENDIF}
{ message handlers }
procedure VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DayViewInit;
@@ -2549,7 +2552,6 @@ begin
end;
end;
-{.$IFNDEF LCL}
procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
begin
Unused(Msg);
@@ -2564,7 +2566,17 @@ begin
dvCalcVisibleLines(Height, dvColHeadHeight, dvRowHeight, 1, TopLine, -1);
SetVScrollPos;
end;
-{.$ENDIF}
+
+{$IF VP_LCL_SCALING = 1}
+procedure TVpDayView.ScaleFontsPPI(const AProportion: Double);
+begin
+ inherited;
+ DoScaleFontPPI(AllDayEventAttributes.Font, AProportion);
+ DoScaleFontPPI(HeadAttributes.Font, AProportion);
+ DoScaleFontPPI(RowHeadAttributes.HourFont, AProportion);
+ DoScaleFontPPI(RowHeadAttributes.MinuteFont, AProportion);
+end;
+{$ENDIF}
(*****************************************************************************)
{ TVpCHAttributes }
@@ -2648,6 +2660,5 @@ begin
FOwner.Invalidate;
end;
end;
-{=====}
end.
diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas
index 5a9cf26a0..6e57df912 100644
--- a/components/tvplanit/source/vpdayviewpainter.pas
+++ b/components/tvplanit/source/vpdayviewpainter.pas
@@ -328,7 +328,9 @@ begin
if NumADEvents > 0 then begin
// Measure the AllDayEvent text height
RenderCanvas.Font.Assign(FDayView.AllDayEventAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin;
// Distance between text and border
@@ -469,7 +471,9 @@ begin
SavedFont.Assign(RenderCanvas.Font);
try
RenderCanvas.Font.Assign(FDayView.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
RenderCanvas.Brush.Color := RealColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, R);
@@ -550,72 +554,13 @@ begin
end;
TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect);
- (*
-
-
- if not DisplayOnly then begin // this means: during screen output
- if FDayView.Focused and (FDayView.ActiveCol = col) and
- (FDayView.ActiveRow = StartLine + I)
- then begin
- { Paint background hilight color }
- RenderCanvas.Brush.Color := HighlightBkg;
- RenderCanvas.Font.Color := HighlightText;
- TPSFillRect(RenderCanvas, Angle, RenderIn, LineRect);
- end else
- begin
- { paint the active, inactive, weekend, and holiday colors }
-
- { HOLIDAY COLORS ARE NOT IMPLEMENTED YET }
-
- { if ColDate is a weekend, then paint all rows the weekend }
- { color. }
- if (DayOfWeek(ColDate) = 1) or (DayOfWeek(ColDate) = 7) then begin
- { this is a weekend }
- RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Weekend;
- TPSFillRect(RenderCanvas, Angle, RenderIn, LineRect);
- end
- else begin
- { ColDate is a weekday, so check to see if the active }
- { range is set. If it isn't then paint all rows the color }
- { corresponding to Weekday. If it is, then paint inactive }
- { rows the color corresponding to inactive and the active }
- { rows the color corresponding to Active Rows. }
- if FDayView.TimeSlotColors.ActiveRange.RangeBegin = FDayView.TimeSlotColors.ActiveRange.RangeEnd then
- begin
- { there is no active range, so all time slots are to be }
- { painted the color of Weekday }
- RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Weekday;
- TPSFillRect(RenderCanvas, Angle, RenderIn, LineRect);
- end
- else begin
- { there is an active range defined, so we need to see if }
- { the current line falls in the active range or not, and }
- { paint it accordingly }
- LineStartTime := TVpDayViewOpener(FDayView).dvLineMatrix[Col, StartLine + I].Time;
- if TimeInRange(LineStartTime,
- FDayView.TimeSlotColors.ActiveRange.StartTime,
- FDayView.TimeSlotColors.ActiveRange.EndTime - (1/MinutesInDay), true)
- then begin
- RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Active;
- TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect);
- end else begin
- RenderCanvas.Brush.Color := FDayView.TimeSlotColors.Inactive;
- TPSFillRect (RenderCanvas, Angle, RenderIn, LineRect);
- end;
- end;
- end;
- end;
- end;
- *)
{ Draw the lines }
-// if I + StartLine <= FDayView.LineCount then begin
- RenderCanvas.Pen.Color := FDayView.LineColor;
- TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Top);
- TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Top);
- TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Bottom);
- TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Bottom);
- // end;
+ RenderCanvas.Pen.Color := FDayView.LineColor;
+ TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Top);
+ TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Top);
+ TPSMoveTo(RenderCanvas, Angle, RenderIn, LineRect.Left, LineRect.Bottom);
+ TPSLineTo(RenderCanvas, Angle, RenderIn, LineRect.Right - 1, LineRect.Bottom);
inc(I);
end; // while true ...
@@ -650,7 +595,9 @@ begin
{ Draw Column Header }
RenderCanvas.Font.Assign(FDayView.HeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
RenderCanvas.Brush.Color := RealHeadAttrColor;
RenderCanvas.Pen.Style := psClear;
tmpRect := R;
@@ -1084,14 +1031,6 @@ var
bmp.Free;
end;
-// RenderCanvas.StretchDraw(R, ABitmap);
- {
- RenderCanvas.CopyRect( // wp: was FDayview.Canvas -- does not look correct...
- Rect(AIconRect.Left + 1, AIconRect.Top + 1, AIconRect.Left + w + 1, AIconRect.Top + h + 1),
- bmp.Canvas,
- Rect(0, 0, bmp.Width, bmp.Height)
- );
- }
if IncDrawPos then
inc(DrawPos, w + FScaledIconMargin);
end;
@@ -1302,7 +1241,9 @@ begin
{ Calculate the column rect for this day }
RenderCanvas.Font.Assign(FDayView.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
CellsRect := Rect(RPos, ADEventsRect.Bottom + 1, RPos + DayWidth, RealBottom - 2);
if (i = RealNumDays - 1) and (ExtraSpace > 0) then
CellsRect.Right := CellsRect.Right + ExtraSpace;
@@ -1435,7 +1376,9 @@ begin
begin
// In case of 60-min granularity paint time as simple string
RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
timeStr := Format('%s:%s', [hourStr, minuteStr]);
x := lineRect.Right - RenderCanvas.TextWidth(timeStr) - MINUTES_BORDER;
TPSTextOut(RenderCanvas, Angle, RenderIn, x, y + TextMargin, timeStr);
@@ -1444,13 +1387,17 @@ begin
// In all other cases, paint large hour and small minutes (or am/pm)
// Draw minutes
RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
x := lineRect.Right - RenderCanvas.TextWidth(MinuteStr) - MINUTES_BORDER;
TPSTextOut(RenderCanvas, Angle, RenderIn, x, y + TextMargin, minuteStr);
// Draw hours
RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.HourFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
dec(x, RenderCanvas.TextWidth(HourStr) + MINUTES_HOUR_DISTANCE);
TPSTextOut(RenderCanvas, Angle, RenderIn, x, y + TextMargin{ - 2}, hourStr);
end;
@@ -1482,7 +1429,9 @@ begin
// Calculate length of minutes ticks
RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
minutesLen := RenderCanvas.TextWidth('00') + MINUTES_BORDER + MINUTES_HOUR_DISTANCE div 2;
// Prepare pen
@@ -1551,10 +1500,14 @@ function TVpDayViewPainter.CalcRowHeadWidth: integer;
begin
Result := 2 * MINUTES_BORDER + MINUTES_HOUR_DISTANCE;
RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.MinuteFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
inc(Result, RenderCanvas.TextWidth('00'));
RenderCanvas.Font.Assign(FDayView.RowHeadAttributes.HourFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
inc(Result, RenderCanvas.TextWidth('33'));
end;
diff --git a/components/tvplanit/source/vpmonthview.pas b/components/tvplanit/source/vpmonthview.pas
index 59e1e5ed4..320e63355 100644
--- a/components/tvplanit/source/vpmonthview.pas
+++ b/components/tvplanit/source/vpmonthview.pas
@@ -39,7 +39,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls, Forms, Menus,
- VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils;
+ VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
type
TVpMonthdayRec = packed record
@@ -221,6 +221,9 @@ type
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure Paint; override;
+ {$IF VP_LCL_SCALING = 1}
+ procedure ScaleFontsPPI(const AProportion: Double); override;
+ {$ENDIF}
{ message handlers }
{$IFNDEF LCL}
@@ -281,7 +284,6 @@ type
property Color: TColor read FColor write SetColor;
property DateLabelFormat: string read FDateLabelFormat write SetDateLabelFormat;
property DayHeadAttributes: TVpMonthviewAttr read FDayHeadAttr write FDayHeadAttr;
-// property DayHeadAttributes: TVpDayHeadAttr read FDayHeadAttr write FDayHeadAttr;
property DayNameStyle: TVpMVDayNameStyle read FDayNameStyle write SetDayNameStyle;
property DayNumberFont: TVpFont read FDayNumberFont write SetDayNumberFont;
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle stored True;
@@ -1262,6 +1264,18 @@ begin
Invalidate;
end;
end;
-{=====}
+
+{$IF VP_LCL_SCALING = 1}
+procedure TVpMonthView.ScaleFontsPPI(const AProportion: Double);
+begin
+ inherited;
+ DoScaleFontPPI(DayHeadAttributes.Font, AProportion);
+ DoScaleFontPPI(EventFont, Aproportion);
+ DoScaleFontPPI(HeadAttributes.Font, AProportion);
+ DoScaleFontPPI(HolidayAttributes.Font, AProportion);
+ DoScaleFontPPI(TodayAttributes.Font, AProportion);
+ DoScaleFontPPI(WeekendAttributes.Font, AProportion);
+end;
+{$ENDIF}
end.
diff --git a/components/tvplanit/source/vpmonthviewpainter.pas b/components/tvplanit/source/vpmonthviewpainter.pas
index a850b1614..04be2c69d 100644
--- a/components/tvplanit/source/vpmonthviewpainter.pas
+++ b/components/tvplanit/source/vpmonthviewpainter.pas
@@ -13,7 +13,6 @@ type
private
FMonthView: TVpMonthView;
// local parameters of the old TVpMonthView method
-// HeadRect: TRect;
DisplayDate: TDateTime;
DisplayMonth: Word;
RealColor: TColor;
@@ -174,7 +173,9 @@ begin
RenderCanvas.Font.Assign(FMonthView.TodayAttributes.Font)
else
RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
fontstyle := RenderCanvas.Font.style;
if (DisplayDate = ADate) then begin
@@ -272,7 +273,9 @@ var
begin
{ clear day head area }
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
RenderCanvas.Brush.Color := DayHeadAttrColor;
{ build rect }
@@ -550,7 +553,9 @@ begin
{ set the event font }
RenderCanvas.Font.Assign(FMonthView.EventFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
if TVpMonthViewOpener(FMonthView).mvMonthDayArray[I].OffDay then
RenderCanvas.Font.Color := FMonthView.OffDayFontColor;
@@ -644,7 +649,9 @@ begin
{ Calculate the text rectangle }
RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
if DisplayOnly and (RenderCanvas.TextWidth(HeadStr) >= RealWidth) then
HeadTextRect.Left:= RealLeft + TextMargin * 2
else
@@ -669,7 +676,9 @@ begin
// Draw the text
RenderCanvas.Font.Assign(FMonthView.HeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
TPSTextOut(
RenderCanvas,
Angle,
@@ -775,20 +784,28 @@ begin
{ we use the VpProductName because is is a good representation of some }
{ generic text }
RenderCanvas.Font.Assign(FMonthView.DayHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
with TVpMonthViewOpener(FMonthView) do
mvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2;
RenderCanvas.Font.Assign(FMonthView.DayNumberFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
mvDayNumberHeight := RenderCanvas.TextHeight('00');
RenderCanvas.Font.Assign(FMonthView.EventFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
mvEventTextHeight := RenderCanvas.TextHeight(VpProductName);
RenderCanvas.Font.Assign(FMonthView.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
mvLineHeight := RenderCanvas.TextHeight(VpProductName) + 2;
mvColWidth := (RealWidth - 4) div 7;
end;
diff --git a/components/tvplanit/source/vptasklist.pas b/components/tvplanit/source/vptasklist.pas
index 63099d0ef..806a96ac2 100644
--- a/components/tvplanit/source/vptasklist.pas
+++ b/components/tvplanit/source/vptasklist.pas
@@ -39,7 +39,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Menus,
- VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils;
+ VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
type
TVpTaskRec = packed record
@@ -186,25 +186,26 @@ type
function tlTaskIndexToVisibleTask(const ATaskIndex: Integer) : Integer;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
+ procedure EditTask;
+ procedure EndEdit(Sender: TObject);
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ {$IF VP_LCL_SCALING = 1}
+ procedure ScaleFontsPPI(const AProportion: Double); override;
+ {$ENDIF}
+
+ { message handlers }
{$IFNDEF LCL}
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMRButtonDown (var Msg: TWMRButtonDown); message WM_RBUTTONDOWN;
- {$ELSE}
- procedure WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN;
- procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
- procedure WMRButtonDown (var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
- {$ENDIF}
- procedure EditTask;
- procedure EndEdit(Sender: TObject);
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- { message handlers }
- {$IFNDEF LCL}
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
message CM_WANTSPECIALKEY;
{$ELSE}
+ procedure WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN;
+ procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
+ procedure WMRButtonDown (var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
procedure WMSize(var Msg: TLMSize); message LM_SIZE;
procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
{$ENDIF}
@@ -232,6 +233,9 @@ type
property TabStop;
property TabOrder;
property ReadOnly;
+ {$IFDEF LCL}
+ property BorderSpacing;
+ {$ENDIF}
property AllowInplaceEditing: Boolean
read FAllowInplaceEdit write FAllowInplaceEdit default true;
@@ -254,10 +258,8 @@ implementation
uses
SysUtils, Forms, Dialogs, VpTaskEditDlg, VpDlg, VpTasklistPainter;
-
(*****************************************************************************)
-
{ TVpTaskDisplayOptions }
constructor TVpTaskDisplayOptions.Create(Owner: TVpTaskList);
begin
@@ -1246,7 +1248,13 @@ begin
end;
end;
-{=====}
+{$IF VP_LCL_SCALING}
+procedure TVpTaskList.ScaleFontsPPI(const AProportion: Double);
+begin
+ inherited;
+ DoScaleFontPPI(TaskHeadAttributes.Font, AProportion);
+end;
+{$ENDIF}
end.
diff --git a/components/tvplanit/source/vptasklistpainter.pas b/components/tvplanit/source/vptasklistpainter.pas
index 0744856b9..a97462351 100644
--- a/components/tvplanit/source/vptasklistpainter.pas
+++ b/components/tvplanit/source/vptasklistpainter.pas
@@ -5,9 +5,9 @@ unit VpTasklistPainter;
interface
uses
- SysUtils, LCLType, LCLIntf,
+ SysUtils, LCLType, LCLIntf, LCLVersion,
Classes, Graphics, Types,
- VPBase, VpTaskList, VpBasePainter;
+ VpConst, VpBase, VpTaskList, VpBasePainter;
type
TVpTaskListPainter = class(TVpBasePainter)
@@ -55,7 +55,7 @@ type
implementation
uses
- VpConst, VpData, VpMisc, VpCanvasUtils, VpSR;
+ VpData, VpMisc, VpCanvasUtils, VpSR;
type
TVpTaskListOpener = class(TVpTaskList);
@@ -206,38 +206,6 @@ begin
DrawBevelRect(RenderCanvas, R, BevelDarkShadow, BevelFace);
end;
end;
- (*
- if FDrawingStyle = dsFlat then begin
- { draw an outer and inner bevel }
- DrawBevelRect(
- RenderCanvas,
- Rect(RenderIn.Left, RenderIn.Top, RenderIn.Right - 1, RenderIn.Bottom - 1),
- BevelShadow,
- BevelHighlight
- );
- DrawBevelRect (RenderCanvas,
- Rect (RenderIn.Left + 1,
- RenderIn.Top + 1,
- RenderIn.Right - 2,
- RenderIn.Bottom - 2),
- BevelHighlight,
- BevelShadow);
- end else if FDrawingStyle = ds3d then begin
- { draw a 3d bevel }
- DrawBevelRect (RenderCanvas,
- Rect (RenderIn.Left, RenderIn.Top,
- RenderIn.Right - 1, RenderIn.Bottom - 1),
- BevelShadow,
- BevelHighlight);
- DrawBevelRect (RenderCanvas,
- Rect (RenderIn.Left + 1,
- RenderIn.Top + 1,
- RenderIn.Right - 2,
- RenderIn.Bottom - 2),
- BevelDarkShadow,
- BevelFace);
- end;
- *)
end;
procedure TVpTaskListPainter.DrawHeader;
@@ -249,7 +217,9 @@ var
begin
RenderCanvas.Brush.Color := TaskHeadAttrColor;
RenderCanvas.Font.Assign(FTaskList.TaskHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
if FTaskList.DrawingStyle = dsFlat then delta := 1 else delta := 2;
HeadRect.Left := RealLeft + delta;
@@ -319,7 +289,9 @@ begin
else
HeadStr := RSTaskTitleNoResource;
RenderCanvas.Font.Assign(TaskHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
TPSTextOut(
RenderCanvas,
Angle,
@@ -395,7 +367,9 @@ begin
end;
RenderCanvas.Font.Assign(Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
for I := StartLine to pred(tlAllTaskList.Count) do begin
Task := tlAllTaskList[I];
if (LineRect.Top + Trunc(RowHeight * 0.5) <= RealBottom) then begin
@@ -531,7 +505,9 @@ end;
procedure TVpTaskListPainter.MeasureRowHeight;
begin
RenderCanvas.Font.Assign(FTaskList.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
RowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2;
end;
diff --git a/components/tvplanit/source/vpweekview.pas b/components/tvplanit/source/vpweekview.pas
index 9673029ce..e2ab354b1 100644
--- a/components/tvplanit/source/vpweekview.pas
+++ b/components/tvplanit/source/vpweekview.pas
@@ -53,7 +53,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Forms, Menus,
- VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, VpDayView;
+ VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils, VpDayView;
type
TVpWeekdayRec = packed record
@@ -219,6 +219,9 @@ type
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
+ {$IF VP_LCL_SCALING = 1}
+ procedure ScaleFontsPPI(const AProportion: Double); override;
+ {$ENDIF}
{ drag and drop }
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
@@ -1737,6 +1740,18 @@ begin
end;
end;
+{$IF VP_LCL_SCALING = 1}
+procedure TVpWeekView.ScaleFontsPPI(const AProportion: Double);
+begin
+ inherited;
+ DoScaleFontPPI(AllDayEventAttributes.Font, AProportion);
+ DoScaleFontPPI(DayHeadAttributes.Font, AProportion);
+ DoScaleFontPPI(EventFont, AProportion);
+ DoScaleFontPPI(HeadAttributes.Font, AProportion);
+end;
+{$ENDIF}
+
+
{ TVpWvHeadAttributes }
constructor TVpWvHeadAttributes.Create(AOwner: TVpWeekView);
diff --git a/components/tvplanit/source/vpweekviewpainter.pas b/components/tvplanit/source/vpweekviewpainter.pas
index 0793a2a17..78c5917f0 100644
--- a/components/tvplanit/source/vpweekviewpainter.pas
+++ b/components/tvplanit/source/vpweekviewpainter.pas
@@ -143,7 +143,9 @@ begin
{ Measure the AllDayEvent TextHeight }
txtDist := TextMargin div 2;
RenderCanvas.Font.Assign(FWeekView.AllDayEventAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
ADTextHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + txtDist;
{ Build the AllDayEvent rect based on the value of NumADEvents }
@@ -298,7 +300,9 @@ begin
tmpRect := TextRect;
inc(tmpRect.Right);
RenderCanvas.Font.Assign(FWeekView.DayHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
RenderCanvas.Brush.Color := RealDayHeadAttrColor;
TPSFillRect(RenderCanvas, Angle, RenderIn, tmpRect);
if FWeekView.DayHeadAttributes.Bordered and (FWeekView.DrawingStyle <> dsNoBorder) then
@@ -544,7 +548,9 @@ begin
{ set the event font }
RenderCanvas.Font.Assign(FWeekView.EventFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
if AEvent.IsOverlayed then
RenderCanvas.Font.Color := clGray;
RenderCanvas.Brush.Color := RealColor;
@@ -574,7 +580,9 @@ var
begin
RenderCanvas.Brush.Color := RealHeadAttrColor;
RenderCanvas.Font.Assign(TFont(FWeekView.HeadAttributes.Font));
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
{ draw the header cell and borders }
if FWeekView.DrawingStyle = ds3d then begin
@@ -732,16 +740,22 @@ begin
StartDate := GetStartOfWeek(RenderDate, WeekStartsOn);
RenderCanvas.Font.Assign(FWeekView.DayHeadAttributes.Font);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
FDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2 ;
RenderCanvas.Font.Assign(FWeekView.EventFont);
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
with TVpWeekViewOpener(FWeekView) do
wvRowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin div 2;
RenderCanvas.Font.Assign(TFont(FWeekView.HeadAttributes.Font));
+ {$IF VP_LCL_SCALING = 0}
RenderCanvas.Font.Size := ScaleY(RenderCanvas.Font.Size, DesignTimeDPI);
+ {$ENDIF}
with TVpWeekViewOpener(FWeekView) do
wvHeaderHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2;
end;