求助 vb picturebox 画圆 半透明

[chinacohit]

这个问题困扰我很久了，在此诚向大家求助。
求教一个vb问题：
如何在picaturebox里面画一个圆，然后将其填充为半透明色。
类似于powerpoint下的效果:我的邮箱是[e-mail]

[me4405801]

还是用GDI+吧…… 以下在FORM1中： Private Sub Form_Click() Dim Token As Long Dim Grp As Long Dim Brush1 As Long, Brush2 As Long, Brush3 As Long Dim pen As Long Dim uInput As GdiplusStartupInput uInput.GdiplusVersion = 1 GdiplusStartup Token, uInput GdipCreateFromHDC Me.hDC, Grp GdipSetSmoothingMode Grp, 4 GdipCreateSolidFill &H80FF0000, Brush1 GdipCreateSolidFill &H8000FF00, Brush2 GdipCreateSolidFill &H800000FF, Brush3 GdipCreatePen1 &HFF0000FF, 1, UnitPixel, pen GdipDrawEllipseI Grp, pen, 10, 10, 100, 100 GdipFillEllipseI Grp, Brush1, 10, 10, 100, 100 GdipDrawEllipseI Grp, pen, 50, 50, 100, 100 GdipFillEllipseI Grp, Brush2, 50, 50, 100, 100 GdipDrawEllipseI Grp, pen, 90, 10, 100, 100 GdipFillEllipseI Grp, Brush3, 90, 10, 100, 100 Me.Refresh GdipDeletePen pen GdipDeleteBrush Brush1 GdipDeleteBrush Brush2 GdipDeleteGraphics Grp GdiplusShutdown Token End Sub Private Sub Form_Load() Me.AutoRedraw = True Me.ScaleMode = 3 End Sub 以下在Module1中： Option Explicit Public Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Public Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus Public Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal Graphics As Long, ByVal SmoothingMd As Long) As GpStatus Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal Token As Long) As GpStatus Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, Graphics As Long) As GpStatus Public Declare Function GdipCreatePen1 Lib "gdiplus" (ByVal Color As Long, ByVal Width As Single, ByVal unit As GpUnit, pen As Long) As GpStatus Public Declare Function GdipCreateSolidFill Lib "gdiplus" (ByVal argb As Long, Brush As Long) As GpStatus Public Declare Function GdipDrawEllipseI Lib "gdiplus" (ByVal Graphics As Long, ByVal pen As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As GpStatus Public Declare Function GdipFillEllipseI Lib "gdiplus" (ByVal Graphics As Long, ByVal Brush As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As GpStatus Public Declare Function GdipDeletePen Lib "gdiplus" (ByVal pen As Long) As GpStatus Public Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal Brush As Long) As GpStatus Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As GpStatus Public Enum GpStatus Ok = 0 GenericError = 1 InvalidParameter = 2 OutOfMemory = 3 ObjectBusy = 4 InsufficientBuffer = 5 NotImplemented = 6 Win32Error = 7 WrongState = 8 Aborted = 9 FileNotFound = 10 ValueOverflow = 11 AccessDenied = 12 UnknownImageFormat = 13 FontFamilyNotFound = 14 FontStyleNotFound = 15 NotTrueTypeFont = 16 UnsupportedGdiplusVersion = 17 GdiplusNotInitialized = 18 PropertyNotFound = 19 PropertyNotSupported = 20 End Enum Public Enum GpUnit UnitWorld UnitDisplay UnitPixel UnitPoint UnitInch UnitDocument UnitMillimeter End Enum

[me4405801]

[VBToy]

Option Explicit

Private Sub Command1_Click()
    Dim c As Long
    c = RGB(200, 255, 200)
    c = c Xor &HFFFFFF
    
    Picture1.FillStyle = 0
    
    Picture1.FillColor = c
    Picture1.Circle (120, 120), 80
    
    c = RGB(255, 255, 100)
    c = c Xor &HFFFFFF
    Picture1.FillColor = c
    Picture1.Circle (140, 140), 80
End Sub

Private Sub Form_Load()
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .DrawMode = 7
    End With
End Sub

[chinacohit]

非常感谢上楼的及时回复，但是如果有三个圆的时候重叠在一起的部分较多的时候，半透明的效果不是很好，按照您的代码测试如下

Private Sub Command1_Click()
Dim c As Long
c = RGB(200, 255, 200)
c = c Xor &HFFFFFF

Picture1.FillStyle = 0

Picture1.FillColor = c
Picture1.Circle (120, 120), 80, vbGreen

c = RGB(255, 255, 100)
c = c Xor &HFFFFFF
Picture1.FillColor = c
Picture1.Circle (140, 140), 80, vbGreen

c = RGB(200, 255, 200)
c = c Xor &HFFFFFF
Picture1.FillColor = c
Picture1.Circle (200, 160), 80, vbGreen

End Sub

Private Sub Form_Load()
With Picture1
.AutoRedraw = True
.ScaleMode = vbPixels
.DrawMode = 7
'.FillStyle = 0
.BorderStyle = 1

End With

End Sub

[chinacohit]

三个圆半透明重叠比较如下图，

[chinacohit]

非常感谢楼上的回复，我测试了一下，很好用。 现在还剩下半个问题，我没解决了，如果不是这样的三个重叠圆，要是重叠的扇形呢？咋办，我查了百度没能确定选用哪个GDI 函数。能再帮我一下吗？在线等啊。

[贝隆]

显然，实用GDI+是最佳的选择 参考： http://download.csdn.net/detail/veron_04/4814790 http://download.csdn.net/detail/veron_04/4039695

[chinacohit]

楼上的下载需要积分啊，而且看起来貌似很复杂啊。我只需要一个GDI函数用来画扇形的就ok了，能简单明了的像上上楼的那样写个例程吗？

[贝隆]

GDI+相对于GDI功能更强大，使用更方便。不可同日而语

[贝隆]

我不是给出例子了吗？你只需要在这个程序的基础上取你需要的部分略作修改就行

[chinacohit]

楼上的你给出的例子下载不了啊，跪求啊。每天都来关注啊。

[chinacohit]

拜托楼上的，能否给个gdi+画扇形的函数示例？

[chinacohit]

拜托楼上的，能否给个gdi+画扇形的函数示例？

[chinacohit]

拜托楼上的，能否给个gdi+画扇形的函数示例？