home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / getdis2r / primer3.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-30  |  6.2 KB  |  212 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
  3. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
  4. Begin VB.Form Primer 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Primer"
  7.    ClientHeight    =   3135
  8.    ClientLeft      =   1980
  9.    ClientTop       =   1440
  10.    ClientWidth     =   4215
  11.    ClipControls    =   0   'False
  12.    Icon            =   "Primer3.frx":0000
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MousePointer    =   1  'Arrow
  16.    PaletteMode     =   1  'UseZOrder
  17.    Picture         =   "Primer3.frx":0442
  18.    ScaleHeight     =   3135
  19.    ScaleWidth      =   4215
  20.    Begin RichTextLib.RichTextBox Primes 
  21.       Height          =   1455
  22.       Left            =   0
  23.       TabIndex        =   6
  24.       Top             =   600
  25.       Width           =   4215
  26.       _ExtentX        =   7435
  27.       _ExtentY        =   2566
  28.       _Version        =   393217
  29.       ScrollBars      =   2
  30.       DisableNoScroll =   -1  'True
  31.       TextRTF         =   $"Primer3.frx":0884
  32.    End
  33.    Begin ComctlLib.ProgressBar PB 
  34.       Height          =   255
  35.       Left            =   0
  36.       TabIndex        =   4
  37.       Top             =   2880
  38.       Width           =   4215
  39.       _ExtentX        =   7435
  40.       _ExtentY        =   450
  41.       _Version        =   327682
  42.       Appearance      =   1
  43.    End
  44.    Begin VB.CommandButton Command1 
  45.       Caption         =   "&Copy"
  46.       Height          =   375
  47.       Left            =   2880
  48.       TabIndex        =   3
  49.       Top             =   2160
  50.       Width           =   1335
  51.    End
  52.    Begin VB.CommandButton cmdStop 
  53.       Caption         =   "&Stop"
  54.       Height          =   375
  55.       Left            =   1440
  56.       TabIndex        =   1
  57.       Top             =   2160
  58.       Width           =   1335
  59.    End
  60.    Begin VB.CommandButton cmdStart 
  61.       Caption         =   "&Start"
  62.       Default         =   -1  'True
  63.       Height          =   375
  64.       Left            =   0
  65.       TabIndex        =   0
  66.       Top             =   2160
  67.       Width           =   1335
  68.    End
  69.    Begin VB.Label lblStat 
  70.       BackStyle       =   0  'Transparent
  71.       Height          =   255
  72.       Left            =   0
  73.       TabIndex        =   5
  74.       Top             =   2640
  75.       Width           =   4215
  76.    End
  77.    Begin VB.Label lblDir 
  78.       BackStyle       =   0  'Transparent
  79.       Caption         =   "Press start to view the prime numbers."
  80.       Height          =   255
  81.       Left            =   600
  82.       TabIndex        =   2
  83.       Top             =   120
  84.       Width           =   3495
  85.    End
  86. Attribute VB_Name = "Primer"
  87. Attribute VB_GlobalNameSpace = False
  88. Attribute VB_Creatable = False
  89. Attribute VB_PredeclaredId = True
  90. Attribute VB_Exposed = False
  91. Dim PrimeOn As Boolean
  92. Dim P As New Collection
  93. Dim H As New Collection
  94. Dim S As String
  95. Sub Prime()
  96. Static A As Long, B As Long, C As Long
  97. Dim D As String, E As Long, i As Integer
  98.     lblDir = "Calculating..."
  99.     For i = 1 To P.Count
  100.         P.Remove 1
  101.     Next i
  102.     Primes = ""
  103.     D = InputBox("Type in the maximum prime number:")
  104.     If D = "" Then Exit Sub
  105.     E = Val(Right(D, 7))
  106.     If E Mod 2 = 0 Then E = E - 1
  107.     PB.Min = 0
  108.     PB.Max = E
  109.     Ad 2
  110.     For A = 3 To E Step 2
  111.         DoEvents
  112.         PB.Value = A
  113.         If Not PrimeOn Then PrimeOn = True: Exit Sub
  114.         For B = 1 To P.Count
  115.             If P.Item(B) > Sqr(A) Then
  116.                 Ad (A): Exit For
  117.             End If
  118.             If A Mod P.Item(B) = 0 Then Exit For
  119.         Next B
  120.         lblStat = "Status -- " & Prc(PB.Max, PB.Value)
  121.         Caption = "Primer - " & Prc(PB.Max, PB.Value)
  122.     Next A
  123.     lblStat = "": PB.Value = 0
  124.     PB.Max = P.Count
  125.     lblDir = "Acquiring primes. Please wait."
  126.     For C = 1 To P.Count
  127.         If Not PrimeOn Then PrimeOn = True: Exit Sub
  128.         Primes.SelStart = Len(Primes) - 1
  129.         Primes.SelText = CStr(P.Item(C)) & vbCrLf
  130.         PB.Value = C
  131.         lblStat = "Printing - " & Prc(PB.Max, PB.Value)
  132.         Caption = "Primer - " & Prc(PB.Max, PB.Value)
  133.     Next C
  134.     lblStat = "": PB.Value = 0
  135.     Caption = "Primer"
  136.     lblDir = "Complete. Click the Copy button to send primes to clipboard."
  137.     Exit Sub
  138. End Sub
  139. Function Prc(ByVal Mx As Long, ByVal Vl As Long) As String
  140.     Prc = (1 / (Mx / Vl) * 100) \ 1 & "%"
  141. End Function
  142. Private Sub cmdStart_Click()
  143. Dim i As Integer
  144.     For i = H.Count To 1 Step -1
  145.         H.Remove (i)
  146.     Next i
  147.     S = "Priming"
  148.     PrimeOn = True
  149.     Prime
  150. End Sub
  151. Private Sub cmdStop_Click()
  152.     S = "Copying"
  153.     PrimeOn = False
  154. End Sub
  155. Private Sub Command1_Click()
  156. Dim i As Double, Tex As String
  157.     PrimeOn = True
  158.     PB.Max = P.Count
  159.     PB.Min = 0
  160.     For i = 1 To P.Count
  161.         DoEvents
  162.         PB.Value = i
  163.         If Not PrimeOn Then Exit Sub
  164.         Tex = Tex & ", " & P.Item(i)
  165.         Caption = "Primer - " & P.Item(i) & "; " & Prc(PB.Max, PB.Value)
  166.         lblStat = "Copying to Clipboard - " & Prc(PB.Max, PB.Value)
  167.     Next i
  168.     PB.Value = 0
  169.     lblStat = ""
  170.     Clipboard.SetText Tex, &HBF01
  171.     Clipboard.SetText Tex, 1
  172.     Caption = "Primer"
  173.     PB.Value = 0
  174.     lblStat = ""
  175. End Sub
  176. Function Ad(ByVal Amt As Long)
  177.     P.Add (Amt)
  178.     Foo Amt
  179. End Function
  180. Public Function Foo(ByVal Number As Long) As Long
  181. Dim Word As String, SizeNum As Integer, i As Integer, j As Integer
  182. Dim Temp As String, Add As Long
  183.     Word = Str(Number)
  184.     SizeNum = Len(Word)
  185.     For i = 1 To SizeNum
  186.         j = SizeNum - i
  187.         Temp = Left(Right(Word, j), i)
  188.         Add = Add + Val(Left(Temp, 1))
  189.     Next i
  190.     H.Add Add
  191. End Function
  192. Private Sub lblStat_Click()
  193. Dim i As Integer, St As String
  194.     Primes.Text = ""
  195.     For i = 1 To H.Count
  196.         If H.Item(i) Mod 2 = 0 Then St = St & H(i) & " "
  197.         DoEvents
  198.         Debug.Print i
  199.     Next i
  200.     Clipboard.SetText St, &HBF01
  201.     Clipboard.SetText St, 1
  202. End Sub
  203. '''''''''''''''''''''''''
  204. '   1  999   999   6    '
  205. ' 1 1 9   9 9   9 6     '
  206. '   1  9999  9999 6666  '
  207. '   1     9     9 6   6 '
  208. ' 11111  9     9   666  '
  209. '''''''''''''''''''''''''
  210. '   Feucht Production   '
  211. '''''''''''''''''''''''''
  212.