• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

Hypr

[vb6] Alterar resolução do monitor

5 mensagens neste tópico

tive muita ajuda de pesquisa pela net :D mas tb tem algum trabalho meu xD espero k ajude alguem

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 Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32

Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_BITSPERPEL = &H40000

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
Dim DevM() As DEVMODE


Private Sub Command1_Click()
Dim Tmp1 As Long
Dim Tmp2 As Long
Dim Tmp3 As Long
  If Combo1.ListIndex < 0 Then Exit Sub
  If Combo2.ListIndex < 0 Then Exit Sub
  If Combo2.ListIndex < 0 Then Exit Sub
  
  DevM(Combo1.ItemData(Combo1.ListIndex)).dmFields = DM_PELSWIDTH
  DevM(Combo2.ItemData(Combo2.ListIndex)).dmFields = DM_PELSHEIGHT
  DevM(Combo3.ItemData(Combo3.ListIndex)).dmFields = DM_BITSPERPEL
  
  Tmp1 = ChangeDisplaySettings(DevM(Combo1.ItemData(Combo1.ListIndex)), 0&)
  Tmp2 = ChangeDisplaySettings(DevM(Combo2.ItemData(Combo2.ListIndex)), 0&)
  Tmp3 = ChangeDisplaySettings(DevM(Combo3.ItemData(Combo3.ListIndex)), 0&)
   
End Sub

Private Sub Command2_Click()
If MsgBox("pretende sair?", vbYesNo) = vbYes Then
End
Else: MsgBox "vai continuar"

End If
End Sub

Private Sub Form_Load()

InicializarDevM
  
  If Combo1.ListCount = 0 Then
    Command1.Enabled = False

  Else
    Combo1.ListIndex = 0
  End If

End Sub

Public Sub InicializarDevM()
  Dim Tmp1 As Boolean
  Dim Tmp2 As Integer
  Dim Tmp3 As Integer
  Dim Tmp4 As Integer
  Tmp2 = 0
  Tmp3 = 0
  Tmp4 = 0
  Do
    ReDim Preserve DevM(0 To Tmp2)
    Tmp1 = EnumDisplaySettings(0&, Tmp2, DevM(Tmp2))
    Tmp1 = EnumDisplaySettings(0&, Tmp3, DevM(Tmp3))
    Tmp1 = EnumDisplaySettings(0&, Tmp4, DevM(Tmp4))
    If Tmp1 Then
      Combo1.AddItem DevM(Tmp2).dmPelsWidth & "x"
      Combo1.ItemData(Combo1.NewIndex) = Tmp2
    
    Combo2.AddItem DevM(Tmp3).dmPelsHeight
    Combo2.ItemData(Combo2.NewIndex) = Tmp3
       
       Combo3.AddItem DevM(Tmp4).dmBitsPerPel & "bits"
       Combo3.ItemData(Combo3.NewIndex) = Tmp4
    End If
    
    Tmp2 = Tmp2 + 1
    
    Tmp3 = Tmp3 + 1
    
    Tmp4 = Tmp4 + 1
  
  Loop Until (Tmp1 = False)

End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Bom trabalho,

Vou mover para o Armazém de Código.

Alguns comentários no código também era uma boa ajuda para quem queria utilizar.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

ola boa tarde desculp incomodar mas podes me mandar o layout do teu programa ....sff

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

ola boa tarde desculp incomodar mas podes me mandar o layout do teu programa ....sff

O layout é simples: 2 buttons, se não me faltou nada.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora