Terimakasih atas saran dan codenya,
memang ini lebih efektif.
Selain itu jg tergantung juga sama hardware yang ada.
Makasih.
--- Yulianto <[EMAIL PROTECTED]> wrote:
> Dear Suseno,
>
> Bagaimana kalo resolusi monitor yang diganti aja.
> Karena tidak efektif kalo ukuran form yang diubah.
>
> Untuk ubah resolusi monitor, gunakan script dibawah
> ini.
>
> 'Option Explicit
>
> Declare Function EnumDisplaySettings Lib "user32"
> Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName
> As Long, ByVal
> iModeNum As Long, lpDevMode As Any) As Boolean
> Declare Function ChangeDisplaySettings Lib
> "user32" _
> Alias "ChangeDisplaySettingsA" (lpDevMode As
> Any, ByVal dwFlags
> As Long) As Long
>
> Declare Function ExitWindowsEx Lib "user32" (ByVal
> uFlags As Long,
> ByVal dwReserved As Long) As Long
> Public Const EWX_LOGOFF = 0
> Public Const EWX_SHUTDOWN = 1
> Public Const EWX_REBOOT = 2
> Public Const EWX_FORCE = 4
> Public Const CCDEVICENAME = 32
> Public Const CCFORMNAME = 32
> Public Const DM_BITSPERPEL = &H40000
> Public Const DM_PELSWIDTH = &H80000
> Public Const DM_PELSHEIGHT = &H100000
> Public Const CDS_UPDATEREGISTRY = &H1
> Public Const CDS_TEST = &H4
> Public Const DISP_CHANGE_SUCCESSFUL = 0
> Public Const DISP_CHANGE_RESTART = 1
> 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
>
> 'These variables store the screen's current
> resolution.
> Global ScreenWidth As Integer, ScreenHeight As
> Integer
>
>
> Public GantiResolusi As Boolean
>
>
> Public Sub SetResolution(Optional ByVal vResolusiX
> As Integer = 640,
> Optional ByVal vResolusiY As Integer = 480)
>
> Dim DevM As DEVMODE
>
>
> 'GantiResolusi = EnumDisplaySettings(0&, 0&,
> DevM)
>
> If GantiResolusi = True Then
> 'Simpan Resolusi awal, agar nantinya bisa
> dikembalikan /restore.
> ScreenWidth = Screen.Width
> ScreenHeight = Screen.Height
>
> DevM.dmFields = DM_PELSWIDTH Or
> DM_PELSHEIGHT 'Or
> DM_BITSPERPEL
>
> 'Tentukan resolusi yang diinginkan disini.
> DevM.dmPelsWidth = vResolusiX '640
> 'ScreenWidth
> DevM.dmPelsHeight = vResolusiY '480
> 'ScreenHeight
>
> erg& = ChangeDisplaySettings(DevM, CDS_TEST)
>
> GantiResolusi = Not GantiResolusi
>
> Select Case erg&
> Case DISP_CHANGE_RESTART
> an = MsgBox("You have to reboot",
> 64, "Info")
>
> If an = vbYes Then
> erg& =
> ExitWindowsEx(EWX_REBOOT, 0&)
> End If
>
> Case DISP_CHANGE_SUCCESSFUL
> erg& = ChangeDisplaySettings(DevM,
> CDS_UPDATEREGISTRY)
> Case Else
> MsgBox "Mode Not supported",
> vbOKOnly +
> vbSystemModal, "KwetChiro - Error"
> End Select
>
> Exit Sub
> End If
>
> 'Kembali ke resolusi awal
> If GantiResolusi = False Then
> ScreenWidth = ScreenWidth / 15
> ScreenHeight = ScreenHeight / 15
>
> DevM.dmFields = DM_PELSWIDTH Or
> DM_PELSHEIGHT 'Or
> DM_BITSPERPEL
>
>
> DevM.dmPelsWidth = ScreenWidth
> DevM.dmPelsHeight = ScreenHeight
>
> erg& = ChangeDisplaySettings(DevM, CDS_TEST)
>
> GantiResolusi = Not GantiResolusi
>
> Select Case erg&
> Case DISP_CHANGE_RESTART
> an = MsgBox("You have to reboot",
> 64, "Info")
>
> If an = vbYes Then
> erg& =
> ExitWindowsEx(EWX_REBOOT, 0&)
> End If
>
> Case DISP_CHANGE_SUCCESSFUL
> erg& = ChangeDisplaySettings(DevM,
> CDS_UPDATEREGISTRY)
>
> Case Else
> MsgBox "Mode Not supported",
> vbOKOnly +
> vbSystemModal, "KwetChiro - Error"
> End Select
>
> Exit Sub
> End If
> End Sub
>
>
>
>
> Taruh skript ini dalam satu module.
> Kemudian panggil modul tersebut
>
> GantiResolusi = true
> call SetResolution (640, 480)
>
> semoga membantu.
>
> Regards,
> Yulianto
> KwetChiro
>
>
> --- In [email protected], Jenar Suseno
> <[EMAIL PROTECTED]>
> wrote:
> >
> > Beberapa waktu lalu aku baca ada yang nanya untuk
> atur
> > form supaya bisa jalan di semua resolusi monitor.
> >
> > Aku coba buka2 arsip kok gak ketemu ya..
> >
> > Kl ada yang masih punya, bisa dong di sharing
> lagi...
> >
> > Makasih,
> >
> >
> >
> >
>
=== message truncated ===
__________________________________________
Yahoo! DSL Something to write home about.
Just $16.99/mo. or less.
dsl.yahoo.com
Untuk keluar dari millis ini, kirim email kosong ke:
[EMAIL PROTECTED]
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/Programmer-VB/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
