home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / STRAIGHT / STRAIGHT2.MSA / BASIC_P_Q_PROCEDUR.LST < prev    next >
Encoding:
File List  |  1996-09-17  |  4.5 KB  |  143 lines
  1. PRINT "  PROCEDURE  Beispiel"
  2. PRINT
  3. PRINT
  4. PRINT
  5. PRINT " Schreibweise: name              ! oder GOSUB name, auch @name (GFA2.0)"
  6. PRINT "               PROCEDURE name"
  7. PRINT "                 Programmzeilen 1,2,3 usw..."
  8. PRINT "               RETURN"
  9. PAUSE 300
  10. '
  11. xt%=2-SGN(XBIOS(4))
  12. yt%=MIN(2,3-XBIOS(4))
  13. start%=1
  14. anzahl%=20
  15. DIM feld$(start%+anzahl%)
  16. RESTORE m.datas
  17. FOR i%=1 TO start%+anzahl%
  18.   READ feld$(i%)
  19. NEXT i%
  20. m.datas:
  21. DATA ---,Speichern,Laden,Löschen,Kopieren,----------,QUIT
  22. DATA ---,Speichern,Laden,Löschen,Kopieren,----------,QUIT
  23. DATA ---,Speichern,Laden,Löschen,Kopieren,----------,QUIT
  24. ' BOX 50/xt%,50/yt%,300/xt%,300/yt%
  25. DO
  26.   REPEAT
  27.     IF MOUSEX>50/xt% AND MOUSEX<300/xt% AND MOUSEY>50/yt% AND MOUSEY<399/yt%
  28.       @menue(start%,anzahl%,50/xt%,50/yt%,300/xt%,399/yt%,*feld$(),*index%)
  29.     ENDIF
  30.     '    IF MOUSEK=2
  31.     '      @menue(start%,anzahl%,0,0,639/xt%,399/yt%,*feld$(),*index%)
  32.     '    ENDIF
  33.   UNTIL index%>0
  34.   IF feld$(index%+start%)="Speichern"
  35.     feld$(index%+start%)="-Speichern"
  36.     feld$(index%+start%+1)="Laden"
  37.     PRINT AT(1,1);"gewählt: Speichern     "
  38.   ENDIF
  39.   IF feld$(index%+start%)="Laden"
  40.     feld$(index%+start%-1)="Speichern"
  41.     feld$(index%+start%)="-Laden"
  42.     PRINT AT(1,1);"gewählt: Laden         "
  43.   ENDIF
  44.   IF feld$(index%+start%)="Löschen"
  45.     PRINT AT(1,1);"gewählt: Löschen       "
  46.   ENDIF
  47.   IF feld$(index%+start%)="Kopieren"
  48.     feld$(index%+start%)=CHR$(8)+" Kopieren"
  49.     PRINT AT(1,1);"gewählt: Kopieren      "
  50.     GOTO label
  51.   ENDIF
  52.   IF feld$(index%+start%)=CHR$(8)+" Kopieren"
  53.     feld$(index%+start%)="Kopieren"
  54.     PRINT AT(1,1);"gewählt: Kopieren      "
  55.   ENDIF
  56.   IF feld$(index%+start%)="QUIT"
  57.     PRINT AT(1,1);"gewählt: Quit          "
  58.   ENDIF
  59. label:
  60.   PRINT "Menüindex : ";index%
  61.   EXIT IF feld$(index%+start%)="QUIT"
  62.   CLR index%
  63. LOOP
  64. > PROCEDURE menue(pm1%,mmx%,mxl%,myo%,mxr%,myu%,f.adr%,v.adr%)
  65.   '
  66.   ' Diese Prozedur stammt aus: Das große Atari ST GFA Basic Buch
  67.   ' erschienen bei Data Becker
  68.   '
  69.   LOCAL mmen$,msk%,m.key$,yi%,yi2%,mrs%,m.i%,lsr%
  70.   LOCAL mxl2%,mxr2%,myo2%,myu2%,m.xt%,m.yt%
  71.   m.xt%=2-SGN(XBIOS(4))
  72.   m.yt%=MIN(2,3-XBIOS(4))
  73.   DIM dum$(1)
  74.   SWAP *f.adr%,dum$()
  75.   mxl2%=MIN(MAX(MOUSEX-(68/m.xt%),mxl%),mxr%-(136/m.xt%))
  76.   mxr2%=mxl2%+(136/m.xt%)
  77.   myo2%=MIN(MAX(MOUSEY-(6/m.yt%),myo%),myu%-(18+mmx%*18)/m.yt%)
  78.   myu2%=myo2%+((18+mmx%*18)/m.yt%)
  79.   mxl%=MIN(mxl%,mxl2%)
  80.   myo%=MIN(myo%,myo2%)
  81.   GET MAX(0,mxl2%),MAX(0,myo2%),MIN((639/m.xt%),mxr2%),MIN(myu2%,399/m.yt%),mmen$
  82.   DEFTEXT 1,0,0,8-2*m.yt%
  83.   DEFFILL 1,0,0
  84.   GRAPHMODE 1
  85.   PBOX mxl2%,myo2%,mxr2%,myu2%
  86.   BOX mxl2%+(1/m.xt%),myo2%+(1/m.yt%),mxr2%-(1/m.xt%),myu2%-(1/m.yt%)
  87.   DEFFILL 1,2,4
  88.   PBOX mxl2%+(6/m.xt%),myo2%+(6/m.yt%),mxr2%-(6/m.xt%),myu2%-(6/m.yt%)
  89.   DEFFILL 1,0,0
  90.   FOR m.i%=1 TO mmx%
  91.     GRAPHMODE 1
  92.     PBOX mxl2%+(13/m.xt%),myo2%-6/m.yt%+m.i%*18/m.yt%,mxr2%-(13/m.xt%),myo2%+6/m.yt%+m.i%*18/m.yt%
  93.     GRAPHMODE 2
  94.     IF LEFT$(dum$(m.i%+pm1%))="-"
  95.       DEFTEXT ,2
  96.       TEXT mxl2%+(20/m.xt%),myo2%+3/m.yt%+m.i%*18/m.yt%,100/m.xt%,RIGHT$(dum$(m.i%+pm1%),LEN(dum$(m.i%+pm1%))-1)
  97.     ELSE
  98.       DEFTEXT ,0
  99.       TEXT mxl2%+(20/m.xt%),myo2%+3/m.yt%+m.i%*18/m.yt%-1+m.yt%,100/m.xt%,dum$(m.i%+pm1%)
  100.     ENDIF
  101.   NEXT m.i%
  102.   DEFMOUSE 3
  103.   DEFFILL 1,1,1
  104.   GRAPHMODE 3
  105.   BOUNDARY 0             ! für V3.0
  106.   ' Dpoke Vdibase+34,0   ! für V2.xx
  107.   REPEAT
  108.     ON MENU
  109.     MOUSE xko.x%,yko.y%,msk%
  110.     yi%=INT((yko.y%-(myo2%-(8/m.yt%)))/(18/m.yt%))
  111.     IF xko.x%>mxl2%+(12/m.xt%) AND yi%>0 AND xko.x%<mxr2%-(13/m.xt%) AND yi%<=(mmx%)
  112.       IF LEFT$(dum$(yi%+pm1%))<>"-"
  113.         PBOX mxl2%+(14/m.xt%),myo2%-(5/m.yt%)+yi%*(18/m.yt%)-1+m.yt%,mxr2%-(14/m.xt%)+1-m.xt%,myo2%+(5/m.yt%)+yi%*(18/m.yt%)
  114.       ENDIF
  115.       REPEAT
  116.         yi2%=INT((MOUSEY-(myo2%-(8/m.yt%)))/(18/m.yt%))
  117.         msk%=MOUSEK
  118.         m.key$=INKEY$
  119.         ON MENU
  120.       UNTIL MOUSEX<mxl2%+(12/m.xt%) OR MOUSEX>mxr2%-(13/m.xt%) OR yi%<>yi2% OR msk%>0 OR m.key$>""
  121.       IF LEFT$(dum$(yi%+pm1%))<>"-"
  122.         PBOX mxl2%+(14/m.xt%),myo2%-(5/m.yt%)+yi%*(18/m.yt%)-1+m.yt%,mxr2%-(14/m.xt%)+1-m.xt%,myo2%+(5/m.yt%)+yi%*(18/m.yt%)
  123.       ELSE
  124.         CLR msk%
  125.       ENDIF
  126.     ELSE
  127.       CLR yi2%
  128.     ENDIF
  129.     EXIT IF (MOUSEX<mxl% OR MOUSEX>mxr% OR MOUSEY<myo% OR MOUSEY>myu%) AND yi2%<=mmx%
  130.     m.key$=INKEY$
  131.   UNTIL (msk%>0 OR m.key$>"") AND yi2%<=mmx%
  132.   DEFMOUSE 0
  133.   DEFFILL 1,0,0
  134.   GRAPHMODE 1
  135.   PUT MAX(0,mxl2%),MAX(0,myo2%),mmen$
  136.   BOUNDARY 1            ! für V3.0
  137.   ' Dpoke Vdibase+34,1  ! für V2.xx
  138.   SWAP *f.adr%,dum$()
  139.   ERASE dum$()
  140.   *v.adr%=yi2%
  141.   PAUSE 5
  142. RETURN
  143.