VERSION 5.00
Object = "{5A187E03-1FE4-11D3-9C2F-000021DF30C1}#1.0#0"; "EditView.ocx"
Object = "{24075224-9523-41F5-B041-AF891E546822}#1.0#0"; "GisAttEdit.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin GISATTEDITLib.GisAttEdit GisAttEdit 
      Height          =   615
      Left            =   480
      TabIndex        =   1
      Top             =   2520
      Width           =   3735
      _Version        =   65536
      _ExtentX        =   6588
      _ExtentY        =   1085
      _StockProps     =   0
   End
   Begin EDITVIEWLib.EditView EditView 
      Height          =   2295
      Left            =   480
      TabIndex        =   0
      Top             =   0
      Width           =   3735
      _Version        =   65536
      _ExtentX        =   6588
      _ExtentY        =   4048
      _StockProps     =   0
   End
   Begin VB.Menu mnuOpen 
      Caption         =   "打開文件"
   End
   Begin VB.Menu mnuRectAsk 
      Caption         =   "拉框取圖元"
   End
   Begin VB.Menu mnuCancel 
      Caption         =   "取消操作"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'簡單起見，用區工作區取代工程(其實是一樣的)
Dim area As RegArea

'拉框查詢圖元標志
Dim bRectAsk As Boolean

'左鍵按下標志
Dim bLeftDown As Boolean

'瀏覽、編輯的屬性是否為記錄集標志
Dim bAttIsRcdSt As Boolean

'確定畫異或矩形時該矩形兩個角的設備坐標
Dim x1 As Variant
Dim y1 As Variant
Dim x2 As Variant
Dim y2 As Variant

'畫異或矩形時保存本次的坐標位置，下一次用異或線擦掉(設備坐標)
Dim lastX As Variant
Dim lastY As Variant

Dim lst As IDList           '返回查詢實體號

Dim pdc As MapGisDC

Private Sub EditView_CurAttElement(ByVal lNo As Long)
    If Not bAttIsRcdSt Then
        GisAttEdit.GotoAtt lNo
    Else
        GisAttEdit.GotoAtt SemiSearch(0, lst.Count - 1, lNo) + 1
        'GisAttEdit.GotoAtt lNo
    End If
End Sub

Private Sub EditView_MouseLButtonDown(ByVal xPos As Double, ByVal yPos As Double)
    Dim lastmode As Long
    
    If bRectAsk Then
        bLeftDown = True
        
        lastmode = pdc.SetPenMode(7)
        
        pdc.LpToDp xPos, yPos, x1, y1
        
        lastX = x1
        lastY = y1
        
        pdc.RectXY x1, y1, lastX, lastY, EditView.BackgroundColor
        
        Call pdc.SetPenMode(lastmode)
    End If
End Sub

Private Sub EditView_MouseLButtonUp(ByVal xPos As Double, ByVal yPos As Double)
    Dim rc As New D_Rect        '最后形成的查詢矩形
    
    Dim myQuery As New Query    '查詢對象
    
    Dim rcd As Record           '
    
    Dim rcdst As New Recordset  '記錄集
    
    Dim i As Long
    
    Dim flg As Integer
    
    Dim lX1 As Variant
    Dim lY1 As Variant
    Dim lX2 As Variant
    Dim lY2 As Variant
    
    Dim lastmode As Long
    
    If bRectAsk And bLeftDown Then
        bLeftDown = False
        bRectAsk = False
        
        '將畫筆設置為“異或”
        lastmode = pdc.SetPenMode(7)    '7 代表異或
        
        '用“異或”矩形擦掉最后一次畫的矩形
        '即最后左鍵彈起時矩形消失
        pdc.RectXY x1, y1, lastX, lastY, EditView.BackgroundColor
                
        '將畫筆設置為原來的值，便于以后系統對畫筆的調用
        Call pdc.SetPenMode(lastmode)
            
        '將 x1,y1,x2,y2 轉成邏輯坐標
        EditView.DpToLp CLng(x1), CLng(y1), lX1, lY1
        EditView.DpToLp CLng(x2), CLng(y2), lX2, lY2
        
        '形成查詢矩形
        If lX1 < lX2 Then
            rc.xmin = lX1
            rc.xmax = lX2
        Else
            rc.xmax = lX1
            rc.xmin = lX2
        End If
        
        If lY1 < lY2 Then
            rc.ymin = lY1
            rc.ymax = lY2
        Else
            rc.ymax = lY1
            rc.ymin = lY2
        End If
        
        '調用查詢
        myQuery.sourceArea = area
        
        Set lst = myQuery.RectAskToList(gisREG_ENTITY, rc)
            
        For i = 0 To lst.Count - 1
            flg = area.RegAtt.Get(lst(i), rcd)
            
            If flg > 0 Then
                rcdst.Append rcd
            End If
        Next
            
        GisAttEdit.DetachArea
        GisAttEdit.DetachRcds
        
        If rcdst.numbrecord > 0 Then
            GisAttEdit.AttachRcds rcdst     '屬性控件綁定記錄集
        
            bAttIsRcdSt = True
        
            '拉框后馬上閃爍記錄集中第一條記錄對應的實體
            EditView.GotoElement area, lst(0), gisREG_ENTITY
        End If
    End If
    
    Set rcdst = Nothing
    Set myQuery = Nothing
    Set rc = Nothing
