function tform1.DynamicResolution(x, y: WORD): Boolean;
var
lpDevMode: TDeviceMode;
screenFrequency:integer;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_DISPLAYFREQUENCY;
lpDevMode.dmPelsWidth := x;
lpDevMode.dmPelsHeight := y;
screenFrequency:=getdevicecaps(getdc(0),VREFRESH);
lpDevmode.dmDisplayFrequency:=screenFrequency;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end;
end;
var
lpDevMode: TDeviceMode;
screenFrequency:integer;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_DISPLAYFREQUENCY;
lpDevMode.dmPelsWidth := x;
lpDevMode.dmPelsHeight := y;
screenFrequency:=getdevicecaps(getdc(0),VREFRESH);
lpDevmode.dmDisplayFrequency:=screenFrequency;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end;
end;
先在表单单元的Interface部分定义两个常量,表示设计时的屏幕的宽度和高度(以像素为单位)。在表单的Create事件中先判断当前分辨率是否与设计分辨率相同,如果不同,调用表单的SCALE过程重新能调整表单中控件的宽度和高度。
Const
Orignwidth=800;
Orignheight=600;
procedureTForm1.FormCreate(Sender:TObject);
begin
scaled:=true;
if(screen.width<>orignwidth)then
begin
height:=longint(height)*longint
(screen.height)divorignheight;
width:=longint(width)*longint
(screen.width)divorignwidth;
scaleby(screen.width,orignwidth);
end;
end;
SCALE过程在调整控件宽度和高度的同时,也自动调整控件字体的大小,以适应新的分辨率, 但美中不足的是它并不改变控件的顶点坐标位置,也就是说,该过程不改变控件之间的相对位置关系。要想调整控件之间的选队相对位置,还需要自己编程实现,有兴趣的读者可试一试。
二、将机器分辨率更改为设计时的分辨率
这种方法不改变表单本身,而是将屏幕分辨率更改为与表单设计时用到的分辨率相同。它需要用到WINDOWSAPI函数EnumDisplaySettings和ChangeDisplaySettings,前者取当前显示模式信息,后者则更改显示设置,具体参数的含义请参见DELPHI帮助。设计时宽度常量和高度常量的定义如方法一。
procedureTForm1.FormCreate(Sender:TObject);
var
devmode:tDevicemode;
begin
ifscreen.width<>orignwidththen
begin
ifEnumDisplaySettings(nil,0,devmode)then
begin
devmode.dmfields:=dm_pelswidthORdm_pelsheight;
devmode.dmpelswidth:=orignwidth;{宽度}
devmode.dmpelsheight:=orignheight;{高度}
ChangeDisplaySettings(devmode,0);{更改设置}
end;
end;
end; 以上代码我都试过是可以的
CDS_TEST) = DISP_CHANGE_SUCCESSFUL then
ChangeDisplaySettings(lpDevMode,
CDS_UPDATEREGISTRY);SendMessage(HWND_BROADCAST,
WM_DISPLAYCHANGE,
SPI_SETNONCLIENTMETRICS,
0);
CDS_TEST) = DISP_CHANGE_SUCCESSFUL then
ChangeDisplaySettings(lpDevMode,
CDS_UPDATEREGISTRY);SendMessage(HWND_BROADCAST,
WM_DISPLAYCHANGE,
SPI_SETNONCLIENTMETRICS,
0);