GFCurveMaker/GFCurveMakermod.bas
Attribute VB_Name = "GFCurveMakermod"
Option Explicit
'(c)2003 by Louis. Module containing public functions to read and write GFCurveMaker‑curves (can be used by any kind of target project).
'general use
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'***WRITE FUNCTIONS***
Public Function GFCurveMaker_CurveToFileInt(ByRef CurveArray() As Integer, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important (if file cannot be written); returns True for success or False for error
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim Tempstr As String * 2
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Output As #1
Print #1, "GFCurveMakerFile";
Print #1, "ValueFormat:INT";
For CurveFor = CurveArrayLBound To CurveArrayUBound
Call CopyMemory(ByVal Tempstr, CurveArray(CurveFor), 2&)
Print #1, Tempstr;
Next CurveFor
Close #1
GFCurveMaker_CurveToFileInt = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveToFileInt = False 'error
Exit Function
End Function
Public Function GFCurveMaker_CurveToFileLong(ByRef CurveArray() As Long, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important (if file cannot be written); returns True for success or False for error
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim Tempstr As String * 4
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Output As #1
Print #1, "GFCurveMakerFile";
Print #1, "ValueFormat:LNG";
For CurveFor = CurveArrayLBound To CurveArrayUBound
Call CopyMemory(ByVal Tempstr, CurveArray(CurveFor), 4&)
Print #1, Tempstr;
Next CurveFor
Close #1
GFCurveMaker_CurveToFileLong = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveToFileLong = False 'error
Exit Function
End Function
Public Function GFCurveMaker_CurveToFileSingle(ByRef CurveArray() As Single, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important (if file cannot be written); returns True for success or False for error
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim Tempstr As String * 4
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Output As #1
Print #1, "GFCurveMakerFile";
Print #1, "ValueFormat:SNG";
For CurveFor = CurveArrayLBound To CurveArrayUBound
Call CopyMemory(ByVal Tempstr, CurveArray(CurveFor), 4&)
Print #1, Tempstr;
Next CurveFor
Close #1
GFCurveMaker_CurveToFileSingle = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveToFileSingle = False 'error
Exit Function
End Function
Public Function GFCurveMaker_CurveToFileDouble(ByRef CurveArray() As Double, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important (if file cannot be written); returns True for success or False for error
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim Tempstr As String * 8
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Output As #1
Print #1, "GFCurveMakerFile";
Print #1, "ValueFormat:DBL";
For CurveFor = CurveArrayLBound To CurveArrayUBound
Call CopyMemory(ByVal Tempstr, CurveArray(CurveFor), 8&)
Print #1, Tempstr;
Next CurveFor
Close #1
GFCurveMaker_CurveToFileDouble = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveToFileDouble = False 'error
Exit Function
End Function
'***END OF WRITE FUNCTIONS***
'***READ FUNCTIONS***
Public Function GFCurveMaker_CurveFromFileInt(ByRef CurveArray() As Integer, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important; returns True if values could be completely read (exact value number match) or False if not
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim InfoString As String
Dim Tempstr As String * 2
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Binary As #1
InfoString = String$(16, Chr$(0))
Get #1, 1, InfoString
If Not (InfoString = "GFCurveMakerFile") Then GoTo Error:
InfoString = String$(15, Chr$(0))
Get #1, , InfoString
If Not (InfoString = "ValueFormat:INT") Then GoTo Error:
CurveFor = CurveArrayLBound
Do
If (EOF(1)) Then GoTo Error:
If CurveFor > CurveArrayUBound Then GoTo Error:
Get #1, , Tempstr
Call CopyMemory(CurveArray(CurveFor), ByVal Tempstr, 2&)
CurveFor = CurveFor + 1&
Loop
Close #1
GFCurveMaker_CurveFromFileInt = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveFromFileInt = False 'error
Exit Function
End Function
Public Function GFCurveMaker_CurveFromFileLong(ByRef CurveArray() As Long, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important; returns True if values could be completely read (exact value number match) or False if not
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim InfoString As String
Dim Tempstr As String * 4
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Binary As #1
InfoString = String$(16, Chr$(0))
Get #1, 1, InfoString
If Not (InfoString = "GFCurveMakerFile") Then GoTo Error:
InfoString = String$(15, Chr$(0))
Get #1, , InfoString
If Not (InfoString = "ValueFormat:LNG") Then GoTo Error:
CurveFor = CurveArrayLBound
Do
If (EOF(1)) Then GoTo Error:
If CurveFor > CurveArrayUBound Then GoTo Error:
Get #1, , Tempstr
Call CopyMemory(CurveArray(CurveFor), ByVal Tempstr, 4&)
CurveFor = CurveFor + 1&
Loop
Close #1
GFCurveMaker_CurveFromFileLong = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveFromFileLong = False 'error
Exit Function
End Function
Public Function GFCurveMaker_CurveFromFileSingle(ByRef CurveArray() As Single, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important; returns True if values could be completely read (exact value number match) or False if not
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim InfoString As String
Dim Tempstr As String * 4
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Binary As #1
InfoString = String$(16, Chr$(0))
Get #1, 1, InfoString
If Not (InfoString = "GFCurveMakerFile") Then GoTo Error:
InfoString = String$(15, Chr$(0))
Get #1, , InfoString
If Not (InfoString = "ValueFormat:SNG") Then GoTo Error:
CurveFor = CurveArrayLBound
Do
If (EOF(1)) Then GoTo Error:
If CurveFor > CurveArrayUBound Then GoTo Error:
Get #1, , Tempstr
Call CopyMemory(CurveArray(CurveFor), ByVal Tempstr, 4&)
CurveFor = CurveFor + 1&
Loop
Close #1
GFCurveMaker_CurveFromFileSingle = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveFromFileSingle = False 'error
Exit Function
End Function
Public Function GFCurveMaker_CurveFromFileDouble(ByRef CurveArray() As Double, ByVal CurveFile As String) As Boolean
On Error GoTo Error: 'important; returns True if values could be completely read (exact value number match) or False if not
Dim CurveArrayLBound As Long
Dim CurveArrayUBound As Long
Dim CurveFor As Long
Dim InfoString As String
Dim Tempstr As String * 8
'preset
CurveArrayLBound = LBound(CurveArray())
CurveArrayUBound = UBound(CurveArray())
'begin
Open CurveFile For Binary As #1
InfoString = String$(16, Chr$(0))
Get #1, 1, InfoString
If Not (InfoString = "GFCurveMakerFile") Then GoTo Error:
InfoString = String$(15, Chr$(0))
Get #1, , InfoString
If Not (InfoString = "ValueFormat:DBL") Then GoTo Error:
CurveFor = CurveArrayLBound
Do
If (EOF(1)) Then GoTo Error:
If CurveFor > CurveArrayUBound Then GoTo Error:
Get #1, , Tempstr
Call CopyMemory(CurveArray(CurveFor), ByVal Tempstr, 8&)
CurveFor = CurveFor + 1&
Loop
Close #1
GFCurveMaker_CurveFromFileDouble = True 'ok
Exit Function
Error:
Close #1 'make sure file is closed
GFCurveMaker_CurveFromFileDouble = False 'error
Exit Function
End Function
'***END OF READ FUNCTIONS***
[END OF FILE]