|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как программно выключить монитор?
// *****************************
// !!! Только для Windows 95 !!!
// *****************************
// Включить монитор
SendMessage( Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1 );
// Перевести монитор в режим энергосберижения
SendMessage( Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1 );
// Выключить монитор
SendMessage( Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2 );
|
Как отследить изменения дисплея?
type
TForm1 = class(TForm)
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure WMDisplayChange( var message: TMessage ); message WM_DISPLAYCHANGE;
public
{ Public declarations }
end;
implementation
procedure TForm1.WMDisplayChange(var message: TMessage);
begin
ShowMessage( 'Настройки экрана были изменены' );
inherited;
end;
|
Как получить список установленных мониторов и их параметры?
function EnumDisplayMonitors( dc: HDC; rect: PRect; EnumProc: pointer;
lData: LPARAM ): BOOL; stdcall; external user32;
type
TMonInfo = record
h: THandle; // хэндл окна рабочего стола
dc: HDC; // DC рабочего стола
r: TRect; // Координаты рабочего стола
end;
var
MonList: array of TMonInfo;
implementation
function MonitorEnumProc( hMonitor: THandle; hdcMonitor: HDC; lprcMonitor: DWORD; dwData: LPARAM ): BOOL; stdcall;
type
PRect = ^TRect;
var
i: integer;
begin
i := High( MonList )+1;
SetLength( MonList, i+1 );
MonList[i].h := hMonitor;
MonList[i].dc := hdcMonitor;
MonList[i].r := PRect( lprcMonitor )^;
Result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
i: integer;
begin
s := 'Кол-во мониторов: ' + IntToStr( High( MonList )+1 ) + #13;
for i := 0 to High( MonList ) do
with MonList[i] do
begin
s := s + #13 + 'handle: ' + IntToStr( h ) + #13 +
'dc: ' + IntToStr( dc ) + #13 +
'size: ' + IntToStr( r.Right ) + 'x' + IntToStr( r.Bottom );
end;
ShowMessage( s );
end;
initialization
EnumDisplayMonitors( 0, nil, Addr( MonitorEnumProc ), 0 );
|
Как программно изменить яркость (софтовую гамму) монитора?
type
// Массив для хранения таблиц гамма-коррекции (gamma ramp)
TRampArray = array[0..2] of array[byte] of word;
var
// Текущие значения gamma ramp
origRampArray: TRampArray;
{...}
implementation
{...}
// Функция изменения яркости. Чем больше wBrightness, тем больше яркость
function SetBrightness( wBrightness: word ): boolean;
var
RampArray: TRampArray;
i, Value: integer;
DC: HDC;
begin
for i := 0 to MAXBYTE do
begin
Value := i * ( wBrightness + 128 );
if ( Value > MAXWORD ) then Value := MAXWORD;
RampArray[0][i] := Value;
RampArray[1][i] := Value;
RampArray[2][i] := Value;
end;
DC := GetDC( 0 );
try
Result := SetDeviceGammaRamp( DC, RampArray );
finally
ReleaseDC( 0, DC );
end;
end;
// Cохраняем текущие значения gamma ramp
procedure TForm1.FormCreate(Sender: TObject);
var
DC: HDC;
begin
DC := GetDC( 0 );
try
GetDeviceGammaRamp( DC, origRampArray );
finally
ReleaseDC( 0, DC );
end
end;
// Меняем яркость
procedure TForm1.Button1Click(Sender: TObject);
begin
SetBrightness( 64 );
end;
// Восстанавливаем gamma ramp
procedure TForm1.Button2Click(Sender: TObject);
var
DC: HDC;
begin
DC := GetDC( 0 );
try
SetDeviceGammaRamp( DC, origRampArray );
finally
ReleaseDC( 0, DC );
end
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Button2Click( Button2 );
end;
|
Как программно включить/отключить второй монитор?
const
EDD_GET_DEVICE_INTERFACE_NAME = 1;
ENUM_REGISTRY_SETTINGS = DWORD(-2);
///
/// Выключить второй монитор
///
procedure TForm1.Button1Click(Sender: TObject);
var
Display: TDisplayDevice;
DevMode: TDevMode;
begin
Display.cb := SizeOf( TDisplayDevice );
EnumDisplayDevices( nil, 1 {второй монитор, для первого ноль},
Display, EDD_GET_DEVICE_INTERFACE_NAME );
ZeroMemory( @DevMode, SizeOf( TDevMode ) );
DevMode.dmSize := SizeOf( TDevMode );
DevMode.dmBitsPerPel := 32;
DevMode.dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT or
DM_DISPLAYFREQUENCY or DM_DISPLAYFLAGS or DM_POSITION;
ChangeDisplaySettingsEx( PChar( @Display.DeviceName[0] ), DevMode, 0,
CDS_UPDATEREGISTRY or CDS_NORESET, nil );
ChangeDisplaySettingsEx( nil, PDevMode( nil )^, 0, 0, nil );
end;
///
/// Включить второй монитор
///
procedure TForm1.Button2Click(Sender: TObject);
var
Display: TDisplayDevice;
DevMode: TDevMode;
begin
Display.cb := SizeOf( TDisplayDevice );
EnumDisplayDevices( nil, 1 {второй монитор, для первого ноль},
Display, EDD_GET_DEVICE_INTERFACE_NAME );
EnumDisplaySettings( PChar( @Display.DeviceName[0] ),
ENUM_REGISTRY_SETTINGS, DevMode );
DevMode.dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT or
DM_DISPLAYFREQUENCY or DM_DISPLAYFLAGS or DM_POSITION;
ChangeDisplaySettingsEx( PChar( @Display.DeviceName[0] ), DevMode, 0,
CDS_UPDATEREGISTRY or CDS_NORESET, nil );
ChangeDisplaySettingsEx( nil, PDevMode( nil )^, 0, 0, nil );
end;
|
Как определить в каком режиме находится монитор?
function GetDevicePowerState(hDevice:DWORD; var pfOn:BOOL): BOOL; stdcall; external kernel32;
function CheckMonitorState:Boolean;
var
Hwnd: THandle;
Stat: LongBool;
begin
Hwnd := CreateFile('\\.\LCD' , 0, 0, nil, OPEN_EXISTING, 0, 0);
if Hwnd <> INVALID_HANDLE_VALUE then
GetDevicePowerState(Hwnd, Stat);
Result := Stat;
CloseHandle(Hwnd);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckMonitorState then
Caption := 'Monitor ON'
else
Caption := 'Monitor OFF';
end;
|
Как определить, поддерживает ли экран автоповорот?
uses
{...,} Registry;
function IsAutoRotationExist: Boolean;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE; // HKEY_CURRENT_USER
Result := OpenKey(
'Software\Microsoft\Windows\CurrentVersion\AutoRotation', False);
CloseKey;
finally
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsAutoRotationExist then
ShowMessage('yes')
else
ShowMessage('no');
end;
|
Как определить, включен ли автоповорот экрана?
uses
{...,} Registry;
function IsAutoRotationExist: Boolean;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE; // HKEY_CURRENT_USER
Result := OpenKey(
'Software\Microsoft\Windows\CurrentVersion\AutoRotation', False);
CloseKey;
finally
Free;
end;
end;
function IsAutoRotationEnabled: Boolean;
begin
Result := IsAutoRotationExist;
if not Result then
Exit;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE; // HKEY_CURRENT_USER
Result := OpenKey(
'Software\Microsoft\Windows\CurrentVersion\AutoRotation', False);
if Result then
Result := ReadInteger('Enable') = 1;
CloseKey;
finally
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsAutoRotationEnabled then
ShowMessage('yes')
else
ShowMessage('no');
end;
|
Как включить/отключить автоповорот экрана?
uses
{...,} Registry;
function IsAutoRotationExist: Boolean;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE; // HKEY_CURRENT_USER
Result := OpenKey(
'Software\Microsoft\Windows\CurrentVersion\AutoRotation', False);
CloseKey;
finally
Free;
end;
end;
function IsAutoRotationEnabled: Boolean;
begin
Result := IsAutoRotationExist;
if not Result then
Exit;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE; // HKEY_CURRENT_USER
Result := OpenKey(
'Software\Microsoft\Windows\CurrentVersion\AutoRotation', False);
if Result then
Result := ReadInteger('Enable') = 1;
CloseKey;
finally
Free;
end;
end;
function SetAutoRotation(const Enable: Boolean): Boolean;
begin
Result := IsAutoRotationExist;
if not Result then
Exit;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE; // HKEY_CURRENT_USER
Result := OpenKey(
'Software\Microsoft\Windows\CurrentVersion\AutoRotation', False);
if Result then
try
try
WriteBool('Enable', Enable);
except
Result := False;
Exit;
end;
finally
CloseKey;
end;
finally
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Включить автоповорот экрана
SetAutoRotation(True);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// Выключить автоповорот экрана
SetAutoRotation(False);
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
