mdrawgraphic.bas

地面测试仪

Attribute VB_Name = "mDrawGraphic"
'绘图模块
'打印绘图
Option Base 1
Option Explicit
Const YtTiTle = "地面测试仪曲线图"
Const RepTitle = "地面测试仪数据报表"
Const DataRepTitle = "地面测试仪数据报表"

Const YmColor = &HFF00FF
Const TyColor = &HFF00
Const JpColor = &HFF00

Private repHead(34) As String

Public Const ytx = 0.1
Public Const ytw = 0.8
Public Const yty = 0.94
Public Const yth = 0.8

Private Sub setHead() '标题
'**********************************************************************
'* 函数名称:setHead
'* 函数描述:设置报表头
'* 参数列表:
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
        repHead(1) = "井    号": repHead(2) = "测压类别": repHead(3) = "仪器类别": repHead(4) = "仪 器 号": repHead(5) = "测  压  时  间"
        repHead(6) = "示 功 仪": repHead(7) = "自动监测仪": repHead(8) = "": repHead(9) = ""
        repHead(10) = "项    目": repHead(11) = "开    井": repHead(12) = "测动液面": repHead(13) = "关    井": repHead(14) = "测试完毕": repHead(15) = "起      抽"
        repHead(16) = "时间(h:min)": repHead(17) = "油压( Mpa )": repHead(18) = "套压( Mpa )"
        repHead(19) = "产液量(t/d)": repHead(20) = "含水( % )": repHead(21) = "冲程( m )": repHead(22) = "冲次(次/分)": repHead(23) = "泵深( m )"
        repHead(24) = "泵径( mm )": repHead(25) = "饱和压力(Mpa)": repHead(26) = "时标( s )": repHead(27) = "备    注:   "
        repHead(28) = "测试单位:": repHead(29) = "测 量 人:": repHead(30) = "审 核 人:": repHead(31) = "解释人:": repHead(32) = "解释日期:"
        repHead(33) = "保存单位:   各测试大队": repHead(34) = "保存期限:    三年"
End Sub

'画液面套压
Function drawYt(pic As Object, Optional ytFlag = 2, Optional drawtitle = False)
'**********************************************************************
'* 函数名称: drawYt
'* 函数描述: 画液面套压
'* 参数列表: pic画图控件 ytFlag绘哪个曲线 0液面1套压2全部
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim i As Integer, j As Integer
Dim strTemp As String
Dim OldColer As Long '颜色
Dim oldFont As Long
Dim bx As Single, byy As Single, bty As Single
Dim curx As Single, curY As Single, curWidth As Single, curHeight As Single '绘图区域
Dim x1 As Single, x2 As Single, y1 As Single, y2 As Single
Dim DrawCircle As Boolean
'打印标题
If drawtitle Then
    oldFont = pic.FontSize
    pic.FontSize = 12
    pic.CurrentX = (pic.Width - pic.TextWidth(YtTiTle)) / 2
    pic.CurrentY = (pic.Height * 0.14 - pic.TextHeight(YtTiTle)) / 2
    pic.Print YtTiTle
    pic.FontSize = oldFont
Else
    
End If

'绘图
'画框
curx = pic.Width * ytx
curY = pic.Height * yty
curWidth = pic.Width * ytw
curHeight = pic.Height * yth

pic.CurrentX = curx
pic.CurrentY = curY

pic.Line -(curx, curY - curHeight), YmColor
pic.Line -(curx + curWidth, curY - curHeight)
pic.Line -(curx + curWidth, curY), TyColor
pic.Line -(curx, curY)

If ytFlag = 0 Or ytFlag = 2 Then
    strTemp = "液面"
    pic.CurrentX = curx - pic.TextWidth(strTemp) / 2
    pic.CurrentY = curY - curHeight - pic.TextHeight(strTemp) * 1.5
    pic.Print strTemp
    
End If
If ytFlag = 1 Or ytFlag = 2 Then
    strTemp = "套压"
    pic.CurrentX = curx + curWidth - pic.TextWidth(strTemp) / 2
    pic.CurrentY = curY - curHeight - pic.TextHeight(strTemp) * 1.5
    pic.Print strTemp
End If

'画刻度
pic.DrawStyle = 2
For i = 1 To 4
    pic.Line (curx, curY - curHeight / 5 * i)-(curx + curWidth, curY - curHeight / 5 * i)
    pic.Line (curx + curWidth / 5 * i, curY - curHeight)-(curx + curWidth / 5 * i, curY)
Next
'原点
pic.CurrentX = curx - pic.TextHeight("0") / 2
pic.CurrentY = curY
pic.Print "0"

