⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmadd.frm

📁 一个vb的mis系统
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmadd1 
   BorderStyle     =   0  'None
   Caption         =   "增加信息"
   ClientHeight    =   5910
   ClientLeft      =   0
   ClientTop       =   -105
   ClientWidth     =   6675
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   Picture         =   "frmadd.frx":0000
   ScaleHeight     =   5910
   ScaleWidth      =   6675
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   6840
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   1320
      Width           =   180
   End
   Begin VB.TextBox stu_age 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      Height          =   300
      Left            =   1920
      TabIndex        =   5
      Top             =   3360
      Width           =   2655
   End
   Begin VB.ComboBox stu_term 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      Height          =   300
      ItemData        =   "frmadd.frx":1A598
      Left            =   1920
      List            =   "frmadd.frx":1A5A5
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   2950
      Width           =   2655
   End
   Begin VB.TextBox stu_id 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      Height          =   300
      Left            =   1920
      TabIndex        =   1
      Top             =   1770
      Width           =   2655
   End
   Begin VB.TextBox stu_name 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      Height          =   300
      Left            =   1920
      TabIndex        =   2
      Top             =   2160
      Width           =   2655
   End
   Begin VB.TextBox stu_photo 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      BorderStyle     =   0  'None
      Height          =   230
      Left            =   1950
      TabIndex        =   6
      Top             =   3775
      Width           =   2415
   End
   Begin VB.TextBox stu_add 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      BorderStyle     =   0  'None
      Height          =   240
      Left            =   1950
      TabIndex        =   7
      Top             =   4170
      Width           =   2415
   End
   Begin VB.ComboBox stu_sex 
      Appearance      =   0  'Flat
      BackColor       =   &H00F2F3F7&
      Height          =   300
      ItemData        =   "frmadd.frx":1A5C7
      Left            =   1920
      List            =   "frmadd.frx":1A5D1
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   2575
      Width           =   2655
   End
   Begin VB.Timer mousemovetimer 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   240
      Top             =   5160
   End
   Begin VB.Image tbutton2 
      Height          =   210
      Left            =   1560
      Picture         =   "frmadd.frx":1A5DD
      Top             =   1080
      Width           =   960
   End
   Begin VB.Image pic_close 
      Height          =   180
      Left            =   6360
      Picture         =   "frmadd.frx":1A634
      Top             =   120
      Width           =   180
   End
   Begin VB.Image pic_ok 
      Height          =   285
      Left            =   2760
      Picture         =   "frmadd.frx":1A686
      Top             =   5400
      Width           =   1065
   End
   Begin VB.Image pic_exit 
      Height          =   285
      Left            =   5160
      Picture         =   "frmadd.frx":1B6D2
      Top             =   5400
      Width           =   1065
   End
   Begin VB.Image pic_clear 
      Height          =   285
      Left            =   3960
      Picture         =   "frmadd.frx":1C71E
      Top             =   5400
      Width           =   1065
   End
   Begin VB.Image mousermovepic 
      Height          =   345
      Left            =   0
      Picture         =   "frmadd.frx":1D76A
      Top             =   0
      Width           =   6270
   End
End
Attribute VB_Name = "frmadd1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim oldx As Integer      '为解决全图形窗口没有标题栏而无法拖动的问题而定义的鼠标新旧两个XY变量
Dim oldy As Integer
Dim newx As Integer
Dim newy As Integer



'>>>>>>>>>>>>>>>>>>>>>>>>以下程序段解决全图形窗口的移动问题<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'移植须知:将该功能移植到一个全图片窗口以解决不能移动的问题时,需注意:1 赋值计时器和伪装标题栏到新的全图片窗体中;2 赋值定义的新旧XY值(4个)和本程序段到新的全图片窗体中;3 修改计时器的过程“mousemovetimer_Timer”中的四个窗体名字。4 修改伪装标题栏的图片
'当指定图片(伪装标题栏)被鼠标点击时启动计时器,并记录下当时的初始鼠标坐标
Private Sub mousermovepic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mousemovetimer.Enabled = True
    oldx = X
    oldy = Y
End Sub
'当指定图片(伪装标题栏)上鼠标移动时,赋给新的鼠标XY值,注意系统每隔很短的时间会赋值一次。
Private Sub mousermovepic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    newx = X
    newy = Y
