home *** CD-ROM | disk | FTP | other *** search
- (* ------------------------------------------------------------------- *)
- (* SHOWPIC.PAS *)
- (* Anzeigen, drucken und Text-Konvertierung von Schnappschuessen *)
- (* unter Verwendung von FASTSCR.INC (PASCAL 7/87, S.88) *)
- PROGRAM ShowPic;
-
- CONST ScreenBaseAdress = $B800; (* Monochrom = $B000 ! *)
- ScrSize = 2048;
- TYPE strng = STRING[255];
- VAR Screen : ARRAY[1..ScrSize,1..2] OF CHAR
- ABSOLUTE ScreenBaseAdress:$0000;
- ScrBuf : ARRAY[1..ScrSize,1..2] OF CHAR;
- ScrFil : FILE;
- c : CHAR;
-
- PROCEDURE BufScreen;
- BEGIN Move(Screen,ScrBuf,4000); END;
-
- FUNCTION LoadScreen (Name: strng): BOOLEAN;
- VAR Anzahl: INTEGER;
- BEGIN
- anzahl := 0; Assign(ScrFil,Name);
- (*$I-*) ReSet(ScrFil); (*$I+*)
- IF IOResult = 0 THEN BlockRead(ScrFil,Screen,32,anzahl);
- Close(ScrFil); LoadScreen := (anzahl >= 31);
- END;
-
- PROCEDURE convert;
- VAR i, j: INTEGER; TxtFil: TEXT;
- BEGIN
- BufScreen;
- Assign(TxtFil,'FOTOFILE.TXT'); ReWrite(TxtFil);
- FOR i := 0 TO 24 DO BEGIN
- FOR j := 1 TO 80 DO Write(TxtFil,ScrBuf[i*80+j]);
- WriteLn(TxtFil);
- END;
- Close(TxtFil);
- END;
-
- PROCEDURE print_screen;
- VAR i, j, k: INTEGER;
- BEGIN
- BufScreen;
- FOR i := 0 TO 24 DO BEGIN
- FOR j := 1 TO 80 DO BEGIN
- k := i*80+j;
- (* an dieser Stelle kann das Attribut-Byte "screen[k,2]" ausge-
- wertet und entsprechendes an den Drucker gesendet werden !
- Bei Monochrom z.B. invers, unterstrichen etc. (s. techn. Hand-
- buch des Rechners). Durch entspr. Steuersequenzen fuer Ihren
- Drucker kann die Wiedergabe so verbessert werden! *)
- Write(Lst,Screen[k,1]);
- END;
- WriteLn(Lst);
- END;
- END;
-
- BEGIN (* ShowPic *)
- WriteLn; WriteLn; WriteLn;
- WriteLn('SNAPSHOT & SHOWPIC v1.2 (C) 1987 G.Krüger & PASCAL INT.');
- WriteLn;
- Write('a)nzeigen d)rucken k)onvertieren ?');
- GotoXY(80,25); Read(Kbd,c); c := UpCase(c);
- CASE c OF
- 'A': IF LoadScreen('FOTOFILE.PIC') THEN ELSE;
- 'D': IF LoadScreen('FOTOFILE.PIC') THEN print_screen;
- 'K': IF LoadScreen('FOTOFILE.PIC') THEN convert;
- END;
- IF c = 'A' THEN REPEAT UNTIL KeyPressed;
- END.
-