vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Schützen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB4, VB5, VB624.10.02
Brüche kürzen

Dieses Beispiel zeigt, wie man VB dazu große mathematische Brüche auf den kleinsten Nenner zu bringen.

Autor:   Thomas JankBewertung:     [ Jetzt bewerten ]Views:  24.642 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Wie oft saß ich schon vor Rechenaufgaben, deren Ergebnis drei- oder nochmehr stellige Brüche enthielten. Als braver Fachoberschüler liefert man seinem Mathe-Lehrer natürlich Brüche nur als gnadenlos zusammengekürzte Ergebnisse.

Leider ist es bei hohen Zahlen kaum noch möglich die maximale Kürzbarkeit auf den ersten Blick zu erkennen.

Also kam mir die Idee doch den Rechner für mich arbeiten zu lassen. Bin ja schließlich ein fauler Mensch

Die Kernfunktion läßt sich übrigens auch ohne Weiteres auf programmierbaren Taschenrechnern umsetzen. Ich beginne mit dem Anlegen der Hauptform, um auf sinnvolle Weise auf Fehleingaben des Benutzers zu reagieren, noch bevor die Kernfunktion ins Spiel kommt. Enthalten sind vier Textfelder, zwei Lines (Bruchstriche), ein Labelfeld und ein Commandbutton.

Private Sub cmdKürzen_Click()
  Dim dblZähler As Double
  Dim dblNenner As Double
  Dim dblZählerNeu As Double
  Dim dblNennerNeu As Double
  Dim dblGGT As Double
 
  txtZähler1.Visible = False
  Line2.Visible = False
  txtNenner1.Visible = False
  lblAntwort.Caption = ""
 
  ' Falscheingaben abfangen (Text)
  If (IsNumeric(txtZähler.Text) = False) Or _
    (IsNumeric(txtNenner.Text) = False) Then
 
    lblAntwort.Caption = "Geben sie einen gültigen Bruch ein!"
    Exit Sub
  End If
 
  ' Kommazahlen abfangen
  If (Int(txtZähler.Text) = txtZähler.Text = False) Or _
    (Int(txtNenner.Text) = txtNenner.Text) = False Then
 
    lblAntwort.Caption = "Argument ist keine Ganzzahl."
    Exit Sub
  End If
 
  dblZähler = txtZähler.Text
  dblNenner = txtNenner.Text
 
  ' Null abfangen
  If dblNenner = 0 Then
    lblAntwort.Caption = "Division durch Null ist verboten!"
  End If
 
  If dblZähler = 0 Then
    lblAntwort.Caption = "Dieser Bruch stellt die Zahl -0- dar."
    Exit Sub
  End If
 
  ' Ganze Zahlen abfangen
  If dblZähler / dblNenner = Int(dblZähler / dblNenner) Then
    lblAntwort.Caption = "Dieser Bruch stellt die Zahl -" & _
      dblZähler / dblNenner & "- dar."
    Exit Sub
  End If

Der vorstehende Code hat lediglich die Aufgabe, Falscheingaben und Sonderformen von Brüchen abzufangen. Die eigentliche Rechnerei beginnt erst nach Ausschluß dieser Sonderfälle.

  ' Immer noch "Sub cmdKürzen"
  ' Bruch kürzen, Ergebnisausgabe
  dblGGT = Kürzen(dblZähler, dblNenner)
  If dblGGT = 1 Then
    lblAntwort.Caption = "Dieser Bruch läßt sich nicht kürzen."
  Else
    lblAntwort.Caption = "Dieser Bruch läßt sich mit -" & _
      dblGGT & "- kürzen."
    txtZähler1.Text = dblZähler / dblGGT
    txtNenner1.Text = dblNenner / dblGGT
    txtZähler1.Visible = True
    Line2.Visible = True
    txtNenner1.Visible = True
  End If
End Sub

Nun die Kernfunktion
Ich habe bewußt darauf verzichtet die Funktion MOD zu verwenden, da diese Funktion intern nur mit LONG-Daten arbeiten kann. Ein Überlauffehler tritt schon bei Zahlen von wenigen Tausend auf.

Public Function Kürzen(tmpZähler As Double, _
  tmpNenner As Double) As Double
 
  ' Das Abfangen von Nullwerten, Texteingaben und
  ' Kommazahlen erfolgte bereits im aufrufenden
  ' Programmcode, da dort die Interaktion mit dem
  ' Benutzer besser gesteuert werden kann. Somit wird
  ' der Code modular gehalten und die Funktion ist ohne
  ' Änderung wiederverwendbar.
 
  Dim dblTeiler As Double
 
  Select Case tmpZähler - tmpNenner
    Case Is > 0
      ' Zähler ist größer
      ' Ist der Nenner bereits ein Teiler des Zählers?
      If tmpZähler / tmpNenner = Int(tmpZähler / tmpNenner) Then
        Kürzen = tmpNenner
        Exit Function
      End If
 
      ' Wenn nicht, ist der ggT maximal so groß wie
      ' die Hälfte des Nenners
 
      ' + 2, um auch kleine Nenner, wie 3 berechnen
      ' zu können
      For dblTeiler = (Int(tmpNenner / 2) + 2) To 2 Step -1
        ' Rechenzeit für andere Prozesse freigeben.
        DoEvents
 
        ' Wichtig bei großen Zahlen!
        If tmpNenner / dblTeiler = Int(tmpNenner / dblTeiler) Then
          If tmpZähler / dblTeiler = Int(tmpZähler / dblTeiler) Then
            Kürzen = dblTeiler
            Exit Function
          End If
        End If
      Next dblTeiler
 
    Case Is < 0
      ' Nenner ist größer
      If tmpNenner / tmpZähler = Int(tmpNenner / tmpZähler) Then
        Kürzen = tmpZähler
        Exit Function
      End If
 
      For dblTeiler = (Int(tmpZähler / 2) + 2) To 2 Step -1
        DoEvents
        If tmpZähler / dblTeiler = Int(tmpZähler / dblTeiler) Then
          If tmpNenner / dblTeiler = Int(tmpNenner / dblTeiler) Then
            Kürzen = dblTeiler
            Exit Function
          End If
        End If
      Next dblTeiler
  End Select
 
  ' Rückgabewert bei nichtkürzbaren Brüchen;
  ' 1 ist mathematisch korrekter als der
  ' Standardrückgabewert 0
  Kürzen = 1
End Function

Viel Spaß damit, wer auch immer sowas gebrauchen kann
 

Dieser Tipp wurde bereits 24.642 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel