lx1.frm

完整的英语900句源码－采用顶条技术

    Is_Movestar_B = False
End Sub

'实现窗口拖动（静音切换label3 顶条10缇）
Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Movex = MyPoint.X - MyRect.left
      Movey = MyPoint.Y - MyRect.top
      Is_Movestar_B = True
End Sub
Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Dim dl&
      If Is_Movestar_B Then
             dl& = MoveWindow(Form1.hwnd, MyPoint.X - Movex, MyPoint.Y - Movey, _
                          MyRect.Right - MyRect.left, MyRect.Bottom, -1)
      End If
End Sub
Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Form1.left <= 0 Then Form1.left = 0 '限制不超过左边界
    If Form1.left + 6300 > Screen.Width Then Form1.left = Screen.Width - 6300 '限制不超过右边界
    Get_Windows_Rect
    Is_Movestar_B = False
End Sub

'实现窗口拖动（图标的衬底label4 ,遮挡左右穿过的字体）
Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Movex = MyPoint.X - MyRect.left
      Movey = MyPoint.Y - MyRect.top
      Is_Movestar_B = True
End Sub
Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Dim dl&
      If Is_Movestar_B Then
             dl& = MoveWindow(Form1.hwnd, MyPoint.X - Movex, MyPoint.Y - Movey, _
                          MyRect.Right - MyRect.left, MyRect.Bottom, -1)
      End If
End Sub
Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Form1.left <= 0 Then Form1.left = 0 '限制不超过左边界
    If Form1.left + 6300 > Screen.Width Then Form1.left = Screen.Width - 6300 '限制不超过右边界
    Get_Windows_Rect
    Is_Movestar_B = False
End Sub

'设置软件是否静音(双击Label3可开/关语音）
Private Sub Label3_DblClick()
  voice = Not (voice)
  If voice = -2 Then
  Label3.ToolTipText = "双击可以打开语音"
  Else
  Label3.ToolTipText = "双击可以关闭语音"
  End If
End Sub

'检测鼠标位置及软件设置及是否在启动4.2秒内，决定窗口是否自动隐藏（visi为设置变量 1 隐藏 0 不隐藏 ）
Private Sub Timer1_Timer()
        
       oncetime = oncetime - 1 '为启动计时,是否达到4.2秒
       
       '判断窗口该大该小
        Dim dl&
            dl& = GetCursorPos(MyPoint)
        If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
             (Form1.Height = max Or MyPoint.Y <= 3)) Or visi = 0 Or oncetime > 0 Then
            Form1.Height = max '窗口保持最大
        Else
            Form1.Height = 20 '窗体高度缩小为20缇
        End If

        '对启动进行计时判断，并处理时序
        If oncetime = 0 Then
           oncetime = 1
        Else
              If oncetime <= 2 Then '显示欢迎使用问候语结束，语音恢复(设置或自助窗口打开时不恢复)并清除显示
                 Label1.Caption = " "
                 If Image1.Enabled = True Then Timer5.Enabled = True: Label1.Caption = " "
              Else
                  '显示欢迎使用问候语
                    If oncetime <= 20 Then
                       Label1.Caption = " 欢迎使用E900英语朗读软件。V1.0 ！"
                    Else
                         If oncetime <= 50 Then Unload Form4: Form1.Visible = True '显示封面(form4)1.2秒后进入主程序
                         Label1.Caption = Space(oncetime - 20) + " 欢迎使用E900英语朗读软件。V1.0 ！"
                    End If
              End If
        End If

End Sub

'当隐藏时画变化颜色的线条并计算软件累计使用时间(usetime)
Private Sub Timer2_Timer()
     
     '计算软件累计使用时间(usetime达到9600即4小时开启烈焰红唇模式)
     usetime = usetime + 1
     If usetime >= 9600 Then usetime = 9600
     
     '全显示或拖动时不画彩线
     If Form1.Height = max Or Is_Movestar_B = True Then Cls: GoTo vvv
     Form1.Line (0, Form1.Height - 20)-(Form1.Width, Form1.Height), QBColor(color), BF
