📄 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 + -