home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / cvd_mbf / cvdmbf.bas next >
BASIC Source File  |  1993-06-25  |  6KB  |  234 lines
  1. Declare Sub hmemcpy Lib "kernel" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  2.  
  3. Function CVI (X As String) As Integer
  4.  If Len(X) <> 2 Then
  5.   MsgBox "Illegal Function Call"
  6.   Stop
  7.  End If
  8.  hmemcpy temp%, ByVal X, 2
  9.  CVI = temp%
  10. End Function
  11.  
  12. Function CVL (X As String) As Long
  13.  If Len(X) <> 4 Then
  14.   MsgBox "Illegal Function Call"
  15.   Stop
  16.  End If
  17.  hmemcpy temp&, ByVal X, 4
  18.  CVL = temp&
  19. End Function
  20.  
  21. Function CVS (X As String) As Single
  22.  If Len(X) <> 4 Then
  23.   MsgBox "Illegal Function Call"
  24.   Stop
  25.  End If
  26.  hmemcpy temp!, ByVal X, 4
  27.  CVS = temp!
  28. End Function
  29.  
  30. Function CVD (X As String) As Double
  31.  If Len(X) <> 8 Then
  32.   MsgBox "Illegal Function Call"
  33.   Stop
  34.  End If
  35.  hmemcpy temp#, ByVal X, 8
  36.  CVD = temp#
  37. End Function
  38.  
  39. Function CVSMBF (OldStringSP As String) As Single
  40.  Dim X, Sign, Exponent As Integer
  41.  Dim NewNum As String
  42.  Static ONA(0 To 3), NNA(0 To 7)
  43.  For X = 0 To 3
  44.   ONA(X) = Asc(Mid$(OldStringSP, X + 1, 1))
  45.  Next
  46.  For X = 0 To 7
  47.   NNA(X) = 0
  48.  Next
  49.  Sign = ONA(2) And 128
  50.  Exponent = ONA(3) - 129 + 1023
  51.  NNA(6) = Exponent * 2 ^ 4 And 255
  52.  NNA(7) = (Exponent \ 2 ^ 4 And 255) Or Sign
  53.  For X = 2 To 1 Step -1
  54.   ONA(X) = ONA(X) * 2 ^ 1 And 255
  55.   ONA(X) = ONA(X) Or ONA(X - 1) \ 2 ^ 7 And 255
  56.  Next
  57.  ONA(0) = ONA(0) * 2 ^ 1 And 255
  58.  For X = 6 To 4 Step -1
  59.   NNA(X) = NNA(X) Or ONA(X - 4) \ 2 ^ 4 And 255
  60.   NNA(X - 1) = ONA(X - 4) * 2 ^ 4 And 255
  61.  Next
  62.  For X = 0 To 7
  63.   NewNum = NewNum + Chr$(NNA(X))
  64.  Next
  65.  CVSMBF = CSng(CVD(NewNum))
  66. End Function
  67.  
  68. Function CVDMBF (OldStringDP As String) As Double
  69.  Dim X, Sign, Exponent As Integer
  70.  Dim NewNum As String
  71.  Static ONA(0 To 7), NNA(0 To 7)
  72.  For X = 0 To 7
  73.   ONA(X) = Asc(Mid$(OldStringDP, X + 1, 1)): NNA(X) = 0
  74.  Next
  75.  Sign = ONA(6) And 128
  76.  Exponent = ONA(7) - 129 + 1023
  77.  NNA(6) = Exponent * 2 ^ 4 And 255
  78.  NNA(7) = (Exponent \ 2 ^ 4 And 255) Or Sign
  79.  For X = 6 To 1 Step -1
  80.   ONA(X) = ONA(X) * 2 ^ 1 And 255
  81.   ONA(X) = ONA(X) Or ONA(X - 1) \ 2 ^ 7 And 255
  82.  Next
  83.  ONA(0) = ONA(0) * 2 ^ 1 And 255
  84.  For X = 6 To 2 Step -1
  85.   NNA(X) = NNA(X) Or ONA(X) \ 2 ^ 4 And 255
  86.   NNA(X - 1) = ONA(X) * 2 ^ 4 And 255
  87.  Next
  88.  For X = 0 To 7
  89.   NewNum = NewNum + Chr$(NNA(X))
  90.  Next
  91.  CVDMBF = CVD(NewNum)
  92. End Function
  93.  
  94. Function CVDTPR (OldStringTP As String) As Double
  95.  Dim X, Sign, Exponent As Integer
  96.  Dim NewNum As String
  97.  Static ONA(0 To 5), NNA(0 To 7)
  98.  For X = 0 To 5
  99.   ONA(X) = Asc(Mid$(OldStringTP, X + 1, 1))
  100.  Next
  101.  For X = 0 To 7
  102.   NNA(X) = 0
  103.  Next
  104.  Sign = ONA(5) And 128
  105.  Exponent = ONA(0) - 129 + 1023
  106.  NNA(6) = Exponent * 2 ^ 4 And 255
  107.  NNA(7) = (Exponent \ 2 ^ 4 And 255) Or Sign
  108.  For X = 5 To 2 Step -1
  109.   ONA(X) = ONA(X) * 2 ^ 1 And 255
  110.   ONA(X) = ONA(X) Or ONA(X - 1) \ 2 ^ 7 And 255
  111.  Next
  112.  ONA(0) = ONA(0) * 2 ^ 1 And 255
  113.  For X = 6 To 2 Step -1
  114.   NNA(X) = NNA(X) Or ONA(X - 1) \ 2 ^ 4 And 255
  115.   NNA(X - 1) = ONA(X - 1) * 2 ^ 4 And 255
  116.  Next
  117.  For X = 0 To 7
  118.   NewNum = NewNum + Chr$(NNA(X))
  119.  Next
  120.  CVDTPR = CVD(NewNum)
  121. End Function
  122.  
  123. Function MKI$ (X As Integer)
  124.  temp$ = Space$(2)
  125.  hmemcpy ByVal temp$, X%, 2
  126.  MKI$ = temp$
  127. End Function
  128.  
  129. Function MKL$ (X As Long)
  130.  temp$ = Space$(4)
  131.  hmemcpy ByVal temp$, X&, 4
  132.  MKL$ = temp$
  133. End Function
  134.  
  135. Function MKS$ (X As Single)
  136.  temp$ = Space$(4)
  137.  hmemcpy ByVal temp$, X!, 4
  138.  MKS$ = temp$
  139. End Function
  140.  
  141. Function MKD$ (X As Double)
  142.  temp$ = Space$(8)
  143.  hmemcpy ByVal temp$, X, 8
  144.  MKD$ = temp$
  145. End Function
  146.  
  147. Function MKSMBF$ (OldNumberSP As Single)
  148.  Dim X, Sign, Exponent As Integer
  149.  Dim OldString As String
  150.  ReDim ONA(0 To 7)
  151.  ReDim NNA(0 To 3)
  152.  OldString = MKD$(CDbl(OldNumberSP))
  153.  For X = 0 To 7
  154.   ONA(X) = Asc(Mid$(OldString, X + 1, 1))
  155.  Next
  156.  Sign = ONA(7) And 128
  157.  Exponent = ((ONA(7) And 127) * 2 ^ 4 And 255) + (ONA(6) \ 2 ^ 4 And 255)
  158.  If Exponent Then Exponent = (Exponent + 129 - 1023) And 255
  159.  For X = 2 To 0 Step -1
  160.   NNA(X) = ONA(X + 4) * 2 ^ 4 And 255
  161.   NNA(X) = NNA(X) Or ONA(X + 3) \ 2 ^ 4 And 255
  162.  Next
  163.  For X = 0 To 1
  164.   NNA(X) = NNA(X) \ 2 ^ 1 And 255
  165.   NNA(X) = NNA(X) Or NNA(X + 1) * 2 ^ 7 And 255
  166.  Next
  167.  NNA(2) = NNA(2) \ 2 ^ 1 And 255
  168.  NNA(2) = NNA(2) Or Sign
  169.  NNA(3) = Exponent
  170.  MKSMBF$ = Space$(4)
  171.  For X = 0 To 3
  172.   Mid$(MKSMBF$, X + 1, 1) = Chr$(NNA(X))
  173.  Next
  174. End Function
  175.  
  176. Function MKDMBF$ (OldNumberDP As Double)
  177.  Dim X, Sign, Exponent As Integer
  178.  Dim NewNum As String
  179.  Dim OldString As String
  180.  Static ONA(0 To 7), NNA(0 To 7)
  181.  OldNum# = OldNumberDP
  182.  OldString = MKD$(OldNum#)
  183.  For X = 0 To 7
  184.   ONA(X) = Asc(Mid$(OldString, X + 1, 1))
  185.  Next
  186.  Sign = ONA(7) And 128
  187.  Exponent = ((ONA(7) And 127) * 2 ^ 4 And 255) + (ONA(6) \ 2 ^ 4 And 255)
  188.  If Exponent Then Exponent = (Exponent + 129 - 1023) And 255
  189.  For X = 6 To 1 Step -1
  190.   NNA(X) = ONA(X) * 2 ^ 4 And 255
  191.   NNA(X) = NNA(X) Or ONA(X - 1) \ 2 ^ 4 And 255
  192.  Next
  193.  For X = 0 To 5
  194.   NNA(X) = NNA(X) \ 2 ^ 1 And 255
  195.   NNA(X) = NNA(X) Or NNA(X + 1) * 2 ^ 7 And 255
  196.  Next
  197.  NNA(6) = NNA(6) \ 2 ^ 1 And 255
  198.  NNA(6) = NNA(6) Or Sign
  199.  NNA(7) = Exponent
  200.  MKDMBF$ = Space$(8)
  201.  For X = 0 To 7
  202.   Mid$(MKDMBF$, X + 1, 1) = Chr$(NNA(X))
  203.  Next
  204. End Function
  205.  
  206. Function MKDTPR$ (OldNumberDP As Double)
  207.  Dim X, Sign, Exponent As Integer
  208.  Dim NewNum, OldString As String
  209.  Static ONA(0 To 7), NNA(0 To 5)
  210.  OldNum# = OldNumberDP
  211.  OldString = MKD$(OldNum#)
  212.  For X = 0 To 7
  213.   ONA(X) = Asc(Mid$(OldString, X + 1, 1))
  214.  Next
  215.  Sign = ONA(7) And 128
  216.  Exponent = (((ONA(7) And 127) * 2 ^ 4 And 255) + (ONA(6) \ 2 ^ 4 And 255) + 129 - 1023) And 255
  217.  For X = 5 To 1 Step -1
  218.   NNA(X) = ONA(X + 1) * 2 ^ 4 And 255
  219.   NNA(X) = NNA(X) Or ONA(X) \ 2 ^ 4 And 255
  220.  Next
  221.  For X = 1 To 4
  222.   NNA(X) = NNA(X) \ 2 ^ 1 And 255
  223.   NNA(X) = NNA(X) Or NNA(X + 1) * 2 ^ 7 And 255
  224.  Next
  225.  NNA(5) = NNA(5) \ 2 ^ 1 And 255
  226.  NNA(5) = NNA(5) Or Sign
  227.  NNA(0) = Exponent
  228.  MKDTPR$ = Space$(6)
  229.  For X = 0 To 5
  230.   Mid$(MKDTPR$, X + 1, 1) = Chr$(NNA(X))
  231.  Next
  232. End Function
  233.  
  234.