home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / cebit_91 / tricks / allotest.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-03-06  |  4.8 KB  |  157 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    ALLOTEST.PAS                        *)
  3. (*      Compiler: Turbo-Pascal 4.0/5.0/5.5/6.0            *)
  4. (*    Ein Demonstrationsprogramm zur Verwendung           *)
  5. (*    der Unit ReAlloc}                                   *)
  6. (*           (c) 1991 Gerd Cebulla & TOOLBOX              *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM Demo;
  9.  
  10. USES
  11.   Crt, ReAlloc2;
  12.  
  13. CONST
  14.   MaxZeilen = 18;
  15.   ScrBase   = 5;
  16.  
  17. TYPE
  18.   Str79 = STRING [79];
  19.  
  20. VAR
  21.   SP : ARRAY [1..MaxZeilen] OF ^Str79;
  22.  
  23. {$F+}
  24.   FUNCTION HeapFunc (Size : WORD) : INTEGER; {$F-}
  25. {Heapfehlerbehandlung. Wird von der Turbo-Pascal-Laufzeit- }
  26. {bibliothek aufgerufen, wenn der verfügbare Speicherplatz  }
  27. {zu klein ist, und sorgt dafür, daß die Funktionen New,    }
  28. {GetMem und ChangeMem das Programm nicht mit einer Fehler- }
  29. {meldung abbrechen, sondern lediglich den Zeigerwert nil   }
  30. {zurückliefern.                                            }
  31.   BEGIN
  32.     HeapFunc := 1;
  33.   END; {HeapFunc}
  34.  
  35.   PROCEDURE Init;
  36.   VAR
  37.     i : BYTE;
  38.   BEGIN
  39.     HeapError := @HeapFunc;
  40.                          {eigene Fehlerroutine installieren}
  41.     FOR i := 1 TO MaxZeilen DO BEGIN
  42.       GetMem (SP [i], 1);
  43.       SP [i]^ := '';
  44.     END;
  45.     ClrScr;
  46.     WriteLn ('Ein kleiner Texteditor zur Demonstration ' +
  47.              'der Benutzung der Unit ReAlloc.');
  48.     WriteLn ('Geben Sie ein paar Zeilen ein, ' +
  49.              'und editieren Sie sie.');
  50.     WriteLn ('Achten Sie dabei auf die Anzeige des ' +
  51.              'freien Speicherplatzes.');
  52.     WriteLn ('(Esc = Programmende.)');
  53.     GotoXY (1, 25);
  54.     Write ('Frei: ', MemAvail:6, ' Byte');
  55.   END; {Init}
  56.  
  57.   PROCEDURE DisplayError;
  58.   BEGIN
  59.     GotoXY (54, 25);
  60.     Write (^G'NICHT GENUG SPEICHERPLATZ!');
  61.     WHILE ReadKey = #0 DO
  62.       ;
  63.     GotoXY (54, 25);
  64.     ClrEol;
  65.   END; {DisplayError}
  66.  
  67.   PROCEDURE Edit;
  68.   VAR
  69.     P : Pointer;
  70.     Spalte,
  71.     Zeile,
  72.     Len : BYTE;
  73.     Taste,
  74.     FTaste : CHAR;
  75.   BEGIN
  76.     Spalte := 1;
  77.     Zeile := 1;
  78.     REPEAT
  79.       GotoXY (7, 25);
  80.       Write (MemAvail:6);
  81.       GotoXY (Spalte, ScrBase + Zeile);
  82.       Taste := ReadKey;
  83.       CASE Taste OF
  84.         #32..#255 : BEGIN                 {normales Zeichen}
  85.           Len := Length (SP [Zeile]^);
  86.           IF Len < 79 THEN BEGIN
  87.             P := ChangeMem (SP [Zeile], Len + 1, Len + 2);
  88.             IF P = NIL THEN
  89.               DisplayError
  90.             ELSE BEGIN
  91.               SP [Zeile] := P;
  92.               Insert (Taste, SP [Zeile]^, Spalte);
  93.               Write (Copy (SP [Zeile]^, Spalte, 79));
  94.               Inc (Spalte);
  95.             END;
  96.           END;
  97.         END;
  98.         #13 :                                       {Return}
  99.           IF Zeile < MaxZeilen THEN BEGIN
  100.             Inc (Zeile);
  101.             Spalte := 1;
  102.           END;
  103.         #8 :                                     {BackSpace}
  104.           IF Spalte > 1 THEN BEGIN
  105.             Dec (Spalte);
  106.             Delete (SP [Zeile]^, Spalte, 1);
  107.             Len := Length (SP [Zeile]^);
  108.             SP [Zeile] := ChangeMem (SP [Zeile],
  109.                                      Len + 2, Len + 1);
  110.             GotoXY (Spalte, ScrBase + Zeile);
  111.             Write (Copy (SP [Zeile]^, Spalte, 79));
  112.             ClrEol;
  113.           END;
  114.         #0 : BEGIN                          {Funktionstaste}
  115.           FTaste := ReadKey;
  116.           CASE FTaste OF
  117.             #72 :                                {Cursor up}
  118.               IF Zeile > 1 THEN BEGIN
  119.                 Dec (Zeile);
  120.                 Len := Length (SP [Zeile]^);
  121.                 IF Len < Spalte - 1 THEN
  122.                   Spalte := Len + 1;
  123.               END;
  124.             #80 :                              {Cursor down}
  125.               IF Zeile < MaxZeilen THEN BEGIN
  126.                 Inc (Zeile);
  127.                 Len := Length (SP [Zeile]^);
  128.                 IF Len < Spalte - 1 THEN
  129.                   Spalte := Len + 1;
  130.               END;
  131.             #75 :                              {Cursor left}
  132.               IF Spalte > 1 THEN
  133.                 Dec (Spalte);
  134.             #77 :                             {Cursor right}
  135.               IF Spalte <= Length (SP [Zeile]^) THEN
  136.                 Inc (Spalte);
  137.             #83 : BEGIN                                {Del}
  138.               Len := Length (SP [Zeile]^);
  139.               IF Spalte <= Len THEN BEGIN
  140.                 Delete (SP [Zeile]^, Spalte, 1);
  141.                 SP [Zeile] := ChangeMem (SP [Zeile],
  142.                                          Len + 1, Len);
  143.                 Write (Copy (SP [Zeile]^, Spalte, 79));
  144.                 ClrEol;
  145.               END;
  146.             END;
  147.           END; {case FTaste}
  148.         END;
  149.       END; {case Taste}
  150.     UNTIL Taste = #27;
  151.   END; {Edit}
  152.  
  153. BEGIN
  154.   Init;
  155.   Edit;
  156. END.
  157.