tvplanit: TVpGanttView supports LCL scaling. Fix font scaling in TVpDayView, TVpWeekView, TVpMonthView, TVpContactGrid and TVpTaskList.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8437 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/source/vpcalendar.pas

@@ -43,7 +43,7 @@ uses
   Windows, Messages,
   {$ENDIF}
   SysUtils, Buttons, Classes, Controls, Forms, Graphics, Menus,
-  VpConst, VpBase, VpSR, VpMisc, VpBaseDS, VpCanvasUtils, VpException;
+  VpConst, VpBase, VpSR, VpMisc, VpBaseDS, VpException;
 
 type
   TVpCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive,

components/tvplanit/source/vpcontactgrid.pas

@@ -39,7 +39,7 @@ uses
   Windows, Messages,
   {$ENDIF}
   Classes, Graphics, Controls, ExtCtrls, StdCtrls, Forms, Menus,
-  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
+  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
 
 const
   MaxColumns = 100;  { An arbitrary number representing the maximum number of }
@@ -260,6 +260,7 @@ type
     function SelectContactByName(const Name: String): Boolean;
 
     {$IF VP_LCL_SCALING = 2}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
     procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
     {$ELSEIF VP_LCL_SCALING = 1}
     procedure ScaleFontsPPI(const AProportion: Double); override;
@@ -1933,6 +1934,12 @@ begin
 end;
 
 {$IF VP_LCL_SCALING = 2}
+procedure TVpContactGrid.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(ContactHeadAttributes.Font, ADesignTimePPI);
+end;
+
 procedure TVpContactGrid.ScaleFontsPPI(const AToPPI: Integer;
   const AProportion: Double);
 begin

components/tvplanit/source/vpdayview.pas

@@ -72,7 +72,7 @@ uses
   Windows, Messages,
   {$ENDIF}
   Classes, Graphics, Controls, ExtCtrls, StdCtrls, Buttons, Forms, Menus, ImgList,
-  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
+  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
 
 type
   TVpLineRec = packed record
@@ -472,6 +472,7 @@ type
       StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;
 
     {$IF VP_LCL_SCALING = 2}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
     procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
     {$ELSE}
     {$IF VP_LCL_SCALING = 1}
@@ -2749,6 +2750,15 @@ begin
 end;
 
 {$IF VP_LCL_SCALING = 2}
+procedure TVpDayView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(AllDayEventAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(RowHeadAttributes.HourFont, ADesignTimePPI);
+  DoFixDesignFontPPI(RowHeadAttributes.MinuteFont, ADesignTimePPI);
+end;
+
 procedure TVpDayView.ScaleFontsPPI(const AToPPI: Integer;
   const AProportion: Double);
 begin

components/tvplanit/source/vpevnteditdlg.lfm

@@ -328,14 +328,14 @@ object DlgEventEdit: TDlgEventEdit
         AnchorSideTop.Control = StartDate
         AnchorSideTop.Side = asrCenter
         AnchorSideRight.Control = StartDate
-        Left = 78
+        Left = 105
         Height = 15
         Top = 105
-        Width = 54
+        Width = 27
         Alignment = taRightJustify
         Anchors = [akTop, akRight]
         BorderSpacing.Right = 8
-        Caption = 'Start time:'
+        Caption = 'Start:'
         Color = clDefault
         ParentColor = False
       end
@@ -344,14 +344,14 @@ object DlgEventEdit: TDlgEventEdit
         AnchorSideTop.Control = EndDate
         AnchorSideTop.Side = asrCenter
         AnchorSideRight.Control = EndDate
-        Left = 82
+        Left = 109
         Height = 15
         Top = 136
-        Width = 50
+        Width = 23
         Alignment = taRightJustify
         Anchors = [akTop, akRight]
         BorderSpacing.Right = 8
-        Caption = 'End time:'
+        Caption = 'End:'
         Color = clDefault
         ParentColor = False
       end

components/tvplanit/source/vpevnteditdlg.lrj

@@ -9,8 +9,8 @@
 {"hash":160085834,"name":"tdlgeventedit.locationlbl.caption","sourcebytes":[76,111,99,97,116,105,111,110,58],"value":"Location:"},
 {"hash":180232266,"name":"tdlgeventedit.categorylbl.caption","sourcebytes":[67,97,116,101,103,111,114,121,58],"value":"Category:"},
 {"hash":56787604,"name":"tdlgeventedit.cballday.caption","sourcebytes":[65,108,108,32,68,97,121,32,69,118,101,110,116],"value":"All Day Event"},
-{"hash":102787866,"name":"tdlgeventedit.starttimelbl.caption","sourcebytes":[83,116,97,114,116,32,116,105,109,101,58],"value":"Start time:"},
+{"hash":95062394,"name":"tdlgeventedit.starttimelbl.caption","sourcebytes":[83,116,97,114,116,58],"value":"Start:"},
-{"hash":108711882,"name":"tdlgeventedit.endtimelbl.caption","sourcebytes":[69,110,100,32,116,105,109,101,58],"value":"End time:"},
+{"hash":312442,"name":"tdlgeventedit.endtimelbl.caption","sourcebytes":[69,110,100,58],"value":"End:"},
 {"hash":54683424,"name":"tdlgeventedit.startdate.text","sourcebytes":[48,49,46,48,49,46,50,48,48,48],"value":"01.01.2000"},
 {"hash":264355450,"name":"tdlgeventedit.recurringlbl.caption","sourcebytes":[65,112,112,111,105,110,116,109,101,110,116,32,82,101,99,117,114,114,101,110,99,101,58],"value":"Appointment Recurrence:"},
 {"hash":36863562,"name":"tdlgeventedit.intervallbl.caption","sourcebytes":[73,110,116,101,114,118,97,108,32,40,100,97,121,115,41,58],"value":"Interval (days):"},

components/tvplanit/source/vpganttview.pas

@@ -214,6 +214,12 @@ type
     procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
     procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
 
+    { LCL scaling }
+    {$IF VP_LCL_SCALING <> 0}
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
+    {$IFEND}
+
     { Hints }
     procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent);
     procedure HideHintWindow;
