★★★快来抢100分★★★:考考大家，如何做椭圆形按钮控件？？

Question

我不知道～我只是在想，你会画圆圈吗，那么椭圆那，就是用那个绘图控件啊，那么在他的click里写代码不就行了吗～除非你非得用模块，类模块，改变他按钮的外形……

Answer 1

先用第一个函数建一个椭圆区域，并返回该区域的区柄，然后用第二个函数指定窗口样式就要以把窗口变成椭圆了，把这些用在usercontrol上，就可以得到一个椭圆按钮，具体自己想一想。
*******************************************
Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 
说明 
创建一个椭圆，该椭圆与X1，Y1和X2，Y2坐标点确定的矩形内切 
返回值 
Long，执行成功则为区域句柄，失败则为零 
参数表 
参数 类型及说明 
X1,Y1 Long，矩形左上角X，Y坐标 
X2,Y2 Long，矩形右下角X，Y坐标 
注解 
不用时一定要用DeleteObject函数删除区域。用Ellipse API函数绘出的椭圆与该椭圆区域不完全相同，因为本函数的绘图计算不包括矩形的下边和右边************************************************
 
VB声明 
Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long 
说明 
这是那些很难有人注意到的对编程者来说是个巨大的宝藏的隐含的API函数中的一个。本函数允许您改变窗口的区域。
通常所有窗口都是矩形的——窗口一旦存在就含有一个矩形区域。本函数允许您放弃该区域。这意味着您可以创建圆的、星形的窗口，也可以将它分为两个或许多部分——实际上可以是任何形状 
返回值 
Long，执行成功为非零值，失败为0 
参数表 
参数 类型及说明 
hWnd Long，将设置其区域的窗口 
hRgn Long，将设置的区域的句柄，一旦设置了该区域，就不能使用或修改该区域句柄，也不要删除它 
bRedraw Boolean，若为TRUE，则立即重画窗口 
注解 
为区域指定的所有坐标都以窗口坐标（不是客户坐标）表示，它们以整个窗口（包括标题栏和边框）的左上角为起点
 

Answer 2

给你个例子'RoundButton.ctl'Event Declarations:
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUpPrivate Sub Label1_Click()
    RaiseEvent Click
End SubPrivate Sub UserControl_Initialize()
Dim Theta As Long
Const Pi As Double = 3.141592654
Dim OriginX As Long
Dim OriginY As Long
Dim Radius As DoubleDim X As Double
Dim Y As Double
UserControl.Width = UserControl.Height
Label1.Left = (UserControl.ScaleWidth - Label1.Width) / 2
'Label1.Width = Me.Width
Label1.Top = (UserControl.ScaleHeight - Label1.Height) / 2
' This Draws a Circle
Dim i As Integer
    UserControl.Cls
    OriginX = UserControl.ScaleWidth / 2
    Radius = UserControl.ScaleWidth / 2.5
    OriginY = UserControl.ScaleHeight / 2
    
    i = 135
    X = (Cos((Pi / 180) * i) * Radius) + OriginX
    Y = (Sin((Pi / 180) * i) * Radius) + OriginY
    UserControl.Line (X, Y)-(X, Y), RGB(255, 255, 255)
    For i = 135 To 315
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(255, 255, 255)
    Next i
    For i = 315 To 495
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(100, 100, 100)
    Next i
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseDown(Button, Shift, X, Y)
End SubPrivate Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseUp(Button, Shift, X, Y)
End SubPrivate Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Theta As Long
Const Pi As Double = 3.141592654
Dim OriginX As Long
Dim OriginY As Long
Dim Radius As Double
' This Draws a Circle
Dim i As Integer
    UserControl.Cls
    OriginX = UserControl.ScaleWidth / 2
    Radius = UserControl.ScaleWidth / 2.5
    OriginY = UserControl.ScaleHeight / 2
    
    i = 135
    X = (Cos((Pi / 180) * i) * Radius) + OriginX
    Y = (Sin((Pi / 180) * i) * Radius) + OriginY
    UserControl.Line (X, Y)-(X, Y), RGB(100, 100, 100)
    For i = 135 To 315
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(100, 100, 100)
    Next i
    For i = 315 To 495
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(255, 255, 255)
    Next i    RaiseEvent MouseDown(Button, Shift, X, Y)End SubPrivate Sub UserControl_Resize()
