Procedimientos relacionados con el monitor del PC

Índice de los procedimientos:

- Procedimiento para ver las propiedades del monitor

- Cambiar la resolución de la pantalla

- Ajustar la pantalla para diferentes dispositivos móviles 

- Ajustar la pantalla para resoluciones diferentes

- Seleccionar un monitor diferente cuando abro mi aplicación

- Capturar un trozo de la pantalla y guardarlo en un bitmap

Procedimiento para ver las propiedades del monitor:

PROCEDURE TForm1.GetWMIDisplayInfo(CONSTRemoteMachine,Username,Password:STRING);
VAR
FSWbemLocator:OLEVariant;
FWMIService:OLEVariant;
FWbemObjectSet:OLEVariant;
FWbemObject:OLEVariant;
oEnum:IEnumvariant;
iValue:LongWord;
BEGIN
;
TRY
FSWbemLocator:=CreateOleObject('WbemScripting.SWbemLocator');
FWMIService:=FSWbemLocator.ConnectServer(RemoteMachine,'root\CIMV2',
Username,Password);
FWbemObjectSet:=FWMIService.ExecQuery(
'select*fromWin32_DesktopMonitor','WQL',0);
TRY
oEnum:=IUnknown(FWbemObjectSet._NewEnum)ASIEnumVariant;
WHILEoEnum.Next(1,FWbemObject,iValue)=0DO
BEGIN
memo5.lines.add(
VarToStr(FWbemObject.Availability)+','+
VarToStr(FWbemObject.Bandwidth)+','+
VarToStr(FWbemObject.Caption)+','+
VarToStr(FWbemObject.ConfigManagerErrorCode)+','+
VarToStr(FWbemObject.ConfigManagerUserConfig)+','+
VarToStr(FWbemObject.CreationClassName)+','+
VarToStr(FWbemObject.Description)+','+
VarToStr(FWbemObject.DeviceID)+','+
VarToStr(FWbemObject.DisplayType)+','+
VarToStr(FWbemObject.ErrorCleared)+','+
VarToStr(FWbemObject.ErrorDescription)+','+
VarToStr(FWbemObject.InstallDate)+','+
VarToStr(FWbemObject.IsLocked)+','+
VarToStr(FWbemObject.LastErrorCode)+','+
VarToStr(FWbemObject.MonitorManufacturer)+','+
VarToStr(FWbemObject.MonitorType)+','+
VarToStr(FWbemObject.Name)+','+
VarToStr(FWbemObject.PixelsPerXLogicalInch)+','+
VarToStr(FWbemObject.PixelsPerYLogicalInch)+','+
VarToStr(FWbemObject.PNPDeviceID)+','+
VarToStr(FWbemObject.PowerManagementCapabilities)+','+
VarToStr(FWbemObject.PowerManagementSupported)+','+
VarToStr(FWbemObject.ScreenHeight)+','+
VarToStr(FWbemObject.ScreenWidth)+','+
VarToStr(FWbemObject.Status)+','+
VarToStr(FWbemObject.StatusInfo)+','+
VarToStr(FWbemObject.SystemCreationClassName)+','+
VarToStr(FWbemObject.SystemName)

);

FWbemObject:=Unassigned;
END;

FINALLY
FWbemObjectSet:=Unassigned;
END;

EXCEPTON E:Exception DO
RAISE;
END;
END;







y la llamada al procedimiento sería:



PROCEDURE TForm1.Button12Click(Sender: TObject);
BEGIN

   TRY
      CoInitialize(NIL);
      TRY
         GetWMIDisplayInfo('localhost', '', '');
      FINALLY
         CoUninitialize;
      END;
   EXCEPT
      ON E: Exception DO
      BEGIN
         showmessage(E.Classname + ':' + E.Message);

      END;
   END;

END;

- Cambiar la resolución de la pantalla

var
  FMenu: TFMenu;
  W, H : integer;  //para coger resolución
  spCambioResolucion: string;  //para cambiar resolución

implementation

Uses UDM;

{$R *.dfm}

function NuevaRes(XRes, YRes: DWord): Integer;
var
  lpDevMode : TDeviceMode;
begin
  EnumDisplaySettings (nil, 0, lpDevMode);
  lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  lpDevMode.dmPelsWidth := XRes;
  lpDevMode.dmPelsHeight := YRes;
  NuevaRes := ChangeDisplaySettings (lpDevMode, 0)
end;


En OnCreate para cambiarla

Código Delphi [-]
procedure TFMenu.FormCreate(Sender: TObject);
begin
  //coger resolución de pantalla
  W := Screen.Width;
  H := Screen.Height;
  spCambioResolucion := 'No';
  //si es 800 por 600 se cambia a 1024 por 768 y se anota el cambio
  if (W = 800) and (H = 600) then
    begin
      NuevaRes(1024, 768);
      spCambioResolucion := 'Si';
    end;
end;

En OnClose para dejarlo como estaba

Código Delphi [-]
procedure TFMenu.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //si se cambio la resolución que había de 800 por 600 volver a poner 800 por 600
  if spCambioResolucion = 'Si' then
    NuevaRes(800, 600);
end;

- Ajustar la pantalla para diferentes dispositivos móviles



1) ajusta los controles a tu gusto, según el tamaño de la pantalla del dispositivo seleccionado

2) Cambia en las propiedades de alineamiento de los controles a "scale"



al jugar esta propiedad podrás conseguir lo que quieres




- Ajustar la pantalla para resoluciones diferentes



No utilizes formularios que no puedan maximizarse y tengan un tamaño fijo. Utiliza las propiedades  Anchors, Align y Constraits de los componentes visuales de forma que estos se adapten al formulario.






- Seleccionar un monitor diferente cuando abro mi aplicación

Usando el objeto Screen

Obtengo el número de monitores

ShowMessage(IntToStr(Screen.MonitorCount))

Obtengo los parametros del monitor

Screen.Monitors[i].Left (integer)
                  .Top (integer)
                  .Width (integer)
                  .Height (integer)
                  .BoundsRect (TRect)
                  .WorkareaRect (TRect)
                  .Primary (boolean)

Donde i es el indice del monitor, esto es: i = 0, 1, ..., Screen.MonitorCount - 1.


Para hacer que el form ocupe todo el monitor:

BoundsRect := Screen.Monitors[i].BoundsRect; 
WindowState := wsMaximized; 



Otra forma:

if Screen.MonitorCount > 1 then   //existen 2 o mas monitores
 begin
  if not Assigned(CustMonForm) then
     CustMonForm := TCustMonForm.create(tFSPosLoginform);
  CustMonForm.Show;
 end;

On the create of the form you want to show on the other monitor

En el OnCreate del form se muestra el monitor

 if Screen.MonitorCount > 1 then
     with Screen.monitors[ 1 ] do begin
       self.left := left +(width  div 2) -(self.width  div 2);
      self.top  := top  +(height div 2) -(self.height div 2)
   end
 end;


Otra forma:

application.mainForm.monitor := screen.monitors[ 1 ]; 

- Capturar un trozo de la pantalla  y guardarlo en un bitmap

procedure CapturarPantalla( x, y, iAncho, iAlto: Integer; Imagen: TBitmap );
var
  DC: HDC;
  lpPal : PLOGPALETTE;
begin
  if ( iAncho = 0 ) OR ( iAlto = 0 ) then
    Exit;

  Imagen.Width := iAncho;
  Imagen.Height := iAlto;
  DC := GetDc( 0 );

  if ( DC = 0 ) then
    Exit;

  if ( GetDeviceCaps( dc, RASTERCAPS) and  RC_PALETTE = RC_PALETTE ) then
  begin
    GetMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
    FillChar( lpPal^, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ), #0 );
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := GetSystemPaletteEntries( DC, 0, 256, lpPal^.palPalEntry );

    if (lpPal^.PalNumEntries <> 0) then
      Imagen.Palette := CreatePalette( lpPal^ );

    FreeMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
  end;

  BitBlt( Imagen.Canvas.Handle, 0, 0, iAncho, iAlto, DC, x, y, SRCCOPY );
  ReleaseDc( 0, DC );
end;


Para capturar toda la pantalla de Windows haríamos lo siguiente:

var Imagen: TBitmap;
begin
  Imagen := TBitmap.Create;
  CapturarPantalla( 0, 0, Screen.Width, Screen.Height, Imagen );
  Imagen.SaveToFile( ExtractFilePath( Application.ExeName ) + 'captura.bmp' );
  Imagen.Free;
end;