屏幕相关操作（XE10.1+WIN8.164）

相关资料：

http://www.bianceng.cn/Programming/Delphi/201104/25455.htm

http://blog.csdn.net/anbangs/article/details/5008923

http://bbs.csdn.net/topics/280065261?locationNum=11

 

注意事项：

1.改屏幕分辨率时，不是随意的，如果显示器不支持的话，只能右击属性里面看一下支持哪些分辨率。

 

实例代码：

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  8   Vcl.Imaging.jpeg;
  9 
 10 type
 11   TForm1 = class(TForm)
 12     Button2: TButton;
 13     Button3: TButton;
 14     Button4: TButton;
 15     Label1: TLabel;
 16     Label2: TLabel;
 17     Label3: TLabel;
 18     Button1: TButton;
 19     Image1: TImage;
 20     procedure Button2Click(Sender: TObject);
 21     procedure Button3Click(Sender: TObject);
 22     procedure Button4Click(Sender: TObject);
 23     procedure Button1Click(Sender: TObject);
 24   private
 25     { Private declarations }
 26   public
 27     { Public declarations }
 28   end;
 29 
 30 var
 31   Form1: TForm1;
 32 
 33 implementation
 34 
 35 {$R *.dfm}
 36 
 37 procedure TForm1.Button1Click(Sender: TObject);
 38 var
 39   mmW,mmH: Integer;
 40   pixW,pixH: Integer;
 41   pm: Double;
 42 begin
 43   {以毫米为单位获取屏幕尺寸}
 44   mmW := GetDeviceCaps(Canvas.Handle, HORZSIZE);
 45   mmH := GetDeviceCaps(Canvas.Handle, VERTSIZE);
 46   ShowMessageFmt('屏幕宽: %d 毫米; 屏幕高: %d 毫米', [mmW, mmH]);
 47   {屏幕宽: 510 毫米; 屏幕高: 287 毫米}
 48   {以像素为单位获取屏幕尺寸}
 49   pixW := GetDeviceCaps(Canvas.Handle, HORZRES);
 50   pixH := GetDeviceCaps(Canvas.Handle, VERTRES);
 51   ShowMessageFmt('屏幕宽: %d 像素; 屏幕高: %d 像素', [pixW, pixH]);
 52   {屏幕宽: 1920 像素; 屏幕高: 1080 像素}
 53   {当前状态下, 1 毫米等于多少像素?}
 54   ShowMessage(FloatToStr(pixW / mmW)); {3.76470588235294}
 55   ShowMessage(FloatToStr(pixH / mmH)); {3.76306620209059}
 56   {一步获取}
 57   pm := GetDeviceCaps(Canvas.Handle, HORZRES) / GetDeviceCaps(Canvas.Handle, HORZSIZE);
 58   ShowMessage(FloatToStr(pm)); {3.76470588235294}
 59 end;
 60 
 61 procedure TForm1.Button2Click(Sender: TObject);
 62 var
 63   lpDevMode: TDeviceMode;
 64 begin
 65   EnumDisplaySettings(nil, 0, lpDevMode);
 66   lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
 67   lpDevMode.dmPelsWidth := 1600;
 68   lpDevMode.dmPelsHeight := 900;
 69   ChangeDisplaySettings(lpDevMode, 0);
 70 end;
 71 
 72 procedure TForm1.Button3Click(Sender: TObject);
 73 begin
 74   Label1.Caption := IntToStr(screen.width);//宽
 75   Label2.Caption := IntToStr(screen.height);//高
 76   Label3.Caption := IntToStr(Screen.MonitorCount);//显示器数量
 77 end;
 78 
 79 procedure TForm1.Button4Click(Sender: TObject);
 80 begin
 81   //我的电脑最大支持1920，所以返回的是1920
 82   case GetDeviceCaps(GetDC(Form1.Handle), HORZRES) of
 83     640: //对640×480分辨率进行处理的代码；
 84     begin
 85     end;
 86     800: //对800×600分辨率进行处理的代码；
 87     begin
 88     end;
 89     1024: //对1024×768分辨率进行处理的代码；
 90     begin
 91     end;
 92     1280: //对1280×1024分辨率进行处理的代码；
 93     begin
 94     end;
 95     1600://1600*900
 96     begin
 97     end;
 98     1920://1920*1080
 99     begin
100     end;
101   end;
102 end;
103 
104 end.
View Code

 

posted on 2017-04-01 11:04  疯狂delphi  阅读(425)  评论(0)  编辑  收藏  举报

导航