能不能自己制作shape控件

vb中的shape 控件只有几个形状，不多，比如我想要一个五角星的形状，或者更复杂的图形，应该怎么做？ --------------------编程问答-------------------- --------------------编程问答-------------------- 我的vb水平不高，还希望能够详细的说说。比如，如何编写一个shape 控件，具体怎么做。 --------------------编程问答-------------------- 这需要自己画了 --------------------编程问答-------------------- 具体怎么画？这个shape控件怎么制作，是不是用个usercontrol上面放很多的直线，用直线按坐标去拼成一个
图形，还是有其他的方法呢。 --------------------编程问答-------------------- 路过，看看 --------------------编程问答-------------------- 用API画 --------------------编程问答-------------------- Const pi = 3.14159265358979
Dim i&, X1&, Y1&
Private Sub Form_Click()
   Call DrawAngle(5, 0, 1600, 1500) '参数:几角型,X座标,Y座标,边长
End Sub

Public Sub DrawAngle(Nangle%, StartX&, StartY&, Lsize&)
   StartX = IIf(StartX < Lsize, Lsize, StartX)
   StartY = IIf(StartY < Lsize, Lsize, StartY)
   Me.Cls
   PSet (StartX + Sin(0) * Lsize, StartY - Cos(0) * Lsize)
   For i = 0 To 360 Step (360 / Nangle)
      X1 = StartX + Sin(i * pi / 180) * Lsize
      Y1 = StartY - Cos(i * pi / 180) * Lsize
      Line -(X1, Y1)
      X1 = StartX + Sin((i + (180 / Nangle)) * pi / 180) * Lsize / 2
      Y1 = StartY - Cos((i + (180 / Nangle)) * pi / 180) * Lsize / 2
      Line -(X1, Y1)
   Next i
   Line -(StartX + Sin(0) * Lsize, StartY - Cos(0) * Lsize)
End Sub

--------------------编程问答-------------------- 工程->用户自定义控件->自己想怎么画就怎么画了 --------------------编程问答-------------------- 工程-> 用户自定义控件哪有这个选项？？？
DrawAngle是一个自写的函数，但怎样把他编为一个控件呢。我认为shape控件有优点几个：1，有top，left属性，可以任意定位，加个timer控件还能搞个动画。2，背景透明，怎么放都不影响下面图形。3、可以使用虚线，实线，填充等很多属性，希望能指点我，如果能自己编个这样的控件就好了。

--------------------编程问答-------------------- 不搞动画就用IMAGE控件吧，弄点背景通透图上去，别说是5角星，10角星也没问题，而且比画的好看
如果想搞动画控件，作成ActiveX,用timer+image也可以，直接封装个webbrowser也可以（不过太胖了点） --------------------编程问答-------------------- usercontrol和form差不多，你要是能把form搞成五角形，哪么，你就可以编本个5角形shape了
我这里有一个网上收集的例子，不过不是五角形

'T型窗体

Private Type POINTAPI

   X As Long

   Y As Long

End Type

Dim XY() As POINTAPI

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub cmdT_Click()

    Dim hRgn As Long

    Dim lRes As Long

    ReDim XY(7) As POINTAPI 'T shape has 8 points

    With Me

        XY(0).X = 0

        XY(0).Y = 0

        XY(1).X = .ScaleWidth

        XY(1).Y = 0

        XY(2).X = .ScaleWidth

        XY(2).Y = .ScaleHeight / 2

        XY(3).X = .ScaleWidth - (.ScaleWidth / 3)

        XY(3).Y = .ScaleHeight / 2

        XY(4).X = .ScaleWidth - (.ScaleWidth / 3)

        XY(4).Y = .ScaleHeight

        XY(5).X = .ScaleWidth / 3

        XY(5).Y = .ScaleHeight

        XY(6).X = .ScaleWidth / 3

        XY(6).Y = .ScaleHeight / 2

        XY(7).X = 0

        XY(7).Y = .ScaleHeight / 2

    End With

    

    hRgn = CreatePolygonRgn(XY(0), 8, 2)

    lRes = SetWindowRgn(Me.hWnd, hRgn, True)

End Sub



Private Sub cmdQuit_Click()

  Unload Me

End Sub



Private Sub Command1_Click()



End Sub



Private Sub Form_Load()

  Me.ScaleMode = vbPixels

  Me.BorderStyle = 0

End Sub

--------------------编程问答-------------------- 感觉用form制作一个形状比较大，而且背景也不好透明。 --------------------编程问答-------------------- 在工程中添加用户控件，把backstyle设为透明，然后，你在用户控件里面添加多个线条之类的Shape,然后自己进行定位，以后把这个用户控件添加到你的窗口上了。 --------------------编程问答-------------------- ************ 放在桌面上半透明的五角星 **************

