SMARTWARE PROGRAM CODE, Page 1

_oswait() NT WAIT FUNCTION
'By Alan Salmon and Paul Budd (c) 1998
'function to wait (mainly under NT) for the end of a spawned DOS session
'2 parameters, 1 - Name of the command or batch file to run
' 2 - message to display while waiting
PUBLIC _oswait(2)
FUNCTION _oswait(program$,message$)
LOCAL a$ flag c p$
'find out if TEMP variable exists
'yes - use this path, no - use root of c:
p$=GETENV("temp") 'not case specific
IF p$=0
    p$="c:\"
ELSEIF p$<>0
    p$=p$|"\"
END IF
'erase old copies of files
TOOLS FILE ERASE p$|"oswait.bat"
TOOLS FILE ERASE p$|"oswait.tmp"
'create batch file
FOPEN p$|"oswait.bat" AS 1
IF upper(program$)!".BAT"
    FWRITE 1 FROM "CALL"&program$
ELSE
    FWRITE 1 FROM program$
END IF
FWRITE 1 FROM "ECHO DONE>"|p$|"oswait.tmp"
FCLOSE 1
SCREEN CLEAR BOX 1 1 SCRHEIGHT SCRWIDTH FGPLEASING BGPLEASING NO-BORDER
BIGOS p$|"oswait.bat"
flag=1
c=1
'display message while process is running and wait until finished
'finish of process indicated by creation of oswait.tmp
WHILE NOT(FILE(p$|"oswait.tmp"))
a$=" "|message$|" " 'spaces on each end erase scrolling message
c=c+flag
IF c=SCRWIDTH-LEN(a$)
    flag=-1
ELSEIF c=1
    flag=1
END IF
SCREEN PRINT SCRHEIGHT/2 c FGPLEASING BGPLEASING a$
MILLI-WAIT 100
END WHILE
END FUNCTION
SWITCHING MODULES - DBLOAD.PF3, SSLOAD.PF1
PUBLIC program$
REPAINT OFF
CZBREAK OFF
TOOLS PREFERENCES HARDWARE
KEYS Down,Down,"HPIII_DC",Enter,F10
LOCK SYSTEM program$
LOAD "banner.rf2" IN-MEMORY
LOAD "barmenu.rf3" IN-MEMORY
LOAD "clear.rf3" IN-MEMORY
LOAD "drawbox.rf3" IN-MEMORY
LOAD "drawtxt.rf3" IN-MEMORY
TRANSFER program$ FROM-FILE
ISKEY.PF3
'list of key fields as space separated list
LOCAL c keyfields
QUIET OFF
FOR c =1 TO DBINFO(DB_FIELDS)
    IF DBFLDINFO(c,DBF_ISKEY)=1 AND DBFLDINFO(c,DBF_ONTABLE)=0
        keyfields=keyfields&DBFLDINFO(c,DBF_NAME)
    END IF
END FOR
MESSAGE keyfields

 

