frmmain1.frm

地面测试仪

't = PicMain.LinkTimeout
'PicMain.LinkTimeout = 1     ' |______终止DDE通道。当然，也可以用别的方法
'PicMain.LinkMode = 0        '这里用的是超时强制终止的方法
'PicMain.LinkTimeout = t     '
End Sub



Private Sub Form_Resize()
ResizeForm Me
ResizeRep
setTitle
SSTab1_Click 0

End Sub

Private Sub ListDde_GotFocus()
'Debug.Print "ListDde_GotFocus"
End Sub

Private Sub ListDde_ItemClick(ByVal Item As MSComctlLib.ListItem)
If TempDmyData.fileName <> Item.ToolTipText Then FOpenfile Item.ToolTipText

StatusBar1.Panels(1).Text = "文件——" & Item.ToolTipText
End Sub




Private Sub m_v_v_Click(Index As Integer)
SSTab1.Tab = Index
SSTab1_Click Index
End Sub

Private Sub m_w_j_Click()
JianDing
End Sub

Private Sub m_w_print_Click()
FPrintView
End Sub

Private Sub Option1_Click(Index As Integer)
mPic.Cls
drawYt mPic, Index
End Sub

Private Sub PicMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim curX As Single, curY As Single, curWidth As Single, curHeight As Single

If PicFlag = 3 Then
    Line1.BorderWidth = 2
    Line1.BorderColor = vbBlack
    curX = 0
    curWidth = PicMain.Width
    curY = PicMain.Height - PicMain.TextHeight("高") * 1.5
    curHeight = curY
    If X >= curX And X <= curX + curWidth And Y >= (curY - curHeight) And Y <= curY Then
        Line1.Visible = True
        Line1.x1 = X
        Line1.x2 = X
        Line1.y1 = curY - curHeight
        Line1.y2 = curY
        curPiont = xToIndex(X, 3)
        drawPiont curPiont, 3
        
    Else
        Line1.Visible = False
    End If
End If

If PicFlag = 1 Then
    Line1.BorderWidth = 1
    Line1.BorderColor = vbBlue
    curX = PicMain.Width * ytx
    curY = PicMain.Height * yty
    curWidth = PicMain.Width * ytw
    curHeight = PicMain.Height * yth
    
    If X >= curX And X <= curX + curWidth And Y >= (curY - curHeight) And Y <= curY Then
        Line1.Visible = True
        Line1.x1 = X
        Line1.x2 = X
        Line1.y1 = curY - curHeight
        Line1.y2 = curY
        curPiont = xToIndex(X, 1)
        drawPiont curPiont, 1
'        drawmsg X & "----" & PicMain.ScaleWidth & "---" & curHeight
        listData.ListItems(curPiont).Selected = True
        listData.ListItems(curPiont).EnsureVisible
        
    Else
        Line1.Visible = False
    End If
    
End If

End Sub

Private Sub PicMain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim curX As Single, curY As Single, curWidth As Single, curHeight As Single

'If PicFlag = 1 Then
'    Line1.BorderWidth = 1
'    Line1.BorderColor = vbBlue
'    curX = PicMain.Width * ytx
'    curY = PicMain.Height * yty
'    curWidth = PicMain.Width * ytw
'    curHeight = PicMain.Height * yth
'
'    If X >= curX And X <= curX + curWidth And Y >= (curY - curHeight) And Y <= curY Then
'        Line1.Visible = True
'        Line1.x1 = X
'        Line1.x2 = X
'        Line1.y1 = curY - curHeight
'        Line1.y2 = curY
'        curPiont = xToIndex(X, 1)
'        drawPiont curPiont, 1
'        drawmsg X & "----" & PicMain.ScaleWidth & "---" & curHeight
'        listData.ListItems(curPiont).Selected = True
'        listData.ListItems(curPiont).EnsureVisible
'
'    Else
'        Line1.Visible = False
'    End If
'
'End If
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
Dim i As Integer

'清除绘图区
mPic.Cls
picDis.Cls
Line1.Visible = False
'pic置前
If SSTab1.Tab = 3 Then
'    mPic.Visible = False
    mPic.ZOrder 1
Else
'    mPic.Visible = True
    SSTab1.ZOrder 1
End If
 
'设置菜单
For i = 0 To 3
    
    If i = SSTab1.Tab Then
        m_v_v(i).Checked = True
    Else
        m_v_v(i).Checked = False
    End If
Next

If Not TempDmyData.ReadSuc Then Exit Sub