For i = 1 To 5
    strTemp = (TempDmyData.TimeMax / 5) * i \ 3600 & ":" & Int((TempDmyData.TimeMax / 5) * i Mod 3600) \ 60 & ":" & (TempDmyData.TimeMax / 5) * i Mod 60 & "h"
    pic.CurrentX = (curx + curWidth / 5 * i) - pic.TextWidth(strTemp) / 2
    pic.CurrentY = curY
    pic.Print strTemp
    If ytFlag = 0 Or ytFlag = 2 Then
        strTemp = Format(TempDmyData.YNoodlesMax * i / 5, "0")
        pic.CurrentX = curx - pic.TextWidth(CStr(TempDmyData.YNoodlesMax)) / 2
        pic.CurrentY = curY - curHeight / 5 * i - pic.TextHeight(strTemp) / 2
        pic.Print strTemp
        
    End If
    If ytFlag = 1 Or ytFlag = 2 Then
        strTemp = Format(TempDmyData.TPressMax * i / 5, "0.00")
        pic.CurrentX = curx + curWidth
        pic.CurrentY = curY - curHeight / 5 * i - pic.TextHeight(strTemp) / 2
        pic.Print strTemp
    End If
Next


bx = curWidth / TempDmyData.TimeMax 'x轴比例
byy = curHeight / TempDmyData.YNoodlesMax '液面比例
bty = curHeight / TempDmyData.TPressMax  '套压比例


pic.DrawStyle = 0

TempDmyData.dmyYT(1, 4) = curx + TempDmyData.dmyYT(1, 1) * bx


For i = 2 To UBound(TempDmyData.dmyYT())
    x1 = curx + TempDmyData.dmyYT(i - 1, 1) * bx
    x2 = curx + TempDmyData.dmyYT(i, 1) * bx
    TempDmyData.dmyYT(i, 4) = curx + TempDmyData.dmyYT(i, 1) * bx
    '液面
    If ytFlag = 0 Or ytFlag = 2 Then
        y1 = curY - TempDmyData.dmyYT(i - 1, 2) * byy
        y2 = curY - TempDmyData.dmyYT(i, 2) * byy
        
        pic.Line (x1, y1)-(x2, y2), YmColor
      
    End If
    '套压
    If ytFlag = 1 Or ytFlag = 2 Then
        y1 = curY - TempDmyData.dmyYT(i - 1, 3) * bty
        y2 = curY - TempDmyData.dmyYT(i, 3) * bty
        
        pic.Line (x1, y1)-(x2, y2), TyColor
    End If
Next

End Function

'画高低频
Function drawFrequency(pic As PictureBox, Optional piontNum = 1, Optional disPlay = True, Optional disPiont = -1)
'**********************************************************************
'* 函数名称: drawFrequency
'* 函数描述: 画高低频
'* 参数列表: pic画图控件,piontNum开始点,disPlay(true显示false打印)
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim rowNum As Integer '行数 每页4行
Dim tempPiont As Integer
Dim strTemp As String
Dim curx As Single, curY As Single, curWidth As Single, curHeight As Single '绘图区域
Dim x1 As Single, x2 As Single, y1 As Single, y2 As Single
Dim bx As Single, byh As Single, byl As Single
Dim i As Integer, j As Integer
If disPlay Then '显示pic
   rowNum = 1
   curx = 0
   curWidth = pic.Width
   curY = pic.Height * 0.9
   curHeight = pic.Height * 0.8
   
   If disPiont = -1 Then
        tempPiont = IIf(UBound(TempDmyData.dmyHL) - piontNum >= TempDmyData.HLRowPiont, TempDmyData.HLRowPiont, UBound(TempDmyData.dmyHL) - piontNum)
   Else
        tempPiont = disPiont - 1
   End If
   
Else '打印
    pic.FontSize = 12
    rowNum = (piontNum \ TempDmyData.HLRowPiont) + 1
    curx = 0
    curWidth = pic.Width
    curY = pic.Height * 0.08 + (pic.Height * 0.9 \ HLRowCount) * rowNum
    curHeight = pic.Height * 0.9 \ HLRowCount
    '表头
    If rowNum = 1 Then
        
        strTemp = "井号:" & TempDmyData.dmyHead(1) & " 日期:" & TempDmyData.dmyHead(2) & " 时间:" & TempDmyData.dmyHead(3) & " 声速:" & TempDmyData.dmyHead(7) & "m/s 液面深:" & TempDmyData.dmyHead(5) & "m"
        pic.CurrentX = (pic.Width - pic.TextWidth(strTemp)) / 2
        pic.CurrentY = (pic.Height * 0.06 - pic.TextHeight(strTemp)) / 2
        pic.Print strTemp
        
    End If
    pic.FontSize = 9
    tempPiont = IIf(UBound(TempDmyData.dmyHL) - piontNum >= TempDmyData.HLRowPiont, TempDmyData.HLRowPiont, UBound(TempDmyData.dmyHL) - piontNum)

