?? lx1.frm
字號:
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00AAD59B&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 1770
ClientLeft = 870
ClientTop = 1380
ClientWidth = 6300
FillStyle = 2 'Horizontal Line
Icon = "lx1.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 1770
ScaleWidth = 6300
ShowInTaskbar = 0 'False
Begin VB.Timer Timer5
Enabled = 0 'False
Interval = 100
Left = 2730
Top = 1095
End
Begin VB.Timer Timer4
Interval = 80
Left = 2100
Top = 1095
End
Begin VB.Timer Timer3
Interval = 50
Left = 1470
Top = 1095
End
Begin VB.Timer Timer2
Interval = 1500
Left = 840
Top = 1095
End
Begin VB.Timer Timer1
Interval = 60
Left = 210
Top = 1095
End
Begin VB.Label Label2
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "由下而上的實驗"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H008F0901&
Height = 330
Left = 0
TabIndex = 1
Top = 400
Width = 5805
End
Begin VB.Shape Shape1
Height = 330
Left = 0
Top = 10
Width = 6300
End
Begin VB.Label Label3
Appearance = 0 'Flat
BackColor = &H80000003&
ForeColor = &H80000008&
Height = 10
Left = 0
TabIndex = 2
Top = 0
Width = 6300
End
Begin VB.Image Image1
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Height = 270
Left = 5985
Picture = "lx1.frx":030A
Top = 45
Width = 270
End
Begin VB.Label Label4
BackColor = &H00AAD59B&
BeginProperty Font
Name = "MS Serif"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 5900
TabIndex = 3
Top = 10
Width = 410
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H00AAD59B&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H008F0901&
Height = 280
Left = 0
TabIndex = 0
Top = 50
Width = 11880
WordWrap = -1 'True
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'程序∶張新華(tooboy,2001.12)
'獲得鼠標指針在屏幕坐標上的位置
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'獲得窗口在屏幕坐標中的位置
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'判斷指定的點是否在指定的矩形內部
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
'準備用來使窗體始終在最前面
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'用來移動窗體
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const HWND_TOPMOST = -1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
left As Long
top As Long
Right As Long
Bottom As Long
End Type
Dim txtvoice As New VTxtAuto.VTxtAuto '引用文本發音引擎
Private Is_Movestar_B As Boolean '判斷移動是否開始的標志(true 拖動狀態 )
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long '記錄窗體移動前，窗體左上角與鼠標指針位置間的縱橫距離
Private max As Long '窗口變長以后的尺寸(根據字體可有2種選擇暫時未使用)
Private kk As Integer '用來控制左右字幕插入的空格數量
Private color As Integer, color1 As Integer, color2 As Integer '定義彩線的顏色變量
Private estring As String '用來記錄英語的字符串
Private cstring As String '用來記錄漢語的字符串
Private enuber As Integer '用來記錄英語的位置，用以求對應漢語
'主程序入口
Private Sub Form_Load()
'判斷是否重入
Dim title As String
If App.PrevInstance Then
title = App.title
'Call MsgBox("程序已執行", vbCritical) '可以顯示提示
App.title = "" '如此才不會Avtivate到自己
AppActivate title '激活先前就已執行的程序
End
End If
'啟動時對發音引擎進行初始化
Set txtvoice = Nothing
txtvoice.Register vbNullString, " "
'判斷是否是首次運行
xxx = GetSetting("tooboy", "e900", "xxx")
If xxx <> "" Then GoTo readreg
Randomize '首次運行產生軟件編號（6位整隨機數）
softcode = Int(Rnd * 900000 + 100000)
SaveSetting "tooboy", "e900", "ce", 1 '首次運行設定默認初值
SaveSetting "tooboy", "e900", "n", 2
SaveSetting "tooboy", "e900", "ctime", 3
SaveSetting "tooboy", "e900", "etime", 5
SaveSetting "tooboy", "e900", "rd", 0
SaveSetting "tooboy", "e900", "psave", 1
SaveSetting "tooboy", "e900", "ssave", 1
SaveSetting "tooboy", "e900", "visi", 1
SaveSetting "tooboy", "e900", "voice", 1
SaveSetting "tooboy", "e900", "guage", 1
SaveSetting "tooboy", "e900", "guagen", 11000
SaveSetting "tooboy", "e900", "red", 0
SaveSetting "tooboy", "e900", "mark", 0
SaveSetting "tooboy", "e900", "xxx", 1
SaveSetting "tooboy", "e900", "softcode", softcode
SaveSetting "tooboy", "e900", "sn", 888888
SaveSetting "tooboy", "e900", "left", Screen.Width / 2 - 2000
SaveSetting "tooboy", "e900", "sspeed", 150
SaveSetting "tooboy", "e900", "usetime", 0
readreg: ce = GetSetting("tooboy", "e900", "ce") '非首次運行每次讀取設定值并初始化變量
n = GetSetting("tooboy", "e900", "n")
ctime = GetSetting("tooboy", "e900", "ctime")
etime = GetSetting("tooboy", "e900", "etime")
rd = GetSetting("tooboy", "e900", "rd")
psave = GetSetting("tooboy", "e900", "psave")
ssave = GetSetting("tooboy", "e900", "ssave")
visi = GetSetting("tooboy", "e900", "visi")
voice = GetSetting("tooboy", "e900", "voice")
guage = GetSetting("tooboy", "e900", "guage")
guagen = GetSetting("tooboy", "e900", "guagen")
red = GetSetting("tooboy", "e900", "red")
mark = GetSetting("tooboy", "e900", "mark")
xxx = GetSetting("tooboy", "e900", "xxx")
softcode = GetSetting("tooboy", "e900", "softcode")
sn = GetSetting("tooboy", "e900", "sn")
left = GetSetting("tooboy", "e900", "left")
sspeed = GetSetting("tooboy", "e900", "sspeed")
usetime = GetSetting("tooboy", "e900", "usetime")
'判斷從注冊表讀取的累計時間值的合法性(合法-使用,否-清0)防止修改注冊表方法直入烈焰紅唇模式
If Int((usetime - 1) / 3) <> (usetime - 1) / 3 Then
usetime = 0
Else
usetime = (usetime - 1) / 3
End If
'初始化窗體位置和定時器、顏色、延時值
Form1.top = 0: Form1.left = left
Form1.Visible = False
Form4.top = Screen.Height / 2 - 1500: Form4.left = Screen.Width / 2
Form4.Visible = True
Timer1.Interval = 60
Timer2.Interval = 1500
Timer3.Enabled = False
Timer4.Enabled = False
Timer5.Enabled = False
delaytime = 0 '計時初值為0
sstep = 0: '從頭第一步
color = 10: color1 = 12: color2 = 10 '定義變色彩線初值
oncetime = 70 '啟動后推遲4.2秒(用來顯示歡迎畫面)隱藏窗口（70*Timer1=4200=4.2秒）
'計算一組新串為首次播放使用
Call newstring
'初始化開/關聲音的提示信息
If voice = -2 Then
Label3.ToolTipText = "雙擊可以打開語音"
Else
Label3.ToolTipText = "雙擊可以關閉語音"
End If
'設置窗體在最前
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.left / Screen.TwipsPerPixelX, _
Me.top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
'調用窗體置頂部子過程
Get_Windows_Rect
End Sub
'窗體始終放在屏幕頂部子過程
Sub Get_Windows_Rect()
Dim dl&
max = 340: Form1.Height = max
Form1.top = 0
dl& = GetWindowRect(Form1.hwnd, MyRect)
End Sub
'鼠標經過頭像圖標彈出菜單
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Form1.PopupMenu Form2.mnu_file, vbPopupMenuRightAlign, 6300, max + 10
End Sub
'實現窗口拖動（左右字幕label1）
Private Sub Label1_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 Label1_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 Label1_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
'實現窗口拖動（上下字幕label2）
Private Sub Label2_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 Label2_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 Label2_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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -