?? lx1.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -