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 5330 times
tekstikuva.png (42.49 KiB) Viewed 5330 times
EDIT:
En tiedä onko joku tehnyt tällaisen aikaisemmin, mutta nytpä tuli tällainen.
Ja tuonhan olisi voinut toteuttaa monella tapaa.
Itse pidän enemmän siitä perinteisestä versiosta, jossa generoidaan puhdas merkkijono. Jotenkin tekstisyydestä menee maku, jos lopputuloksena on värikäs kuva.
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.
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
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