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 AnyByVal cbCopy As Long)

'***WRITE FUNCTIONS***

Public Function GFCurveMaker_CurveToFileInt(ByRef CurveArray() As IntegerByVal 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 LongByVal 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 SingleByVal 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 DoubleByVal 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 IntegerByVal 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 LongByVal 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 SingleByVal 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 DoubleByVal 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]