form1.frm

此为在图像处理中的定位程序,其中在图像上的输入即坐标获取方面有比较好的优势

        If IsNull(RsFind1.Fields("appealerNumber").Value) Then
            renshu = 0
        Else
            renshu = RsFind1.Fields("appealerNumber").Value
        End If
        
        
        
        xfxs = ""
        xfgm = ""
        
       ' On Error Resume Next
        
        If Not IsNull(RsFind1.Fields("appealFormId").Value) Then
            If RsFind1.Fields("appealFormId").Value = 1 Then
                If renshu >= 5 Then
                    xfgm = "联名信"
                End If
                xfxs = "来信"
            ElseIf RsFind1.Fields("appealFormId").Value = 2 Then
                xfxs = "来电"
            ElseIf RsFind1.Fields("appealFormId").Value = 3 Then
                If renshu >= 5 Then
                    xfgm = "集体访"
                End If
                xfxs = "来访"
            ElseIf RsFind1.Fields("appealFormId").Value = 4 Then
                xfxs = "网上信访"
            ElseIf RsFind1.Fields("appealFormId").Value = 5 Then
                xfxs = "督查"
            End If

        End If
        
        
        If stylename <> "0" Then
        
            pR.Open "select appealcategoryname from tbxappealcategory where appealcategoryid=" & style1, pSQLServer, adOpenStatic, adLockOptimistic
            If Not pR.EOF Then
               style1_name = pR.Fields(0).Value
            End If
            pR.Close
            
            pR.Open "select appealcategoryname from tbxappealcategory where appealcategorycode='" + CStr(style2) + "' and appealcategoryparentid='" + CStr(style1) + "'", pSQLServer, adOpenStatic, adLockOptimistic
            If Not pR.EOF Then
               style2_name = pR.Fields(0).Value
            End If
            pR.Close

        
        
        End If
        
        If sort <> "0" Then
        
            pR.Open "select appealsortname from tbxappealsort where appealsortid=" & sort, pSQLServer, adOpenStatic, adLockOptimistic
            If Not pR.EOF Then
               sort_name = pR.Fields(0).Value
            End If
            pR.Close
        End If
        
        threatening_name = ""
        If threateningId <> 0 Then
            pR.Open "select threateningname from tbxthreatening where threateningid=" & threateningId, pSQLServer, adOpenStatic, adLockOptimistic
            If Not pR.EOF Then
               threatening_name = pR.Fields(0).Value
            End If
            pR.Close
            
        End If
        
    End If
    
    
    
    Set pFCursor = pFClass.Insert(True)
    Set pFBuffer = pFClass.CreateFeatureBuffer
    Set pFBuffer.Shape = pPoint
    Set pfeature = pFBuffer
    
    Set pFCursor1 = pFClass1.Insert(True)
    Set pFBuffer1 = pFClass1.CreateFeatureBuffer
    Set pFBuffer1.Shape = pPoint
    Set pfeature1 = pFBuffer1
    
    
    
    
   
    pfeature.Value(pFClass.FindField("编号")) = id
    pfeature1.Value(pFClass1.FindField("编号")) = id
    If Not IsNull(RsFind1.Fields("appealDate").Value) Then
        pfeature.Value(pFClass.FindField("信访时间")) = RsFind1.Fields("appealDate").Value
        pfeature1.Value(pFClass1.FindField("信访时间")) = RsFind1.Fields("appealDate").Value
    End If
    
    If IsNull(RsFind1.Fields("eventoccuraddress").Value) Then
        address = ""
    Else
        address = RsFind1.Fields("eventoccuraddress").Value
    End If
    
