Delphi枚舉當前所有的顯示模式,並通過拖動滑塊的方式來改變當前顯示器的分辨率,本程序與Windows系統緊密相關,大部分操作都是基於Delphi內置函數來實現,有助於Delphi初學者熟悉Windows內置函數的使用,特別值得一提的是代碼中的ChangeDisplaySettings函數,功能非常強大,所有與顯示有關的操作都可以用這個函數來實現,這裡只是在改變屏幕分辨率方面小試牛刀而已:
01
unit
Unit1;
02
interface
03
uses
04
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
05
Dialogs, StdCtrls, ComCtrls;
06
type
07
TForm1 =
class
(TForm)
08
Button2: TButton;
09
ListBox1: TListBox;
10
Button1: TButton;
11
TrackBar1: TTrackBar;
12
Label1: TLabel;
13
procedure
Button1Click(Sender: TObject);
14
procedure
TrackBar1Change(Sender: TObject);
15
procedure
Button2Click(Sender: TObject);
16
private
17
public
18
end
;
19
var
20
Form1: TForm1;
21
implementation
22
uses
Math;
23
{$R *.dfm}
24
procedure
TForm1
.
Button1Click(Sender: TObject);
25
var
26
DevModeCount:
Integer
;
// 顯示模式的數目
27
DevModeInfo: ^TDevMode;
//指向顯示模式信息的指針
28
DevModeArray: TList;
// 顯示模式信息結構列表
29
begin
30
DevModeArray := TList
.
Create;
31
DevModeCount :=
0
;
32
GetMem(DevModeInfo, SizeOf(TDevMode));
33
{枚舉顯示模式}
34
while
EnumDisplaySettings(
nil
, DevModeCount, DevModeInfo^)
do
35
begin
36
DevModeArray
.
Add(DevModeInfo);
37
Inc(DevModeCount);
38
ListBox1
.
Items
.
Add(IntToStr(DevModeInfo^.dmPelsWidth)+
'x'
+
39
IntToStr(DevModeInfo^.dmPelsHeight)+
', '
+
40
IntToStr(Trunc(IntPower(
2
, DevModeInfo^.dmBitsPerPel)))+
41
'colors,'
+IntToStr(DevModeInfo
.
dmDisplayFrequency)+
'hz'
);
42
GetMem(DevModeInfo, SizeOf(TDevMode));
43
end
;
44
FreeMem(DevModeInfo, SizeOf(TDevMode));
45
ListBox1
.
ItemIndex :=
0
;
46
end
;
47
{var dm:DEVMODE;
48
begin
49
//以下幾個是DEVMODE在改變屏幕分辨率時必須使用的幾個必須設置的幾個值;
50
with dm do
51
begin
52
dmBitsPerPel:=16;
53
dmpelswidth:=640;
54
dmpelsheight:=480;
55
dmDisplayFlags:=DM_INTERLACED;//前面的參數是彩色的,還可以是DM_GRAYSCALE(單色的);
56
dmDisplayFrequency :=0;
57
end;
58
ChangeDisplaySettings(dm,0);
59
//ChangeDisplaySettings功能相當強大了,所有與顯示有關的操作都可以用這個函數來完成,
60
//這裡只是用它來改變屏幕分辨率;
61
}
62
procedure
TForm1
.
TrackBar1Change(Sender: TObject);
63
begin
64
Case
TrackBar1
.
Position
Of
65
0
:Label1
.
Caption:=
'640×480'
;
66
1
:Label1
.
Caption:=
'800×600'
;
67
2
:Label1
.
Caption:=
'1280×1024'
;
68
end
;
69
end
;
70
function
DynamicResolution(X, Y:
Word
;freq:
Word
): BOOL;
71
var
72
lpDevMode: TDeviceMode;
73
begin
74
Result := EnumDisplaySettings(
nil
,
0
, lpDevMode);
75
if
Result
then
76
begin
77
lpDevMode
.
dmFIElds := DM_PELSWIDTH
Or
DM_PELSHEIGHT
or
DM_DISPLAYFREQUENCY;
78
lpDevMode
.
dmPelsWidth := X;
79
lpDevMode
.
dmPelsHeight := Y;
80
lpDevMode
.
dmDisplayFrequency:=freq;
81
Result := ChangeDisplaySettings(lpDevMode,
0
) = DISP_CHANGE_SUCCESSFUL;
//更改成功,不能更改刷新頻率
82
end
;
83
end
;
84
procedure
TForm1
.
Button2Click(Sender: TObject);
85
begin
86
Case
TrackBar1
.
Position
Of
87
0
: DynamicResolution(
640
,
480
,
80
);
88
1
: DynamicResolution(
800
,
600
,
80
);
89
2
: DynamicResolution(
1280
,
1024
,
80
);
90
end
;
91
end
;
92
end
.
代碼運行後的測試截圖,下面的滑塊可改變分辨率,拖動滑塊後,點擊後面的“改變分辨率”按鈕即可確定。