home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
WBB12.ZIP
/
SAMPLEG4.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-09-09
|
6KB
|
263 lines
rem
rem This program is just like SAMPLEG3.BAS except that in this
rem one we handle our own screen repainting (ON PAINT GOSUB xxxx)
rem AND we use our own palette.
rem
rem This program is for WINDOWS use only.
rem
rem Notice use of the ON PAINT command. Please note that any variables
rem you change while handling an ON PAINT command will also be changed
rem in your main program and you can receive an ON PAINT command
rem A N Y T I M E !!!!!!! Also notice that we use the function SYSTEM(12)
rem to see if we are the active window and if we are not we DO NOT use
rem the paint command. Since we are using our own palette, if we were
rem not the active window, Windows can erase our custom colors. Then
rem the PAINT command might not work correctly since the border color we are
rem looking for might not exist. Hence we would paint the entire window.
rem
rem windows size 30,9,50,11
REM windows name "Mark's Clock"
rem
rem Before going into graphics mode say we are handling paint. If we
rem wait and do this after SCREEN command then a big bitmap would be
rem created (during SCREEN command) and then deleted (during ON PAINT).
rem
on paint gosub 1000
screen 1000,16
mode=system(7)
createfont 1,60,0,0,0,0,0,0,0,0,0,0,0,0,""
createfont 2,14,0,0,0,0,0,0,0,0,0,0,0,0,""
selectfont 1
xsize=dlen("00:00:00")
rem
rem See if we have written out initialization parameters
rem
l=len(dir$("marks.stu"))
if l>0 then
open "marks.stu" for input as #1
input #1,leftx,topy,offset
close #1
else
leftx=0
topy=0
end if
rem
rem size window
rem
position leftx,topy,xsize+1-(xsize/9),60
rem
rem make background color our own special blend
rem
line (0,0)-(xsize+1-(xsize/9),60),4,bf
color 15,4
PALETTE 4,65536*255+256*200+150
rem bright blue + a little green + a smidgeon of red
gosub makebuttons
mouseflag=mouseon
t$=""
quartersec=5
rem
rem Now we enter a perpetual loop to update time
rem
100
tt$=time$
if left$(tt$,5)<>t$ then
t$=left$(tt$,5)
gosub drawhourmin
end if
sec=val(right$(tt$,2))
sec=int(sec/15)
if sec<>quartersec then
if quartersec=5 then
for quartersec=0 to sec
gosub drawsec
next quartersec
else
quartersec=sec
gosub drawsec
end if
end if
rem
rem check for button push
rem
a$=inkey$
if len(a$)>1 then
if asc(right$(a$,1))=59 or asc(right$(a$,1))=60 then
rem + pushed
if asc(right$(a$,1))=59 then
offset=offset+1
if offset>30 then offset=30
else
offset=offset-1
if offset<-30 then offset=-30
end if
ix=xsize-((xsize/8)*2)
iy=40
ix=ix-10
iy=iy-10
line (ix,iy)-(ix+20,iy+20),4,BF
selectfont 2
locate iy,ix
print str$(offset);
selectfont 1
gosub drawhourmin
open "marks.stu" for output as #1
print #1, x,y,offset
close #1
end if
end if
goto 100
rem
rem routine to draw hour/min
rem
rem on input tt$ has 5 chars for hour/min
rem
drawhourmin:
ttt$=left$(tt$,5)
if offset<>0 then
h=val(left$(ttt$,2))
m=val(right$(ttt$,2))
m=m+offset
if m>59 then
m=m-60
h=h+1
if h=24 then h=0
elseif m<0 then
m=m+60
h=h-1
if h<0 then h=23
end if
m$=str$(m)
l=len(m$)
m$=right$(m$,l-1)
if len(m$)<2 then m$="0"+m$
if len(m$)>2 then m$=right$(m$,2)
h$=str$(h)
l=len(h$)
h$=right$(h$,l-1)
if len(h$)<2 then h$="0"+h$
if len(h$)>2 then h$=right$(h$,2)
ttt$=h$+":"+m$
end if
locate 0,0
print ttt$;
return
rem
rem draw second
rem
rem quartersec has 1/4 min
rem
drawsec:
x=xsize-((xsize/8)*2)
y=40
if quartersec=0 then
circle (x,y),10,12
if system(12)=1 then
paint (x,y),12
end if
circle (x,y),10,7,-.01,-3.1416/2
if system(12)=1 then
paint (x+2,y-2),7
end if
elseif quartersec=1 then
circle (x,y),10,6,-4.7124,-.01
if system(12)=1 then
paint (x+2,y+2),6
end if
elseif quartersec=2 then
circle (x,y),10,5,-3.1416,-4.7124
if system(12)=1 then
paint (x-2,y+2),5
end if
elseif quartersec=3 then
circle (x,y),10,3,-3.1416/2,-3.1416
if system(12)=1 then
paint (x-2,y-2),3
end if
gosub checkposition
end if
return
rem
rem check and see if window position has changed. If so write new
rem position to my initialization file
rem
checkposition:
x=system(8)
y=system(9)
if x<>leftx or y<>topy then
open "marks.stu" for output as #1
print #1, x,y,offset
close #1
end if
return
rem
rem We come here when notified by windows to paint the screen
rem
rem We could get a paint command before we have gotten our first
rem time (tt$=""). If so do nothing.
rem
1000
if tt$="" then return
line (0,0)-(xsize+1-(xsize/9),60),4,BF
selectfont 1
gosub drawhourmin
savequartersec=quartersec
for quartersec=0 to savequartersec
gosub drawsec
next quartersec
quartersec=savequartersec
return
makebuttons:
rem
rem define buttons
rem
px=xsize-((xsize/8)*3)+4
py=10
CBUTTON "+",1059,0,"Push",0,px+5,py,16,14,7,1
cbutton "-",1060,0,"Push",0,px+25,py,16,14,7,1
return