200+200分 - 寻按钮控件源代码（无任何外形特点、可设置图片）

Question

按钮为一矩形区域，无边框在正常、鼠标在其上面、按下鼠标时能更换图片 200分图片能支持 GIF JPG PNG 或有发声属性 200分E-mail :[email protected]分 + 200分 + 万分感谢

Answer 1

http://www.applevb.com/sourcecode/WINDOWS%20XP%20CONTROLS%20created%20in%20VB6.zip
http://www.applevb.com/sourcecode/CHAMELEON%20BUTTON.zip

Answer 2

http://www.dapha.net/down/list.asp?id=1607

Answer 3

http://www.dapha.net/down/list.asp?id=1607

Answer 4

http://www.dapha.net/down/list.asp?id=1076

Answer 5

lihonggen0(李洪根,用.NET，标准答案来了)
所提供的两种按钮我都有，不过无法在无边框情况下设置各种鼠标行为图片。

Answer 6

小熊 和 ipman 的提供给我的按钮代码都很好，但可惜无法让边框消失，最好是可以使用 PNG/GIF 文件作为图片的，有没有发声属性都不重要。如果使用GIF文件时能使图片透明部分不响应鼠标的操作我另出200分。

Answer 7

http://www.csdn.net/cnshare/soft/15/15784.shtm
http://www.csdn.net/cnshare/soft/15/15785.shtm  看看我的吧

Answer 8

如果按钮符合以下描述，我就用现金 256 元购买其源代码：
有边框属性但可设置为 false 使边框完全消失；
有发声属性；
不能有焦点框；
文字对齐方式为按钮区域的正中，并可设置文字的属性；
可使用 BMP JPG GIF PNG 作为其外形；--------------------------------------
当其处于“未获得焦点、获得焦点、鼠标悬停其上且未获得焦点、鼠标悬停其上并获得焦点、按下”这几种状态时均能设置独立的图片；
当其处于“未获得焦点、获得焦点、鼠标悬停其上且未获得焦点、鼠标悬停其上并获得焦点、按下”这几种状态时均能以不同的颜色填充按钮区域；
--------------------------------------该按钮占用的资源不能太高；
该按钮控件中不能包含其他任何控件；
该按钮在程序中同时出现约 32 个时不会导致系统资源短缺。
请各位帮帮忙。

Answer 9

Speedies(Speedies) 你说的问题小小的修改就可解决 .我的控件都是用API实现的,没有加其他空间,不然占用会很高.utiao(天下文章) 你说的问题我没遇到过, 请说说详情, 我好修改.

Answer 10

我用向导作了一个
VERSION 5.00
Begin VB.UserControl UserControl1 
   ClientHeight    =   2520
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3975
   ScaleHeight     =   2520
   ScaleWidth      =   3975
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1095
      Left            =   600
      ScaleHeight     =   1095
      ScaleWidth      =   2895
      TabIndex        =   0
      Top             =   480
      Width           =   2895
   End
End
Attribute VB_Name = "UserControl1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option ExplicitPrivate Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long'事件声明:
Event Click() 'MappingInfo=Picture1,Picture1,-1,Click
Event DblClick() 'MappingInfo=Picture1,Picture1,-1,DblClick
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Picture1,Picture1,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Picture1,Picture1,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Picture1,Picture1,-1,MouseUp
'属性变量:
Dim m_MoveOverWave As String
Dim m_MouseDownWave As String
Dim m_bMovein As Boolean
Dim m_NormalPic As Picture
Dim m_MoveOverPic As Picture
Dim m_MouseDownPic As Picture
'缺省属性值:
Const m_def_MoveOverWave = ""
Const m_def_MouseDownWave = ""
Const m_def_bMovein = False'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/设置对象中文本和图形的背景色。"
    BackColor = UserControl.BackColor
End PropertyPublic Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置一个值，决定一个对象是否响应用户生成事件。"
    Enabled = UserControl.Enabled
