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