Page 1 of 1

Windows message box object

Posted: Fri Apr 04, 2014 2:36 pm
by Henko

Code: Select all

' Windows "message" function.
' The only argument is a string to be displayed in a window.
' The size of the window is calulated by the function, 
' dependent on the number of characters in the string,
' the font size, and the aspect ratio of the window.
' The window is placed in the centre of the screen.
' Pushing the ok button will remove the message and restores
' the previous content of the screen.
' Font size must be defined in a global variable, as the 
' message function refers to it. For the time being it is
' simply set in the main program (fs=20). In a future version
' of SB we might be able to get it using a command like
' fs=GET FONTSIZE. 
' The aspect ratio of the window is set in the first instruction 
' in the function (aspect=2).
' When used for iPhone or iPod, i recommend a fontsize of 10-12
' and an aspect ratio of 1.
' Extreme values for font size and/or aspect ratio may give
' unsatisfactory results.
' A slightly adapted version of the w_open function is used.
' The function gen_str$ is not nessecary, it is used here
' to generate some (rubbish) strings.
'
option base 1 ! randomize       '  main (test) program
graphics ! graphics clear .8,.8,.8
fill color .8,.8,.8 ! draw color 0,0,0
s_w=screen_width() ! s_h=screen_height()
s_cx=s_w/2 ! s_cy=s_h/2

graphics lock
for s=10 to 700 step 20      ' create some background
  draw color rnd(1),rnd(1),rnd(1) ! draw line 10,s to 700,s
  draw color rnd(1),rnd(1),rnd(1) ! draw line s,10 to s,700
  next s
graphics unlock

a$=gen_str$(50+rnd(300))  ' generate a random text string
fs=20  ' font size must be defined by a global variabele "fs"
win_message(a$) 
end

def win_message(a$)
aspect=2 ! ntek=len(a$) ! fac=min(ntek/5000,.2)
fs=.fs ! fs=max(fs,8) ! draw font size fs
a=aspect ! b=40+30*aspect ! c=(.8-fac)*fs*fs*ntek-1200
hgt=.5*(b+sqrt(b*b+4*a*c))/a ! wid=aspect*hgt 
xt=.s_cx-wid/2 ! yt=.s_cy-hgt/2
xb=xt+wid ! yb=yt+hgt
graphics lock
sprite "bg" scan xt-3,yt-3,wid+6,hgt+30
w_open("testwindow",xt,yt,xb,yb,fs)
button "oke" title "Ok" at xb-40,yt+32 size 36,hgt-40
widtek=wid-35 ! ypr=yt+30-fs ! prprev=0 ! prev=1 ! nxt=0
do
  nxt=instr(a$," ",prev)
  if nxt=-1 then
    ypr+=fs-1 ! pr$=substr$(a$,prprev+1,ntek)
    draw text pr$ at xt+5,ypr
    break
    end if
  pos=5+.6*fs*(nxt-prprev)
  if pos<widtek then ! prev=nxt+1 ! continue ! end if
  nxt=prev ! ypr+=fs-1 ! pr$=substr$(a$,prprev+1,nxt-1)
  draw text pr$ at xt+5,ypr ! prprev=nxt
  until nxt=-1
graphics unlock
wait: if not button_pressed("oke") then wait
button "oke" delete
sprite "bg" at xt-3,yt-3 ! sprite "bg" stamp
end def

def w_open (title$,xtop,ytop,xbot,ybot,fs)
r=10 ! draw size 4
draw color 0,0,0
draw circle xtop,ytop to xtop+20,ytop+20
draw circle xbot-20,ytop to xbot,ytop+20
draw circle xtop,ybot-20 to xtop+20,ybot
draw circle xbot-20,ybot-20 to xbot,ybot
draw line xtop+r,ytop to xbot-r,ytop
draw line xtop+r,ybot to xbot-r,ybot
draw line xtop,ytop+r to xtop,ybot-r
draw line xbot,ytop+r to xbot,ybot-r
fill rect xtop+r,ytop+2 to xbot-r,ybot-2
fill rect xtop+2,ytop+r to xbot-2,ybot-r
if title$<>"" then
  l=(xbot-xtop-.6*fs*len(title$))/2
  draw line xtop,ytop+24 to xbot,ytop+24
  draw color 0,0,1
  draw text title$ at xtop+l,ytop+60/fs
  draw color 0,0,0
end if
end def

def gen_str$(length)
ko=substr$("10",1,1) ' works for either OPTION BASE 0 or 1
randomize
nwords=length/5.5
kl$="aeiou" ! m$="bcdfghjklmnprstvwz" ! cap=1
for i=1 to nwords
  leng=3+rnd(4)
  for j=1 to leng
    if rnd(1)>.35 then
      k=ko+rnd(18) ! b$=substr$(m$,k,k)
      if cap then
        cap=0 ! b$=capstr$(b$)
        end if
      a$=a$ & b$
      else
      k=ko+rnd(5) ! b$=substr$(kl$,k,k)
      if cap then
        cap=0 ! b$=capstr$(b$)
        end if
      a$=a$ & b$
      end if
    next j
  if rnd(1)<.05 and tel>3 then
    a$=a$ & "." ! cap=1 ! tel=0
    else
    tel=tel+1
    end if
  a$=a$ & " "
  next i
a$=a$ & "."
gen_str$=a$
end def


Re: Windows message box object

Posted: Fri Apr 04, 2014 5:39 pm
by Mr. Kibernetik
Very interesting!