'Temperaturen Mega Pack
'This software is Open Source.
'You can use it, change it and give to everyone.
'The calculation is from:
'http://de.wikipedia.org/wiki/Rankine-Skala
 
Option Explicit
 
' Alle geladenen Forms beenden
Private Sub UnloadForms()
  Dim F As Form
  For Each F In Forms
    Unload F
    Set F = Nothing
  Next F
End Sub
Private Sub Form_Load()
 
    Combo1.AddItem "Celsius"
    Combo1.AddItem "Delisle"
    Combo1.AddItem "Fahrenheit"
    Combo1.AddItem "Kelvin"
    Combo1.AddItem "Newton"
    Combo1.AddItem "Rankie"
    Combo1.AddItem "Réaumur"
    Combo1.AddItem "Romer"
    Combo2.AddItem "Celsius"
    Combo2.AddItem "Delisle"
    Combo2.AddItem "Fahrenheit"
    Combo2.AddItem "Kelvin"
    Combo2.AddItem "Newton"
    Combo2.AddItem "Rankie"
    Combo2.AddItem "Réaumur"
    Combo2.AddItem "Romer"
End Sub
Private Sub Combo1_Click()
    Select Case Combo1.ListIndex
    Case 0
        Label1.Caption = "°C"
    Case 1
        Label1.Caption = "°De"
    Case 2
        Label1.Caption = "°F"
    Case 3
        Label1.Caption = "K"
    Case 4
        Label1.Caption = "°N"
    Case 5
        Label1.Caption = "°Ra"
    Case 6
        Label1.Caption = "°Ré"
    Case 7
        Label1.Caption = "°Ro"
 
    End Select
 
End Sub
Private Sub Combo2_Click()
    Select Case Combo2.ListIndex
    Case 0
        Label2.Caption = "°C"
    Case 1
        Label2.Caption = "°De"
    Case 2
        Label2.Caption = "°F"
    Case 3
        Label2.Caption = "K"
    Case 4
        Label2.Caption = "°N"
    Case 5
        Label2.Caption = "°Ra"
    Case 6
        Label2.Caption = "°Ré"
    Case 7
        Label2.Caption = "°Ro"
 
    End Select
