home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_2_94 / vbdos / pointer.bas next >
BASIC Source File  |  1994-04-09  |  5KB  |  153 lines
  1. DECLARE SUB Liste1_Ausgabe (BYVAL Pointer AS INTEGER)
  2. DECLARE SUB Liste1_Delete (BYVAL Pointer AS INTEGER)
  3. DECLARE SUB Liste1_Dispose (BYVAL Pointer AS INTEGER)
  4. DECLARE SUB Liste1_Init ()
  5. DECLARE SUB Liste1_Insert (BYVAL NachPointer AS INTEGER, BYVAL WasPointer AS INTEGER)
  6. DECLARE SUB Liste1_New (Pointer AS INTEGER)
  7. DECLARE FUNCTION Liste1_Finde (BYVAL Pointer AS INTEGER, BYVAL Zeichen AS STRING) AS INTEGER
  8. ' POINTER.BAS - Demoprogramm für Listenverwaltung
  9.  
  10. TYPE Liste1_Typ
  11.    Wert AS STRING * 1
  12.    Prev AS INTEGER
  13.    Next AS INTEGER
  14. END TYPE
  15.  
  16. DIM SHARED Liste1() AS Liste1_Typ
  17. DIM NeuZeiger AS INTEGER, Zeiger AS INTEGER
  18. DIM Char AS STRING
  19.  
  20. Liste1_Init
  21.  
  22. PRINT
  23. PRINT "Eingabe der Startdaten"
  24. DO
  25.    INPUT "   Buchstaben eingeben (Leer=Ende): ", Char
  26.    IF Char = "" THEN EXIT DO
  27.  
  28.    ' Ein neues Element im Array erzeugen (es wird noch
  29.    ' nicht in die Liste eingetragen)
  30.    Liste1_New Zeiger
  31.  
  32.    ' Den Buchstaben zuweisen und das Element an letzter
  33.    ' Stelle [Liste1(0).Prev = letztes Element] in die
  34.    ' Liste eintragen lassen
  35.    Liste1(Zeiger).Wert = Char
  36.    Liste1_Insert Liste1(0).Prev, Zeiger
  37. LOOP
  38.  
  39. PRINT "Inhalt der Liste:": PRINT "   ";
  40. Liste1_Ausgabe Liste1(0).Next
  41.  
  42. INPUT "Welches Element löschen:", Char
  43. Zeiger = Liste1_Finde(Liste1(0).Next, Char)
  44. IF Zeiger = 0 THEN
  45.    PRINT "   Gibt's nicht"
  46. ELSE
  47.    PRINT "   Adresse des gefundenen Elements:"; Zeiger
  48.    Liste1_Delete Zeiger
  49.    PRINT "   Neue Liste:": PRINT "   ";
  50.    Liste1_Ausgabe (Liste1(0).Next)
  51. END IF
  52.  
  53. INPUT "Nach welchem Element einfügen:", Char
  54. Zeiger = Liste1_Finde(Liste1(0).Next, Char)
  55. IF Zeiger = 0 THEN
  56.    PRINT "   Gibt's nicht - Einfügen am Anfang"
  57. ELSE
  58.    PRINT "   Adresse des gefundenen Elements:"; Zeiger
  59. END IF
  60. INPUT "   Welches Zeichen einfügen:", Char
  61. Liste1_New NeuZeiger: Liste1(NeuZeiger).Wert = Char
  62. Liste1_Insert Zeiger, NeuZeiger
  63. PRINT "   Neue Liste:": PRINT "   ";
  64. Liste1_Ausgabe (Liste1(0).Next)
  65.  
  66. ' Ausgabe einer Liste auf dem Schirm
  67. SUB Liste1_Ausgabe (BYVAL Pointer AS INTEGER)
  68.  
  69.    IF Pointer = 0 THEN PRINT : EXIT SUB
  70.    PRINT Liste1(Pointer).Wert; " ";
  71.    Liste1_Ausgabe Liste1(Pointer).Next
  72.  
  73. END SUB
  74.  
  75. ' Löschen eines Elements aus der Liste mit Umbiegen
  76. ' der Zeiger. Das Element verbleibt aber zunächst im
  77. ' Array und wird erst von DISPOSE gelöscht.
  78. SUB Liste1_Delete (BYVAL Pointer AS INTEGER)
  79.  
  80.    Liste1(Liste1(Pointer).Prev).Next = Liste1(Pointer).Next
  81.    Liste1(Liste1(Pointer).Next).Prev = Liste1(Pointer).Prev
  82.    Liste1_Dispose Pointer
  83.  
  84. END SUB
  85.  
  86. ' DISPOSE: Löschen eines Elements aus dem Array
  87. SUB Liste1_Dispose (BYVAL Pointer AS INTEGER)
  88.  
  89.    DIM Grenze AS INTEGER
  90.  
  91.    Grenze = UBOUND(Liste1)
  92.    IF Pointer < Grenze THEN
  93.       ' Wenn nicht das letzte Element gelöscht wird,
  94.       ' muß das letzte Element umkopiert werden, um
  95.       ' Speicherplatz freigeben zu können
  96.       Liste1(Liste1(Grenze).Prev).Next = Pointer
  97.       Liste1(Liste1(Grenze).Next).Prev = Pointer
  98.       Liste1(Pointer) = Liste1(Grenze)
  99.    END IF
  100.    Grenze = Grenze - 1
  101.    REDIM PRESERVE Liste1(0 TO Grenze) AS Liste1_Typ
  102.  
  103. END SUB
  104.  
  105. ' Findet das erste Element, dessen "Wert" gleich dem
  106. ' gegebenen Zeichen ist, und gibt seinen Pointer zurück.
  107. ' Beginnt mit der Suche erst bei der übergebenen Adresse.
  108. FUNCTION Liste1_Finde (BYVAL Pointer AS INTEGER, BYVAL Zeichen AS STRING) AS INTEGER
  109.  
  110.    IF Pointer = 0 THEN
  111.       ' Liste schon zu Ende - keine Aktion
  112.    ELSEIF Liste1(Pointer).Wert = Zeichen THEN
  113.       ' Gefunden! Adresse zurückgeben:
  114.       Liste1_Finde = Pointer
  115.    ELSE
  116.       ' Nicht gefunden, aber Liste geht weiter:
  117.       Liste1_Finde = Liste1_Finde(Liste1(Pointer).Next, Zeichen)
  118.    END IF
  119.  
  120. END FUNCTION
  121.  
  122. ' Initialisiert die Liste. Das Element Nr. 0 dient als
  123. ' Kontroll-Element, sein Next-Pointer zeigt auf das erste,
  124. ' sein Prev-Pointer auf das letzte Element der Liste.
  125. SUB Liste1_Init ()
  126.  
  127.    REDIM Liste1(0 TO 0) AS Liste1_Typ
  128.    Liste1(0).Prev = 0: Liste1(0).Next = 0
  129.  
  130. END SUB
  131.  
  132. ' Fügt das Element, auf das der Pointer "WasPointer"
  133. ' zeigt, hinter dem Listenelement "NachPointer" ein
  134. SUB Liste1_Insert (BYVAL NachPointer AS INTEGER, BYVAL WasPointer AS INTEGER)
  135.  
  136.    Liste1(WasPointer).Next = Liste1(NachPointer).Next
  137.    Liste1(Liste1(WasPointer).Next).Prev = WasPointer
  138.    Liste1(WasPointer).Prev = NachPointer
  139.    Liste1(NachPointer).Next = WasPointer
  140.  
  141. END SUB
  142.  
  143. ' Einfuegen eines neuen Elements am Ende des Arrays
  144. ' (Wo innerhalb der Liste das Element eingefügt wird,
  145. ' ist hier nicht festgelegt, dazu muss erst INSERT
  146. ' aufgerufen werden!)
  147. SUB Liste1_New (Pointer AS INTEGER)
  148.  
  149.    Pointer = UBOUND(Liste1) + 1
  150.    REDIM PRESERVE Liste1(0 TO Pointer) AS Liste1_Typ
  151.  
  152. END SUB
  153.