delphi窗体和控件随着屏幕分辨率变化而变化

yang2lin 2012-01-01 08:58:55
各位朋友,有谁知道当调整屏幕分辨率的时候,窗体和控件的大小随着变化而变化,我再网上找了很久的资料也没找到,希望大家给的答案是自己确定能成功的,谢谢大家!高分对待!
...全文
4192 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
yclszjx 2014-07-28
  • 打赏
  • 举报
回复
TFrame就不行了。
LLC0314 2014-01-17
  • 打赏
  • 举报
回复
6楼正解,亲测通过
softheaded 2012-09-11
  • 打赏
  • 举报
回复
给你一段代码,网上转的:
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.
老吴子 2012-06-19
  • 打赏
  • 举报
回复
多用容器如Panel布局,设置空间的anchor(记不清了)属性。
阿荷 2012-06-19
  • 打赏
  • 举报
回复
设置anchor属性。
阿荷 2012-05-28
  • 打赏
  • 举报
回复
设置 最大化
山东蓝鸟贵薪 2012-02-27
  • 打赏
  • 举报
回复
rzsize 设置一下也是可以的
zhimingcom 2012-01-04
  • 打赏
  • 举报
回复
看看窗体的 AutoScaleMode 属性

1,978

社区成员

发帖
与我相关
我的任务
社区描述
.NET技术 其他语言讨论
社区管理员
  • 其他语言社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