Changeset 469 for Common/UScaleDPI.pas


Ignore:
Timestamp:
Dec 4, 2014, 9:49:58 PM (10 years ago)
Author:
chronos
Message:
  • Added: Different ScaleDPI scaling approach which use stored dimensions and then apply scaling against stored dimensions. So AutoSizing problem with some controls are solved.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Common/UScaleDPI.pas

    r467 r469  
    88
    99uses
    10   Classes, Forms, Graphics, Controls, ComCtrls, LCLType;
     10  Classes, Forms, Graphics, Controls, ComCtrls, LCLType, SysUtils, StdCtrls,
     11  Contnrs;
    1112
    1213type
     14
     15  { TControlDimension }
     16
     17  TControlDimension = class
     18    BoundsRect: TRect;
     19    AuxSize: TPoint;
     20    FontHeight: Integer;
     21    Controls: TObjectList; // TList<TControlDimension>
     22    constructor Create;
     23    destructor Destroy; override;
     24  end;
    1325
    1426  { TScaleDPI }
     
    1729  private
    1830    FAutoDetect: Boolean;
     31    FDesignDPI: TPoint;
     32    FDPI: TPoint;
    1933    procedure SetAutoDetect(AValue: Boolean);
     34    procedure SetDesignDPI(AValue: TPoint);
     35    procedure SetDPI(AValue: TPoint);
    2036  public
    21     DPI: TPoint;
    22     DesignDPI: TPoint;
     37    procedure StoreDimensions(Control: TControl; Dimensions: TControlDimension);
     38    procedure RestoreDimensions(Control: TControl; Dimensions: TControlDimension);
     39    procedure ScaleDimensions(Control: TControl; Dimensions: TControlDimension);
    2340    procedure ApplyToAll(FromDPI: TPoint);
    24     procedure ScaleDPI(Control: TControl; FromDPI: TPoint);
     41    procedure ScaleControl(Control: TControl; FromDPI: TPoint);
    2542    procedure ScaleImageList(ImgList: TImageList; FromDPI: TPoint);
    26     function ScaleXY(Size: TPoint; FromDPI: Integer): TPoint;
     43    function ScalePoint(APoint: TPoint; FromDPI: TPoint): TPoint;
     44    function ScaleRect(ARect: TRect; FromDPI: TPoint): TRect;
    2745    function ScaleX(Size: Integer; FromDPI: Integer): Integer;
    2846    function ScaleY(Size: Integer; FromDPI: Integer): Integer;
    29     constructor Create(AOwner: TComponent);
     47    constructor Create(AOwner: TComponent); override;
     48    property DesignDPI: TPoint read FDesignDPI write SetDesignDPI;
     49    property DPI: TPoint read FDPI write SetDPI;
    3050  published
    3151    property AutoDetect: Boolean read FAutoDetect write SetAutoDetect;
     
    3454procedure Register;
    3555
     56
    3657implementation
    3758
     59resourcestring
     60  SWrongDPI = 'Wrong DPI [%d,%d]';
     61
    3862procedure Register;
    3963begin
    4064  RegisterComponents('Common', [TScaleDPI]);
     65end;
     66
     67{ TControlDimension }
     68
     69constructor TControlDimension.Create;
     70begin
     71  Controls := TObjectList.Create;
     72end;
     73
     74destructor TControlDimension.Destroy;
     75begin
     76  Controls.Free;
     77  inherited Destroy;
    4178end;
    4279
     
    5087end;
    5188
     89procedure TScaleDPI.SetDesignDPI(AValue: TPoint);
     90begin
     91  if (FDesignDPI.X = AValue.X) and (FDesignDPI.Y = AValue.Y) then Exit;
     92  if (AValue.X <= 0) or (AValue.Y <= 0) then
     93    raise Exception.Create(Format(SWrongDPI, [AValue.X, AValue.Y]));
     94  FDesignDPI := AValue;
     95end;
     96
     97procedure TScaleDPI.SetDPI(AValue: TPoint);
     98begin
     99  if (FDPI.X = AValue.X) and (FDPI.Y = AValue.Y) then Exit;
     100  if (AValue.X <= 0) or (AValue.Y <= 0) then
     101    raise Exception.Create(Format(SWrongDPI, [AValue.X, AValue.Y]));
     102  FDPI := AValue;
     103end;
     104
     105procedure TScaleDPI.StoreDimensions(Control: TControl;
     106  Dimensions: TControlDimension);
     107var
     108  NewControl: TControlDimension;
     109  I: Integer;
     110begin
     111  Dimensions.BoundsRect := Control.BoundsRect;
     112  Dimensions.FontHeight := Control.Font.GetTextHeight('Hg');
     113  Dimensions.Controls.Clear;
     114  if Control is TToolBar then
     115    Dimensions.AuxSize := Point(TToolBar(Control).ButtonWidth, TToolBar(Control).ButtonHeight);
     116
     117  if Control is TWinControl then
     118  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
     119    if TWinControl(Control).Controls[I] is TControl then begin
     120      NewControl := TControlDimension.Create;
     121      Dimensions.Controls.Add(NewControl);
     122      StoreDimensions(TWinControl(Control).Controls[I], NewControl);
     123    end;
     124  end;
     125end;
     126
     127procedure TScaleDPI.RestoreDimensions(Control: TControl;
     128  Dimensions: TControlDimension);
     129var
     130  I: Integer;
     131begin
     132  Control.BoundsRect := Dimensions.BoundsRect;
     133  Control.Font.Height := Dimensions.FontHeight;
     134  if Control is TToolBar then begin
     135    TToolBar(Control).ButtonWidth := Dimensions.AuxSize.X;
     136    TToolBar(Control).ButtonHeight := Dimensions.AuxSize.Y;
     137  end;
     138  if Control is TWinControl then
     139  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
     140    if TWinControl(Control).Controls[I] is TControl then begin
     141      RestoreDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
     142    end;
     143  end;
     144end;
     145
     146procedure TScaleDPI.ScaleDimensions(Control: TControl;
     147  Dimensions: TControlDimension);
     148var
     149  I: Integer;
     150begin
     151  Control.BoundsRect := ScaleRect(Dimensions.BoundsRect, DesignDPI);
     152  Control.Font.Height := ScaleY(Dimensions.FontHeight, DesignDPI.Y);
     153  if Control is TToolBar then begin
     154    TToolBar(Control).ButtonWidth := ScaleX(Dimensions.AuxSize.X, DesignDPI.X);
     155    TToolBar(Control).ButtonHeight := ScaleY(Dimensions.AuxSize.Y, DesignDPI.Y);
     156  end;
     157  if Control is TWinControl then
     158  for I := 0 to TWinControl(Control).ControlCount - 1 do begin
     159    if TWinControl(Control).Controls[I] is TControl then begin
     160      ScaleDimensions(TWinControl(Control).Controls[I], TControlDimension(Dimensions.Controls[I]));
     161    end;
     162  end;
     163end;
     164
    52165procedure TScaleDPI.ApplyToAll(FromDPI: TPoint);
    53166var
     
    55168begin
    56169  for I := 0 to Screen.FormCount - 1 do begin
    57     ScaleDPI(Screen.Forms[I], FromDPI);
     170    ScaleControl(Screen.Forms[I], FromDPI);
    58171  end;
    59172end;
     
    110223end;
    111224
    112 function TScaleDPI.ScaleXY(Size: TPoint; FromDPI: Integer): TPoint;
    113 begin
    114   Result.X := ScaleX(Size.X, FromDPI);
    115   Result.Y := ScaleY(Size.Y, FromDPI);
     225function TScaleDPI.ScalePoint(APoint: TPoint; FromDPI: TPoint): TPoint;
     226begin
     227  Result.X := ScaleX(APoint.X, FromDPI.X);
     228  Result.Y := ScaleY(APoint.Y, FromDPI.Y);
     229end;
     230
     231function TScaleDPI.ScaleRect(ARect: TRect; FromDPI: TPoint): TRect;
     232begin
     233  Result.TopLeft := ScalePoint(ARect.TopLeft, FromDPI);
     234  Result.BottomRight := ScalePoint(ARect.BottomRight, FromDPI);
    116235end;
    117236
     
    123242end;
    124243
    125 procedure TScaleDPI.ScaleDPI(Control: TControl; FromDPI: TPoint);
     244procedure TScaleDPI.ScaleControl(Control: TControl; FromDPI: TPoint);
    126245var
    127246  I: Integer;
    128247  WinControl: TWinControl;
    129248  ToolBarControl: TToolBar;
    130 begin
     249  OldAnchors: TAnchors;
     250  OldAutoSize: Boolean;
     251begin
     252  //if Control is TMemo then Exit;
     253  //if Control is TForm then
     254  //  Control.DisableAutoSizing;
    131255  with Control do begin
     256    //OldAutoSize := AutoSize;
     257    //AutoSize := False;
     258    //Anchors := [];
    132259    Left := ScaleX(Left, FromDPI.X);
    133260    Top := ScaleY(Top, FromDPI.Y);
     261    //if not (akRight in Anchors) then
    134262    Width := ScaleX(Width, FromDPI.X);
     263    //if not (akBottom in Anchors) then
    135264    Height := ScaleY(Height, FromDPI.Y);
    136265    {$IFDEF LCL Qt}
     
    139268      Font.Height := ScaleY(Font.GetTextHeight('Hg'), FromDPI.Y);
    140269    {$ENDIF}
    141   end;
     270    //Anchors := OldAnchors;
     271    //AutoSize := OldAutoSize;
     272  end;
     273
     274
    142275
    143276  if Control is TToolBar then begin
     
    149282  end;
    150283
     284  //if not (Control is TCustomPage) then
    151285  if Control is TWinControl then begin
    152286    WinControl := TWinControl(Control);
     
    154288      for I := 0 to WinControl.ControlCount - 1 do begin
    155289        if WinControl.Controls[I] is TControl then begin
    156           ScaleDPI(WinControl.Controls[I], FromDPI);
     290          ScaleControl(WinControl.Controls[I], FromDPI);
    157291        end;
    158292      end;
    159293    end;
    160294  end;
     295  //if Control is TForm then
     296  //  Control.EnableAutoSizing;
    161297end;
    162298
Note: See TracChangeset for help on using the changeset viewer.