在窗体依据屏幕分辨率自适应调整尺度方面,昨天的工作可以说是一个突破点。昨天的工作找到了长期以来我的原有方案的问题所在,这是非常关键的。但是昨天晚上的解决方案并不完美,今天的这个才是比较完美的解决版。

先补充说明一下这个问题的重要性。这本来只是一个很小的技术问题,但在现有的Windows软件开发过程中,这个问题非常常见。一些非常著名的商业化软件,也会发现这方面的问题。Delphi的IDE本身在不同屏幕分辨率的机器上运行时,有些界面也会出现变形和控件找不到的情况;Adobe是家软件大公司,他的PDF编辑器在不同屏幕分辨率的机器上运行时,也会出现按钮不见或者被吃掉一半的情况。

因此,这实际上是软件开发过程中一个小的但又常常让人烦恼的顽疾。

昨天的解决方案中,有一点有所忽略。也就是,由于容器中的控件的位置和尺寸会随着容器尺寸的改变而改变,那么,容器尺寸的改变应该发生在其所包含的控件尺寸调整之前。但是,我并不清楚,一个容器里面到底嵌套了多少级,到底存在多少容器和控件,也不清楚容器中组件的排列方式。昨天的方案在这个地方带有点尝试性,似乎是倒着顺序去调整控件的尺寸,出来的窗体就会比较合理,而顺着序改则会调整不好。这个经验是很久以前试出来的,昨天没有改所以忘了说。

今天的方案是是首先利用递归方法做第一次遍历,一层一层地搜索,直到把所有的控件搜索完毕。搜索过程中将每个控件的原始坐标保存起来。然后按照同样的方式做第二次遍历,利用保存的原始坐标数据计算新的坐标数据。由于搜索是从顶层容器依次往下的,因此先修改的是容器的尺度,然后才修改容器内部控件的尺度,这样明确保证了控件尺度的调整在其宿主容器尺寸调整之后,也就不会再受其宿主容器尺度改变的影响。最后对窗体中所有组件做遍历,修改字体大小。

改进后的源代码如下,经过试验,效果非常完美,用法跟昨天的一样。

unit uMyClassHelpers;
{实现窗体自适应调整尺寸以适应不同屏幕分辩率的显示问题。
        陈小斌,2012年3月5日
}

interface
Uses
  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;

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
  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,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;
      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 AdjustComponentFont(vCmp:TComponent);
  Var
    i:Integer;
    locCmp:TComponent;
  Begin
    try
      For i:=vCmp.ComponentCount-1 Downto 0 Do
      Begin
        locCmp:=vCmp.Components[i];
        If PropertyExists(LocCmp,'FONT') Then
        Begin
          LocFont:=TFont(GetObjectProperty(LocCmp,'FONT'));
          LocFontSize := Round(LocFontRate*LocFont.Size);
          LocFont.Size:=LocFontSize;
        End;
      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.

本文引用地址:http://blog.sciencenet.cn/blog-39148-544498.html

