home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / LANG20 / LANG20.ZIP / LANG1.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-02-03  |  2.8 KB  |  105 lines
  1.  
  2. DEFINT A-Z
  3. '$INCLUDE: 'lang.bi'
  4. '$INCLUDE: 'cmndlg.bi'
  5.  
  6. '$FORM form1
  7.  
  8. DECLARE FUNCTION Message$ (BYVAL index&)
  9. DECLARE FUNCTION Readstr$ (index&, fil%)
  10. DECLARE SUB main ()
  11.  
  12. main
  13.  
  14. REM $DYNAMIC
  15. SUB AddStr (s$, index&, fil%, BeginStr&)
  16.  
  17. ' ----------------------------------------------------
  18. '  This part I got from Karl W. Stembol, on the CompuServe MSBASIC-forum
  19. '  I just changed it a little.
  20. '   Thanks!
  21. ' ----------------------------------------------------
  22.  
  23. IF BeginStr& = 0 THEN BeginStr& = 16004
  24.  
  25. IF index& = 0 THEN
  26.     GET fil%, 401, numstr&               ' get current last string
  27.     IF EOF(fil%) THEN
  28.         numstr& = 1: xpos& = BeginStr& ' new file, this is first string
  29.     ELSE
  30.         numstr& = numstr& + 1: xpos& = LOF(fil%) + 1
  31.     END IF
  32.     x% = LEN(s$)
  33.     PUT fil%, xpos&, x%                ' put length
  34.     PUT fil%, , s$                     ' and then the data
  35.     PUT fil%, 401, numstr&               ' update number of strings
  36.     PUT fil%, (numstr& * 4) + 401, xpos& ' and position of this string
  37.     index& = numstr&
  38. ELSE
  39.     GET fil%, 401, numstr&               ' get current last string
  40.  
  41.     IF EOF(fil%) THEN
  42.         numstr& = 1
  43.         xpos& = BeginStr&  ' new file, this is first string
  44.     ELSE
  45.         IF index& > numstr& THEN
  46.             numstr& = index&
  47.         END IF
  48.         xpos& = LOF(fil%) + 1
  49.     END IF
  50.  
  51.     x% = LEN(s$)
  52.     PUT fil%, xpos&, x%                ' put length
  53.     PUT fil%, xpos& + 2, s$            ' and then the data
  54.     PUT fil%, (index& * 4) + 401, xpos& ' and position of this string
  55.     PUT fil%, 401, numstr&               ' update number of strings
  56.  
  57. END IF
  58.  
  59. END SUB
  60.  
  61. SUB main ()
  62.  
  63.     COLOR 14, 0
  64.     CLS
  65.     PRINT "Language 2.00"
  66.     PRINT "CC Advies - PO Box 351 - 3940 AJ  Doorn, the Netherlands"
  67.     COLOR 7, 0
  68.     PRINT STRING$(80, 250)
  69.     PRINT "Taco Oosterkamp  CompuServe ID 100117,2545  "
  70.     PRINT "Public Domain"
  71.     PRINT "WITH LOT OF THANKS to Karl W. Stembol for the main-routine."
  72.     PRINT
  73.  
  74.     Screen.Controlpanel(7) = 0
  75.  
  76.     FileSave FilNam$, Pad$, "*.LNO", "FileName", 0, 7, 0, Cancel
  77.         IF Cancel <> 0 THEN
  78.             END
  79.         END IF
  80.  
  81.     Lang_Bestand$ = Pad$ + "\" + FilNam$
  82.     Lang_BestandLeft$ = LEFT$(Lang_Bestand$, INSTR(Lang_Bestand$, ".") - 1)
  83.  
  84.     f% = FREEFILE
  85.     OPEN Lang_Bestand$ FOR BINARY AS f%
  86.  
  87.     form1.SHOW
  88.  
  89. END SUB
  90.  
  91. FUNCTION Readstr$ (index&, fil%)
  92.  
  93. ' ----------------------------------------------------
  94. '  This part I got from Karl W. Stembol, on the CompuServe MSBASIC-forum
  95. '   Thanks!
  96. ' ----------------------------------------------------
  97.  
  98.     GET fil%, (index& * 4) + 401, xpos&      ' get position of string
  99.     GET fil%, xpos&, x%                      ' get length of string
  100.     Readstr$ = SPACE$(x%)
  101.     GET fil%, , Readstr$                     ' and read the string
  102.  
  103. END FUNCTION
  104.  
  105.