Bay Six Software Forum Index Bay Six Software
Beyond the Basics
 
 FAQFAQ   SearchSearch   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

QB/QBASIC work-alikes
 



Download
Download as a single file

CVD Function LB3
Code:
Function CVD( DBits$ )
'-- Equivalent to QB's CVD function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    If Len(DBits$) >= 8 Then
        Struct local1, D As Double
        CallDLL #kernel32, "RtlMoveMemory", _
            local1 As Struct, DBits$ As Ptr, _
            8 As Long, r As void
        CVD = local1.D.struct
    End If
End Function

Related to: MKD$


CVI Function JB1/LB2
Code:
Function CVI( IBits$ )
'-- Equivalent to QB's CVI function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    If Len(IBits$) >= 2 Then
        CVI = Asc(IBits$) _
            + 256 * Asc(Mid$(IBits$, 2, 1))
    End If
End Function

Related to: MKI$


CVL Function JB1/LB2
Code:
Function CVL( LBits$ )
'-- Equivalent to QB's CVL function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    If Len(LBits$) >= 4 Then
        CVL = Asc(LBits$) _
            + 256 * Asc(Mid$(LBits$, 2, 1)) _
            + 65536 * Asc(Mid$(LBits$, 3, 1)) _
            + 16777216 * Asc(Mid$(LBits$, 4, 1))
    End If
End Function

Related to: MKL$


CVS Function LB3
Code:
Function CVS( SBits$ )
'-- Equivalent to QB's CVS function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    If Len(SBits$) >= 4 Then
        CVS = Asc(SBits$) _
            + 256 * Asc(Mid$(SBits$, 2, 1)) _
            + 65536 * Asc(Mid$(SBits$, 3, 1)) _
            + 16777216 * Asc(Mid$(SBits$, 4, 1))
        Struct local1, D As Double
        Open "oleaut32" For DLL As #oleaut32
        CallDLL #oleaut32, "VarR8FromR4", _
            CVS As ULong, local1 As Struct, _
            ret As Long
        Close #oleaut32
        CVS = local1.D.struct
    End If
End Function

Related to: MKS$


INT Function JB1/LB2
Code:
Function QBINT( Num )
'-- Equivalent to QB's INT function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    intNum = Int(Num)
    QBINT = intNum - (Num < 0 And intNum <> Num)
End Function


MID$ Statement JB1/LB2
Code:
Sub QBMID ByRef Dst$, Pos, Cnt, Src$
'-- Equivalent to QB's MID$(d$,p,c)=s$ command.
'-- Usage:  Call QBMID d$,p,c,s$
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    If Cnt > Len(Src$) Then Cnt = Len(Src$)
    If Pos + Cnt > Len(Dst$) Then _
      Cnt = Len(Dst$) - Pos + 1
    If Cnt > 0 Then
        Dst$ = Left$(Dst$, Pos - 1) _
             + Left$(Src$, Cnt) _
             + Mid$(Dst$, Pos + Cnt)
    End If
End Sub

See also: Large Strings Library


MKD$ Function LB3
Code:
Function MKD$( DNum )
'-- Equivalent to QB's MKD$ function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    Struct local1, D As Double
    local1.D.struct = DNum + 0.5-0.5 ' force FP
    MKD$ = Space$(8)
    CallDLL #kernel32, "RtlMoveMemory", _
        MKD$ As Ptr, local1 As Struct, _
        8 As Long, r As void
End Function

Related to: CVD


MKI$ Function JB1/LB2
Code:
Function MKI$( INum )
'-- Equivalent to QB's MKI$ function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    MKI$ = Chr$(INum And 255) _
         + Chr$((INum And 65280) / 256)
End Function

Related to: CVI


MKL$ Function JB1/LB2
Code:
Function MKL$( LNum )
'-- Equivalent to QB's MKL$ function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    MKL$ = Chr$(LNum And 255) _
         + Chr$((LNum And 65280) / 256) _
         + Chr$((LNum And 16711680) / 65536) _
         + Chr$((LNum And 4278190080) / 16777216)
End Function

Related to: CVL


MKS$ Function LB3
Code:
Function MKS$( SNum )
'-- Equivalent to QB's MKS$ function.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    MKS$ = Space$(4)
    Open "oleaut32" For DLL As #oleaut32
    CallDLL #oleaut32, "VarR4FromR8", _
        SNum As Double, MKS$ As Ptr, _
        ret As Long
    Close #oleaut32
    If ret <> 0 Then MKS$ = ""
End Function

Related to: CVS


NOT Operator JB1/LB2
Code:
Function QBNOT( Num )
'-- Equivalent to QB's NOT operator.
'-- Provided freely by Brent D. Thorn.
'-- http://www.b6sw.com
    QBNOT = -1 * Num - 1
End Function

Powered by phpBB © 2001, 2005 phpBB Group