PicFlag = SSTab1.Tab + 1
Command3.Enabled = False
Select Case PicFlag
Case 1 '液面套压
    Option1(2).Value = True
    drawYt mPic
    StatusBar1.Panels(1).Text = "视图——液面套压"
Case 2 '静液面
    drawmsg "注意：需添加正确含水和中深，单击确定，才会显示正确的图像"
    Command3.Enabled = True
    '-----------------------------
    txtHs.Text = TempDmyData.hanshui
    txtZs.Text = TempDmyData.zhongshen
    GetJpress CInt(TempDmyData.zhongshen), CInt(TempDmyData.hanshui)
    drawJp mPic
    '-----------------------------
    StatusBar1.Panels(1).Text = "视图——静压图"
Case 3 '
    If Not TempDmyData.HaveDym Then
        MsgBox "没有高低频数据！！！"
        SSTab1.Tab = PreviousTab
    Else
       HScroll1.Max = UBound(TempDmyData.dmyHL) - TempDmyData.HLRowPiont
'       HScroll1.LargeChange = HScroll1.Max \ 10
       HScroll1.Min = 1
       drawFrequency mPic
       StatusBar1.Panels(1).Text = "视图——动液面"
    End If
Case 4
    drawmsg "注意：报表需保存后打印才会显示，清空会清除报表信息"
    For i = 1 To 35
            
            Text1(i - 1).Text = TempDmyData.dmyRep(i + 2)  'Trim(Text1(i - 1).Text)
     
    Next
    StatusBar1.Panels(1).Text = "视图——报表"
End Select

End Sub

Private Sub SSTab2_Click(PreviousTab As Integer)
Dim i As Integer
For i = 0 To 1
    
    If i = SSTab2.Tab Then
        m_v_d(i).Checked = True
    Else
        m_v_d(i).Checked = False
    End If
Next
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1 'comm
    Fcomm
Case 2
Case 3 'open
    FOpenfile
Case 4 'close
    FClose
Case 5
    FMergeData
    
Case 7
    JianDing
Case 8
    FPrintView
Case 10
    FExit
End Select

End Sub

Private Sub w_tx_Click()
    Fcomm
End Sub
'设置窗体
Sub setForm()
    
    SSTab1.Tab = 0
    SSTab1_Click 0

    If TempDmyData.ReadSuc Then
        SSTab1.Enabled = True
        mPic.Enabled = True
    Else
        mPic.Enabled = False
        SSTab1.Enabled = False
    End If
    StatusBar1.Panels(1).Text = "主界面"
    
    setListData listData
    
    setTitle
End Sub

Sub FPrintView()
 If TempDmyData.ReadSuc Then
    frmPreview.Show 1
Else
    MsgBox "请先打开数据文件！！！"
End If
End Sub

'退出
Sub FExit()
    End
End Sub
'打开文件
Public Sub FOpenfile(Optional fileName As String)
   
    If fileName = "" Then
        mDialog.DialogTitle = "打开数据文件"
        mDialog.Filter = "文件 (*.dmy)|*.dmy"
        mDialog.Flags = cdlOFNFileMustExist
        mDialog.fileName = ""
        mDialog.DefaultExt = "dmy"
        mDialog.InitDir = App.Path 'getdefaultpath_load
        mDialog.ShowOpen
        fileName = Trim(mDialog.fileName)
    End If
    If fileName <> "" Then
        
        addList fileName
        TempDmyData = openFile(fileName)
        Me.Caption = "汇发地面测试仪[" & fileName & "]"
       
    End If
    
    setForm
End Sub

'通讯
Sub Fcomm()
    StatusBar1.Panels(1).Text = "通讯——回放数据"
    FrmComm.Show 1
    StatusBar1.Panels(1).Text = "主界面"
End Sub

'关闭文件
Sub FClose()
    If mList.ListItems.Count > 0 Then
        delList mList.SelectedItem.ToolTipText
        
        If mList.ListItems.Count > 0 Then
            FOpenfile (mList.ListItems(1).ToolTipText)
            setListFocus 1
        Else
            TempDmyData.ReadSuc = False
        End If
    End If
    setForm
End Sub
'合并
Sub FMergeData()
    StatusBar1.Panels(1).Text = "文件——合并文件"
    FrmMerge.Show 1
    StatusBar1.Panels(1).Text = "主界面"
End Sub


