Software Público Brasileiro

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "MSCOMCTL.OCX"
Begin VB.Form frmEncontraTexto 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Localizar Textos"
   ClientHeight    =   4260
   ClientLeft      =   9645
   ClientTop       =   5790
   ClientWidth     =   5475
   Icon            =   "frmEncontraTexto.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4260
   ScaleWidth      =   5475
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   780
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   180
      Width           =   4545
   End
   Begin VB.Frame Frame1 
      Caption         =   "Parte do texto"
      Height          =   720
      Left            =   90
      TabIndex        =   3
      Top             =   1170
      Width           =   3750
      Begin VB.OptionButton optQQRParte 
         Caption         =   "Qualquer parte"
         Height          =   300
         Left            =   2055
         TabIndex        =   6
         Top             =   300
         Width           =   1395
      End
      Begin VB.OptionButton optFim 
         Caption         =   "Fim"
         Height          =   315
         Left            =   1185
         TabIndex        =   5
         Top             =   300
         Width           =   840
      End
      Begin VB.OptionButton optInicio 
         Caption         =   "Início"
         Height          =   255
         Left            =   195
         TabIndex        =   4
         Top             =   330
         Value           =   -1  'True
         Width           =   960
      End
   End
   Begin MSComctlLib.ListView Lista 
      Height          =   1995
      Left            =   90
      TabIndex        =   2
      Top             =   1950
      Width           =   5205
      _ExtentX        =   9181
      _ExtentY        =   3519
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   3
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Localizado"
         Object.Width           =   3528
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "Eixo X"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "Eixo Y"
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.CommandButton cmdPesquisar 
      Caption         =   "Localizar"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   360
      Left            =   4065
      TabIndex        =   1
      Top             =   1395
      Width           =   1005
   End
   Begin VB.TextBox TXTSTRING 
      Height          =   330
      Left            =   780
      TabIndex        =   0
      Top             =   660
      Width           =   4515
   End
   Begin VB.Label Label3 
      Height          =   225
      Left            =   180
      TabIndex        =   10
      Top             =   3990
      Width           =   3405
   End
   Begin VB.Label Label2 
      Caption         =   "Texto"
      Height          =   270
      Left            =   165
      TabIndex        =   9
      Top             =   720
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "Tema"
      Height          =   300
      Left            =   165
      TabIndex        =   8
      Top             =   240
      Width           =   465
   End
End
Attribute VB_Name = "frmEncontraTexto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim str As String
Dim rs As ADODB.Recordset
Dim strLayerID As String

Dim gu1 As String
Dim gu2 As String
Dim gu3 As String
Dim gu4 As String
Dim gu5 As String
Dim gu6 As String
Dim gu7 As String
Dim gu8 As String
Dim gu9 As String
 Dim str3, str2, str4 As String
