'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