'设置表头
Sub setTitle()
    Dim curX As Single, curY As Single, curWidth As Single, curHeight As Single '绘图区域
    Dim rowHeigh As Single, rowWidth As Single
    Dim tempStr(6) As String
    Dim i As Integer, j As Integer
    picTitle.Cls
    curX = picTitle.Width * 0.05
    curWidth = picTitle.Width * 0.9
    curY = picTitle.Height
    curHeight = picTitle.Height
    rowHeigh = curHeight / 2
    rowWidth = curWidth / 3
    
    If TempDmyData.ReadSuc Then
        tempStr(1) = "井    号:" & TempDmyData.dmyHead(1)
        tempStr(2) = "日    期:" & TempDmyData.dmyHead(2)
        tempStr(3) = "时    间:" & TempDmyData.dmyHead(3)
        tempStr(4) = "关井液深:" & TempDmyData.dmyHead(5)
        tempStr(5) = "关井套压:" & TempDmyData.dmyHead(6)
        tempStr(6) = "声    速:" & TempDmyData.dmyHead(7)
    Else
        tempStr(1) = "井    号:"
        tempStr(2) = "日    期:"
        tempStr(3) = "时    间:"
        tempStr(4) = "关井液深:"
        tempStr(5) = "关井套压:"
        tempStr(6) = "声    速:"
    End If
    
    For i = 1 To 3
        For j = 1 To 2
            picTitle.CurrentX = curX + rowWidth * (i - 1)
            picTitle.CurrentY = rowHeigh * (j - 1) + picTitle.TextHeight(tempStr(3 * (j - 1) + i)) / 2
            picTitle.Print tempStr(3 * (j - 1) + i)
        Next
    Next
    
End Sub
Sub drawPiont(sPiont As Long, dFlag As Integer)
Dim curX As Single, curY As Single, curWidth As Single, curHeight As Single '绘图区域
Dim rowHeigh As Single, rowWidth As Single
Dim strTemp(4) As String
Dim i As Integer

picDis.Cls
curX = picDis.Width * 0.05
curWidth = picDis.Width * 0.9
curY = picDis.Height
curHeight = picDis.Height
rowWidth = curWidth / 4

Select Case dFlag
    Case 1
        strTemp(1) = "当前点数:" & sPiont
        strTemp(2) = "液面深度:" & TempDmyData.dmyYT(sPiont, 2)
        strTemp(3) = "套    压:" & TempDmyData.dmyYT(sPiont, 3)
        strTemp(4) = "当前时间:" & Format(DateAdd("s", TempDmyData.dmyYT(sPiont, 1), TempDmyData.dmyHead(3)), "YYYY年MM月DD日 HH:MM")
    Case 3
        strTemp(1) = "当前点数:" & sPiont
        strTemp(2) = ""
        strTemp(3) = "液面深度:" & sPiont / 1000 * CLng(TempDmyData.dmyHead(7))
        strTemp(4) = ""
End Select

For i = 1 To 4
    picDis.CurrentX = curX + rowWidth * (i - 1)
    picDis.CurrentY = rowHeigh + picDis.TextHeight(strTemp(i)) / 2
    picDis.Print strTemp(i)
Next
End Sub

Sub drawmsg(strMsg As String)
Dim curX As Single, curY As Single, curWidth As Single, curHeight As Single '绘图区域
Dim oldColor As Long
picDis.Cls
curX = picDis.Width * 0.05
curWidth = picDis.Width * 0.9
curY = picDis.Height

oldColor = picDis.ForeColor
picDis.ForeColor = vbRed
picDis.CurrentX = curX + (curWidth - picDis.TextWidth(strMsg)) / 2
picDis.CurrentY = (curY - picDis.TextHeight(strMsg)) / 2
picDis.Print strMsg

picDis.ForeColor = oldColor

End Sub



Function xToIndex(sX As Single, dFlag As Integer) As Long
Dim i As Long
If dFlag = 1 Then
    For i = UBound(TempDmyData.dmyYT) To 1 Step -1
        If sX > CSng(TempDmyData.dmyYT(i, 4)) Then
            xToIndex = i
            Exit Function
        Else
'            Debug.Print i
        End If
    Next
End If

If dFlag = 3 Then
'    xToIndex = CLng(sX * TempDmyData.HLRowPiont / PicMain.Width)
    For i = HScroll1.Value + TempDmyData.HLRowPiont - 1 To HScroll1.Value Step -1
        If sX > CSng(TempDmyData.dmyHL(i, 3)) Then
            xToIndex = i
            Exit Function
        End If
    Next
End If
End Function