tcomplex.bas

酒店管理VB源码

Attribute VB_Name = "Complex"
'  复数类型 TComplex
'  复数函数库  作者：侯思松   2003.3.29

'  注意:函数名称中C_Sqr代表平方，C_Sqrt代表开方，不要和VB的函数弄混了

Option Explicit

'复数类型TComplex
Public Type TComplex
    Real  As Double         '复数实部
    Imag  As Double         '复数虚部
End Type
  
Public Const cm_PI As Double = 3.14159265358979  '    {圆周率PI}
Public Const cm_e As Double = 2.71828182845905   '    {自然数e}


' 支持的函数 列表
' Public Function SinH(x As Double) As Double '双曲正弦
' Public Function CosH(x As Double) As Double '双曲余弦
' Public Sub SinHCosH(x As Double, ByRef xSinH As Double, ByRef xCosh As Double) '同时算出SinH和CosH
' Public Sub SinCos(x As Double, ByRef xSin As Double, ByRef xCos As Double) ' 同时算出Sin和Cos
' Public Function ArcTan2(y As Double, x As Double) As Double ' 全角度反正切(值域-PI到PI)

' Public Function C_CreateTComplex(x As Double, y As Double) As TComplex ' 产生一个复数
' Public Function C_CreateTComplexR(R As Double, Arg As Double) As TComplex  '用半径和复角产生一个复数

' Public Function C_Add(Z1 As TComplex, Z2 As TComplex) As TComplex ' 复数加法
' Public Function C_Sub(Z1 As TComplex, Z2 As TComplex) As TComplex ' 复数减法
' Public Function C_Mul(Z1 As TComplex, Z2 As TComplex) As TComplex ' 复数乘法
' Public Function C_Div(Z1 As TComplex, Z2 As TComplex) As TComplex ' 复数除法

' Public Function C_Abs(Z1 As TComplex) As TComplex     ' |Z|
' Public Function C_AbsSqr(Z1 As TComplex) As TComplex  ' |Z|^2
' Public Function C_AbsA(Z1 As TComplex) As TComplex    ' Z.Real:=abs(Z1.Real);Z.Imag:=abs(Z1.Imag)
' Public Function C_Floor(Z1 As TComplex) As TComplex   ' Z:=Floor(Z1)    {取整，小于x的最大整数}
' Public Function C_Trunc(Z1 As TComplex) As TComplex   ' Z:=Trunc(Z1)    {向零取整，即截断}
' Public Function C_Round(Z1 As TComplex) As TComplex   ' Z:=Round(Z1)    {四舍五入到整数}
' Public Function C_Distance(Z1 As TComplex, Z2 As TComplex) As TComplex  ' Z.Real:=|Z1-Z2|,Z.Imag:=0
' Public Function C_IsEqual(Z1 As TComplex, Z2 As TComplex, Error As Double) As Boolean ' {是否相等}
' Public Function C_Zero() As TComplex    ' 返回 0+0*i
' Public Function C_Imag1() As TComplex   ' 返回 0+1*i
' Public Function C_Unity(Z1 As TComplex) As TComplex  '  Z:=Z1/|Z1|    {归一化 }
' Public Function C_Conj(Z1 As TComplex) As TComplex   '  共轭
' Public Function C_Flip(Z1 As TComplex) As TComplex   '  虚部实部交换
' Public Function C_Rev(Z1 As TComplex) As TComplex    '  Z:=1/Z1       {倒数}
' Public Function C_Sgn(Z1 As TComplex) As TComplex    '  Z:=Sgn(Z1)      {求符号}
' Public Sub C_Xchg(ByRef Z1 As TComplex, ByRef Z2 As TComplex) '  {交换值}
' Public Function C_Chs(Z1 As TComplex) As TComplex   ' Z:=-Z1  求负

