Ajustar todos os Forms à Resolução de Video

24/07/2010

0

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

Responder

Posts

24/07/2010

Marco Salles

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
Responder

Que tal ter acesso a um e-book gratuito que vai te ajudar muito nesse momento decisivo?

Ver ebook

Recomendado pra quem ainda não iniciou o estudos.

Eu quero
Ver ebook

Recomendado para quem está passando por dificuldades nessa etapa inicial

Eu quero

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar