Delphi 实现窗体自适应调整尺寸以适应不同屏幕分辩率的显示问题

摘要:
给你一段在线传输的代码:unituMyClassHelpers//实现窗口自适应大小调整,以适应不同屏幕分辨率的显示问题//陈晓彬,2012年3月5日,interfaceUsesSysUtils,Windows,Classes,Graphics,Controls,Forms,Dialogs,Math,typeinfo//uMySysUtils;Const//在设计时记录屏幕分辨率OriWidth=

给你一段代码,网上转的:
unit uMyClassHelpers;
//实现窗体自适应调整尺寸以适应不同屏幕分辩率的显示问题。
//        陈小斌,2012年3月5日


interface

Uses
  SysUtils,Windows,Classes,Graphics, Controls,Forms,Dialogs, Math,typinfo;
//  uMySysUtils;

Const   //记录设计时的屏幕分辨率
   OriWidth=1024;
   OriHeight=768;

var
   OriWidth,OriHeight:Integer;

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

uses UMain;

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;
  
  function PropertyExists(const AObject: TObject;const APropName:String):Boolean;
  //判断一个属性是否存在
  var
   PropInfo:PPropInfo;
  begin
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
   Result:=Assigned(PropInfo);
  end;

  function GetObjectProperty(
     const AObject   : TObject;
     const APropName : string
     ):TObject;
  var
   PropInfo:PPropInfo;
  begin
   Result  :=  nil;
   PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
   if Assigned(PropInfo) and
       (PropInfo^.PropType^.Kind = tkClass) then
     Result  :=  GetObjectProp(AObject,PropInfo);
  end;

//保存原有坐标位置:利用递归法遍历各级容器里的控件,直到最后一级
  Procedure ControlsPostoList(vCtl:TControl;vList:TList);
  Var
    locPRect:^TRect;
    i:Integer;
    locCtl:TControl;
    locFontp:^Integer;
  Begin
    try
      New(locPRect);
      locPRect^:=vCtl.BoundsRect;
      vList.Add(locPRect);
      If PropertyExists(vCtl,'FONT') Then
      Begin
        LocFont:=TFont(GetObjectProperty(vCtl,'FONT'));
        New(locFontp);
        locFontP^:=LocFont.Size;
        vList.Add(locFontP);
//        ShowMessage(vCtl.Name+'Ori:='+InttoStr(LocFont.Size));
      End;
      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;
      If PropertyExists(vCtl,'FONT') Then
      Begin
        Inc(vK);
        LocFont:=TFont(GetObjectProperty(vCtl,'FONT'));
        locFontSize:=Integer(vList.Items[vK]^);
        LocFont.Size := Round(LocFontRate*locFontSize);
//        ShowMessage(vCtl.Name+'New:='+InttoStr(LocFont.Size));
      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 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.

免责声明:文章转载自《Delphi 实现窗体自适应调整尺寸以适应不同屏幕分辩率的显示问题》仅用于学习参考。如对内容有疑问,请及时联系本站处理。

上篇JS CustomEvent自定义事件传参网络编程bind函数详解(转载)下篇

宿迁高防,2C2G15M,22元/月;香港BGP,2C5G5M,25元/月 雨云优惠码:MjYwNzM=

相关文章

delphi 脚本引擎比较

TMS Scripter:支持Pascal和VBScript两种语法。优点是文档齐全、例子齐全,脚本可直接支持DLL,官方还提供了丰富的IDE Debug工具、单元导出函数工具等,缺点是编译运行较慢。for 空循环1000万次,需要10秒钟以上。TMS Scripter是商业共享软件。 FastScript:用过FastReport报表的同学都知道Fast...

delphi 多媒体 操作 wave(1)

Wave 文件的文件格式微软的多媒体文件(wav、avi、tif 等)都有一个 RIFF 头, Wave 文件基本是这个样子: RIFF 头 fmt 子块 data 子块 Wave 文件的编码方式有好多, 最常用最简单的就是 PCM 编码.其他编码会包含更多的"块", 但至少会包含上面的块, PCM 编码只包含上面的块 2.判断一个文件是否是 W...

delphi hook alt+F4 ctrl+delete+alt win键等

unit uHook;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms, Dialogs,  StdCtrls;type  tagKBDLLHOOKSTRUCT = packed record    vkCode: DWORD;    scanCod...

delphi PDFium 常用功能

PDFium 常用功能 属性和方法 TPdf.Active property Active: Boolean; 打开或关闭选定的PDF文档。 TPdf.FileName property FileName: string; PDF文件的名称(包含路径)。 TPdf.Password property Password: string; PDF文件的密...

delphi

procedureTForm1.btnFindClick(Sender: TObject); varhr, hr1, hr_id, hr_pwd: THandle; WindowText: array[0..MAX_PATH] ofChar; beginhr := FindWindow('#32770', 'TeamViewer'); hr :=...

用element-ui的走马灯carousel轻松实现自适应全屏banner图

写在前面:网站轮播图建议使用swiper组件,非常方便快捷。vue轮播图插件之vue-awesome-swiper 接手一个项目,轮播图是用element-ui的carousel实现的,看起来效果还不错,只是固定宽高,并未做适配,于是将就代码做下修改,以适配各种显示器屏幕。 &lt;el-carousel indicator-positi...