能不能自己制作shape控件

njsf_79 2008-03-11 12:26:38
vb中的shape 控件只有几个形状，不多，比如我想要一个五角星的形状，或者更复杂的图形，应该怎么做？
...全文
277 16 打赏 收藏 转发到动态 举报
写回复
用AI写文章
16 条回复
切换为时间正序
请发表友善的回复…
发表回复
cbm6666 2008-03-17
  • 打赏
  • 举报
 回复
'打开一个窗体即可, 不用添加其它控件

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

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

cbm6666 2008-03-16
  • 打赏
  • 举报
 回复
忘了说了..... 鼠标左键更换随机颜色, 右键退出/
cbm6666 2008-03-16
  • 打赏
  • 举报
 回复
************ 放在桌面上半透明的 五角星 **************

'添加 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

smalle 2008-03-16
  • 打赏
  • 举报
 回复
在工程中添加用户控件，把backstyle设为透明，然后，你在用户控件里面添加多个线条之类的Shape,然后自己进行定位，以后把这个用户控件添加到你的窗口上了。
njsf_79 2008-03-16
  • 打赏
  • 举报
 回复
感觉用form制作一个形状比较大，而且背景也不好透明。
zzyong00 2008-03-14
  • 打赏
  • 举报
 回复
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

forbearORfolie 2008-03-14
  • 打赏
  • 举报
 回复
不搞动画就用IMAGE控件吧，弄点背景通透图上去，别说是5角星，10角星也没问题，而且比画的好看
如果想搞动画控件，作成ActiveX,用timer+image也可以，直接封装个webbrowser也可以（不过太胖了点）
njsf_79 2008-03-14
  • 打赏
  • 举报
 回复
工程-> 用户自定义控件 哪有这个选项？？？
DrawAngle是一个自写的函数，但怎样把他编为一个控件呢。我认为shape控件有优点几个：1，有top，left属性，可以任意定位，加个timer控件还能搞个动画。2，背景透明，怎么放都不影响下面图形。3、可以使用虚线，实线，填充等很多属性，希望能指点我，如果能自己编个这样的控件就好了。

smalle 2008-03-13
  • 打赏
  • 举报
 回复
工程->用户自定义控件->自己想怎么画就怎么画了
cbm6666 2008-03-13
  • 打赏
  • 举报
 回复
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

forbearORfolie 2008-03-13
  • 打赏
  • 举报
 回复
用API画
forbearORfolie 2008-03-13
  • 打赏
  • 举报
 回复
路过，看看
njsf_79 2008-03-13
  • 打赏
  • 举报
 回复
具体怎么画？这个shape控件怎么制作，是不是用个usercontrol上面放很多的直线，用直线按坐标去拼成一个
图形，还是有其他的方法呢。
东方之珠 2008-03-13
  • 打赏
  • 举报
 回复
这需要自己画了
njsf_79 2008-03-13
  • 打赏
  • 举报
 回复
我的vb水平不高，还希望能够详细的说说。比如，如何编写一个shape 控件，具体怎么做。
用VB 制作Active X 控件
用VB 制作Active X 控件 很实用的技术文件
制作无规则控件代码
制作无规则控件，包含类，及示例代码
利用VB自制OCX控件
利用VB自制OCX控件.如今OCX控件在编程中已占领了很重要的地位,我们可以利用OCX控件完成一些相当复杂的编程操作.同时OCX 控件还有利于主程序的简单化、功能的重用、隐常程序实现细节、便于升级、传播方便等优点。现在我们可以利用VB 5.0方便的制作出自己的OCX控件供我们在编程中使用同时还可以把它送给你周围喜欢编程的朋友!
C# 自定义控件实现时间轴
C# 自定义控件实现时间轴，C# 自定义控件实现时间轴，C# 自定义控件实现时间轴，C# 自定义控件实现时间轴，C# 自定义控件实现时间轴
[VB6]Alpha Shape Control
vb6下使用的Shape控件(使用GDI+),这是制作者的描述： This control is similar to VB's shape control, but adds much more flexibility. You can get mouse clicks, mouse enter/exit events, create shapes from 3 to 360 sides, draw with translucency, fill shapes with 60 different patterns, including gradients and texture. Creating a shape based off of text is simple. Want to create your own shape and add it during runtime, can do! 比VB6自带的功能强多了，而且还可以做艺术字体
控件

1,453

社区成员

41,351

社区内容

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章