Advertisement
leandrobpedro

GE iFix OpenPopup

May 27th, 2022
600
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. '******************************************************************************'
  2. ' File      : basCommonRoutines
  3. ' Author    : In-Tech Automacao e Sistemas.
  4. ' Date      : 2019.04.15
  5. '
  6. ' Revision history
  7. '------------------------------------------------------------------------------'
  8. ' Date      Author  Revision
  9. ' 19.04.15  lbp     First commit
  10. ' 22.02.09  lbp     ADD fator escala de correcao posicao OpenPopup
  11. '******************************************************************************'
  12. Option Explicit
  13.  
  14. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  15. '
  16. ' Abre poupup posicao automatica
  17. '
  18. Sub OpenPopup(ByVal PopupName As String _
  19.             , Optional PopupAlias As String _
  20.             , Optional TagGroupName As String _
  21.             , Optional bNewInstance As Boolean = False)
  22.     Dim iMonitorID As Integer
  23.     Dim lLowerPosition As Double
  24.     Dim lOffset As Double
  25.     Dim lRightmostPosition As Double
  26.     Dim lWidthFactor As Double
  27.     Dim lHeightFactor As Double
  28.     Dim oPicture As Object
  29.     Dim pt As POINTAPI
  30.     Dim pX As Double
  31.     Dim pY As Double
  32.  
  33.    
  34.     On Error GoTo ErrorHandler
  35.    
  36.     ' Rodando a partir do Workspace
  37.     If TypeName(Application) <> "CFixApp" Then
  38.         Exit Sub
  39.     End If
  40.  
  41.     '''''''''''''''''''''''''' Validacao arquivo .grf ''''''''''''''''''''''''''
  42.     ' Verificar se caminho do arquivo foi passada.
  43.     If InStr(1, PopupName, "\", vbTextCompare) = 0 Then
  44.         PopupName = System.PicturePath & "\" & PopupName
  45.     End If
  46.    
  47.     ' Verificar se extensao do arquivo foi passada.
  48.     If InStr(1, PopupName, ".", vbTextCompare) = 0 Then
  49.         PopupName = PopupName & ".grf"
  50.     End If
  51.    
  52.     ' Verificar se de fato arquivo .grf existe.
  53.     If Dir(PopupName) = "" Then
  54.         Exit Sub
  55.     End If
  56.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  57.    
  58.     ' Retorna posicao atual do mouse.
  59.     GetCursorPos pt
  60.     pX = pt.X
  61.     pY = pt.Y
  62.    
  63.     ' Distancia minima oPicture em px da posicao do click do mouse
  64.     lOffset = 24
  65.    
  66.     ConvertPixelToPct pY, pX, lOffset, 0
  67.  
  68.     ' TODO: add ".grf" to the file name
  69.     Set oPicture = Application.Documents.Open(PopupName, 2)
  70.  
  71.     ' Fator de multiplicacao para compensar a posicao a esquerda de abertura do
  72.     ' form em pictures que foram desenvolvidas em resolucoes diferentes da corrente.
  73.     ' Fator eh igual largura do iMonitorID original dividido pela resolucao x do iMonitorID.
  74.     lWidthFactor = oPicture.Page.OriginalScreenWidth / GetSystemMetrics(0)
  75.     lHeightFactor = oPicture.Page.OriginalScreenHeight / GetSystemMetrics(1)
  76.  
  77.     ' Posicao inferior da oPicture (altura + distancia do topo do iMonitorID)
  78.     lLowerPosition = pY + oPicture.Page.WindowHeightPercentage
  79.    
  80.     ' Posicao a direita da oPicture (largura + distancia a esquerda do iMonitorID)
  81.     lRightmostPosition = (pX + oPicture.Page.WindowWidthPercentage)
  82.    
  83.     ' Posicao iMonitorID onde esta inserido o objeto.
  84.     iMonitorID = 100 * (CInt(Left(pX / 100, 1)) + 1)
  85.    
  86.     ' Caso parte inferior da oPicture esta abaixo do limite do iMonitorID.
  87.     If (lLowerPosition > 100#) Then
  88.         oPicture.Page.WindowTopPercentage = 100 - oPicture.Page.WindowHeightPercentage - lOffset
  89.     Else
  90.         oPicture.Page.WindowTopPercentage = (pY - lOffset) / lHeightFactor
  91.     End If
  92.    
  93.     ' Caso parte a direita da oPicture ultrapasse limite direito do iMonitorID.
  94.     If (lRightmostPosition > iMonitorID) Then
  95.         oPicture.Page.WindowLeftPercentage = _
  96.                 ((pX - lOffset) / lWidthFactor) - oPicture.Page.WindowWidthPercentage
  97.     Else
  98.         oPicture.Page.WindowLeftPercentage = (pX + lOffset) / lWidthFactor
  99.     End If
  100.        
  101.     '''''''''''''''''''''''''' Validacao arquivo .tgd ''''''''''''''''''''''''''
  102.     ' Verificar se caminho do arquivo foi passada.
  103.     If InStr(1, TagGroupName, "\", vbTextCompare) = 0 Then
  104.         TagGroupName = System.PicturePath & "\" & TagGroupName
  105.     End If
  106.    
  107.     ' Verificar se extensao do arquivo foi passada.
  108.     If InStr(1, TagGroupName, ".", vbTextCompare) = 0 Then
  109.         TagGroupName = TagGroupName & ".tgd"
  110.     End If
  111.    
  112.     ' Verificar se de fato arquivo .tgd existe.
  113.     If Dir(TagGroupName) <> "" Then
  114.         oPicture.Page.LoadTagGroupFile TagGroupName
  115.     End If
  116.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  117.    
  118.     ' Mostra oPicture.
  119.     oPicture.Page.RuntimeVisible = True
  120.  
  121.     ' Passa alias a oPicture.
  122.     oPicture.ActiveWindow.WindowName = PopupAlias
  123.    
  124.     Exit Sub
  125. ErrorHandler:
  126.     Select Case Err
  127.         Case -2147220504   ' .grf not found.
  128.         Case Else
  129.             Debug.Print Err.Number, Err.Description
  130.     End Select
  131. End Sub
  132.  
Advertisement
RAW Paste Data Copied
Advertisement