zoukankan      html  css  js  c++  java
  • delphi 窗体自适应屏幕分辨率

    这是个困惑我很长时间的问题,到今天终于得到解决了。

    话说Delphi有个很强的窗体设计器,这一点让VC粉丝垂涎三尺而不可得。但是,Delphi里设计的窗体并没有自动适应屏幕分辨率的属性,也就是说,软件设计时调整完美的窗体控件布局,在不同屏幕分辨率的机器上运行时可能会变得面目全非。控件之间会相互移位,有的甚至移出窗体再也找不到了。

    这个问题在网上搜索过多次,但大都依据控件方法ScaleBy或者ChangeScale。采用这两个方法进行自适应调整,我自己都试过,但效果并不理想。后来我自己也写了一个继承自窗体的基类,覆盖构造函数,调用自己的一个设备分辨率自适应方法,该方法遍历窗体上所有控件,并按照设计时的屏幕分辨率和当前屏幕分辨率的比值,逐一计算控件的位置和尺寸。这个想法是不错,效果也是有的,比单纯的采用ScaleBy或者ChangeScale方法要好,但也不是非常理想,没有达到自己设想的要求。原因在哪里,一直不知道。

    我原来的代码曾经发布在Delphi盒子和CSDN上。

    这个问题今天终于得以彻底解决了!!

    原因是,我原以为将所有控件的Align属性设为alnone,Anchors属性设为空[],控件位置和尺寸就不会受其容器尺寸改变的影响。今天我在设计期对此进行试验时,发现不是这样。当窗体大小改变的时候,即使某个控件的Align:=alNone,Anchors:=[],它依然会随着窗体尺度的变化而变化。这意味着我需要一个数组事先保存所有控件的原始位置和尺寸。在窗体因为屏幕分辨率的改变而自动调整时,计算的依据依然是不变的原始窗体位置尺寸数据,这样问题就解决了。

    闲话少说,上源码。

    unit uMyClassHelpers;

    interface


    Uses


      SysUtils,Windows,Classes,Graphics, Controls,Forms,Dialogs,
      uMySysUtils;

    Const   //记录设计时的屏幕分辨率


      OriWidth=1366;
      OriHeight=768;

    Type

      TfmForm=Class(TForm)   //实现窗体屏幕分辨率的自动调整
      Private
        fScrResolutionRateW: Double;
        fScrResolutionRateH: Double;
        fIsFitDeviceDone: Boolean;
        fPosition:Array of TRect;
        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
      i:Integer;
      LocList:TList;
      LocFontSize:Integer;
      LocFont:TFont;
      LocCmp:TComponent;
      LocFontRate:Double;
      LocRect:TRect;
      LocCtl:TControl;
    begin
      LocList:=TList.Create;
      Try
        Try
          if (Screen.width<>OriWidth)OR(Screen.Height<>OriHeight) then
          begin
            Self.Scaled:=False;
            fScrResolutionRateH:=screen.height/OriHeight;
            fScrResolutionRateW:=screen.Width/OriWidth;
            Try
              if fScrResolutionRateH<fScrResolutionRateW then
                LocFontRate:=fScrResolutionRateH
              Else
                LocFontRate:=fScrResolutionRateW;
            Finally
              ReleaseDC(0, GetDc(0));
            End;

            For i:=Self.ComponentCount-1 Downto 0 Do
            Begin
              LocCmp:=Self.Components[i];
              If LocCmp Is TControl Then
                LocList.Add(LocCmp);
              If PropertyExists(LocCmp,'FONT') Then
              Begin
                LocFont:=TFont(GetObjectProperty(LocCmp,'FONT'));
                LocFontSize := Round(LocFontRate*LocFont.Size);
                LocFont.Size:=LocFontSize;
              End;
            End;

            SetLength(fPosition,LocList.Count+1);
            For i:=0 to LocList.Count-1 Do
              With TControl(LocList.Items[i])Do
                fPosition[i+1]:=BoundsRect;
            fPosition[0]:=Self.BoundsRect;

            With LocRect Do
            begin
               Left:=Round(fPosition[0].Left*fScrResolutionRateW);
               Right:=Round(fPosition[0].Right*fScrResolutionRateW);
               Top:=Round(fPosition[0].Top*fScrResolutionRateH);
               Bottom:=Round(fPosition[0].Bottom*fScrResolutionRateH);
               Self.SetBounds(Left,Top,Right-Left,Bottom-Top);
            end;

            i:= LocList.Count-1;
            While (i>=0) Do
             Begin
              LocCtl:=TControl(LocList.Items[i]);
              If LocCtl.Align=alClient Then
              begin
                Dec(i);
                Continue;
              end;
              With LocRect Do
              begin
                 Left:=Round(fPosition[i+1].Left*fScrResolutionRateW);
                 Right:=Round(fPosition[i+1].Right*fScrResolutionRateW);
                 Top:=Round(fPosition[i+1].Top*fScrResolutionRateH);
                 Bottom:=Round(fPosition[i+1].Bottom*fScrResolutionRateH);
                 LocCtl.SetBounds(Left,Top,Right-Left,Bottom-Top);
              end;
              Dec(i);
            End;
          End;

        Except on E:Exception Do
          Raise Exception.Create('进行屏幕分辨率自适应调整时出现错误'+E.Message);
        End;
      Finally
        LocList.Free;
      End;
    end;


    { TfdForm }

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

    end.

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

  • 相关阅读:
    The Mac Application Environment 不及格的程序员
    Xcode Plugin: Change Code In Running App Without Restart 不及格的程序员
    The property delegate of CALayer cause Crash. 不及格的程序员
    nil localizedTitle in SKProduct 不及格的程序员
    InApp Purchase 不及格的程序员
    Safari Web Content Guide 不及格的程序员
    在Mac OS X Lion 安装 XCode 3.2 不及格的程序员
    illustrate ARC with graphs 不及格的程序员
    Viewing iPhoneOptimized PNGs 不及格的程序员
    What is the dSYM? 不及格的程序员
  • 原文地址:https://www.cnblogs.com/FuYan/p/4972894.html
Copyright © 2011-2022 走看看