Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
4. kierros:
7.11. klo 18 – 9.11. klo 23

Keskustelu: Koodit: Pascal: Resoluution vaihtaja

Janezki [28.06.2004 16:15:11]

#

Näillä procedure:illa voit kätevästi vaihtaa näytön resoluution ja bitit. Koodi on toiminut moitteettomasti neljällä viidestä koneesta, eli kolmella Xp ja yhdellä Windows 98 -käyttöjärjestelmällä.

Koodiin ei toivottavasti kenekään tarvi koskea(ei sillä että ei saisi), sillä resoluution vaihto tapahtuu parilla yksinkertaisella käskyllä:

procedure ChangeResolution(Width, Height, Bits);
-Vaihtaa resoluution halutuksi esim. ChangeResolution(800, 600, 16);

Procedure ResoreResolution;
-Palauttaa alkuperäisen resoluution.

Huom!
1.Älä kutsu RestoreResolution ennen kuin olet kutsunut ChangeResolution, voi olla että se pimentää näytön.
2.Älä käytä ChangeResolution:iä kahdesti ilman ResoreResolution:iä välissä, sillä ohjelma ei saa palautettua alkuperäistä resoluutioa.

Koodvinkkiä saa käyttää kaupallisiin ja ei-kaupallisiin sovelluksiin. En jaksanut kommentoida koodivinkkiä koska kaikki siinä ei ole minullekaan täysin kirkasta.

unit Display;

interface

uses
    Windows,
      Forms,
       Dialogs;

var
 OriginalRes,
 NewRes       : TDeviceMode;

 procedure ChangeResolution(Width, Height: Word; Bits: Byte);
 procedure RestoreResolution;

implementation

procedure ChangeResolution(Width, Height: Word; Bits: Byte);
 var
  i           : integer;
  liRetValue  : Longint;
  BitHandle   : THandle;
  OldBits     : Byte;
begin
 BitHandle := GetDC(0);

 OldBits := GetDeviceCaps(BitHandle,bitspixel*
          GetDeviceCaps(BitHandle,planes));

 {$IFOPT R+}
 {$DEFINE CKRANGE}
 {$R-} //range-checking of
 {$ENDIF}

 i := 0;
 while EnumDisplaySettings(nil, i, OriginalRes) do
  begin
   with OriginalRes do
   if (dmPelsWidth = Cardinal(Screen.Width)) and
   (dmpelsheight = Cardinal(Screen.Height)) and
   (dmbitsperPel = Cardinal(OldBits)) then
     Break;

   inc(i);
  end;

 i := 0;
 while EnumDisplaySettings(nil,i,NewRes) do
  begin
   with NewRes do
   if (dmPelsWidth = Cardinal(Width)) and
   (dmpelsheight = Cardinal(Height)) and
   (dmbitsperPel = Cardinal(Bits)) then
     begin
      if EnumDisplaySettings(nil,i,NewRes) then
       begin
        liRetValue := ChangeDisplaySettings(NewRes,0);
        case liRetValue of
         DISP_CHANGE_BADFLAGS  : ShowMessage('DISP_CHANGE_BADFLAGS: An invalid set of flags was passed in.');
         DISP_CHANGE_FAILED    : ShowMessage('DISP_CHANGE_FAILED: The display driver failed the specified graphics mode');
         DISP_CHANGE_BADMODE   : ShowMessage('DISP_CHANGE_BADMODE: The graphics mode is not supported');
         DISP_CHANGE_NOTUPDATED: ShowMessage('DISP_CHANGE_NOTUPDATED: Unable to write settings to the registry.');
        end;
        {$IFDEF CKRANGE}
        {$UNDEF CKRANGE}
        {$R+}  //range-checking on
        {$ENDIF}
        Exit;
       end;
     end;

 inc(i);

 end;
 {$IFDEF CKRANGE}
 {$UNDEF CKRANGE}
 {$R+}  //range-checking on
 {$ENDIF}

 Showmessage ('Can''t change display resolution')
end;

procedure RestoreResolution;
begin
  ChangeDisplaySettings(OriginalRes,0);
end;

end.

Metabolix [29.06.2004 21:27:31]

#

Teitpäs hankalaksi! Itse sain saman paljon pienempään tilaan...
Nykyiset asetukset saa muuten tällä:
EnumDisplaySettings(nil, Cardinal(-1), MinneLaitetaan);

Edit: Et muuten huomioi hertsilukemaa... Oletus taitaa olla 60Hz, ja se on hyvin ikävä mikäli ei omista TFT-näyttöä.

Janezki [30.06.2004 12:14:24]

#

lainaus:

EnumDisplaySettings(nil, Cardinal(-1), MinneLaitetaan);

Empä tiennyt. Koodi muuten pohjautuu Delphi.About.com:in Get'n'set display-ohjelmaan.
Jos koodisi on paljon lyhyempi ja saat tuon herstijutun mukaan niin lähetä se koodivinkkeihin kun tuo on kyllä aika epäkäytännöllinen.

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta