[Resolvido]Código que altere resolução do monitor

Boa tarde Amigos

Alguém tem um exemplo de BD que permita mudar a resolução do monitor (tela)?

Obrigado

*Nobre Assis, sugiro alteração do nome do tópico para "Código que altere resolução do monitor", ou algo mais descritivo.

Lembro de já ter visto algo que fazia isso, talvez outro membro relembre de onde.

Qual a finalidade? Talvez haja outra solução. Não é o ideal que o desenvolvedor altere configurações na máquina do cliente.

Boa noite;

Lembro de um exemplo do mestre João Paulo que alterava a resolução da tela, se não me

engano era um exemplo de reservas em pousada, acredito que seja o que você procura Assis.

Bom dia

Ivan e Fernando a ideia é:
Eu executo as BD na resolução 1366 * 768 e ao abrir noutra resolução a visualização é diferente.
Então se ao abrir a BD num monitor com a resolução do monitor diferente de 1366*768, mudava a resolução para a dita resolução, e ao fechar a BD voltava a mudar a resolução para a original.

Obrigado

Olá a todos,

Assis já tentou a "Busca" aqui do fórum:
https://www.maximoaccess.com/t1115-busca-no-forum-search

Será isto:
https://www.maximoaccess.com/t21665-resolvidoajustar-a-tela-ao-tamanho-e-resolucao-do-monitor

Abraçoa todos

Obrigado Teixeira

Bom dia Amigos

Teixeira no exemplo que me indicou tem a função abaixo.

Tenho que mudar alguma coisa ?

Meu monitor o máximo é 1366*768

Obrigado

Código:

Function SizeAccess()
Dim cx As Long, cy As Long, cHeight As Long
Dim cWidth As Long, H As Long

H = Application.hWndAccessApp
cx = 80: cy = 80: cWidth = 640: cHeight = 480

SetWindowPos H, HWND_TOP, cx, cy, cWidth, cHeight, SWP_NOZORDER
End Function

Código:

'Num modulo novo, cole e salve:

'Digite a resolução em que os seus formularios
'foram criados, exemplo 1336

Global Const DesignResolutionX = 1336


Global Const WM_HORZRES = 8
Global Const WM_VERTRES = 10

Dim Width As Integer
Dim Factor As Single

#If VBA7 Then 'para 64 bits
Declare PtrSafe Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare PtrSafe Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Declare PtrSafe Function WM_apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Declare PtrSafe Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare PtrSafe Function WM_apiGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
#Else 'para 32 bits
Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function WM_apiGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
#End If

Public Function GetScreenResolution() As String
'retorna a altura e a largura
Dim DisplayHeight As Integer
Dim DisplayWidth As Integer
Dim hDesktopWnd As Long
Dim hDCcaps As Long
Dim iRtn As Integer

'API que obtem a resolução atual
    hDesktopWnd = WM_apiGetDesktopWindow()
    hDCcaps = WM_apiGetDC(hDesktopWnd)
    DisplayHeight = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
    DisplayWidth = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
    iRtn = WM_apiReleaseDC(hDesktopWnd, hDCcaps)
    GetScreenResolution = DisplayWidth & "x" & DisplayHeight
    Width = DisplayWidth

End Function

Public Sub ReSizeForm(frm As Form)
Dim ctl As Control

On Error Resume Next
SetFactor 'chama o sub SetFactor
    With frm
    .Width = frm.Width * Factor
    End With
    For Each ctl In frm.Controls
    With ctl
    .Height = ctl.Height * Factor
    .Left = ctl.Left * Factor
    .Top = ctl.Top * Factor
    .Width = ctl.Width * Factor
    .FontSize = .FontSize * Factor
    End With
Next ctl
End Sub

Sub SetFactor()
    GetScreenResolution 'chama a função GetScreenResolution
    Factor = Width / DesignResolutionX
End Sub

'Para chamar, no evento VBA ao carregar do seu formulario;

'Private Sub Form_Load()
'    Call ReSizeForm(Me)
'End Sub


Boa tarde Amigos

Esta BD é para quem usa resolução superior a 1024*768, e o Monitor onde possa ser aberta é de resolução diferente.

Ao abri esta BD de exemplo é convidado a alterar a resolução para a resolução em que a BD foi criada.

Ao fechar a mesma BD a resolução do Monitor volta ao tamanho original. ????????????

(No meu funciona espero que me informem como se porta nos Vossos Monitores).

Testem e retornem.

Aguardo

Olá Assis

Eu tenho este que uso que salvo engano foi criado pelo Criquio
Veja se te ajuda

Abraços

Obrigado Celso

Olá Assis..

E este como esta?
Resolveu ?

Abraços

Bom dia Celso

O seu exemplo é bom para quem vai fazer uma BD nova. Agora para alterar uma já feita dá muito trabalho.

Optei por um exemplo que ao abrir uma BD se a resolução do Vídeo for diferente da resolução em que foi feita a BD, convida o utilizador a alterar a resolução do vídeo para a resolução em que foi feita a BD.

Obrigado

Olá Assis,

Obrigado pelo retorno

Também guardei seu exemplo para uso posterior

Abraços

Aqui, Assis

Ivan

Testei num monitor com resolução 1920x1080.

A abrir muda a resolução.

Mas ao fechar não retorna o valor inicial e dá o error da imagem que anexo.

Obrigado

Aqui funciona tranquilo. Testei em todas as resoluções disponíveis na minha máquina. Tenta essa variação.

Ivan

Eis o erro, na minha BD.

O exemplo eu o Ivan postou funciona bem.

Observe no meu arquivo que na função "ChangeRes" os parâmetros são recebidos por valor (ByVal). Faça as mesmas alterações no seu arquivo.

Ivan

Resolvi ….

Obrigado