home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / praxis / menue.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-04  |  7.1 KB  |  266 lines
  1. (*---------------------------------------------------------------------------
  2.      Unit Menue - Menüroutinen.
  3.  
  4.      Letzte Bearbeitung: 4.10.1988 ST
  5.  
  6.      Copyright (C) 1987&1988 by Lutz&Stefan Tandecki, D-3307 Schöppenstedt.
  7.   ---------------------------------------------------------------------------*)
  8.  
  9. Unit Menue;
  10.  
  11. Interface
  12.  
  13. Uses Crt, MenRouts;
  14.  
  15. Const ITEM_LEFT    = $01;
  16.       ITEM_CENTER  = $02;
  17.       ITEM_RIGHT   = $04;
  18.       CENTER_HORIZ = $08;
  19.       CENTER_VERT  = $10;
  20.       ESC_BREAKS   = $20;
  21.       WHITESPACE   = $40;
  22.       DONT_DRAW    = $80;
  23.  
  24.       Simple      = 0;                          (* Konstanten für den Rahmen *)
  25.       Double      = 1;
  26.  
  27.       TopLeft     : Array[0..1] Of Char = ('┌', '╔');
  28.       TopEdge     : Array[0..1] Of Char = ('─', '═');
  29.       TopRight    : Array[0..1] Of Char = ('┐', '╗');
  30.       SideEdge    : Array[0..1] Of Char = ('│', '║');
  31.       BottomLeft  : Array[0..1] Of Char = ('└', '╚');
  32.       BottomRight : Array[0..1] Of Char = ('┘', '╝');
  33.  
  34. Type String20 = String[20];
  35.  
  36. Function HandleMenu (x, y, First, Flags, Border: Integer;
  37.                      DateiName: String20;
  38.                      AnfIndex, EndIndex: Integer;
  39.                      Kopf: String20): Integer;
  40.  
  41. Implementation
  42.  
  43. Type ListPtr = ^ListElement;
  44.  
  45.      ListElement = Record
  46.                      Prev, Next : ListPtr;
  47.                      Text       : WorkString;
  48.                      Index      : Integer;
  49.                    End;
  50.  
  51. (*---------------------------------------------------------------------------
  52.      HandleMenu - Hauptroutine.
  53.   ---------------------------------------------------------------------------*)
  54.  
  55. Function HandleMenu (x, y, First, Flags, Border: Integer;
  56.                      DateiName: String20;
  57.                      AnfIndex, EndIndex: Integer;
  58.                      Kopf: String20): Integer;
  59.  
  60. Var i, s, MenuNr, Hoehe, Breite                  : Integer;
  61.     Key                                          : Char;
  62.     Ende, KeyIsValid                             : Boolean;
  63.     Anfang, Vorg, Hilf, Items                    : ListPtr;
  64.     Line                                         : WorkString;
  65.     Datei                                        : Text;
  66.     HeapTop                                      : ^Integer;
  67.     LinkerRand                                   : Array[1..30] Of Byte;
  68.     Attr                                         : Byte;
  69.  
  70. Begin
  71.   CursorOff;
  72.   ReversAus;
  73.   LowVideo;
  74.  
  75.   Assign (Datei, DateiName);
  76.   (*$I-*) Reset (Datei); (*$I+*)
  77.  
  78.   If (IOResult <> 0) Then                  (* Fehler, Datei nicht gefunden!! *)
  79.   Begin
  80.     CursorOn;
  81.     ReversAus;
  82.     Write (^G);
  83.  
  84.     Write ('Datei '+DateiName+' nicht vorhanden! Programmende mit RETURN.');
  85.     While (ReadKey <> #13) Do;
  86.  
  87.     Halt;
  88.   End;
  89.  
  90.                                   (* Bis zur Zeile AnfIndex Datei überlesen. *)
  91.  
  92.   For i:=1 To AnfIndex-1 Do
  93.     ReadLn (Datei, Line);
  94.  
  95.   Hoehe := EndIndex - AnfIndex + 2;
  96.   Mark (HeapTop);
  97.  
  98.   Anfang := Nil;
  99.   Vorg := Nil;
  100.   i := 1;
  101.   Breite := Length (Kopf);
  102.  
  103.     (* Menüzeilen werden eingelesen und in die verkettete Liste einsortiert. *)
  104.  
  105.   While (i < Hoehe) Do
  106.   Begin
  107.     ReadLn (Datei, Line);
  108.     New (Hilf);
  109.  
  110.     With Hilf^ Do
  111.     Begin
  112.       Text := Line;
  113.  
  114.       If (Length (Text) > Breite) Then
  115.         Breite := Length (Text);
  116.  
  117.       Index := i;
  118.       Next := Nil;
  119.     End; (* Of With Hilf^ *)
  120.  
  121.     INC (i);
  122.  
  123.     If (Anfang = Nil) Then
  124.       Anfang := Hilf;
  125.  
  126.     If (Vorg <> Nil) Then
  127.       Vorg^.Next := Hilf;
  128.  
  129.     Hilf^.Prev := Vorg;
  130.     Vorg := Hilf;
  131.   End; (* Of While *)
  132.  
  133.   Close (Datei);
  134.   Items := Anfang;
  135.   Breite := Breite + 2;
  136.  
  137.   If (Flags And WHITESPACE) <> 0 Then
  138.     Breite := Breite + 2;
  139.  
  140.   If (Flags And CENTER_HORIZ) <> 0 Then
  141.     x := (80 - Breite) Div 2;
  142.  
  143.   If (Flags And CENTER_VERT) <> 0 Then
  144.     y := (25 - Hoehe) Div 2;
  145.  
  146.   i := 1;
  147.   Hilf := Anfang;
  148.  
  149.   If (Flags And DONT_DRAW) = 0 Then
  150.   Begin
  151.     While (Hilf <> Nil) Do
  152.     Begin
  153.       If (Flags And ITEM_LEFT) <> 0 Then
  154.         LinkerRand[i] := x + 1;
  155.  
  156.       If (Flags And ITEM_CENTER) <> 0 Then
  157.         LinkerRand[i] := x + (Breite - Length (Hilf^.Text)) Div 2;
  158.  
  159.       If (Flags And ITEM_RIGHT) <> 0 Then
  160.         LinkerRand[i] := x + Breite - Length (Hilf^.Text);
  161.  
  162.       Hilf := Hilf^.Next;
  163.       INC (i);
  164.     End; (* Of While *)
  165.  
  166.     InitMergeClip;
  167.     WriteInMergeClip (x, y, TopLeft[Border] +
  168.                       Kette (Breite-2, Ord (TopEdge[Border])) +
  169.                       TopRight[Border]);
  170.  
  171.                                (* Schreiben einer Kopfzeile, wenn gewünscht. *)
  172.     If (Kopf <> '') Then
  173.     Begin
  174.       Attr := TextAttr;
  175.       s := x + (Breite - Length (Kopf)) Div 2;
  176.  
  177.       If (Flags And WHITESPACE <> 0) Then
  178.         WriteInMergeClip (s-1, y, #2' '+Kopf+' ')
  179.       Else
  180.         WriteInMergeClip (s, y, #2+Kopf);
  181.  
  182.       TextAttr := Attr;
  183.     End;
  184.  
  185.     i := 1;
  186.     Hilf := Anfang;
  187.  
  188.     While (Hilf <> Nil) Do
  189.     Begin
  190.       WriteInMergeClip (x, y+i, SideEdge[Border]);
  191.       WriteInMergeClip (LinkerRand[i], y+i, Hilf^.Text);
  192.       WriteInMergeClip (x+Breite-1, y+i, SideEdge[Border]);
  193.  
  194.       Hilf := Hilf^.Next;
  195.       INC (i);
  196.     End; (* Of While *)
  197.  
  198.     WriteInMergeClip (x, y+Hoehe, BottomLeft[Border] + Kette (Breite-2,
  199.                                  Ord (TopEdge[Border])) + BottomRight[Border]);
  200.     MergeBoxInScreen (x, y, x+Breite, y+Hoehe, x, y);
  201.   End;
  202.  
  203.   Release (HeapTop);
  204.   MenuNr := First;
  205.   Ende := False;
  206.  
  207.   While Not Ende Do
  208.   Begin
  209.     ReversEin;
  210.     FillLinePart (y+MenuNr, x+1, Breite-2);
  211.  
  212.     Repeat
  213.       Key:= ReadKey;
  214.       KeyIsValid := False;
  215.  
  216.       Case Ord (Key) Of
  217.         27: If (Flags And ESC_BREAKS) <> 0 Then
  218.             Begin
  219.               ReversAus;
  220.               CursorOn;
  221.               HandleMenu := -1;
  222.               Ende := True;
  223.             End;
  224.         13: Begin
  225.               ReversAus;
  226.               CursorOn;
  227.               HandleMenu := MenuNr;
  228.               Ende := True;
  229.             End;
  230.          0: If KeyPressed Then
  231.             Begin
  232.               Key := ReadKey;
  233.  
  234.               If (Key In [#118, #132, #72, #80]) Then
  235.               Begin
  236.                 KeyIsValid := True;
  237.                 ReversAus;
  238.                 LowVideo;
  239.                 FillLinePart (y+MenuNr, x+1, Breite-2);
  240.               End;
  241.  
  242.               Case Ord (Key) Of
  243.                132: MenuNr := 1;                             (* Ctrl-Page up *)
  244.                118: MenuNr := Hoehe-1;                     (* Ctrl-Page down *)
  245.                 72: Begin                                       (* Cursor up *)
  246.                       DEC (MenuNr);
  247.  
  248.                       If (MenuNr < 1) Then
  249.                         MenuNr := Hoehe-1;
  250.                     End;
  251.                 80: Begin                                     (* Cursor down *)
  252.                       INC (MenuNr);
  253.  
  254.                       If (MenuNr > Hoehe-1) Then
  255.                         MenuNr := 1;
  256.                     End;
  257.               End; (* Of Case Ord (Key) *)
  258.             End;
  259.       End; (* Of Case Ord (Key) *)
  260.     Until (KeyIsValid) Or (Ende);
  261.   End; (* Of While *)
  262. End;
  263.  
  264. Begin (* Of Unit *)
  265. End.
  266.