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