GE iFix OpenPopup

'******************************************************************************'
' File      : basCommonRoutines
' Author    : In-Tech Automacao e Sistemas.
' Date      : 2019.04.15
'
' Revision history
'------------------------------------------------------------------------------'
' Date      Author  Revision
' 19.04.15  lbp     First commit
' 22.02.09  lbp     ADD fator escala de correcao posicao OpenPopup
'******************************************************************************'
Option Explicit

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'
' Abre poupup posicao automatica
'
Sub OpenPopup(ByVal PopupName As String _
            , Optional PopupAlias As String _
            , Optional TagGroupName As String _
            , Optional bNewInstance As Boolean = False)
    Dim iMonitorID As Integer
    Dim lLowerPosition As Double
    Dim lOffset As Double
    Dim lRightmostPosition As Double
    Dim lWidthFactor As Double
    Dim lHeightFactor As Double
    Dim oPicture As Object
    Dim pt As POINTAPI
    Dim pX As Double
    Dim pY As Double


    On Error GoTo ErrorHandler

    ' Rodando a partir do Workspace
    If TypeName(Application) <> "CFixApp" Then
        Exit Sub
    End If

    '''''''''''''''''''''''''' Validacao arquivo .grf ''''''''''''''''''''''''''
    ' Verificar se caminho do arquivo foi passada.
    If InStr(1, PopupName, "\", vbTextCompare) = 0 Then
        PopupName = System.PicturePath & "\" & PopupName
    End If

    ' Verificar se extensao do arquivo foi passada.
    If InStr(1, PopupName, ".", vbTextCompare) = 0 Then
        PopupName = PopupName & ".grf"
    End If

    ' Verificar se de fato arquivo .grf existe.
    If Dir(PopupName) = "" Then
        Exit Sub
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' Retorna posicao atual do mouse.
    GetCursorPos pt
    pX = pt.X
    pY = pt.Y

    ' Distancia minima oPicture em px da posicao do click do mouse
    lOffset = 24

    ConvertPixelToPct pY, pX, lOffset, 0

    ' TODO: add ".grf" to the file name
    Set oPicture = Application.Documents.Open(PopupName, 2)

    ' Fator de multiplicacao para compensar a posicao a esquerda de abertura do
    ' form em pictures que foram desenvolvidas em resolucoes diferentes da corrente.
    ' Fator eh igual largura do iMonitorID original dividido pela resolucao x do iMonitorID.
    lWidthFactor = oPicture.Page.OriginalScreenWidth / GetSystemMetrics(0)
    lHeightFactor = oPicture.Page.OriginalScreenHeight / GetSystemMetrics(1)

    ' Posicao inferior da oPicture (altura + distancia do topo do iMonitorID)
    lLowerPosition = pY + oPicture.Page.WindowHeightPercentage

    ' Posicao a direita da oPicture (largura + distancia a esquerda do iMonitorID)
    lRightmostPosition = (pX + oPicture.Page.WindowWidthPercentage)

    ' Posicao iMonitorID onde esta inserido o objeto.
    iMonitorID = 100 * (CInt(Left(pX / 100, 1)) + 1)

    ' Caso parte inferior da oPicture esta abaixo do limite do iMonitorID.
    If (lLowerPosition > 100#) Then
        oPicture.Page.WindowTopPercentage = 100 - oPicture.Page.WindowHeightPercentage - lOffset
    Else
        oPicture.Page.WindowTopPercentage = (pY - lOffset) / lHeightFactor
    End If

    ' Caso parte a direita da oPicture ultrapasse limite direito do iMonitorID.
    If (lRightmostPosition > iMonitorID) Then
        oPicture.Page.WindowLeftPercentage = _
                ((pX - lOffset) / lWidthFactor) - oPicture.Page.WindowWidthPercentage
    Else
        oPicture.Page.WindowLeftPercentage = (pX + lOffset) / lWidthFactor
    End If

    '''''''''''''''''''''''''' Validacao arquivo .tgd ''''''''''''''''''''''''''
    ' Verificar se caminho do arquivo foi passada.
    If InStr(1, TagGroupName, "\", vbTextCompare) = 0 Then
        TagGroupName = System.PicturePath & "\" & TagGroupName
    End If

    ' Verificar se extensao do arquivo foi passada.
    If InStr(1, TagGroupName, ".", vbTextCompare) = 0 Then
        TagGroupName = TagGroupName & ".tgd"
    End If

    ' Verificar se de fato arquivo .tgd existe.
    If Dir(TagGroupName) <> "" Then
        oPicture.Page.LoadTagGroupFile TagGroupName
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' Mostra oPicture.
    oPicture.Page.RuntimeVisible = True

    ' Passa alias a oPicture.
    oPicture.ActiveWindow.WindowName = PopupAlias

    Exit Sub
ErrorHandler:
    Select Case Err
        Case -2147220504   ' .grf not found.
        Case Else
            Debug.Print Err.Number, Err.Description
    End Select
End Sub