Delphi：窗體自適應屏幕分辨率的改進

在窗體依據屏幕分辨率自適應調整尺度方面，昨天的工做能夠說是一個突破點。昨天的工做找到了長期以來個人原有方案的問題所在，這是很是關鍵的。可是昨天晚上的解決方案並不完美，今天的這個纔是比較完美的解決版。

 

先補充說明一下這個問題的重要性。這原本只是一個很小的技術問題，但在現有的Windows軟件開發過程當中，這個問題很是常見。一些很是著名的商業化軟件，也會發現這方面的問題。Delphi的IDE自己在不一樣屏幕分辨率的機器上運行時，有些界面也會出現變形和控件找不到的狀況；Adobe是家軟件大公司，他的PDF編輯器在不一樣屏幕分辨率的機器上運行時，也會出現按鈕不見或者被吃掉一半的狀況。

 

所以，這其實是軟件開發過程當中一個小的但又經常讓人煩惱的頑疾。

 

昨天的解決方案中，有一點有所忽略。也就是，因爲容器中的控件的位置和尺寸會隨着容器尺寸的改變而改變，那麼，容器尺寸的改變應該發生在其所包含的控件尺寸調整以前。可是，我並不清楚，一個容器裏面到底嵌套了多少級，到底存在多少容器和控件，也不清楚容器中組件的排列方式。昨天的方案在這個地方帶有點嘗試性，彷佛是倒着順序去調整控件的尺寸，出來的窗體就會比較合理，而順着序改則會調整很差。這個經驗是好久之前試出來的，昨天沒有改因此忘了說。

 

今天的方案是是首先利用遞歸方法作第一次遍歷，一層一層地搜索，直到把全部的控件搜索完畢。搜索過程當中將每一個控件的原始座標保存起來。而後按照一樣的方式作第二次遍歷，利用保存的原始座標數據計算新的座標數據。因爲搜索是從頂層容器依次往下的，所以先修改的是容器的尺度，而後才修改容器內部控件的尺度，這樣明確保證了控件尺度的調整在其宿主容器尺寸調整以後，也就不會再受其宿主容器尺度改變的影響。最後對窗體中全部組件作遍歷，修改字體大小。

 

改進後的源代碼以下，通過試驗，效果很是完美，用法跟昨天的同樣。

 

unit uMyClassHelpers;
{實現窗體自適應調整尺寸以適應不一樣屏幕分辯率的顯示問題。
        陳小斌，2012年3月5日
}

interface
Uses
  SysUtils,Windows,Classes,Graphics, Controls,Forms,Dialogs, Math,
  uMySysUtils;

Const   //記錄設計時的屏幕分辨率
  OriWidth=1366;
  OriHeight=768;

Type

  TfmForm=Class(TForm)   //實現窗體屏幕分辨率的自動調整
  Private
    fScrResolutionRateW: Double;
    fScrResolutionRateH: Double;
    fIsFitDeviceDone: Boolean;
    procedure FitDeviceResolution;
  Protected
    Property IsFitDeviceDone:Boolean Read fIsFitDeviceDone;
    Property ScrResolutionRateH:Double Read fScrResolutionRateH;
    Property ScrResolutionRateW:Double Read fScrResolutionRateW;
  Public
    Constructor Create(AOwner: TComponent); Override;
  End;

  TfdForm=Class(TfmForm)   //增長對話框窗體的修改確認
  Protected
    fIsDlgChange:Boolean;
  Public
  Constructor Create(AOwner: TComponent); Override;
  Property IsDlgChange:Boolean Read fIsDlgChange default false;
 End;

implementation

constructor TfmForm.Create(AOwner: TComponent);
begin
 Inherited Create(AOwner);
  fScrResolutionRateH:=1;
  fScrResolutionRateW:=1;
  Try
    if Not fIsFitDeviceDone then
    Begin
      FitDeviceResolution;
   fIsFitDeviceDone:=True;
    End;
  Except
  fIsFitDeviceDone:=False;
  End;
end;

procedure TfmForm.FitDeviceResolution;
Var
  LocList:TList;
  LocFontRate:Double;
  LocFontSize:Integer;
  LocFont:TFont;
  locK:Integer;