Private Sub Combo1_Click()
    On Error GoTo Trata_Erro
    Dim rs As New ADODB.Recordset
    Dim Vetor As Variant
    Dim intTema As Integer
    
    Me.Lista.ListItems.Clear

      intTema = 0

    Open glo.diretorioGeoSan & "\CONTROLES\FTema.txt" For Input As #3   'LÊ O ARQUIVO LOG QUE FOI CRIADO NO MOMENTO DE ABERTURA DO MAPA
    Do While Not EOF(3)
        Line Input #3, str4
        Vetor = Split(str4, ";")
        If Vetor(1) = Combo1.Text Then
            intTema = Vetor(0)
            Exit Do
        End If
        'MsgBox vetor(0) & " É O NÚMERO THEME_ID QUE IDENTIFICA O LAYER E É FEITO O SELECT"
        'MsgBox vetor(1) & " É O NOME DO LAYER"
        ' vetor(2) 'É O COMANDO DO FILTRO
    Loop
    Close #3
    If frmCanvas.TipoConexao <> 4 Then
    str3 = "SELECT THEME_ID, LAYER_ID FROM TE_THEME WHERE THEME_ID =" & intTema & ""
    Else
    gu1 = "theme_id"
    gu2 = "layer_id"
    gu3 = "te_theme"
    gu4 = "geom_id"
    gu5 = "text_value"
    gu6 = "Texts"
    str3 = "SELECT " + """" + gu1 + """" + ", " + """" + gu2 + """" + " FROM " + """" + gu3 + """" + " WHERE " + """" + gu1 + """" + " ='" & intTema & "'"
    End If
     Set rs = Conn.execute(str3)
    ' DE ABERTURA DO MAPA
  
    
   
   
    If rs.EOF = False Then
        strLayerID = rs!layer_id
    End If
    rs.Close
 
    If frmCanvas.TipoConexao <> 4 Then
     str2 = "SELECT GEOM_ID,TEXT_VALUE FROM TEXTS" & strLayerID & " WHERE GEOM_ID = 0"
     Else
      gu1 = "theme_id"
    gu2 = "layer_id"
    gu3 = "te_theme"
    gu4 = "geom_id"
    gu5 = "text_value"
    gu6 = "Texts"
    gu7 = strLayerID
    gu8 = gu6 + gu7
     str2 = "SELECT " + """" + gu4 + """" + "," + """" + gu5 + """" + " FROM " + """" + "texts" + strLayerID + """" + " WHERE " + """" + gu4 + """" + " = '0'"
     End If
    
    
  
     Set rs = Conn.execute(str2)

     Me.cmdPesquisar.Enabled = True

     rs.Close

Trata_Erro:

If Err.Number = 0 Or Err.Number = 20 Then
    Resume Next
Else

    'MsgBox Err.Number & " " & Err.Description
    Err.Clear
    MsgBox "Não há texto na vista selecionada.", vbInformation
    Me.cmdPesquisar.Enabled = False
End If
End Sub
' Carrega os temas que estão ativos para o usuário
'
'
'
Private Sub Form_Load()
    On Error GoTo Trata_Erro
    Dim Vetor As Variant
    Dim str As String
    
    Close #3
    Open glo.diretorioGeoSan & "\CONTROLES\FTema.txt" For Input As #3 'LÊ O ARQUIVO LOG QUE FOI CRIADO NO MOMENTO DE ABERTURA DO MAPA
    Do While Not EOF(3)
        Line Input #3, str
        Vetor = Split(str, ";")
        Combo1.AddItem Vetor(1)
    Loop
    Close #3

Trata_Erro:
    If Err.Number = 0 Or Err.Number = 20 Then
        Resume Next
    Else
       ErroUsuario.Registra "frmEncontraTexto", "Form_Load", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
    End If
