home *** CD-ROM | disk | FTP | other *** search
/ PC Action 1997 December / PCACTION1297.ISO / menue / POSTFACH / 97120755.TXT < prev    next >
Text File  |  1997-10-29  |  12KB  |  445 lines
  1. 0
  2. PCA CD Viewer für Dos Seite03
  3. Black Baron
  4. Programmieren
  5. Datum:   09.10.1997
  6. Betreff: PCA CD Viewer Seite3 (BB_CDV.PAS)
  7.          (Das Hauptprogramm)
  8. From:    Black Baron
  9. To:
  10. ============================================
  11. Program BB_CDV;
  12. Uses Crt , Dos , Printer , CRT_DOSX , DESIGN , FIL
  13. Const MAX_INFO_SEITEN = 7;
  14. Var SUCHEN1 , SUCHEN2 : String;
  15.  
  16. Procedure FARBEN;
  17. Begin
  18.   Textcolor ( 15 );
  19.   Textbackground ( 0 );
  20. End;
  21.  
  22. Procedure LAUFWERKS_BILDSCHIRM;
  23. Begin
  24.   Clrscr;
  25.   Gotoxy ( 10 , 10 );
  26.   Write ('CD-ROM Laufwerksbezeichnung eingeben: ' 
  27.   Gotoxy ( 10 , 11 );
  28.   Write ( '(z.B.: "d" für Laufwerk D)' );
  29.   Gotoxy ( 10 , 13 );
  30.   Write ( 'Drücken Sie ESC für Abbrechen' );
  31.   Gotoxy ( 1 , 24 );
  32.   Write ( '(Der Laufwerksbezeichner kann in Zukunf
  33.   Gotoxy ( 48 , 10 );
  34. End;
  35.  
  36. Function CD_LAUFWERK_MANUELL_ERMITTELN : Char;
  37. Var EINGABE : Char;
  38. Begin
  39.   LAUFWERKS_BILDSCHIRM;
  40.   EINGABE := Readkey;
  41.   If EINGABE = #27 Then Halt;
  42.   CD_LAUFWERK_MANUELL_ERMITTELN := EINGABE;
  43. End;
  44.  
  45. Procedure INFO_TEXT ( SEITE : Byte );
  46. Var DATEI : Text;
  47.     DATEI_INHALT : String;
  48.     I : Word;
  49. Begin
  50.   Window ( 1 , 1 , 80 , 24 );
  51.   RAHMEN ( 10 , 3 , 58 , 20 , 15 , 1 );
  52.   Textcolor ( 15 );
  53.   Textbackground ( 1 );
  54.   Gotoxy ( 55 , 2 );
  55.   Write ( SEITE , '/' , MAX_INFO_SEITEN );
  56.   Gotoxy ( 32 , 21 );
  57.   Write ( '[    ]' );
  58.   PCA_OUT ( 33 , 21 , 'Exit' , 1 , 0 );
  59.   If SEITE > 1 Then Begin
  60.     Gotoxy ( 15 , 21 );
  61.     Write ( '[            ]' );
  62.     PCA_OUT ( 16 , 21 , 'Letzte Seite', 1 , 0 );
  63.   End;
  64.   If SEITE < MAX_INFO_SEITEN Then Begin
  65.     Gotoxy ( 42 , 21 );
  66.     Write ( '[             ]' );
  67.     PCA_OUT ( 43 , 21 , 'Nächste Seite', 1 , 0 );
  68.   End;
  69.   Window ( 10 , 3 , 58 , 20 );
  70.   Textbackground ( 1 );
  71.   Textcolor ( 15 );
  72.   Assign ( DATEI ,  PATH . HAUPT + 'HELPINFO.TXT' 
  73.   Reset ( DATEI );
  74.   For I := 18 to ( SEITE * 17 ) do Readln ( DATEI 
  75.   For I := 1 to 17 do Begin
  76.     Readln ( DATEI , DATEI_INHALT );
  77.     Writeln ( DATEI_INHALT );
  78.   End;
  79.   Close ( DATEI );
  80. End;
  81.  
  82. Procedure INFO;
  83. Var SEITE : Byte;
  84.     NEU : Boolean;
  85.     EINGABE : Char;
  86. Begin
  87.   SEITE := 1;
  88.   NEU := True;
  89.   Repeat
  90.     If NEU Then Begin
  91.       INFO_TEXT ( SEITE );
  92.       NEU := False;
  93.     End;
  94.     EINGABE := Upcase ( Readkey );
  95.     Case EINGABE of
  96.       #0 : Begin
  97.         Case Readkey of
  98.           #75 : Begin
  99.             If SEITE > 1 Then Begin
  100.               SEITE := SEITE - 1;
  101.               NEU := True;
  102.             End;
  103.           End;
  104.           #77 : Begin
  105.             If SEITE < MAX_INFO_SEITEN Then Begin
  106.               SEITE := SEITE + 1;
  107.               NEU := True;
  108.             End;
  109.           End;
  110.         End;
  111.       End;
  112.       'L' : Begin
  113.         If SEITE > 1 Then Begin
  114.           SEITE := SEITE - 1;
  115.           NEU := True;
  116.         End;
  117.       End;
  118.       'N' : Begin
  119.         If SEITE < MAX_INFO_SEITEN Then Begin
  120.           SEITE := SEITE + 1;
  121.           NEU := True;
  122.         End;
  123.       End;
  124.     End;
  125.   Until EINGABE in [ #27 , 'E' ];
  126. End;
  127.  
  128. Procedure DATEI_DARSTELLEN ( DATEI_NAME : String ;
  129. Var DATEI : Text;
  130.     DATEI_INHALT : String;
  131.     I , I2 : Longint;
  132. Begin
  133.   Window ( 1 , 1 , 80 , 25 );
  134.   If FORUM <> 0 Then HINTERGRUND ( False , False ,
  135.                 Else HINTERGRUND ( False , False ,
  136.   Window ( 10 , 3 , 58 , 20 );
  137.   Textbackground ( 1 );
  138.   Textcolor ( 15 );
  139.   Clrscr;
  140.   Case FORUM of
  141.     0 : DATEI_NAME := PATH . CD_LAUFWERK + ':\MENU
  142.     1 : DATEI_NAME := PATH . DATEN + 'FORUM_VO.INF
  143.     2 : DATEI_NAME := PATH . DATEN + 'FORUM_AN.INF
  144.   End;
  145.   Assign ( DATEI , DATEI_NAME );
  146.   {$I-}
  147.   Reset ( DATEI );
  148.   {$I+}
  149.   FEHLER_EXIT ( 5 , 1 , 0 , True );
  150.   I2 := 0;
  151.   I := 1;
  152.   While ( I < BILD_Y ) and ( not Eof ( DATEI ) ) d
  153.     Readln ( DATEI , DATEI_INHALT );
  154.     I := I + 1;
  155.     I2 := I2 + 1;
  156.   End;
  157.   I := 1;
  158.   While ( I <= 18 ) and ( not Eof ( DATEI ) ) do B
  159.     Readln ( DATEI , DATEI_INHALT );
  160.     Gotoxy ( 1 , I );
  161.     If Length ( DATEI_INHALT ) > 44 Then DATEI_INH
  162.     WRITE_ ( DATEI_INHALT );
  163.     I := I + 1;
  164.     I2 := I2 + 1;
  165.   End;
  166.   SPERRE := Eof ( DATEI );
  167.   Close ( DATEI );
  168. End;
  169.  
  170. Procedure DATEI_DRUCKEN ( DATEI_NAME , TITEL , VON
  171. Var DATEI : Text;
  172.     DATEI_INHALT : String;
  173. Begin
  174.   Textcolor ( 9 );
  175.   Textbackground ( 0 );
  176.   Gotoxy ( 35 , 12 );
  177.   Write ( '  Drucken  ' );
  178.   Case FORUM of
  179.     0 : Begin
  180.       DATEI_NAME := PATH . CD_LAUFWERK + ':\MENUE\
  181.       Writeln ( lst , 'Dateiname: ' + DATEI_NAME +
  182.     End;
  183.     1 : Begin
  184.       DATEI_NAME := PATH . DATEN + 'FORUM_VO.INF';
  185.       Writeln ( lst , 'Forumliste VON' );
  186.     End;
  187.     2 : Begin
  188.       DATEI_NAME := PATH . DATEN + 'FORUM_AN.INF';
  189.       Writeln ( lst , 'Forumliste AN' );
  190.     End;
  191.   End;
  192.   Assign ( DATEI , DATEI_NAME );
  193.   {$I-}
  194.   Reset ( DATEI );
  195.   {$I+}
  196.   FEHLER_EXIT ( 5 , 2 , 0 , True );
  197.   While not Eof ( DATEI ) do Begin
  198.     Readln ( DATEI , DATEI_INHALT );
  199.     Writeln ( Lst , KOREKT ( DATEI_INHALT ) );
  200.   End;
  201.   Close ( DATEI );
  202. End;
  203.  
  204. Procedure DATEI_ANZEIGEN ( DATEI_NAME , TITEL , VO
  205. Var EINGABE : Char;
  206.     NEU , SPERRE : Boolean;
  207.     BILD_Y : Longint;
  208. Begin
  209.   RAHMEN ( 10 , 3 , 58 , 20 , 15 , 1 );
  210.   Window ( 10 , 3 , 58 , 20 );
  211.   NEU := True;
  212.   If FORUM <> 0 Then BILD_Y := 1
  213.                 Else BILD_Y := 5;
  214.   Repeat
  215.     If NEU Then Begin
  216.       DATEI_DARSTELLEN ( DATEI_NAME , BILD_Y , SPE
  217.       NEU := False;
  218.     End;
  219.     EINGABE := Upcase ( Readkey );
  220.     Case EINGABE of
  221.       #0 : Begin
  222.         Case Readkey of
  223.           #72 : Begin
  224.             If BILD_Y > 1 Then Begin
  225.               BILD_Y := BILD_Y - 1;
  226.               NEU := True;
  227.             End;
  228.           End;
  229.           #80 : Begin
  230.             If not SPERRE Then Begin
  231.               BILD_Y := BILD_Y + 1;
  232.               NEU := True;
  233.             End;
  234.           End;
  235.         End;
  236.       End;
  237.       'M' : Begin
  238.         If FORUM = 0 Then Begin
  239.           If TYP <> 4 Then NEUE_MAIL ( True , Fals
  240.                       Else NEUE_MAIL ( True , True
  241.         End;
  242.       End;
  243.       'D' : Begin
  244.         DATEI_DRUCKEN ( DATEI_NAME , TITEL , VON ,
  245.         NEU := True;
  246.       End;
  247.     End;
  248.   Until ( EINGABE in [ #13 , #27 , 'E' ] ) or ( ( 
  249.   Window ( 1 , 1 , 80 , 25 );
  250. End;
  251.  
  252. Procedure DATENSAETZE_AUSGEBEN ( MODUS , STELLE : 
  253. Begin
  254.   Textcolor ( 15 );
  255.   If CURSOR Then Textbackground ( 2 )
  256.             Else Textbackground ( 1 );
  257.   Window ( 1 , ( STELLE - 1 ) * 3 + 6 , 80 , ( STE
  258.   Clrscr;
  259.   Window ( 1 , 1 , 80 , 24 );
  260.   If MODUS = 0 Then Textcolor ( 14 )
  261.                Else Textcolor ( 15 );
  262.   Gotoxy ( 2 , ( STELLE - 1 ) * 3 + 6 );
  263.   WRITE_ ( 'Nummer: ' + STR_ ( SAMMEL_DATEN . NUMM
  264.   If MODUS = 1 Then Textcolor ( 14 )
  265.                Else Textcolor ( 15 );
  266.   Gotoxy ( 20 , ( STELLE - 1 ) * 3 + 6 );
  267.   WRITE_ ( 'Titel: ' + SAMMEL_DATEN . TITEL );
  268.   If MODUS = 4 Then Textcolor ( 14 )
  269.                Else Textcolor ( 15 );
  270.   Gotoxy ( 5 , ( STELLE - 1 ) * 3 + 7 );
  271.   WRITE_ ( 'Dateiname: ' + SAMMEL_DATEN . DATEI_NA
  272.   If MODUS = 2 Then Textcolor ( 14 )
  273.                Else Textcolor ( 15 );
  274.   Gotoxy ( 26 , ( STELLE - 1 ) * 3 + 7 );
  275.   WRITE_ ( 'Von: ' + SAMMEL_DATEN . VON );
  276.   If MODUS = 3 Then Textcolor ( 14 )
  277.                Else Textcolor ( 15 );
  278.   Gotoxy ( 54 , ( STELLE - 1 ) * 3 + 7 );
  279.   WRITE_ ( 'An: ' + SAMMEL_DATEN . ZU );
  280. End;
  281.  
  282. Procedure ALLE_DATENSAETZE_AUSGEBEN ( MODUS , CURS
  283. Var I : Integer;
  284. Begin
  285.   For I := 1 to MAX_DARSTELLEN do Begin
  286.     If CURSOR = I Then DATENSAETZE_AUSGEBEN ( MODU
  287.                   Else DATENSAETZE_AUSGEBEN ( MODU
  288.   End;
  289. End;
  290.  
  291. Procedure SUCHEN_MENUE ( TYP , MODUS : Byte ; MAX 
  292. Var ANTWORT : Byte;
  293.     NAME : ARRAY_10_STRING_20;
  294.     WO : ARRAY_10_BYTE;
  295.     GEFUNDEN : Boolean;
  296.     POS : Word;
  297. Begin
  298.   NAME [ 1 ] := 'Begriff';
  299.   NAME [ 2 ] := 'Neue Suche';
  300.   NAME [ 3 ] := 'Weitersuchen';
  301.   NAME [ 4 ] := 'Exit';
  302.   WO [ 1 ] := 1;
  303.   WO [ 2 ] := 1;
  304.   WO [ 3 ] := 1;
  305.   WO [ 4 ] := 1;
  306.   ANTWORT := 1;
  307.   HINTERGRUND ( False , False , False , False , Fa
  308.   Repeat
  309.     Gotoxy ( 25 , 9 );
  310.     Textbackground ( 0 );
  311.     Textcolor ( 8 );
  312.     WRITE_JOKER ( SUCHEN1 , SUCHEN2 , 15 );
  313.     ANTWORT := MENUE_S2 ( 4 , NAME , WO , 0 , 7 , 
  314.     If ANTWORT = 1 Then Begin
  315.       Textcolor ( 15 );
  316.       Textbackground ( 0 );
  317.       CURSOR_SETZEN ( 6 , 7 );
  318.       SUCHEN2 := READ_MAX ( 44 , 25 , 9 , 15 , SUC
  319.       CURSOR_SETZEN ( 255 , 255 );
  320.     End;
  321.   Until ( ANTWORT <> 1 );
  322.   If ANTWORT <> 4 Then Begin
  323.     Textbackground ( 0 );
  324.     Textcolor ( 9 );
  325.     Gotoxy ( 35 , 12 );
  326.     Write ( '  suchen  ' );
  327.     If ANTWORT = 2 Then GEFUNDEN := SUCHEN ( SUCHE
  328.                    Else GEFUNDEN := SUCHEN ( SUCHE
  329.     If GEFUNDEN Then Begin
  330.       BILD_OBERKANTE := POS + 1;
  331.       If BILD_OBERKANTE + MAX_DARSTELLEN < MAX The
  332.       Else Begin
  333.         BILD_OBERKANTE := MAX - MAX_DARSTELLEN + 1
  334.         BILD_CURSOR := POS - BILD_OBERKANTE + 2;
  335.       End;
  336.     End
  337.     Else BEEP2;
  338.   End;
  339. End;
  340.  
  341. Procedure SCROLL_UP ( Var BILD_CURSOR : Byte ; Var
  342. Begin
  343.   CODE := 0;
  344.   If BILD_CURSOR > 1 Then Begin
  345.     BILD_CURSOR := BILD_CURSOR - 1;
  346.     CODE := 1;
  347.   End
  348.   Else Begin
  349.     If BILD_OBERKANTE > 1 Then Begin
  350.       BILD_OBERKANTE := BILD_OBERKANTE - 1;
  351.       CODE := 3;
  352.     End;
  353.   End;
  354. End;
  355.  
  356. Procedure SCROLL_DOWN ( Var BILD_CURSOR : Byte ; V
  357. Begin
  358.   CODE := 0;
  359.   If BILD_CURSOR < MAX_DARSTELLEN Then Begin
  360.     BILD_CURSOR := BILD_CURSOR + 1;
  361.     CODE := 2;
  362.   End
  363.   Else Begin
  364.     If BILD_OBERKANTE + MAX_DARSTELLEN - 1 < MAX T
  365.       BILD_OBERKANTE := BILD_OBERKANTE + 1;
  366.       CODE := 4;
  367.     End;
  368.   End;
  369. End;
  370.  
  371. Procedure PAGE_UP ( Var BILD_CURSOR : Byte ; Var B
  372. Begin
  373.   CODE := 0;
  374.   If BILD_OBERKANTE > 1 Then Begin
  375.     If BILD_OBERKANTE > MAX_DARSTELLEN Then Begin
  376.       BILD_OBERKANTE := BILD_OBERKANTE - MAX_DARST
  377.       CODE := 5;
  378.     End
  379.     Else Begin
  380.       BILD_OBERKANTE := 1;
  381.       CODE := 5;
  382.     End;
  383.   End
  384.   Else Begin
  385.     If BILD_CURSOR > 1 Then Begin
  386.       BILD_CURSOR := 1;
  387.       CODE := 6;
  388.     End;
  389.   End;
  390. End;
  391.  
  392. Procedure PAGE_DOWN ( Var BILD_CURSOR : Byte ; Var
  393. Begin
  394.   CODE := 0;
  395.   If BILD_OBERKANTE + MAX_DARSTELLEN - 1 < MAX The
  396.     If BILD_OBERKANTE + ( 2 * MAX_DARSTELLEN ) < M
  397.       BILD_OBERKANTE := BILD_OBERKANTE + MAX_DARST
  398.       CODE := 5;
  399.     End
  400.     Else Begin
  401.       BILD_OBERKANTE := MAX - MAX_DARSTELLEN + 1;
  402.       CODE := 5;
  403.     End;
  404.   End
  405.   Else Begin
  406.     If BILD_CURSOR < MAX_DARSTELLEN Then Begin
  407.       BILD_CURSOR := MAX_DARSTELLEN;
  408.       CODE := 6;
  409.     End;
  410.   End;
  411. End;
  412.  
  413. Procedure DATENSAETZE_SPEICHER_VERSCHIEBEN ( Var S
  414.                                              BILD_
  415. Var I : Byte;
  416.     DATEN : SINGLE_DATEN_TYPE;
  417. Begin
  418.   If RICHTUNG = -1 Then Begin
  419.     For I := 1 to MAX_DARSTELLEN - 1 do SAMMEL_DAT
  420.     DATENSATZ_LESEN ( BILD_OBERKANTE , CURSOR , TY
  421.     SAMMEL_DATEN [ MAX_DARSTELLEN ] := DATEN;
  422.   End;
  423.   If RICHTUNG = 1 Then Begin
  424.     For I := MAX_DARSTELLEN downto 2 do SAMMEL_DAT
  425.     DATENSATZ_LESEN ( BILD_OBERKANTE , CURSOR , TY
  426.     SAMMEL_DATEN [ 1 ] := DATEN;
  427.   End;
  428. End;
  429.  
  430. Procedure DATENSAETZE_VERSCHIEBEN_OPTISCH ( Var SA
  431.                                             CURSOR
  432. Begin
  433.   If RICHTUNG = -1 Then DATENSAETZE_AUSGEBEN ( MOD
  434.   If RICHTUNG = 1 Then DATENSAETZE_AUSGEBEN ( MODU
  435.   DATENSAETZE_AUSGEBEN ( MODUS , CURSOR , SAMMEL_D
  436. End;
  437.  
  438. Procedure DATENSAETZE_VERSCHIEBEN ( Var SAMMEL_DAT
  439.                                     CURSOR , MODUS
  440. Begin
  441.   DATENSAETZE_SPEICHER_VERSCHIEBEN ( SAMMEL_DATEN 
  442.   ALLE_DATENSAETZE_AUSGEBEN ( MODUS , CURSOR , SAM
  443. End;
  444.  
  445.