mainstart.frm

本系统是给大庆油田做的一个示例程序

      Height          =   480
      Index           =   10
      Left            =   540
      Picture         =   "MainStart.frx":1E80
      Top             =   540
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   11
      Left            =   540
      Picture         =   "MainStart.frx":218A
      Top             =   1080
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   12
      Left            =   540
      Picture         =   "MainStart.frx":2494
      Top             =   1620
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   13
      Left            =   540
      Picture         =   "MainStart.frx":279E
      Top             =   2160
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   14
      Left            =   540
      Picture         =   "MainStart.frx":2AA8
      Top             =   2700
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   15
      Left            =   540
      Picture         =   "MainStart.frx":2DB2
      Top             =   3240
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   16
      Left            =   600
      Picture         =   "MainStart.frx":30BC
      Top             =   3780
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Index           =   17
      Left            =   600
      Picture         =   "MainStart.frx":33C6
      Top             =   4320
      Visible         =   0   'False
      Width           =   480
   End
End
Attribute VB_Name = "MainStart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim kl As Integer, Y, ji As Integer, op As Integer

'初始化“开始”窗体事件过程
Private Sub Form_Load()
  '防止应用程序重复调用
  If App.PrevInstance = True Then
    MsgBox "已经有一个该程序的实例在运行！", vbOKOnly, "提示"
    End
  End If
  
  Dim i As Long, j As Integer, aa$, myByte As Byte
  
  '确定工作目录
  curproj = App.Path & "\8J4126\"
  mainpath$ = CurDir$
  CurPath = App.Path & "\"
  aa$ = Dir("roddatazy.ini")
  On Error Resume Next
  Me.Picture = LoadResPicture(103, vbbitmap)
  
  Rem 主界面调入。主界面存于资源内，替换101图片。
  Rem __________________________________________

  Timer1.Enabled = False   '置定时器1无效
  Picture1.Visible = False '置图片框（动画）不可见
  '初始化媒体播放控件
  MMControl1.DeviceType = "WaveAudio"
  MMControl1.Notify = False
  MMControl1.UpdateInterval = 1000#
  MMControl1.Shareable = False
  MMControl1.FileName = CurPath & "rodmusic.wav" '定义乐曲文件名
  MMControl1.Command = "open"               '打开媒体播放机
  Load FrmMain                        '调入主界面
   
  Timer2.Interval = MBackwave
  On Error GoTo ErrorHandle


    Exit Sub
myerrActivate:

    MsgBox "已到期！"
    FrmMain.MenuS.Enabled = False
    FrmMain.MenuR_Data.Enabled = False
    FrmMain.MenuR_Simulation.Enabled = False
    
  Exit Sub
ErrorHandle:
  Close
  Call Sound
 
End Sub
'“开始”窗体成为活动窗体时的事件过程
Private Sub Form_Activate()
  Dim i As Long, x, ss As String, Mx(15) As Byte
    
  ji = 0
  Text1.SetFocus           '将焦点移至“接收键入文本框”
  mimap.Visible = False    '设置“密码框”为不可见
  Text1.Text = ""          '将“接收键入文本框”置空
  Mimas = ""               '将“密码框”置空
  
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
  x = DoEvents
 
  
  Call zi                 '调用弹出说明子程序
  ss = Dir(CurPath & "rodmima.dat")
  x = FreeFile
  If ss = "" Then
    Mimasave = "dsm"
    ss = CurPath & "rodmima.dat"
    Open ss For Binary Access Write As #x '打开（创建）密码文件
    For i = 0 To Len(Mimasave) - 1
      Mx(i) = Asc(Mid$(Mimasave, i + 1, 1))
      Mx(i) = Mx(i) + 100 + i * 3
      Put #x, , Mx(i)
    Next i
    Close #x
   Else
    Open CurPath & "rodmima.dat" For Binary Access Read As #x  '打开密码数据文件
    Mimasave = ""
    For i = 0 To LOF(x) - 1
     Get #x, , Mx(i)
     Mx(i) = Mx(i) - 100 - i * 3
     Mimasave = Mimasave & Chr$(Mx(i))
    Next i
    Close #x
  End If
  
  Text1.Visible = False
End Sub
'弹出说明子程序
Private Sub zi()
  Dim i, x
  Picture1.Visible = True '设置图片框（动画）可见
  Y = 2                   '置图片计数器为第二张图片
  Timer1.Enabled = True   '启动定时器1（播放动画图片）
End Sub

