[Aporte] Elección de Resolución

por Sderty Vie Ago 23, 2013 12:32 am

Cambian el modResolution por

Código:: Option Explicit Private Const CCDEVICENAME As Long = 32 Private Const CCFORMNAME As Long = 32 Private Const DM_BITSPERPEL As Long = &H40000 Private Const DM_PELSWIDTH As Long = &H80000 Private Const DM_PELSHEIGHT As Long = &H100000 Private Const DM_DISPLAYFREQUENCY As Long = &H400000 Private Const CDS_TEST As Long = &H4 Private Const ENUM_CURRENT_SETTINGS As Long = -1 Private Type typDevMODE 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 Public oldResHeight As Long Public oldResWidth As Long Public oldDepth As Integer Public oldFrequency As Long Public bNoResChange As Boolean Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lptypDevMode As Any) As Boolean Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, ByVal dwFlags As Long) As Long 'TODO : Change this to not depend on any external public variable using args instead! Public Sub SetResolucion() Dim lRes As Long Dim MidevM As typDevMODE Dim CambiarResolucion As Boolean lRes = EnumDisplaySettings(0, ENUM_CURRENT_SETTINGS, MidevM) oldResWidth = Screen.width \ Screen.TwipsPerPixelX oldResHeight = Screen.height \ Screen.TwipsPerPixelY If NoRes Then CambiarResolucion = (oldResWidth < 800 Or oldResHeight < 600) Else CambiarResolucion = (oldResWidth <> 800 Or oldResHeight <> 600) End If If CambiarResolucion Then With MidevM oldDepth = .dmBitsPerPel oldFrequency = .dmDisplayFrequency .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL .dmPelsWidth = 800 .dmPelsHeight = 600 .dmBitsPerPel = 16 End With lRes = ChangeDisplaySettings(MidevM, CDS_TEST) Else bNoResChange = True End If End Sub Public Sub ResetResolucion() Dim typDevM As typDevMODE Dim lRes As Long If Not bNoResChange Then lRes = EnumDisplaySettings(0, ENUM_CURRENT_SETTINGS, typDevM) With typDevM .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY .dmPelsWidth = oldResWidth .dmPelsHeight = oldResHeight .dmBitsPerPel = oldDepth .dmDisplayFrequency = oldFrequency End With lRes = ChangeDisplaySettings(typDevM, CDS_TEST) End If End Sub

Buscan

Código:: Sub Main()

Y abajo

Código:: If MsgBox("Quieres cambiar la resolusion a 800 x 600. By: Sderty", vbYesNo, "Resolucion") = vbYes Then 'Sderty Bitches Call Resolution.SetResolucion End If

Ola k ase