IDENTIFICAR A RESOLUCAO DE VIDEO
Boa noite pessoal outra vezes estou aqui p/ agradecer a ajuda de vcs e p/ pedir mais uma ajuda!!
Eu tnho um código q consegui aqui mesmo com vcs q altera a resolução de vÃdeo sozinho.
Nele eu posso determinar uma resolução e qdo abro o form. ele altera a resolução de vÃdeo para o valor q eu determinar q no meu caso foi 800x600 e q qdo eu fecho ele muda a resolução para o valor q eu determinar q no caso 1024x768...
E é esse o problema, eu qria q qdo eu abrir o form. ele identificasse a resolução e guardasse esse valor em um textbox para q qdo eu fechar ele volte como era antes e não 1024 pq nem todos os outros computadores tem essa resolução!!
Mais uma vez me ajuda nesse ai um código p/ Identificar a resolução e inserir o valor dela dentro de um textbox, e como chamar esse valor sendo q meu código está em um modulo...
Se alguém puder me ajudar agradeço muito mesmo!!
A paz esteja em seu coração!!
Eu tnho um código q consegui aqui mesmo com vcs q altera a resolução de vÃdeo sozinho.
Nele eu posso determinar uma resolução e qdo abro o form. ele altera a resolução de vÃdeo para o valor q eu determinar q no meu caso foi 800x600 e q qdo eu fecho ele muda a resolução para o valor q eu determinar q no caso 1024x768...
E é esse o problema, eu qria q qdo eu abrir o form. ele identificasse a resolução e guardasse esse valor em um textbox para q qdo eu fechar ele volte como era antes e não 1024 pq nem todos os outros computadores tem essa resolução!!
Mais uma vez me ajuda nesse ai um código p/ Identificar a resolução e inserir o valor dela dentro de um textbox, e como chamar esse valor sendo q meu código está em um modulo...
Se alguém puder me ajudar agradeço muito mesmo!!
A paz esteja em seu coração!!
Dá uma olhada no anexo que passei pra Kelly que é justamente o que tu precisa
http://www.vbmania.com.br/pages/index.php?varModulo=Forum&varMethod=abrir&varID=348468&varWorld=
Blz . . .
Boa noite a todos!!
MICROSCHEME o codigo q vc me mandou é do vb6 e estou trabalhando com o vba do excel...
Mas mesmo assim muito obrigado eu abri ele em bloco de notas e deu p/ ter uma ideia!!
Agora estou com outra duvida eu consegui o codigo para pegar a resolução do monitor e por em uma textbox. e tbm para mudar a resolução.
Só q está faltando uma coisa q é como pegar esse valor e por em um modulo??
é q qdo eu fecho esse UserForm a resolução tem q voltar ao normal do mesmo jeito q era antes!!
Eu não qro definir duas resoluções uma p/ entrar e outra p/ sair eu qro q ao sair o codigo deixe tudo igual era antes!!
Se alguém puder me ajudar... Como chamar o valor da textbox no modulo??
Vou deixar o codigo aqui...
no modulo1 eu coloquei um para identificar a resolução.
Option Explicit
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Declare Function GetDesktopWindow Lib [Ô]User32[Ô] () As Long
Declare Function GetWindowRect Lib [Ô]User32[Ô] _
(ByVal hWnd As Long, rectangle As RECT) As Long
Private Declare Function ChangeDisplaySettings Lib [Ô]User32[Ô] Alias _
[Ô]ChangeDisplaySettingsA[Ô] (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib [Ô]User32[Ô] Alias _
[Ô]EnumDisplaySettingsA[Ô] (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CCFORMNAME = 32
Const CCDEVICENAME = 32
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
Function GetScreenResolution() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long
hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
GetScreenResolution = (R.x2 - R.x1) & [Ô];[Ô] & (R.y2 - R.y1)
End Function
no UserForm p/ pegar e guardar a resolução coloquei
Private Sub UserForm_Initialize()
TextBox1 = GetScreenResolution
End Sub
E para mudar a minha resolução eu tenho inserido em um outro modulo o seguinte
Declare Function GetSystemMetrics Lib [Ô]User[Ô] (ByVal nIndex As Integer) As Integer
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 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
Public Sub ChangeRes(iWidth As Single, iHeight _
As Single)
Dim DevM As DEVMODE
Dim a As Boolean
Dim i As Long
Dim b As Long
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevM, 0)
End Sub
Sub resolucao1()
Call ChangeRes(800, 600)
End Sub
Tudo isso da certo o unico problema é q eu qro q a resolução volte ao q era antes ou seja q volte a ficar igual ao valor guardado na textbox1 como eu faço isso??
Quem puder me ajudar mais uma vez nessa um muito obrigado!!
MICROSCHEME o codigo q vc me mandou é do vb6 e estou trabalhando com o vba do excel...
Mas mesmo assim muito obrigado eu abri ele em bloco de notas e deu p/ ter uma ideia!!
Agora estou com outra duvida eu consegui o codigo para pegar a resolução do monitor e por em uma textbox. e tbm para mudar a resolução.
Só q está faltando uma coisa q é como pegar esse valor e por em um modulo??
é q qdo eu fecho esse UserForm a resolução tem q voltar ao normal do mesmo jeito q era antes!!
Eu não qro definir duas resoluções uma p/ entrar e outra p/ sair eu qro q ao sair o codigo deixe tudo igual era antes!!
Se alguém puder me ajudar... Como chamar o valor da textbox no modulo??
Vou deixar o codigo aqui...
no modulo1 eu coloquei um para identificar a resolução.
Option Explicit
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Declare Function GetDesktopWindow Lib [Ô]User32[Ô] () As Long
Declare Function GetWindowRect Lib [Ô]User32[Ô] _
(ByVal hWnd As Long, rectangle As RECT) As Long
Private Declare Function ChangeDisplaySettings Lib [Ô]User32[Ô] Alias _
[Ô]ChangeDisplaySettingsA[Ô] (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib [Ô]User32[Ô] Alias _
[Ô]EnumDisplaySettingsA[Ô] (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CCFORMNAME = 32
Const CCDEVICENAME = 32
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
Function GetScreenResolution() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long
hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
GetScreenResolution = (R.x2 - R.x1) & [Ô];[Ô] & (R.y2 - R.y1)
End Function
no UserForm p/ pegar e guardar a resolução coloquei
Private Sub UserForm_Initialize()
TextBox1 = GetScreenResolution
End Sub
E para mudar a minha resolução eu tenho inserido em um outro modulo o seguinte
Declare Function GetSystemMetrics Lib [Ô]User[Ô] (ByVal nIndex As Integer) As Integer
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 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
Public Sub ChangeRes(iWidth As Single, iHeight _
As Single)
Dim DevM As DEVMODE
Dim a As Boolean
Dim i As Long
Dim b As Long
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevM, 0)
End Sub
Sub resolucao1()
Call ChangeRes(800, 600)
End Sub
Tudo isso da certo o unico problema é q eu qro q a resolução volte ao q era antes ou seja q volte a ficar igual ao valor guardado na textbox1 como eu faço isso??
Quem puder me ajudar mais uma vez nessa um muito obrigado!!
Muito bem, não especificou que é VBA.
Mesmo assim, se o projeto guarda em variáveis a resolução atual quando carrega, refaz pra resolução que tu quer e
retorna a resolução original na saÃda, o porque de guardar em text os valores, se tudo é automático ?
é só alterar estas variáveis no load do form pro valor que tu usar nos teus forms:
sinResolucaoX = 1024 [ô]pode ser 800
sinResolucaoY = 768 [ô]pode ser 600
e automaticamente vai retornar os valores originais na saÃda, mano, independente de qual for a resolução original . . .
. . .
MicroScheme tdo bem??
Me da uma luz ai por favor não estou conseguindo!!
Eu faria isso com o codigo do 1º ou do segundo modulo??
é q não estou usando um userform p/ chamar o codigo coloquei ele p/ ser executado ao abrir a pasta de trabalho...
Me descupa ai é q estou começando no lance de vba agora e estou muito perdido ainda!!
Abraços!!
Me da uma luz ai por favor não estou conseguindo!!
Eu faria isso com o codigo do 1º ou do segundo modulo??
é q não estou usando um userform p/ chamar o codigo coloquei ele p/ ser executado ao abrir a pasta de trabalho...
Me descupa ai é q estou começando no lance de vba agora e estou muito perdido ainda!!
Abraços!!
Mano, eu não tenho nem idéia pra chamar a função no vba sem form
mas, mesmo assim, deve existir uma forma de criar uma macro (tu manja de vba mais do que eu), pra chamar a função
vou pesquisar e se encontrar uma forma retorno
blz . . .
eu me lembro de alguma coisa que a muito tempo atrás fiz com vba, que ao carrega a planilha carregava imediatamente
um form e quando dava o comando num button pra fechar, salvava e fechava tudo
era algo tipo apllicatiion. . . .
vou ver ser lembro . . .
um form e quando dava o comando num button pra fechar, salvava e fechava tudo
era algo tipo apllicatiion. . . .
vou ver ser lembro . . .
MicroScherme abri o form e fechalo eu até consegui, e até mudar a resolução eu só não estou conseguindo é fazer ele voltar a resolução q estava no pc antes!!
Como eu faço isso??
Como eu faço isso??
Mano no form que te passei:
Private Sub Form_Load()
[ô] Definição e Chamada Para a Troca da Resolução do VÃdeo
sinResolucaoX = 1024
sinResolucaoY = 768
Call GetClipCursor(Resolucao_Atual)
sinOldResolucaoX = Resolucao_Atual.Right
sinOldResolucaoY = Resolucao_Atual.Bottom
curFatorX = sinOldResolucaoX / sinResolucaoX
curFatorY = sinOldResolucaoY / sinResolucaoY
intXTwipsForm = Me.Width
intYTwipsForm = Me.Height
intXTwipsScreen = Screen.TwipsPerPixelX
intXTwipsScreen = sinOldResolucaoX * intXTwipsScreen
intYTwipsScreen = Screen.TwipsPerPixelY
intYTwipsScreen = sinOldResolucaoY * intYTwipsScreen
Label1.Caption = sinOldResolucaoX
Label2.Caption = sinOldResolucaoY
Label3.Caption = sinResolucaoX
Label4.Caption = sinResolucaoY
If sinOldResolucaoX <> sinResolucaoX Or sinOldResolucaoY <> sinResolucaoY Then
booResolucao = True
Call Troca_Resolucao(sinResolucaoX, sinResolucaoY) [txt-color=#e80000]<<---- Aqui chama a nova resolução[/txt-color]
Me.Width = intXTwipsScreen * (intXTwipsForm / intXTwipsScreen)
Me.Height = intYTwipsScreen * (intYTwipsForm / intYTwipsScreen)
Else
booResolucao = False
End If
[ô] Definição e Chamada Para a Transparência do Formulário
Transparencia = 210
Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hWnd, 0, Transparencia, LWA_ALPHA
End Sub
Private Sub Form_Unload(Cancel As Integer)
If booResolucao = True Then
Call Troca_Resolucao(sinOldResolucaoX, sinOldResolucaoY) [txt-color=#e80000]<<---- Aqui devolve a resolução antiga[/txt-color]
End If
End Sub
coloca essa linha no fechamento da planilha:
Call Troca_Resolucao(sinOldResolucaoX, sinOldResolucaoY)
isso se tu conseguiu chamar a resolução pelo código que te passei.
Blz . . .
Pessoal consegui identificar, alterar a resolução e devolver a resolução ao sair!!
Deu trabalho mas consegui!!
Se alguém precisar é só pedir q eu passo o codigo!!
Lembrando q é VBA do Excel...
Deus os abençoe!!
Deu trabalho mas consegui!!
Se alguém precisar é só pedir q eu passo o codigo!!
Lembrando q é VBA do Excel...
Deus os abençoe!!
Tópico encerrado , respostas não são mais permitidas