vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB4, VB5, VB602.03.04
Primzahlen nach dem Sieb des Eratosthenes

Dieser Tipp ermittelt alle Primzahlen eines bestimmten Wertbereichs nach dem Verfahren "Sieb des Eratosthenes".

Autor:   Günter FuchsBewertung:  Views:  17.170 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 
Diese Methode besagt, dass alle Vielfachen einer Zahl - außer der Zahl selbst - keine Primzahlen sind. Der Algorithmus ist ab ca. 400 Elemente schneller als die Prüfung auf Teilbarkeit. Allerdings wird viel Arbeitsspeicher benötigt.

Kurzbeschreibung:
Es wird ein Feld ablnSieb(1 to lngBis) vom Typ Boolean deklariert. Durch diese Deklaration haben alle Elemente des Feldes zunächst den Wert False (= 0). In einer Schleife von 4 bis lngBis werden dann alle geradzahlige Elemente auf True gesetzt. Danach werden die ungeraden Zahlen getestet und deren Vielfache ebenfalls auf True gesetzt. Der Code kann optimiert werden, indem man erst ab der Quadratzahl der Primzahl die entsprechenden Elemente auf True setzt. Außerdem kann man die doppelte Step-Zahl der Primzahl nehmen, weil ungerade Zahl + ungerade Zahl eine gerade Zahl ergibt. Ist also lngPrimzahl * lngPrimzahl größer als lngBis, sind alle auf True gesetzten Elemente k e i n e Primzahlen. In einer Schleife von 3 bis lngBis werden alle False-Elemente erfasst. Der Schleifenwert ist die entsprechende Primzahl.

Damit mehr als 32.767 Primzahlen in einer ListBox ausgegeben werden können, habe ich 100 Primzahlen in einen String zusammengefasst. Außerdem wird hierdurch die Programmausführung beschleunigt. Möchte man einen sauberen Abschluss der ListBox, kann man auch die Länge des Strings für die Ausgabe heranziehen. Z.B.:

If Len(strPrimzahlenAusgabe & CStr(I)) > 800 Then lstAusgabe.AddItem strPrimzahlenAusgabe
.

Die Font-Eigenschaft der ListBox sollte dann aber auf z.B. Courier New eingestellt werden.

Um sich die Zahlen in der ListBox ansehen zu können, musste ein horizontaler Scrollbalken eingefügt werden. Wie man das macht, kann man hier nachlesen:
 Horizontale Scrollbalken in Listboxen

Die Zeitmessung habe ich aus dem Buch "Nitty Gritty Visual Basic 6" von Jürgen Bayer.

