Delphi：窗体自适应屏幕分辨率的改进.docxVIP

unit uMyClassHelpers;{实现窗体自适应调整尺寸以适应不同屏幕分辩率的显示问题。 陈小斌，2012年3月5日}interfaceUses 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;implementationconstructor 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,L