Tekstikuva (vai mikä nyt onkaan)

[DJ-Filbe]

Tein tässä sitten pienen ohjelman joka muuntaa kuvia tekstimäiseen muotoon, eli pikselit voi korvata vaikka X -kirjaimella.

Lähdekoodi:

Code: Select all

img=LoadImage("image.jpg")
SCREEN ImageWidth(img), ImageHeight(img)
img=LoadImage("image.jpg")
DrawImage img,0,0[attachment=1]image.jpg[/attachment][attachment=1]image.jpg[/attachment]
SetFont LoadFont("Arial",8)
Dim dots(ImageWidth(img), ImageHeight(img))
For y=1 To ImageHeight(img) Step 8
    For x=1 To ImageWidth(img) Step 8
        dots(x,y) = GetPixel(x,y)
    Next x
Next y
DrawScreen
For y=1 To ImageHeight(img) Step 8
    For x=1 To ImageWidth(img) Step 8
        Color 0,0,dots(x,y)
        Text x,y,"0"
    Next x
Next y
ScreenShot "tekstikuva.bmp"
DrawScreen
WaitKey

Ja tässä vielä esimerkkikuvat:

image.jpg (211.1 KiB) Viewed 5317 times

tekstikuva.png (42.49 KiB) Viewed 5317 times

EDIT:

En tiedä onko joku tehnyt tällaisen aikaisemmin, mutta nytpä tuli tällainen.
Ja tuonhan olisi voinut toteuttaa monella tapaa.

[Koodiapina]

Itse pidän enemmän siitä perinteisestä versiosta, jossa generoidaan puhdas merkkijono. Jotenkin tekstisyydestä menee maku, jos lopputuloksena on värikäs kuva.

[koodaaja]

Siinä tapauksessa Grandi saattaisi pitää omasta wanhasta toteutuksestani, joka toimii sekä väreillä että ilman :) Generoin joskus kirkkauksien mukaan sortatun tiedoston kaikista perusmerkeistä, koodikin saattaisi olla vielä jossain tallessa.

Code: Select all

path$ = "media\monalisa.jpg"
img = LoadImage(path)
SCREEN ImageWidth(img), ImageHeight(img)
img = LoadImage(path)
tiles$ = Flip("@MBHENR#KWXDFPQASUZbdehx*8Gm&04LOVYkpq5Tagns69owz$CIu23Jcfry%1v7l+it[]{}?j|()=~!-/<>"+Chr(92)+Chr(34)+"^_';,:`.")
For i = 0 To ImageWidth(img) Step 8
    For j = 0 To ImageHeight(img) Step 10
        bright# = .0
        midr# = 0
        midg# = 0
        midb# = 0
        For x = i To i+8
            For y = j To j+10
                PickImageColor img, x, y
                midr = midr + getRGB(1)/128.0
                midg = midg + getRGB(2)/128.0
                midb = midb + getRGB(3)/128.0
                bright = bright + (.3*getRGB(1) + .59*getRGB(1) + .11*getRGB(1))/25500.0
            Next y
        Next x
        letter$ = Mid(tiles, RoundUp(1+bright*(Len(tiles)-2)),1)
        //Color midr, midg, midb
        Color 255, 255, 255
        Text i+5-TextWidth(letter)/2, j+5-TextHeight(letter)/2, letter
    Next j
    DrawScreen OFF
Next i
DrawScreen
WaitKey

[DJ-Filbe]

Kyllä sitä täälläkin osataan:

Code: Select all

img=LoadImage("image.jpg")
SCREEN ImageWidth(img), ImageHeight(img)
img=LoadImage("image.jpg")
DrawImage img,0,0
textsize=10
SetFont LoadFont("Lucida Console",textsize)
Dim dots(ImageWidth(img), ImageHeight(img))
For y=1 To ImageHeight(img)
    For x=1 To ImageWidth(img)
        dots(x,y) = GetPixel(x,y)
    Next x
Next y
DrawScreen
chars$ = ".,'¨:|-/]¤#%.iuopydbsfIUYOPQDBSF"
For y=1 To ImageHeight(img) Step 10
    For x=1 To ImageWidth(img) Step 10
        Color 0,0,dots(x,y)
        mrk$=Mid(chars, RoundDown(getRGB(1)+getRGB(2)+getRGB(3))/3 /32+1,1)
        //Color 255,255,255
        Text x,y, mrk
       
        If x Mod 50 = 0 Then DrawScreen OFF
    Next x
Next y
ScreenShot "tekstikuva.bmp"
DrawScreen
WaitKey

[MaGetzUb]

Kyllä sitä täälläkin osataan:

Lol? En minä osaa mitään.

Code: Select all

SCREEN 800, 600
img = LoadImage("Media\Map.BMP")
ni = ImageASCII(img, 0, 2)
Repeat 
    DrawImage ni, 0, 0
DrawScreen
Forever 


Function ImageASCII(imgd, colflip, zoomed = 1, characters$ = " .,-=+!172380WE%@#§$")
        
    If zoomed > 1 Then
        img = CloneImage(imgd)
        ResizeImage img, ImageWidth(img)*zoomed, ImageHeight(img) * zoomed
        Else 
        img = imgd
    EndIf 
    
    
    If colfilp Then characters$ = Flip(characters$)
    newimg = MakeImage(ImageWidth(img), ImageHeight(img))
   
    tw = TextWidth("_")
    th = TextHeight("|")
    
    Lock Image(img)
    
    DrawToImage newimg
    
    If colflip Then Box 0, 0, ImageWidth(newimg), ImageHeight(newimg)
    
        For x = 0 To ImageWidth(img) / tw 
            For y = 0 To ImageHeight(img) / th
                
                PickImageColor2 img,x * tw, y * th
                
                midcol = (getRGB(1) + getRGB(2) + getRGB(3)) / 3
                
                Color 255, 255, 255
                If colflip Then Color 0, 0, 0
                
                charnum = Int(Float(Len(characters)) / 255.0 * Float(midcol))+1
                Text x * tw, y * -th, Mid(characters, charnum, 1)
                
            Next y
        Next x
    
    DrawToScreen
    Unlock Image(img)
    
    Return newimg
EndFunction