{**********************************}
{    Program brev udskriver        }
{  modtager/afsender p† kuverter   }
{            af                    }
{       Mikael Mortensen           }
{            1993                  }
{**********************************}

PROGRAM brevetiket;

USES
  crt,dos,graph,printer,winscr,star;

CONST
  esc = #27;
  f1 = #59;
  f2 = #60;
  f3 = #61;
  f4 = #62;
  f5 = #63;
  f6 = #64;
  f7 = #65;
  max = 10;

TYPE
  brevpost = RECORD
               navn1      : STRING(.60.);
               adresse1   : STRING(.60.);
               postby1    : STRING(.60.);
               afnavn1    : STRING(.60.);
               afadresse1 : STRING(.60.);
               afpostby1  : STRING(.60.);
             END;

  register = FILE OF brevpost;

VAR
  brev           : brevpost;
  brevfil        : register;
  brevliste      : ARRAY(.1..max.) OF STRING;
  navn           : STRING(.60.);
  adresse        : STRING(.60.);
  postby         : STRING(.60.);
  afnavn         : STRING(.60.);
  afadresse      : STRING(.60.);
  afpostby       : STRING(.60.);
  filnavn        : STRING(.14.);
  gemhent        : STRING(.4.);
  grafmode       : INTEGER;
  klarfarve      : BYTE;
  f,ff,fs,bredde : BYTE;
  klarx,klary    : INTEGER;
  font,check     : CHAR;
  printsvar      : CHAR;

{*******************************************************************}

PROCEDURE grafiktest;

VAR
  grafdriver : INTEGER;
  fejlkode : INTEGER;
  
BEGIN
  grafdriver := DETECT;
  INITGRAPH(grafdriver,grafmode,'D:\TP\BGI');
  fejlkode := GRAPHRESULT;
  IF fejlkode <> GROK THEN
    BEGIN
      WRITELN('Grafikfejl: ',GRAPHERRORMSG(fejlkode));
      WRITELN('Programmet afbrudt...');
      HALT(1);
    END;
END; {grafiktest}

{-------------------------------------------------------------------}

PROCEDURE slut;

BEGIN
  CLOSEGRAPH;
END;{slut}

{-------------------------------------------------------------------}

PROCEDURE slet;       { sletter skriften i "input" }

VAR
  i,j : INTEGER;

