Ignore:
Timestamp:
Jun 29, 2020, 5:53:08 PM (4 years ago)
Author:
chronos
Message:
  • Fixed: TDpiControl.BorderSpacing scaling to fix scrollbars positioning.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r268 r269  
    129129
    130130  TDpiWinControl = class;
     131  TDpiControlBorderSpacing = class;
    131132
    132133  { TDpiControl }
     
    134135  TDpiControl = class(TComponent)
    135136  private
     137    FBorderSpacing: TDpiControlBorderSpacing;
    136138    FConstraints: TDpiSizeConstraints;
    137139    FFont: TDpiFont;
     
    165167    procedure SetAlign(AValue: TAlign);
    166168    procedure SetAnchors(AValue: TAnchors);
     169    procedure SetBorderSpacing(AValue: TDpiControlBorderSpacing);
    167170    procedure SetBoundsRect(AValue: TRect);
    168171    procedure SetClientHeight(AValue: Integer);
     
    192195    procedure MouseEnterHandler(Sender: TObject); virtual;
    193196  protected
     197    procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
    194198    function GetText: TCaption; virtual;
    195199    procedure SetText(AValue: TCaption); virtual;
     
    235239    property Visible: Boolean read GetVisible write SetVisible;
    236240    property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
     241    property BorderSpacing: TDpiControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
    237242  published
    238243    property ClientHeight: Integer read GetClientHeight write SetClientHeight;
     
    261266
    262267  TDpiControls = specialize TFPGObjectList<TDpiControl>;
     268
     269  { TDpiControlBorderSpacing }
     270
     271  TDpiControlBorderSpacing = class(TPersistent)
     272  private
     273    FAround: TSpacingSize;
     274    FBottom: TSpacingSize;
     275    FLeft: TSpacingSize;
     276    FOnChange: TNotifyEvent;
     277    FRight: TSpacingSize;
     278    FTop: TSpacingSize;
     279    FControl: TDpiControl;
     280    FDefault: PControlBorderSpacingDefault;
     281    function IsAroundStored: Boolean;
     282    function IsBottomStored: Boolean;
     283    function IsLeftStored: Boolean;
     284    function IsRightStored: Boolean;
     285    function IsTopStored: Boolean;
     286    procedure SetAround(AValue: TSpacingSize);
     287    procedure SetBottom(AValue: TSpacingSize);
     288    procedure SetLeft(AValue: TSpacingSize);
     289    procedure SetRight(AValue: TSpacingSize);
     290    procedure SetTop(AValue: TSpacingSize);
     291    procedure Change(InnerSpaceChanged: Boolean); virtual;
     292  public
     293    constructor Create(OwnerControl: TDpiControl; ADefault: PControlBorderSpacingDefault = nil);
     294  published
     295    property OnChange: TNotifyEvent read FOnChange write FOnChange;
     296    property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
     297    property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
     298    property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
     299    property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
     300    property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
     301  end;
    263302
    264303  { TDpiGraphic }
     
    635674  TDpiScrollBar = class(TDpiControl)
    636675  private
    637     function GetBorderSpacing: TControlBorderSpacing;
    638676    function GetKind: TScrollBarKind;
    639677    function GetMax: Integer;
     
    642680    function GetPageSize: Integer;
    643681    function GetPosition: Integer;
    644     procedure SetBorderSpacing(AValue: TControlBorderSpacing);
    645682    procedure SetKind(AValue: TScrollBarKind);
    646683    procedure SetMax(AValue: Integer);
     
    653690  public
    654691    NativeScrollBar: TScrollBar;
     692    constructor Create(TheOwner: TComponent); override;
    655693    destructor Destroy; override;
    656694  published
     
    659697    property Max: Integer read GetMax write SetMax;
    660698    property Position: Integer read GetPosition write SetPosition;
    661     property BorderSpacing: TControlBorderSpacing read GetBorderSpacing write SetBorderSpacing;
    662699    property Kind: TScrollBarKind read GetKind write SetKind;
    663700    property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
     
    11471184end;
    11481185
     1186{ TDpiControlBorderSpacing }
     1187
     1188function TDpiControlBorderSpacing.IsBottomStored: Boolean;
     1189begin
     1190  if FDefault = nil
     1191  then Result := FBottom <> 0
     1192  else Result := FBottom <> FDefault^.Bottom;
     1193end;
     1194
     1195function TDpiControlBorderSpacing.IsAroundStored: Boolean;
     1196begin
     1197  if FDefault = nil
     1198  then Result := FAround <> 0
     1199  else Result := FAround <> FDefault^.Around;
     1200end;
     1201
     1202function TDpiControlBorderSpacing.IsLeftStored: Boolean;
     1203begin
     1204  if FDefault = nil
     1205  then Result := FLeft <> 0
     1206  else Result := FLeft <> FDefault^.Left;
     1207end;
     1208
     1209function TDpiControlBorderSpacing.IsRightStored: Boolean;
     1210begin
     1211  if FDefault = nil
     1212  then Result := FRight <> 0
     1213  else Result := FRight <> FDefault^.Right;
     1214end;
     1215
     1216function TDpiControlBorderSpacing.IsTopStored: Boolean;
     1217begin
     1218  if FDefault = nil
     1219  then Result := FTop <> 0
     1220  else Result := FTop <> FDefault^.Top;
     1221end;
     1222
     1223procedure TDpiControlBorderSpacing.SetAround(AValue: TSpacingSize);
     1224begin
     1225  if FAround = AValue then Exit;
     1226  FAround := AValue;
     1227  Change(False);
     1228end;
     1229
     1230procedure TDpiControlBorderSpacing.SetBottom(AValue: TSpacingSize);
     1231begin
     1232  if FBottom = AValue then Exit;
     1233  FBottom := AValue;
     1234  Change(False);
     1235end;
     1236
     1237procedure TDpiControlBorderSpacing.SetLeft(AValue: TSpacingSize);
     1238begin
     1239  if FLeft = AValue then Exit;
     1240  FLeft := AValue;
     1241  Change(False);
     1242end;
     1243
     1244procedure TDpiControlBorderSpacing.SetRight(AValue: TSpacingSize);
     1245begin
     1246  if FRight = AValue then Exit;
     1247  FRight := AValue;
     1248  Change(False);
     1249end;
     1250
     1251procedure TDpiControlBorderSpacing.SetTop(AValue: TSpacingSize);
     1252begin
     1253  if FTop = AValue then Exit;
     1254  FTop := AValue;
     1255  Change(False);
     1256end;
     1257
     1258procedure TDpiControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
     1259begin
     1260  if FControl <> nil then
     1261    FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);
     1262  if Assigned(OnChange) then OnChange(Self);
     1263end;
     1264
     1265constructor TDpiControlBorderSpacing.Create(OwnerControl: TDpiControl;
     1266  ADefault: PControlBorderSpacingDefault);
     1267begin
     1268  FControl := OwnerControl;
     1269  FDefault := ADefault;
     1270  if ADefault <> nil then
     1271  begin
     1272    FLeft := ADefault^.Left;
     1273    FRight := ADefault^.Right;
     1274    FTop := ADefault^.Top;
     1275    FBottom := ADefault^.Bottom;
     1276    FAround := ADefault^.Around;
     1277  end;
     1278  inherited Create;
     1279end;
     1280
    11491281{ TDpiEdit }
    11501282
     
    18241956{ TDpiScrollBar }
    18251957
    1826 function TDpiScrollBar.GetBorderSpacing: TControlBorderSpacing;
    1827 begin
    1828   Result := NativeScrollBar.BorderSpacing;
    1829 end;
    1830 
    18311958function TDpiScrollBar.GetKind: TScrollBarKind;
    18321959begin
     
    18571984begin
    18581985  Result := NativeScrollBar.Position;
    1859 end;
    1860 
    1861 procedure TDpiScrollBar.SetBorderSpacing(AValue: TControlBorderSpacing);
    1862 begin
    1863   NativeScrollBar.BorderSpacing := AValue;
    18641986end;
    18651987
     
    19002022end;
    19012023
     2024constructor TDpiScrollBar.Create(TheOwner: TComponent);
     2025begin
     2026  inherited;
     2027end;
     2028
    19022029destructor TDpiScrollBar.Destroy;
    19032030begin
    19042031  FreeAndNil(NativeScrollBar);
    1905   inherited Destroy;
     2032  inherited;
    19062033end;
    19072034
     
    29213048procedure TDpiScreen.UpdateScreen;
    29223049begin
    2923   //Dpi := 96 * 2; //Screen.PixelsPerInch;
    2924   //Dpi := Round(96 * 1.35);
    2925   //Dpi := 144; //Round(96 * 2);
    2926   //Dpi := Round(96 * 1.6);
    29273050  Dpi := Screen.PixelsPerInch;
    29283051end;
     
    30383161end;
    30393162
     3163procedure TDpiControl.DoBorderSpacingChange(Sender: TObject;
     3164  InnerSpaceChanged: Boolean);
     3165begin
     3166  GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);
     3167  GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);
     3168  GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);
     3169  GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);
     3170  GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);
     3171end;
     3172
    30403173procedure TDpiControl.SetText(AValue: TCaption);
    30413174begin
     
    31463279  if Assigned(TheOwner) and (TheOwner is TDpiWinControl) then
    31473280    Parent := TDpiWinControl(TheOwner);
     3281  FBorderSpacing := TDpiControlBorderSpacing.Create(Self);
    31483282  GetNativeControl;
    31493283  UpdateNativeControl;
     
    31533287destructor TDpiControl.Destroy;
    31543288begin
     3289  FreeAndNil(FBorderSpacing);
    31553290  FreeAndNil(FConstraints);
    31563291  FreeAndNil(FFont);
     
    32833418begin
    32843419  GetNativeControl.Anchors := AValue;
     3420end;
     3421
     3422procedure TDpiControl.SetBorderSpacing(AValue: TDpiControlBorderSpacing);
     3423begin
     3424  if FBorderSpacing = AValue then Exit;
     3425  FBorderSpacing := AValue;
    32853426end;
    32863427
Note: See TracChangeset for help on using the changeset viewer.