当前位置: 源码素材网 » VB教程 » 详情页

VB 质因数分解算法及代码演示

  •   时间:2020-04-18
  • 概述:分解质因数

VB 质因数分解算法及代码演示,这个程序是帮助小学生分解质因数,要求是所输入的数字不能小于2,该程序能自动判断您输入的数字是素数还是合数,如果是合数,将自动进行质因数分解,下面来看具体的代码:

VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "质因数分解工具"
   ClientHeight    =   2610
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6240
   Icon            =   "Fjzys.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2610
   ScaleWidth      =   6240
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   1
      Left            =   2520
      Top             =   840
   End
   Begin VB.TextBox Text2
      BeginProperty Font
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   1  'Horizontal
      TabIndex        =   2
      Top             =   840
      Width           =   6015
   End
   Begin VB.CommandButton Command1
      Caption         =   "判断"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   120
      Width           =   735
   End
   Begin VB.TextBox Text1
      BeginProperty Font
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label2
      BeginProperty Font
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   1920
      Width           =   6015
   End
   Begin VB.Label Label1
      BackColor       =   &H00FFC0FF&
      Caption         =   "正在运算中,请稍候"
      BeginProperty Font
         Name            =   "隶书"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   495
      Left            =   2760
      TabIndex        =   3
      Top             =   120
      Width           =   3255
   End
   Begin VB.Menu PopUpHelpMenu
      Caption         =   "帮助菜单(&A)"
      Visible         =   0   'False
      Begin VB.Menu mnuHelp
         Caption         =   "帮助(&H)"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Num1 As Long
Dim Num2 As Long
Dim Num3 As Long
Dim Hms As Long
Private Sub Command1_Click()
   Timer1.Enabled = True
   Command1.Enabled = False
   Text2.Text = ""
   If Len(Trim(Text1.Text)) < 1 Then
      MsgBox "数值不能空", 16, "数据错误"
      Text1.SetFocus
      Command1.Enabled = True
      Exit Sub
   End If
   If Len(Text1.Text) < 1 Or Int(Val(Text1.Text)) <> Val(Text1.Text) Or Val(Text1.Text) < 2 Then
      MsgBox "数值必须为不小于2的正整数", 16, "数据错误"
      Text1.Text = ""
      Text1.SetFocus
      Command1.Enabled = True
      Exit Sub
   End If
   Label1.Visible = True
   Num1 = Text1.Text
   If IsPrime(Num1) = True Then
     Timer1.Enabled = False
     If Hms < 0 Then Hms = 0
     If Hms = 0 Then
        Label2.Caption = "一共用了0秒"
     Else
        Label2.Caption = "一共用了0" & Hms / 1000 & "秒"
     End If
     Hms = 0
     Text2.Text = Num1 & "是素数"
     Command1.Enabled = True
     Label1.Visible = False
     Exit Sub
   End If
   Text2.Visible = False
   For Num2 = 2 To Num1 - 1
     If IsPrime(Num2) = True Then
       Do While Num1 / Num2 = Num1 \ Num2
          DoEvents
          If Len(Trim(Text2.Text)) < 1 Then
             Text2.Text = Text1.Text & "=" & Num2
          Else
             Text2.Text = Text2.Text & "*" & Num2
          End If
          Num1 = Num1 / Num2
       Loop
     End If
   Next Num2
   Timer1.Enabled = False
   If Hms < 0 Then Hms = 0
   If Hms = 0 Then
        Label2.Caption = "一共用了0秒"
   Else
        Label2.Caption = "一共用了0" & Hms / 1000 & "秒"
   End If
   Hms = 0
   Text2.Visible = True
   Command1.Enabled = True
   Label1.Visible = False
End Sub
Private Sub Form_Load()
If App.PrevInstance = True Then
   'MsgBox "程序已经运行,不要重复运行!", vbInformation, "错误提示"
   Unload Me
End If
Dim RetVal As Long
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
MsgBox "在窗体上按下鼠标右键将弹出帮助菜单", vbInformation, "给您带来不便,在这里先说声对不起"
RetVal = SendMessage(Text2.hwnd, EM_SETREADONLY, True, ByVal 0&)
Text2.BackColor = Me.BackColor
Label1.Visible = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then
     PopupMenu PopUpHelpMenu
   End If
End Sub
Private Sub mnuHelp_Click()
   MsgBox "这个程序是帮助小学生分解质因数" & vbCrLf & _
          "要求是所输入的数字不能小于2" & vbCrLf & _
          "该程序能自动判断您输入的数字是素数还是合数" & vbCrLf & _
          "如果是合数,将自动进行质因数分解" & vbCrLf & _
          "希望广大朋友提出您的意见、建议和要求" & vbCrLf & _
          "信箱: ", vbInformation, "帮助窗口"
End Sub
Private Sub Text1_Change()
Text2.Text = ""
Label1.Visible = False
Label2.Caption = ""
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
  If KeyAscii = 8 And Len(Text1.Text) > 1 Then
     Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1)
  End If
  If KeyAscii = 13 Then Command1_Click
  If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
     KeyAscii = 0
  End If
End Sub
Private Sub Timer1_Timer()
  Hms = Hms + 1
End Sub

    相关声明:

      若“VB 质因数分解算法及代码演示”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。