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
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
Curtir tópico
+ 0
Responder
Posts
24/07/2010
Marco Salles
rente colocar em uma Unit o seguinte método
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
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.
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
Clique aqui para fazer login e interagir na Comunidade :)