home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 07 / ldm / memoerg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-03-27  |  8.8 KB  |  290 lines
  1. UNIT MEMOERG;
  2. { Hilfsprozeduren zum Programm MEMO }
  3.  
  4. INTERFACE
  5.  
  6. USES crt,dos;
  7.  
  8. CONST grundfarbe      : byte = 31;
  9.       abfragefarbe    : byte = 79;
  10.       buchstabenfarbe : byte = 29;
  11.       eingabefarbe    : byte = 32;
  12.       kartenfarbe     : byte = 96;
  13.       aktkartenfarbe  : byte = 111;
  14.       hilfefarbe      : byte = 95;
  15.       hintergrundfarbe: byte = 112;
  16.  
  17. TYPE  s80 = string[80];
  18.       s25 = string[25];
  19.       bildschirm = Array [1..25,1..80] of RECORD
  20.                                            ch  : char;
  21.                                            attr: byte;
  22.                                           END;
  23.  
  24. VAR screen      : ^bildschirm;
  25.     s_mem       : bildschirm;
  26.     regs        : registers;
  27.  
  28. PROCEDURE Farbe (att : byte);
  29. PROCEDURE Escape;
  30. PROCEDURE GetCode (VAR code: integer);
  31. PROCEDURE Beep;
  32. PROCEDURE c_off;
  33. PROCEDURE c_on;
  34. PROCEDURE Wrtxy (x,y: byte; s: s80);
  35. PROCEDURE Farbexy (x,y,attr: byte);
  36. PROCEDURE Upper (var s: s25);
  37. PROCEDURE ReadStr(x,y: byte; VAR s: s25; VAR neu: boolean);
  38. FUNCTION Kleiner (x,y: word) : word;
  39. PROCEDURE Rahmen (x1,y1,x2,y2,art:integer;
  40.                   strich,schatten:boolean);
  41. PROCEDURE Hilfe;
  42.  
  43. IMPLEMENTATION
  44.  
  45. PROCEDURE Farbe (att : byte);
  46. BEGIN textattr := att; END;
  47.  
  48. PROCEDURE Escape;
  49. VAR ch: char;
  50. BEGIN REPEAT ch := readkey; UNTIL ch = #27; END;
  51.  
  52. PROCEDURE GetCode (VAR code: integer);
  53. VAR ch : char;
  54. BEGIN
  55.   ch := readkey;
  56.   IF ch = #0 Then code := (ord(readkey)+1000)
  57.   ELSE code := ord(ch);
  58. END;
  59.  
  60. PROCEDURE Beep;
  61. BEGIN sound (1000); delay (100); nosound; END;
  62.  
  63. PROCEDURE c_off;  { Cursor aus }
  64. BEGIN
  65.   regs.ax := 1 shl 8;  regs.cx := 48 shl 8;
  66.   intr ($10,regs);
  67. END;
  68.  
  69. PROCEDURE c_on;   { Cursor ein }
  70. BEGIN
  71.   regs.ax := 1 shl 8;  regs.cx := 12 shl 8 + 13;
  72.   intr($10,regs);
  73. END;
  74.  
  75. PROCEDURE Wrtxy (x,y: byte; s: s80);
  76. VAR i: byte;
  77. BEGIN
  78.   For i := 1 to length(s) DO
  79.     screen^[y,x-1+i].ch := s[i];
  80. END;
  81.  
  82. PROCEDURE Farbexy (x,y,attr: byte);
  83. BEGIN screen^[y,x].attr := attr; END;
  84.  
  85. PROCEDURE Upper (var s: s25);
  86. VAR i: byte;
  87. BEGIN
  88.   For i := 1 to length(s) DO BEGIN
  89.     CASE s[i] of
  90.       'ä' : s[i] := 'Ä';
  91.       'ö' : s[i] := 'Ö';
  92.       'ü' : s[i] := 'Ü';
  93.       ELSE s[i] := upcase(s[i]);
  94.     END;
  95.   END;
  96. END;
  97.  
  98. PROCEDURE ReadStr(x,y: byte; VAR s: s25; VAR neu: boolean);
  99. VAR pos,i : byte; s0: s25;  taste: integer;
  100. BEGIN
  101.   s0 := s; pos := length(s)+1; gotoxy (x,y);
  102.   IF s <> '' Then write (s);
  103.   For i := length(s)+1 to 25 do write (chr(250));
  104.   REPEAT
  105.     gotoxy (x+pos-1,y); getcode (taste);
  106.     CASE taste of
  107.       32..255:IF length(s) < 25 Then BEGIN
  108.                 insert (chr(taste),s,pos);
  109.                 write (copy (s,pos,25)); inc(pos);
  110.               END;
  111.       8     : IF pos > 1 Then BEGIN
  112.                 dec(pos); delete (s,pos,1);
  113.                 write (chr(taste));
  114.                 write (copy(s,pos,25));
  115.                 For i := length(s) to 24 do write(chr(95));
  116.               END ELSE beep;
  117.       1083  : IF pos <= length(s) Then BEGIN
  118.                 delete(s,pos,1); write (copy(s,pos,25));
  119.                 For i := length(s) to 24 do write(chr(95));
  120.               END ELSE beep;
  121.       1075  : IF pos > 1 Then dec(pos) Else beep;
  122.       1077  : IF pos <= length(s) Then inc(pos) Else beep;
  123.       1071  : pos := 1;
  124.       1079  : pos := length(s)+1;
  125.       13,27 :;
  126.     END;
  127.   UNTIL (taste = 13) or (taste= 27);
  128.   IF taste = 27 Then neu := false
  129.   ELSE BEGIN
  130.     upper (s);
  131.     IF s = s0 Then neu := false ELSE neu := true;
  132.   END;
  133. END;
  134.  
  135. FUNCTION Kleiner (x,y: word) : word;
  136. BEGIN IF x < y Then kleiner := x ELSE kleiner := y; END;
  137.  
  138. PROCEDURE Rahmen (x1,y1,x2,y2,art:integer;
  139.                    strich,schatten:boolean);
  140. VAR i: byte;  k: string[9];
  141. BEGIN
  142.   window (x1,y1,x2,y2); clrscr; window (1,1,80,25);
  143.   CASE art of
  144.     1: k := '┌┐└┘─│├┤┬';
  145.     2: k := '╔╗╚╝═║╟╢╤';
  146.   END;
  147.   wrtxy (x1,y1,k[1]);
  148.   For i := x1+1 to x2-1 DO wrtxy (i,y1,k[5]);
  149.   wrtxy (x2,y1,k[2]);  wrtxy (x1,y2,k[3]);
  150.   For i := x1+1 to x2-1 DO wrtxy (i,y2,k[5]);
  151.   wrtxy (x2,y2,k[4]);
  152.   For i := y1+1 to y2-1 DO
  153.   BEGIN wrtxy (x1,i,k[6]); wrtxy (x2,i,k[6]); END;
  154.   IF strich Then BEGIN
  155.     wrtxy (x1,y1+2,k[7]);
  156.     For i := x1+1 to x2-1 DO wrtxy (i,y1+2,chr(196));
  157.     wrtxy (x2,y1+2,k[8]); wrtxy (x2-4,y1,k[9]);
  158.     wrtxy (x2-4,y1+1,chr(179)); wrtxy (x2-4,y1+2,chr(193));
  159.   END;
  160.   IF schatten Then
  161.   BEGIN
  162.     For i := x1+2 to x2+2 do screen^[y2+1,i].attr := 8;
  163.     For i := y1+1 to y2 do screen^[i,x2+1].attr := 8;
  164.     For i := y1+1 to y2 do screen^[i,x2+2].attr := 8;
  165.   END;
  166. END;
  167.  
  168. PROCEDURE Hilfe;
  169. LABEL bild1,bild2,bild3,bild4,ausgang;
  170. VAR taste: integer;
  171. BEGIN
  172.  s_mem := screen^; farbe (hilfefarbe);
  173.  rahmen (15,3,67,21,2,false,true);
  174.  window (16,4,66,20); wrtxy (36,3,' Hilfe ');
  175.  bild1:
  176.  clrscr;
  177.  wrtxy (17,4,'<E> Neue Karteikarte eingeben:');
  178.  wrtxy (21,5,'Geben Sie zuerst das Stichwort ein, unter');
  179.  wrtxy (21,6,'dem die Karte abgespeichert werden soll.');
  180.  wrtxy (21,7,'Schließen Sie mit <Return> ab, und geben');
  181.  wrtxy (21,8,'dann den Text ein.');
  182.  wrtxy (21,9,'Die aktiven Editiertasten sind jeweils in');
  183.  wrtxy (21,10,'der unteren Bildschirmzeile dargestellt.');
  184.  wrtxy (21,11,'Mit <INS> kann der Insert-Modus aus- bzw.');
  185.  wrtxy (21,12,'wieder eingeschaltet werden.');
  186.  wrtxy (21,13,'<F2> speichert die Karte ab, <ESC> beendet');
  187.  wrtxy (21,14,'ohne Abspeichern.');
  188.  wrtxy (17,16,'<B> Karteikarte bearbeiten:');
  189.  wrtxy (21,17,'Mit dieser Funktion kann eine vorhandene');
  190.  wrtxy (21,18,'Karte bearbeitet werden.');
  191.  wrtxy (21,19,'Es gelten dabei die gleichen Regeln, wie');
  192.  wrtxy (21,20,'bei einer Neueingabe.');
  193.  wrtxy (50,21,'═════ PgDn/ESC ');
  194.   Getcode (taste);
  195.   CASE taste of
  196.     1081 : goto bild2;
  197.     27   : goto ausgang;
  198.     Else   goto bild1;
  199.   END;
  200.   bild2:
  201.   clrscr;
  202.   wrtxy (17,5,'<L> Karteikarte löschen:');
  203.   wrtxy (21,6,'Sie können entweder die vorderste Karte');
  204.   wrtxy (21,7,'löschen oder alle markierten Karteikarten.');
  205.   wrtxy (21,8,'Geben Sie auf die Nachfrage entweder A');
  206.   wrtxy (21,9,'(Aktuelle Karte) oder M (Markierte Karten)');
  207.   wrtxy (21,10,'ein. ESC bricht die Funktion ab.');
  208.   wrtxy (17,12,'<M> Karteikarte markieren:');
  209.   wrtxy (21,13,'Wenn Sie <M> betätigen, wird jeweils die');
  210.   wrtxy (21,14,'aktuelle Karteikarte markiert');
  211.   wrtxy (21,15,'(erkennbar an einem Häkchen "√").');
  212.   wrtxy (21,16,'Die Markierungen sind wichtig für die');
  213.   wrtxy (21,17,'Lösch- bzw. Druckfunktion.');
  214.   wrtxy (50,21,' PgUp/PgDn/ESC ');
  215.   Getcode (taste);
  216.   CASE taste of
  217.     1081 : goto bild3;
  218.     1073 : goto bild1;
  219.     27   : goto ausgang;
  220.     Else   goto bild2;
  221.   END;
  222. bild3:
  223. clrscr;
  224. wrtxy (17,4,'<S> Karteikarte suchen:');
  225. wrtxy (21,5,'Geben Sie dazu das Stichwort ein, unter');
  226. wrtxy (21,6,'dem Sie die Karte gespeichert haben.');
  227. wrtxy (21,7,'Die Karte, die dem gesuchten Begriff am');
  228. wrtxy (21,8,'nächsten kommt, wird dann angezeigt.');
  229. wrtxy (17,10,'<D> Neue Datei einlesen:');
  230. wrtxy (21,11,'Obwohl vom Programm her "Memo.dat" als');
  231. wrtxy (21,12,'Standarddatei vorgegeben ist, können Sie');
  232. wrtxy (21,13,'mit dieser Funktion eine neue Datei ein-');
  233. wrtxy (21,14,'lesen bzw. anlegen.');
  234. wrtxy (21,15,'Wenn Sie nur einen Dateinamen angeben, wird');
  235. wrtxy (21,16,'die Datei im aktuellen Verzeichnis angelegt');
  236. wrtxy (21,17,', sonst in dem genannten Verzeichnis.');
  237. wrtxy (21,18,'Geben Sie auf die Frage nach dem Dateinamen');
  238. wrtxy (21,19,'nur <Return> ein, wird die Funktion abge-');
  239. wrtxy (21,20,'brochen.');
  240. wrtxy (50,21,' PgUp/PgDn/ESC ');
  241.  Getcode (taste);
  242.  CASE taste of
  243.     1081 : goto bild4;
  244.     1073 : goto bild2;
  245.     27   : goto ausgang;
  246.     Else   goto bild3;
  247.   END;
  248.   bild4:
  249.   clrscr;
  250.   wrtxy (17,5,'<P> Karteikarten ausdrucken:');
  251.   wrtxy (21,6,'Sie haben dabei die Wahl, entweder alle');
  252.   wrtxy (21,7,'Karten oder nur die markierten zu drucken.');
  253.   wrtxy (21,8,'Geben Sie auf Nachfrage entweder A (Alle)');
  254.   wrtxy (21,9,'oder M (Markierte) ein.');
  255.   wrtxy (21,10,'ESC bricht die Funktion ab.');
  256.   wrtxy (17,12,'INS Mit <Insert> können Sie alle Kartei-');
  257.   wrtxy (21,13,'karten markieren.');
  258.   wrtxy (17,15,'DEL Alle Markierungen werden gelöscht.');
  259.   wrtxy (17,17,'F10 beendet MEMO.');
  260.   wrtxy (50,21,'═════ PgUp/ESC ');
  261.   Getcode (taste);
  262.   CASE taste of
  263.     1073 : goto bild3;
  264.     27   : goto ausgang;
  265.     Else   goto bild4;
  266.   END;
  267.   ausgang:
  268.   window (1,1,80,25);
  269.   screen^ := s_mem; farbe (grundfarbe);
  270. END;
  271.  
  272. { --------------- Initialisierungsteil -------------- }
  273. { - ermittelt die Grafikkarte, und setzt die Farben - }
  274.  
  275. BEGIN
  276.   IF mem[$40:$49] = 7 Then
  277.   BEGIN
  278.     screen := ptr($B000,0);
  279.     grundfarbe      := 112;
  280.     abfragefarbe    := 15;
  281.     buchstabenfarbe := 15;
  282.     eingabefarbe    := 15;
  283.     kartenfarbe     := 112;
  284.     aktkartenfarbe  := 112;
  285.     hilfefarbe      := 15;
  286.     hintergrundfarbe:= 7;
  287.   END
  288.   ELSE screen := ptr($B800,0);
  289. END.
  290.