vb手写笔迹源代码.frm

Height = 615
Left = 6840
Style = 1 'Graphical
TabIndex = 4
Top = 3840
Top = 4560
Width = 975
End
Begin VB.TextBox TextLineWidth
Height = 375
Left = 2640
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
Rem 防止执行多次
Private Sub Form_Initialize()
Begin mandButton Command2
Caption = "删除"
Height = 615
Left = 4320
TabIndex = 5
BorderStyle = 0 'None
FillStyle = 0 'Solid
Height = 3615
Left = 0
ScaleHeight = 3615
If App.PrevInstance Then End
End Sub
Private Sub Command1_Click()
' Picture1.PaintPicture Picture1.Image, 0, 0, Picture1.width / 2, Picture1.Height / 2, 0, 0, Picture1.width / 3, Picture1.Height / 3
Rem 移动没有标题栏窗体的声明
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Picture1.Picture = Picture1.Image
Rem 窗口置顶的声明
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
VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "原笔迹"
ClientHeight = 5010
ClientLeft = 60
Rem 模拟按键声明
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Rem 禁止本窗体拥有输入焦点的常数
Width = 1815
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H8000000E&
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
SpeedDoor = Val(TextSpeed.Text)
LineWidth = Val(TextLineWidth.Text)
widthAdd = Val(TextAdd.Text)
Picture1.DrawWidth = LineWidth
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command2_Click()
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Rem 转移输入焦点的声明
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
ToolTipText = "平均书写速度"
Top = 4560
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Private Const HWND_NOTOPMOST = -2
Private Const WS_DISABLED = &H8000000
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)
Rem 窗口置顶的常数
Dim lastX, lastY As Single
Dim LineWidth As Single
Dim lastWidth As Single
Dim SpeedDoor As Single
Dim widthAdd As Single
Dim lastSpeed As Single
Dim times As Integer
ScaleWidth = 8775
TabIndex = 3
Top = 120
Width = 8775
End
Begin VB.TextBox TextAdd
Height = 375
Left = 4080
TabIndex = 2
Text = "0.1"
ToolTipText = "笔画粗细增加量"
ClientTop = 450
ClientWidth = 8805
LinkTopic = "Form1"
ScaleHeight = 5010
ScaleWidth = 8805
StartUpPosition = 2 '屏幕中心
TabIndex = 1
Text = "5"
ToolTipText = "笔画最大宽度"
Top = 4560
Width = 975
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_DISABLED
Rem 移动没有标题栏窗体的常数
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Rem 模拟按钮常数
Private Const KEYEVENTF_KEYUP = &H2
Dim IsMouseDown As Boolean
SendKeys "{BKSP}"
Clipboard.Clear
Picture1.Picture = Nothing
End Sub
Rem 以下是程序执行主体部分
Rem 窗体调用时置顶，且禁止拥有输入焦点
Private Sub Form_Load()
Me.Show
Top = 3840
Width = 2175
End
Begin mandButton Command1
BackColor = &H8000000E&
Caption = "复制"
End
Begin VB.TextBox TextSpeed
Height = 375
Left = 1080
TabIndex = 0
பைடு நூலகம்Text = "10"
IsMouseDown = False
times = 0
End Sub
Rem 鼠标移动到窗体上时，窗体置顶
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)