'    If wz = "" Then
'         wz = getwz(address)
'    End If
    
    If Len(address) > 30 Then
        address = Mid(address, 1, 30)
    End If
    
    pfeature.Value(pFClass.FindField("地址")) = address
    pfeature1.Value(pFClass1.FindField("地址")) = address
    
    pfeature.Value(pFClass.FindField("类别1编号")) = style1
    pfeature1.Value(pFClass1.FindField("类别1编号")) = style1
    
    pfeature.Value(pFClass.FindField("类别1名称")) = style1_name
    pfeature1.Value(pFClass1.FindField("类别1名称")) = style1_name
    
    pfeature.Value(pFClass.FindField("类别2编号")) = style2
    pfeature1.Value(pFClass1.FindField("类别2编号")) = style2
    
    pfeature.Value(pFClass.FindField("类别2名称")) = style2_name
    pfeature1.Value(pFClass1.FindField("类别2名称")) = style2_name
    
    pfeature.Value(pFClass.FindField("专项编号")) = sort
    pfeature1.Value(pFClass1.FindField("专项编号")) = sort
    
    pfeature.Value(pFClass.FindField("专项名称")) = sort_name
    pfeature1.Value(pFClass1.FindField("专项名称")) = sort_name
    
    pfeature.Value(pFClass.FindField("是否扬言")) = threatening_name
    pfeature1.Value(pFClass1.FindField("是否扬言")) = threatening_name
    
    pfeature.Value(pFClass.FindField("类别综述")) = style2_name & "(" & style1_name & ")"
    pfeature1.Value(pFClass1.FindField("类别综述")) = style2_name & "(" & style1_name & ")"
    
    
    If IsNull(RsFind1.Fields("appealSummary").Value) Then
        pfeature.Value(pFClass.FindField("事件概述")) = ""
        pfeature1.Value(pFClass1.FindField("事件概述")) = ""
    Else
        If Len(RsFind1.Fields("appealSummary").Value) > 20 Then
            pfeature.Value(pFClass.FindField("事件概述")) = Mid(RsFind1.Fields("appealSummary").Value, 1, 20)
            pfeature1.Value(pFClass1.FindField("事件概述")) = Mid(RsFind1.Fields("appealSummary").Value, 1, 20)
            
        Else
            pfeature.Value(pFClass.FindField("事件概述")) = RsFind1.Fields("appealSummary").Value
            pfeature1.Value(pFClass1.FindField("事件概述")) = RsFind1.Fields("appealSummary").Value
            
        End If
    End If
    'pfeature.value(pFClass.FindField("事件概述")) = RsFind1.fields("appealSummary").value
    
    pfeature.Value(pFClass.FindField("备注")) = ""
    pfeature1.Value(pFClass1.FindField("备注")) = ""
    
    pfeature.Value(pFClass.FindField("区界")) = get_qj(pPoint)
    pfeature1.Value(pFClass1.FindField("区界")) = pfeature.Value(pFClass.FindField("区界"))
    
    pfeature.Value(pFClass.FindField("街道")) = get_jd(pPoint)
    pfeature1.Value(pFClass1.FindField("街道")) = pfeature.Value(pFClass.FindField("街道"))
    
    pfeature.Value(pFClass.FindField("人数")) = renshu
    pfeature1.Value(pFClass1.FindField("人数")) = renshu
    
    pfeature.Value(pFClass.FindField("信访规模")) = xfgm
    pfeature1.Value(pFClass1.FindField("信访规模")) = xfgm

    
    
    pfeature.Value(pFClass.FindField("信访形式")) = xfxs
    pfeature1.Value(pFClass1.FindField("信访形式")) = xfxs


    pfeature.Value(pFClass.FindField("区域")) = wz
    pfeature1.Value(pFClass1.FindField("区域")) = wz


    pfeature.Value(pFClass.FindField("时间")) = Now
    pfeature1.Value(pFClass1.FindField("时间")) = Now


    pfeature.Value(pFClass.FindField("定位方式")) = dwfunction
    pfeature1.Value(pFClass1.FindField("定位方式")) = dwfunction

    
    
    
    
    pFCursor.InsertFeature pFBuffer
    pFCursor1.InsertFeature pFBuffer1
    
    
    
    
    AddFeature = True
    Exit Function
'e:
    AddFeature = False
    MsgBox "添加数据出现问题！！！" & id, vbCritical, "系统提示："
End Function




