Code:'+=====================================================================================================================================+ '| | '| An additional set of mathematical functions for Visual Basic 6 | '| | '| Кривоус Анатолий Анатольевич (The trick) | '| | '+=====================================================================================================================================+ Private Declare Function GetMem2 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long Private Declare Function GetMem4 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long Public Type Complex R As Double I As Double End Type Public Type Matrix Col As Long ' Number of columns Row As Long ' Number of rows D() As Double End Type Public Const PI = 3.14159265358979 Public Const E = 2.71828182845905 Private Const PI2 = PI / 2 '+=====================================================================================================================================+ '| Real numbers | '+=====================================================================================================================================+ ' // From degree to radians Public Function Deg(ByVal Value As Double) As Double Deg = 1.74532925199433E-02 * Value End Function ' // The logarithm to the base of a real number X Public Function LogX(ByVal Value As Double, ByVal Base As Double) As Double LogX = Log(Value) / Log(Base) End Function ' // The decimal logarithm of a real number Public Function Log10(ByVal Value As Double) As Double Log10 = Log(Value) / 2.30258509299405 End Function ' // The binary logarithm of a real number Public Function Log2(ByVal Value As Double) As Double Log2 = Log(Value) / 0.693147180559945 End Function ' // Rounding up Public Function Ceil(ByVal Value As Double) As Double Ceil = -Int(-Value) End Function ' // Rounding down (Int) Public Function Floor(ByVal Value As Double) As Double Floor = Int(Value) End Function ' // Secant of a real number Public Function Sec(ByVal Value As Double) As Double Sec = 1 / Cos(Value) End Function ' // Cosecant of a real number Public Function Csc(ByVal Value As Double) As Double Csc = 1 / Sin(Value) End Function ' // Cotangent of a real number Public Function Ctg(ByVal Value As Double) As Double Ctg = 1 / Tan(Value) End Function ' // Arcsine of a real number Public Function Asin(ByVal Value As Double) As Double If Value = -1 Then Asin = -PI2: Exit Function If Value = 1 Then Asin = PI2: Exit Function Asin = Atn(Value / Sqr(-Value * Value + 1)) End Function ' // Arccosine of a real number Public Function Acos(ByVal Value As Double) As Double If CSng(Value) = -1# Then Acos = PI: Exit Function If CSng(Value) = 1# Then Acos = 0: Exit Function Acos = Atn(-Value / Sqr(-Value * Value + 1)) + 2 * Atn(1) End Function ' // Arcsecant of a real number Public Function Asec(ByVal Value As Double) As Double Asec = 1.5707963267949 - Atn(Sgn(Value) / Sqr(Value * Value - 1)) End Function ' // Arccosecant of a real number Public Function Acsc(ByVal Value As Double) As Double Acsc = Atn(Sgn(Value) / Sqr(Value * Value - 1)) End Function ' // Returns the angle whose tangent is the ratio of the two numbers Public Function Atan2(ByVal Y As Double, ByVal X As Double) As Double If Y > 0 Then If X >= Y Then Atan2 = Atn(Y / X) ElseIf X <= -Y Then Atan2 = Atn(Y / X) + PI Else Atan2 = PI / 2 - Atn(X / Y) End If Else If X >= -Y Then Atan2 = Atn(Y / X) ElseIf X <= Y Then Atan2 = Atn(Y / X) - PI Else Atan2 = -Atn(X / Y) - PI / 2 End If End If End Function ' // Arccotangent of a real number Public Function Actg(ByVal Value As Double) As Double Actg = 1.5707963267949 - Atn(Value) End Function ' // Hyperbolic sine of a real number Public Function Sinh(ByVal Value As Double) As Double Sinh = (Exp(Value) - Exp(-Value)) / 2 End Function ' // Hyperbolic cosine of a real number Public Function Cosh(ByVal Value As Double) As Double Cosh = (Exp(Value) + Exp(-Value)) / 2 End Function ' // Hyperbolic tangent of a real number Public Function Tanh(ByVal Value As Double) As Double Tanh = (Exp(2 * Value) - 1) / (Exp(2 * Value) + 1) End Function ' // Hyperbolic cotangent of a real number Public Function Ctgh(ByVal Value As Double) As Double Ctgh = 1 / (Exp(2 * Value) + 1) / (Exp(2 * Value) - 1) End Function ' // Hyperbolic secant of a real number Public Function Sech(ByVal Value As Double) As Double Sech = 2 / (Exp(Value) + Exp(-Value)) End Function ' // Hyperbolic cosecant of a real number Public Function Csch(ByVal Value As Double) As Double Csch = 2 / (Exp(Value) - Exp(-Value)) End Function ' // Hyperbolic arcsine of a real number Public Function Asinh(ByVal Value As Double) As Double Asinh = Log(Value + Sqr(Value * Value + 1)) End Function ' // Hyperbolic arcosine of a real number Public Function Acosh(ByVal Value As Double) As Double Acosh = Log(Value + Sqr(Value * Value - 1)) End Function ' // Hyperbolic arctangent of a real number Public Function Atanh(ByVal Value As Double) As Double Atanh = Log((1 + Value) / (1 - Value)) / 2 End Function ' // Hyperbolic arccotangent of a real number Public Function Actan(ByVal Value As Double) As Double Actan = Log((Value + 1) / (Value - 1)) / 2 End Function ' // Hyperbolic arcsecant of a real number Public Function Asech(ByVal Value As Double) As Double Asech = Log((Sqr(-Value * Value + 1) + 1) / Value) End Function ' // Hyperbolic arccosecant of a real number Public Function Acsch(ByVal Value As Double) As Double Acsch = Log((Sgn(Value) * Sqr(Value * Value + 1) + 1) / Value) End Function ' // Return maximum of two numbers Public Function Max(ByVal Op1 As Double, ByVal Op2 As Double) As Double Max = IIf(Op1 > Op2, Op1, Op2) End Function ' // Return maximum of three numbers Public Function Max3(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double) As Double Max3 = IIf(Op1 > Op2, IIf(Op1 > Op3, Op1, Op3), IIf(Op2 > Op3, Op2, Op3)) End Function ' // Return maximum of four numbers Public Function Max4(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double, ByVal Op4 As Double) As Double Max4 = Max(Max3(Op1, Op2, Op3), Op4) End Function ' // Return minimum of two numbers Public Function Min(ByVal Op1 As Double, ByVal Op2 As Double) As Double Min = IIf(Op1 < Op2, Op1, Op2) End Function ' // Return minimum of three numbers Public Function Min3(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double) As Double Min3 = IIf(Op1 < Op2, IIf(Op1 < Op3, Op1, Op3), IIf(Op2 < Op3, Op2, Op3)) End Function ' // Return minimum of four numbers Public Function Min4(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double, ByVal Op4 As Double) As Double Min4 = Min(Min3(Op1, Op2, Op3), Op4) End Function ' // Returns the remainder of dividing one specified number by another specified number. Public Function IEEERemainder(ByVal Op1 As Double, ByVal Op2 As Double) As Double IEEERemainder = Op1 - (Op2 * Round(Op1 / Op2)) End Function ' // Returns the remainder of dividing one specified number by another specified number. Public Function rMod(ByVal Op1 As Double, ByVal Op2 As Double) As Double rMod = (Abs(Op1) - (Abs(Op2) * (Int(Abs(Op1) / Abs(Op2))))) * Sgn(Op1) End Function




Reply With Quote
