Changeset 269 for branches/highdpi/Packages/DpiControls/UDpiControls.pas

Timestamp:

Jun 29, 2020, 5:53:08 PM (4 years ago)

Author:

chronos

Message:

• Fixed: TDpiControl.BorderSpacing scaling to fix scrollbars positioning.

File:

• branches/highdpi/Packages/DpiControls/UDpiControls.pas (modified) (19 diffs)

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -129 +129 @@
 
   TDpiWinControl = class;
+  TDpiControlBorderSpacing = class;
 
   { TDpiControl }
@@ -134 +135 @@
   TDpiControl = class(TComponent)
   private
+    FBorderSpacing: TDpiControlBorderSpacing;
     FConstraints: TDpiSizeConstraints;
     FFont: TDpiFont;
@@ -165 +167 @@
     procedure SetAlign(AValue: TAlign);
     procedure SetAnchors(AValue: TAnchors);
+    procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing);
     procedure SetBoundsRect(AValue: TRect);
     procedure SetClientHeight(AValue: Integer);
@@ -192 +195 @@
     procedure MouseEnterHandler(Sender: TObject); virtual;
   protected
+    procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
     function GetText: TCaption; virtual;
     procedure SetText(AValue: TCaption); virtual;
@@ -235 +239 @@
     property Visible: Boolean read GetVisible write SetVisible;
     property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
+    property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
   published
     property ClientHeight: Integer read GetClientHeight write SetClientHeight;
@@ -261 +266 @@
 
   TDpiControls = specialize TFPGObjectList<TDpiControl>;
+
+  { TDpiControlBorderSpacing }
+
+  TDpiControlBorderSpacing = class(TPersistent)
+  private
+    FAround: TSpacingSize;
+    FBottom: TSpacingSize;
+    FLeft: TSpacingSize;
+    FOnChange: TNotifyEvent;
+    FRight: TSpacingSize;
+    FTop: TSpacingSize;
+    FControl: TDpiControl;
+    FDefault: PControlBorderSpacingDefault;
+    function IsAroundStored: Boolean;
+    function IsBottomStored: Boolean;
+    function IsLeftStored: Boolean;
+    function IsRightStored: Boolean;
+    function IsTopStored: Boolean;
+    procedure SetAround(AValue: TSpacingSize);
+    procedure SetBottom(AValue: TSpacingSize);
+    procedure SetLeft(AValue: TSpacingSize);
+    procedure SetRight(AValue: TSpacingSize);
+    procedure SetTop(AValue: TSpacingSize);
+    procedure Change(InnerSpaceChanged: Boolean); virtual;
+  public
+    constructor Create(OwnerControl: TDpiControl; ADefault: PControlBorderSpacingDefault = nil);
+  published
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
+    property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
+    property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
+    property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
+    property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
+  end;
 
   { TDpiGraphic }
@@ -635 +674 @@
   TDpiScrollBar = class(TDpiControl)
   private
-    function GetBorderSpacing: TControlBorderSpacing;
     function GetKind: TScrollBarKind;
     function GetMax: Integer;
@@ -642 +680 @@
     function GetPageSize: Integer;
     function GetPosition: Integer;
-    procedure SetBorderSpacing(AValue: TControlBorderSpacing);
     procedure SetKind(AValue: TScrollBarKind);
     procedure SetMax(AValue: Integer);
@@ -653 +690 @@
   public
     NativeScrollBar: TScrollBar;
+    constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
   published
@@ -659 +697 @@
     property Max: Integer read GetMax write SetMax;
     property Position: Integer read GetPosition write SetPosition;
-    property BorderSpacing: TControlBorderSpacing read GetBorderSpacing write SetBorderSpacing;
     property Kind: TScrollBarKind read GetKind write SetKind;
     property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
@@ -1147 +1184 @@
 end;
 