End Sub
' Localiza os textos no mapa para poder fazer zoom
'
'
'
Private Sub cmdPesquisar_Click()
    On Error GoTo Trata_Erro
    Dim j As Long
    Dim itmx As ListItem
    Dim rs As New ADODB.Recordset

    Lista.ListItems.Clear
    gu1 = "theme_id"
    gu2 = "layer_id"
    gu3 = "te_theme"
    gu4 = "geom_id"
    gu5 = "text_value"
    gu6 = "texts"
    gu7 = "x"
    gu8 = "y"
    If Me.optInicio.value = True Then
        If frmCanvas.TipoConexao <> 4 Then
            str = "SELECT GEOM_ID,TEXT_VALUE,X,Y FROM TEXTS" & strLayerID & " WHERE TEXT_VALUE LIKE '" & TXTSTRING.Text & "%'"
        Else
            str = "SELECT " + """" + gu4 + """" + "," + """" + gu5 + """" + "," + """" + gu7 + """" + "," + """" + gu8 + """" + " FROM " + """" + gu6 + strLayerID + """" + " WHERE " + """" + gu5 + """" + " LIKE '" & TXTSTRING.Text & "%'"
        End If
    ElseIf Me.optFim.value = True Then
        If frmCanvas.TipoConexao <> 4 Then
            str = "SELECT GEOM_ID,TEXT_VALUE,X,Y FROM TEXTS" & strLayerID & " WHERE TEXT_VALUE LIKE '%" & TXTSTRING.Text & "'"
        Else
            str = "SELECT " + """" + gu4 + """" + "," + """" + gu5 + """" + "," + """" + gu7 + """" + "," + """" + gu8 + """" + " FROM " + """" + gu6 + strLayerID + """" + " WHERE " + """" + gu5 + """" + " LIKE '" & TXTSTRING.Text & "%'"
        End If
    ElseIf Me.optQQRParte.value = True Then
        If frmCanvas.TipoConexao <> 4 Then
            str = "SELECT GEOM_ID,TEXT_VALUE,X,Y FROM TEXTS" & strLayerID & " WHERE TEXT_VALUE LIKE '%" & TXTSTRING.Text & "%'"
        Else
            str = "SELECT " + """" + gu4 + """" + "," + """" + gu5 + """" + "," + """" + gu7 + """" + "," + """" + gu8 + """" + " FROM " + """" + gu6 + strLayerID + """" + " WHERE " + """" + gu5 + """" + " LIKE '" & TXTSTRING.Text & "%'"
        End If
    End If
    'FAZ SELECT COM BASE NOS CAMPOS CRIADOS
    j = 0
    If str <> "" Then
        Set rs = Conn.execute(str)
        If rs.EOF = False Then
            'CARREGA NO FORM TODAS AS LIGAÇÕES DISPONIVEIS COM BASE NO PRÉ FILTRO
            Do While Not rs.EOF
                'DoEvents
                Set itmx = Lista.ListItems.Add(, , rs.Fields("TEXT_VALUE").value)
                itmx.SubItems(1) = IIf(IsNull(rs.Fields("X").value), "", rs.Fields("X").value)
                itmx.SubItems(2) = IIf(IsNull(rs.Fields("Y").value), "", rs.Fields("Y").value)
                itmx.Tag = rs.Fields("GEOM_ID").value
                j = j + 1
                rs.MoveNext
            Loop
        End If
        rs.Close
        'Set Rs = Nothing
    End If
    Label3.Caption = "Localizadas " & j & " referências."
    Exit Sub
    
Trata_Erro:
    If Err.Number = 0 Or Err.Number = 20 Then
        Resume Next
    Else
       ErroUsuario.Registra "frmEncontraTexto", "cmdPesquisar_Click", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
    End If
End Sub
' Usuário clicou duas vezes no texto que deseja visualizar no mapa
'
'
'
Private Sub Lista_DblClick()
    On Error GoTo Trata_Erro
    Dim i As Long
    Dim X As Double, Y As Double
    Dim rs As New ADODB.Recordset

    gu1 = "theme_id"
    gu2 = "layer_id"
    gu3 = "te_theme"
    gu4 = "geom_id"
    gu5 = "text_value"
    gu6 = "texts"
    gu7 = "x"
    gu8 = "y"
    If strLayerID <> "" And Me.cmdPesquisar.Enabled = True Then
        If Lista.ListItems.count <= 0 Then
            Exit Sub
        End If
        i = Lista.SelectedItem.Tag
        If frmCanvas.TipoConexao <> 4 Then
            str = "SELECT GEOM_ID,TEXT_VALUE,X,Y FROM TEXTS" & strLayerID & " WHERE GEOM_ID =" & i & ""
        Else
            str = "SELECT " + """" + gu4 + """" + "," + """" + gu5 + """" + "," + """" + gu7 + """" + "," + """" + gu8 + """" + " FROM " + """" + gu6 + strLayerID + """" + " WHERE " + """" + gu4 + """" + "='" & i & "'"
        End If
        Set rs = Conn.execute(str)
        If rs.EOF = False Then
            xWorld = CLng(rs!X) 'carrega as variáveis públicas com valores do banco
            yWorld = CLng(rs!Y) 'carrega as variáveis públicas com valores do banco
        End If
        rs.Close
    End If
    Exit Sub

Trata_Erro:
    If Err.Number = 0 Or Err.Number = 20 Then
        Resume Next
    Else
       ErroUsuario.Registra "frmEncontraTexto", "Lista_DblClick", CStr(Err.Number), CStr(Err.Description), True, glo.enviaEmails
    End If
End Sub