' Public Function C_sqr(Z1 As TComplex) As TComplex   ' 求复数平方 Z1*Z1
' Public Function C_Sqr3(Z1 As TComplex) As TComplex  ' 立方  Z1*Z1*Z1
' Public Function C_Sqr4(Z1 As TComplex) As TComplex  ' 四次方 Z1*Z1*Z1*Z1
' Public Function C_Power(Z1 As TComplex, Z2 As TComplex) As TComplex ' Z:=Z1^Z2  指数函数 Z1的Z2次方
' Public Function C_Sqrt(Z1 As TComplex) As TComplex  ' 开方 Z:=Z1^0.5
' Public Function C_Exp(Z1 As TComplex) As TComplex   ' Z:=Exp(Z1) {e^Z1}
' Public Function C_Ln(Z1 As TComplex) As TComplex    ' Z:=Ln(Z1)  自然对数
' Public Function C_Log2(Z1 As TComplex) As TComplex  ' 2的对数
' Public Function C_Log10(Z1 As TComplex) As TComplex ' 10的对数

' Public Function C_Sin(Z1 As TComplex) As TComplex   ' 复数正弦
' Public Function C_Cos(Z1 As TComplex) As TComplex   ' 复数余弦
' Public Function C_Tan(Z1 As TComplex) As TComplex   ' 复数正切
' Public Function C_Cot(Z1 As TComplex) As TComplex   ' 复数余切
' Public Function C_Csc(Z1 As TComplex) As TComplex   ' 复数余割
' Public Function C_Sec(Z1 As TComplex) As TComplex   ' 复数正割
' Public Function C_SinH(Z1 As TComplex) As TComplex  ' 复数双曲正弦
' Public Function C_CosH(Z1 As TComplex) As TComplex  ' 复数双曲余弦
' Public Function C_TanH(Z1 As TComplex) As TComplex  ' 复数双曲正切
' Public Function C_CotH(Z1 As TComplex) As TComplex  ' 复数双曲余切
' Public Function C_CscH(Z1 As TComplex) As TComplex  ' 复数双曲余割
' Public Function C_SecH(Z1 As TComplex) As TComplex  ' 复数双曲正割
' Public Function C_ArcSin(Z1 As TComplex) As TComplex   ' 复数反正弦
' Public Function C_ArcCos(Z1 As TComplex) As TComplex   ' 复数反余弦
' Public Function C_ArcTan(Z1 As TComplex) As TComplex   ' 复数反正切
' Public Function C_ArcCot(Z1 As TComplex) As TComplex   ' 复数反余切
' Public Function C_ArcCsc(Z1 As TComplex) As TComplex   ' 复数反余割
' Public Function C_ArcSec(Z1 As TComplex) As TComplex   ' 复数反正割
' Public Function C_ArcSinh(Z1 As TComplex) As TComplex  ' 复数反双曲正弦
' Public Function C_ArcCosh(Z1 As TComplex) As TComplex  ' 复数反双曲余弦
' Public Function C_ArcTanh(Z1 As TComplex) As TComplex  ' 复数反双曲正切
' Public Function C_ArcCoth(Z1 As TComplex) As TComplex  ' 复数反双曲余切
' Public Function C_ArcCsch(Z1 As TComplex) As TComplex  ' 复数反双曲余割
' Public Function C_ArcSech(Z1 As TComplex) As TComplex  ' 复数反双曲正割
'


