laatzen/Pruef2000/source/General.bas

Attribute VB_Name = "modGeneral"
'==============================================================================
'
' File   : General.bas
' Date   : 31.03.1999
' Version: 1.00
' Author : Andreas Schmidt, lindner&partner
'
'==============================================================================
'
' Diverse Hilfsmethoden
'
'==============================================================================
'
' History:
'
' Date   : 31.03.1999
' Version: 1.00
' Author : Andreas Schmidt, lindner&partner
'
' Erste Version.
'
'==============================================================================

Global Const NEGATIVVORZEICHEN$ = "-"
Global Const DEZIMALTRENNER$ = ","
Global Const TAUSENDERSTELLE$ = "."
Global Const TAUSENDER_VERWENDEN = True

Public Function stringToInt(sInput As String) As Integer
    Dim i As Integer
    Dim s As String
    
    ' Alle Punkte, Buchstaben etc. entfernen
    For i = 1 To Len(sInput)
        If IsNumeric(Mid$(sInput, i, 1)) Then
            s = s + Mid$(sInput, i, 1)
        End If
    Next i
    
    stringToInt = Val(s)
End Function

Public Function stringToLong(sInput As String) As Long
    Dim i As Integer
    Dim s As String
    
    ' Alle Punkte, Buchstaben etc. entfernen
    For i = 1 To Len(sInput)
        If IsNumeric(Mid$(sInput, i, 1)) Then
            s = s + Mid$(sInput, i, 1)
        End If
    Next i
    
    stringToLong = Val(s)
End Function

' String-Wert in ein Double konvertieren.
'
' @param s String der Form "99.999,99"
'
' @return double-Wert
'
Public Function stringToDouble(sInput As String)
    Dim i As Integer
    Dim nDecPos As Integer
    Dim s As String
    
    ' Alle Punkte, Buchstaben etc. bis auf den
    ' Dezimaltrenner entfernen
    For i = 1 To Len(sInput)
        If IsNumeric(Mid$(sInput, i, 1)) Or _
           Mid$(sInput, i, 1) = DEZIMALTRENNER Or _
           Mid$(sInput, i, 1) = NEGATIVVORZEICHEN _
        Then
            s = s + Mid$(sInput, i, 1)
        End If
    Next i
    
    ' Wir merken uns die Stelle, an der das Komma
    ' als Dezimaltrenner steht
    nDecPos = InStr(1, s, DEZIMALTRENNER)
    If nDecPos > 0 Then
        s = Left$(s, nDecPos - 1) + "." + Mid$(s, nDecPos + 1)
    End If
    
    stringToDouble = Val(s)
End Function

' Integer-Value in einen String umwandeln.
'
' @param d                  Ausgangswert
' @param sFormat            Format-String (siehe VB Format$())
'
Public Function intToString(i As Integer, sFormat As String, Optional nStringLen As Integer)
    If IsMissing(nStringLen) Then
        intToString = Format$(i, sFormat)
    Else
        intToString = leftFill(Format$(i, sFormat), nStringLen)
    End If
End Function

' Long-Value in einen String umwandeln.
'
' @param d                  Ausgangswert
' @param sFormat            Format-String (siehe VB Format$())
'
Public Function longToString(l As Long, sFormat As String, Optional nStringLen As Integer)
    If IsMissing(nStringLen) Then
        longToString = Format$(l, sFormat)
    Else
        longToString = leftFill(Format$(l, sFormat), nStringLen)
    End If
End Function

' Double-Value in einen String umwandeln.
'
' @param d                  Ausgangswert
' @param sFormat            Format-String (siehe VB Format$())
'
Public Function doubleToString(d As Double, sFormat As String, Optional nStringLen As Integer)
    If IsMissing(nStringLen) Then
        doubleToString = Format$(d, sFormat)
    Else
        doubleToString = leftFill(Format$(d, sFormat), nStringLen)
    End If
End Function

' Füllt den String s links mit spaces auf, bis die vorgegebene
' Stringlänge erreicht ist.
'
Private Function leftFill(s As String, nStringLen As Integer) As String
    Do While Len(s) < nStringLen
        s = " " + s
    Loop
    
    leftFill = s
End Function

' @return = K-String
' Umrechnung von Wert nach K-String
' wird benötigt für das Setzen des K-Wertes bei der Programmierung der FM85
' splittet Wert in 4 stellige Mantisse ohne führendes Komma und 10er Exponent auf
' mit Rundung der 4. Stelle der Mantisse

Public Function ValToKString(Wert As Double) As String
    Dim Exponent As Integer
    Dim Vorzeichen As String
    
    Exponent = 0
    Vorzeichen = "+"
    Do While Wert >= 1 Or Wert < 0.1
        If Wert >= 1 Then
            ' Wert ist zu groß (größer gleich 1) , deshalb durch 10 teilen
            Exponent = Exponent + 1
            Wert = Wert / 10
            Vorzeichen = "+"
        Else
            ' Wert ist zu klein (kleiner 0.1), deshalb mal 10
            Vorzeichen = "-"
            Exponent = Exponent - 1
            Wert = Wert * 10
        End If
    Loop
    ' Hier gilt 0.1 <= Wert < 1
    ValToKString = Mid(Format(Wert, "0.0000"), 3, 4) & "K" & Vorzeichen & CStr(Abs(Exponent))
End Function



Public Function UpdateInDruckpruefung(FabNr As Long, SerienNr As Long) As Boolean
    Dim strSQL As String
    Dim rs As CRecordset
    Set rs = New CRecordset
    UpdateInDruckpruefung = False
    
    strSQL = "SELECT * FROM Druckpruefung where FabNr =" & FabNr & " or SerienNr = " & SerienNr
    rs.openRS strSQL, False
    
    Do While Not rs.EOF
        UpdateInDruckpruefung = True
        rs.setValue "SerienNr", SerienNr
        rs.update
        rs.MoveNext
    Loop
    Set rs = Nothing
End Function

Public Function IstFabNrDruckGeprueft(FabNr As Long) As Boolean
    Dim strSQL As String
    Dim rs As CRecordset
    Set rs = New CRecordset
    IstFabNrDruckGeprueft = False
    
    strSQL = "SELECT * FROM Druckpruefung where FabNr =" & FabNr
    rs.openRS strSQL, False
    
    If Not rs.EOF Then
        IstFabNrDruckGeprueft = True
    End If
    Set rs = Nothing
End Function