End PropertyPublic Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As Integer
Attribute BackStyle.VB_Description = "指出 Label 或 Shape 的背景样式是透明的还是不透明的。"
    BackStyle = UserControl.BackStyle
End PropertyPublic Property Let BackStyle(ByVal New_BackStyle As Integer)
    UserControl.BackStyle() = New_BackStyle
    PropertyChanged "BackStyle"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "返回/设置对象的边框样式。"
    BorderStyle = UserControl.BorderStyle
End PropertyPublic Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    UserControl.BorderStyle() = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=Picture1,Picture1,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "强制完全重画一个对象。"
    Picture1.Refresh
End SubPrivate Sub Picture1_Click()
    RaiseEvent Click
End SubPrivate Sub Picture1_DblClick()
    RaiseEvent DblClick
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Set Picture1.Picture = m_MouseDownPic
    If MouseDownWave <> "" Then
            Call sndPlaySound(MouseDownWave, 2)
    End If
    
    RaiseEvent MouseDown(Button, Shift, X, Y)
    
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With Picture1
    
        If Not ((X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height)) Then
        
            ReleaseCapture
        
            If Not m_bMovein Then m_bMovein = True
        
            SetCapture Picture1.hwnd
            
            Set Picture1.Picture = m_MoveOverPic
            If MoveOverWave <> "" Then
                Call sndPlaySound(MoveOverWave, 2)
            End If
        
        Else
          
            m_bMovein = True
            
            Set Picture1.Picture = m_NormalPic        End If
        
    End With
    
    RaiseEvent MouseMove(Button, Shift, X, Y)
    
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub'注意！不要删除或修改下列被注释的行！
'MappingInfo=Picture1,Picture1,-1,AutoSize
Public Property Get AutoSize() As Boolean
Attribute AutoSize.VB_Description = "返回/设置一个值，决定是否调整图形的大小以适应图像控件。"
    AutoSize = Picture1.AutoSize
End PropertyPublic Property Let AutoSize(ByVal New_AutoSize As Boolean)
    Picture1.AutoSize() = New_AutoSize
    PropertyChanged "AutoSize"
End Property'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    Picture1.AutoSize = PropBag.ReadProperty("AutoSize", False)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    Picture1.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    Set m_NormalPic = PropBag.ReadProperty("NormalPic", Nothing)
    Set m_MoveOverPic = PropBag.ReadProperty("MoveOverPic", Nothing)
    Set m_MouseDownPic = PropBag.ReadProperty("MouseDownPic", Nothing)
    m_bMovein = PropBag.ReadProperty("bMovein", m_def_bMovein)
    
    Set Picture1.Picture = NormalPic
    
    m_MoveOverWave = PropBag.ReadProperty("MoveOverWave", m_def_MoveOverWave)
    m_MouseDownWave = PropBag.ReadProperty("MouseDownWave", m_def_MouseDownWave)
End Sub
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
    Call PropBag.WriteProperty("AutoSize", Picture1.AutoSize, False)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", Picture1.MousePointer, 0)
    Call PropBag.WriteProperty("NormalPic", m_NormalPic, Nothing)
    Call PropBag.WriteProperty("MoveOverPic", m_MoveOverPic, Nothing)
    Call PropBag.WriteProperty("MouseDownPic", m_MouseDownPic, Nothing)
    Call PropBag.WriteProperty("bMovein", m_bMovein, m_def_bMovein)
    Call PropBag.WriteProperty("MoveOverWave", m_MoveOverWave, m_def_MoveOverWave)
    Call PropBag.WriteProperty("MouseDownWave", m_MouseDownWave, m_def_MouseDownWave)
End Sub

Answer 11

Private Sub UserControl_Resize()
    Picture1.Move UserControl.ScaleLeft, UserControl.ScaleTop, UserControl.ScaleWidth, UserControl.ScaleHeight
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=Picture1,Picture1,-1,MouseIcon
Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "设置一个自定义鼠标图标。"
    Set MouseIcon = Picture1.MouseIcon
