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,
>
>
>
>
>
>
> __________________________________________
> 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/
