让窗体自适应屏幕分辨率的变化——已经比较准确的源代码

我的上个帖子中的源代码有点问题,把窗体的尺寸调整放在了后面,应该放在前面,才能满足等比例放大的要求,现在改了过来,基本上应该比较正确了。以下源码可以直接引用,在你的窗体的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;

原文地址:https://www.cnblogs.com/martian6125/p/9631290.html