{計算尺度調整的基本參數}
  Procedure CalBasicScalePars;
  Begin
    try
      Self.Scaled:=False;
      fScrResolutionRateH:=screen.height/OriHeight;
      fScrResolutionRateW:=screen.Width/OriWidth;
      LocFontRate:=Min(fScrResolutionRateH,fScrResolutionRateW);
    except
      Raise;
    end;
  End;

{保存原有座標位置：利用遞歸法遍歷各級容器裏的控件，直到最後一級}
  Procedure ControlsPostoList(vCtl:TControl;vList:TList);
  Var
    locPRect:^TRect;
    i:Integer;
    locCtl:TControl;
  Begin
    try
      New(locPRect);
      locPRect^:=vCtl.BoundsRect;
      vList.Add(locPRect);
      If vCtl Is TWinControl Then
        For i:=0 to TWinControl(vCtl).ControlCount-1 Do
        begin
          locCtl:=TWinControl(vCtl).Controls[i];
          ControlsPosToList(locCtl,vList);
        end;
    except
      Raise;
    end;
  End;

{計算新的座標位置：利用遞歸法遍歷各級容器裏的控件，直到最後一層。
 計算座標時先計算頂級容器級的，而後逐級遞進}
  Procedure AdjustControlsScale(vCtl:TControl;vList:TList;Var vK:Integer);
  Var
    locOriRect,LocNewRect:TRect;
    i:Integer;
    locCtl:TControl;
  Begin
    try
      If vCtl.Align<>alClient Then
      Begin
        locOriRect:=TRect(vList.Items[vK]^);
        With locNewRect Do
        begin
           Left:=Round(locOriRect.Left*fScrResolutionRateW);
           Right:=Round(locOriRect.Right*fScrResolutionRateW);
           Top:=Round(locOriRect.Top*fScrResolutionRateH);
           Bottom:=Round(locOriRect.Bottom*fScrResolutionRateH);
           vCtl.SetBounds(Left,Top,Right-Left,Bottom-Top);
        end;
      End;
      Inc(vK);
      If vCtl Is TWinControl Then
        For i:=0 to TwinControl(vCtl).ControlCount-1 Do
        begin
          locCtl:=TWinControl(vCtl).Controls[i];
          AdjustControlsScale(locCtl,vList,vK);
        end;
    except
      Raise;
    end;
  End;

{按照新的比例設計窗體中各組件的字體}
  Procedure AdjustComponentFont(vCmp:TComponent);
  Var
    i:Integer;
    locCmp:TComponent;
  Begin
    try
      For i:=vCmp.ComponentCount-1 Downto 0 Do
      Begin
        locCmp:=vCmp.Components[i];
        If PropertyExists(LocCmp,'FONT') Then
        Begin
          LocFont:=TFont(GetObjectProperty(LocCmp,'FONT'));
          LocFontSize := Round(LocFontRate*LocFont.Size);
          LocFont.Size:=LocFontSize;
        End;
      End;
    except
      Raise;
    end;
  End;

{釋放座標位置指針和列表對象}
  Procedure FreeListItem(vList:TList);
  Var
    i:Integer;
  Begin
    For i:=0 to vList.Count-1 Do
      Dispose(vList.Items[i]);
    vList.Free;
  End;

begin
  LocList:=TList.Create;
  Try
  Try
      if (Screen.width<>OriWidth)OR(Screen.Height<>OriHeight) then
      begin
        CalBasicScalePars;
        AdjustComponentFont(Self);
        ControlsPostoList(Self,locList);
        locK:=0;
        AdjustControlsScale(Self,locList,locK);

   End;
  Except on E:Exception Do
      Raise Exception.Create('進行屏幕分辨率自適應調整時出現錯誤'+E.Message);
  End;
  Finally
    FreeListItem(locList);
  End;
end;

{ TfdForm }

constructor TfdForm.Create(AOwner: TComponent);
begin
  inherited;
  fIsDlgChange:=False;
end;

end.

本文引用地址：http://blog.sciencenet.cn/blog-39148-544498.html