home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC Action 1997 December
/
PCACTION1297.ISO
/
menue
/
POSTFACH
/
97120755.TXT
< prev
next >
Wrap
Text File
|
1997-10-29
|
12KB
|
445 lines
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;