jvcllaz: High-dpi support for TJvTFWeeks and TJvTFMonths

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

components/jvcllaz/examples/JvTimeFramework/tfmain.lfm

@@ -169,7 +169,7 @@ object MainForm: TMainForm
         SelCellAttr.Font.Color = clWindowText
         SelCellAttr.TitleAttr.Color = clHighlight
         SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clHighlightText
-        SelCellAttr.DrawBottomLine = True
+        SelCellAttr.DrawBottomLine = False
         ScrollBtnAttr.DisabledArrowColor = clScrollBar
         CellPics = StateImageList
         Viewer = GlanceTextViewer1
@@ -471,7 +471,7 @@ object MainForm: TMainForm
         SelCellAttr.Font.Color = clWindowText
         SelCellAttr.TitleAttr.Color = clHighlight
         SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clHighlightText
-        SelCellAttr.DrawBottomLine = True
+        SelCellAttr.DrawBottomLine = False
         ScrollBtnAttr.DisabledArrowColor = clScrollBar
         Viewer = GlanceTextViewer2
         DateFormat = 'ddddd'
@@ -1694,6 +1694,7 @@ object MainForm: TMainForm
     Title = 'SIMPLDaysPrinter Demo'
     ApptAttr.Color = clLime
     ApptAttr.ParentFont = False
+    ApptBar.Width = 5
     ApptBuffer = 0
     ColHdrHeight = 0
     Color = clBlack

components/jvcllaz/examples/JvTimeFramework/tfmain.pas

@@ -1,6 +1,3 @@
-// todo -cTJvTimeFramework: Remove small square at left/top corner of screen; assosciated with Days/Months/Weeks
-// todo -cTJvTimeFramework: Fix text height when printing text with font size 0
-
 {******************************************************************
 
                        JEDI-VCL Demo

components/jvcllaz/run/JvTimeFramework/jvtfdays.pas

@@ -2824,7 +2824,10 @@ var
   ApptGrid: TJvTFDays;
   absMinColWidth: Integer;
 begin
-  absMinColWidth := TJvTFDaysCols(Collection).ApptGrid.Scale96ToFont(DEFAULT_MIN_COL_WIDTH);
+  if Assigned(ColCollection.ApptGrid) then
+    absMinColWidth := ColCollection.ApptGrid.Scale96ToFont(DEFAULT_MIN_COL_WIDTH)
+  else
+    absMinColWidth := DEFAULT_MIN_COL_WIDTH;
   if Value < absMinColWidth then
     Value := absMinColWidth;
 
@@ -2911,7 +2914,7 @@ procedure TJvTFDaysCol.AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
 begin
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
   begin
-    if not IsStoredWidth then
+    if IsStoredWidth then
       FWidth := round(FWidth * AXProportion);
   end;
 end;
@@ -4254,16 +4257,16 @@ begin
   with FSelGroupHdrAttr do
   begin
     Color := clBtnFace;
-    Font.Color := clBlack;
+    Font.Color := clWindowText;
   end;
 
   FFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self);
   FSelFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self);
   with FSelFancyRowHdrAttr do
   begin
-    TickColor := clBlack;
+    TickColor := clWindowText;
-    MinorFont.Color := clBlack;
+    MinorFont.Color := clWindowText;
-    MajorFont.Color := clBlack;
+    MajorFont.Color := clWindowText;
   end;
 
   FSelCellAttr := TJvTFSelCellAttr.Create(Self);
@@ -4277,6 +4280,7 @@ begin
   // ok
   FTimeBlocks := TJvTFDaysTimeBlocks.Create(Self);
   FTimeBlockProps := TJvTFDaysBlockProps.Create(Self);
+  FTimeBlockProps.FBlockHdrWidth := Scale96ToFont(DEFAULT_BLOCK_HDR_WIDTH);
   {$ENDIF Jv_TIMEBLOCKS}
 
   FEditor := TJvTFInPlaceApptEditor.Create(Self);
