Программирование на Delphi

FAQ VCL
Железо\Монитор (экран)

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: 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 );

Как узнать количество подключенных мониторов?

GetSystemMetrics( SM_CMONITORS );

Как программно изменить яркость (софтовую гамму) монитора?

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);
 
/// <summary>
/// Выключить второй монитор
/// </summary>
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;
 
/// <summary>
/// Включить второй монитор
/// </summary>
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;

При использовании материала - ссылка на сайт обязательна