首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

还有50分,图片部分凸起的效果

2012-03-02 
还有50分,求一个图片部分凸起的效果有一个大的图片,我想鼠标移动的时候我规定的范围图片凸起(或者画个边框

还有50分,求一个图片部分凸起的效果
有一个大的图片,我想鼠标移动的时候我规定的范围图片凸起(或者画个边框啥的也行),这些坐标点我会先存放到一个数组里,可以判断当前x,y是否在这个范围内,不过怎么凸起呢?这个是不是要把这个区域的图片剪切过来放到一个图片框?然后这个图片框位置移动一下?
最好是代码,,,思路也行,不过最好还是有代码好点,实在是不会搞

[解决办法]
给你一个比较完整的方案吧:
窗体上放一个picturebox 暂且命名为picture1,尺寸别放太小啊免得代码设定的热点区域显示不出来,给他的picture属性里面赋予一张图片,也别太小啊。
在picture1里面放两个picturebox 分别命名为picture2 和 picture3
然后粘贴下面的代码。

VB code
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
VB code
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 

热点排行