End If


    

pic.Line (curx, curY)-(curWidth, curY)
'画高低频分界线
pic.Line (curx, curY - curHeight / 2)-(curWidth, curY - curHeight / 2)

pic.Line (curx, curY - curHeight)-(curWidth, curY - curHeight)
'画时间坐标轴
pic.DrawWidth = 2
For i = 0 To 10
    pic.CurrentX = curx + i * (curWidth / 10)
    pic.CurrentY = curY
    pic.Line -(curx + i * (curWidth / 10), curY - pic.TextHeight("高") / 2)
    
    strTemp = Format(((piontNum - 1) + i * (tempPiont / 10)) * 2, "#0")
    
    pic.CurrentY = curY
    Select Case i
    Case 0
        pic.CurrentX = (curx + i * (curWidth / 10))
    Case 10
        strTemp = "ms " 'strTemp & "ms "
        pic.CurrentX = (curx + i * (curWidth / 10)) - pic.TextWidth(strTemp)
    Case Else
        pic.CurrentX = (curx + i * (curWidth / 10)) - pic.TextWidth(strTemp) / 2
    End Select
    pic.Print strTemp
Next i
'画高低频曲线
bx = curWidth / tempPiont
byh = (curHeight / 2) / TempDmyData.HFrequencyMax
byl = (curHeight / 2) / TempDmyData.LFrequencyMax
j = 1
TempDmyData.dmyHL(piontNum, 3) = curx
For i = piontNum + 1 To piontNum + tempPiont
    
    x1 = curx + (j - 1) * bx
    x2 = curx + j * bx
    
    y1 = (curY - curHeight / 2) - TempDmyData.dmyHL(i - 1, 1) * byh
    y2 = (curY - curHeight / 2) - TempDmyData.dmyHL(i, 1) * byh
    pic.Line (x1, y1)-(x2, y2), vbBlue
    
    y1 = curY - TempDmyData.dmyHL(i - 1, 2) * byl
    y2 = curY - TempDmyData.dmyHL(i, 2) * byl
    pic.Line (x1, y1)-(x2, y2), vbRed
    TempDmyData.dmyHL(i, 3) = x2
    j = j + 1
Next

pic.DrawWidth = 1
End Function

'画静压
Function drawJp(pic As Object, Optional drawtitle = False)
'**********************************************************************
'* 函数名称: drawJp
'* 函数描述: 画静压图
'* 参数列表: pic画图控件,drawTitle是否绘标题
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim i As Integer, j As Integer
Dim strTemp As String
Dim oldFont As Long
Dim bx As Single, by As Single
Dim curx As Single, curY As Single, curWidth As Single, curHeight As Single '绘图区域
Dim x1 As Single, x2 As Single, y1 As Single, y2 As Single
'标题

pic.DrawWidth = 2
curx = pic.Width * 0.1
curY = pic.Height * 0.84
curWidth = pic.Width * 0.8
curHeight = pic.Height * 0.7
'----------------------------------------------------
oldFont = pic.FontSize
If drawtitle Then
    strTemp = "井    号:" & TempDmyData.dmyHead(1) & "日    期:" & TempDmyData.dmyHead(2) & "时    间:" & TempDmyData.dmyHead(3)
    
    pic.FontSize = 12
    pic.CurrentX = (pic.Width - pic.TextWidth(strTemp)) / 2
    pic.CurrentY = (pic.Height * 0.14 - pic.TextHeight(strTemp)) / 2
    pic.Print strTemp
End If

strTemp = "时间压力图"
pic.CurrentX = (pic.Width - pic.TextWidth(strTemp)) / 2
pic.CurrentY = curY + pic.TextHeight(strTemp) * 1.5
pic.Print strTemp
pic.FontSize = oldFont

'画框
pic.CurrentX = curx
pic.CurrentY = curY

pic.Line -(curx, curY - curHeight)
pic.Line -(curx + curWidth, curY - curHeight)
pic.Line -(curx + curWidth, curY)
pic.Line -(curx, curY)

pic.DrawStyle = 2
pic.DrawWidth = 1
For i = 1 To 4
    pic.Line (curx, curY - curHeight / 5 * i)-(curx + curWidth, curY - curHeight / 5 * i)
    pic.Line (curx + curWidth / 5 * i, curY - curHeight)-(curx + curWidth / 5 * i, curY)
Next
'原点
pic.CurrentX = curx - pic.TextHeight("0") / 2
pic.CurrentY = curY
pic.Print "0"

For i = 1 To 5
    strTemp = (TempDmyData.TimeMax \ 5) * i \ 3600
    pic.CurrentX = (curx + curWidth / 5 * i) - pic.TextWidth(strTemp) / 2