Private Function get_jd(pPoint As IPoint) As String
On Error GoTo e
    
    Dim pSFilter As ISpatialFilter
    Dim pFCursor As IFeatureCursor
    Set pSFilter = New SpatialFilter
    Set pSFilter.Geometry = pPoint
    pSFilter.SpatialRel = esriSpatialRelWithin
    Set pFCursor = pFClass_jd.Search(pSFilter, True)
    Dim pF As IFeature
    Set pF = pFCursor.NextFeature
    If pF Is Nothing Then
       get_jd = "未明确"
       Exit Function
    End If
    get_jd = pF.Value(pFClass_jd.FindField("名称"))

e:


End Function










Private Function get_qj(pPoint As IPoint) As String
On Error GoTo e
    
    Dim pSFilter As ISpatialFilter
    Dim pFCursor As IFeatureCursor
    Set pSFilter = New SpatialFilter
    Set pSFilter.Geometry = pPoint
    pSFilter.SpatialRel = esriSpatialRelWithin

    Set pFCursor = pFClass_qj.Search(pSFilter, True)
       
    Dim pF As IFeature
    Set pF = pFCursor.NextFeature
    If pF Is Nothing Then
       get_qj = "未明确"
       Exit Function
    End If
    get_qj = pF.Value(pFClass_qj.FindField("名称"))

e:


End Function



Public Function getlayername(yearid As Integer) As String
On Error GoTo e
Dim str As String
Dim midstr As String
str = ""
Dim lenstr As Integer
lenstr = Len(CStr(yearid))
Dim j As Integer
For i = 1 To lenstr
  midstr = Mid(CStr(yearid), i, 1)
  j = CInt(midstr)
  If j = 0 Then
     str = str & "零"
  ElseIf j = 1 Then
     str = str & "一"
  ElseIf j = 2 Then
     str = str & "二"
  ElseIf j = 3 Then
     str = str & "三"
  ElseIf j = 4 Then
     str = str & "四"
  ElseIf j = 5 Then
     str = str & "五"
  ElseIf j = 6 Then
     str = str & "六"
  ElseIf j = 7 Then
     str = str & "七"
  ElseIf j = 8 Then
     str = str & "八"
  ElseIf j = 9 Then
     str = str & "九"
  End If
Next i
If Len(str) = 4 Then
   getlayername = str & "年信访事件"
Else
   getlayername = ""
End If
Exit Function
e:
getlayername = ""
End Function




Public Function getsdeWorkspace() As IWorkspace 'sde

    Dim strServer As String
    Dim strInstance As String
    Dim strDatabase As String
    Dim strUser As String
    Dim strPassword As String
    Dim strVersion As String
    Dim strDataPath As String
    Dim strPath As String
    
    strPath = App.Path & "\config.ini"
     strServer = GetProfile(strPath, "sde", "ServerName")
    strInstance = GetProfile(strPath, "sde", "instance")
    strDatabase = GetProfile(strPath, "sde", "DatabaseName")
    strUser = GetProfile(strPath, "sde", "UserName")
    strPassword = GetProfile(strPath, "sde", "Password")
    strVersion = "SDE.DEFAULT"
    
    
    Set getsdeWorkspace = OpenSDEWorkspace(strServer, strInstance, strDatabase, strUser, strPassword, strVersion)
    
    
End Function

Public Function getConnection() As ADODB.Connection 'sde
  Dim ServerName As String
    Dim password As String
    Dim DatabaseName As String
    Dim username As String
    Dim strPath As String
    
    strPath = App.Path & "\config.ini"
    ServerName = GetProfile(strPath, "database", "ServerName")
    DatabaseName = GetProfile(strPath, "database", "DatabaseName")
    username = GetProfile(strPath, "database", "UserName")
    password = GetProfile(strPath, "database", "Password")
    
    
    Set getConnection = openoracleServer(username, password, ServerName)
    
    
    
    
End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub


Private Function getwz(address As String) As String

If address = "" Then
    getwz = "未明确"
    Exit Function
End If

If InStr(address, "上海市") Then
    getwz = "上海"
    Exit Function
End If

If Not InStr(address, "上海") Then
    If InStr(address, "省") Then
        getwz = "外省"
        Exit Function
    End If
End If

getwz = "未明确"

End Function