不同分辨率下如何自动调整控件大小(100分)

  • 主题发起人 主题发起人 87150
  • 开始时间 开始时间
8

87150

Unregistered / Unconfirmed
GUEST, unregistred user!
我用WINXP+DELPHI6/1024*468开发的程序
在WINXP/800*600和WIN98/800*600运行时控件大小不一
请教如何自动调整控件大小比例?
 
我也想知道
 
在开始要引用一个typinfo的单元
遍历窗体上所有的component,判断他们是否有left、top、height、width属性,有的话就开始转换。
用GetPropInfo来判断
var
DHeight, DWidth: Integer;
n: integer;
p1, p2, p3: PPropInfo;
begin
DHeight := 600;//设计模式的大小
DWidth := 800;
if Screen.Width <> Dwidth then
begin
self.Width := self.Width * screen.Width div DWidth;
self.Height := self.Height * screen.Height div DHeight;


for n := 0 to self.ComponentCount - 1 do

begin
p1 := nil;
p2 := nil;
// p3 := nil;
p1 := GetPropInfo(self.Components[n].classinfo, 'height');
p2 := GetPropInfo(self.Components[n].classinfo, 'left');
// p3 := GetPropInfo(self.Components[n].classinfo, 'font');
if (p1 <> nil) and (p2 <> nil) then
begin
Tcontrol(self.Components[n]).Left := (Tcontrol(components[n]).Left * screen.Width) div DWidth;
Tcontrol(self.Components[n]).top := (Tcontrol(components[n]).top * screen.Height) div DHeight;
Tcontrol(self.Components[n]).Width := (Tcontrol(components[n]).Width * screen.Width) div DWidth;
Tcontrol(self.Components[n]).Height := (Tcontrol(components[n]).Height * screen.Height) div DHeight;
end;
end;
self.font.Size := self.font.Size * screen.Height div DHeight;
end;
end;
 
好,长见识
 
不用怎么复杂,用这个方法吧:
//定义分辨率
const
ScreenHeight: integer = 800;
ScreenWidth: integer = 600;

procedure TForm1.FormCreate(Sender: TObject);
var
x, y: LongInt;
begin
form1.scaled := true;
//窗体可以缩放
x := getSystemMetrics(SM_CXSCREEN);
y := getSystemMetrics(SM_CYSCREEN);
//程序运行时获取目标机器的屏幕分辨率
if (x <> ScreenHeight) or (y <> ScreenWidth) then
//目标机器的屏幕分辨率与作者机器的屏幕分辨率不同
begin
form1.height:=form1.height*x DIV ScreenHeight;
form1.width:=form1.width*y DIV ScreenWidth;
scaleBy(x,ScreenHeight);
//调用窗体的scaleBy函数,将窗体大小变为初始大小的x/ ScreenHeight倍。
//这是本程序的关键技巧,同时缩放的包括窗体上各组件和字体。
end;
end;
 
to 比尔.丐痴
我以前用过你那方法,是重画一次窗体,但有时字体会变得很恶心,而且控件之间的距离
也变得不是很好
 
谢谢楼上几位,控件的字体怎么处理,有些控件大小不变?!
 
倒数第三行就是处理字体的。
你不就是要改变分辨率后大小不变吗?
 
怎么还不结帐?
 
再说一句 经验
在98下 就算是你的分辨率是800,600 也不行
举个例子 比如说在 2000下 分辨率是800,600 你窗体 宽 500 高 400
到 98 下分辨率也是800,600 但窗体 宽 600 高 500 了 (不一定是实际大小)
你最好 这么写个函数
type
TfontControl = Class(Tcontrol)
Public
protery Font ;
end ;
procedure Zoom(const FrmWidth ,FrmHeight(你在设计时的窗体大小) : integer);
var
i : integer ;
x, y: LongInt;
tmpFrmWidth,tmpFrmHeight : integer ;
begin
//窗体可以缩放
x := 800;
y := 600;
//程序运行时获取目标机器的屏幕分辨率
if (x <> Screen.Height) or (y <> Screen.Width) then
//目标机器的屏幕分辨率与作者机器的屏幕分辨率不同
begin
form1.height:=form1.height*x DIV Screen.Height;
form1.width:=form1.width*y DIV Screen.Width;
scaleBy(x,ScreenHeight);
//调用窗体的scaleBy函数,将窗体大小变为初始大小的x/ ScreenHeight倍。
//这是本程序的关键技巧,同时缩放的包括窗体上各组件和字体。
end
else FrmWidth <> form1.width then
begin
tmpFrmWidth := FrmWidth ;
form1.width := FrmWidth ;
form1.height := frmHeight ;
scaleBy(FrmWidth,tmpFrmWidth)
For i := 0 to self.ControlCount-1 do
TFontcontrol(Self.Controls).Font.size := TFontcontrol(Self.Controls).Font.size
* (FrmWidth /tmpFrmWidth)
end;

end ;
写的 不太好 指告诉你个大概意思
 
但是这样控件的位置全部不对了!!
 
其实我发现在win2000/xp下编译和win98下的界面的属性'变形'有以下规律:win2000/xp各控件的top,left,height,width,fontsize的值正好是98下1.25倍,可以用上面的提到的方法先找form上的每个元件,然后在用他们
Tcontrol(self.Components[n]).Left := (Tcontrol(components[n]).Left * 100) div 125;........
不过在这之前要先用Tregisty先从注册表中windows/windows NT中读ProductName,看下用户的操作系统是98还是2000,如果是是98就属性大小转换下,如果是2000/xp就不用转换,经过这样的转换各控件及相对位置都不失真!
前提:你的程序是在 2000/xp下设计编译的。不知道大家还有没有更好的办法!
 
接受答案了.
 
to:hebohb
你这个方法可以实现静态的。但是我想实现动态的怎么做呢??
你原来方法可以实现:
如果原来就是: 800*600 可以实现.
如果原来就是: 1024*768 可以实现.

但是动态的就不行了??
如果我原来是: 1024*768 ,然后我改成 800*600 ,(原来在1024*768没有关闭,只是最小化)改完分辩率之后,再最大化,那么在800*600 就不行了???
 
后退
顶部