让窗体自适应屏幕分辨率的变化——已经比较准确的源代码
我的上个帖子中的源代码有点问题,把窗体的尺寸调整放在了后面,应该放在前面,才能满足等比例放大的要求,现在改了过来,基本上应该比较正确了。以下源码可以直接引用,在你的窗体的FormCreate方法中调用
FitDeviceResolution(Self);
即可实现。
//实现屏幕分辨率的自动调整
procedure FitDeviceResolution(Sender: TForm);
Const //记录设计时的屏幕分辨率
OriWidth=1125;
OriHeight=844;
Var
i:Integer;
j: Integer;
LocAnchors:Array of TAnchors;
LocAlign:Array of TAlign;
LocList:TList;
LocFontSize:Integer;
LocFont:TFont;
LocFontRate:Double;
LocCmp:TComponent;
LocParentFont:Boolean;
begin
ScrResolutionRateH:=screen.height/OriHeight;
ScrResolutionRateW:=screen.Width/OriWidth;
if Abs(ScrResolutionRateH-1)<Abs(ScrResolutionRateW-1) then
LocFontRate:=ScrResolutionRateH
Else
LocFontRate:=ScrResolutionRateW;
LocList:=TList.Create;
Try
Try
if (screen.width<>OriWidth)OR(screen.Height<>OriHeight) then
begin
Sender.Scaled:=False;
For i:=Sender.ComponentCount-1 Downto 0 Do
Begin
LocCmp:=Sender.Components[i];
If LocCmp Is TControl Then
LocList.Add(LocCmp);
If PropertyExists(LocCmp,'PARENTFONT') Then
Begin
LocParentFont:=Boolean(GetObjectProperty(LocCmp,'PARENTFONT'));
LocParentFont:=False;
End;
If PropertyExists(LocCmp,'FONT') Then
Begin
LocFont:=TFont(GetObjectProperty(LocCmp,'FONT'));
LocFontSize := Round(LocFontRate*LocFont.Size);
LocFont.Size:=LocFontSize;
End;
End;
SetLength(LocAnchors,LocList.Count);
SetLength(LocAlign,LocList.Count);
For i:=0 to LocList.Count-1 Do
With TControl(LocList.Items[i]) Do
Begin
LocAnchors[i]:=Anchors;
LocAlign[i]:=Align;
Align:=alNone;
Anchors:=[akLeft,akTop];
End;
Sender.Top:=Round(Sender.Top*ScrResolutionRateH);
Sender.Left:=Round(Sender.Left*ScrResolutionRateW);
Sender.Height:=Round(Sender.Height*ScrResolutionRateH);
Sender.Width:=Round(Sender.Width*ScrResolutionRateW);
Sender.Font.size := Round(LocFontRate*Sender.Font.size);
For i:=0 to LocList.Count-1 Do
Begin
With TControl(LocList.Items[i]) Do
Begin
Top:=Round(Top*ScrResolutionRateH);
Left:=Round(Left*ScrResolutionRateW);
Height:=Round(height*ScrResolutionRateH);
Width:=Round(width*ScrResolutionRateW);
End;
End;
For i:=0 to LocList.Count-1 Do
TControl(LocList.Items[i]).Align:=LocAlign[i];
For i:=0 to LocList.Count-1 Do
TControl(LocList.Items[i]).Anchors:=LocAnchors[i];
End;
Except
MyErrorDlg(LocCMP.Name);
End;
Finally
LocList.Free;
End;
end;