Beispielprojekt:
Erstellen Sie ein neues Projekt und platzieren auf die Form:

  • 1 x TextBox (txtBis)
  • 1 x ListBox (lstAusgabe)
  • 1 x Label (lblProzent)
  • 1 x Label (lblDauer)
  • 1 x Label (lblAnzahl)
  • 1 x CommandButton (cmdStart)

    Fügen Sie nachfolgenden Code in den Codeteil der Form ein:

    Option Explicit
     
    ' API-Deklarationen für die Zeitmessung
    Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
      ByRef lpPerformanceCount As Currency) As Long
     
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
      ByRef lpFrequency As Currency) As Long
     
    ' API-Deklarationen für den horizontalen Scrollbalken in der ListBox
    Private Declare Function SendMessage Lib "user32" _
      Alias "SendMessageA" ( _
      ByVal hwnd As Long, _
      ByVal wMsg As Long, _
      ByVal wParam As Long, _
      lParam As Any) As Long
     
    Private Const LB_SETHORIZONTALEXTENT = &H194
    Private mcurFrequency
    Private Sub Form_Load()
      ' Ermitteln der Frequenz
      QueryPerformanceFrequency mcurFrequency
     
      ' Primzahlen bis ... ermitteln
      txtBis.Text = "1000"
     
      lblProzent.Caption = "0,0%"
      lblDauer.Caption = ""
      lblAnzahl.Caption = ""
    End Sub
    ' Primzahlen ermitteln
    Private Sub cmdStart_Click()
      Dim lngBis As Long
      Dim I As Long, lngPrimzahl As Long
      Dim ablnSieb() As Boolean
      Dim lngZähler As Long
      Dim lngDifferenz As Long
      Dim curStart As Currency, curEnd As Currency
      Dim curTime As Currency
      Dim strPrimzahlenAusgabe As String
      Dim myForm As Form
      Dim ScrollWidth As Long
      Dim j As Integer
     
      ' Starten der Zeitmessung
      QueryPerformanceCounter curStart
     
      lstAusgabe.Clear
      ' Durch lstAusgabe.Visible = False wird die
      ' Programmausführung beschleunigt
      lstAusgabe.Visible = False
      lngBis = CLng(txtBis.Text)
     
      ' lngDifferenz dient zur Berechnung des prozentualen Anteils
      lngDifferenz = lngBis
     
      ' Nach der Re-Dimensionierung haben alle Elemente
      ' den Wert 0 = False
      ReDim ablnSieb(1 To lngBis)
     
      ' Die geradzahligen Elemente werden auf True gesetzt
      For I = 4 To lngBis Step 2
        ablnSieb(I) = True
      Next I
      ' Die "1" ist keine Primzahl
      ablnSieb(1) = True
     
      lngPrimzahl = 3
      Do Until (lngPrimzahl * lngPrimzahl) > lngBis
        If ablnSieb(lngPrimzahl) = False Then
          For I = (lngPrimzahl * lngPrimzahl) To _
            lngBis Step (lngPrimzahl + lngPrimzahl)
            ablnSieb(I) = True
          Next I
        End If
        lngPrimzahl = lngPrimzahl + 2
      Loop
     
      ' Die Ausgabe als String beschleunigt das Programm.
      ' Die "2" ist die kleiste Primzahl
      strPrimzahlenAusgabe = "2  "
      lngZähler = 1
      For I = 3 To lngBis Step 2
        If ablnSieb(I) = False Then
          ' 100 Primzahlen werden als ein String zusammen-
          ' gefasst, damit mehr Zahlen in der ListBox
          ' dargestellt werden können
          If lngZähler Mod 101 = 0 Then
            lstAusgabe.AddItem strPrimzahlenAusgabe
            ' damit ein neuer String ausgegeben werden kann:
            strPrimzahlenAusgabe = "  "
          Else
            strPrimzahlenAusgabe = strPrimzahlenAusgabe & CStr(I) & "  "
          End If
          lngZähler = lngZähler + 1
        End If
      Next I
     
      If Len(strPrimzahlenAusgabe) > 0 Then
        lstAusgabe.AddItem strPrimzahlenAusgabe
      End If
     
      ' Damit das Ergebnis betrachtet werden kann
      lstAusgabe.Visible = True
      lblProzent.Caption = Quote(lngZähler, lngDifferenz)
     
      ' Stoppen der Zeitmessung
      QueryPerformanceCounter curEnd
     
      ' Auswertung
      If mcurFrequency = 0 Then
        curTime = 0
      Else
        curTime = (curEnd - curStart) / mcurFrequency
      End If
     
      ' Die Ausgabe kann direkt mit der Currency-
      ' Dezimalstelle, in Sekunden erfolgen
      lblDauer.Caption = CStr(curTime) & " Sekunden"
      lblAnzahl.Caption = Format(CStr(lngZähler), "#,##0")
     
      ' Schriftart der ListBox verwenden
      Set myForm = Me
      With myForm
        Set .Font = lstAusgabe.Font
     
        ' Längsten Eintrag suchen
        ScrollWidth = 0
        For j = lstAusgabe.ListCount - 1 To lstAusgabe.ListCount - 2 Step -1
          If .TextWidth(lstAusgabe.List(j)) > ScrollWidth Then _
            ScrollWidth = .TextWidth(lstAusgabe.List(j))
        Next j
      End With
      Set myForm = Nothing
     
      ' Setzen des ScrollBereichs
      Call SendMessage(lstAusgabe.hwnd, LB_SETHORIZONTALEXTENT, _
        Int(ScrollWidth / Screen.TwipsPerPixelX) + 15, 0&)
    End Sub
    ' Hilfsfunktion zum Ermitteln des Prozentsatzes
    Private Function Quote(ByVal lngZahlen As Long, _
      ByVal lngMenge As Long) As String
     
      Dim dblProzent As Double
     
      dblProzent = lngZahlen / lngMenge
      Quote = Format(dblProzent, "0.000%")
    End Function

    Starten Sie das Projekt und geben die obere Wertegrenze in die TextBox ein. Klicken Sie dann auf den Start-Button, um die Primzahlen zu ermitteln.
     



  • 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.
     
     
    Copyright ©2000-2024 vb@rchiv Dieter OtterAlle 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.