CRIME POTENTIAL GRAPH - DATABASE PROJECT FILE
EXTERNAL _drawbox() _drawtxt() _banner() ' declare functions
PUBLIC qu$ co$ start finish program$ ' set public variables
LOCAL array[168],cnt ' create an array for each hour of the week
LOCK SYSTEM qu$ co$ start finish program$
CZBREAK OFF ' turn off 'break'
qu$=CHR(34) ' set qu$ to be double quotes
co$=","
REPAINT OFF
_banner("CRIME POTENTIAL") ' use 'banner' function to title screen
_drawtxt(5,5,"Calculating. Please wait....",15,14,1) ' use '3d drawtxt' function to display text
TOOLS FILE ERASE "potent.idx" ' erase old potential index
ORDER CHANGE PHYSICAL
DATA QUERY EXECUTE "potent" INDEX "potent" ' eliminate crimes that do not match criteria
EXECUTE "save_db" FROM-FILE ' saves name of currentl loaded database
IF FILE("potent.idx")=0 ' check if records found, index file true
_drawtxt(SCRHEIGHT-10,5,"Nothing found to analyse !!",15,14,12) ' otherwise display nothing found
BEEP 2
WAIT 2
TRANSFER "4grpmen" FROM-FILE ' return to main graph menu
END IF
TOOLS FILE ERASE "potent.tmp" ' delete temporary fiel which stores array
DATA GOTO RECORD FIRST ' start loop to work through each record
WHILE RECORD<=RECORDS
' work out numeric day of crime
start=CASE [DAY-FROM]("Mon",0)("Tue",1)("Wed",2)("Thu",3)("Fri",4)("Sat",5)("Sun",6)
start=start*24 ' convert numeric day to hours
start=start+HOUR([TIME-FROM]) ' add hours in the day (start hour)
' convert finish day to numeric
finish=case [DAY-to]("Mon",0)("Tue",1)("Wed",2)("Thu",3)("Fri",4)("Sat",5)("Sun",6)
finish=finish*24 'convert to hours
finish=finish+HOUR([TIME-TO]) ' add hours during finish day
IF start<=finish ' when start is before finishi
FOR cnt=start TO finish ' go from start time to finish time and add to
array[cnt+1]=array[cnt+1]+(1/(finish-start+1)) ' appropriate array element
END FOR
ELSE
FOR cnt=start TO 167 ' otherwise it is over different weeks so
array[cnt+1]=array[cnt+1]+(1/(finish-start+169)) ' go from start to end of the week
END FOR ' and then carry on from 0 to finish
FOR cnt=0 TO finish
array[cnt+1]=array[cnt+1]+(1/(finish-start+169))
END FOR
END IF
' display progress indication
_drawtxt(9,5,"Completed:"|STR(INT((RECORD/RECORDs)*100))|"%",15,14,1)
DATA GOTO RECORD NEXT
END WHILE
FOPEN "potent.tmp" AS 1 ' write array to text file (imported into S/Sheet)
FOR cnt=1 TO 168
FWRITE 1 FROM STR(array[cnt])
END FOR
FWRITE 1 FROM qu$|APINFO(AP_FILE)|qu$
FWRITE 1 FROM STR(RECORDS)
FCLOSE 1
program$="potent" ' set program to run in S/Sheet
QUIT SPREADSHEET PROJECT-FILE "ssload" ' quit to the spreadsheet for next part
DRAWBOX AND DRAWTXT.PF3 'SHADOW EFFECTS'
PUBLIC _drawbox()
FUNCTION _drawbox(r,c,rows,width,fg,bg)
IF width+1+c>SCRWIDTH
ERRORMESSAGE 998 "The box is too wide - reduce the width parameter."
EXIT FUNCTION
END IF
IF r+rows+1>SCRHEIGHT
ERRORMESSAGE 997 "The box is to high - reduce the height parameter."
EXIT FUNCTION
END IF
SCREEN CLEAR BOX r+1 c+1 r+rows+1 c+width+1 0 0
SCREEN CLEAR BOX r c r+rows c+width fg bg
SCREEN DRAW BOX r c r+rows c+width fg bg
END FUNCTION

PUBLIC _drawtxt()
FUNCTION _drawtxt(r,c,strng$,col,fg,bg)
LOCAL width
width=LEN(strng$)+2
IF width+3+c>SCRWIDTH
ERRORMESSAGE 999 "The text is too wide - reduce the text width."
EXIT FUNCTION
END IF
SCREEN CLEAR BOX r+1 c+1 r+2+1 c+width+2 0 0 NO-BORDER
SCREEN CLEAR BOX r c r+2 c+width+1 fg bg
SCREEN DRAW BOX r c r+2 c+width+1 fg bg
SCREEN PRINT r+1 c+2 col bg strng$
END FUNCTION

BARMENU.PF3
PUBLIC _barmenu()
FUNCTION _barmenu($prompt,$options,$row,$col,col_scheme,default)
LOCAL character options choice key_pressed max_length
LOCAL i j fg bg bxfg hfg hbg ch$
CASE col_scheme
WHEN 0
fg=15
bg=0
bxfg=15
hfg=15
hbg=1
WHEN 1
fg=15
bg=1
bxfg=14
hfg=15
hbg=12
WHEN 2
fg=10
bg=3
bxfg=15
hfg=10
hbg=4
WHEN 3
fg=10
bg=12
bxfg=8
hfg=0
hbg=14
END CASE
options=1
FOR character=1 TO LEN($options)
IF MID($options,character,1)=" "
options=options+1
END IF
END FOR
max_length=LEN($prompt)
FOR i=1 TO options
IF LEN(GROUP($options,i))>max_length
max_length=LEN(GROUP($options,i))
END IF
END FOR
SCREEN CLEAR BOX $row+1 $col+1 ($row+options+4) ($col+max_length+4) 0 0 no-border
SCREEN CLEAR BOX $row $col ($row+options+3) ($col+max_length+3) \
bxfg bg
SCREEN PRINT $row $col+2 fg bg $prompt
choice=default
WHILE 1
FOR i=1 TO options
IF choice=i
SCREEN PRINT ($row+1+i) ($col+2) hfg hbg GROUP($options,i)
ELSE
SCREEN PRINT ($row+1+i) ($col+2) fg bg GROUP($options,i)
END IF
END FOR

ch$=0
WHILE ch$=0
ch$=NEXTKEY
SCREEN PRINT ($row+2+options) ($col+max_length-LEN(TIME)+3) fg-1 bg-1 STR(TIME)
END WHILE
key_pressed=INCHAR
CASE key_pressed
WHEN {enter}
EXIT WHILE
WHEN {down}
choice=choice+1
WHEN {up}
choice=choice-1
WHEN {space}
choice=choice+1
WHEN {bs}
choice=choice-1
WHEN {Esc}
choice=options
WHEN {Mouse}   
    IF CLICKINFO(M_LEFTUP) AND CLICKINFO(M_COL)>=$col+2 AND CLICKINFO(M_COL)<=$col+2+LEN(GROUP($options,(CLICKINFO(m_ROW)-($row+1))))-1
        key_pressed=ASC(LEFT(GROUP($options,(CLICKINFO(M_ROW)-($row+1))),1))
    END IF
