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.
代碼運行後的測試截圖,下面的滑塊可改變分辨率,拖動滑塊後,點擊後面的“改變分辨率”按鈕即可確定。
