1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154:
| 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 public 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); 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. |