modcomputeavgctvalue.bas

1、以DLL形式提供医生工作站 2、 根据【检查项目】

Attribute VB_Name = "modComputeAvgCTValue"
Option Explicit






'绘制椭圆
Public Function DrawEllipse(ByVal hDC As Long, ByVal x1 As Long, ByVal y1 As Long, _
    ByVal x2 As Long, ByVal y2 As Long)
    
    On Error GoTo ErrHandler
    Dim bRet As Boolean
    Dim oldPoint As POINTAPI
    Dim hPen As Long
    hPen = CreatePen(PS_DOT, 1, RGB(0, 255, 0))
    Dim nRet As Long
    nRet = SelectObject(hDC, hPen)
    
    Dim oldPt As POINTAPI
    
    Call Arc(hDC, x1, y1, x2, y2, x1, (y1 + y2) / 2, x2, (y1 + y2) / 2)
    Call Arc(hDC, x2, y2, x1, y1, x2, (y1 + y2) / 2, x1, (y1 + y2) / 2)
    
    Exit Function
ErrHandler:
    
End Function




Public Function Red(ByVal mlColor As Long) As Long
    Red = mlColor And &HFF
End Function



Public Function DrawRectangle(hDC As Long, x1 As Long, y1 As Long, x2 As Long, y2 As Long)
    On Error GoTo ErrHandler
    Dim bRet As Boolean
    Dim oldPoint As POINTAPI
    Dim hPen As Long
    hPen = CreatePen(PS_DOT, 2, RGB(255, 0, 0))
    Dim nRet As Long
    nRet = SelectObject(hDC, hPen)

    Dim ptDcmEnd As POINTAPI
    Call GetCursorPos(ptDcmEnd)

    'ptDcmEnd.X = ScaleX(ptDcmEnd.X, vbPixels, vbTwips)
    'ptDcmEnd.Y = ScaleX(ptDcmEnd.Y, vbPixels, vbTwips)
    '
    'Dim nLeft As Long, nRight As Long, nTop As Long, nBottom As Long
    '
    
    'bRet = Rectangle(hDCDcmX, nLeft, nTop, g_picX2 - dcmTest.left, g_picY2)

    
    
    
    'ptDcmEnd.X = ptDcmEnd.X - Me.ScaleX((Me.left + Me.dcmTest.left), vbTwips, vbPixels)
    'ptDcmEnd.Y = ptDcmEnd.Y - Me.ScaleY((Me.top + Me.dcmTest.top), vbTwips, vbPixels)
    'nLeft = ptDcmEnd.X - Me.ScaleX(Me.dcmTest.left, vbTwips, vbPixels) - (g_picX2 - g_picX1)
    'nTop = ptDcmEnd.Y - Me.ScaleY(Me.dcmTest.top, vbTwips, vbPixels) - (g_picY2 - g_picY1)
    '
    ' nLeft = ptDcmEnd.X - (g_picX2 - g_picX1)
    'nTop = ptDcmEnd.Y - (g_picY2 - g_picY1)

    

    'bRet = Rectangle(hDCDcmX, nLeft, nTop, ptDcmEnd.X, ptDcmEnd.Y)

    Exit Function
ErrHandler:
    
End Function




'将DCM图片进行初始化
Public Function InitDcm(ByRef dcmPara As DICOMX) As Boolean
On Error GoTo ErrHandler
    Dim dcm As New DcmInit
    dcmPara.LicenseCode = dcm.MyDcmInit()
    
    InitDcm = True
    Exit Function
ErrHandler:
    InitDcm = False
    Debug.Print Err.Description
End Function





'测试当前光标是否在椭圆区域内
Public Function MyPtInRectEllipse(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Boolean
    On Error GoTo ErrHandler
    
    Dim hRgnOva As Long
    hRgnOva = CreateEllipticRgn(x1, y1, x2, y2)
    Dim bRet As Boolean
    
    Dim ptNow As POINTAPI
    GetCursorPos ptNow
    
    MyPtInRectEllipse = PtInRegion(hRgnOva, ptNow.X, ptNow.Y)
    
    DeleteObject hRgnOva
    
    Exit Function
ErrHandler:
    MyPtInRectEllipse = False
    
End Function






Public Function ComputeAvgCTValue(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, _
    ByVal p_dcm As DICOMX, ByRef p_nAvgCTValue As Long, ByRef p_nPixelCount As Long, ByRef p_strErr As String)

On Error GoTo ErrHandler
        Dim i As Long, j As Long
        Dim nSumCTValue As Long, nSumNumber As Long
    
        nSumCTValue = 0
        nSumNumber = 0
    
        '椭圆方程(ax)^2 + (by)^2 = r^2
        '椭圆的原点
        Dim ptOrigin As POINTAPI
        ptOrigin.X = (x1 + x2) / 2
        ptOrigin.Y = (y1 + y2) / 2
    
        '椭圆的半径, a为横向半径, b为纵向半径
        Dim a As Long, b As Long
        p_nAvgCTValue = 0
        p_nPixelCount = 0
        
        nSumCTValue = 0
        nSumNumber = 0
        a = (Abs(x1 - x2)) / 2
        b = (Abs(y1 - y2)) / 2
    
        For i = x1 To x2
            For j = y1 To y2
                If ((b * b) * (i - ptOrigin.X) * (i - ptOrigin.X)) + ((a * a) * (j - ptOrigin.Y) * (j - ptOrigin.Y)) <= (a * a) * (b * b) Then
                    nSumCTValue = nSumCTValue + p_dcm.ImageGetCTValue(i, j)
                    nSumNumber = nSumNumber + 1
                End If
            Next
        Next
    
        If nSumNumber > 0 Then
            p_nAvgCTValue = Round(nSumCTValue / nSumNumber)
        End If
        p_nPixelCount = nSumNumber
    Exit Function
ErrHandler:
    p_nAvgCTValue = 0
    p_nPixelCount = 0
    
    p_strErr = Err.Description
End Function