home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library2 / pd200.bas < prev    next >
Encoding:
BASIC Source File  |  1990-03-09  |  16.4 KB  |  518 lines
  1.  ' PW200 VIDEO, WINDOW AND MENU SUBROUTINES AND FUNCTIONS
  2.  ' POWERBASIC VERSION 2.0 DEMONSTRATION PROGRAM
  3.  ' COPYRIGHT (C) 1990, RICHARD D. FOTHERGILL  ALL RIGHTS RESERVED
  4.  
  5. $COMPILE EXE
  6.  
  7. $LIB ALL-
  8.  
  9. $ERROR ALL-
  10.  
  11. $INCLUDE "PW200.INC"
  12.  
  13.  CALL Openwin(1,1,25,80,attr(0,7),attr(0,7),0,0,0,0)
  14.  CALL Fakewin(2,1,23,80,attr(7,1),attr(7,1),1,0,0,0)
  15.  CALL Openwin(5,20,11,40,attr(0,7),attr(1,7),2,0,0,0)
  16.  CALL Printcwin(2,"PW200")
  17.  SELECT CASE curdisplay%
  18.  CASE 0 : msg$ = "MONO"
  19.  CASE 1 : msg$ = "CGA"
  20.  CASE 2 : msg$ = "EGA"
  21.  CASE 3 : msg$ = "MCGA"
  22.  CASE 4 : msg$ = "VGA"
  23.  END SELECT
  24.  msg1$ = STR$(curvideo%)
  25.  msg$ = msg$ + " monitor in video mode "+msg1$
  26.  CALL Printcwin(3,msg$)
  27.  IF mousehere THEN msg$ = "Mouse present and active." ELSE msg$ = "No mouse present"
  28.  CALL Printcwin(4,msg$)
  29.  CALL Printcwin(5,"Copyright (C) 1990")
  30.  CALL Printcwin(6,"by Richard D. Fothergill")
  31.  CALL Printcwin(7,"All Rights Reserved")
  32.  x = 0
  33.  WHILE NOT INSTAT AND (x < 32000)
  34.    INCR x
  35.  WEND
  36.  CALL Closewin
  37.  IF INKEY$ <> "" THEN
  38.    a$ = INKEY$
  39.    a$ = CHR$(0)
  40.  END IF
  41.  done = 0
  42.  CALL Initmenus
  43.  
  44.  CALL Sprint(25,1,"             Use arrow keys to change selection - Return to select              ",attr(0,3))
  45.  WHILE NOT done
  46.    CALL Makehmenu(mitem$(),subitem$,mitemcount,mcurntpos,mstartpos,mhlattr,mflattr,mflon,mmenuspaces,mbarloc)
  47.    SELECT CASE mcurntpos
  48.    CASE 1 : CALL Fdemo
  49.    CASE 2 : CALL Tdemo
  50.    CASE 3 : CALL Sdemo
  51.    CASE 4 : CALL Edemo
  52.    CASE ELSE
  53.      CALL Closewin
  54.      CLS
  55.      CALL Openwin(9,16,8,52,attr(0,7),attr(1,7),2,0,0,0)
  56.      CALL Printcwin(3," P W ")
  57.      CALL Printcwin(4,"2 0 0")
  58.      DELAY(3)
  59.      CALL Closewin
  60.      done = -1
  61.    END SELECT
  62.  WEND
  63.  END
  64.  
  65. SUB Initmenus
  66.  SHARED mitem$(),subitem$,mitemcount,mcurntpos,mstartpos,mhlattr,mflattr,mflon,mmenuspaces,mbarloc
  67.  SHARED sitem$(),sliveitem$,sitemcount,scurntpos,sstartpos,shlattr,sflattr,snoattr,sbartype,sflon
  68.  SHARED eitem$(),eliveitem$,eitemcount,ecurntpos,estartpos,ehlattr,eflattr,enoattr,ebartype,eflon IF curvideo = 7 THEN menunoattr = attr(0,0) ELSE menunoattr = attr(8,7)
  69.  
  70.  mcurntpos = 0
  71.  mstartpos = 1
  72.  DIM mitem$(5)
  73.  mitem$(1) = "Frames"
  74.  mitem$(2) = "Titles"
  75.  mitem$(3) = "Shadows"
  76.  mitem$(4) = "Demos"
  77.  mitem$(5) = "Quit"
  78.  mitemcount = 5
  79.  mhlattr  = attr(7,0)
  80.  mflattr  = attr(15,7)
  81.  mflon = -1
  82.  mmenuspaces = 8
  83.  mbarloc = 0
  84.  subitem$ ="001110"
  85.  sliveitem$ = "11011011"
  86.  scurntpos = 0
  87.  sstartpos = 1
  88.  DIM sitem$(8)
  89.  sitem$(1) = "Flat         (   0)"
  90.  sitem$(2) = "Reattribute  (1, 2)"
  91.  sitem$(3) = "Solid        (3, 4)"
  92.  sitem$(4) = "Light Hatch  (5, 6)"
  93.  sitem$(5) = "Medium Hatch (7, 8)"
  94.  sitem$(6) = "Heavy Hatch  (9,10)"
  95.  sitem$(7) = "Activate Items 3,6 "
  96.  sitem$(8) = "Deact. Items   3,6 "
  97.  sitemcount = 8
  98.  shlattr = attr(7,0)
  99.  sflattr = attr(15,7)
  100.  snoattr = menunoattr
  101.  sbartype = 1
  102.  sflon = -1
  103.  eliveitem$ = "11111"
  104.  ecurntpos = 0
  105.  estartpos = 1
  106.  DIM eitem$(5)
  107.  eitem$(1) = "Pop Windows       "
  108.  eitem$(2) = "Zoom Windows      "
  109.  eitem$(3) = "File / List Window"
  110.  eitem$(4) = "DOS Utilities     "
  111.  eitem$(5) = "Field Input       "
  112.  eitemcount = 5
  113.  ehlattr = attr(7,0)
  114.  eflattr = attr(15,7)
  115.  enoattr = menunoattr
  116.  ebartype = 1
  117.  eflon = -1
  118. END SUB
  119.  
  120. SUB Continue
  121.  CALL Sprintc(25,1,80,"             Press any key to continue...            ",attr(15,3))
  122.  CALL Getkey(a1$,a2$)
  123.  CALL Sprintc(25,1,80,"Use arrow keys to change selection - Return to select",attr(0,3))
  124. END SUB
  125.  
  126. SUB Fdemo
  127.  CALL Openwin(5,15,6,15,attr(15,2),attr(15,2),0,0,1,0)
  128.  CALL Titlewin(2,attr(14,2),"[ Style 0 ]")
  129.  CALL Openwin(5,34,6,15,attr(15,5),attr(15,5),1,8,1,0)
  130.  CALL Titlewin(2,attr(14,5),"[ Style 1 ]")
  131.  CALL Openwin(5,53,6,15,attr(15,3),attr(15,3),2,8,1,0)
  132.  CALL Titlewin(2,attr(14,3),"[ Style 2 ]")
  133.  CALL Openwin(8,5,6,15,attr(15,4),attr(15,4),3,8,1,0)
  134.  CALL Titlewin(2,attr(14,4),"[ Style 3 ]")
  135.  CALL Openwin(8,24,6,15,attr(15,3),attr(15,3),4,8,1,0)
  136.  CALL Titlewin(2,attr(14,3),"[ Style 4 ]")
  137.  CALL Openwin(8,43,6,15,attr(15,6),attr(15,6),5,8,1,0)
  138.  CALL Titlewin(2,attr(14,6),"[ Style 5 ]")
  139.  CALL Openwin(8,62,6,15,attr(15,5),attr(15,5),6,8,1,0)
  140.  CALL Titlewin(2,attr(14,5),"[ Style 6 ]")
  141.  CALL Openwin(11,15,6,15,attr(15,2),attr(15,2),7,8,1,0)
  142.  CALL Titlewin(2,attr(14,2),"[ Style 7 ]")
  143.  CALL Openwin(11,34,6,15,attr(15,7),attr(15,7),8,8,1,0)
  144.  CALL Titlewin(2,attr(14,7),"[ Style 8 ]")
  145.  CALL Openwin(11,53,6,15,attr(15,4),attr(15,4),9,8,1,0)
  146.  CALL Titlewin(2,attr(14,4),"[ Style 9 ]")
  147.  CALL Openwin(14,5,6,15,attr(15,7),attr(15,7),10,8,1,0)
  148.  CALL Titlewin(2,attr(14,7),"[ Style 10]")
  149.  CALL Openwin(14,24,6,15,attr(15,6),attr(15,6),11,8,1,0)
  150.  CALL Titlewin(2,attr(14,6),"[ Style 11]")
  151.  CALL Openwin(14,43,6,15,attr(15,5),attr(15,5),12,8,1,0)
  152.  CALL Titlewin(2,attr(14,5),"[ Style 12]")
  153.  CALL Openwin(14,62,6,15,attr(15,2),attr(15,2),13,8,1,0)
  154.  CALL Titlewin(2,attr(14,2),"[ Style 13]")
  155.  CALL Openwin(17,15,6,15,attr(15,3),attr(15,3),14,8,1,0)
  156.  CALL Titlewin(2,attr(14,3),"[ Style 14]")
  157.  CALL Openwin(17,34,6,15,attr(15,2),attr(15,2),15,8,1,0)
  158.  CALL Titlewin(2,attr(14,2),"[ Style 15]")
  159.  CALL Openwin(17,53,6,15,attr(15,7),attr(15,7),16,8,1,0)
  160.  CALL Titlewin(2,attr(14,7),"[ Style 16]")
  161.  CALL Continue
  162.  FOR x = 1 TO 17
  163.    CALL Closewin
  164.  NEXT
  165. END SUB
  166.  
  167. SUB Tdemo
  168.  CALL Openwin(8,8,10,68,attr(15,5),attr(15,5),2,0,1,0)
  169.  CALL Printcwin(3,"Titles may be placed in any of six different locations")
  170.  CALL Printcwin(4,"and in any color attribute!")
  171.  FOR x=1 TO 6
  172.    msg$ = STR$(x)
  173.    msg$ = "[ LOCATION "+msg$+" ]"
  174.    CALL Titlewin(x,attr(9+x,5),msg$)
  175.    DELAY(1)
  176.  NEXT
  177.  CALL Continue
  178.  CALL Closewin
  179. END SUB
  180.  
  181. SUB Sdemo
  182.  SHARED sitem$(),sliveitem$,sitemcount,scurntpos,sstartpos,shlattr,sflattr,snoattr,sbartype,sflon
  183.  CALL Openwin(2,32,10,23,attr(0,7),attr(0,7),1,8,1,0)
  184.  done = 0
  185.  WHILE NOT done
  186.    CALL Makevmenu(sitem$(),sliveitem$,sitemcount,scurntpos,sstartpos,shlattr,sflattr,snoattr,sbartype,sflon)
  187.    SELECT CASE scurntpos
  188.    CASE 1
  189.      CALL Openwin(10,4,7,74,attr(15,5),attr(15,5),2,0,0,0)
  190.      CALL Titlewin(2,attr(15,5)," FLAT ")
  191.      CALL Openwin(11,8,10,30,attr(15,3),attr(0,3),1,0,0,0)
  192.      CALL Openwin(11,43,10,30,attr(15,7),attr(1,7),1,0,0,0)
  193.      CALL Continue
  194.      CALL Closewin
  195.      CALL Closewin
  196.      CALL Closewin
  197.    CASE 2
  198.      CALL Openwin(10,4,7,74,attr(15,5),attr(15,5),2,0,0,0)
  199.      CALL Titlewin(2,attr(15,5)," REATTRIBUTE ")
  200.      CALL Openwin(11,8,10,30,attr(15,3),attr(0,3),2,8,1,0)
  201.      CALL Printcwin(7,"Left Shadow")
  202.      DELAY(2)
  203.      CALL Openwin(11,43,10,30,attr(15,7),attr(1,7),2,8,2,0)
  204.      CALL Printcwin(7,"Right Shadow")
  205.      CALL Continue
  206.      CALL Closewin
  207.      CALL Closewin
  208.      CALL Closewin
  209.    CASE 3
  210.      CALL Openwin(10,4,7,74,attr(15,5),attr(15,5),2,0,0,0)
  211.      CALL Titlewin(2,attr(15,5)," SOLID ")
  212.      CALL Openwin(11,8,10,30,attr(15,3),attr(0,3),2,0,3,0)
  213.      CALL Printcwin(7,"Left Shadow")
  214.      DELAY(2)
  215.      CALL Openwin(11,43,10,30,attr(15,7),attr(1,7),2,0,4,0)
  216.      CALL Printcwin(7,"Right Shadow")
  217.      CALL Continue
  218.      CALL Closewin
  219.      CALL Closewin
  220.      CALL Closewin
  221.    CASE 4
  222.      CALL Openwin(10,4,7,74,attr(15,5),attr(15,5),2,0,0,0)
  223.      CALL Titlewin(2,attr(15,5)," LT. HATCH ")
  224.      CALL Openwin(11,8,10,30,attr(15,3),attr(0,3),2,attr(0,7),5,0)
  225.      CALL Printcwin(7,"Left Shadow")
  226.      DELAY(2)
  227.      CALL Openwin(11,43,10,30,attr(15,7),attr(1,7),2,attr(0,7),6,0)
  228.      CALL Printcwin(7,"Right Shadow")
  229.      CALL Continue
  230.      CALL Closewin
  231.      CALL Closewin
  232.      CALL Closewin
  233.    CASE 5
  234.      CALL Openwin(10,4,7,74,attr(15,5),attr(15,5),2,0,0,0)
  235.      CALL Titlewin(2,attr(15,5)," MED. HATCH ")
  236.      CALL Openwin(11,8,10,30,attr(15,3),attr(0,3),2,attr(0,7),7,0)
  237.      CALL Printcwin(7,"Left Shadow")
  238.      DELAY(2)
  239.      CALL Openwin(11,43,10,30,attr(15,7),attr(1,7),2,attr(0,7),8,0)
  240.      CALL Printcwin(7,"Right Shadow")
  241.      CALL Continue
  242.      CALL Closewin
  243.      CALL Closewin
  244.      CALL Closewin
  245.    CASE 6
  246.      CALL Openwin(10,4,7,74,attr(15,5),attr(15,5),2,0,0,0)
  247.      CALL Titlewin(2,attr(15,5)," HEAVY HATCH ")
  248.      CALL Openwin(11,8,10,30,attr(15,3),attr(0,3),2,attr(0,7),9,0)
  249.      CALL Printcwin(7,"Left Shadow")
  250.      DELAY(2)
  251.      CALL Openwin(11,43,10,30,attr(15,7),attr(1,7),2,attr(0,7),10,0)
  252.      CALL Printcwin(7,"Right Shadow")
  253.      CALL Continue
  254.      CALL Closewin
  255.      CALL Closewin
  256.      CALL Closewin
  257.    CASE 7
  258.      MID$(sliveitem$,3) = "1"
  259.      MID$(sliveitem$,6) = "1"
  260.    CASE 8
  261.      MID$(sliveitem$,3) = "0"
  262.      MID$(sliveitem$,6) = "0"
  263.    CASE ELSE
  264.      CALL Closewin
  265.      done = -1
  266.    END SELECT
  267.  WEND
  268.  done = 0
  269. END SUB
  270.  
  271. SUB Edemo
  272.  SHARED eitem$(),eliveitem$,eitemcount,ecurntpos,estartpos,ehlattr,eflattr,enoattr,ebartype,eflon
  273.  CALL Openwin(2,46,7,22,attr(0,7),attr(0,7),1,8,1,0)
  274.  done = 0
  275.  WHILE NOT done
  276.    CALL Makevmenu(eitem$(),eliveitem$,eitemcount,ecurntpos,estartpos,ehlattr,eflattr,enoattr,ebartype,eflon)
  277.    SELECT CASE ecurntpos
  278.    CASE 1
  279.      CALL Openwin(8,8,10,65,attr(15,5),attr(15,5),2,0,1,0)
  280.      CALL Printcwin(3,"Windows can be popped")
  281.      CALL Printcwin(4,"onto the screen.")
  282.      DELAY(2)
  283.      CALL Openwin(5,5,10,50,attr(0,2),attr(14,2),2,8,1,0)
  284.      DELAY(2)
  285.      CALL Openwin(13,15,10,60,attr(1,3),attr(15,3),3,8,1,0)
  286.      DELAY(2)
  287.      CALL Openwin(7,33,10,45,attr(14,5),attr(14,5),1,8,1,0)
  288.      CALL Continue
  289.      FOR x = 1 TO 4
  290.        CALL Closewin
  291.      NEXT
  292.    CASE 2
  293.      CALL Openwin(8,8,10,65,attr(15,5),attr(15,5),2,0,1,0)
  294.      CALL Printcwin(3,"Windows can be zoomed")
  295.      CALL Printcwin(4,"onto the screen.")
  296.      DELAY(2)
  297.      winspeed = 0
  298.      CALL Openwin(5,5,10,50,attr(0,2),attr(14,2),2,8,1,1)
  299.      DELAY(2)
  300.      winspeed = 10000
  301.      CALL Openwin(13,15,10,60,attr(1,3),attr(15,3),3,8,1,1)
  302.      DELAY(2)
  303.      winspeed = 20000
  304.      CALL Openwin(7,33,10,45,attr(14,5),attr(14,5),1,8,1,1)
  305.      DELAY(2)
  306.      winspeed = 30000
  307.      CALL Openwin(7,20,12,40,attr(15,4),attr(14,4),2,8,1,1)
  308.      CALL Printcwin(5,"HOW ABOUT THAT !!!")
  309.      CALL Continue
  310.      FOR x = 1 TO 5
  311.        CALL Closewin
  312.      NEXT
  313.    CASE 3
  314.      CALL Showfile
  315.    CASE 4
  316.      CALL Ddemo
  317.    CASE 5
  318.      CALL Idemo
  319.    CASE ELSE
  320.      CALL Closewin
  321.      done = -1
  322.    END SELECT
  323.  WEND
  324.  done = 0
  325. END SUB
  326.  
  327. SUB Showfile
  328.  dirinfo$ = STRING$(43,CHR$(0))
  329.  DIM recarr$(5000)
  330.  CALL Openwin(10,20,7,41,attr(0,7),attr(1,7),2,attr(8,0),1,0)
  331.  CALL Titlewin(5,attr(1,7),"[ Press Enter for Directory ]")
  332.  CALL Printcwin(2,"Enter a Text File Name to Display")
  333.  sourcename$ = ""
  334.  Capson = -1
  335.  CALL Getfield(4,10,sourcename$,"S",20,0,retcode,attr(15,1),attr(0,7))
  336.  Capson = 0
  337.  CALL Closewin
  338.  IF retcode <> 0 THEN
  339.    IF sourcename$ = "" THEN
  340.      sourcename$ = Makefmenu$("*.*",5,10,17,attr(1,7),attr(1,7),2,attr(8,0),1,0,attr(7,1))
  341.    END IF
  342.    IF RIGHT$(sourcename$,1)<>"\" THEN
  343.      CALL Findfirst(sourcename$+CHR$(0),&H10,dirinfo$,doserror)
  344.      IF doserror = 0 THEN
  345.        OPEN sourcename$ FOR INPUT AS #1
  346.        rec = 1
  347.        DO
  348.      LINE INPUT #1,recarr$(rec)
  349.      IF LEN(recarr$(rec)) > 76 THEN
  350.        recarr$(rec + 1) = RIGHT$(recarr$(rec),LEN(recarr$(rec))-76)
  351.        recarr$(rec) = LEFT$(recarr$(rec),76)
  352.        INCR rec
  353.      END IF
  354.      INCR rec
  355.        LOOP UNTIL EOF(1)
  356.        CLOSE #1
  357.        CALL Openwin(1,1,25,80,Attr(7,0),Attr(15,1),0,0,0,0)
  358.        CALL Titlewin(1,Attr(15,1),"LIST DEMO")
  359.        CALL Titlewin(3,Attr(15,1),Falign$(sourcename$))
  360.        CALL Makelmenu(recarr$(),rec,pickrec,1,Attr(0,7))
  361.        CALL Closewin
  362.      ELSE
  363.        CALL Openwin(10,20,5,40,Attr(15,4),Attr(15,4),2,Attr(8,0),1,0)
  364.        CALL Printcwin(2,"FILE NOT FOUND - PROCEDURE ABORTED!")
  365.        CALL Continue
  366.        CALL Closewin
  367.      END IF
  368.    END IF
  369.  END IF
  370.  ERASE recarr$
  371. END SUB
  372.  
  373. SUB Ddemo
  374.  LOCAL dirinfo$,doserror
  375.  dirinfo$ = SPACE$(43)
  376.  CALL Openwin(1,1,24,80,attr(7,1),attr(7,1),0,0,0,0)
  377.  PRINT
  378.  PRINT
  379.  PRINT
  380.  PRINT "      The following is a sampling of the DOS functions available"
  381.  PRINT "      in PW201.  For a better understanding of how to use the"
  382.  PRINT "      information returned by these functions consult any of the"
  383.  PRINT "      reference books on DOS interrupts.  You must have a good"
  384.  PRINT "      understanding of DOS interrupts to take full advantage of"
  385.  PRINT "      these utilities."
  386.  CALL Continue
  387.  CALL Clearwin
  388.  LOCATE 1,1
  389.  PRINT " THE DEFAULT DRIVE IS "Curdrive$
  390.  PRINT
  391.  PRINT " THEN CURRENT DIRECTORY PATH IS "Curdir$
  392.  PRINT
  393.  PRINT " FILES IN THIS DIRECTORY ARE:"
  394.  PRINT
  395.  CALL Findfirst("*.*"+CHR$(0),&H20,dirinfo$,doserror)
  396.  PRINT Falign$(EXTRACT$(MID$(dirinfo$,31,12),CHR$(0)))"  ";
  397.  WHILE doserror = 0
  398.    CALL Findnext(dirinfo$,doserror)
  399.    PRINT Falign$(EXTRACT$(MID$(dirinfo$,31,12),CHR$(0)))"  ";
  400.  WEND
  401.  PRINT
  402.  PRINT
  403.  PRINT " THE CURRENT DOS VERSION IS "Dosversion$
  404.  PRINT USING " CURRENT DISK SIZE    ###,###,###";Disksize&(0)
  405.  PRINT USING " DISK SPACE AVAILABLE ###,###,###";Diskfree&(0)
  406.  PRINT USING " CONV MEMORY SIZE         ###,###";Maxmem&
  407.  PRINT USING " AVAILABLE MEMORY         ###,###";FRE(-1)
  408.  CALL Continue
  409.  CALL Closewin
  410. END SUB
  411.  
  412. SUB Idemo
  413.  LOCAL wfield,done,info$(),loandata$()
  414.  DIM info$(3)
  415.  info$(1) = "R0010221092"
  416.  info$(2) = "R0020324062"
  417.  info$(3) = "I0030426040"
  418.  DIM loandata$(3)
  419.  CALL Openwin(5,7,14,32,attr(0,3),attr(0,3),2,8,1,0)
  420.  CALL Titlewin(2,attr(15,3),"[ Payment Calculator ]")
  421.  CALL Titlewin(5,attr(15,3),"[ Esc - Exit ]")
  422.  CALL Printwin(2,2,"Principal Amount:")
  423.  CALL Printwin(3,2,"   Interest Rate:")
  424.  CALL Printwin(4,2," No. of Payments:")
  425.  CALL Printwin(5,2,"         Payment:")
  426.  CALL Printcwin(7, "F1 - Help             ")
  427.  CALL Printcwin(8, "F2 - Calculate Payment")
  428.  CALL Printcwin(9, "F5 - Pop-up Calculator")
  429.  done = 0
  430.  wfield = 1
  431.  WHILE NOT done
  432.    IF amount## = 0 THEN loandata$(1) = "" ELSE loandata$(1) = STR$(amount##)
  433.    IF rate## = 0 THEN loandata$(2) = "" ELSE loandata$(2) = STR$(rate##)
  434.    IF month = 0 THEN loandata$(3) = "" ELSE loandata$(3) = STR$(month)
  435.    DO
  436.      CALL Getrec(info$(),loandata$(),3,returncode,wfield,-1,attr(3,0),attr(0,3))
  437.    LOOP UNTIL INSTR(CHR$(0)+CHR$(59)+CHR$(60)+CHR$(63),CHR$(returncode))
  438.    amount## = VAL(loandata$(1))
  439.    rate## = VAL(loandata$(2))
  440.    month = VAL(loandata$(3))
  441.    SELECT CASE returncode
  442.    CASE 0   : done = -1
  443.    CASE 59  : CALL Help.Message(wfield)
  444.    CASE 60  : CALL Compute.Payment(amount##,rate##,month)
  445.    CASE 63  : CALL Calculator(5,49,attr(15,5),1)
  446.    END SELECT
  447.  WEND
  448.  CALL Closewin
  449. END SUB
  450.  
  451. SUB Errmsg(what)
  452.  CALL Openwin(13,44,5,32,attr(15,4),attr(15,4),1,8,1,0)
  453.  SELECT CASE what
  454.  CASE 3
  455.    CALL Printcwin(1,"YOU MUST PROVIDE INPUT")
  456.    CALL Printcwin(2,"FOR ALL THREE FIELDS")
  457.    CALL Printcwin(3,"Press any key to continue ")
  458.  END SELECT
  459.  CALL Getkey(ch1$,ch2$)
  460.  CALL Closewin
  461. END SUB
  462.  
  463. FUNCTION Frac##(num##)
  464.  Frac## = num## - INT(num##)
  465. END FUNCTION
  466.  
  467. FUNCTION Powerof## (number##, power)
  468.  Powerof## = EXP10(power * LOG10(number##))
  469. END FUNCTION
  470.  
  471. SUB Compute.Payment(amt##,rt##,mo)
  472.  LOCAL hold##
  473.  IF (amt## > 0.0) AND (mo > 0) AND (rt## > 0.0) THEN
  474.    hold## = powerof##(1.0 + rt## / 1200.0, mo)
  475.    payment## = ((rt## / 1200.0) * hold## * amt##) / (hold## - 1.0)
  476.    payment## = payment## + 0.005
  477.    hold## = frac##(payment## * 100.0)
  478.    payment## = ((payment## * 100.0)-hold##)/100.0
  479.    CALL Windowxy(5,21)
  480.    print using "######.##";payment##;
  481.  ELSE
  482.    CALL Errmsg(3)
  483.  END IF
  484. END SUB
  485.  
  486. SUB Help.Message(what)
  487.  CALL Openwin(6+what,38,8,36,attr(0,2),attr(0,2),2,8,1,0)
  488.  CALL Sprint(6+what,38,CHR$(17),attr(0,2))
  489.  SELECT CASE what
  490.  CASE 1
  491.    CALL Titlewin(2,attr(15,2),"[ Principal Amount ]")
  492.    CALL Printwin(1,2,"Enter the amount of the loan you")
  493.    CALL Printwin(2,2,"wish to calulate.  The format is")
  494.    CALL Printwin(3,2,"######.##.  Do not enter a")
  495.    CALL Printwin(4,2,"negative number.")
  496.  CASE 2
  497.    CALL Titlewin(2,attr(15,2),"[ Interest Rate ]")
  498.    CALL Printwin(1,2,"Enter the interest rate for the")
  499.    CALL Printwin(2,2,"the loan you wish to calculate.")
  500.    CALL Printwin(3,2,"The format is ##.##.  Where 11%")
  501.    CALL Printwin(4,2,"would be entered as 11.00.  Do")
  502.    CALL Printwin(5,2,"not enter a negative number.")
  503.  CASE 3
  504.    CALL Titlewin(2,attr(15,2),"[ No. of Payments ]")
  505.    CALL Printwin(1,2,"Enter the number of payments for")
  506.    CALL Printwin(2,2,"the loan you wish to calulate.")
  507.    CALL Printwin(3,2,"The format is ####.  Enter the")
  508.    CALL Printwin(4,2,"actual number of payments not the")
  509.    CALL Printwin(5,2,"number of years.  Do not enter a")
  510.    CALL Printwin(6,2,"negative number.")
  511.   END SELECT
  512.   CALL Titlewin(5,attr(15,2)," Press any key to continue ")
  513.   CALL Getkey(ch1$,ch2$)
  514.   CALL Closewin
  515. END SUB
  516.  
  517.  ' ********** END OF PROGRAM **********
  518.