@@ -244,6 +250,15 @@ type
       StartLine, StopLine: Integer; UseGran: TVpGranularity;
       DisplayOnly: Boolean); override;
 
+    {$IF VP_LCL_SCALING = 2}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
+    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
+    {$ELSE}
+    {$IF VP_LCL_SCALING = 1}
+    procedure ScaleFontsPPI(const AProportion: Double); override;
+    {$ENDIF}
+    {$ENDIF}
+
     // Methods to be called by painter
     function CalcVisibleCols(AWidth: Integer): Integer;
     function CalcVisibleRows(AHeight: Integer): Integer;
@@ -476,7 +491,6 @@ const
   DATE_FORMAT = 'ddddd';
 var
   timeFmt: String;
-  timeStr: String;
   startDateStr, endDateStr: string;
   s: String;
 begin
@@ -548,7 +562,8 @@ end;
 
 function TVpGanttView.CalcVisibleCols(AWidth: Integer): Integer;
 var
-  d, m: Integer;  // "d" = result of div, "m" = result of mod
+  d: Integer = 0;   // Result of div
+  m: Integer = 0;   // Result of mod
 begin
   DivMod(AWidth - FixedColWidth, ColWidth, d, m);
   if m <> 0 then
@@ -559,7 +574,8 @@ end;
 
 function TVpGanttView.CalcVisibleRows(AHeight: Integer): Integer;
 var
-  d, m: Integer;  // "d" = result of div, "m" = result of mod
+  d: Integer = 0;  // Result of div
+  m: Integer = 0;  // Result of mod
 begin
   DivMod(AHeight - TotalColHeaderHeight, FRowHeight, d, m);
   if m <> 0 then
@@ -677,6 +693,17 @@ begin
   end;
 end;
 
+procedure TVpGanttView.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  inherited;
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    ColWidth := round(ColWidth * AXProportion);
+    FixedColWidth := round(FixedColWidth * AXProportion);
+  end;
+end;
+
 function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
 begin
   Result := inherited DoMouseWheelDown(Shift, MousePos);
@@ -1276,6 +1303,33 @@ begin
   end;
 end;
 
+{$IF VP_LCL_SCALING = 2}
+procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI);
+  DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI);
+  DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI);
+end;
+
+procedure TVpGanttView.ScaleFontsPPI(const AToPPI: Integer;
+  const AProportion: Double);
+begin
+  inherited;
+  DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion);
+  DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion);
+  DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion);
+end;
+{$ELSEIF VP_LCL_SCALING = 1}
+procedure TVpGantView.ScaleFontsPPI(const AProportion: Double);
+begin
+  inherited;
+  DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion);
+  DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion);
+  DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion);
+end;
+{$ENDIF}
+
 procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
 begin
   if (FStartDate = 0) or (FStartDate = NO_DATE) then