Public Function SinH(x As Double) As Double
    'SinH = (Exp(x) - Exp(-x)) / 2
    Dim tmp  As Double
    tmp = Exp(x)
    SinH = (tmp - 1# / tmp) * 0.5
End Function
  
Public Function CosH(x As Double) As Double
    'CosH = (Exp(x) + Exp(-x)) / 2
    Dim tmp  As Double
    tmp = Exp(x)
    CosH = (tmp + 1# / tmp) * 0.5
End Function
  
'同时算出SinH和CosH
Public Sub SinHCosH(x As Double, ByRef xSinH As Double, ByRef xCosh As Double)
    Dim tmp  As Double
    Dim tmprev As Double
    tmp = Exp(x)
    tmprev = 1# / tmp
    xSinH = (tmp - tmprev) * 0.5
    xCosh = (tmp + tmprev) * 0.5
End Sub

Public Sub SinCos(x As Double, ByRef xSin As Double, ByRef xCos As Double)
    xSin = Sin(x)
    xCos = Cos(x)
End Sub

Public Function ArcTan2(y As Double, x As Double) As Double
    If x > 0 Then
        ArcTan2 = Atn(y / x)
    ElseIf x = 0 Then
        If y > 0 Then
            ArcTan2 = cm_PI * 0.5
        ElseIf y < 0 Then
            ArcTan2 = -cm_PI * 0.5
        Else
            ArcTan2 = 0
        End If
    ElseIf y >= 0 Then
        ArcTan2 = Atn(y / x) + cm_PI
    Else
        ArcTan2 = Atn(y / x) - cm_PI
    End If
End Function


  
Public Function C_CreateTComplex(x As Double, y As Double) As TComplex
    C_CreateTComplex.Real = x
    C_CreateTComplex.Imag = y
End Function

Public Function C_CreateTComplexR(R As Double, Arg As Double) As TComplex
    C_CreateTComplexR.Real = R * Cos(Arg)
    C_CreateTComplexR.Imag = R * Sin(Arg)
End Function

Public Function C_Add(Z1 As TComplex, Z2 As TComplex) As TComplex
    C_Add.Real = Z1.Real + Z2.Real
    C_Add.Imag = Z1.Imag + Z2.Imag
End Function

Public Function C_Sub(Z1 As TComplex, Z2 As TComplex) As TComplex
    C_Sub.Real = Z1.Real - Z2.Real
    C_Sub.Imag = Z1.Imag - Z2.Imag
End Function

Public Function C_Mul(Z1 As TComplex, Z2 As TComplex) As TComplex
    C_Mul.Real = Z1.Real * Z2.Real - Z1.Imag * Z2.Imag
    C_Mul.Imag = Z1.Real * Z2.Imag + Z1.Imag * Z2.Real
End Function

Public Function C_Div(Z1 As TComplex, Z2 As TComplex) As TComplex
    Dim tmp  As Double
    tmp = 1# / (Z2.Real * Z2.Real + Z2.Imag * Z2.Imag)
    C_Div.Real = (Z1.Real * Z2.Real + Z1.Imag * Z2.Imag) * tmp
    C_Div.Imag = (Z1.Imag * Z2.Real - Z1.Real * Z2.Imag) * tmp
End Function

Public Function C_Abs(Z1 As TComplex) As TComplex
    C_Abs.Real = Sqr(Z1.Real * Z1.Real + Z1.Imag * Z1.Imag)
    C_Abs.Imag = 0
End Function

Public Function C_AbsSqr(Z1 As TComplex) As TComplex
    C_AbsSqr.Real = (Z1.Real * Z1.Real + Z1.Imag * Z1.Imag)
    C_AbsSqr.Imag = 0
End Function

Public Function C_AbsA(Z1 As TComplex) As TComplex
    C_AbsA.Real = Abs(Z1.Real)
    C_AbsA.Imag = Abs(Z1.Imag)
End Function

Public Function C_Floor(Z1 As TComplex) As TComplex
    C_Floor.Real = Int(Z1.Real)
    C_Floor.Imag = Int(Z1.Imag)
End Function

Public Function C_Trunc(Z1 As TComplex) As TComplex
    C_Trunc.Real = Fix(Z1.Real)
    C_Trunc.Imag = Fix(Z1.Imag)
End Function

Public Function C_Round(Z1 As TComplex) As TComplex
    C_Round.Real = Round(Z1.Real)
    C_Round.Imag = Round(Z1.Imag)
End Function


'Public Function C_Ceil(Z1 As TComplex) As TComplex
'
'End Function


Public Function C_Distance(Z1 As TComplex, Z2 As TComplex) As TComplex
    C_Distance.Real = Sqr((Z1.Real - Z2.Real) * (Z1.Real - Z2.Real) + (Z1.Imag - Z2.Imag) * (Z1.Imag - Z2.Imag))
    C_Distance.Imag = 0
End Function

Public Function C_IsEqual(Z1 As TComplex, Z2 As TComplex, Error As Double) As Boolean
    C_IsEqual = (Abs(Z1.Real - Z2.Real) + Abs(Z1.Imag - Z2.Imag)) < Abs(Error)
End Function


Public Function C_Zero() As TComplex
    C_Zero.Real = 0
    C_Zero.Imag = 0
End Function

Public Function C_Imag1() As TComplex
    C_Imag1.Real = 0
    C_Imag1.Imag = 1
End Function

Public Function C_Unity(Z1 As TComplex) As TComplex
    Dim tmp As Double
    tmp = 1# / (Z1.Real * Z1.Real + Z1.Imag * Z1.Imag)
    C_Unity.Real = Z1.Real * tmp
    C_Unity.Imag = Z1.Imag * tmp
End Function

Public Function C_Conj(Z1 As TComplex) As TComplex
    C_Conj.Real = Z1.Real
    C_Conj.Imag = -Z1.Imag
End Function


Public Function C_Flip(Z1 As TComplex) As TComplex
    C_Flip.Real = Z1.Imag
    C_Flip.Imag = Z1.Real
End Function

Public Function C_Rev(Z1 As TComplex) As TComplex
    Dim tmp As Double
    tmp = 1# / (Z1.Real * Z1.Real + Z1.Imag * Z1.Imag)
    C_Rev.Real = Z1.Real * tmp
    C_Rev.Imag = -Z1.Imag * tmp
End Function

Public Function C_Sgn(Z1 As TComplex) As TComplex
    C_Sgn.Real = Sgn(Z1.Real)
    C_Sgn.Imag = Sgn(Z1.Imag)
End Function

Public Sub C_Xchg(ByRef Z1 As TComplex, ByRef Z2 As TComplex)
    Dim Ztmp As TComplex
    Ztmp = Z1
    Z1 = Z2
    Z2 = Ztmp
End Sub

Public Function C_Chs(Z1 As TComplex) As TComplex
    C_Chs.Real = -Z1.Real
    C_Chs.Imag = -Z1.Imag
End Function

'求复数平方
Public Function C_sqr(Z1 As TComplex) As TComplex
    C_sqr.Real = Z1.Real * Z1.Real - Z1.Imag * Z1.Imag
    C_sqr.Imag = 2 * (Z1.Real * Z1.Imag)
End Function

Public Function C_Sqr3(Z1 As TComplex) As TComplex
    C_Sqr3.Real = Z1.Real * ((Z1.Real * Z1.Real) - 3 * (Z1.Imag * Z1.Imag))
    C_Sqr3.Imag = Z1.Imag * (3 * (Z1.Real * Z1.Real) - (Z1.Imag * Z1.Imag))
End Function

Public Function C_Sqr4(Z1 As TComplex) As TComplex
    Dim tmp1 As Double
    Dim tmp2 As Double
    tmp1 = ((Z1.Real * Z1.Real) - (Z1.Imag * Z1.Imag))
    tmp2 = Z1.Real * Z1.Imag * 2
    C_Sqr4.Real = ((tmp1 * tmp1) - (tmp2 * tmp2))
    C_Sqr4.Imag = tmp1 * tmp2 * 2
End Function


Public Function C_Power(Z1 As TComplex, Z2 As TComplex) As TComplex

    Dim tmph1x As Double
    Dim tmph1y As Double
    Dim tmph2x As Double
    Dim tmph2y As Double
    Dim tmpf   As Double
    Dim s As Double, c As Double

    tmph1x = 0.5 * Log((Z1.Real * Z1.Real) + (Z1.Imag * Z1.Imag))
    tmph1y = ArcTan2(Z1.Imag, Z1.Real)

    tmph2x = tmph1x * Z2.Real - tmph1y * Z2.Imag
    tmph2y = tmph1y * Z2.Real + tmph1x * Z2.Imag

    tmpf = Exp(tmph2x)