End PropertyPublic Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set Picture1.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property'注意！不要删除或修改下列被注释的行！
'MappingInfo=Picture1,Picture1,-1,MousePointer
Public Property Get MousePointer() As Integer
Attribute MousePointer.VB_Description = "返回/设置当鼠标经过对象某一部分时鼠标的指针类型。"
    MousePointer = Picture1.MousePointer
End PropertyPublic Property Let MousePointer(ByVal New_MousePointer As Integer)
    Picture1.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property'注意！不要删除或修改下列被注释的行！
'MemberInfo=11,0,0,0
Public Property Get NormalPic() As Picture
    Set NormalPic = m_NormalPic
End PropertyPublic Property Set NormalPic(ByVal New_NormalPic As Picture)
    
    Set m_NormalPic = New_NormalPic
    
    Set Picture1.Picture = NormalPic
    
    PropertyChanged "NormalPic"
    
End Property'注意！不要删除或修改下列被注释的行！
'MemberInfo=11,0,0,0
Public Property Get MoveOverPic() As Picture
    Set MoveOverPic = m_MoveOverPic
End PropertyPublic Property Set MoveOverPic(ByVal New_MoveOverPic As Picture)
    Set m_MoveOverPic = New_MoveOverPic
    PropertyChanged "MoveOverPic"
End Property'注意！不要删除或修改下列被注释的行！
'MemberInfo=11,0,0,0
Public Property Get MouseDownPic() As Picture
    Set MouseDownPic = m_MouseDownPic
End PropertyPublic Property Set MouseDownPic(ByVal New_MouseDownPic As Picture)
    Set m_MouseDownPic = New_MouseDownPic
    PropertyChanged "MouseDownPic"
End Property'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    Set m_NormalPic = LoadPicture("")
    Set m_MoveOverPic = LoadPicture("")
    Set m_MouseDownPic = LoadPicture("")
    m_bMovein = m_def_bMovein
    m_MoveOverWave = m_def_MoveOverWave
    m_MouseDownWave = m_def_MouseDownWave
End Sub'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,False
Public Property Get bMovein() As Boolean
    bMovein = m_bMovein
End PropertyPublic Property Let bMovein(ByVal New_bMovein As Boolean)
    m_bMovein = New_bMovein
    PropertyChanged "bMovein"
End Property
'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,
Public Property Get MoveOverWave() As String
    MoveOverWave = m_MoveOverWave
End PropertyPublic Property Let MoveOverWave(ByVal New_MoveOverWave As String)
    m_MoveOverWave = New_MoveOverWave
    PropertyChanged "MoveOverWave"
End Property'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,
Public Property Get MouseDownWave() As String
    MouseDownWave = m_MouseDownWave
End PropertyPublic Property Let MouseDownWave(ByVal New_MouseDownWave As String)
    m_MouseDownWave = New_MouseDownWave
    PropertyChanged "MouseDownWave"
End Property

Answer 12

做的比较简单，其中声音文件用断一点的wave文件
VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   3780
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5355
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3780
   ScaleWidth      =   5355
   StartUpPosition =   3  '窗口缺省
   Begin 工程1.UserControl1 UserControl11 
      Height          =   855
      Left            =   1200
      TabIndex        =   0
      Top             =   720
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   1508
      NormalPic       =   "Form1.frx":0000
      MoveOverPic     =   "Form1.frx":25D2
      MouseDownPic    =   "Form1.frx":4BA4
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Sub Form_Load()
    With UserControl11
        Set .NormalPic = LoadPicture(App.Path & "\1.bmp")
        Set .MoveOverPic = LoadPicture(App.Path & "\2.bmp")
        Set .MouseDownPic = LoadPicture(App.Path & "\3.bmp")
        .MoveOverWave = App.Path & "\1.wav"
        .MouseDownWave = App.Path & "\2.wav"
    End With
End Sub

Answer 13

我也要一份，唐人大哥，小弟信箱：[email protected]
谢谢