@@ -1323,7 +1377,8 @@ end;
 
 procedure TVpGanttView.SetActiveCol(AValue: Integer);
 var
-  R, eventRect, dayRect: TRect;
+  R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
+  eventRect, dayRect: TRect;
   dt: TDateTime;
   event: TVpEvent;
 begin
@@ -1383,7 +1438,8 @@ end;
 
 procedure TVpGanttView.SetActiveRow(AValue: Integer);
 var
-  R, eventRect, dayRect: TRect;
+  R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
+  eventRect, dayRect: TRect;
   event: TVpEvent;
   dt: TDateTime;
 begin

components/tvplanit/source/vpmisc.pas

@@ -40,7 +40,7 @@ uses
   Windows, Consts, Messages,
   {$ENDIF}
   SysUtils, Buttons, Classes, Controls, StdCtrls, ExtCtrls, Forms, Graphics, Menus,
-  VpBase, VpData, VpConst, VpCanvasUtils;
+  VpBase, VpData, VpConst;
 
 type
   TDayList = array[1..12] of Word;

components/tvplanit/source/vpmonthview.pas

@@ -43,7 +43,7 @@ uses
   Windows, Messages,
   {$ENDIF}
   Classes, Graphics, Controls, ComCtrls, ExtCtrls, Buttons, Forms, Menus,
-  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
+  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
 
 type
   TVpMonthdayRec = packed record
@@ -305,6 +305,7 @@ type
       DisplayOnly: Boolean); override;
 
     {$IF VP_LCL_SCALING = 2}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
     procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
     {$ELSEIF VP_LCL_SCALING = 1}
     procedure ScaleFontsPPI(const AProportion: Double); override;
@@ -1582,6 +1583,17 @@ begin
 end;
 
 {$IF VP_LCL_SCALING = 2}
+procedure TVpMonthView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(DayHeadAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(EventFont, ADesignTimePPI);
+  DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(HolidayAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(TodayAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(WeekendAttributes.Font, ADesignTimePPI);
+end;
+
 procedure TVpMonthView.ScaleFontsPPI(const AToPPI: Integer;
   const AProportion: Double);
 begin

components/tvplanit/source/vptasklist.pas

@@ -39,7 +39,7 @@ uses
   Windows, Messages,
   {$ENDIF}
   Classes, Graphics, Controls, ExtCtrls, StdCtrls, Menus,
-  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
+  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
 
 type
   TVpTaskRec = packed record
@@ -233,6 +233,7 @@ type
       StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;
 
     {$IF VP_LCL_SCALING = 2}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
     procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
     {$ELSEIF VP_LCL_SCALING = 1}
     procedure ScaleFontsPPI(const AProportion: Double); override;
@@ -1350,6 +1351,12 @@ begin
 end;
 
 {$IF VP_LCL_SCALING = 2}
+procedure TVpTaskList.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(TaskHeadAttributes.Font, ADesignTimePPI);
+end;
+
 procedure TVpTaskList.ScaleFontsPPI(const AToPPI: Integer;
   const AProportion: Double);
 begin

components/tvplanit/source/vpweekview.pas

@@ -60,7 +60,7 @@ uses
   Windows, Messages,
   {$ENDIF}
   Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Buttons, Forms, Menus,
-  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils, VpDayView;
+  VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpDayView;
 
 type
   TVpWeekdayRec = packed record
@@ -301,6 +301,7 @@ type
       DisplayOnly: Boolean); override;
 
     {$IF VP_LCL_SCALING = 2}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
     procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
     {$ELSEIF VP_LCL_SCALING = 1}
     procedure ScaleFontsPPI(const AProportion: Double); override;
@@ -1928,6 +1929,15 @@ begin
 end;
 
 {$IF VP_LCL_SCALING = 2}
+procedure TVpWeekView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(AllDayEventAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(DayHeadAttributes.Font, ADesignTimePPI);
+  DoFixDesignFontPPI(EventFont, ADesignTimePPI);
+  DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
+end;
+
 procedure TVpWeekView.ScaleFontsPPI(const AToPPI: Integer;
   const AProportion: Double);
 begin