Ajustar todos os Forms à Resolução de Video

Delphi

24/07/2010

Estive vasculhando os sites sobre como resolver o problema de resolução de tela. Meus projetos em delphi são feitos em resolução acima dos padrões 800x600 e 1024x800 pixels. Nestas resoluções as telas ficam "comidas". Achei aqui no Forum da Active Delphi de autoria do Sr. usr2:
Ajustar o Form à Resolução de Video. O código abaixo:



function SetScreenResolution(Width, Height: integer): Longint;
var
DeviceMode: TDeviceMode;
begin
with DeviceMode do begin
dmSize := SizeOf(TDeviceMode);
dmPelsWidth := Width;
dmPelsHeight := Height;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
end;
Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end;

Declare as seguintes variáveis globais :

oldwidth:integer;
OldHeight :integer;
Auxwidth:integer;
Auxheight:integer ;


No evento On Create do Form principal ponha o seguinte código :

var Mens: String;

begin
EnableMenuItem(GetSystemMenu(handle, False), SC_CLOSE, MF_BYCOMMAND or MF_GRAYED);
begin

if (Screen.Width =1024) and (Screen.Height = 768) then
begin
Auxwidth :=1024;
Auxheight :=768;
end;

if (Screen.Width <> 1024) and (Screen.Height <> 768) then
begin

OldWidth := Screen.Width;
OldHeight := Screen.Height;
Auxwidth:=oldwidth;
Auxheight:=OldHeight;

Mens := 'O Programa "Seu programa -"irá ajustar sua resolução de vídeo para 1024 X 768'+#13;
Mens := Mens + 'automaticamente para uma melhor visualisação, mas não se preocupe pois ao termino de uso ,' + #13;
Mens := Mens + ' ele retornará sua resolução novamente. Muito obrigado...';
MessageBox(Self.Handle, PChar(Mens), 'Ajuste de Vídeo', MB_OK + MB_ICONWARNING);
SetScreenResolution(1024, 768);
end;
end;


end;


Agora coloque um botão “sair “ ou no evento OnClose do seu form e ponha o seguinte código :


If (Screen.Width = 1024)and(Auxwidth=1024)and(Screen.Height = 768)and(Auxheight=768) then
begin
Application.Terminate;
end;
If (Screen.Width = 1024)and(Auxwidth<>1024)and(Screen.Height = 768)and(Auxheight<>768) then

if (Application.MessageBox('Voltando para sua resolução antiga...','Ajustes Automaticos',MB_OK +MB_ICONWARNING)=ID_OK )then

Begin
OldWidth := 800 ;
OldHeight := 600;
SetScreenResolution(Auxwidth, Auxheigth);
end;
Application.Terminate;
end;

Para somente um form tudo bem e para os demais como fica? Lembrando que meus forms não tem herança entre eles.

Obrigado
Carlos Leonel

Carlos Leonel

Curtidas 0

Respostas

Marco Salles

Marco Salles

24/07/2010

rente colocar em uma Unit o seguinte método
unit uResolucao;
interface
uses
Forms, Windows;
procedure Resolucao(form:TForm;cExibir:boolean=false);

implementation
uses
  Dialogs, SysUtils;
var
oldwidth:integer;
OldHeight :integer;
Auxwidth:integer;
Auxheight:integer ;
procedure SetScreenResolution(form:TForm;Width, Height: integer);
var
DeviceMode: TDeviceMode;
begin
with DeviceMode do begin
dmSize := SizeOf(TDeviceMode);
dmPelsWidth := Width;
dmPelsHeight := Height;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
end;
ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end;
procedure Resolucao(form:TForm;cExibir:Boolean=False);
var
  Mens: String;
begin
 with form do
    begin
      MessageBox(Handle, PChar(Mens), 'Ajuste de Vídeo', MB_OK + MB_ICONWARNING);
      if (Screen.Width =1024) and (Screen.Height = 768) then
        begin
          Auxwidth :=1024;
          Auxheight :=768;
          end;
          if (Screen.Width <> 1024) and (Screen.Height <> 768) then
          begin
           EnableMenuItem(GetSystemMenu(handle, False), SC_CLOSE, MF_BYCOMMAND or MF_GRAYED);
           OldWidth := Screen.Width;
           OldHeight := Screen.Height;
           Auxwidth:=oldwidth;
           Auxheight:=OldHeight;
           if cExibir then
             begin
               Mens := 'O Programa "Seu programa -"irá ajustar sua resolução de vídeo para 1024 X 768'+sLineBreak;
               Mens := Mens + 'automaticamente para uma melhor visualisação, mas não se preocupe pois ao termino de uso ,'+sLineBreak;
               Mens := Mens + ' ele retornará sua resolução novamente. Muito obrigado...';
               MessageBox(Handle, PChar(Mens), 'Ajuste de Vídeo', MB_OK + MB_ICONWARNING);
             end;
           SetScreenResolution(form,1024, 768);
        end;
      end;
end;
end.
  No evento de cada Form Faça   procedure TForm3.FormCreate(Sender: TObject);
begin
Resolucao(self);  // caso não queira que apareça mensagem Resolucao(self,true);  // caso queira que apareça mensagem de alteração da resolução
end;   A function para retornar a Resolução o processo é identico , pode ficar nesta unidade   Não esqueça de dar USES
GOSTEI 0
POSTAR