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 SubVinkin 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.