vb为什么两个窗口单机第一个出现第二个后图片控件不能跟随鼠标动

 我来答
明槐宸739
2016-05-10 · TA获得超过1045个赞
知道大有可为答主
回答量:1507
采纳率:92%
帮助的人:463万
展开全部
现提供会跟随鼠标动的眼睛的VB源码。希望对你有所帮助。
一、打开VB,选择菜单“新建-ActiveX控件”,在窗体内
添加一个时间控件:timer(name=tmrEyes)
然后复制以下代码,并保存为Eye.ctl退出。
=============tmrEyes=======================
Option Explicit

Private Type POINTAPI
x As Long
y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

'Default Property Values:
Const m_def_EdgeColor = vbBlack
Const m_def_PupilColor = vbBlack
Const m_def_EyeballColor = vbWhite
'Property Variables:
Dim m_EdgeColor As OLE_COLOR
Dim m_PupilColor As OLE_COLOR
Dim m_EyeballColor As OLE_COLOR

' Drawing dimensions.
Private cx1 As Single
Private cx2 As Single
Private cy As Single
Private radius1 As Single
Private radius2 As Single
Private aspect As Single
Private hgt As Single
Private wid As Single
' Draw one eyeball.
Private Sub DrawEye(ByVal x1 As Single, ByVal y1 As Single, ByVal x As Single, ByVal y As Single)
Dim x2 As Single
Dim y2 As Single
Dim dx As Single
Dim dy As Single
Dim dist As Single

' Draw the outside of the eye.
FillColor = m_EyeballColor
Circle (x1, y1), radius1, m_EdgeColor, , , aspect

dx = x - x1
dy = y - y1
dist = Sqr(dx * dx + dy * dy)
If dist > 0 Then
dx = dx / dist
dy = dy / dist
Else
dx = 0
dy = 0
End If

' Draw the pupil.
x2 = x1 + wid * dx / 2
y2 = y1 + hgt * dy / 2
FillColor = m_PupilColor
Circle (x2, y2), radius2, m_PupilColor, , , aspect
End Sub
' Draw the eyes looking at the indicated point.
Private Sub DrawEyes(ByVal x As Single, ByVal y As Single)
Cls
DrawEye cx1, cy, x, y
DrawEye cx2, cy, x, y
End Sub
' Display the about dialog.
Public Sub ShowAbout()
AboutForm.Show
End Sub

' Draw the eyes looking toward the cursor.
Private Sub tmrEyes_Timer()
Static LastX As Long
Static LastY As Long

Dim pt As POINTAPI

If Not Ambient.UserMode Then Exit Sub

' See where the cursor is.
GetCursorPos pt

' If the cursor hasn't moved, do nothing.
If (LastX = pt.x) And (LastY = pt.y) _
Then Exit Sub
LastX = pt.x
LastY = pt.y

' Convert into form coordinates.
ScreenToClient hwnd, pt

' Draw the eyes.
DrawEyes pt.x, pt.y
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
UserControl.BackColor() = New_BackColor
PropertyChanged "BackColor"
If Not Ambient.UserMode Then _
DrawEyes ScaleWidth * 1.5, ScaleHeight
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=tmrEyes,tmrEyes,-1,Interval
Public Property Get Interval() As Long
Interval = tmrEyes.Interval
End Property

Public Property Let Interval(ByVal New_Interval As Long)
tmrEyes.Interval() = New_Interval
PropertyChanged "Interval"
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_EdgeColor = m_def_EdgeColor
m_PupilColor = m_def_PupilColor
m_EyeballColor = m_def_EyeballColor
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
tmrEyes.Interval = PropBag.ReadProperty("Interval", 1000)
m_EdgeColor = PropBag.ReadProperty("EdgeColor", m_def_EdgeColor)
m_PupilColor = PropBag.ReadProperty("PupilColor", m_def_PupilColor)
m_EyeballColor = PropBag.ReadProperty("EyeballColor", m_def_EyeballColor)
tmrEyes.Enabled = PropBag.ReadProperty("Enabled", True)

' Make it draw now.
tmrEyes_Timer
End Sub

' Save dimensions for later drawing.
Private Sub UserControl_Resize()

cx1 = ScaleWidth * 0.25
cx2 = ScaleWidth * 0.75
cy = ScaleHeight * 0.5

hgt = ScaleHeight * 0.4
wid = ScaleWidth / 2 * 0.4
If hgt > wid Then
radius1 = hgt
Else
radius1 = wid
End If
radius2 = radius1 * 0.5
aspect = hgt / wid

If Not Ambient.UserMode Then _
DrawEyes ScaleWidth * 1.5, ScaleHeight
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
Call PropBag.WriteProperty("Interval", tmrEyes.Interval, 1000)
Call PropBag.WriteProperty("EdgeColor", m_EdgeColor, m_def_EdgeColor)
Call PropBag.WriteProperty("PupilColor", m_PupilColor, m_def_PupilColor)
Call PropBag.WriteProperty("EyeballColor", m_EyeballColor, m_def_EyeballColor)
Call PropBag.WriteProperty("Enabled", tmrEyes.Enabled, True)
End Sub
Public Property Get EdgeColor() As OLE_COLOR
EdgeColor = m_EdgeColor
End Property

Public Property Let EdgeColor(ByVal New_EdgeColor As OLE_COLOR)
m_EdgeColor = New_EdgeColor
PropertyChanged "EdgeColor"
If Not Ambient.UserMode Then _
DrawEyes ScaleWidth * 1.5, ScaleHeight
End Property

Public Property Get PupilColor() As OLE_COLOR
PupilColor = m_PupilColor
End Property

Public Property Let PupilColor(ByVal New_PupilColor As OLE_COLOR)
m_PupilColor = New_PupilColor
PropertyChanged "PupilColor"
If Not Ambient.UserMode Then _
DrawEyes ScaleWidth * 1.5, ScaleHeight
End Property

Public Property Get EyeballColor() As OLE_COLOR
EyeballColor = m_EyeballColor
End Property

Public Property Let EyeballColor(ByVal New_EyeballColor As OLE_COLOR)
m_EyeballColor = New_EyeballColor
PropertyChanged "EyeballColor"
If Not Ambient.UserMode Then _
DrawEyes ScaleWidth * 1.5, ScaleHeight
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=tmrEyes,tmrEyes,-1,Enabled
Public Property Get Enabled() As Boolean
Enabled = tmrEyes.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
tmrEyes.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
============================================
二、新建一个工程,选择菜单“工程-添加-添加文件”,引入上述控件后双击该控件,并输入以下代码:
Private Sub Form_Resize()
Eyes1.Move 0, 0, ScaleWidth / 5, ScaleHeight / 5
End Sub
三、现在运行程序,看看效果吧!:-)
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式