Kirjoittaja: Pekka Kauppila
Kirjoitettu: 28.02.2003 – 28.02.2003
Tagit: koodi näytille, vinkki
Alkeellinen, mutta toimiva koodinpätkä näyttötilojen muuntamiseen. Muuttaa näyttötilan kun aukaiset ohjelman ja palauttaa sen alkuperäiseksi kun ohjelma suljetaan.
Private Type DEVMODE dmDeviceName As String * 32 dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * 32 dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long Dim DevOrg As DEVMODE Dim ok As Boolean Private Sub Form_Load() Dim DevNew As DEVMODE 'Haetaan alkuperäiset asetukset muistiin... Call EnumDisplaySettings(0&, -1&, DevOrg) 'Otetaan vanhat asetukset pohjaksi... DevNew = DevOrg 'Määritellään uusi resolutio... DevNew.dmPelsWidth = 800 DevNew.dmPelsHeight = 600 'Ja värit... (bitteinä) DevNew.dmBitsPerPel = 16 'Ja virkistystaajuus DevNew.dmDisplayFrequency = 75 ok = False Dim test As Long 'Testataan... test = ChangeDisplaySettings(DevNew, &H4) Select Case test Case 0 'Uusi näyttö tila voidaan ottaa käyttöön Call ChangeDisplaySettings(DevNew, &H1) ok = True Case 1 'Kone vaatii uudelleen käynnistyksen 'jotta asetukset tulevat voimaan. Case Else 'Ei tukea valituille asetuksille End Select End Sub Private Sub Form_Unload(Cancel As Integer) 'Jos tila on vaihdettu onnistuneesti 'niin palautetaan alkuperäinen lopetetaessa. If ok = True Then Call ChangeDisplaySettings(DevOrg, &H1) End If End End Sub
Vinkin nimessä näyttäisi olevan pieni typo, sillä eikö se ole resoluutio suomeksi eikä resolutio?
siis voi itku
Kyllä se "resoluutio" kirjotetaan, mutta kun nyt alettiin pilkua naimaan, niin tässä ei vaihdeta resoluutiota vaan näyttötilaa.
Ihan sama tosin, eiköhän kaikki tajua, mistä on kyse.
No sekavahan tuo hieman on mutta jos halutaan oikein tarkoja olla niin resolutio on suomeksi erottelukyky/erottelutarkkuus. Voihan tuolla koodinpätkällä muttaa muutakin kun pelkän resoluutionin.
Tää on ihan mahtava ja hyödyks pelien koodaajille. Otin tän ite heti käyttöön =)
Loistava pelien koodaajille kuten kaviaari sanoi...
Itse myös otin heti käyttöön
Hyvä vinkki, tosin ei toimi VB.NETillä ja Windows 7:lla.