Forum > Graphics

CAMBIO RISOLUZIONE VIDEO

(1/1)

Guba:
Salve a tutti.
Vorreisapere se qualcuno può indicarmi dei componenti che permettano di gestire la risoluzione dello schermo.
Ad esempio ho un monitor che mi permette di avere il 4K, ma per ragioni di comodità lo uso a 1920x1080.
Mi piacerebbe potere gestire la risoluzione all'interno di una applicazione, un po' come avviene in alcuni viddeogiochi.
Qualcuno puà darmi una dritta ?
Grazie

nomorelogic:
ciao

se usi linux basta che ti documenti sul comando xrandr.
Se usi windows non ti so dire.

DragoRosso:
Allego un progetto per il cambio di risoluzione (SOLO SU WINDOWS) al volo e il ripristino della risoluzione originale all'uscita del programma.
Usatelo a vs. rischio, è da rifinire ma comunque funzionale. Primo progetto fatto con Lazarus.

Posto anche qua il codice, sulla Form vanno inserite una label, una ComboBox e un Button che sul progetto invece ci sono ovviamente.
Gli eventi penso che siano chiari.
Il progetto contiene anche nei setting delle directory di appoggio (ci metto il codice usabile), non sò se può essere compilato senza queste directory.

--- Codice: ---

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ComboBox1: TComboBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    DevModeOriginale: TDevMode;
    procedure ListaRisoluzioni;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

//DA FARE: AL CAMBIO DI RISOLUZIONE VERIFICARIL RISULTATO DI RITORNO
//DA FARE: VERIFICARE CHE LA TASK BAR EFFETIVAMENTE VENGA AGGIORNATA ... EVENTUALMENTE USARE LA SHOWWINDOW E LA UPDATEWINDOW AL POSTO DEL POSTMESSAGE

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Salva la risoluzione originale per ripristinarla all'uscita
  if not EnumDisplaySettings( nil,                      // potrebbe specificare a quale monitor si riferiscono i settaggi (da implementare)
                              ENUM_CURRENT_SETTINGS,    // modo, da usare nella funzione changedisplaysetting
                              DevModeOriginale          // struttura che mantiene i dati relativi al modo selezionato
                            ) then
    begin
      ShowMessage('Non è possibile acquisire lo stato del display. Il programma terminerà');
      exitprocess(0);
    end;
  ListaRisoluzioni;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  //Ripristina la risoluzione originale
  ChangeDisplaySettings( DevModeOriginale, CDS_UPDATEREGISTRY );
  CloseAction := caFree;
end;

procedure TForm1.Button1Click(Sender: TObject);
var taskhandle: HWnd;
    Modo: integer;
    DevMode: TDevMode;
begin
  if ComboBox1.ItemIndex >= 0 then
    begin
      Modo := strtoint(ComboBox1.Items.ValueFromIndex[ComboBox1.ItemIndex]);
      //Nascondi la barra di stato: la barra di stato se non viene nascosta e rivisualizzata dopo la variazione della risoluzione potrebbe risultare "bacata"
      taskhandle := FindWindow('Shell_TrayWnd', nil);
      if (taskhandle <> 0) then
        begin
          postmessage(taskhandle, WM_SHOWWINDOW, 0, 0);
        end;
      try
        //Andiamo a richiamare il modo selezionato precedentemente
        if EnumDisplaySettings( nil,      // potrebbe specificare a quale monitor si riferiscono i settaggi (da implementare)
                                Modo,     // modo, da usare nella funzione changedisplaysetting
                                DevMode   // struttura che mantiene i dati relativi al modo selezionato
                              ) then
          begin
            //Aggiornamento della risoluzione
            ChangeDisplaySettings(DevMode, 0 );
          end;
      except on e: exception do
        ;
      end;
      //Rispristiniamo la barra
      if (taskhandle <> 0) then
        begin
          postmessage(taskhandle, WM_SHOWWINDOW, 1, 0);
        end;
    end;
end;

procedure TForm1.ListaRisoluzioni;
var status: BOOL;
    Modo: Integer;
    tempstring: String;
    DevMode: TDevMode;
begin
   ComboBox1.Clear;
   Modo := 0;
   status := true;
   while status do
     begin
       //Elenca tutti i modi video del monito indicato
       status := EnumDisplaySettings( nil,      // potrebbe specificare a quale monitor si riferiscono i settaggi (da implementare)
                                      Modo,     // modo, da usare nella funzione changedisplaysetting
                                      DevMode   // struttura che mantiene i dati relativi al modo selezionato
                                    );
       // Se lo status è true allora ci sono ulteriori modi da elencare
       if status then
         begin
           //Selezioniamo solo i modi con il .... (è solo un modo per evitare ripetizioni sull'elenco delle risoluzioni)
           if DevMode.dmDefaultSource = 0 then
             begin
               tempstring := DevMode.dmPelsWidth.ToString+'x'+DevMode.dmPelsHeight.ToString+' ('+DevMode.dmDisplayFrequency.ToString+'Hz) ';
               ComboBox1.Items.AddPair(tempstring, Modo.ToString);
             end;
           inc(Modo);
         end;
     end;
end;

end.


--- Termina codice ---

Guba:
GRAZIE PER IL PROGETTO.
Adesso lo provo su Delphi.
Speriamo che funzioni.

Navigazione

[0] Indice dei post