sábado, 17 de outubro de 2009

Configuração de vídeo

{A aplicação abaixo permite que você modifique as configurações de vídeo:

inicie uma nova aplicação;
insira um componente TListBox;
insira dois componentes TButton;
insira o seguinte código no evento OnCreate do formulário: }

procedure TForm1.FormCreate(Sender: TObject);
Var
i : Integer;
Conf : TDevMode;
begin
i := 0;
While EnumDisplaySettings(Nil,i,Conf) Do
Begin
With Conf Do
ListBox1.Items.Add(Format('%dx%d %d Cores',[dmPelsWidth,dmPelsHeight,1 Shl dmBitsperPel]));
Inc(i);
End;
end;
insira o seguinte código no evento OnClick do componente TListBox:

procedure TForm1.ListBox1Click(Sender: TObject);
begin
Button1.Enabled := Listbox1.ItemIndex >= 0;
end;
insira o seguinte código no evento OnClick do botão Alterar:

procedure TForm1.Button1Click(Sender: TObject);
Var
Conf : TDevMode;
begin
If MessageDlg('Deseja realmente alterar as configurações ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
Begin
EnumDisplaySettings(Nil,Listbox1.ItemIndex,Conf);
ChangeDisplaySettings(Conf,0);
End;
end;
insira o seguinte código no evento OnClick do botão Fechar:
procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;
Código Completo
unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Var
i : Integer;
Conf : TDevMode;
begin
i := 0;
While EnumDisplaySettings(Nil,i,Conf) Do
Begin
With Conf Do
ListBox1.Items.Add(Format('%dx%d %d Cores',[dmPelsWidth,dmPelsHeight,1 Shl dmBitsperPel]));
Inc(i);
End;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
Conf : TDevMode;
begin
If MessageDlg('Deseja realmente alterar as configurações ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
Begin
EnumDisplaySettings(Nil,Listbox1.ItemIndex,Conf);
ChangeDisplaySettings(Conf,0);
End;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
Button1.Enabled := Listbox1.ItemIndex >= 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

end.

Nenhum comentário:

Postar um comentário