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.
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.