Dim Theta As Long
Const Pi As Double = 3.141592654
Dim OriginX As Long
Dim OriginY As Long
Dim Radius As DoubleDim X As Double
Dim Y As Double
UserControl.Width = UserControl.Height
Label1.Left = (UserControl.ScaleWidth - Label1.Width) / 2
'Label1.Width = Me.Width
Label1.Top = (UserControl.ScaleHeight - Label1.Height) / 2
' This Draws a Circle
Dim i As Integer
    UserControl.Cls
    OriginX = UserControl.ScaleWidth / 2
    Radius = UserControl.ScaleWidth / 2.5
    OriginY = UserControl.ScaleHeight / 2
    
    i = 135
    X = (Cos((Pi / 180) * i) * Radius) + OriginX
    Y = (Sin((Pi / 180) * i) * Radius) + OriginY
    UserControl.Line (X, Y)-(X, Y), RGB(255, 255, 255)
    For i = 135 To 315
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(255, 255, 255)
    Next i
    For i = 315 To 495
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(100, 100, 100)
    Next i
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

Answer 3

'继续
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Label1,Label1,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
    ForeColor = Label1.ForeColor
End PropertyPublic Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    Label1.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End PropertyPublic Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Label1,Label1,-1,Font
Public Property Get Font() As Font
    Set Font = Label1.Font
End PropertyPublic Property Set Font(ByVal New_Font As Font)
    Set Label1.Font = New_Font
    PropertyChanged "Font"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As Integer
    BackStyle = UserControl.BackStyle
End PropertyPublic Property Let BackStyle(ByVal New_BackStyle As Integer)
    UserControl.BackStyle() = New_BackStyle
    PropertyChanged "BackStyle"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Label1,Label1,-1,BorderStyle
Public Property Get BorderStyle() As Integer
    BorderStyle = Label1.BorderStyle
End PropertyPublic Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    Label1.BorderStyle() = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
    UserControl.Refresh
End SubPrivate Sub UserControl_Click()
    RaiseEvent Click
End SubPrivate Sub UserControl_DblClick()
    RaiseEvent DblClick
End SubPrivate Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End SubPrivate Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End SubPrivate Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End SubPrivate Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End SubPrivate Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Theta As Long
Const Pi As Double = 3.141592654
Dim OriginX As Long
Dim OriginY As Long
Dim Radius As Double
' This Draws a Circle
Dim i As Integer
    UserControl.Cls
    OriginX = UserControl.ScaleWidth / 2
    Radius = UserControl.ScaleWidth / 2.5
    OriginY = UserControl.ScaleHeight / 2
    
    i = 135
    X = (Cos((Pi / 180) * i) * Radius) + OriginX
    Y = (Sin((Pi / 180) * i) * Radius) + OriginY
    UserControl.Line (X, Y)-(X, Y), RGB(255, 255, 255)
    For i = 135 To 315
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(255, 255, 255)
    Next i
    For i = 315 To 495
        X = (Cos((Pi / 180) * i) * Radius) + OriginX
        Y = (Sin((Pi / 180) * i) * Radius) + OriginY
        UserControl.Line -(X, Y), RGB(100, 100, 100)
    Next i    
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Label1,Label1,-1,Caption
Public Property Get Caption() As String
    Caption = Label1.Caption
End PropertyPublic Property Let Caption(ByVal New_Caption As String)
    Label1.Caption() = New_Caption
    PropertyChanged "Caption"
    Label1.Left = (UserControl.ScaleWidth - Label1.Width) / 2
    Label1.Top = (UserControl.ScaleHeight - Label1.Height) / 2
End Property'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    Label1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    Set Font = PropBag.ReadProperty("Font", Ambient.Font)
    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    Label1.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    Label1.Caption = PropBag.ReadProperty("Caption", "Label1")
End Sub'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", Label1.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", Font, Ambient.Font)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BorderStyle", Label1.BorderStyle, 0)
    Call PropBag.WriteProperty("Caption", Label1.Caption, "Label1")
End Sub

Answer 4

thank you,I have a try!
to c7654321(荷船) :
   谢谢，不过效果很差！

Answer 5

to  hmily_girl(冷冰冰):
   我试了一下，那样只能画一个椭圆形，但不能成为按钮！

Answer 6

vb.net和vb区别很大，希望大家想想在vb.net里实现的好办法！
to hmily_girl(冷冰冰):
   其实这样做太麻烦，只要把一般按钮的形状改变成椭圆形即可，不知在vb.net里有什么好方法把一般按钮的形状改变成椭圆形？

Answer 7

vb.net和vb区别很大，希望大家想想在vb.net里实现的好办法！
to hmily_girl(冷冰冰):
   其实这样做太麻烦，只要把一般按钮的形状改变成椭圆形即可，不知在vb.net里有什么好方法把一般按钮的形状改变成椭圆形？

Answer 8

可能这是VB版，对VB.net了解的不多，偶也只会VB6.0.
你可以把这个帖子转移到VB.net区.