BEGIN
  SETCOLOR(0);
  SETTEXTSTYLE(0,HORIZDIR,2);
  j := 13;
  FOR i := 1 TO 595 DO
    BEGIN
     OUTTEXTXY(j,klary,#219);
     j := j + 1;
   END;
   SETCOLOR(15);
   SETTEXTSTYLE(0,HORIZDIR,1);
END; {slet}

{--------------------------------------------------------------------}

PROCEDURE klar; { klar lys i "input"}

BEGIN
  SETCOLOR(klarfarve);
  OUTTEXTXY(klarx,klary,#219);
  SETCOLOR(15);
END; {klar}

{-------------------------------------------------------------------}

PROCEDURE findfil;

VAR
  DirInfo : SEARCHREC;
  i,j,k   : INTEGER;

BEGIN
  k := 0;
  i := 130;
  j := 200;
  GOTOXY(65, 5);WRITE('FILER');
  FindFirst('*.brv', Archive, DirInfo);
  WHILE DosError = 0 DO
    BEGIN
      OUTTEXTXY(j,i,dirinfo.name);
      FindNext(DirInfo);
      k := k + 1;
      i := i + 20;
       IF i >= 230 THEN
         BEGIN
           i := 130;
           j := 325;
          IF k >= 10 THEN
           BEGIN
             i := 130;
             j := 450;
           END;
         END;
    END;
END; {findfil}

{-------------------------------------------------------------------}

PROCEDURE angiv_filnavn;

VAR
  i,antal : INTEGER;

BEGIN
  SETCOLOR(4);
  SETLINESTYLE(solidln,0,thickwidth);
  SETFILLSTYLE(1,0);
  RECTANGLE(80,80,GETMAXX - 80,GETMAXY - 200);
  FLOODFILL(100,100,4);
  SETCOLOR(4);
  LINE(80,120,GETMAXX - 80,120);
  LINE(80,240,GETMAXX - 80,240);
  findfil;
  SETTEXTSTYLE(1,HORIZDIR,1);
  SETCOLOR(8);
  OUTTEXTXY(270,90,gemhent);
  SETTEXTSTYLE(0,HORIZDIR,1);
  OUTTEXTXY(85,130,'Filer(brv): ');
  OUTTEXTXY(85,260,'Filnavn: ');
  REPEAT
    i := 150;
    FOR antal := 1 TO 40 DO
      BEGIN
        SETTEXTSTYLE(0,HORIZDIR,2);
        SETCOLOR(0);
        OUTTEXTXY(i,255,#219);
        i := i + 10;
      END;
    TEXTCOLOR(15);
    GOTOXY(20,17);
    READLN(filnavn);
  UNTIL LENGTH(filnavn) < 9;
  filnavn := filnavn+'.brv';
  ASSIGN(brevfil,filnavn);
END;

{---------------------------------------------------------}

PROCEDURE gem;

BEGIN
  {$I-}
  REWRITE(brevfil);
  {$I+}
  IF IOResult <> 0 THEN
     BEGIN
       WRITE(#7);
       SETTEXTSTYLE(0,HORIZDIR,1);
       SETCOLOR(10);
       OUTTEXTXY(180,230,'Filen er ikke fundet - Tryk <Enter>');
       READLN;
       EXIT;
     END
  ELSE
      WITH brev DO
        BEGIN
          navn1 := navn;
          adresse1 := adresse;
          postby1 := postby;
          afnavn1 := afnavn;
          afadresse1 := afadresse;
          afpostby1 := afpostby;
        END;
  WRITE(brevfil,brev);
  CLOSE(brevfil);
END; {gem}

{-------------------------------------------------------------------}

PROCEDURE hent;

BEGIN
  {$I-}
  RESET(brevfil);
  {$I+}
  IF IOResult <> 0 THEN
     BEGIN
       WRITE(#7);
       SETTEXTSTYLE(0,HORIZDIR,1);
       SETCOLOR(10);
       OUTTEXTXY(180,230,'Filen er ikke fundet - Tryk <Enter>');
       READLN;
       EXIT;
     END
  ELSE
  IF FILESIZE(brevfil) = 0 THEN
    BEGIN
      WRITE(#7);
      SETTEXTSTYLE(0,HORIZDIR,1);
      SETCOLOR(10);
      OUTTEXTXY(210,230,'Filen er tom - Tryk <Enter>');
      READLN;
      EXIT;
    END
  ELSE
   BEGIN
     WHILE NOT EOF(brevfil) DO
       BEGIN
         READ(brevfil,brev);
         WITH brev DO
           BEGIN
             navn := navn1;
             adresse := adresse1;
             postby := postby1;
             afnavn := afnavn1;
             afadresse := afadresse1;
             afpostby := afpostby1;
           END;
         END;
     END;
     CLOSE(brevfil);
END; {hent}

{---------------------------------------------------------}

PROCEDURE input;

BEGIN
  klary := 368;
  klarx := 17;
  klarfarve := 2;
  TEXTCOLOR(white);klar;
  GOTOXY(5,24);
  READLN(navn);
  OUTTEXTXY(110,110,navn);slet;klar;
  GOTOXY(5,24);
  READLN(adresse);
  OUTTEXTXY(110,130,adresse);slet;klar;
  GOTOXY(5,24);
  READLN(postby);
  OUTTEXTXY(110,150,postby);slet;klar; 
END; {input}

{-------------------------------------------------------------------}

PROCEDURE inputafsender;

BEGIN
  klary := 368;
  klarx := 17;
  klarfarve := 2;
  TEXTCOLOR(white);klar;
  GOTOXY(5,24);
  READLN(afnavn);
  OUTTEXTXY(110,240,afnavn);slet;klar;
  GOTOXY(5,24);
  READLN(afadresse);
  OUTTEXTXY(110,260,afadresse);slet;klar;
  GOTOXY(5,24);
  READLN(afpostby);
  OUTTEXTXY(110,280,afpostby);slet;
  klarfarve := 4;klar;
END; {inputafsender}

{-------------------------------------------------------------------}

PROCEDURE inputnavne;

BEGIN
  TEXTCOLOR(white);
  OUTTEXTXY(110,110,navn);
  OUTTEXTXY(110,130,adresse);
  OUTTEXTXY(110,150,postby);
  OUTTEXTXY(110,240,afnavn);
  OUTTEXTXY(110,260,afadresse);
  OUTTEXTXY(110,280,afpostby);
END; {inputnavne}

{-------------------------------------------------------------------}

PROCEDURE overskriv;       { sletter skriften i "modt + afs" }

VAR
  i,j : INTEGER;

BEGIN
  SETCOLOR(0);
  SETTEXTSTYLE(0,HORIZDIR,2);
  j := 110;
  FOR i := 1 TO 500 DO
    BEGIN
     OUTTEXTXY(j,klary,#219);
     j := j + 1;
   END;
   SETCOLOR(15);
   SETTEXTSTYLE(0,HORIZDIR,1);
END; {overskriv}

{--------------------------------------------------------------------}

PROCEDURE overskriv_modt;

BEGIN
  klary := 110; overskriv;
  klary := 130; overskriv;
  klary := 150; overskriv;
END; {overskriv_modt}

{-------------------------------------------------------------------}

PROCEDURE overskriv_afs;

BEGIN
  klary := 240; overskriv;
  klary := 260; overskriv;       
  klary := 280; overskriv;
END; {overskriv_afs}

{-------------------------------------------------------------------}

PROCEDURE slet_modtager;

BEGIN
  navn := ' ';
  adresse := ' ';
  postby := ' ';
END; {slet_modtager}

{-------------------------------------------------------------------}

PROCEDURE slet_afsender;

BEGIN
  afnavn := ' ';
  afadresse := ' ';
  afpostby := ' ';
END; {slet_afsender}

{-------------------------------------------------------------------}
FUNCTION store(ch : CHAR) : CHAR;

BEGIN
  IF (ch >= 'a') AND (ch <= '†') THEN
    store := CHR(ORD(ch) - 32)
  ELSE
    store := ch;
END; {store}

{-------------------------------------------------------------------}

PROCEDURE fontvalg;


BEGIN
  OUTTEXTXY(150,320,'I - Italics');
  OUTTEXTXY(350,320,'O - Orator');
  OUTTEXTXY(150,360,'C - Courier');
  OUTTEXTXY(350,360,'S - Sanserif');
  font := ReadKey; font := store(font);
   CASE font OF
     'C' : BEGIN
             reset_all;
             courier;
           END;
     'S' : BEGIN
             reset_all;
             sanserif;
           END;
     'O' : BEGIN
             reset_all;
             oratorblok;
           END;
     'I' : BEGIN
             reset_all;
             italics;
             italics_nlq;
           END;
     'D' : BEGIN
             reset_all;
             fremh;
             double_strike;
             draft;
           END;
     esc : BEGIN
             check := 'j';
           END;
   ELSE
     courier;
   END;
END; {fontvalg}

{---------------------------------------------------------}

PROCEDURE fontvalg_til_c4;


BEGIN
  OUTTEXTXY(150,320,'N - Normal');
  OUTTEXTXY(350,320,'V - Vektor');
  OUTTEXTXY(150,360,'G - Gotiske');
  OUTTEXTXY(350,360,'S - Sanserif');
  font := ReadKey; font := store(font);
   CASE font OF
     'N' : BEGIN
             f := 0;
             ff := 1;
             fs := 2;
             bredde := 80;
           END;
     'S' : BEGIN
             f := 3;
             ff := 1;
             fs := 0;
             bredde := 100;
           END;
     'G' : BEGIN
             f := 4;
             ff := 2;
             fs := 0;
             bredde := 100;
           END;
     'V' : BEGIN
             f := 1;
             ff := 1;
             fs := 0;
             bredde := 100;
           END;
     'L' : BEGIN
             f := 2;
             ff := 5;
             fs := 9;
             bredde := 100;
           END;
     esc : BEGIN
             check := 'j';
           END
   ELSE
     BEGIN
       f := 2;
       ff := 5;
       fs := 9;
       bredde := 100;
     END;
   END;
END; {fontvalg_til_c4}

{---------------------------------------------------------}

PROCEDURE c4;

BEGIN
  fremh;
  double_strike;
  CLEARDEVICE;
  SETTEXTSTYLE(f,HORIZDIR,fs);
  SETBKCOLOR(0);
  SETCOLOR(15);
  OUTTEXTXY(10,300,navn);
  OUTTEXTXY(10,335,adresse);
  OUTTEXTXY(10,370,postby);
  READLN;
  CLEARDEVICE;
  SETTEXTSTYLE(f,HORIZDIR,ff);
  OUTTEXTXY(10,20,'Afs:');
  OUTTEXTXY(50,20,afnavn);
  OUTTEXTXY(50,40,afadresse);
  OUTTEXTXY(50,60,afpostby);
  READLN;
END; {c4}

{---------------------------------------------------------}

PROCEDURE printer_check; FORWARD;

{---------------------------------------------------------}

PROCEDURE c5;

VAR
  i : BYTE;

BEGIN
  envejs_print;
  fremh;
  double_strike;
  dob_firedob(1);
  TEXTBACKGROUND(7);ClrScr;
  WINSHADOW(20,6,40,8,0,2);
 ClrScr;
  GOTOXY(6,2);WRITE('* Modtager *');
  FOR i := 1 TO 4 DO
    BEGIN
      WRITELN(LST,' ');
    END;
  WRITELN(LST,navn);
  WRITELN(LST,adresse);
  WRITELN(LST,postby);
  form_feed;
  READLN;
  IF (font = 'D') OR (font = 'd') THEN
    BEGIN
      nlq_karak;
    END;
  ClrScr;
  dob_firedob(0);
  karakstr(1);
  fremh;
  formindsket_print;
  GOTOXY(6,2);ClrEol;
  WRITE('* Afsender *');
  WRITELN(LST,'Afs: ',afnavn : 2,',',afadresse,',',afpostby);
  form_feed;
END; {c5}

{-------------------------------------------------------------------}

PROCEDURE m65;

VAR
  i : BYTE;

BEGIN
  envejs_print;
  fremh;
  double_strike;
  karakstr(1);
  TEXTBACKGROUND(7);ClrScr;
  WINSHADOW(20,6,40,8,0,2);
 ClrScr;
  GOTOXY(6,2);WRITE('* Modtager *');
  FOR i := 1 TO 4 DO
    BEGIN
      WRITELN(LST,' ');
    END;
  WRITELN(LST,navn);
  WRITELN(LST,adresse);
  WRITELN(LST,postby);
  form_feed;
  READLN;
  IF (font = 'D') OR (font = 'd') THEN
    BEGIN
      nlq_karak;
    END;
  ClrScr;
  fremh;
  formindsket_print;
  GOTOXY(6,2);ClrEol;
  WRITE('* Afsender *');
  WRITELN(LST,'Afs: ',afnavn : 2,',',afadresse,',',afpostby);
  form_feed;
END; {m65}

{-------------------------------------------------------------------}

PROCEDURE printer_check;

VAR
  valg : CHAR;

BEGIN
  {$I-}
  WRITE(LST,' ');
  IF IOResult <> 0 THEN
    BEGIN
      REPEAT
        WRITE(#7);
        SETCOLOR(10);
        OUTTEXTXY(150,270,'Printerfejl - Check printer P/ESC');
        valg := ReadKey; valg := store(valg);
      UNTIL (valg = 'P') OR (valg = 'p') OR (valg = esc);
      CASE valg OF
       'P' : BEGIN
               printer_check;
               printsvar := 'k';
             END;
       esc : BEGIN
               printsvar := 'm';
             END;
      END;
    END;
    SETCOLOR(15);
    {$I+}
END; {printer_check}

{-------------------------------------------------------------------}

PROCEDURE brevmenu;

LABEL
  11,22,33;

VAR
  svar : CHAR;

BEGIN
  printsvar := 's';
  SETCOLOR(4);
  SETLINESTYLE(solidln,0,thickwidth);
  SETFILLSTYLE(1,0);
  RECTANGLE(80,80,GETMAXX - 80,GETMAXY - 80);
  FLOODFILL(100,100,4);
  SETCOLOR(4);
  LINE(80,120,GETMAXX - 80,120);
  LINE(80,300,GETMAXX - 80,300);
  SETTEXTSTYLE(1,HORIZDIR,2);
  SETCOLOR(7);
  OUTTEXTXY(270,90,'PRINT');
  SETCOLOR(8);
  SETTEXTSTYLE(0,HORIZDIR,1);
  OUTTEXTXY(85,130,'TYPE:');
  OUTTEXTXY(85,310,'FONTE:');
  SETLINESTYLE(solidln,0,normwidth);
  SETTEXTSTYLE(1,HORIZDIR,2);
  OUTTEXTXY(260,155,'A - M65');
  OUTTEXTXY(260,185,'B - C5');
  OUTTEXTXY(260,215,'C - C4');
  SETCOLOR(7);
  svar := ReadKey; svar := store(svar);
  CASE svar OF
    'A' : BEGIN;
            printer_check;
            IF printsvar = 'm' THEN
               GoTo 11;
            fontvalg;
            IF check = 'j' THEN
              EXIT;
            RESTORECRTMODE;
            m65;
            SETGRAPHMODE(grafmode);
            11: EXIT;
          END;
    'B' : BEGIN
            printer_check;
            IF printsvar = 'm' THEN
              GoTo 22;
            fontvalg;
            IF check = 'j' THEN
              EXIT;
            RESTORECRTMODE;
            c5;
            SETGRAPHMODE(grafmode);
            22: EXIT;
          END;
    'C' : BEGIN
            printer_check;
            IF printsvar = 'm' THEN
              GoTo 33;
            fontvalg_til_c4;
            IF check = 'j' THEN
              EXIT;
            c4;
            33: EXIT;
          END;
    esc : EXIT;
  END;
END; {brevmenu}

{-------------------------------------------------------------------}

PROCEDURE skermbilled;

LABEL
  11;

VAR
  ok,slut : BOOLEAN;
  svar : CHAR;

BEGIN
 REPEAT
  CLEARDEVICE;
  printsvar := 'k';
  check := 'n';
  slut := FALSE; 
  RECTANGLE(0,0,GETMAXX,GETMAXY);
  LINE(0,60,GETMAXX,60);
  LINE(0,GETMAXY - 60,GETMAXX,GETMAXY - 60);
  SETTEXTSTYLE(1,HORIZDIR,2);
  SETCOLOR(7);
  OUTTEXTXY(240,20,'KUVERT PRINT');
  SETCOLOR(15);
  SETTEXTSTYLE(0,HORIZDIR,1);
{--------------------------------------------------}
  OUTTEXTXY(10,75,'Modtager:');
  RECTANGLE(10,90,GETMAXX - 10,GETMAXY - 290);
  OUTTEXTXY(15,110,'Navn......:');
  OUTTEXTXY(15,130,'Adresse...:');
  OUTTEXTXY(15,150,'By/postnr.:');
{--------------------------------------------------}
  OUTTEXTXY(10,205,'Afsender:');
  RECTANGLE(10,220,GETMAXX - 10,GETMAXY - 155);
  OUTTEXTXY(15,240,'Navn......:');
  OUTTEXTXY(15,260,'Adresse...:');
  OUTTEXTXY(15,280,'By/postnr.:');
  OUTTEXTXY(10,335,'Input:');
  RECTANGLE(10,400,GETMAXX - 10,GETMAXY - 130);
  inputnavne;
  SETCOLOR(7);
  OUTTEXTXY(20,440,'ESC-Quit  F1-Ny  F2-Gem  F3-Hent  F4-Print  F5-Slet  F6-Ny modt.  F7-Ny afs.');
  SETCOLOR(15);
  klary := 368;
  klarx := 17;
  klarfarve := 4; klar;
   REPEAT
   11:
   ok := TRUE;
   svar := ReadKey; svar := store(svar);
     CASE svar OF
        f1 : BEGIN
               klarfarve := 2;
               slet_modtager;
               overskriv_modt;
               slet_afsender;
               overskriv_afs;
               input;
               inputafsender;
               GoTo 11     
             END;
        f2 : BEGIN
               gemhent := 'GEM';
               angiv_filnavn;
               gem;
               SETGRAPHMODE(grafmode);
             END;
        f3 : BEGIN
               gemhent := 'HENT';
               angiv_filnavn;
               hent;
               SETGRAPHMODE(grafmode);
             END;
        f4 : BEGIN
               brevmenu;
             END;  
        f5 : BEGIN
               slet_modtager;
               slet_afsender;
             END;
        f6 : BEGIN
               slet_modtager;
               overskriv_modt;  
               input;
             END;
        f7 : BEGIN
               slet_afsender;
               overskriv_afs;
               inputafsender;
             END;
       esc : BEGIN
               slut := TRUE;
             END
     ELSE
       ok := FALSE;
     END;
   UNTIL  ok;
 UNTIL  slut;
END; {skermbilled}

{-------------------------------------------------------------------}

BEGIN
  grafiktest;
  slet_modtager;
  slet_afsender;
  skermbilled;
  slut;
END.