home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 351-375 / apd370 / posttarieven.amos / posttarieven.amosSourceCode
AMOS Source Code  |  1991-06-13  |  5KB  |  230 lines
  1. '
  2. ' PTT Posttarieven programma 
  3. '
  4. ' V1.0 door J.Valks
  5. '
  6. '
  7. Flash Off : Curs Off 
  8. Palette $0,$0,$0
  9. Cls 
  10. SETUP_SCREEN1
  11. HOOFDMENU
  12. HOOFDPROG
  13. '
  14. Procedure SETUP_SCREEN1
  15.    Break Off 
  16.    Screen Open 1,640,250,8,Hires
  17.    Flash Off : Curs Off 
  18.    Palette $222,$222,$AAA
  19.    Colour Back $222
  20.    Colour 3,$AAA
  21.    Colour 4,$999
  22.    Colour 5,$666
  23.    Colour 6,$FFF
  24.    Ink 5 : Pen 5
  25.    Wind Open 1,0,0,79,10,1
  26.    Curs Off 
  27. End Proc
  28. Procedure HOOFDMENU
  29.    GRIJS1
  30.    Locate 0,0 : Centre "PTT POSTTARIEVEN BINNENLAND"
  31.    GRIJS3
  32.    Locate 0,2 : Centre "Met dit programma kunt u snel kijken hoeveel postzegels u nodig,"
  33.    Locate 0,3 : Centre "heeft om op een brief, pakket, monster enz. te plakken.         "
  34.    GRIJS1
  35.    Locate 0,5 : Centre "Door J.Valks"
  36.    WIT
  37.    Locate 0,7 : Centre "Druk op een toets"
  38.    Wait Key 
  39.    Wind Close 
  40.    Wind Open 1,0,0,79,5,1
  41.    GRIJS3
  42.    Locate 0,0 : Centre "PTT Posttarieven binnenland 1991"
  43.    GRIJS1
  44.    Locate 0,2 : Centre "by J.Valks - 25-08-91 - 23:10"
  45.    Wind Open 2,0,70,79,5,1
  46.    Wind Open 3,0,130,40,10,1
  47.    Wind Open 4,390,130,30,10,1
  48. End Proc
  49. Procedure HOOFDPROG
  50.    VRAAG:
  51.    Window 2
  52.    Clw 
  53.    GRIJS1
  54.    Locate 1,1 : Print "Wat is het te versturen gewicht [*=stoppen]"
  55.    GRIJS3
  56.    Locate 45,1 : Input "";G$
  57.    If G$="*" Then EINDE
  58.    If G$="" or Val(G$)>10000 or Val(G$)=0
  59.       HOOFDPROG
  60.    End If 
  61.    Clw 
  62.    '
  63.    ' *** BEREKEN GEWICHT ***
  64.    '
  65.    If Val(G$)<=20 Then Goto KEUZE1
  66.    If Val(G$)>=21 and Val(G$)<=50 Then Goto KEUZE2
  67.    If Val(G$)>=51 and Val(G$)<=100 Then Goto KEUZE3
  68.    If Val(G$)>=101 and Val(G$)<=250 Then Goto KEUZE4
  69.    If Val(G$)>=250 and Val(G$)<=500 Then Goto KEUZE5
  70.    If Val(G$)>=501 and Val(G$)<=1000 Then Goto KEUZE6
  71.    If Val(G$)>=1001 and Val(G$)<=3000 Then Goto KEUZE7
  72.    If Val(G$)>=3001 and Val(G$)<=5000 Then Goto KEUZE8
  73.    If Val(G$)>=5001 and Val(G$)<=10000 Then Goto KEUZE9
  74.    '
  75.    '======
  76.    KEUZE1:
  77.    '======
  78.    Window 3 : GRIJS1
  79.    Locate 0,0 : Centre "Wat wilt u versturen?"
  80.    GRIJS3
  81.    Locate 0,2 : Centre "F1 - Brieven, pakjes, paketten.    "
  82.    Locate 0,3 : Centre "F2 - Drukwerken, monsters.         "
  83.    Locate 0,4 : Centre "F3 - Briefkaarten, drukwerkkaarten."
  84.    WIT
  85.    Locate 0,6 : Centre "Maak een keuze."
  86.    Do 
  87.       Repeat 
  88.          T$=Inkey$
  89.          S=Scancode
  90.       Until T$<>""
  91.       If S=80
  92.          BEDRAG$="f 0,80"
  93.          Clw 
  94.          Goto UITKOMST
  95.       End If 
  96.       If S=81
  97.          BEDRAG$="f 0,70"
  98.          Clw 
  99.          Goto UITKOMST
  100.       End If 
  101.       If S=82
  102.          BEDRAG$="f 0,60"
  103.          Clw 
  104.          Goto UITKOMST
  105.       End If 
  106.    Loop 
  107.    '======
  108.    KEUZE2:
  109.    '======
  110.    Gosub VRAAGX
  111.    If WAARDE=1 Then BEDRAG$="f 1,60"
  112.    If WAARDE=2 Then BEDRAG$="f 1,30"
  113.    Goto UITKOMST
  114.    '======
  115.    KEUZE3:
  116.    '======
  117.    Gosub VRAAGX
  118.    If WAARDE=1 Then BEDRAG$="f 2,40"
  119.    If WAARDE=2 Then BEDRAG$="f 1,90"
  120.    Goto UITKOMST
  121.    '======  
  122.    KEUZE4:
  123.    '======
  124.    Gosub VRAAGX
  125.    If WAARDE=1 Then BEDRAG$="f 3,20"
  126.    If WAARDE=2 Then BEDRAG$="f 2,70"
  127.    Goto UITKOMST
  128.    '======
  129.    KEUZE5:
  130.    '======
  131.    Gosub VRAAGX
  132.    If WAARDE=1 Then BEDRAG$="f 5,-"
  133.    If WAARDE=2 Then BEDRAG$="f 5,-"
  134.    Goto UITKOMST
  135.    '======
  136.    KEUZE6:
  137.    '======
  138.    Gosub VRAAGX
  139.    If WAARDE=1 Then BEDRAG$="f 6,-"
  140.    If WAARDE=2 Then BEDRAG$="f 6,-"
  141.    Goto UITKOMST
  142.    '======
  143.    KEUZE7:
  144.    '======
  145.    Gosub VRAAGX
  146.    If WAARDE=1 Then BEDRAG$="f 7,50"
  147.    If WAARDE=2 Then BEDRAG$="f 7,50"
  148.    Goto UITKOMST
  149.    '======
  150.    KEUZE8:
  151.    '======
  152.    Gosub VRAAGX
  153.    If WAARDE=1 Then BEDRAG$="f 9,-"
  154.    If WAARDE=2 Then BEDRAG$="f 9,-"
  155.    Goto UITKOMST
  156.    '======
  157.    KEUZE9:
  158.    '======
  159.    Gosub VRAAGX
  160.    If WAARDE=1 Then BEDRAG$="f 11,50"
  161.    If WAARDE=2 Then BEDRAG$="f 11,50"
  162.    Goto UITKOMST
  163.    '
  164.    ' *** STANDAARD VRAAG ***
  165.    '
  166.    VRAAGX:
  167.    Window 3
  168.    GRIJS1 : WAARDE=0
  169.    Locate 0,0 : Centre "Wat wilt u versturen?"
  170.    GRIJS3
  171.    Locate 0,2 : Centre "F1 - Brieven, pakjes, pakketten."
  172.    Locate 0,3 : Centre "F2 - Drukwerken, monsters.      "
  173.    WIT
  174.    Locate 0,6 : Centre "Maak een keuze."
  175.    Do 
  176.       Repeat 
  177.          T$=Inkey$
  178.          S=Scancode
  179.       Until T$<>""
  180.       If S=80
  181.          WAARDE=1
  182.          Clw 
  183.          Return 
  184.       End If 
  185.       If S=81
  186.          WAARDE=2
  187.          Clw 
  188.          Return 
  189.       End If 
  190.    Loop 
  191.    '
  192.    ' *** Weergeven van het bedrag 
  193.    '
  194.    '========
  195.    UITKOMST:
  196.    '========
  197.    Window 4 : GRIJS1
  198.    Locate 1,0 : Print "U heeft het volgende bedrag"
  199.    Locate 1,1 : Print "aan postzegels nodig:"
  200.    GRIJS3
  201.    Locate 0,4 : Centre BEDRAG$
  202.    WIT
  203.    Locate 0,7 : Centre "Druk op een toets."
  204.    Wait Key 
  205.    Clw 
  206.    HOOFDPROG
  207. End Proc
  208. Procedure GRIJS2
  209.    Pen 3 : Ink 3
  210. End Proc
  211. Procedure GRIJS3
  212.    Pen 4 : Ink 4
  213. End Proc
  214. Procedure GRIJS1
  215.    Pen 5 : Ink 5
  216. End Proc
  217. Procedure WIT
  218.    Pen 6 : Ink 6
  219.    Flash 6,"(fff,15)(000,15)"
  220.    Curs Off 
  221. End Proc
  222. Procedure EINDE
  223.    Cls 
  224.    GRIJS2
  225.    Print "Einde..."
  226.    Wait 50
  227.    Screen Close 1
  228.    Palette $0,$0,$0 : Colour Back $0
  229.    Run "menu.amos"
  230. End Proc