End Sub

Private Sub EditView_MousePosition(ByVal x_Pos As Double, ByVal y_Pos As Double)
    Dim lastmode As Long
    
    If bRectAsk And bLeftDown Then
        pdc.LpToDp x_Pos, y_Pos, x2, y2
        
        '將畫筆設置為“異或”
        lastmode = pdc.SetPenMode(7)    '7 代表異或
        
        '先用“異或”矩形擦掉上一次畫的矩形
        pdc.RectXY x1, y1, lastX, lastY, EditView.BackgroundColor
        
        '畫出新的矩形
        pdc.RectXY x1, y1, x2, y2, EditView.BackgroundColor
        
        '記錄這一次矩形的位置
        lastX = x2
        lastY = y2
        
        '將畫筆設置為原來的值，便于以后系統對畫筆的調用
        Call pdc.SetPenMode(lastmode)
    End If
End Sub

Private Sub EditView_MouseRButtonUp(ByVal xPos As Double, ByVal yPos As Double)
'    mnuCancel_Click
End Sub

Private Sub Form_Load()
    Set area = New RegArea
    
    EditView.DspBigCross = False    '不顯示大十字光標
    EditView.PopMenuControl = 1     '控制彈出菜單
    
    bRectAsk = False
    bLeftDown = False
    bAttIsRcdSt = False
End Sub

Private Sub Form_Resize()
    EditView.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight * 2 / 3
    GisAttEdit.Move 0, EditView.Height, Me.ScaleWidth, Me.ScaleHeight - EditView.Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set area = Nothing
End Sub

Private Sub GisAttEdit_CurRcdFldNo(ByVal rcdNo As Long, ByVal fldNo As Integer)
    If Not bAttIsRcdSt Then
        EditView.GotoElement area, rcdNo, gisREG_ENTITY
    Else
        EditView.GotoElement area, lst(rcdNo - 1), gisREG_ENTITY
    End If
End Sub

Private Sub mnuCancel_Click()
    EditView.CancelOperation
    bRectAsk = False
    bAttIsRcdSt = False
    GisAttEdit.AttachArea area, gisREG_ENTITY
End Sub

Private Sub mnuOpen_Click()
    area.Load
    EditView.RegArea = area
    EditView.LinkAttSwitch = True
    EditView.AttachAttWorkArea area, gisREG_ENTITY
    GisAttEdit.AttachArea area, gisREG_ENTITY
End Sub

'拉框取圖元
Private Sub mnuRectAsk_Click()
    bRectAsk = True         '鼠標事件判斷此標志作出響應
    
    Set pdc = EditView.pMapGisDC
    
    '準備拉框，停止閃爍當前圖元
    EditView.StopFlash
End Sub


'折半查找
Private Function SemiSearch(pStart As Long, pEnd As Long, lNo As Long) As Long
    Dim pMid As Long
    Dim rtl As Long
    
    If pEnd - pStart <= 1 Then
        If lst(pStart) = lNo Then
            rtl = pStart
        ElseIf lst(pEnd) = lNo Then
            rtl = pEnd
        Else
            rtl = -1
        End If
    Else
        pMid = (pStart + pEnd) / 2
        
        If lst(pMid) < lNo Then
            rtl = SemiSearch(pMid, pEnd, lNo)
        ElseIf lst(pMid) > lNo Then
            rtl = SemiSearch(pStart, pMid, lNo)
        Else
            rtl = pMid
        End If
    End If
    
    SemiSearch = rtl
End Function