'添加 Picture1

Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
'*******************************
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
Const FLOODFILLBORDER = 0
Const pi = 3.14159265358979
Const FLOODFILLSURFACE = 1
Const crNewColor = &HFFFF80
Dim rtn&, i&, X1&, Y1&, transcolor&, mBrush&
Private Sub Form_Load()
   transcolor = RGB(66, 66, 66)
   Me.BorderStyle = 0: Me.Caption = "": Me.BackColor = transcolor
   Me.Width = 9800: Me.Height = 9100
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   Picture1.BorderStyle = 0: Picture1.AutoRedraw = True
   Picture1.Width = Me.Width: Picture1.Height = Me.Height
   Picture1.Move 0, 0
   Picture1.BackColor = transcolor
   Picture1.FillStyle = 0: Picture1.FillColor = QBColor(Int(Rnd * 7) + 9)
   Picture1.ScaleMode = 3
   mBrush = CreateSolidBrush(crNewColor)
   SelectObject Picture1.hdc, mBrush
   Call DrawAngle(5, 0, 0, 300) '参数:几角型,X座标,Y座标,边长
   Me.ScaleMode = 3
   X1 = Me.Width \ 2 \ 15: Y1 = Me.Height \ 2 \ 15
   ExtFloodFill Picture1.hdc, X1, Y1, Picture1.Point(X1, Y1), 1
   rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
   rtn = rtn Or WS_EX_LAYERED
   SetWindowLong hwnd, GWL_EXSTYLE, rtn
   SetLayeredWindowAttributes hwnd, transcolor, 150, LWA_COLORKEY Or LWA_ALPHA
End Sub

Private Sub Form_Unload(Cancel As Integer)
   DeleteObject mBrush
   End
End Sub

Public Sub DrawAngle(Nangle%, StartX&, StartY&, Lsize&)
   StartX = IIf(StartX <= Lsize, Lsize, StartX)
   StartY = IIf(StartY <= Lsize, Lsize, StartY)
   Picture1.Cls
   Picture1.PSet (StartX + Sin(0) * Lsize, StartY - Cos(0) * Lsize)
   For i = 0 To 360 Step (360 / Nangle)
      X1 = StartX + Sin(i * pi / 180) * Lsize
      Y1 = StartY - Cos(i * pi / 180) * Lsize
      Picture1.Line -(X1, Y1)
      X1 = StartX + Sin((i + (180 / Nangle)) * pi / 180) * Lsize / 2
      Y1 = StartY - Cos((i + (180 / Nangle)) * pi / 180) * Lsize / 2
      Picture1.Line -(X1, Y1)
   Next i
   Picture1.Line -(StartX + Sin(0) * Lsize, StartY - Cos(0) * Lsize)
   DeleteObject mBrush
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then Unload Me
   Picture1.FillColor = QBColor(Int(Rnd * 7) + 9)
   ExtFloodFill Picture1.hdc, X, Y, Picture1.Point(X, Y), 1
End Sub

效果图:
http://p.blog.csdn.net/images/p_blog_csdn_net/cbm666/366646/o_ROSL.jpg

--------------------编程问答-------------------- 忘了说了..... 鼠标左键更换随机颜色, 右键退出/ --------------------编程问答-------------------- '打开一个窗体即可, 不用添加其它控件

'鼠标左键更换随机颜色, 右键退出

Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
'*******************************
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
Const FLOODFILLBORDER = 0
Const pi = 3.14159265358979
Const FLOODFILLSURFACE = 1
Const crNewColor = &HFFFF80
Dim rtn&, i&, X1&, Y1&, transcolor&, mBrush&
Private Sub Form_Load()
   transcolor = RGB(66, 66, 66)
   Me.BorderStyle = 0: Me.Caption = "": Me.BackColor = transcolor
   Me.FillColor = QBColor(Int(Rnd * 6) + 9): Me.FillStyle = 0
   Me.AutoRedraw = True
   mBrush = CreateSolidBrush(crNewColor)
   SelectObject Me.hdc, mBrush
   Call DrawAngle(5, 0, 0, 5000) '参数:几角型,X座标,Y座标,边长
   Me.ScaleMode = 3: Me.Width = 10000: Me.Height = 10000
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   X1 = Me.Width \ 2 \ 15: Y1 = Me.Height \ 2 \ 15
   ExtFloodFill Me.hdc, X1, Y1, Me.Point(X1, Y1), 1
   rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
   rtn = rtn Or WS_EX_LAYERED
   SetWindowLong hwnd, GWL_EXSTYLE, rtn
   SetLayeredWindowAttributes hwnd, transcolor, 150, LWA_COLORKEY Or LWA_ALPHA
End Sub

Private Sub Form_Unload(Cancel As Integer)
   DeleteObject mBrush
   End
End Sub

Public Sub DrawAngle(Nangle%, StartX&, StartY&, Lsize&)
   StartX = IIf(StartX <= Lsize, Lsize, StartX)
   StartY = IIf(StartY <= Lsize, Lsize, StartY)
   Me.Cls
   Me.PSet (StartX + Sin(0) * Lsize, StartY - Cos(0) * Lsize)
   For i = 0 To 360 Step (360 / Nangle)
      X1 = StartX + Sin(i * pi / 180) * Lsize
      Y1 = StartY - Cos(i * pi / 180) * Lsize
      Me.Line -(X1, Y1)
      X1 = StartX + Sin((i + (180 / Nangle)) * pi / 180) * Lsize / 2
      Y1 = StartY - Cos((i + (180 / Nangle)) * pi / 180) * Lsize / 2
      Me.Line -(X1, Y1)
   Next i
   Me.Line -(StartX + Sin(0) * Lsize, StartY - Cos(0) * Lsize)
   DeleteObject mBrush
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then Unload Me
   Me.FillColor = QBColor(Int(Rnd * 6) + 9)
   ExtFloodFill Me.hdc, X, Y, Me.Point(X, Y), 1
End Sub

补充：VB ,  控件