home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
07
/
ldm
/
memo.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-03-29
|
19KB
|
551 lines
PROGRAM MEMO;
USES crt,dos,memoerg,printer;
CONST dateiname : pathstr = 'MEMO.DAT';
leer = ' ';
dx = 45; { dx und dy sind entscheidend für die }
dy = 7; { Größe der Karteikarten; dabei darf }
{ dx höchstens 66 sein, und dy höchs- }
{ tens 17; -> am besten ausprobieren ! }
bzahl= (17-dy) div 2 +1;
msg1 = chr(27)+' '+chr(26)+' Home End '+
'BS DEL ESC-Abbruch RETURN-Ende ';
msg2 = ' '+chr(24)+' '+chr(25)+' '+chr(26)+' '+
chr(27)+' Home End BS INS DEL ^Y ^N '+
'RET ESC-Abbruch F2-Speichern ';
TYPE chararray = Array [1..dx*dy] of char;
datensatz = RECORD
titel : s25;
txt : chararray;
mark : boolean;
END;
VAR dfile : file of datensatz;
ds : datensatz;
zeile,spalte: byte;
aus,ende,neu: boolean;
ch : char;
taste,z : integer;
satznummer : word;
maxdat : word;
dummy : pathstr;
trenner : Set of char;
PROCEDURE BildAufbau;
BEGIN
For zeile := 2 to 24 DO
For spalte := 1 to 80 DO
BEGIN
screen^[zeile,spalte].ch := chr(176);
screen^[zeile,spalte].attr := hintergrundfarbe;
END;
farbe (grundfarbe);
gotoxy (1,1); clreol; write (' Datei: '+dateiname);
wrtxy (33,1,'»»» MEMO V 1.0 «««');
gotoxy (62,1); write ('Datensätze: ',maxdat:3);
END;
{ Die 4 folgenden Routinen sind für die }
{ Dateibearbeitung zuständig : }
PROCEDURE LiesDatensatz (nr: word; VAR dat: datensatz);
BEGIN seek (dfile,nr-1); read (dfile,dat); END;
PROCEDURE SchreibeDatenSatz (nr: word; dat: datensatz);
BEGIN seek (dfile,nr-1); write (dfile,dat); END;
PROCEDURE DatensatzEinfuegen (dat: datensatz);
VAR i,j: word; d : datensatz; fertig: boolean;
BEGIN
i := 1; fertig := false;
While (i <= maxdat) and not fertig DO BEGIN
LiesDatensatz (i,d);
IF d.titel < dat.titel Then inc(i) ELSE fertig := true;
END;
For j := maxdat downto i DO BEGIN
LiesDatensatz (j,d); SchreibeDatensatz (j+1,d);
END;
SchreibeDatensatz (i,dat);
END;
PROCEDURE DatensatzEntfernen (pos: word);
VAR d0: datensatz;
BEGIN
While pos < maxdat DO BEGIN
LiesDatensatz (pos+1,d0);
SchreibeDatensatz (pos,d0); inc (pos);
END;
seek (dfile,maxdat-1); truncate(dfile); dec(maxdat);
END;
{ Prozedur zum Einlesen, bzw. Editieren der Memo-Texte }
PROCEDURE LiesCharArray (x1,y1: byte; VAR txt: chararray;
VAR ok: boolean);
VAR x2,y2,x,y,i,wi,sz: byte;
b : char;
insert : boolean;
PROCEDURE ArraySchieben (px,py: byte; art: byte);
VAR k,pos: word;
BEGIN
k := 1;
For zeile := y1 to y2 DO
For spalte := x1 to x2-1 DO
BEGIN txt[k] := screen^[zeile,spalte].ch; inc(k); END;
pos := (px-x1+1) + (py-y1)*dx;
IF art = 1 Then
BEGIN
For k := dx*dy downto pos+1 do txt[k] := txt[k-1];
txt[pos] := ' ';
END
ELSE IF art = 2 Then
BEGIN
For k := pos to (dx*dy)-1 do txt[k] := txt[k+1];
txt[dx*dy] := ' ';
END;
k := 1;
For zeile := y1 to y2 DO
For spalte := x1 to x2-1 DO
BEGIN screen^[zeile,spalte].ch := txt[k]; inc(k); END;
END;
BEGIN
x2 := x1+dx; y2 := y1+dy-1; x := x1; y := y1;
trenner := [' ',',','.','-','!','?',';',':'];
insert := true;
gotoxy (x,y);
REPEAT
getcode (taste);
CASE taste of
13 : IF y < y2 Then BEGIN inc(y); x := x1; END
ELSE x := x1;
14 : BEGIN { ^N = Zeile einfügen }
For zeile := y2 downto y+1 DO
For spalte := x1 to x2-1 DO
screen^[zeile,spalte].ch :=
screen^[zeile-1,spalte].ch;
For i:=x1 to x2-1 DO screen^[y,i].ch:=' ';
END;
25 : BEGIN { ^Y = Zeile löschen }
For zeile := y to y2-1 DO
For spalte := x1 to x2-1 DO
screen^[zeile,spalte].ch :=
screen^[zeile+1,spalte].ch;
For i:=x1 to x2-1 DO screen^[y2,i].ch:=' ';
END;
32 : IF x < x2 Then
BEGIN
IF insert Then ArraySchieben (x,y,1);
write (chr(taste)); inc(x);
END
ELSE IF (x = x2) Then IF (y < y2) Then
BEGIN x := x1; inc(y); END
ELSE BEGIN dec(x); beep; END;
33..255: BEGIN
IF x < x2 Then
BEGIN
IF insert Then ArraySchieben (x,y,1);
write (chr(taste));
END;
IF (x = x2) Then
BEGIN
IF y < y2 Then
BEGIN
If not (screen^[y,x-1].ch in trenner)
Then BEGIN
i := x;
REPEAT
dec(i);
UNTIL (screen^[y,i].ch in trenner)
or (i=x1);
sz := 1;
For wi := i+1 to x2-1 do
BEGIN
b := screen^[y,wi].ch;
screen^[y,wi].ch := ' ';
IF insert Then
ArraySchieben (x1+sz,y+1,1);
wrtxy (x1+wi-i-1,y+1,b);
inc(sz);
END;
x := x1+sz-1; inc(y);
wrtxy (x,y,chr(taste));
END
ELSE BEGIN
x := x1; inc(y);
wrtxy (x,y,chr(taste));
END;
END ELSE BEGIN dec(x); beep; END;
END;
inc(x);
END;
1072 : IF y > y1 Then dec(y) ELSE beep;
1080 : IF y < y2 Then inc(y) ELSE beep;
1071 : x := x1;
1079 : BEGIN
x := x2;
While screen^[y,x-1].ch = ' ' DO dec(x);
END;
1077 : IF x < x2 Then inc(x) ELSE IF y < y2 Then
BEGIN x := x1; inc(y); END ELSE beep;
1075 : IF x > x1 Then dec(x) ELSE IF y > y1 Then
BEGIN x := x2; dec(y); END ELSE beep;
1082 : IF insert = true Then Insert := false
Else insert := true;
1083 : ArraySchieben (x,y,2);
8 : IF x > x1 Then
BEGIN dec(x); ArraySchieben (x,y,2); END;
END;
gotoxy (x,y);
UNTIL (taste = 1060) or (taste = 27);
IF taste = 1060 Then
BEGIN
ok := true; z := 1;
For zeile := y1 to y2 DO
For spalte := x1 to x2-1 DO
BEGIN txt[z] := screen^[zeile,spalte].ch; inc(z); END;
END
ELSE IF taste = 27 Then ok := false;
END;
PROCEDURE Eingabe (VAR dat: datensatz; VAR aus: boolean);
VAR i: byte; z: word; ok: boolean;
BEGIN
gotoxy (1,25); clreol; wrtxy (29,25,msg1);
farbe (eingabefarbe);
Rahmen (14,6,14+dx+1,6+dy+3,2,true,true);
wrtxy (16,7,'Stichwort: '); dat.titel := '';
c_on; readstr (27,7,dat.titel,neu);
IF neu Then
BEGIN
aus := false; gotoxy (16,7); write (dat.titel);
For i := length(dat.titel) to dx-6 do write (' ');
wrtxy (1,25,msg2);
For z := 1 to dx*dy do dat.txt[z] := ' ';
Lieschararray (15,9,dat.txt,ok);
IF not ok Then aus := true;
dat.mark := false;
END
ELSE aus := true;
farbe (grundfarbe); c_off;
END;
PROCEDURE Drucken;
VAR sz: word; pl: byte;
PROCEDURE Drucke (d : datensatz; VAR p: byte);
VAR i,j: byte;
BEGIN
IF p = bzahl+1 Then { dann neue Seite }
BEGIN p := 0; write (lst,#12); END;
write (lst,chr(218));
For i := 1 to dx DO write (lst,chr(196));
writeln (lst,chr(191)); write (lst,chr(179));
write (lst,d.titel);
For i := length(d.titel)+1 to dx DO write (lst,' ');
writeln (lst,chr(179)); write (lst,chr(195));
For i := 1 to dx DO write (lst,chr(196));
writeln (lst,chr(180));
z := 1;
For j := 1 to dy DO BEGIN
write (lst,chr(179));
For i := 1 to dx DO
BEGIN write (lst,d.txt[z]); inc(z); END;
writeln (lst,chr(179));
END;
write (lst,chr(192));
For i := 1 to dx DO write (lst,chr(196));
writeln (lst,chr(217));
END;
BEGIN
pl := 0; farbe (abfragefarbe);
rahmen (20,7,60,13,2,false,true);
wrtxy (24,9,'A - Alle Datensätze drucken ');
wrtxy (24,10,'M - Markierte Datensätze drucken ');
wrtxy (24,11,'ESC - Abbruch');
REPEAT
ch := upcase(readkey);
UNTIL ch in ['A','M',#27];
farbe (grundfarbe);
CASE ch of
'A' : BEGIN
For sz := 1 to maxdat DO BEGIN
inc(pl); liesdatensatz (sz,ds);
drucke (ds,pl);
END;
END;
'M' : BEGIN
For sz := 1 to maxdat DO BEGIN
liesdatensatz (sz,ds);
IF ds.mark = true Then
BEGIN inc(pl); drucke (ds,pl); END;
END;
END;
END;
END;
PROCEDURE NixDa;
BEGIN
farbe (abfragefarbe);
Rahmen (14,7,66,13,2,false,true);
wrtxy (16,9,'Die Datei enthält bisher '+
'noch keine Datensätze!');
wrtxy (16,11,'Bitte <ESC> drücken ...');
escape; farbe (grundfarbe);
END;
PROCEDURE NeueDatei;
BEGIN
Rahmen (10,6,70,12,2,false,true);
wrtxy (12,8,'Neue Datei einlesen, bzw. erzeugen :');
wrtxy (12,10,'Dateiname:');
c_on; gotoxy (23,10); readln (dummy); c_off;
IF dummy <> '' Then
BEGIN
close (dfile); dateiname := dummy;
{$I-} assign (dfile,dateiname);
reset (dfile); {$I+}
IF ioresult <> 0 Then rewrite(dfile);
maxdat := filesize(dfile);
IF maxdat = 0 Then nixda;
END;
END;
PROCEDURE EintragZeigen (x1,y1,x2,y2: byte;
nr: word; art: byte);
VAR z: word;
BEGIN
z := 1; LiesDatensatz (nr,ds);
farbe (aktkartenfarbe);
Rahmen (x1,y1,x2,y2,art,true,false);
wrtxy (x1+2,y1+1,ds.titel);
IF ds.mark Then wrtxy (x2-2,y1+1,chr(251));
For zeile := y1+3 to y2-1 DO
For spalte := x1+1 to x2-1 DO
BEGIN screen^[zeile,spalte].ch := ds.txt[z]; inc(z); END;
farbe (grundfarbe);
END;
PROCEDURE Bearbeiten;
VAR x1,y1,i : byte;
sz,count,anzahl: word;
stichwort : s25;
gefunden,ok : boolean;
merktext : chararray;
PROCEDURE HintereKartenZeigen;
VAR i: byte;
BEGIN
IF maxdat >= sz Then BEGIN
count := 0;
For i := 1 to kleiner (anzahl-1,maxdat-sz) DO BEGIN
LiesDatensatz (sz+i,ds);
wrtxy(x1+2+(2*i),y1+1-(2*i),leer);
wrtxy(x1+2+(2*i),y1+1-(2*i),ds.titel);
IF ds.mark Then
wrtxy (x1+dx-1+(2*i),y1+1-(2*i),chr(251))
ELSE wrtxy (x1+dx-1+(2*i),y1+1-(2*i),' ');
inc(count);
END;
For i := count+1 to anzahl-1 DO BEGIN
LiesDatensatz (i-count,ds);
wrtxy(x1+2+(2*i),y1+1-(2*i),leer);
wrtxy(x1+2+(2*i),y1+1-(2*i),ds.titel);
IF ds.mark Then
wrtxy (x1+dx-1+(2*i),(y1+1)-(2*i),chr(251))
ELSE wrtxy (x1+dx-1+(2*i),(y1+1)-(2*i),' ');
END;
END;
END;
BEGIN
gotoxy (1,25); clreol;
wrtxy (2,25,'F1-Hilfe Eingabe Bearbeiten Löschen '+
'Mark. Suchen Datei Print F10-Ende');
farbexy (12,25,buchstabenfarbe);
farbexy (21,25,buchstabenfarbe);
farbexy (33,25,buchstabenfarbe);
farbexy (42,25,buchstabenfarbe);
farbexy (49,25,buchstabenfarbe);
farbexy (57,25,buchstabenfarbe);
farbexy (64,25,buchstabenfarbe);
x1 := (80-dx) div 2; y1 := 3; sz := bzahl;
While sz > maxdat DO
BEGIN dec(sz); dec(x1,2); inc(y1,2); END;
anzahl := sz;
farbe (kartenfarbe);
For count := anzahl downto 1 DO
BEGIN
IF count = 1 Then
eintragzeigen (x1,y1,x1+dx+1,y1+dy+3,sz,2)
ELSE
Rahmen (x1,y1,x1+dx+1,y1+dy+3,1,true,false);
dec(x1,2); inc(y1,2); dec(sz);
END;
farbe (grundfarbe);
x1 := ((80-dx) div 2)-(bzahl-1)*2;
y1 := 3+(bzahl-1)*2; sz := 1;
HintereKartenZeigen;
REPEAT
getcode(taste);
CASE taste of
1059 : Hilfe;
1072,
1073 : IF maxdat > 0 Then
BEGIN { Vorwärts blättern }
IF sz < maxdat Then inc(sz) ELSE sz := 1;
eintragzeigen (x1,y1,x1+dx+1,y1+dy+3,sz,2);
HintereKartenZeigen;
END;
1080,
1081 : IF maxdat > 0 Then
BEGIN { Rückwärts blättern }
IF sz > 1 Then dec(sz) ELSE sz := maxdat;
eintragzeigen (x1,y1,x1+dx+1,y1+dy+3,sz,2);
HintereKartenZeigen;
END;
1071 : IF maxdat > 0 Then
BEGIN { Home = An Dateianfang }
sz := 1;
eintragzeigen(x1,y1,x1+dx+1,y1+dy+3,sz,2);
HintereKartenZeigen;
END;
83,115: IF maxdat > 0 Then
BEGIN { Stichwort suchen }
s_mem := screen^; gefunden := false;
gotoxy (1,25); clreol;
write (' Gesuchtes Stichwort : ');
c_on; beep; stichwort := '';
readstr (24,25,stichwort,neu);
screen^ := s_mem; c_off;
IF neu Then
BEGIN
sz := 1;
REPEAT
LiesDatensatz (sz,ds);
IF ds.titel = stichwort Then
gefunden := true ELSE inc(sz);
UNTIL gefunden or (ds.titel>stichwort) or
(sz > maxdat);
IF (not gefunden) and (sz>1) Then dec(sz);
eintragzeigen (x1,y1,x1+dx+1,y1+dy+3,sz,2);
HintereKartenZeigen;
END;
END;
77,109: IF maxdat > 0 Then
BEGIN { Markierung an/aus }
LiesDatensatz (sz,ds);
ds.mark := not ds.mark;
schreibedatensatz (sz,ds);
IF ds.mark Then wrtxy (x1+dx-1,y1+1,chr(251))
ELSE wrtxy (x1+dx-1,y1+1,' ');
END;
76,108: IF maxdat > 0 Then
BEGIN { Löschen }
s_mem := screen^; farbe (abfragefarbe);
rahmen (20,7,60,13,2,false,true);
wrtxy (24,9,'A - Aktuellen Datensatz löschen');
wrtxy (24,10,'M - Markierte Datensätze löschen');
wrtxy (24,11,'ESC - Abbruch');
REPEAT
ch := upcase(readkey);
UNTIL ch in ['A','M',#27];
farbe (grundfarbe);
screen^ := s_mem;
CASE ch of
'A': BEGIN
datensatzentfernen (sz);
BildAufbau; Bearbeiten;
END;
'M': BEGIN
sz := 1;
While sz <= maxdat DO
BEGIN
LiesDatensatz (sz,ds);
IF ds.mark Then
datensatzentfernen (sz)
ELSE inc(sz);
END;
BildAufbau; Bearbeiten;
END;
END;
END;
66,98 : IF maxdat > 0 Then
BEGIN { Datensatz editieren }
s_mem := screen^; gotoxy (1,25); clreol;
beep; wrtxy (29,25,msg1);
c_on; LiesDatensatz (sz,ds);
merktext := ds.txt;
farbe (aktkartenfarbe);
readstr(x1+2,y1+1,ds.titel,neu);
farbe (grundfarbe);
wrtxy (1,25,msg2);
farbe (aktkartenfarbe);
LiesCharArray (x1+1,y1+3,ds.txt,ok);
IF not ok Then ds.txt := merktext;
farbe (grundfarbe); c_off;
IF neu Then
BEGIN
datensatzentfernen (sz);
datensatzeinfuegen (ds); inc(maxdat);
END
ELSE SchreibeDatensatz (sz,ds);
screen^ := s_mem;
eintragzeigen (x1,y1,x1+dx+1,y1+dy+3,sz,2);
HintereKartenZeigen;
END;
1082 : IF maxdat > 0 Then
BEGIN { Alle Datensätze markieren }
For i := 1 to maxdat DO BEGIN
LiesDatensatz (i,ds); ds.mark := true;
SchreibeDatensatz (i,ds);
END;
Bearbeiten;
END;
1083 : IF maxdat > 0 Then
BEGIN { Alle Markierungen löschen }
For i := 1 to maxdat DO BEGIN
LiesDatensatz (i,ds); ds.mark := false;
SchreibeDatensatz (i,ds);
END;
Bearbeiten;
END;
69,101: BEGIN
REPEAT { Datensatz eingeben }
Eingabe (ds,aus);
IF not aus Then BEGIN
DatensatzEinfuegen(ds); inc(maxdat);
gotoxy (74,1); write (maxdat:3);
END
UNTIL aus;
bildaufbau; bearbeiten;
END;
80,112: IF maxdat > 0 Then
BEGIN { Karteikarten drucken }
s_mem:=screen^; Drucken; screen^:=s_mem;
END;
68,100: BEGIN { Neue Datei einlesen }
NeueDatei; Bildaufbau; bearbeiten;
END;
END;
UNTIL taste = 1068;
END;
{ ---------------- Hauptprogramm ------------------ }
BEGIN
{$I-} assign (dfile,dateiname); reset (dfile); {$I+}
IF ioresult <> 0 Then rewrite (dfile);
ende := false; farbe (grundfarbe); clrscr; c_off;
maxdat := filesize(dfile);
bildaufbau;
IF maxdat = 0 Then
BEGIN s_mem := screen^; NixDa; screen^ := s_mem; END;
Bearbeiten;
clrscr; close (dfile);
END.