屏幕亮度(XE10.1+WIN8.164)

 

相关资料：

http://bbs.csdn.net/topics/390664310

 

实例代码：

 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.Imaging.jpeg,
 8   Vcl.ExtCtrls;
 9 
10 type
11   TRampArray = array[0..2] of array[byte] of word;
12 
13 type
14   TForm1 = class(TForm)
15     Button1: TButton;
16     Button2: TButton;
17     Image1: TImage;
18     procedure Button1Click(Sender: TObject);
19     procedure FormCreate(Sender: TObject);
20     procedure Button2Click(Sender: TObject);
21     procedure FormDestroy(Sender: TObject);
22   private
23     { Private declarations }
24   public
25     { Public declarations }
26   end;
27 
28 var
29   Form1: TForm1;
30   origRampArray: TRampArray;
31 
32 implementation
33 
34 {$R *.dfm}
35 
36 function SetBrightness(wBrightness: word): boolean;
37 var
38   RampArray: TRampArray;
39   I, Value: integer;
40   DC: HDC;
41 begin
42   for I := 0 to MAXBYTE do
43   begin
44     Value := I * (wBrightness + 128);
45     if (Value > MAXWORD) then Value := MAXWORD;
46     RampArray[0][I] := Value;
47     RampArray[1][I] := Value;
48     RampArray[2][I] := Value;
49   end;
50   DC := GetDC(0);
51   try
52     Result := SetDeviceGammaRamp(DC, RampArray);
53   finally
54     ReleaseDC(0, DC);
55   end;
56 end;
57 
58 procedure TForm1.Button1Click(Sender: TObject);
59 begin
60   SetBrightness(64);
61 end;
62 
63 procedure TForm1.Button2Click(Sender: TObject);
64 var
65   DC: HDC;
66 begin
67   DC := GetDC(0);
68   try
69     SetDeviceGammaRamp(DC, origRampArray);
70   finally
71     ReleaseDC(0, DC);
72   end
73 end;
74 
75 procedure TForm1.FormCreate(Sender: TObject);
76 var
77   DC: HDC;
78 begin
79   DC := GetDC(0);
80   try
81     GetDeviceGammaRamp(DC, origRampArray);
82   finally
83     ReleaseDC(0, DC);
84   end
85 end;
86 
87 procedure TForm1.FormDestroy(Sender: TObject);
88 begin
89   Button2Click(Button2);
90 end;
91 
92 end.
View Code

 

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

导航