Post by tsh73 on Apr 11, 2018 10:56:51 GMT
Sometimes I want to have pixel array corresponding to text
(say, to put these pixels somewhere else).
So here a way with GetPixelValue$():
It provides this:
(interesting but with font smoothing (I really didn't find where to turn it off in Win10) it looks much 'bolder'
(say, to put these pixels somewhere else).
So here a way with GetPixelValue$():
open "test" for graphics as #gr
#gr "trapclose [quit]"
#gr "home; down; posxy cx cy"
#gr "font times_new_roman italic 24 "
#gr "\x"
#gr "place ";cx+14;" ";cy+7
#gr "font times_new_roman italic 16 bold"
#gr "\B"
#gr "flush"
i = 0
maxXLtr=22
print "maxXLtr=";maxXLtr
print "dim ltr$(maxXLtr) 'Times New Roman italic via GetPixelValue$ "
for y = cy-15 to cy-15+maxXLtr-1
SCAN
i =i+1
print "ltr$(";using("##",i);")="+chr$(34);
for x = cx-2 to cx+28
c$=" "
' if GetPixelValue$(x, y, "#gr")=" 0 0 0" then c$="*"
if GetPixelValue$(x, y, "#gr")<>"255 255 255" then c$="*"
print c$;
next
print chr$(34)
next
wait
[quit]
close #gr
end
'------------------------------
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)
'Grab a 1*1 bitmap
#handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
'Save in a bmp file
bmpsave "gpv", "getpvaluetemp.bmp"
'Open the file for string input and get it's full contents
open "getpvaluetemp.bmp" for input as #gpv
s$ = input$(#gpv, lof(#gpv))
close #gpv
'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
bpp = asc(mid$(s$, 29, 1))
select case bpp
case 32
red = asc(mid$(s$, 69, 1))
green = asc(mid$(s$, 68, 1))
blue = asc(mid$(s$, 67, 1))
case 24
red = asc(mid$(s$, 57, 1))
green = asc(mid$(s$, 56, 1))
blue = asc(mid$(s$, 55, 1))
case 16
bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
red = (bytes AND 63488) /256 '0xF800
green = (bytes AND 2016) / 32 * 4 '0x7E0
blue = (bytes AND 31) * 8 '0x1F
end select
'concatenate the return value, delete temporary file and free memory
GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue)
kill "getpvaluetemp.bmp"
unloadbmp "gpv"
end function
It provides this:
ltr$( 1)=" "
ltr$( 2)=" ** *** "
ltr$( 3)=" ***** **** "
ltr$( 4)=" *** * * "
ltr$( 5)=" ** * "
ltr$( 6)=" **** "
ltr$( 7)=" ** "
ltr$( 8)=" ** "
ltr$( 9)=" ** ********* "
ltr$(10)=" * ** **** *** "
ltr$(11)=" * ** *** *** "
ltr$(12)=" * ** * *** *** "
ltr$(13)=" ** * ** * *** *** "
ltr$(14)=" **** **** *** ** "
ltr$(15)=" *** ** ****** "
ltr$(16)=" *** *** "
ltr$(17)=" *** *** "
ltr$(18)=" *** *** "
ltr$(19)=" *** *** "
ltr$(20)=" *** **** "
ltr$(21)=" *** **** "
ltr$(22)=" ********* "
(interesting but with font smoothing (I really didn't find where to turn it off in Win10) it looks much 'bolder'
ltr$( 1)=" ***** **** "
ltr$( 2)=" ******* ***** "
ltr$( 3)=" ***** ****** "
ltr$( 4)=" ****** "
ltr$( 5)=" ****** "
ltr$( 6)=" **** "
ltr$( 7)=" **** "
ltr$( 8)=" **** "
ltr$( 9)=" **** "
ltr$(10)=" ****** ********** "
ltr$(11)=" ****** ********* "
ltr$(12)=" ** **** ***** **** "
ltr$(13)="******* ****** **** **** "
ltr$(14)="****** ***** ********* "
ltr$(15)=" **** ***** ******** "
ltr$(16)=" ********** "
ltr$(17)=" **** **** "
ltr$(18)=" **** **** "
ltr$(19)=" ***** **** "
ltr$(20)=" **** ***** "
ltr$(21)=" ***** ***** "
ltr$(22)=" *********** "