0
PCA CD Viewer fr Dos Seite03
Black Baron
Programmieren
Datum:   09.10.1997
Betreff: PCA CD Viewer Seite3 (BB_CDV.PAS)
         (Das Hauptprogramm)
From:    Black Baron
To:
============================================
Program BB_CDV;
Uses Crt , Dos , Printer , CRT_DOSX , DESIGN , FIL
Const MAX_INFO_SEITEN = 7;
Var SUCHEN1 , SUCHEN2 : String;

Procedure FARBEN;
Begin
  Textcolor ( 15 );
  Textbackground ( 0 );
End;

Procedure LAUFWERKS_BILDSCHIRM;
Begin
  Clrscr;
  Gotoxy ( 10 , 10 );
  Write ('CD-ROM Laufwerksbezeichnung eingeben: ' 
  Gotoxy ( 10 , 11 );
  Write ( '(z.B.: "d" fr Laufwerk D)' );
  Gotoxy ( 10 , 13 );
  Write ( 'Drcken Sie ESC fr Abbrechen' );
  Gotoxy ( 1 , 24 );
  Write ( '(Der Laufwerksbezeichner kann in Zukunf
  Gotoxy ( 48 , 10 );
End;

Function CD_LAUFWERK_MANUELL_ERMITTELN : Char;
Var EINGABE : Char;
Begin
  LAUFWERKS_BILDSCHIRM;
  EINGABE := Readkey;
  If EINGABE = #27 Then Halt;
  CD_LAUFWERK_MANUELL_ERMITTELN := EINGABE;
End;

Procedure INFO_TEXT ( SEITE : Byte );
Var DATEI : Text;
    DATEI_INHALT : String;
    I : Word;
Begin
  Window ( 1 , 1 , 80 , 24 );
  RAHMEN ( 10 , 3 , 58 , 20 , 15 , 1 );
  Textcolor ( 15 );
  Textbackground ( 1 );
  Gotoxy ( 55 , 2 );
  Write ( SEITE , '/' , MAX_INFO_SEITEN );
  Gotoxy ( 32 , 21 );
  Write ( '[    ]' );
  PCA_OUT ( 33 , 21 , 'Exit' , 1 , 0 );
  If SEITE > 1 Then Begin
    Gotoxy ( 15 , 21 );
    Write ( '[            ]' );
    PCA_OUT ( 16 , 21 , 'Letzte Seite', 1 , 0 );
  End;
  If SEITE < MAX_INFO_SEITEN Then Begin
    Gotoxy ( 42 , 21 );
    Write ( '[             ]' );
    PCA_OUT ( 43 , 21 , 'N„chste Seite', 1 , 0 );
  End;
  Window ( 10 , 3 , 58 , 20 );
  Textbackground ( 1 );
  Textcolor ( 15 );
  Assign ( DATEI ,  PATH . HAUPT + 'HELPINFO.TXT' 
  Reset ( DATEI );
  For I := 18 to ( SEITE * 17 ) do Readln ( DATEI 
  For I := 1 to 17 do Begin
    Readln ( DATEI , DATEI_INHALT );
    Writeln ( DATEI_INHALT );
  End;
  Close ( DATEI );
End;

Procedure INFO;
Var SEITE : Byte;
    NEU : Boolean;
    EINGABE : Char;
Begin
  SEITE := 1;
  NEU := True;
  Repeat
    If NEU Then Begin
      INFO_TEXT ( SEITE );
      NEU := False;
    End;
    EINGABE := Upcase ( Readkey );
    Case EINGABE of
      #0 : Begin
        Case Readkey of
          #75 : Begin
            If SEITE > 1 Then Begin
              SEITE := SEITE - 1;
              NEU := True;
            End;
          End;
          #77 : Begin
            If SEITE < MAX_INFO_SEITEN Then Begin
              SEITE := SEITE + 1;
              NEU := True;
            End;
          End;
        End;
      End;
      'L' : Begin
        If SEITE > 1 Then Begin
          SEITE := SEITE - 1;
          NEU := True;
        End;
      End;
      'N' : Begin
        If SEITE < MAX_INFO_SEITEN Then Begin
          SEITE := SEITE + 1;
          NEU := True;
        End;
      End;
    End;
  Until EINGABE in [ #27 , 'E' ];
End;

Procedure DATEI_DARSTELLEN ( DATEI_NAME : String ;
Var DATEI : Text;
    DATEI_INHALT : String;
    I , I2 : Longint;
Begin
  Window ( 1 , 1 , 80 , 25 );
  If FORUM <> 0 Then HINTERGRUND ( False , False ,
                Else HINTERGRUND ( False , False ,
  Window ( 10 , 3 , 58 , 20 );
  Textbackground ( 1 );
  Textcolor ( 15 );
  Clrscr;
  Case FORUM of
    0 : DATEI_NAME := PATH . CD_LAUFWERK + ':\MENU
    1 : DATEI_NAME := PATH . DATEN + 'FORUM_VO.INF
    2 : DATEI_NAME := PATH . DATEN + 'FORUM_AN.INF
  End;
  Assign ( DATEI , DATEI_NAME );
  {$I-}
  Reset ( DATEI );
  {$I+}
  FEHLER_EXIT ( 5 , 1 , 0 , True );
  I2 := 0;
  I := 1;
  While ( I < BILD_Y ) and ( not Eof ( DATEI ) ) d
    Readln ( DATEI , DATEI_INHALT );
    I := I + 1;
    I2 := I2 + 1;
  End;
  I := 1;
  While ( I <= 18 ) and ( not Eof ( DATEI ) ) do B
    Readln ( DATEI , DATEI_INHALT );
    Gotoxy ( 1 , I );
    If Length ( DATEI_INHALT ) > 44 Then DATEI_INH
    WRITE_ ( DATEI_INHALT );
    I := I + 1;
    I2 := I2 + 1;
  End;
  SPERRE := Eof ( DATEI );
  Close ( DATEI );
End;

Procedure DATEI_DRUCKEN ( DATEI_NAME , TITEL , VON
Var DATEI : Text;
    DATEI_INHALT : String;
Begin
  Textcolor ( 9 );
  Textbackground ( 0 );
  Gotoxy ( 35 , 12 );
  Write ( '  Drucken  ' );
  Case FORUM of
    0 : Begin
      DATEI_NAME := PATH . CD_LAUFWERK + ':\MENUE\
      Writeln ( lst , 'Dateiname: ' + DATEI_NAME +
    End;
    1 : Begin
      DATEI_NAME := PATH . DATEN + 'FORUM_VO.INF';
      Writeln ( lst , 'Forumliste VON' );
    End;
    2 : Begin
      DATEI_NAME := PATH . DATEN + 'FORUM_AN.INF';
      Writeln ( lst , 'Forumliste AN' );
    End;
  End;
  Assign ( DATEI , DATEI_NAME );
  {$I-}
  Reset ( DATEI );
  {$I+}
  FEHLER_EXIT ( 5 , 2 , 0 , True );
  While not Eof ( DATEI ) do Begin
    Readln ( DATEI , DATEI_INHALT );
    Writeln ( Lst , KOREKT ( DATEI_INHALT ) );
  End;
  Close ( DATEI );
End;

Procedure DATEI_ANZEIGEN ( DATEI_NAME , TITEL , VO
Var EINGABE : Char;
    NEU , SPERRE : Boolean;
    BILD_Y : Longint;
Begin
  RAHMEN ( 10 , 3 , 58 , 20 , 15 , 1 );
  Window ( 10 , 3 , 58 , 20 );
  NEU := True;
  If FORUM <> 0 Then BILD_Y := 1
                Else BILD_Y := 5;
  Repeat
    If NEU Then Begin
      DATEI_DARSTELLEN ( DATEI_NAME , BILD_Y , SPE
      NEU := False;
    End;
    EINGABE := Upcase ( Readkey );
    Case EINGABE of
      #0 : Begin
        Case Readkey of
          #72 : Begin
            If BILD_Y > 1 Then Begin
              BILD_Y := BILD_Y - 1;
              NEU := True;
            End;
          End;
          #80 : Begin
            If not SPERRE Then Begin
              BILD_Y := BILD_Y + 1;
              NEU := True;
            End;
          End;
        End;
      End;
      'M' : Begin
        If FORUM = 0 Then Begin
          If TYP <> 4 Then NEUE_MAIL ( True , Fals
                      Else NEUE_MAIL ( True , True
        End;
      End;
      'D' : Begin
        DATEI_DRUCKEN ( DATEI_NAME , TITEL , VON ,
        NEU := True;
      End;
    End;
  Until ( EINGABE in [ #13 , #27 , 'E' ] ) or ( ( 
  Window ( 1 , 1 , 80 , 25 );
End;

Procedure DATENSAETZE_AUSGEBEN ( MODUS , STELLE : 
Begin
  Textcolor ( 15 );
  If CURSOR Then Textbackground ( 2 )
            Else Textbackground ( 1 );
  Window ( 1 , ( STELLE - 1 ) * 3 + 6 , 80 , ( STE
  Clrscr;
  Window ( 1 , 1 , 80 , 24 );
  If MODUS = 0 Then Textcolor ( 14 )
               Else Textcolor ( 15 );
  Gotoxy ( 2 , ( STELLE - 1 ) * 3 + 6 );
  WRITE_ ( 'Nummer: ' + STR_ ( SAMMEL_DATEN . NUMM
  If MODUS = 1 Then Textcolor ( 14 )
               Else Textcolor ( 15 );
  Gotoxy ( 20 , ( STELLE - 1 ) * 3 + 6 );
  WRITE_ ( 'Titel: ' + SAMMEL_DATEN . TITEL );
  If MODUS = 4 Then Textcolor ( 14 )
               Else Textcolor ( 15 );
  Gotoxy ( 5 , ( STELLE - 1 ) * 3 + 7 );
  WRITE_ ( 'Dateiname: ' + SAMMEL_DATEN . DATEI_NA
  If MODUS = 2 Then Textcolor ( 14 )
               Else Textcolor ( 15 );
  Gotoxy ( 26 , ( STELLE - 1 ) * 3 + 7 );
  WRITE_ ( 'Von: ' + SAMMEL_DATEN . VON );
  If MODUS = 3 Then Textcolor ( 14 )
               Else Textcolor ( 15 );
  Gotoxy ( 54 , ( STELLE - 1 ) * 3 + 7 );
  WRITE_ ( 'An: ' + SAMMEL_DATEN . ZU );
End;

Procedure ALLE_DATENSAETZE_AUSGEBEN ( MODUS , CURS
Var I : Integer;
Begin
  For I := 1 to MAX_DARSTELLEN do Begin
    If CURSOR = I Then DATENSAETZE_AUSGEBEN ( MODU
                  Else DATENSAETZE_AUSGEBEN ( MODU
  End;
End;

Procedure SUCHEN_MENUE ( TYP , MODUS : Byte ; MAX 
Var ANTWORT : Byte;
    NAME : ARRAY_10_STRING_20;
    WO : ARRAY_10_BYTE;
    GEFUNDEN : Boolean;
    POS : Word;
Begin
  NAME [ 1 ] := 'Begriff';
  NAME [ 2 ] := 'Neue Suche';
  NAME [ 3 ] := 'Weitersuchen';
  NAME [ 4 ] := 'Exit';
  WO [ 1 ] := 1;
  WO [ 2 ] := 1;
  WO [ 3 ] := 1;
  WO [ 4 ] := 1;
  ANTWORT := 1;
  HINTERGRUND ( False , False , False , False , Fa
  Repeat
    Gotoxy ( 25 , 9 );
    Textbackground ( 0 );
    Textcolor ( 8 );
    WRITE_JOKER ( SUCHEN1 , SUCHEN2 , 15 );
    ANTWORT := MENUE_S2 ( 4 , NAME , WO , 0 , 7 , 
    If ANTWORT = 1 Then Begin
      Textcolor ( 15 );
      Textbackground ( 0 );
      CURSOR_SETZEN ( 6 , 7 );
      SUCHEN2 := READ_MAX ( 44 , 25 , 9 , 15 , SUC
      CURSOR_SETZEN ( 255 , 255 );
    End;
  Until ( ANTWORT <> 1 );
  If ANTWORT <> 4 Then Begin
    Textbackground ( 0 );
    Textcolor ( 9 );
    Gotoxy ( 35 , 12 );
    Write ( '  suchen  ' );
    If ANTWORT = 2 Then GEFUNDEN := SUCHEN ( SUCHE
                   Else GEFUNDEN := SUCHEN ( SUCHE
    If GEFUNDEN Then Begin
      BILD_OBERKANTE := POS + 1;
      If BILD_OBERKANTE + MAX_DARSTELLEN < MAX The
      Else Begin
        BILD_OBERKANTE := MAX - MAX_DARSTELLEN + 1
        BILD_CURSOR := POS - BILD_OBERKANTE + 2;
      End;
    End
    Else BEEP2;
  End;
End;

Procedure SCROLL_UP ( Var BILD_CURSOR : Byte ; Var
Begin
  CODE := 0;
  If BILD_CURSOR > 1 Then Begin
    BILD_CURSOR := BILD_CURSOR - 1;
    CODE := 1;
  End
  Else Begin
    If BILD_OBERKANTE > 1 Then Begin
      BILD_OBERKANTE := BILD_OBERKANTE - 1;
      CODE := 3;
    End;
  End;
End;

Procedure SCROLL_DOWN ( Var BILD_CURSOR : Byte ; V
Begin
  CODE := 0;
  If BILD_CURSOR < MAX_DARSTELLEN Then Begin
    BILD_CURSOR := BILD_CURSOR + 1;
    CODE := 2;
  End
  Else Begin
    If BILD_OBERKANTE + MAX_DARSTELLEN - 1 < MAX T
      BILD_OBERKANTE := BILD_OBERKANTE + 1;
      CODE := 4;
    End;
  End;
End;

Procedure PAGE_UP ( Var BILD_CURSOR : Byte ; Var B
Begin
  CODE := 0;
  If BILD_OBERKANTE > 1 Then Begin
    If BILD_OBERKANTE > MAX_DARSTELLEN Then Begin
      BILD_OBERKANTE := BILD_OBERKANTE - MAX_DARST
      CODE := 5;
    End
    Else Begin
      BILD_OBERKANTE := 1;
      CODE := 5;
    End;
  End
  Else Begin
    If BILD_CURSOR > 1 Then Begin
      BILD_CURSOR := 1;
      CODE := 6;
    End;
  End;
End;

Procedure PAGE_DOWN ( Var BILD_CURSOR : Byte ; Var
Begin
  CODE := 0;
  If BILD_OBERKANTE + MAX_DARSTELLEN - 1 < MAX The
    If BILD_OBERKANTE + ( 2 * MAX_DARSTELLEN ) < M
      BILD_OBERKANTE := BILD_OBERKANTE + MAX_DARST
      CODE := 5;
    End
    Else Begin
      BILD_OBERKANTE := MAX - MAX_DARSTELLEN + 1;
      CODE := 5;
    End;
  End
  Else Begin
    If BILD_CURSOR < MAX_DARSTELLEN Then Begin
      BILD_CURSOR := MAX_DARSTELLEN;
      CODE := 6;
    End;
  End;
End;

Procedure DATENSAETZE_SPEICHER_VERSCHIEBEN ( Var S
                                             BILD_
Var I : Byte;
    DATEN : SINGLE_DATEN_TYPE;
Begin
  If RICHTUNG = -1 Then Begin
    For I := 1 to MAX_DARSTELLEN - 1 do SAMMEL_DAT
    DATENSATZ_LESEN ( BILD_OBERKANTE , CURSOR , TY
    SAMMEL_DATEN [ MAX_DARSTELLEN ] := DATEN;
  End;
  If RICHTUNG = 1 Then Begin
    For I := MAX_DARSTELLEN downto 2 do SAMMEL_DAT
    DATENSATZ_LESEN ( BILD_OBERKANTE , CURSOR , TY
    SAMMEL_DATEN [ 1 ] := DATEN;
  End;
End;

Procedure DATENSAETZE_VERSCHIEBEN_OPTISCH ( Var SA
                                            CURSOR
Begin
  If RICHTUNG = -1 Then DATENSAETZE_AUSGEBEN ( MOD
  If RICHTUNG = 1 Then DATENSAETZE_AUSGEBEN ( MODU
  DATENSAETZE_AUSGEBEN ( MODUS , CURSOR , SAMMEL_D
End;

Procedure DATENSAETZE_VERSCHIEBEN ( Var SAMMEL_DAT
                                    CURSOR , MODUS
Begin
  DATENSAETZE_SPEICHER_VERSCHIEBEN ( SAMMEL_DATEN 
  ALLE_DATENSAETZE_AUSGEBEN ( MODUS , CURSOR , SAM
End;