vvv: color = color1: color1 = color2: color2 = color

End Sub

'字幕（中文）由下向上运动，到位后停止并使自己不可用(中断值为50)
Private Sub Timer3_Timer()
       Label2.Caption = Space(1) + cstring
       If Label2.top > 60 Then
       Label2.top = Label2.top - 10
       Else
       Label2.top = 60
       Timer3.Enabled = False
       End If
End Sub

'字幕（英文）由右向左运动，到位后停止并使自己不可用(中断值为80)
Private Sub Timer4_Timer()
       Label1.Caption = Space(36 - kk) + estring
       kk = kk + 1
       If kk = 36 Then kk = 0: Timer4.Enabled = False
End Sub

'时序总控制时钟(中断值为100)
Private Sub Timer5_Timer()
        
       '延时累计开始
        delaytime = delaytime + 1
       
       '判断遍数是否到设定值
        If ntimes < n Then GoTo nonew
       
       '到遍数则清0
        ntimes = 0
        '调用产生新串子过程，开始一组新内容循环
        Call newstring
      
nonew: '判断次序
      If ce = 1 Then
         
         'ce = 1 顺序为先英后汉
         Select Case sstep '决定执行步骤
            
         Case 0
             sstep = 1 '步骤推进
            '使Timer4使能(由右到左英语)
             Timer4.Enabled = True
       
            '对英语(estring)发音,出错不做处理也不退出
             On Error Resume Next
             txtvoice.Speed = sspeed
             If voice = 1 Then txtvoice.Speak estring, vtxtst_STATEMENT Or vtxtst_QUESTION
             If Err <> 0 Then Err = 0
         Case 1
            '检查延时(delaytime),判断是否结束
             If delaytime >= 0 And delaytime < 10 * etime Then
             sstep = 1
             Else
             sstep = 2 '步骤延时推进
             End If
                    
         Case 2
             sstep = 3 '步骤推进
            '清除显示
             Label1.Caption = " "
         
            '使Timer3使能(由下到上汉语)
             Timer3.Enabled = True
         
         Case 3
            '检查延时(delaytime),判断是否结束
             If delaytime >= 10 * etime And delaytime <= 10 * (etime + ctime) Then
             sstep = 3
             Else
             sstep = 4 '步骤延时推进
             End If
  
         Case 4
             sstep = 0 '步骤推进(复位)
            '清除显示并复位Label2
             Label2.Caption = " "
             Label2.top = 400
          
            '遍数+1
             ntimes = ntimes + 1
            '延时清0
             delaytime = 0
         
         End Select
      
      Else
      
         'ce=0顺序为先汉后英
         Select Case sstep '决定执行步骤
            
         Case 0
             sstep = 1 '步骤推进
            '使Timer3使能(由下到上汉语)
             Timer3.Enabled = True
       
         Case 1
            '检查延时(delaytime),判断是否结束
             If delaytime >= 0 And delaytime < 10 * ctime Then
             sstep = 1
             Else
             sstep = 2 '步骤延时推进
             End If
                    
         Case 2
             sstep = 3 '步骤推进
            '清除显示并复位Label2
             Label2.Caption = " "
             Label2.top = 400
            
            '使Timer4使能(由右到左英语)
             Timer4.Enabled = True
            
            '对英语(estring)发音,出错不做处理也不退出
             On Error Resume Next
             txtvoice.Speed = sspeed
             If voice = 1 Then txtvoice.Speak estring, vtxtst_STATEMENT Or vtxtst_QUESTION
             If Err <> 0 Then Err = 0
         
         Case 3
            '检查延时(delaytime),判断是否结束
             If delaytime >= 10 * ctime And delaytime <= 10 * (etime + ctime) Then
             sstep = 3
             Else
             sstep = 4 '步骤延时推进
             End If
  
         Case 4
             sstep = 0 '步骤推进(复位)
            '清除显示
             Label1.Caption = " "
          
            '遍数+1
             ntimes = ntimes + 1
            '延时清0
             delaytime = 0
         
         End Select
      
      End If
      
End Sub

'产生新英语串子过程
Private Sub newstring()

        If rd = 0 Then '若随机方式则根据范围设定计算出串值

            If guage = 0 Then             '(guage=0为全范围）
               On Error Resume Next
               Randomize
               enuber = Int(100 * Rnd)
               Randomize
               enuber = enuber + 1000 * Int(9 * Rnd + 1) + 10000
               estring = LoadResString(enuber)
               cstring = LoadResString(enuber + 10000)
               If Err <> 0 Then Err = 0: MsgBox (enuber)
            Else                          '(guage<>0为分范围）
               On Error Resume Next
               Randomize
               enuber = 10000 + guage * 1000 + Int(100 * Rnd)
               estring = LoadResString(enuber)
               cstring = LoadResString(enuber + 10000)
               If Err <> 0 Then Err = 0: MsgBox (enuber)
            End If
            
            '如果红唇模式可用且被选中且随机数(7/100概率)满足,则进入烈焰红唇子过程
             Randomize
             If usetime >= 9600 And red = 1 And Int(100 * Rnd) >= 93 Then Call redpro
             
        Else '否则为顺序方式，则判断是否沿用原(guagen)存储值（范围改变，从0开始，范围未变沿用原值）

            If guage = 0 Then               '(guage=0为全范围）
               On Error Resume Next
               
               '判断是否出界(合法范围是 1*000-1*099)
               If guagen - 1000 * (Int(guagen / 1000)) > 99 Then guagen = 1000 * (11 + Int((guagen - 10000) / 1000))
               estring = LoadResString(guagen)
               cstring = LoadResString(guagen + 10000)
               If Err <> 0 Then Err = 0: MsgBox (guagen)
               guagen = guagen + 1
            Else                            '(guage<>0为分范围）
               If guage <> Int((guagen - 10000) / 1000) Then       '分类变动，进度数取该类第0个
                   guagen = 10000 + guage * 1000
                   On Error Resume Next
                   estring = LoadResString(guagen)
                   cstring = LoadResString(guagen + 10000)
                   If Err <> 0 Then Err = 0: MsgBox (guagen)
               Else                                                '分类未变，进度数用原值
                   On Error Resume Next
                   
                   '判断是否出界(合法范围是 1*000-1*099)
                   If guagen > 10000 + guage * 1000 + 99 Then guagen = 10000 + guage * 1000
                   estring = LoadResString(guagen)
                   cstring = LoadResString(guagen + 10000)
                   If Err <> 0 Then Err = 0: MsgBox (guagen)
               End If
               guagen = guagen + 1
            End If
            
            '如果红唇模式可用且被选中且随机数(7/100概率)满足,则进入烈焰红唇子过程
             Randomize
             If usetime >= 9600 And red = 1 And Int(100 * Rnd) >= 93 Then Call redpro
        
        End If

End Sub

'烈焰红唇模式子过程
Private Sub redpro()
'定义新变量eenuber、防止冲掉原值enuber
Dim eenuber As Integer
'复杂判断模块（以后再加）,出图、放音乐、生成文件、播放语音、连接网址、字体变色、播放怪符号...






'脏话、黑话、胡话、实话、利话范围（10000——10099）
   On Error Resume Next
   Randomize
   eenuber = 10000 + Int(100 * Rnd)
   'estring = LoadResString(eenuber)
   'cstring = LoadResString(eenuber + 10000)
   estring = LoadResString(10000)
   cstring = LoadResString(20000)
   '出错则返回，使用原值
   If Err <> 0 Then Err = 0: estring = LoadResString(enuber): cstring = LoadResString(enuber + 10000)
End Sub