juanjespar
Jun 05, 2009, updated at 08:26:04 (UTC)
view4750
view4
0
Goto Top

Überprüfung von 2 Rechenwerten, ob diese Rechenbar sind (VB6)

GermansolvedQuestionDevelopment

Hallo!
habe das Problem das ich für einen Einheitenrechner 2 verschiedene wertebereiche einbinden muss...
(g , kg, oz darf nicht mit den metrischen Recheneinheiten rechenbar sein)

hier der code

Option Explicit

Private Sub Command1_Click()

Dim dblEinheit0 As Double
Dim dblEinheit1 As Double

If Not IsNumeric(Text1.Text) Then
MsgBox "Bitte Zahlen eingeben!"
Else
Select Case Trim(Text2.Text)
Case "mm"
dblEinheit0 = CDbl(Text1.Text) * 1
Case "cm"
dblEinheit0 = CDbl(Text1.Text) * 10
Case "m"
dblEinheit0 = CDbl(Text1.Text) * 1000
Case "km"
dblEinheit0 = CDbl(Text1.Text) * 1000000
Case "in"
dblEinheit0 = CDbl(Text1.Text) * 25.4
Case "ft"
dblEinheit0 = CDbl(Text1.Text) * 304.8
Case "yd"
dblEinheit0 = CDbl(Text1.Text) * 914.4
Case "g"
dblEinheit0 = CDbl(Text1.Text) * 1
Case "kg"
dblEinheit0 = CDbl(Text1.Text) * 1
Case "oz"
dblEinheit0 = CDbl(Text1.Text) * 1
Case Else
MsgBox "Bitte eine Einheit angeben! (mm, cm , m ,km ,in ,ft ,yd ,g ,kg ,uz)"
End Select

Select Case Trim(Text3.Text)
Case "mm"
dblEinheit1 = dblEinheit0 * 1
Case "cm"
dblEinheit1 = dblEinheit0 / 10
Case "m"
dblEinheit1 = dblEinheit0 / 1000
Case "km"
dblEinheit1 = dblEinheit0 / 1000000
Case "in"
dblEinheit1 = dblEinheit0 / 25.4
Case "ft"
dblEinheit1 = dblEinheit0 / 304.8
Case "yd"
dblEinheit1 = dblEinheit0 / 914.4
Case "g"
dblEinheit1 = dblEinheit0 / 1
Case "kg"
dblEinheit1 = dblEinheit0 / 1
Case "oz"
dblEinheit1 = dblEinheit0 / 1
Case Else
MsgBox "Bitte eine Einheit angeben! (mm, cm , m ,km ,in ,ft ,yd ,g ,kg ,uz)"
End Select

End If

ausgabe.Caption = CStr(dblEinheit1)

End Sub

Private Sub Command2_Click()
End
End Sub
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 117536

Url: https://administrator.de/contentid/117536

Printed on: April 19, 2024 at 22:04 o'clock

4 Comments
Latest comment
Goto Top
Mitglied: 76109
76109 Jun 05, 2009 at 10:01:32 (UTC)
Goto Top
Hallo JuanJespar!

Das würde ich persönlich, anstatt mit Case über ListBoxen machen.

Etwa in der Art:

ListBox 1 alle Einheiten anzeigen und ListBox 2 alle Einheiten passend zur Auswahl von ListBox 1 anzeigen.

Oder: In jeder Case-Anweisung von Text2.Text z.B. ein Call EinheitLaenge()

Private Sub EinheitLaenge()
  Select Case Trim(Text3.Text)
    Case "mm"  
      dblEinheit1 = dblEinheit0 * 1
    Case "cm"  
      dblEinheit1 = dblEinheit0 / 10
    ...
    Case Else
      MsgBox "Msg"  
  End Select
End Sub

Gruß Dieter
Member: JuanJespar
JuanJespar Jun 05, 2009 at 10:54:47 (UTC)
Goto Top
Function Rechnelaenge() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "mm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "cm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 10
Case "m"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "km"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000000
Case "in"
dblAusgangswert = CDbl(Ausgangswert.Text) * 25.4
Case "ft"
dblAusgangswert = CDbl(Ausgangswert.Text) * 304.8
Case "yd"
dblAusgangswert = CDbl(Ausgangswert.Text) * 914.4
Case Else
MsgBox "Bitte eine Längeneinheit angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "mm"
dblErgebniswert = dblAusgangswert * 1
Case "cm"
dblErgebniswert = dblAusgangswert / 10
Case "m"
dblErgebniswert = dblAusgangswert / 1000
Case "km"
dblErgebniswert = dblAusgangswert / 1000000
Case "in"
dblErgebniswert = dblAusgangswert / 25.4
Case "ft"
dblErgebniswert = dblAusgangswert / 304.8
Case "yd"
dblErgebniswert = dblAusgangswert / 914.4
Case Else
MsgBox "Bitte eine Längeneinheit angeben!"
End Select

Rechnelaenge = dblErgebniswert

End Function

Function Rechnegewicht() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "g"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "kg"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "oz"
dblAusgangswert = CDbl(Ausgangswert.Text) * 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "g"
dblErgebniswert = dblAusgangswert * 1
Case "kg"
dblErgebniswert = dblAusgangswert / 1000
Case "oz"
dblErgebniswert = dblAusgangswert / 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Rechnegewicht = dblErgebniswert

