Ir para o conteúdo

Criando Uma Imagem Totalmente Pelo Código


Criado por Patrique, Out 10 2010 00:37

Não há respostas para este tópico
  • Por favor, faça o login para responder

#1 Patrique

Patrique
  • Patrique
  • Colaborador
  • 13 Revisões

Revisou 10 outubro 2010 - 00:37

Fala ai galera, ai vai um code muito doido feito por um chines doido

O cara conseguiu fazer apenas utilizando código uma bandeira, nesse caso a bandeira da china, ele não utilizou nenhuma imagem, apenas pelo código.

Segue a imagem abaixo

Imagem postada

Esse código é excelente para estudo, pois trata de funções raramente vistas.

Segue abaixo.

<%
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
%>





1 usuário(s) está(ão) lendo este código

1 membro(s), 0 visitante(s) e 0 membros anônimo(s)