unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 =
class(TForm)
TB1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure TB1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
FILE_DEVICE_VIDEO = $23;
METHOD_BUFFERED = 0;
FILE_ANY_ACCESS = 0;
IOCTL_VIDEO_SET_DISPLAY_BRIGHTNESS =
FILE_DEVICE_VIDEO
shl 16
or $127
shl 2
or
METHOD_BUFFERED
shl 14
or
FILE_ANY_ACCESS;
IOCTL_VIDEO_QUERY_DISPLAY_BRIGHTNESS =
FILE_DEVICE_VIDEO
Shl 16
Or $126
Shl 2
Or
METHOD_BUFFERED
Shl 14
Or
FILE_ANY_ACCESS;
IOCTL_VIDEO_QUERY_SUPPORTED_BRIGHTNESS =
FILE_DEVICE_VIDEO
Shl 16
Or $125
Shl 2
Or
METHOD_BUFFERED
Shl 14
Or
FILE_ANY_ACCESS;
DISPLAYPOLICY_AC = 1;
DISPLAYPOLICY_DC = 2;
DISPLAYPOLICY_BOTH = 3;
LCDDeviceFile = '
\\.\LCD';
type
TDisplayBrightness =
packed record
ucDisplayPolicy: Byte;
ucACBrightness: Byte;
ucDCBrightness: Byte;
end;
var Form1: TForm1;
g_displayPolicy: integer = 0;
g_supportedLevels: byte;
g_supportedLevelCount: DWORD = 0;
implementation
{$R *.dfm}
function GetLcdDevice(): integer;
var lcd: Thandle;
begin
result:=0;
lcd := CreateFile(LCDDeviceFile, FILE_ANY_ACCESS, 0,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
//check handle:
if lcd = INVALID_HANDLE_VALUE
then
begin
ShowMessage('
An error occurred opening the LCD device');
exit;
end
else result:= lcd;
end;
function QuerySupportedLevels(): integer;
var lcd: HFILE;
begin
result:=0;
ZeroMemory(@g_supportedLevels, sizeof(g_supportedLevels));
lcd:= GetLcdDevice();
if DeviceIoControl(lcd, IOCTL_VIDEO_QUERY_SUPPORTED_BRIGHTNESS,
nil,
0, @g_supportedLevels, 256, &g_supportedLevelCount,
nil)
then
if g_supportedLevelCount= 0
then
begin
ShowMessage('
Your video card or driver does not support
brightness control.');
result:= 0;
end else
result:= g_supportedLevelCount
else
ShowMessage('
An error occurred querying supported brightness levels.');
end;
Function GetLCD_DCBrightnessLevel: Byte;
Var
lcd: HFILE;
DispBrightness: TDisplayBrightness;
BufSize: DWORD;
Begin
Result := 0;
lcd:= GetLcdDevice();
Try
BufSize := SizeOf(DispBrightness);
If Not DeviceIoControl(lcd, IOCTL_VIDEO_QUERY_DISPLAY_BRIGHTNESS,
Nil,
0, @DispBrightness, BufSize, BufSize,
Nil)
Then
Exit;
Result := DispBrightness.ucDCBrightness;
Finally
CloseHandle(lcd);
End;
End;
function SetBrightness(Value: integer): Boolean;
var bytesReturned: DWORD;
lcd: Thandle;
brightness: TDisplayBrightness;
begin
result:= false;
brightness.ucDisplayPolicy := g_displayPolicy;
brightness.ucACBrightness := Value;
brightness.ucDCBrightness := Value;
lcd := GetLcdDevice();
if lcd = INVALID_HANDLE_VALUE
then
begin
ShowMessage('
An error occurred opening the LCD device');
exit;
end else
Result:=true;
if DeviceIoControl(lcd, IOCTL_VIDEO_SET_DISPLAY_BRIGHTNESS, @brightness,
sizeof(brightness),
nil, 0, bytesReturned,
nil) = false
then
ShowMessage('
Error, DeviceIoControl returned False');
CloseHandle(lcd);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TB1Change(Self);
Label2.Caption:= IntToStr(QuerySupportedLevels()-1);
end;
procedure TForm1.TB1Change(Sender: TObject);
begin
CheckBox1.checked:=
not SetBrightness(TB1.Position);
Label1.Caption:= IntToStr(GetLCD_DCBrightnessLevel);
TB1.SelStart:=0; TB1.SelEnd:= TB1.Position;
end;
end.