还有50分,求一个图片部分凸起的效果
有一个大的图片,我想鼠标移动的时候我规定的范围图片凸起(或者画个边框啥的也行),这些坐标点我会先存放到一个数组里,可以判断当前x,y是否在这个范围内,不过怎么凸起呢?这个是不是要把这个区域的图片剪切过来放到一个图片框?然后这个图片框位置移动一下?
最好是代码,,,思路也行,不过最好还是有代码好点,实在是不会搞
[解决办法]
给你一个比较完整的方案吧:
窗体上放一个picturebox 暂且命名为picture1,尺寸别放太小啊免得代码设定的热点区域显示不出来,给他的picture属性里面赋予一张图片,也别太小啊。
在picture1里面放两个picturebox 分别命名为picture2 和 picture3
然后粘贴下面的代码。
Option Explicit '二维数组存储热点区域, '第一维表示热点编号,这里我们暂定两个区域 '第二维数组分别表示热点区域的left top right bottom Dim MyRect(1 To 2, 1 To 4) As Long '记录鼠标在picture1上的最后位置 Dim CurX As Long, CurY As LongPrivate Sub Form_Load() 'picture2作为突起显示的浮动图层 Picture2.BorderStyle = 0 Picture2.Appearance = 0 Picture2.Visible = False 'picture3作为阴影图层 Picture3.BorderStyle = 0 Picture3.Appearance = 0 Picture3.Visible = False '全部用像素作为计量单位 Picture1.ScaleMode = 3 Picture2.ScaleMode = 3 '设定自动重绘 Picture2.AutoRedraw = True '阴影暂用黑色,凭你喜好 Picture3.BackColor = vbBlack '设定一下zorder 阴影要放在图片下面 Picture2.ZOrder 0 Picture3.ZOrder 1 '定义两个区域,分别为100*50 和 100 * 100 的 一个上一个下 MyRect(1, 1) = 50: MyRect(1, 2) = 50: MyRect(1, 3) = MyRect(1, 1) + 100: MyRect(1, 4) = MyRect(1, 2) + 50 MyRect(2, 1) = 50: MyRect(2, 2) = 150: MyRect(2, 3) = MyRect(2, 1) + 100: MyRect(2, 4) = MyRect(2, 2) + 100 End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Integer '遍历预设的热点区域 For i = LBound(MyRect, 1) To UBound(MyRect, 1) '判定鼠标位置落入热点区域了 If X >= MyRect(i, 1) And X <= MyRect(i, 3) And Y >= MyRect(i, 2) And Y <= MyRect(i, 4) Then If Picture2.Visible = False Then '摆放浮动图层 Picture2.Left = MyRect(i, 1) - 3 Picture2.Top = MyRect(i, 2) - 3 Picture2.Width = MyRect(i, 3) - MyRect(i, 1) Picture2.Height = MyRect(i, 4) - MyRect(i, 2) '摆放阴影图层 Picture3.Left = MyRect(i, 1) Picture3.Top = MyRect(i, 2) Picture3.Width = MyRect(i, 3) - MyRect(i, 1) Picture3.Height = MyRect(i, 4) - MyRect(i, 2) Picture2.PaintPicture Picture1.Image, _ 0, _ 0, _ MyRect(i, 3) - MyRect(i, 1), _ MyRect(i, 4) - MyRect(i, 2), _ MyRect(i, 1), _ MyRect(i, 2), _ MyRect(i, 3) - MyRect(i, 1), _ MyRect(i, 4) - MyRect(i, 2) Picture2.Visible = True Picture3.Visible = True Exit For Else End If Else Picture2.Visible = False Picture3.Visible = False End If Next CurX = X: CurY = YEnd SubPrivate Sub Picture2_Click() Dim i As Integer '遍历预设的热点区域 For i = LBound(MyRect, 1) To UBound(MyRect, 1) '判定鼠标位置落入热点区域了 If CurX >= MyRect(i, 1) And CurX <= MyRect(i, 3) And CurY >= MyRect(i, 2) And CurY <= MyRect(i, 4) Then MsgBox "鼠标点击" & i & "区域" End If NextEnd Sub
[解决办法]
只要一个 PictureBox1
Option ExplicitPrivate Const BDR_RAISEDINNER As Long = &H4Private Const BDR_RAISEDOUTER As Long = &H1Private Const EDGE_RAISED As Long = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)Private Const BF_LEFT As Long = &H1Private Const BF_TOP As Long = &H2Private Const BF_RIGHT As Long = &H4Private Const BF_BOTTOM As Long = &H8Private Const BF_RECT As Long = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)Private Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Declare Function DrawEdge Lib "user32.dll" ( _ ByVal hdc As Long, _ ByRef qrc As RECT, _ ByVal edge As Long, _ ByVal grfFlags As Long) As LongPrivate Declare Function PtInRect Lib "user32.dll" ( _ ByRef lpRect As RECT, _ ByVal x As Long, _ ByVal y As Long) As LongPrivate Declare Function SetRect Lib "user32.dll" ( _ ByRef lpRect As RECT, _ ByVal X1 As Long, _ ByVal Y1 As Long, _ ByVal X2 As Long, _ ByVal Y2 As Long) As LongPrivate m_pic As IPictureDispPrivate m_HotArea() As RECTPrivate m_LastFocus As LongPrivate Sub Form_Load() Set m_pic = LoadPicture("C:\WINDOWS\Web\Wallpaper\Bliss.bmp") ReDim m_HotArea(1) SetRect m_HotArea(0), 10, 10, 50, 50 SetRect m_HotArea(1), 100, 100, 200, 200 m_LastFocus = -1 Picture1.AutoRedraw = True Picture1.ScaleMode = vbPixels Picture1.PaintPicture m_pic, 0, 0End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim i As Long For i = UBound(m_HotArea) To 0 Step -1 If PtInRect(m_HotArea(i), x, y) <> 0 Then Exit For End If Next If i <> m_LastFocus Then Picture1.PaintPicture m_pic, 0, 0 If i <> -1 Then DrawEdge Picture1.hdc, m_HotArea(i), EDGE_RAISED, BF_RECT Picture1.Refresh End If m_LastFocus = i End IfEnd Sub