Inputbox em Aplicação com Múltiplos Monitores

Boa tarde!

Na minha aplicação utilizo InputBox para receber valores do usuário. O inputbox aparece centralizado quando está rodando em uma máquina com apenas 1 monitor.

Quando a mesma aplicação está rodando em uma máquina com mais de 1 monitor, mesmo que o E3 esteja aberto no monitor 2, a InputBox abre centralizada no monitor 1.

Alguém sabe como resolver esse problema?

Olá Nivaldo,

O método inputbox do VbScript possui os seguintes parâmetros de configuração: InputBox(prompt[, title][, default][, xpos][, ypos][, helpfile, context])
Para escolher um posicionamento diferente do padrão para a janela, deve-se configurar as propriedades “xpos” e “ypos”.

Os parâmetros de posicionamento do InputBox são em unidade ‘twip’, que basicamente são “pixel*15”. Estes parâmetros do VBScript recebem valores no formato SHORT Number, que tem um limite em 32767 decimal.

Então, se por exemplo estiver utilizando uma resolução 1920 x 1080, sugiro duas possibilidades:

  1. Abrir o InputBox na ‘origem’ do segundo monitor, que seria X=1920*15 e Y=0.
  2. Abrir no limite máximo, que ficaria próximo ao centralizado, que seria X=32767 e Y=540*15.
1 Like

O método InputBox possui o argumento Left (em twip), que define a posição da caixa de entrada à esquerda da tela.

InputBox(prompt, [title], [defaultValue], [xpos], [ypos], [helpfile], [context])

Mais em: https://pt.wikipedia.org/wiki/Twip

De forma simples, considerando um evento de click chamando o InputBox, e constantes com a resolução do monitor:

Sub button_Click()
	Const SCREEN_WIDTH = 1366
	Const SCREEN_HEIGHT = 768
	Dim iMonitor
	Dim lPos
	
	iMonitor = Application.GetMouseX() \ SCREEN_WIDTH
	
	lPos = ( iMonitor * SCREEN_WIDTH ) + ( SCREEN_WIDTH / 2 )
	lPos = lPos - ( 364 / 2 )	' menos metade da largura da inputbox ~364px
	lPos = PixelToTwip( lPos )	' pixel to twip
	
	' do stuffs...
	InputBox "Prompt", "Title", "Default", lPos
End Sub
Function PixelToTwip( px )
	PixelToTwip = px * 15
End Function
Sub Foo()
End Sub

1 Like

Olá Délio,

Sua sugestão respondeu ao que eu precisava. Eu estava tentando colocar a exibição da inputbox dinâmica à partir da posição do mouse, mas estava dando erro de estouro.
Muito obrigado.

Meu código final ficou assim:

If Application.GetMouseX() > 1920 Then
   lpos = 32767
Else
   lpos = 11670
End If

NovoValor = InputBox("Digite o novo valor:",,,lpos)
1 Like

Olá Leandro,

Sua sugestão é parecida com o que eu já estava tentando fazer, entretanto não funcionou para o meu caso, pois devido à resolução de 1920 x 1080, cai no problema de estouro do valor permitido para parametrização do InputBox.
De qualquer forma, é uma boa alternativa para resoluções menores que 1920 x 1080.

1 Like

Entendo, obrigado pelo retorno.

Problema é ficar limitado próximo origem do monitor 2 e/ou a dois monitores somente.

Caso queira testar, ente usar o prj deste link com a seguinte chamada:

Sub button_Click()
    Const SCREEN_WIDTH = 1920
    Const SCREEN_HEIGHT = 1080

    Dim iMonitor
    Dim newValue
    Dim posX
    Dim posY

    iMonitor = Application.GetMouseX() \ SCREEN_WIDTH

    posX = ( iMonitor * SCREEN_WIDTH ) + ( SCREEN_WIDTH / 2 )
    posX = posX - ( 364 / 2 )   ' menos metade da largura da inputbox ~364px

    posY = SCREEN_HEIGHT / 2
    posY = posY - 128           ' menos metade da altura da inputbox ~128px

    newValue = (New InputBoxEx)("Digite o novo valor:", , , posX, posY)

    MsgBox newValue
End Sub

Class InputBoxEx
    Dim sRetval

    ' TODO: prompt, [title], [defaultValue], [xpos], [ypos], [helpfile], [context]
    Public Default Function Init( prompt, title, defaultValue, xpos, ypos )
        sRetval = Application.DoModal("InputBoxEx", title, xpos, ypos, , , Array(prompt, defaultValue), 1+2+16+64+256)

        If sRetval <> vbCancel Then
            sRetval = CreateObject ("WScript.Shell")_
                    .RegRead("HKCU\Software\InputBoxEx\Retval")
        Else
            sRetval = Empty
        End If

        Init = sRetval
    End Function
End Class

Sub Foo()
End Sub
1 Like