zoukankan html css js c++ java

(转) 实现窗体自适应调整尺寸以适应不同屏幕分辩率

下面包括两个类，一个是普通窗体类，一个是其子类对话框型窗体类。在实际应用过程中只要自己创建的窗体类继承自以上两个类中的一个，例如 TForm1 = class(TfdForm)，则不需添加任何源码，设计出窗体会自动调整其上控件的尺寸，以适应不同的屏幕分辨率。

经测试代码可用！

uMyClassHelpers

  1 unit  AutoResolution;
  2 
  3 interface
  4 uses
  5   SysUtils, Windows, Classes, Graphics, Controls, Forms, Dialogs, Math,
  6   TypInfo;
  7 
  8 const //记录设计时的屏幕分辨率
  9  OriWidth = 1024;
 10  OriHeight = 768;
 11 
 12 type
 13 
 14   TfmForm = class(TForm) //实现窗体屏幕分辨率的自动调整
 15   private
 16     fScrResolutionRateW: Double;
 17     fScrResolutionRateH: Double;
 18     fIsFitDeviceDone: Boolean;
 19     procedure FitDeviceResolution;
 20   protected
 21     property IsFitDeviceDone: Boolean read fIsFitDeviceDone;
 22     property ScrResolutionRateH: Double read fScrResolutionRateH;
 23     property ScrResolutionRateW: Double read fScrResolutionRateW;
 24   public
 25     constructor Create(AOwner: TComponent); override;
 26     function PropertyExists(const AObject: TObject;const APropName:String):Boolean;
 27      function GetObjectProperty(
 28      const AObject   : TObject;
 29      const APropName : string
 30      ):TObject;
 31   end;
 32 
 33   TfdForm = class(TfmForm) //增加对话框窗体的修改确认
 34   protected
 35     fIsDlgChange: Boolean;
 36   public
 37     constructor Create(AOwner: TComponent); override;
 38     property IsDlgChange: Boolean read fIsDlgChange default false;
 39   end;
 40 
 41 implementation
 42 
 43 function TfmForm.PropertyExists(const AObject: TObject;const APropName:String):Boolean;
 44  //判断一个属性是否存在
 45  var
 46    PropInfo:PPropInfo;
 47  begin
 48    PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
 49    Result:=Assigned(PropInfo);
 50  end;
 51 
 52  function TfmForm.GetObjectProperty(
 53      const AObject   : TObject;
 54      const APropName : string
 55      ):TObject;
 56  var
 57    PropInfo:PPropInfo;
 58  begin
 59    Result  :=  nil;
 60    PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
 61    if Assigned(PropInfo) and
 62        (PropInfo^.PropType^.Kind = tkClass) then
 63      Result  :=  GetObjectProp(AObject,PropInfo);
 64  end;
 65 
 66 constructor TfmForm.Create(AOwner: TComponent);
 67 begin
 68   inherited Create(AOwner);
 69   fScrResolutionRateH := 1;
 70   fScrResolutionRateW := 1;
 71   try
 72     if not fIsFitDeviceDone then
 73     begin
 74       FitDeviceResolution;
 75       fIsFitDeviceDone := True;
 76     end;
 77   except
 78     fIsFitDeviceDone := False;
 79   end;
 80 end;
 81 
 82 procedure TfmForm.FitDeviceResolution;
 83 var
 84   LocList: TList;
 85   LocFontRate: Double;
 86   LocFontSize: Integer;
 87   LocFont: TFont;
 88   locK: Integer;
 89 {计算尺度调整的基本参数}
 90   procedure CalBasicScalePars;
 91   begin
 92     try
 93       Self.Scaled := False;
 94       fScrResolutionRateH := screen.height / OriHeight;
 95       fScrResolutionRateW := screen.Width / OriWidth;
 96       LocFontRate := Min(fScrResolutionRateH, fScrResolutionRateW);
 97     except
 98       raise;
 99     end;