End Sub
'当指定图片(伪装标题栏)被鼠标释放时关闭计时器。
Private Sub mousermovepic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mousemovetimer.Enabled = False
End Sub
'计时器将定时得到四个值,分别是固定的初始XY值,和不断变化的新的XY值。利用新旧XY的差,可以以此来移动窗体。适当调小计时器间隔时间将有助于移动窗体的流畅性。
Private Sub mousemovetimer_Timer()
    frmadd1.Left = frmadd1.Left - (oldx - newx)
    If frmadd1.Top - (oldy - newy) < 1050 Then
        frmadd1.Top = 1050
    Else
        frmadd1.Top = frmadd1.Top - (oldy - newy)
    End If
End Sub
'>>>>>>>>>>>>>>>>>>>>>>>>以上程序段解决全图形窗口的移动问题<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'初始化窗口
Private Sub Form_Load()
    Me.Top = 1050
    Me.Left = 0
    stu_sex.ListIndex = 0  '默认性别为男性
    stu_term.ListIndex = 0   '默认学期为第一学期
End Sub

'清空所有填写项目
Private Sub pic_clear_Click()
    stu_id.Text = ""
    stu_name.Text = ""
    stu_age.Text = ""
    stu_photo.Text = ""
    stu_add.Text = ""
End Sub

'关闭按钮实现
Private Sub pic_close_Click()
    frmmain.addwindowsishas = False    '还原布尔值
    Unload Me
End Sub

'退出按钮实现
Private Sub pic_exit_Click()
    frmmain.addwindowsishas = False    '还原布尔值
    Unload Me
End Sub

'确定按钮实现
Private Sub pic_ok_Click()
    '检查数据完整性(一种情况:没有填完所有数据)
    If stu_id.Text = "" Or stu_name.Text = "" Or stu_sex.Text = "" Or stu_age.Text = "" Or stu_photo.Text = "" Or stu_add.Text = "" Then
        If frmmain.check_have.Value = 0 Then
        Set publicmbox.Picture = publicmbox.pic1.Picture: publicmbox.Show vbModal
        End If
        Exit Sub
    End If
    '检查数据正确性(两种情况:学生ID或者学生年龄输入了非数字字符,如ID为“ABC123”)
    If Not IsNumeric(Trim(stu_id.Text)) Then
        If frmmain.check_have.Value = 0 Then
        Set publicmbox.Picture = publicmbox.pic2.Picture: publicmbox.Show vbModal
        End If
        stu_id.Text = ""
        Exit Sub
    End If
    If Not IsNumeric(Trim(stu_age.Text)) Then
        If frmmain.check_have.Value = 0 Then
        Set publicmbox.Picture = publicmbox.pic3.Picture: publicmbox.Show vbModal
        End If
        stu_age.Text = "": Exit Sub
    End If
    '检查数据的合法性(两种情况:学生ID或者学生年龄输入的数字超过范围,如ID为“-10”)
    If Trim(stu_id.Text) < 0 Or Trim(stu_id.Text) > 30001 Then
         If frmmain.check_have.Value = 0 Then
         Set publicmbox.Picture = publicmbox.pic4.Picture: publicmbox.Show vbModal
         End If
         stu_id.Text = "": Exit Sub
    End If
    If Trim(stu_age.Text) < 18 Or Trim(stu_age.Text) > 100 Then
        If frmmain.check_have.Value = 0 Then
        Set publicmbox.Picture = publicmbox.pic5.Picture: publicmbox.Show vbModal
        End If
        stu_age.Text = "": Exit Sub
    End If
    '所有数据检查完毕
    
    '执行拼装T-SQL语句
    Dim tsql As String
    tsql = "insert StuInfo values (" & Trim(stu_id.Text) & ",'" & Trim(stu_name.Text) & "','" & Trim(stu_sex.Text) & "','" & Trim(stu_term.Text) & "'," & Trim(stu_age.Text) & ",'" & Trim(stu_photo.Text) & "','" & Trim(stu_add.Text) & "')"
    
    '调用addstuinfo函数添加学生信息
    If runtsql(tsql) Then
        If frmmain.check_have.Value = 0 Then
        publicmbox.pic_exit.Visible = True           '提示信息出现取消框
        Set publicmbox.Picture = publicmbox.pic6.Picture: publicmbox.Show vbModal  '提示添加成功并推荐马上更新该学员的成绩数据
        End If
        Exit Sub
    Else
        If frmmain.check_have.Value = 0 Then
        Set publicmbox.Picture = publicmbox.pic7.Picture: publicmbox.Show vbModal
        End If
    End If
End Sub
'>>>>>>>>>>>>>>>>>切换功能程序段<<<<<<<<<<<<<<<<<<
Private Sub tbutton2_Click()
    frmadd2.Top = Me.Top
    frmadd2.Left = Me.Left
    Unload Me
End Sub
'>>>>>>>>>>>>>>>>>切换功能程序段<<<<<<<<<<<<<<<<<<

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -