填充图案程序

wd840611

<>程序之六</P>
<>
填充图案的程序：
Const Pai = 3.1415926
Dim n As Integer
Dim x, y, cx, cy, x1, y1, r, a, osw, osh, p, c1, c2, c3, c4, c5</P>
<>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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)</P>
<P>Private Sub Form_Load()
ScaleMode = 3
osw = ScaleWidth: osh = ScaleHeight
asp = ScaleHeight / ScaleWidth
ScaleWidth = 640
ScaleHeight = -Int(ScaleWidth * asp)
ScaleLeft = -Int(ScaleWidth / 2)
ScaleTop = -Int(ScaleHeight / 2)
a = 160: n = 4
c1 = QBColor(12)
c2 = QBColor(10)
c3 = QBColor(8)
c4 = QBColor(2)
c5 = QBColor(6)
End Sub</P>
<P>
Private Sub form_Click()
w = ScaleWidth
h = ScaleHeight
cx = ScaleLeft + w / 2
cy = ScaleTop + h / 2
If ScaleWidth &gt; ScaleHeight Then
   a = Abs(ScaleHeight * 0.45)
Else
   a = Abs(ScaleWidth * 0.45)
End If</P>
<P>Form1.Cls: k = 200
For p = 1 To 0.2 Step -0.2
    For th = 0 To 2 * Pai + 0.1 Step Pai / k
        r = Abs(a * Cos(n * th)) * p: x = r * Cos(th)
        y = r * Sin(th)
        gx = cx + x: gy = cy + y
        If flag = 0 Then PSet (gx, gy), col: flag = 1
        Line -(gx, gy), col
    Next th
    gra = 0
Next p</P>
<P>ft = 0
For m = 0 To 5
    If m = 1 Then
    FillColor = c1: p = 1
    ElseIf m = 2 Then
    FillColor = c2: p = 0.8
    ElseIf m = 3 Then
    FillColor = c3: p = 0.6
    ElseIf m = 4 Then
    FillColor = c4: p = 0.4
    ElseIf m = 5 Then
    FillColor = c5: p = 0.2
End If</P>
<P>
For th = 0 To 2 * Pai Step Pai / n
    r = a * p - 10
    x = r * Cos(th)
    y = r * Sin(th)
    x1 = Int((x - ScaleLeft) * osw / ScaleWidth)
    y1 = Int((y - ScaleTop) * osh / ScaleHeight)
    FillStyle = 0
    ExtFloodFill hdc, x1, y1, 0, ft
Next th
Next m</P>
<P>
End Sub</P>