@@ -14643,7 +14647,7 @@ procedure TJvTFDaysBlockProps.AutoAdjustLayout(const AMode: TLayoutAdjustmentPol
 begin
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
   begin
-    if not IsStoredBlockHdrWidth then
+    if IsStoredBlockHdrWidth then
       FBlockHdrWidth := round(FBlockHdrWidth * AXProportion);
   end;
 end;

components/jvcllaz/run/JvTimeFramework/jvtfglance.pas

@@ -31,10 +31,14 @@ unit JvTFGlance;
 interface
 
 uses
-  LCLIntf, LCLType, LMessages,
+  LCLIntf, LCLType, LMessages, LCLVersion,
   SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ImgList,
   JvTFUtils, JvTFManager;
 
+const
+  DEFAULT_GLANCE_TITLE_HEIGHT = 40;
+  DEFAULT_GLANCE_CELL_TITLE_HEIGHT = 20;
+
 type
   EJvTFGlanceError = class(Exception);
   EGlanceViewerError = class(EJvTFGlanceError);
@@ -312,6 +316,7 @@ type
     FGlanceControl: TJvTFCustomGlance;
     FDayTxtAttr: TJvTFTextAttr;
     FPicAttr: TJvTFGlanceTitlePicAttr;
+    function IsStoredHeight: Boolean;
     procedure SetAlign(Value: TJvTFTitleAlign);
     //procedure SetDayFormat(Value: string);
     procedure SetColor(Value: TColor);
@@ -328,12 +333,14 @@ type
     constructor Create(AOwner: TJvTFCustomGlance);
     destructor Destroy; override;
     procedure Assign(Source: TPersistent); override;
+    procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); virtual;
     property GlanceControl: TJvTFCustomGlance read FGlanceControl;
   published
     property Align: TJvTFTitleAlign read FAlign write SetAlign default alTop;
     //property DayFormat: string read FDayFormat write SetDayFormat;
     property Color: TColor read FColor write SetColor default clBtnFace;
-    property Height: Integer read FHeight write SetHeight default 20;
+    property Height: Integer read FHeight write SetHeight stored IsStoredHeight;
     property Visible: Boolean read FVisible write SetVisible default True;
     property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
     property DayTxtAttr: TJvTFTextAttr read FDayTxtAttr write SetDayTxtAttr;
@@ -378,6 +385,7 @@ type
     FFrameAttr: TJvTFGlanceFrameAttr;
     FTxtAttr: TJvTFTextAttr;
     FOnChange: TNotifyEvent;
+    function IsStoredHeight: Boolean;
     procedure SetColor(Value: TColor);
     procedure SetHeight(Value: Integer);
     procedure SetVisible(Value: Boolean);
@@ -389,14 +397,15 @@ type
   public
     constructor Create(AOwner: TJvTFCustomGlance);
     destructor Destroy; override;
-
     procedure Assign(Source: TPersistent); override;
+    procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); virtual;
     property GlanceControl: TJvTFCustomGlance read FGlanceControl;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   published
     property Color: TColor read FColor write SetColor default clBtnFace;
     property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
-    property Height: Integer read FHeight write SetHeight default 40;
+    property Height: Integer read FHeight write SetHeight stored IsStoredHeight;
     property Visible: Boolean read FVisible write SetVisible default True;
     property TxtAttr: TJvTFTextAttr read FTxtAttr write SetTxtAttr;
   end;
@@ -599,6 +608,14 @@ type
     procedure CreateParams(var Params: TCreateParams); override;
 
     procedure SchedNamesChange(Sender: TObject);
+
+    {$IF LCL_FullVersion >= 1080000}
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
+    procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
+      const AProportion: Double); override;
+    {$IFEND}
+
     property SelAppt: TJvTFAppt read FSelAppt write SetSelAppt;
     property AllowCustomDates: Boolean read FAllowCustomDates  write FAllowCustomDates;
     // configuration properties and events
@@ -1341,13 +1358,16 @@ begin
   FTitleAttr := TJvTFGlanceMainTitle.Create(Self);
 // obones: Commented out, it goes against the default value in TJvTFGlanceMainTitle
 //  FTitleAttr.Visible := False; // not visible by default. (Tim)