'单击窗体事件过程
Private Sub Form_Click()
  Dim A As Integer, B As Integer
  A = 0                   '键盘码为0
  B = 0                   '未按Shift键
  Call Text1_KeyUp(A, B)  '调用“接收键入文本框”有键输入事件过程
End Sub

'“接收键入文本框”有键输入事件过程
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = 27 Then    '如果键入了“ESC”键
    End                   '结束软件运行
  Else                    '如果键入了其它键
    mimap.Visible = True  '置密码板为可见
    Timer3.Enabled = True '置定时器3（移入密码板至指定位置）为有效
    mimaT.SetFocus         '将焦点移至“光标文本框”
    Text1.Text = ""       '“接收键入文本框”置空
  End If
End Sub
Private Sub qtdy_Click()
    Dim k As Integer
    
    Mimas = mimaT.Text
 
    If Mimasave = "las" Then
        k = 0
    Else
        k = StrComp(Mimas, Mimasave) '输入密码与原密码比较
    End If
    
    If k = 0 Then                   '如果一致
        Timer1.Enabled = False
        Timer3.Enabled = False
        Unload Me                                   '隐藏“开始”窗体
        FrmMain.Show                              '显示主窗体
        'Call Test_Users
        Call Sound
        Set Me.Picture = Nothing
    Else                                        '否则（不一致）
        mimaT.Text = ""                            '清除密码（“＊”号）
        Mimas = ""
        mimatiui.Caption = "密码错,请重新输入！"  '提示
        mimaT.SetFocus                             '将焦点移至“光标文本框”
        'Call Test_Users
        Call Sound
    End If
    DoEvents
End Sub
'“取消”按钮单击事件过程
Private Sub quxc_Click()
  '将密码输入板移出“开始”窗体
  ji = Me.Height
  mimap.Move mimap.Left, ji
  ji = 0
  
  Text1.Visible = True
  Text1.SetFocus                             '将焦点移至“接收键入文本框”
  Text1.Text = ""                            '“接收键入文本框”置空
  mimaT.Text = ""                            '清除密码显示（“＊”号）
  Mimas = ""                                 '清除密码（“＊”号）
  Text1.Visible = False
  mimatiui.Caption = "请输入密码！"          '提示
End Sub

'“背景标签”单击事件过程
Private Sub Label1_Click()
  Call Text1_KeyUp(0, 0) '调用“接收键入文本框”有键输入事件过程
End Sub
'“说明标签1”单击事件过程
Private Sub lb1_Click()
  Call Text1_KeyUp(0, 0) '调用“接收键入文本框”有键输入事件过程
End Sub
'“说明标签3”单击事件过程
Private Sub lb3_Click()
  Call Text1_KeyUp(0, 0) '调用“接收键入文本框”有键输入事件过程
End Sub
'“说明标签4”单击事件过程
Private Sub lb4_Click()
  Call Text1_KeyUp(0, 0) '调用“接收键入文本框”有键输入事件过程
End Sub
'“图片框（动画）”单击事件过程
Private Sub Picture1_Click()
 Call Text1_KeyUp(0, 0) '调用“接收键入文本框”有键输入事件过程
End Sub

'定时器1（播放动画图片）事件过程
Private Sub Timer1_Timer()
  Y = Y + 1                             '图片计数器累加
  If Y = 18 Then Y = 0                  '如果图片计数器为18，则图片计数器清零
  Picture1.Picture = Image1(Y).Picture  '在图片框（Picture1)中调入（显示）第Y个图片
End Sub
'定时器2（播放音乐）事件过程
Private Sub Timer2_Timer()
 If Timer2.Interval = 0 Then Exit Sub
 If MMControl1.Mode = mciModeStop Then  '如果音乐文件已经播放完
   MMControl1.From = 0                  '置音乐文件开始处
   MMControl1.Command = "play"          '播放音乐
 End If
End Sub
'定时器3（移入密码板至指定位置）事件过程
Private Sub Timer3_Timer()
  ji = ji + 90                          '累加密码板移入步长
  If Me.Height - ji < Me.Height / 2 * 0.8 Then '如果到达开始界面中心
    Timer3.Enabled = False               '关掉定时器3（停止移动密码板）
    mimaT.SetFocus                        '将焦点移至“光标文本框”
    quxc.Enabled = True
  Else                                   '否则
   mimap.Left = (Me.Width - mimap.Width) / 2
   mimap.Move mimap.Left, Me.Height - ji + 1000 '移动密码板
  End If
End Sub