FastReport_2022_VCL/Source/frxDPIAwareBaseControls.pas

{******************************************}
{                                          }
{             FastReport VCL               }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

{ it used to reduce precompiler directives }
{ some interfaces was introduces only in lastest Delphi }
unit frxDPIAwareBaseControls;

interface

{$I frx.inc}

uses
  {$IFNDEF FPC}Windows, Messages, {$ENDIF}
  SysUtils, Classes, frxDPIAwareInt, Controls, StdCtrls, ExtCtrls, ComCtrls
{$IFDEF FPC}
  , LazarusPackageIntf, LazHelper
{$ENDIF};

type
  TfrxDPIAwareBasePanel = class(TCustomPanel)
  private
    FCurrentPPI: Integer;
    procedure WMDpiChanged(var Message: TMessage); message FRX_WM_DPICHANGED_AFTERPARENT;
  protected
    procedure DoPPIChanged(aNewPPI: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    function GetScale: Single;
    function GetReleativeScale: Single;
{$IFDEF DELPHI24}
    procedure ScaleForPPI(NewPPI: Integer); override;
{$ENDIF}
    property CurrentPPI: Integer read FCurrentPPI write FCurrentPPI;
  end;


  TfrxDPIAwarePanel = class(TfrxDPIAwareBasePanel)
  public
    property DockManager;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color;
    property Constraints;
{$IFNDEF FPC}
    property Ctl3D;
    property BevelKind;
{$ENDIF}
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
{$IFNDEF FPC}
    property Locked;
{$ENDIF}
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
{$IFNDEF FPC}
    property ParentCtl3D;
{$ENDIF}
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
{$IFNDEF FPC}
    property OnCanResize;
{$ENDIF}
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TfrxDPIAwareCustomControl = class(TCustomControl)
  private
    FCurrentPPI: Integer;
    procedure WMDpiChanged(var Message: TMessage); message FRX_WM_DPICHANGED_AFTERPARENT;
  protected
    procedure DoPPIChanged(aNewPPI: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
{$IFDEF DELPHI24}
    procedure ScaleForPPI(NewPPI: Integer); override;
{$ENDIF}
    function GetScale: Single;
    function GetReleativeScale: Single;
    property CurrentPPI: Integer read FCurrentPPI write FCurrentPPI;
  end;

implementation

uses Forms;

{ TfrxDPIAwareBasePanel }

constructor TfrxDPIAwareBasePanel.Create(AOwner: TComponent);
begin
  inherited;
  FCurrentPPI := Screen.PixelsPerInch;
end;

procedure TfrxDPIAwareBasePanel.DoPPIChanged(aNewPPI: Integer);
begin

end;

function TfrxDPIAwareBasePanel.GetReleativeScale: Single;
begin
  Result := FCurrentPPI / Screen.PixelsPerInch;
end;

function TfrxDPIAwareBasePanel.GetScale: Single;
begin
  Result := FCurrentPPI / 96;
end;

{$IFDEF DELPHI24}
procedure TfrxDPIAwareBasePanel.ScaleForPPI(NewPPI: Integer);
begin
  inherited;
  if NewPPI = FCurrentPPI then Exit;
  DoPPIChanged(NewPPI);
  FCurrentPPI := NewPPI;
end;
{$ENDIF}

procedure TfrxDPIAwareBasePanel.WMDpiChanged(var Message: TMessage);
var
  NewPPI: Integer;
begin
  Inherited;
  NewPPI := frxGetDpiForWindow(Handle);
  if NewPPI = FCurrentPPI then Exit;
  DoPPIChanged(NewPPI);
  FCurrentPPI := NewPPI;
end;

{ TfrxDPIAwareCustomControl }

constructor TfrxDPIAwareCustomControl.Create(AOwner: TComponent);
begin
  inherited;
  FCurrentPPI := Screen.PixelsPerInch;
end;

procedure TfrxDPIAwareCustomControl.DoPPIChanged(aNewPPI: Integer);
begin

end;

function TfrxDPIAwareCustomControl.GetReleativeScale: Single;
begin
  Result := FCurrentPPI / Screen.PixelsPerInch;
end;

function TfrxDPIAwareCustomControl.GetScale: Single;
begin
  Result := FCurrentPPI /  96;
end;

{$IFDEF DELPHI24}
procedure TfrxDPIAwareCustomControl.ScaleForPPI(NewPPI: Integer);
begin
  inherited;
  if NewPPI = FCurrentPPI then Exit;
  DoPPIChanged(NewPPI);
  FCurrentPPI := NewPPI;
end;
{$ENDIF}

procedure TfrxDPIAwareCustomControl.WMDpiChanged(var Message: TMessage);
var
  NewPPI: Integer;
begin
  Inherited;
  NewPPI := frxGetDpiForWindow(Handle);
  if NewPPI = FCurrentPPI then Exit;
  DoPPIChanged(NewPPI);
  FCurrentPPI := NewPPI;
end;

end.