Maksain Resolusi Monitor Posted on : 11/01/2007 09:22:00 PM

Sodara-sodara, sekali lagi diobral.. seri "PEMAKSAAN SETTING" yang lain, sekali lagi, dari Abang Qvezst Al-Cakepnye Naujubille... Yak, dipili-dipili... Baca satu blog dapat tiga. Tinggal dipili... mo maksain regional setting, mo maksain settingan date/time. Dipili-dipili, barang baru-barang baru. Masih hangat. Maksain resolusi-maksain resolusi... Ayo dipili-dipili...

Hehehe...

Suka nge-game? Pasti pernah tau kan option untuk mode FULLSCREEN, ato milih resolusi sesuai dengan kekuatan VGA? Dulu, maen NFS Underground dengan NVidia GeForce4 MX lebih 'ringan' klo nge-apply resolusi kecil (800x600) ketimbang 1024x768. Suka main Counter-Strike? Presisi crosshair jauh lebih asik klo maen di mode 640x480 ketimbang di resolusi besar yang malah bikin kecil ukuran kursor.. Alhasil, mbidik kepala teroris jadil lebih akurat, tajam, dan terpercaya...

Lha, gimana kita niru tu ide supaya aplikasi dari VB yg kita buat bisa juga ngganti resolusi sesuai yang kita mau?

*sebentar2, sebelum dilanjut ~ apa manfaatnya ngganti2 resolusi? Buat aplikasi database, maksain resolusi utk apa? ~

Hmm..., ngga buat apa2 sih. Iseng aja. Yaa, supaya lebih ber-estetika aja lah... Mgkn ente bikin aplikasi di kompie 1024x768. Ukuran form utama nya juga 1024x768. Ente udah ngedesain control2nya n segalanya supaya "FIT TO SCREEN". Eh, tiba2 pas di-deploy, resolusi monitor d kompie client kondisinya beragam. Ada yang masang 800x600, ada yg masang 1125x864, ada yg lebih tinggi, ada yg lebih kecil... Hancur deh settingan ente... Mau gitu ente?

Alasan lain, ya bisa aja ente nambah fasilitas pilihan resolusi di option menu aplikasi ente. Buat keren-kerenan, mungkin? heHe... Ato ente emang lagi pengen bikin game (entah game biasa ato software pembelajaran), bukan aplikasi database...

Oke deh, ngga terlalu penting alasan (yang terkesan dibuat-buat) kenapa diperlukan pemaksaan resolusi monitor. Klo u suka, pakailah. Klo ngga butuh, ya abaikanlah. Gitu aja koq repot?

Yawda..., simak aja deh modul berikut :

Option Explicit

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
Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4

Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
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 * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Private DevM As DEVMODE

Public Type TUkuranResolusi
ScreenX As Long
ScreenY As Long
End Type

Public TResolusiAsli As TUkuranResolusi

Public Sub GetCurrentResolution()
TResolusiAsli.ScreenX = Screen.Width \ Screen.TwipsPerPixelX
TResolusiAsli.ScreenY = Screen.Height \ Screen.TwipsPerPixelY
End Sub

Public Function UbahResolusi(ByVal ScreenX As Long, ByVal ScreenY As Long, _
Optional ByVal KedalamanWarna As Integer = 32) As Boolean
Dim erg As Long
erg& = EnumDisplaySettings(0&, 0&, DevM)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = ScreenX
DevM.dmPelsHeight = ScreenY
DevM.dmBitsPerPel = KedalamanWarna
'test perubahan dulu... support ngga monitor nya makae resolusi yg mo diset...
erg& = ChangeDisplaySettings(DevM, CDS_TEST)
If erg& = DISP_CHANGE_SUCCESSFUL Then
erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
UbahResolusi = True
Else
'klo ngga support, ya nggak jadi perubahan.
MsgBox "Oops..., monitor anda nggak support dengan resolusi " & _
ScreenX & "x" & ScreenY & "", vbOKOnly + vbSystemModal, "Error"
UbahResolusi = False
End If
End Function

Cara kerjanya begini :
Pas aplikasi mu baru jalan, simpan dulu settingan resolusi awal komputermu. Caranya dengan manggil procedure GetCurrentResolution() di dalam Sub Main(). Informasi resolusi awal itu akan disimpan di variabel global TResolusiAsli.ScreenX dan TResolusiAsli.ScreenY

Public Sub Main()
GetCurrentResolution
'blablabla....
End Sub

Setelah itu, ubahlah resolusi sesuai dengan resolusi yg kita inginkan dengan manggil function UbahResolusi() dengan parameter ukuran width, ukuran height, dan parameter optional berupa kedalaman warna. Tu function akan menghasilkan nilai balik berupa TRUE, kalo penggantian resolusi baru sukses, or FALSE klo penggantian resolusi baru gagal..

Public Sub Main()
GetCurrentResolution
if UbahResolusi(800, 600) = false then end
'blablabla...
End Sub

That's it... dalam sekejap resolusi monitor mu akan berubah ke settingan resolusi yang kmu inginkan.. (klo di contoh, dia akan nge-switch ke resolusi 800x600).

Trus, sebagaimana 'pemaksaan-pemaksaan setting' lainnya, mustinya ada donk cara supaya 'menghentikan pemaksaan' tersebut. Kembalikan ke normal...

IYAP! BetuLL sekali! Itulah fungsinya GetCurrentResolution() tadi. Klo aplikasi udah diakhiri, ya silakan kembalikan resolusi ke settingan awal pake function yang sama. Tapi parameter inputnya diambil dari nilai variabel global TResolusiAsli.ScreenX dan TResolusiAsli.ScreenY .

Private Sub FUtama_Unload(Cancel As Integer)
Call UbahResolusi(TResolusiAsli.ScreenX, TResolusiAsli.ScreenY)
End Sub

Dan, kembalilah settingan resolusi monitor mu seperti sediakala...

Bagaimana-bagaimana? Cool, kan?

Emang, Abang Qvezst bener-bener cakep bangedd deh ach... Shiepp deh pokoke. Hehehe...

Met mencoba. (n jangan takut monitormu rusak. udah ada handlernya koq di API Calls-nya.. tu function udah di-testing bolak balik koq.. *selama kucik-kucik dalam 'the making of' module ini sempet juga sih makan korban 1 unit monitor tua bosok yang emang udah terlalu uzur untuk nge-apply resolusi 1280x1024. hihihi...)

Salam dari Malang, ...eh, Ponorogo...

PS :
setelah ini kira2 seri 'pemaksaan setting' yang lain yang asyik utk di-uthex-uthex apa lagi yak? Kalo ada ide, masukan, wishlist, silakan kabar-kabarin aku via comment dgn nge-klik link di bawah artikel ini, shoutbox di sebelah kiri blog ini, ato YM, ato kirim imel bisa juga, ke rizky.prihanto@gmail.com

Ah, obok-obok komponen JEDI VCL nya Delphi aaah, siapatau ada ide mo bikin apa. (Sori buat penggemar delphi, environment favoritmu kupake 'cuman' utk jalan sore-sore nyari-nyari inspirasi doank. Imple, teuteup d VB... xixixixi..)