+{ TDpiControlBorderSpacing }
+
+function TDpiControlBorderSpacing.IsBottomStored: Boolean;
+begin
+  if FDefault = nil
+  then Result := FBottom <> 0
+  else Result := FBottom <> FDefault^.Bottom;
+end;
+
+function TDpiControlBorderSpacing.IsAroundStored: Boolean;
+begin
+  if FDefault = nil
+  then Result := FAround <> 0
+  else Result := FAround <> FDefault^.Around;
+end;
+
+function TDpiControlBorderSpacing.IsLeftStored: Boolean;
+begin
+  if FDefault = nil
+  then Result := FLeft <> 0
+  else Result := FLeft <> FDefault^.Left;
+end;
+
+function TDpiControlBorderSpacing.IsRightStored: Boolean;
+begin
+  if FDefault = nil
+  then Result := FRight <> 0
+  else Result := FRight <> FDefault^.Right;
+end;
+
+function TDpiControlBorderSpacing.IsTopStored: Boolean;
+begin
+  if FDefault = nil
+  then Result := FTop <> 0
+  else Result := FTop <> FDefault^.Top;
+end;
+
+procedure TDpiControlBorderSpacing.SetAround(AValue: TSpacingSize);
+begin
+  if FAround = AValue then Exit;
+  FAround := AValue;
+  Change(False);
+end;
+
+procedure TDpiControlBorderSpacing.SetBottom(AValue: TSpacingSize);
+begin
+  if FBottom = AValue then Exit;
+  FBottom := AValue;
+  Change(False);
+end;
+
+procedure TDpiControlBorderSpacing.SetLeft(AValue: TSpacingSize);
+begin
+  if FLeft = AValue then Exit;
+  FLeft := AValue;
+  Change(False);
+end;
+
+procedure TDpiControlBorderSpacing.SetRight(AValue: TSpacingSize);
+begin
+  if FRight = AValue then Exit;
+  FRight := AValue;
+  Change(False);
+end;
+
+procedure TDpiControlBorderSpacing.SetTop(AValue: TSpacingSize);
+begin
+  if FTop = AValue then Exit;
+  FTop := AValue;
+  Change(False);
+end;
+
+procedure TDpiControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
+begin
+  if FControl <> nil then
+    FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);
+  if Assigned(OnChange) then OnChange(Self);
+end;
+
+constructor TDpiControlBorderSpacing.Create(OwnerControl: TDpiControl;
+  ADefault: PControlBorderSpacingDefault);
+begin
+  FControl := OwnerControl;
+  FDefault := ADefault;
+  if ADefault <> nil then
+  begin
+    FLeft := ADefault^.Left;
+    FRight := ADefault^.Right;
+    FTop := ADefault^.Top;
+    FBottom := ADefault^.Bottom;
+    FAround := ADefault^.Around;
+  end;
+  inherited Create;
+end;
+
 { TDpiEdit }
 
@@ -1824 +1956 @@
 { TDpiScrollBar }
 
-function TDpiScrollBar.GetBorderSpacing: TControlBorderSpacing;
-begin
-  Result := NativeScrollBar.BorderSpacing;
-end;
-
 function TDpiScrollBar.GetKind: TScrollBarKind;
 begin
@@ -1857 +1984 @@
 begin
   Result := NativeScrollBar.Position;
-end;
-
-procedure TDpiScrollBar.SetBorderSpacing(AValue: TControlBorderSpacing);
-begin
-  NativeScrollBar.BorderSpacing := AValue;
 end;
 
@@ -1900 +2022 @@
 end;
 
+constructor TDpiScrollBar.Create(TheOwner: TComponent);
+begin
+  inherited;
+end;
+
 destructor TDpiScrollBar.Destroy;
 begin
   FreeAndNil(NativeScrollBar);
-  inherited Destroy;
+  inherited;
 end;
 
@@ -2921 +3048 @@
 procedure TDpiScreen.UpdateScreen;
 begin
-  //Dpi := 96 * 2; //Screen.PixelsPerInch;
-  //Dpi := Round(96 * 1.35);
-  //Dpi := 144; //Round(96 * 2);
-  //Dpi := Round(96 * 1.6);
   Dpi := Screen.PixelsPerInch;
 end;
@@ -3038 +3161 @@
 end;
 
+procedure TDpiControl.DoBorderSpacingChange(Sender: TObject;
+  InnerSpaceChanged: Boolean);
+begin
+  GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);
+  GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);
+  GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);
+  GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);
+  GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);
+end;
+
 procedure TDpiControl.SetText(AValue: TCaption);
 begin
@@ -3146 +3279 @@
   if Assigned(TheOwner) and (TheOwner is TDpiWinControl) then
     Parent := TDpiWinControl(TheOwner);
+  FBorderSpacing := TDpiControlBorderSpacing.Create(Self);
   GetNativeControl;
   UpdateNativeControl;
@@ -3153 +3287 @@
 destructor TDpiControl.Destroy;
 begin
+  FreeAndNil(FBorderSpacing);
   FreeAndNil(FConstraints);
   FreeAndNil(FFont);
@@ -3283 +3418 @@
 begin
   GetNativeControl.Anchors := AValue;
+end;
+
+procedure TDpiControl.SetBorderSpacing(AValue: TDpiControlBorderSpacing);
+begin
+  if FBorderSpacing = AValue then Exit;
+  FBorderSpacing := AValue;
 end;