程序代码

Option Explicit

Class FiveStarredFlag

PRivate Width

Private Height

Private Filler

Private SizeImage

Private FileSize

Private BitMap()

Private Sub Class_Initialize

Height = 200

Width = 300

Filler = (32 - Width Mod 32) Mod 32

SizeImage = (Width + Filler) * Height 8

FileSize = SizeImage + 14 + 40 + 8

ReDim BitMap(Width + Filler - 1, Height - 1)

Star Height * 0.25, Height * 0.75, Height * 0.15, 0

Star Width / 3, Height * 0.9, Height * 0.05, 120.9637565320735

Star Width * 0.4, Height * 0.8, Height * 0.05, 98.13010235415598

Star Width * 0.4, Height * 0.65, Height * 0.05, 74.0546040990771

Star Width / 3, Height * 0.55, Height * 0.05, 51.3401917459099

End Sub

Private Sub Class_Terminate

Response.BinaryWrite FileHeader InfoHeader Palette ImageData

End Sub

Private Sub Star(x, y, r, a)

Dim pi, v, d, i, j, k, m2

pi = 3.1415926535897932

v = r * Sin(pi * 0.1) / Sin(pi * 0.7)

For j = -r To r

For i = -r To r

d = Sqr(i ^ 2 + j ^ 2)

If d < v Then

BitMap(x + i, y + j) = 1

ElseIf d < r Then

If i = 0 Then

If j > 0 Then k = 90 Else k = -90

Else

k = Atn(j / i) * 180 / pi

If i < 0 Then k = k + 180

End If

k = k - a - 18

While k < 0

k = k + 360

Wend

While k >= 360

k = k - 360

Wend

While k >= 72

k = k - 72

Wend

If k > 36 Then k = 72 - k

m2 = d ^ 2 + r ^ 2 - d * r * 2 * Cos(k * pi / 180)

If (m2 + r ^ 2 - d ^ 2) / (Sqr(m2) * r * 2) > Cos(pi * 0.1) Then

BitMap(x + i, y + j) = 1

End If

End If

Next

Next

End Sub

Private Function CWord(I16)

CWord = ChrB(I16 And HFF) ChrB(I16 256 And HFF)

End Function

Private Function CDWord(I32)

CDWord = ChrB(I32 And HFF) ChrB(I32 256 And HFF) ChrB(I32 65536 And HFF) ChrB(I32 HFFFFFF And HFF)

End Function

Private Property Get FileHeader

Const FileType = H4D42

Const Reserved1 = 0

Const Reserved2 = 0

Const OffBits = 62

FileHeader = CWord(FileType) CDWord(FileSize) CWord(Reserved1) CWord(Reserved2) CDWord(OffBits)

End Property

Private Property Get InfoHeader

Const InfoSize = 40

Const Planes = 1

Const BitCount = 1

Const Compression = 0

Const XPelsPerMeter = 0

Const YPelsPerMeter = 0

Const ClrUsed = 0

Const ClrImportant = 0

InfoHeader = CDWord(InfoSize) CDWord(Width) CDWord(Height) CWord(Planes) CWord(BitCount) CDWord(Compression) CDWord(SizeImage) CDWord(XPelsPerMeter) CDWord(YPelsPerMeter) CDWord(ClrUsed) CDWord(ClrImportant)

End Property

Private Property Get Palette

&