Delphi:窗体自适应屏幕分辨率的改进的更多相关文章

  1. delphi 窗体自适应屏幕分辨率

    delphi 窗体自适应屏幕分辨率 这是个困惑我很长时间的问题,到今天终于得到解决了. 话说Delphi有个很强的窗体设计器,这一点让VC粉丝垂涎三尺而不可得.但是,Delphi里设计的窗体并没有自动 ...

  2. Delphi:窗体自适应屏幕分辨率(根据预设值的比例改变)

    delphi 程序适应屏幕分辨率,先在表单单元的Interface部分定义两个常量, 表示设计时的屏幕的宽度和高度(以像素为单位). 在表单的Create事件中先判断 当前分辨率是否与设计分辨率相同, ...

  3. Delphi自动适应屏幕分辨率的属性

    https://www.cnblogs.com/zhangzhifeng/category/835602.html 这是个困惑我很长时间的问题,到今天终于得到解决了. 话说Delphi有个很强的窗体设 ...

  4. #region 自适应屏幕分辨率

            #region 自适应屏幕分辨率 [StructLayout(LayoutKind.Sequential, CharSet = CharSet.Auto)]        public ...

  5. Unity3D NGUI自适应屏幕分辨率(2014/4/17更新)

    原地址:http://blog.csdn.net/asd237241291/article/details/8126619 原创文章如需转载请注明:转载自 脱莫柔Unity3D学习之旅 本文链接地址: ...

  6. NGUI自适应屏幕分辨率

    unity官方承诺的新ui系统一直没有推出来,我们的UI使用的是原生的OnGUI系统,刚好UI需要改版,索性就想迁到NGUI上面来,于是看了一下NGUI源码,发现NGUI可以大大的降低DrawCall ...

  7. Unity NGUI根据高度自适应屏幕分辨率

    Unity版本:4.5.1 NGUI版本:3.6.5 本文内容纯粹转载,转载保留参考链接和作者 参考链接:http://blog.csdn.net/asd237241291/article/detai ...

  8. H5自适应屏幕分辨率大小

    说明: ①:H5自适应不同分辨率的设备,其实主要就一句 <meta name="viewport" content="width=device-width,init ...

  9. delphi 动态更改屏幕分辨率(转)

    一.如何动态更改屏幕分辨率 有许多小工具可以在不重新启动Windows的条件下,动态更改屏幕分辨率.你是不是也想自己动手做一个呢?请在interface段中加入下面一句 function Resolu ...

随机推荐

  1. insert一句话实现插入一条数据并且返回这条数据的某列

    insert into [table] output inserted.columnName values();

  2. JS DOM 来控制HTML元素

    JS DOM 来控制HTML元素 (ps:这个有很多方法,挑一些详解,嘻嘻) 1.getElementsByName():获取name. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ...

  3. a+b(高精度)[陈涛]——c语言

    #include<stdio.h>#include<string.h>char s[1000];---------------------------------------- ...

  4. php和js根据子网掩码和ip计算子网

    php $ip = '192.168.6.1'; $mask = '255.255.2.0'; $sub_net = array();//子网 $ip_explode = explode('.', $ ...

  5. Ubuntu 在右键快捷菜单中添加“Open in Terminal”

    操作步骤翻译如下: 1.打开一个Terminal(ctrl+alt+t),输入如下指令 sudo apt-get install nautilus-open-terminal 2.使用以下指令来重启N ...

  6. DAC,MAC和SELinux,SEAndroid

    1. 被ROOT了怎么办 2. SELinux 3. SEAndroid 4. JB(4.3) MR2的漏洞弥补 ------------------------------------------- ...

  7. 2016021801 - Java内存区域归纳对比

    线程私有 线程共享 程序计数器,虚拟机栈,本地方法栈 堆,方法区 内存区 异常 异常原因 程序计数器 无 虚拟机栈 StackOverflowError 线程请求的栈深度大于虚拟机栈所允许的深度 Ou ...

  8. 学习Swift--方法

    方法 方法是与某些特定类型相关联的函数.类.结构体.枚举都可以定义实例方法:实例方法为给定类型的实例封装了具体的任务与功能.类.结构体.枚举也可以定义类型方法:类型方法与类型本身相关联.类型方法与 O ...

  9. id类型

    id类型 在Objective-C 中,id 类型是一个独特的数据类型.在概念上,类似Java 的Object 类,可以转换为任何数据类型.换句话说,id 类型的变量可以存放任何数据类型的对象.在内部 ...

  10. IntraWeb.v14.0.32安装及破解指南

    一.下载 首先从这里下载14.0.32版本的IntraWeb: 链接:http://pan.baidu.com/s/1c0rjnKO 密码:8kv2 二.卸载旧版 1. 我的Delphi版本是XE6, ...