IF key_pressed>=48 and key_pressed<=57 OR key_pressed>=65 AND key_pressed<=90 or key_pressed>=97 AND key_pressed<=122
FOR i=1 TO options
IF CHR(key_pressed)==LEFT(GROUP($options,i),1)
choice=i
FOR j=1 TO options
IF choice=j
SCREEN PRINT ($row+1+j) ($col+2) hfg hbg \
GROUP($options,j)
ELSE
SCREEN PRINT ($row+1+j) ($col+2) fg bg \
GROUP($options,j)
END IF
END FOR
EXIT WHILE
END IF
END FOR
END IF
OTHERWISE
IF key_pressed>=48 and key_pressed<=57 OR key_pressed>=65 AND key_pressed<=90 or key_pressed>=97 AND key_pressed<=122
FOR i=1 TO options
IF CHR(key_pressed)==LEFT(GROUP($options,i),1)
choice=i
FOR j=1 TO options
IF choice=j
SCREEN PRINT ($row+1+j) ($col+2) hfg hbg \
GROUP($options,j)
ELSE
SCREEN PRINT ($row+1+j) ($col+2) fg bg \
GROUP($options,j)
END IF
END FOR
EXIT WHILE
END IF
END FOR
END IF
BEEP
END CASE
IF choice>options
choice=1
END IF
IF choice<1
choice=options
END IF
END WHILE
RETURN choice
END FUNCTION

 

_clip2cell() CLIPBOARD FUNCTION TO PASTE FROM TO CLIPBOARD SPREADSHEET CELLS
‘CLIPBOARD PASTE TO SPREADSHEET
‘COMPLIMENTS CLIPCOPY
‘WRITTEN BY ALAN SALMON 19/1/99

global _clp2cell(0)
main
_clp2cell()
end main

‘HERE IS WHERE THE WORK IS DONE.
function _clp2cell()
local ro1,co1,clip$,i,j,t$,a$
let ro1=row ‘current row
let co1=column ‘current col - ie top left corner of destination
clipboard get clip$
if clip$=""
exit function
end if
if right(clip$,1)<>chr(10)
clip$=clip$|chr(10)
end if
‘ tab separates cols, chr(10) lines
let i=1
while i <= len (clip$)
let j=i
let a$=mid(clip$,j,1)
while a$>=" "
let j=j+1
let a$=mid(clip$,j,1)
end while
let t$=mid(clip$,i,j-i)
if val(t$)=0
enter text t$
else
evaluate "enter value" & t$
end if
cursor right
if a$=chr(10)
let ro1=ro1+1
evaluate ("at r"|str(ro1)|"c"|str(co1))
end if
let i=j+1
end while
end function

cell2clp FUNCTION TO PASTE TO CLIPBOARD FROM SPREADSHEET CELLS

‘COPIES CELLS TO CLIPBOARD
‘REQUIRES ANOGSS S/W 2.65B OR LATER, RUNNING UNDER ‘WINDOWS SPREADSHEET MODULE

‘WRITEEN BY ALAN SALMON, 15/10/98
global _CELL2CLP(1)
public ro1,ro2,co1,co2
‘messy I know, but these variables have to be public to evaluate
main
local block
let block=blockmark
_CELL2CLP(block)
end main

‘THIS IS THE ACTUAL FUNCTION THAT DOES THE BUSINESS
FUNCTION _CELL2CLP (block$)
LOCAL I,J,CLIP$,TEMP$
‘ro1,ro2,co1,co2 should really be local, but need to be evaluated
‘basic check for valid block
if upper(left(block$,1))<>"R"
return -1
end if
evaluate "at "|block$
let ro1=row
let co1=column
evaluate "let ro2=ro1+rows("|block$|")-1"
evaluate "let co2=co1+cols("|block$|")-1"
‘thanks to Paul for suggesting I have to make variables Public to evaluate
LET CLIP$=""
FOR I=Ro1 TO Ro2
FOR J=Co1 TO Co2
LET TEMP$=SSGET(I,J)
IF (ISNUMBER(TEMP$))
TEMP$=STR(TEMP$)
END IF
LET CLIP$=CLIP$ | TEMP$ | CHR(9) ‘ SEPARATE ENTRIES WITH TAB
END FOR
LET CLIP$=LEFT(CLIP$,LEN(CLIP$)-1) | CHR(10)
‘ REMOVE LAST TAB, PUT IN LF
END FOR
CLIPBOARD SET CLIP$
RETURN CLIP$
END FUNCTION

previous.gif (589 bytes)next.gif (589 bytes)

ABOUT ME FAMILY HARDWARE SOFTWARE OTHER SMARTWARE