+  FTitleAttr.Height := Scale96ToFont(DEFAULT_GLANCE_TITLE_HEIGHT);
   FTitleAttr.OnChange := @GlanceTitleChange;
 
   FCellAttr := TJvTFGlanceCellAttr.Create(Self);
   FCellAttr.TitleAttr.DayTxtAttr.AlignH := taLeftJustify;
+  FCellAttr.TitleAttr.Height := Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
   FSelCellAttr := TJvTFGlanceCellAttr.Create(Self);
   FSelCellAttr.TitleAttr.Color := clHighlight;
   FSelCellAttr.TitleAttr.DayTxtAttr.Font.Color := clHighlightText;
+  FSelCellAttr.TitleAttr.Height := Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
 
   FScrollBtnAttr := TJvTFScrollBtnAttr.Create;
   FScrollBtnAttr.OnChange := @ScrollBtnChange;
@@ -1502,8 +1522,6 @@ begin
   end;
 end;
 
-
-
 procedure TJvTFCustomGlance.CMCtl3DChanged(var Msg: TLMessage);
 begin
   if FBorderStyle = bsSingle then
@@ -1543,6 +1561,36 @@ begin
   inherited Click;
 end;
 
+{$IF LCL_FullVersion >= 1080000}
+procedure TJvTFCustomGlance.DoAutoAdjustLayout(
+  const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  inherited;
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    (*
+    if IsStoredColHdrHeight then
+      FColHdrHeight := round(FColHdrHeight * AYProportion);
+    if IsStoredDefColWidth then
+      FDefColWidth := round(FDefColWidth * AXProportion);
+    if IsStoredGroupHdrHeight then
+      FGroupHdrHeight := round(FGroupHdrHeight * AYProportion);
+    if IsStoredMinColWidth then
+      FMinColWidth := round(FMinColWidth * AXProportion);
+    if IsStoredMinRowHeight then
+      FMinRowHeight := round(FMinRowHeight * AYProportion);
+    if IsStoredRowHdrWidth then
+      FRowHdrWidth := round(FRowHdrWidth * AXProportion);
+    if IsStoredRowHeight then
+      FRowHeight := round(FRowHeight * AYProportion);
+    *)
+    FCellAttr.TitleAttr.AutoAdjustLayout(AMode, AXProportion, AYProportion);
+    FTitleAttr.AutoAdjustLayout(AMode, AXProportion, AYProportion);
+  end;
+end;
+{$IFEND}
+
 procedure TJvTFCustomGlance.DoConfigCells;
 begin
   if Assigned(FOnConfigCells) then
@@ -3180,6 +3228,28 @@ begin
   end;
 end;
 
+{$IF LCL_FullVersion >= 1080100}
+procedure TJvTFCustomGlance.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
+begin
+  inherited;
+  DoScaleFontPPI(CellAttr.Font, AToPPI, AProportion);
+  DoScaleFontPPI(CellAttr.TitleAttr.DayTxtAttr.Font, AToPPI, AProportion);
+  DoScaleFontPPI(SelCellAttr.Font, AToPPI, AProportion);
+  DoScaleFontPPI(SelCellAttr.TitleAttr.DayTxtAttr.Font, AToPPI, AProportion);
+  DoScaleFontPPI(TitleAttr.TxtAttr.Font, AToPPI, AProportion);
+end;
+{$ELSEIF LCL_FullVersion >= 1080000}
+procedure TJvTFDays.ScaleFontsPPI(const AProportion: Double);
+begin
+  inherited;
+  DoScaleFontPPI(CellAttr.Font, AProportion);
+  DoScaleFontPPI(CellAttr.TitleAttr.TxtAttr.Font, AProportion);
+  DoScaleFontPPI(SelCellAttr.Font, AProportion);
+  DoScaleFontPPI(SelCellAttr.TitleAttr.TxtAttr.Font, AProportion);
+  DoScaleFontPPI(TitleAttr.TxtAttr.Font, AProportion);
+end;
+{$IFEND}
+
 procedure TJvTFCustomGlance.SplitCell(ACell: TJvTFGlanceCell);
 begin
   ACell.Split;
@@ -3210,7 +3280,7 @@ begin
   FFrameAttr := TJvTFGlanceFrameAttr.Create(AOwner);
 
   FColor := clBtnFace;
-  FHeight := 40;
+  FHeight := DEFAULT_GLANCE_TITLE_HEIGHT;  // is scaled by GlanceControl
   FVisible := True;
 end;
 
@@ -3238,12 +3308,31 @@ begin
     inherited Assign(Source);
 end;
 
+procedure TJvTFGlanceTitle.AutoAdjustLayout(
+  const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    if IsStoredHeight then
+      FHeight := round(FHeight * AYProportion);
+  end;
+end;
+
 procedure TJvTFGlanceTitle.Change;
 begin
   if Assigned(FOnChange) then
     FOnChange(Self);
 end;
 
+function TJvTFGlanceTitle.IsStoredHeight: Boolean;
+begin
+  if Assigned(GlanceControl) then
+    Result := FHeight <> GlanceControl.Scale96ToFont(DEFAULT_GLANCE_TITLE_HEIGHT)
+  else
+    Result := true;
+end;
+
 procedure TJvTFGlanceTitle.SetColor(Value: TColor);
 begin
   if Value <> FColor then
@@ -3447,7 +3536,7 @@ begin
   FAlign := alTop;
 
   FColor := clBtnFace;
-  FHeight := 20;
+  FHeight := FGlanceControl.Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
   FVisible := True;
   //FDayFormat := 'd';
 
@@ -3488,6 +3577,17 @@ begin
     inherited Assign(Source);
 end;
 
+procedure TJvTFGlanceTitleAttr.AutoAdjustLayout(
+  const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    if IsStoredHeight then
+      FHeight := round(FHeight * AYProportion);
+  end;
+end;
+
 procedure TJvTFGlanceTitleAttr.Change;
 begin
   if Assigned(GlanceControl) then
@@ -3498,6 +3598,14 @@ begin
   end;
 end;
 
+function TJvTFGlanceTitleAttr.IsStoredHeight: Boolean;
+begin
+  if Assigned(GlanceControl) then
+    Result := FHeight <> GlanceControl.Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT)
+  else
+    Result := true;
+end;
+
 procedure TJvTFGlanceTitleAttr.PicAttrChange(Sender: TObject);
 begin
   Change;

components/jvcllaz/run/JvTimeFramework/jvtfweeks.pas

@@ -31,7 +31,7 @@ unit JvTFWeeks;
 interface
 
 uses
-  LCLIntf, LCLType, LMessages,
+  LCLIntf, LCLType, LMessages, LCLVersion,
   SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   JvTFManager, JvTFGlance, JvTFUtils;
 
@@ -68,6 +68,14 @@ type
     function GetSplitParentDay: TTFDayOfWeek;
     function GetCellTitleText(Cell: TJvTFGlanceCell): string; override;
 
+    {$IF LCL_FullVersion >= 1080000}
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
+{    procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
+      const AProportion: Double); override;
+      }
+    {$IFEND}
+
     // draws the DW Titles
     procedure DrawTitle(ACanvas: TCanvas); override;
     procedure UpdateTitle;
@@ -190,8 +198,8 @@ begin
   with FDWTitleAttr do
   begin
     Assign(TitleAttr);
-    TxtAttr.Font.Size := 8;
+//    TxtAttr.Font.Size := 8;
-    Height := 20;
+    Height := Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
     OnChange := @GlanceTitleChange;
   end;
 
@@ -208,6 +216,19 @@ begin
   inherited Destroy;
 end;
 
+{$IF LCL_FullVersion >= 1080000}
+procedure TJvTFWeeks.DoAutoAdjustLayout(
+  const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  inherited;
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    FDWTitleAttr.AutoAdjustLayout(AMode, AXProportion, AYProportion);
+  end;
+end;
+{$IFEND}
+
 function TJvTFWeeks.DisplayDayCount: Integer;
 var
   DOW: TTFDayOfWeek;