End Function
Member: JuanJespar
JuanJespar Jun 05, 2009 at 13:27:19 (UTC)
Goto Top
Zitat von @JuanJespar:
Function Rechnelaenge() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "mm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "cm"
dblAusgangswert = CDbl(Ausgangswert.Text) * 10
Case "m"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "km"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000000
Case "in"
dblAusgangswert = CDbl(Ausgangswert.Text) * 25.4
Case "ft"
dblAusgangswert = CDbl(Ausgangswert.Text) * 304.8
Case "yd"
dblAusgangswert = CDbl(Ausgangswert.Text) * 914.4
Case Else
MsgBox "Bitte eine Längeneinheit
angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "mm"
dblErgebniswert = dblAusgangswert * 1
Case "cm"
dblErgebniswert = dblAusgangswert / 10
Case "m"
dblErgebniswert = dblAusgangswert / 1000
Case "km"
dblErgebniswert = dblAusgangswert / 1000000
Case "in"
dblErgebniswert = dblAusgangswert / 25.4
Case "ft"
dblErgebniswert = dblAusgangswert / 304.8
Case "yd"
dblErgebniswert = dblAusgangswert / 914.4
Case Else
MsgBox "Bitte eine Längeneinheit
angeben!"
End Select

Rechnelaenge = dblErgebniswert

End Function

Function Rechnegewicht() As Double

Dim dblAusgangswert As Double
Dim dblErgebniswert As Double

Select Case Trim(Ausgangseinheit.Text)
Case "g"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1
Case "kg"
dblAusgangswert = CDbl(Ausgangswert.Text) * 1000
Case "oz"
dblAusgangswert = CDbl(Ausgangswert.Text) * 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Select Case Trim(Ergebniseinheit.Text)
Case "g"
dblErgebniswert = dblAusgangswert * 1
Case "kg"
dblErgebniswert = dblAusgangswert / 1000
Case "oz"
dblErgebniswert = dblAusgangswert / 28.3495231
Case Else
MsgBox "Bitte eine Gewichtseinheit angeben!"
End Select

Rechnegewicht = dblErgebniswert

End Function


Mitglied: 76109
76109 Jun 05, 2009 at 16:33:12 (UTC)
Goto Top
Hallo JuanJespar!

Eigentlich hatte ich an etwas in der Art gedacht:
Option Explicit

Const MsgE = "Bitte eine Einheit angeben! (mm, cm , m ,km ,in ,ft ,yd ,g ,kg ,uz)"  
Const MsgG = "Bitte eine Gewichtseinheit angeben!"  
Const MsgL = "Bitte eine Längeneinheit angeben!"  

Private Sub CommandButton1_Click()

    If Not IsNumeric(EingabeWert.Text) Then
        MsgBox "Bitte eine Zahl eingeben!"  
    Else
        Select Case LCase(Trim(EingabeEinheit.Text))
            Case "mm":  Call RechneLaenge(1)  
            Case "cm":  Call RechneLaenge(10)  
            Case "m":   Call RechneLaenge(1000)  
            Case "km":  Call RechneLaenge(1000000)  
            Case "in":  Call RechneLaenge(25.4)  
            Case "ft":  Call RechneLaenge(304.8)  
            Case "yd":  Call RechneLaenge(919.4)  
            Case "g":   Call RechneGewicht(1)  
            Case "kg":  Call RechneGewicht(1000)  
            Case "oz":  Call RechneGewicht(28.3495231)  
            Case Else:  MsgBox MsgE
        End Select
    End If
End Sub

Private Sub RechneGewicht(ByVal Faktor As Double)
    
    Dim Eingabe As Double, Ausgabe As Double
    
    Eingabe = CDbl(EingabeWert.Text) * Faktor
    
    Select Case LCase(Trim(AusgabeEinheit.Text))
        Case "g":   Ausgabe = Eingabe  
        Case "kg":  Ausgabe = Eingabe / 1000  
        Case "oz":  Ausgabe = Eingabe / 28.3495231  
        Case Else:  Ausgabe = 0:  MsgBox MsgG
    End Select
    
    If Ausgabe = 0 Then Ergebnis.Caption = "" Else Ergebnis.Caption = CStr(Ausgabe)  
End Sub

Private Sub RechneLaenge(ByVal Faktor As Double)

    Dim Eingabe As Double, Ausgabe As Double
    
    Eingabe = CDbl(EingabeWert.Text) * Faktor
    
    Select Case LCase(Trim(AusgabeEinheit.Text))
        Case "mm":  Ausgabe = Eingabe  
        Case "cm":  Ausgabe = Eingabe / 10  
        Case "m":   Ausgabe = Eingabe / 1000  
        Case "km":  Ausgabe = Eingabe / 1000000  
        Case "in":  Ausgabe = Eingabe / 25.4  
        Case "ft":  Ausgabe = Eingabe / 304.8  
        Case "yd":  Ausgabe = Eingabe / 914.4  
        Case Else:  Ausgabe = 0:  MsgBox MsgL
    End Select

    If Ausgabe = 0 Then Ergebnis.Caption = "" Else Ergebnis.Caption = CStr(Ausgabe)  
End Sub

Gruß Dieter

PS Setze Code-Formatierung so (ohne Dollarzeichen):
<$code>
Dein Code
<$/code>
GermansolvedQuestionDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment