|
Post by rodell2018 on Jan 17, 2019 6:23:20 GMT
what i would like to do is
print a [in one color] b [in a second color] ....
how many colors ?
and how about sound?
|
|
|
Post by tsh73 on Jan 17, 2019 9:01:18 GMT
You can print text to graphicbox in any color 256 levels of Red, 256 of Green and 256 of Blue That makes up 256^3 = 16777216 different colors (Truecolor)
As for sound, read up PLAYMIDI PLAYWAVE in a help file.
Here's old colorwheel program modified so it shows RGB bin that very color.
'HSV 2 RGB 'ref from Wikipedia 'http://en.wikipedia.org/wiki/HSL_and_HSV 'by tsh73, June 2008
nomainwin UpperLeftX = 20 UpperLeftY = 20
open "color wheel" for graphics_nsb as #main 'open "color wheel" for graphics_nsb_fs as #main #main, "trapclose [quit]" #main, "home ; down ; posxy xc yc" 'xc, yc give us width, height (c - Center) width = 2*xc : height = 2*yc #main, "down; fill white"
print width, height 'circle len is 2*Pi*Radius Radius = min(xc,yc) Radius = Radius *0.95 'step inside a bit Pi = 355/113 circLen = 2 * Pi * Radius 'in pixels print Radius, circLen aSize = int(circLen/360)+3 #main, "size "; aSize s = 1 v = 1 'these two should be set for [HSV_2_RGB] to work!!!
k = 1 do while k*Radius >1 'v = k 'value goes from 1 to 0. Color goes black s = k 'value goes from 1 to 0. Color goes white (?) aStep = (aSize - 3)/ (k*circLen) * 360 for h = 0 to 359 step aStep scan 'allow CTRL-BREAK gosub [HSV_2_RGB] #main, "color "; RGB$ x = xc + k*Radius*cos(h*Pi/180) y = yc + k*Radius*sin(h*Pi/180) #main, "set ";x;" ";y next k = k - aSize/Radius loop 'Grab a whole bitmap, discard, put it back and flush. 'This prevents artefacts on redraw #main, "getbmp wholeBMP "; 1; " "; 1; " "; width; " "; height #main, "discard" #main, "drawbmp wholeBMP 1 1" unloadbmp "wholeBMP"
#main, "flush" #main, "when mouseMove [getPixel2]" #main, "when leftButtonDown [getPixel]" #main, "color black" #main, "font Courier 10 bold"
wait
[getPixel] if (MouseX-xc)^2 + (MouseY-yc)^2 <= Radius^2 then #main, "place ";width-100;" 0" #main, "\" #main, "\";GetPixelValue$(MouseX, MouseY, "#main") end if
[getPixel2] ' print MouseX, MouseY,cx,cy, (MouseX-cx)^2 + (MouseY-cy)^2, Radius^2 if (MouseX-xc)^2 + (MouseY-yc)^2 <= Radius^2 then ' print GetPixelValue$(MouseX, MouseY, "#main") #main, "color ";GetPixelValue$(MouseX, MouseY, "#main") #main, "place 0 0" #main, "\" #main, "\";GetPixelValue$(MouseX, MouseY, "#main") else #main, "place 0 0" #main, "\" #main, "\ " 'clear thing end if
wait
[quit] close #main end
[HSV_2_RGB] 'Input: (h,s,v) 'h in the range [0, 360), indicating the angle, in degrees of the hue 's and v varying between 0 and 1, representing the saturation and value, respectively 'Output: r,g,b [0,1] 'and to be useful, R G B [0 255] 'or to JB RGB$ as "R G B" string.
hi = int(h/60) mod 6 f = h/60 - int(h/60) p = v*(1-s) q= v*(1-f*s) t = v*(1-(1-f)*s) ' print hi, select case hi case 0 r = v: g = t: b = p case 1 r = q: g = v: b = p case 2 r = p: g = v: b = t case 3 r = p: g = q: b = v case 4 r = t: g = p: b = v case 5 r = v: g = p: b = q end select R = int(r*255) G = int(g*255) B = int(b*255) RGB$= R;" ";G;" ";B return
'------------------------------------------------ function min(x,y) min = x if y<x then min = y end function
'***************************************************** '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 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
|
|
|
Post by B+ on Jan 17, 2019 17:12:28 GMT
Yes, to do color in JB, you have to open a graphics window. That's a pretty big hurdle as there is a number of things to learn to manage a window.
Here is a Graphics Window Template I use(d) to get started, it's more useful if you've had experience with other Basic's and understand custom subs which you have to CALL and functions. I adopted some example code to show printing things in color along with tiny bit of graphics.
'Graphics Window template.txt for Just Basic v2 [B+=MGA] 2019-01-17
' notes: template code for graphics window
global H$, XMAX, YMAX, PI, DEG, RAD H$ = "gr" ' this winodw handle XMAX = 500 '<======================================== actual drawing space needed YMAX = 500 '<======================================== actual drawing space needed PI = acs(-1) ' most famous and useful math constant DEG = 180 / PI ' convert angle in radians to degrees, mult (radian) angle by DEG RAD = PI / 180 ' convert angle in degrees to radians, mult (degree) angle by RAD
nomainwin WindowWidth = XMAX + 8 WindowHeight = YMAX + 32 UpperLeftX = (DisplayWidth - XMAX) / 2 'or delete if XMAX is 1200 or above UpperLeftY = (DisplayHeight - YMAX) / 2 'or delete if YMAX is 700 or above
open "Graphic Window Template Test" for graphics_nsb_nf as #gr '<=== title, no scroll bar #gr "setfocus" #gr "trapclose quit" #gr "when leftButtonUp lButtonUp" #gr "when characterInput charIn" #gr "down"
'============================== main code note: test some procedures
call fore 255,0,0 'red ink b$ = "" for i=1 to 10 b$ = b$ + str$( rand(1,10) );" " next call stext 10,21, b$ '10 random numbers in red b$ = ""
call fore 0, 128, 0 'green ink to print message in middle of screen (aprox) call ctext 240, "testing 1,2,3... press any key or click screen to quit..."
' make a purple triangle pointing to centered message call QBcolr 13 'another way to set colors call ftriangle 250,250,10,490,490,490
' make blue box around border call QBcolr 9 call box 5, 5, XMAX-5, YMAX-5 'this draws a blue box frame inside screen
'============================== sets drawing #gr "flush" wait
'JB Library of procedures ====================================================== 'notes: arrays are global limited in dimensions, no constants, no imports, no declares... 'must "call" subs no ()! not even in definitions and must use () for parameterless functions
function distance(x1, y1, x2, y2) distance = ( (x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5 end function
function rand(lo, hi) rand = int((hi - lo + 1) * rnd(0)) + lo end function
sub hue r, g, b 'fore and back #gr "color ";r;" ";g;" ";b #gr "backcolor ";r;" ";g;" ";b end sub
sub fore r, g, b #gr "color ";r;" ";g;" ";b end sub
sub back r, g, b 'backcolor is used for fills #gr "backcolor ";r;" ";g;" ";b end sub
sub QBcolr colrNum select case colrNum case 0 : #gr "color black" case 1 : #gr "color darkblue" case 2 : #gr "color brown" case 3 : #gr "color darkcyan" case 4 : #gr "color darkred" case 5 : #gr "color darkpink" case 6 : #gr "color darkgreen" case 7 : #gr "color lightgray" case 8 : #gr "color darkgray" case 9 : #gr "color blue" case 10 : #gr "color green" case 11 : #gr "color cyan" case 12 : #gr "color red" case 13 : #gr "color pink" case 14 : #gr "color yellow" case 15 : #gr "color white" end select end sub
sub pset x, y #gr "set ";x;" ";y end sub
sub aline x0, y0, x1, y1 #gr "line ";x0;" ";y0;" ";x1+1;" ";y1+1 'add 1 to end point end sub
sub box x0, y0, x1, y1 #gr "place ";x0;" ";y0 #gr "box ";x1+1;" ";y1+1 'add pixel at end end sub
sub fbox x0, y0, x1, y1 #gr "place ";x0;" ";y0 #gr "boxfilled ";x1+1;" ";y1+1 end sub
sub circ x, y, radius #gr "place ";x;" ";y;"; circle ";radius end sub
sub fcirc x, y, radius #gr "place ";x;" ";y;"; circlefilled ";radius end sub
sub ellips x, y, w, h '< no e on end! #gr "place ";x;" ";y;"; ellipse ";w;" ";h end sub
sub fellipse x, y, w, h #gr "place ";x;" ";y;"; ellipsefilled ";w;" ";h end sub
'Fast Filled Triangle Sub by AndyAmaya Sub ftriangle x1, y1, x2, y2, x3, y3 'triangle coordinates must be ordered: where x1 < x2 < x3 If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y 'swap x1, y1, with x3, y3 If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y 'swap x2, y2 with x3, y3 If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y If x1 <> x3 Then slope1 = (y3 - y1) /(x3 - x1) 'draw the first half of the triangle length = x2 - x1 If length <> 0 Then slope2 = (y2 - y1)/(x2 - x1) For x = 0 To length #gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1) Next End If 'draw the second half of the triangle y = length * slope1 + y1 : length = x3 - x2 If length <> 0 Then slope3 = (y3 - y2) /(x3 - x2) For x = 0 To length #gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2) Next End If call aline x1, y1, x2, y2 call aline x2, y2, x1, y1 call aline x2, y2, x3, y3 call aline x3, y3, x2, y2 call aline x1, y1, x3, y3 call aline x3, y3, x1, y1 End Sub
' print message$ at pixel x, y note: y is the bottom of the font sub stext x, y, message$ 'note: have to reset fore or back color after ink #gr "place ";x;" ";y;";|";message$ end sub
sub ctext y, message$ 'uses const XMAX and sub stext call stext (XMAX - len(message$) * 7) /2, y, message$ end sub
sub lButtonUp H$, mx, my 'must have handle and mouse x,y call quit H$ '<=== H$ global window handle end sub
sub charIn H$, c$ call quit H$ end sub
'Need line: #gr "trapclose quit" sub quit H$ close #H$ '<=== this needs Global H$ = "gr" end 'Thanks Facundo, close graphic wo error end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
|
|