介绍一个VB小的有趣的程序代码

'粘贴下面代码即可, 不用添加任何控件

Private WithEvents Timer1 As Timer

Dim r&, r1&, t&, a1!, a2!, xb!, yb!, s!, b#

Private Sub Form_Load()

      Me.Width = 4500: Me.Height = 4500

      Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

      Me.AutoRedraw = True

      Me.Caption = "CBM666的万花筒"

      Set Timer1 = Controls.Add("vb.timer", "Timer1")

      Timer1.Interval = 10

End Sub

Private Sub Timer1_Timer()

      Randomize

      r = 340 * Rnd

      If r <> 0 Then

         r1 = 500

         s = r * Rnd

         b = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)

         For t = 1 To 10000

            a1 = t * 3.1415926 / 180

            a2 = (r1 / r) * a1

            xb 局桐= 500 + (-(r1 - r) * Cos(a1) - s * Cos(a2 - a1) + 420) * 4

            卖腊谨yb = 500 + ((r1 - r) * Sin(a1) - s * Sin(a2 - a1) + 380) * 4

            Me.PSet (xb, yb), 中基b

         Next t

      End If

End Sub

普通的窗体都是方明差方的，使用API函数可以做出一些奇怪的形状。比如，窗体是圆角矩形，在中间挖一个椭圆形的洞。

先要理解一个重要行槐芦的概念：区域。区域是描述设备场景中某一块的GDI对象，每个区域都有一个句柄。一个区域可以是矩形，也档带可以是复杂的多边形，甚至是几个区域组织在一起。窗体默认的区域就是我们看到的矩形，当然它并非一定要用这个默认的区域

现在开始，首先在窗体上做一个圆角矩形区域，这是窗体的大致轮廓。在圆角矩形里再确定一个椭圆形的区域，然后把这两个区域组织成一个区域，并设置窗体的区域为这个组织出来的区域。

CreateRoundRectRgn函数用于创建一个圆角矩形区域；CreateEllipticRgn用于创建一个椭圆区域；CombineRgn函数用于将两个区域组合为一个新区域；SetWindowRgn函数允许您改变窗口的区域。使用其他的函数还可以做出其他更奇怪的窗体。

源代码如下：

OptionExplicit

'API函数声明

PrivateDeclareFunctionCreateRectRgnLib"gdi32"(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong)AsLong

PrivateDeclareFunctionCreateRoundRectRgnLib"gdi32"(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong,ByValX3AsLong,ByValY3AsLong)AsLong

PrivateDeclareFunctionCreateEllipticRgnLib"gdi32"(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong)AsLong

PrivateDeclareFunctionCombineRgnLib"gdi32"(ByValhDestRgnAsLong,ByValhSrcRgn1AsLong,ByValhSrcRgn2AsLong,ByValnCombineModeAsLong)AsLong

PrivateDeclareFunctionSetWindowRgnLib"user32"(ByValhWndAsLong,ByValhRgnAsLong,ByValbRedrawAsBoolean)AsLong

PrivateDeclareFunctionDeleteObjectLib"gdi32"(ByValhObjectAsLong)AsLong

'常数声明

PrivateConstRGN_DIFF=4

'目标区域被设置为两个区域不相交的部分

'模块级变量声明

PrivateOutRgnAsLong

'外边的圆角矩形区域

PrivateInRgnAsLong

'里边的椭圆区域

PrivateMyRgnAsLong

'圆角区域剪切掉椭圆区域后的区域，也是窗体最终的形状

PrivateSubForm_Click()

IfOutRgn<>0AndInRgn<>0AndMyRgn<>0ThenExitSub

DimwAsLong,hAsLong

w=ScaleX(Form1.Width,vbTwips,vbPixels)

h=ScaleY(Form1.Height,vbTwips,vbPixels)

MyRgn=CreateRectRgn(0,0,0,0)

OutRgn=CreateRoundRectRgn(30,30,w-30,h-30,100,100)

InRgn=CreateEllipticRgn(100,100,w-100,h-100)

CallCombineRgn(MyRgn,OutRgn,InRgn,RGN_DIFF)

CallSetWindowRgn(Form1.hWnd,MyRgn,True)

Form1.BackColor=QBColor(4)

EndSub

PrivateSubForm_DblClick()

UnloadForm1

EndSub

PrivateSubForm_Load()

OutRgn=0

InRgn=0

MyRgn=0

Form1.Width=7800

Form1.Height=6000

EndSub

PrivateSubForm_Unload(CancelAsInteger)

IfMyRgn<>0ThenDeleteObjectMyRgn

IfOutRgn<>0ThenDeleteObjectOutRgn

IfInRgn<>0ThenDeleteObjectInRgn

EndSub

这个程序运行后，在窗体上单击，窗体就会变形，双击窗体程序结束。要注意的是，在卸载窗体时，用DeleteObject函数删除已定义的区域。