今天看到一个用asp程序编写一个bmp图片格式的五星红旗,像手绘的一样,很好,把它转过来和大家分享
<% 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 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 %>(鼠标移到代码上去,在代码的顶部会出现四个图标,第一个是查看源代码,第二个是复制代码,第三个是打印代码,第四个是帮助)