100   end;
101 
102 {保存原有坐标位置：利用递归法遍历各级容器里的控件，直到最后一级}
103   procedure ControlsPostoList(vCtl: TControl; vList: TList);
104   var
105     locPRect: ^TRect;
106     i: Integer;
107     locCtl: TControl;
108     locFontp: ^Integer;
109   begin
110     try
111       New(locPRect);
112       locPRect^ := vCtl.BoundsRect;
113       vList.Add(locPRect);
114       if PropertyExists(vCtl, 'FONT') then
115       begin
116         LocFont := TFont(GetObjectProperty(vCtl, 'FONT'));
117         New(locFontp);
118         locFontP^ := LocFont.Size;
119         vList.Add(locFontP);
120 //        ShowMessage(vCtl.Name+'Ori:='+InttoStr(LocFont.Size));
121       end;
122       if vCtl is TWinControl then
123         for i := 0 to TWinControl(vCtl).ControlCount - 1 do
124         begin
125           locCtl := TWinControl(vCtl).Controls[i];
126           ControlsPosToList(locCtl, vList);
127         end;
128     except
129       raise;
130     end;
131   end;
132 
133 {计算新的坐标位置：利用递归法遍历各级容器里的控件，直到最后一层。
134  计算坐标时先计算顶级容器级的，然后逐级递进}
135   procedure AdjustControlsScale(vCtl: TControl; vList: TList; var vK: Integer);
136   var
137     locOriRect, LocNewRect: TRect;
138     i: Integer;
139     locCtl: TControl;
140   begin
141     try
142       if vCtl.Align <> alClient then
143       begin
144         locOriRect := TRect(vList.Items[vK]^);
145         with locNewRect do
146         begin
147           Left := Round(locOriRect.Left * fScrResolutionRateW);
148           Right := Round(locOriRect.Right * fScrResolutionRateW);
149           Top := Round(locOriRect.Top * fScrResolutionRateH);
150           Bottom := Round(locOriRect.Bottom * fScrResolutionRateH);
151           vCtl.SetBounds(Left, Top, Right - Left, Bottom - Top);
152         end;
153       end;
154       if PropertyExists(vCtl, 'FONT') then
155       begin
156         Inc(vK);
157         LocFont := TFont(GetObjectProperty(vCtl, 'FONT'));
158         locFontSize := Integer(vList.Items[vK]^);
159         LocFont.Size := Round(LocFontRate * locFontSize);
160 //        ShowMessage(vCtl.Name+'New:='+InttoStr(LocFont.Size));
161       end;
162       Inc(vK);
163       if vCtl is TWinControl then
164         for i := 0 to TwinControl(vCtl).ControlCount - 1 do
165         begin
166           locCtl := TWinControl(vCtl).Controls[i];
167           AdjustControlsScale(locCtl, vList, vK);
168         end;
169     except
170       raise;
171     end;
172   end;
173 
174 {释放坐标位置指针和列表对象}
175   procedure FreeListItem(vList: TList);
176   var
177     i: Integer;
178   begin
179     for i := 0 to vList.Count - 1 do
180       Dispose(vList.Items[i]);
181     vList.Free;
182   end;
183 
184 begin
185   LocList := TList.Create;
186   try
187     try
188       if (Screen.width <> OriWidth) or (Screen.Height <> OriHeight) then
189       begin
190         CalBasicScalePars;
191 //        AdjustComponentFont(Self);
192         ControlsPostoList(Self, locList);
193         locK := 0;
194         AdjustControlsScale(Self, locList, locK);
195 
196       end;
197     except on E: Exception do
198         raise Exception.Create('进行屏幕分辨率自适应调整时出现错误' + E.Message);
199     end;
200   finally
201     FreeListItem(locList);
202   end;
203 end;
204 
205 
206 { TfdForm }
207 
208 constructor TfdForm.Create(AOwner: TComponent);
209 begin
210   inherited;
211   fIsDlgChange := False;
212 end;
213 
214 end.

View Code

经测试代码可用！

uMyClassHelpers

[delphi]view plain copy 
<pre name="code" class="delphi">unit uMyClassHelpers;  
{实现窗体自适应调整尺寸以适应不同屏幕分辩率的显示问题。 
        陈小斌，2012年3月5日 
使用时，主窗体直接继承TfdForm  Tform1=class(TfdForm) 
或TfmForm   Tform1=class(TfmForm)即可 
                                -----haiou327测试       }  
  
interface  
uses  
  SysUtils, Windows, Classes, Graphics, Controls, Forms, Dialogs, Math,  
  TypInfo;  
  
const //记录设计时的屏幕分辨率  
 OriWidth = 1024;  
 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;  
    function PropertyExists(const AObject: TObject;const APropName:String):Boolean;  
     function GetObjectProperty(  
     const AObject   : TObject;  
     const APropName : string  
     ):TObject;  
  end;  
  
  TfdForm = class(TfmForm) //增加对话框窗体的修改确认  
  protected  
    fIsDlgChange: Boolean;  
  public  
    constructor Create(AOwner: TComponent); override;  
    property IsDlgChange: Boolean read fIsDlgChange default false;  
  end;  
  
implementation  
  
function TfmForm.PropertyExists(const AObject: TObject;const APropName:String):Boolean;  
 //判断一个属性是否存在  
 var  
   PropInfo:PPropInfo;  
 begin  
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);  
   Result:=Assigned(PropInfo);  
 end;  
  
 function TfmForm.GetObjectProperty(  
     const AObject   : TObject;  
     const APropName : string  
     ):TObject;  
 var  
   PropInfo:PPropInfo;  
 begin  
   Result  :=  nil;  
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);  
   if Assigned(PropInfo) and  
       (PropInfo^.PropType^.Kind = tkClass) then  
     Result  :=  GetObjectProp(AObject,PropInfo);  
 end;  
  
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;  
    locFontp: ^Integer;  
  begin  
    try  
      New(locPRect);  
      locPRect^ := vCtl.BoundsRect;  
      vList.Add(locPRect);  
      if PropertyExists(vCtl, 'FONT') then  
      begin  
        LocFont := TFont(GetObjectProperty(vCtl, 'FONT'));  
        New(locFontp);  
        locFontP^ := LocFont.Size;  
        vList.Add(locFontP);  
//        ShowMessage(vCtl.Name+'Ori:='+InttoStr(LocFont.Size));  
      end;  
      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;  
      if PropertyExists(vCtl, 'FONT') then  
      begin  
        Inc(vK);  
        LocFont := TFont(GetObjectProperty(vCtl, 'FONT'));  
        locFontSize := Integer(vList.Items[vK]^);  
        LocFont.Size := Round(LocFontRate * locFontSize);  
//        ShowMessage(vCtl.Name+'New:='+InttoStr(LocFont.Size));  
      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 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.</pre>  
<pre></pre>  
<pre></pre>  
     

查看全文

相关阅读:
bzoj 1051: [HAOI2006]受欢迎的牛
 bzoj 1192: [HNOI2006]鬼谷子的钱袋
 一些动规水题
 USACO 2014 Open Silver Fairphoto
USACO 2013 Nov Silver Pogo-Cow
09day1
09day2
08day2
08day1
07day2

原文地址：https://www.cnblogs.com/kayvanguo/p/5911630.html