能不能自己制作shape控件

Question

vb中的shape 控件只有几个形状，不多，比如我想要一个五角星的形状，或者更复杂的图形，应该怎么做？

Answer 1

我的vb水平不高，还希望能够详细的说说。比如，如何编写一个shape 控件，具体怎么做。

Answer 2

具体怎么画？这个shape控件怎么制作，是不是用个usercontrol上面放很多的直线，用直线按坐标去拼成一个
图形，还是有其他的方法呢。

Answer 3

Const pi = 3.14159265358979
Dim i&, X1&, Y1&
Private Sub Form_Click()
   Call DrawAngle(5, 0, 1600, 1500) '参数:几角型,X座标,Y座标,边长
End SubPublic 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

Answer 4

工程->用户自定义控件->自己想怎么画就怎么画了

Answer 5

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

Answer 6

不搞动画就用IMAGE控件吧，弄点背景通透图上去，别说是5角星，10角星也没问题，而且比画的好看
如果想搞动画控件，作成ActiveX,用timer+image也可以，直接封装个webbrowser也可以（不过太胖了点）

Answer 7

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 SubPrivate Sub cmdQuit_Click()
  Unload Me
End SubPrivate Sub Command1_Click()End SubPrivate Sub Form_Load()
  Me.ScaleMode = vbPixels
  Me.BorderStyle = 0
End Sub

Answer 8

感觉用form制作一个形状比较大，而且背景也不好透明。

Answer 9

在工程中添加用户控件，把backstyle设为透明，然后，你在用户控件里面添加多个线条之类的Shape,然后自己进行定位，以后把这个用户控件添加到你的窗口上了。

Answer 10

************ 放在桌面上半透明的 五角星 **************'添加 Picture1Option 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 SubPrivate Sub Form_Unload(Cancel As Integer)
   DeleteObject mBrush
   End
End SubPublic 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 SubPrivate 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

Answer 11

'打开一个窗体即可, 不用添加其它控件'鼠标左键更换随机颜色, 右键退出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 SubPrivate Sub Form_Unload(Cancel As Integer)
   DeleteObject mBrush
   End
End SubPublic 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 SubPrivate 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