求教：如何让程序自适应分辨率(50分)

S

silver888

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #1

如题
前两天写了一个小程序，在本机运行很正常，于是拿给一同事文员MM用
结果一到她电脑上啊。。字体表格全挤到一起去了，表格还有在屏幕外的
检查下，结果她是800x600的分辨率，但是程序已经写好了，有什么好办法让
程序自适应分辨率么。。请各位大虾指点

 

D

dongy_143

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #2

本论坛讨论这个问题太多了,介意搜索一下以前的帖子,我没现成的代码;

 

M

maikee1978

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #3

辨别分辨率

要得到显示器的分辨率，由下列程序得到：
var
x:longint;
a:string;
begin
x := GetSystemMetrics(SM_CXSCREEN);
Str(x,a);
Label1.Caption := '显示器水平分辨率' + a;
x := GetSystemMetrics(SM_CYSCREEN);
Str(x,a);
Label2.Caption := '显示器垂直分辨率' + a;
end;







动态修改显示器分辨率

Windows提供给我们两个API函数，可以动态调整显示器的分辨率，他们是EnumDisplaySettings() 和ChangeDisplaySettings()，下面这个例子就是了

function DynamicResolution(X, Y: word): BOOL;
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight := Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if DynamicResolution(640, 480) then
ShowMessage('Now is 640*480');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if DynamicResolution(800, 600) then
ShowMessage('Now is 800*600');
end;

 

M

maikee1978

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #4

以下例程,不仅能动态改变FORM的大小,而且字号的大小也随着变化

const height:=600; //根据你设计时的屏幕分辩率设定
width := 800;

var
i :integer;
begin
if (screen.width <> ScreenWidth) then
begin
height := longint(height) * longint(screen.height) DIV ScreenHeight;
width := longint(width) * longint(screen.width) DIV ScreenWidth;
scaleBy(screen.width, ScreenWidth);
end;

for i := componentCount - 1 downto 0 do
with components do
begin
if GetPropInfo(ClassInfo, 'font') <> nil then
font.size := (screen.width DIV screenwidth) * font.size;
end;
end;

将这个过程放入FORM.CREATE事件里
USES加入单元typinfo,

 

H

helium-he

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #5

楼上的方法是个不错的选择
然而,分辨率从800*600 到1024是很完美,但若是更高的分辨率,则会产生变形

 

S

sxwy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #6

用RESIZE组件也可以呀.

 

S

silver888

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #7

问题是不能改分辨率呀，我们的机器配置改分辨率当然没问题
但是一般文员MM的机器是很古老的，改1024x768没法用哦

 

S

silver888

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #8

make1978大侠，能给个QQ号么，请教一下

 

Z

zj_mpy

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #9

GetSystemMetrics(SM_CXSCREEN);

 

H

hhjjhhjj

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #10

这个问题应该没有完美的答案，要不就多放些panel,groupbox之类的，设置一下属性就可以了．

 

M

maikee1978

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-27

• #11

to silver888
以前有个QQ号，好久不用，忘了，上面有一个不用改分辩率的例程，你只要把它定义一个过程在一个公共的单元中，然后在各个form的oncreate中执行那个过程就行了。会自己动调整，推荐你用800X600模式设计，在1024X768下有更好的效果

 

踏

踏浪99

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-28

• #12

试试设置窗体的Sceled属性，也许可以

 

S

silver888

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-28

• #13

to maikee1978
我把代码加入后,说没有找到typeinfo.dcu
是不是还要加什么第三方控件哦?

 

G

ghostxp007

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-28

• #14

procedure screenRate(form:Tform); //适应不同分辨率
begin
form.scaled:=true; //screenHeight，screenWidth开发环境的分辨率 定义成常量
if(screen.Width<>screenWidth) then
begin
form.height:=longInt(form.height)*longint(screen.height) div screenHeight;
form.width:=longInt(form.width)*longInt(screen.width) div screenWidth;
form.scaleby(screen.width,screenWidth);
end;

end;

 

一

一条大鱼

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-10-28

• #15

重写程序,没什么好说的

 

M

maikee1978

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-11-02

• #16

to maikee1978
我把代码加入后,说没有找到typeinfo.dcu
是不是还要加什么第三方控件哦?


typeinfo.dcu?
uses错了,是typinfo。
没有那个e

 

S

silver888

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2006-11-16

• #17

结帖

问题已经解决了，谢谢各位大侠