End Sub
Private Sub Command1_Click()
  Dim eins
  Dim zus
  Dim combo
  On Error GoTo infotext
 
  Text2.Text = ""
  zus = Combo1.Text + Combo2.Text
  combo = Combo1.Text
  eins = Text1.Text
 
   ' gleiche Einheiten werden nicht umgerechnet
  If Label1.Caption = Label2.Caption Then
       Beep
       Text2.Text = Text1.Text
       GoTo uberspringen

 ' warnen und nicht rechnen, wenn keine Nummer eingetragen wurde
  ElseIf eins = "" Then GoTo infotext2
 
  ' die Eingangstemperatur darf nicht unter 0 Kelvin sein
  ElseIf combo = "Celsius" And eins + 273.15 < 0 Then Beep
        GoTo infotext3
  ElseIf combo = "Delisle" And 373.15 - eins * 2 / 3 < 0 Then
        Beep
        GoTo infotext3
  ElseIf combo = "Fahrenheit" And (eins + 459.67) / 1.8 < 0 Then
        Beep
        GoTo infotext3
  ElseIf combo = "Kelvin" And eins < 0 Then
        Beep
        GoTo infotext3
  ElseIf combo = "Newton" And eins * 100 / 33 + 273.15 < 0 Then
        Beep
        GoTo infotext3
  ElseIf combo = "Rankie" And eins / 1.8 < 0 Then
        Beep
        GoTo infotext3
  ElseIf combo = "Réaumur" And eins * 1.25 + 273.15 < 0 Then
        Beep
        GoTo infotext3
  ElseIf combo = "Romer" And (eins - 7.5) * 40 / 21 + 273.15 < 0 Then
        Beep
        GoTo infotext3
 
  ' berechnen
  ElseIf zus = "CelsiusDelisle" Then Text2.Text = (100 - eins) * 1.5
  ElseIf zus = "CelsiusFahrenheit" Then Text2.Text = eins * 1.8 + 32
  ElseIf zus = "CelsiusKelvin" Then Text2.Text = eins + 273.15
  ElseIf zus = "CelsiusNewton" Then Text2.Text = eins * 0.33
  ElseIf zus = "CelsiusRankie" Then Text2.Text = eins * 1.8 + 491.67
  ElseIf zus = "CelsiusRéaumur" Then Text2.Text = eins * 0.8
  ElseIf zus = "CelsiusRomer" Then Text2.Text = eins * 21 / 40 + 7.5
  ElseIf zus = "DelisleCelsius" Then Text2.Text = 100 - eins * 2 / 3
  ElseIf zus = "DelisleFahrenheit" Then Text2.Text = 212 - eins * 1.2
  ElseIf zus = "DelisleKelvin" Then Text2.Text = 373.15 - eins * 2 / 3
  ElseIf zus = "DelisleNewton" Then Text2.Text = 33 - eins * 0.22
  ElseIf zus = "DelisleRankie" Then Text2.Text = 671.67 - eins * 1.2
  ElseIf zus = "DelisleRéaumur" Then Text2.Text = 80 - eins * 8 / 15
  ElseIf zus = "DelisleRomer" Then Text2.Text = 60 - eins * 0.35
  ElseIf zus = "FahrenheitCelsius" Then Text2.Text = (eins - 32) / 1.8
  ElseIf zus = "FahrenheitDelisle" Then Text2.Text = (212 - eins) * 5 / 6
  ElseIf zus = "FahrenheitKelvin" Then Text2.Text = (eins + 459.67) / 1.8
  ElseIf zus = "FahrenheitNewton" Then Text2.Text = (eins - 32) * 11 / 60
  ElseIf zus = "FahrenheitRankie" Then Text2.Text = eins + 459.67
  ElseIf zus = "FahrenheitRéaumur" Then Text2.Text = (eins - 32) / 2.25
  ElseIf zus = "FahrenheitRomer" Then Text2.Text = (eins - 32) * 7 / 24 + 7.5
  ElseIf zus = "KelvinCelsius" Then Text2.Text = eins - 273.15
  ElseIf zus = "KelvinDelisle" Then Text2.Text = (373.15 - eins) * 1.5
  ElseIf zus = "KelvinFahrenheit" Then Text2.Text = eins * 1.8 - 459.67
  ElseIf zus = "KelvinNewton" Then Text2.Text = (eins - 273.15) * 0.33
  ElseIf zus = "KelvinRankie" Then Text2.Text = eins * 1.8
  ElseIf zus = "KelvinRéaumur" Then Text2.Text = (eins - 273.15) * 0.8
  ElseIf zus = "KelvinRomer" Then Text2.Text = (eins - 273.15) * 21 / 40 + 7.5
  ElseIf zus = "NewtonCelsius" Then Text2.Text = eins * 100 / 33
  ElseIf zus = "NewtonDelisle" Then Text2.Text = (33 - eins) / 0.22
  ElseIf zus = "NewtonFahrenheit" Then Text2.Text = eins * 60 / 11 + 32
  ElseIf zus = "NewtonKelvin" Then Text2.Text = eins * 100 / 33 + 273.15
  ElseIf zus = "NewtonRankie" Then Text2.Text = eins * 60 / 11 + 491.67
  ElseIf zus = "NewtonRéaumur" Then Text2.Text = eins * 80 / 33
  ElseIf zus = "NewtonRomer" Then Text2.Text = eins * 35 / 22 + 7.5
  ElseIf zus = "RankieCelsius" Then Text2.Text = eins / 1.8 - 273.15
  ElseIf zus = "RankieDelisle" Then Text2.Text = (671.67 - eins) * 5 / 6
  ElseIf zus = "RankieFahrenheit" Then Text2.Text = eins - 459.67
  ElseIf zus = "RankieKelvin" Then Text2.Text = eins / 1.8
  ElseIf zus = "RankieNewton" Then Text2.Text = (eins - 491.67) * 11 / 60
  ElseIf zus = "RankieRéaumur" Then Text2.Text = eins / 2.25 + 218.52
  ElseIf zus = "RankieRomer" Then Text2.Text = (eins - 491.67) * 7 / 24 + 7.5
  ElseIf zus = "RéaumurCelsius" Then Text2.Text = eins * 1.25
  ElseIf zus = "RéaumurDelisle" Then Text2.Text = (80 - eins) * 1.875
  ElseIf zus = "RéaumurFahrenheit" Then Text2.Text = eins * 2.25 + 32
  ElseIf zus = "RéaumurKelvin" Then Text2.Text = eins * 1.25 + 273.15

  ElseIf zus = "RéaumurNewton" Then Text2.Text = eins * 0.4125
  ElseIf zus = "RéaumurRankie" Then Text2.Text = eins * 2.25 + 491.67
  ElseIf zus = "RéaumurRomer" Then Text2.Text = eins * 21 / 32 + 7.5
  ElseIf zus = "RomerCelsius" Then Text2.Text = (eins - 7.5) * 40 / 21
  ElseIf zus = "RomerDelisle" Then Text2.Text = (60 - eins) * 20 / 7
  ElseIf zus = "RomerFahrenheit" Then Text2.Text = (eins - 7.5) * 24 / 7 + 32
  ElseIf zus = "RomerKelvin" Then Text2.Text = (eins - 7.5) * 40 / 21 + 273.15
  ElseIf zus = "RomerNewton" Then Text2.Text = (eins - 7.5) * 22 / 35
  ElseIf zus = "RomerRankie" Then Text2.Text = (eins - 7.5) * 24 / 7 + 491.67
  ElseIf zus = "RomerRéaumur" Then Text2.Text = (eins - 7.5) * 32 / 21
  Else
 
  End If
 
GoTo uberspringen
 
infotext:
MsgBox "Fehler!  Als Trennzeichen darf kein . sein, sondern ein ,  ", vbOKOnly, _
  "ACHTUNG"
GoTo uberspringen
infotext2:
MsgBox "Geben Sie eine Nummer ein.", vbOKOnly, "ACHTUNG"
GoTo uberspringen
infotext3:
MsgBox "        Temperatur, die Sie eingegeben haben" & Chr(10) & Chr(13) & _
  "ist niedriger als der Absolute Nullpunkt  -273,15°C  ", vbOKOnly, "ACHTUNG"
 
uberspringen:
End Sub
Private Sub Form_Unload(Cancel As Integer)
 
 UnloadForms
 End
 
End Sub