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

tvplanit: Correct font scaling for Laz 1.8+

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5890 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-05-22 08:11:27 +00:00
parent 5d5bc8ba94
commit fd3b8f7db8
21 changed files with 190 additions and 1158 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/tvplanit/examples/fulldemo/demo.lpi
View File

@ -7,8 +7,12 @@
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
</General>
<i18n>
<EnableI18N Value="True"/>

1
components/tvplanit/examples/fulldemo/demo.lpr
View File

@ -13,6 +13,7 @@ uses
{$R *.res}
begin
Application.Scaled := True;
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TDemoDM, DemoDM);

6
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -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

10
components/tvplanit/languages/demo.de.po
View File

@ -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"

10
components/tvplanit/languages/demo.fi.po
View File

@ -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ä"

10
components/tvplanit/languages/demo.nl.po
View File

@ -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"

10
components/tvplanit/languages/demo.po
View File

@ -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 ""

10
components/tvplanit/languages/demo.ru.po
View File

@ -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"

2
components/tvplanit/source/vpcalendar.pas
View File

@ -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,

4
components/tvplanit/source/vpcalendarpainter.pas
View File

@ -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

12
components/tvplanit/source/vpconst.pas
View File

@ -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

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

@ -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.

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

File diff suppressed because it is too large Load Diff

19
components/tvplanit/source/vpdayview.pas
View File

@ -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.

97
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -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;

20
components/tvplanit/source/vpmonthview.pas
View File

@ -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.

19
components/tvplanit/source/vpmonthviewpainter.pas
View File

@ -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;

36
components/tvplanit/source/vptasklist.pas
View File

@ -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.

46
components/tvplanit/source/vptasklistpainter.pas
View File

@ -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;

17
components/tvplanit/source/vpweekview.pas
View File

@ -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);

14
components/tvplanit/source/vpweekviewpainter.pas
View File

@ -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;