5748113 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n samplew2.bas
   1: 
   2: rem
   3: rem This program is just like SAMPLEG3.BAS except that in this
   4: rem one we handle our own screen repainting (ON PAINT GOSUB xxxx)
   5: rem AND we use our own palette.
   6: rem
   7: rem This program is for WINDOWS use only.
   8: rem
   9: rem Notice use of the ON PAINT command.  Please note that any variables
  10: rem you change while handling an ON PAINT command will also be changed
  11: rem in your main program and you can receive an ON PAINT command
  12: rem  A N Y T I M E !!!!!!!  Also notice that we use the function SYSTEM(12)
  13: rem to see if we are the active window and if we are not we DO NOT use
  14: rem the paint command.  Since we are using our own palette, if we were
  15: rem not the active window, Windows can erase our custom colors.  Then
  16: rem the PAINT command might not work correctly since the border color we are
  17: rem looking for might not exist.  Hence we would paint the entire window.
  18: rem
  19: 
  20:    rem windows size 30,9,50,11
  21: 
  22:    REM windows name "Mark's Clock"
  23: 
  24: 
  25:    rem
  26:    rem Before going into graphics mode say we are handling paint.  If we
  27:    rem wait and do this after SCREEN command then a big bitmap would be
  28:    rem created (during SCREEN command) and then deleted (during ON PAINT).
  29:    rem
  30:    on paint gosub 1000
  31:    screen 1000,16
  32:    mode=system(7)
  33: 
  34:    createfont 1,60,0,0,0,0,0,0,0,0,0,0,0,0,""
  35:    createfont 2,14,0,0,0,0,0,0,0,0,0,0,0,0,""
  36:    selectfont 1
  37:    xsize=dlen("00:00:00")
  38:    rem
  39:    rem See if we have written out initialization parameters
  40:    rem
  41:    l=len(dir$("marks.stu"))
  42:    if l>0 then
  43:     open "marks.stu" for input as #1
  44:     input #1,leftx,topy,offset
  45:     close #1
  46:    else
  47:     leftx=0
  48:     topy=0
  49:    end if
  50: 
  51:    rem
  52:    rem size window
  53:    rem
  54: 
  55:    position leftx,topy,xsize+1-(xsize/9),60
  56: 
  57: 
  58:    rem
  59:    rem make background color our own special blend
  60:    rem
  61:    line (0,0)-(xsize+1-(xsize/9),60),4,bf
  62:    color 15,4
  63:    PALETTE 4,65536*255+256*200+150
  64: 	 rem bright blue + a little green + a smidgeon of red
  65: 
  66: 
  67:    gosub makebuttons
  68:    mouseflag=mouseon
  69: 
  70: 
  71: 
  72:    t$=""
  73:    quartersec=5
  74: 
  75: 
  76: rem
  77: rem Now we enter a perpetual loop to update time
  78: rem
  79: 
  80: 100
  81:    tt$=time$
  82: 
  83:    if left$(tt$,5)<>t$ then
  84:      t$=left$(tt$,5)
  85:      gosub drawhourmin
  86:    end if
  87: 
  88:    sec=val(right$(tt$,2))
  89:    sec=int(sec/15)
  90:    if sec<>quartersec then
  91:      if quartersec=5 then
  92:        for quartersec=0 to sec
  93: 	 gosub drawsec
  94:        next quartersec
  95:      else
  96:        quartersec=sec
  97:        gosub drawsec
  98:      end if
  99:    end if
 100: 
 101:    rem
 102:    rem check for button push
 103:    rem
 104:    a$=inkey$
 105:    if len(a$)>1 then
 106:     if asc(right$(a$,1))=59 or asc(right$(a$,1))=60 then
 107:      rem + pushed
 108:      if asc(right$(a$,1))=59 then
 109:        offset=offset+1
 110:        if offset>30 then offset=30
 111:      else
 112:        offset=offset-1
 113:        if offset<-30 then offset=-30
 114:      end if
 115:      ix=xsize-((xsize/8)*2)
 116:      iy=40
 117:      ix=ix-10
 118:      iy=iy-10
 119:      line (ix,iy)-(ix+20,iy+20),4,BF
 120:      selectfont 2
 121:      locate iy,ix
 122:      print str$(offset);
 123:      selectfont 1
 124:      gosub drawhourmin
 125:      open "marks.stu" for output as #1
 126:      print #1, x,y,offset
 127:      close #1
 128:     end if
 129:    end if
 130:    goto 100
 131: 
 132: 
 133: 
 134: rem
 135: rem routine to draw hour/min
 136: rem
 137: rem on input tt$ has 5 chars for hour/min
 138: rem
 139: 
 140: drawhourmin:
 141: 
 142:    ttt$=left$(tt$,5)
 143:    if offset<>0 then
 144:      h=val(left$(ttt$,2))
 145:      m=val(right$(ttt$,2))
 146:      m=m+offset
 147:      if m>59 then
 148:        m=m-60
 149:        h=h+1
 150:        if h=24 then h=0
 151:      elseif m<0 then
 152:        m=m+60
 153:        h=h-1
 154:        if h<0 then h=23
 155:      end if
 156:      m$=str$(m)
 157:      l=len(m$)
 158:      m$=right$(m$,l-1)
 159: 
 160:      if len(m$)<2 then m$="0"+m$
 161:      if len(m$)>2 then m$=right$(m$,2)
 162:      h$=str$(h)
 163:      l=len(h$)
 164:      h$=right$(h$,l-1)
 165:      if len(h$)<2 then h$="0"+h$
 166:      if len(h$)>2 then h$=right$(h$,2)
 167:      ttt$=h$+":"+m$
 168:    end if
 169:    locate 0,0
 170:    print ttt$;
 171:    return
 172: 
 173: 
 174: rem
 175: rem draw second
 176: rem
 177: rem quartersec  has 1/4 min
 178: rem
 179: 
 180: drawsec:
 181: 
 182:      x=xsize-((xsize/8)*2)
 183:      y=40
 184:      if quartersec=0 then
 185: 	 circle (x,y),10,12
 186: 	 if system(12)=1 then
 187: 	   paint (x,y),12
 188: 	 end if
 189:        circle (x,y),10,7,-.01,-3.1416/2
 190:        if system(12)=1 then
 191: 	 paint (x+2,y-2),7
 192:        end if
 193:      elseif quartersec=1 then
 194:        circle (x,y),10,6,-4.7124,-.01
 195:        if system(12)=1 then
 196: 	 paint (x+2,y+2),6
 197:        end if
 198:      elseif quartersec=2 then
 199:        circle (x,y),10,5,-3.1416,-4.7124
 200:        if system(12)=1 then
 201: 	 paint (x-2,y+2),5
 202:        end if
 203:      elseif quartersec=3 then
 204:        circle (x,y),10,3,-3.1416/2,-3.1416
 205:        if system(12)=1 then
 206: 	 paint (x-2,y-2),3
 207:        end if
 208:        gosub checkposition
 209:      end if
 210:      return
 211: 
 212: 
 213: 
 214: rem
 215: rem check and see if window position has changed.  If so write new
 216: rem position to my initialization file
 217: rem
 218: 
 219: checkposition:
 220:     x=system(8)
 221:     y=system(9)
 222:     if x<>leftx or y<>topy then
 223:       open "marks.stu" for output as #1
 224:       print #1, x,y,offset
 225:       close #1
 226:     end if
 227:     return
 228: 
 229: 
 230: rem
 231: rem We come here when notified by windows to paint the screen
 232: rem
 233: rem We could get a paint command before we have gotten our first
 234: rem time (tt$="").  If so do nothing.
 235: rem
 236: 
 237: 1000
 238:    if tt$="" then return
 239:    line (0,0)-(xsize+1-(xsize/9),60),4,BF
 240: 
 241:    selectfont 1
 242:    gosub drawhourmin
 243:    savequartersec=quartersec
 244:    for quartersec=0 to savequartersec
 245:      gosub drawsec
 246:    next quartersec
 247:    quartersec=savequartersec
 248:    return
 249: 
 250: 
 251: 
 252: makebuttons:
 253:    rem
 254:    rem define buttons
 255:    rem
 256: 
 257:      px=xsize-((xsize/8)*3)+4
 258:      py=10
 259:      CBUTTON "+",1059,0,"Push",0,px+5,py,16,14,7,1
 260:      cbutton "-",1060,0,"Push",0,px+25,py,16,14,7,1
 261:      return
 262: 
5748114 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:09:11