程序代码
<%
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.ContentType = "image/bmp"
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
'www.knowsky.com
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
Const BackColor = &HFF0000
Const ForeColor = &HFFFF00
Palette = CDWord(BackColor) & CDWord(ForeColor)
End Property
Private Property Get ImageData
Dim i, j
ImageData = ""
For j = 0 To Height - 1
For i = 0 To Width + Filler - 1 Step 8
ImageData = ImageData & ChrB(BitMap(i, j) * 128 or BitMap(i + 1, j) * 64 or BitMap(i + 2, j) * 32 or BitMap(i + 3, j) * 16 or BitMap(i + 4, j) * 8 or BitMap(i + 5, j) * 4 or BitMap(i + 6, j) * 2 or BitMap(i + 7, j))
Next
Next
End Property
End Class
With New FiveStarredFlag
End With
%>
