home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / pulldown / pulldown.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-05-27  |  5.0 KB  |  135 lines
  1. (***************************************************************************)
  2. (*                            PULLDOWN.PAS                                 *)
  3. (*              Bereitstellung von Pulldown-Menue-Technik                  *)
  4.  
  5. (* -----------------     Hardwareabhaengige Routinen    ------------------ *)
  6.  
  7.        PROCEDURE SaveScreen;    (* sichert aktuellen Bildschirm *)
  8.          BEGIN  Move (ScreenRAM,SaveRAM,ScreenLen);  END;
  9.  
  10.  
  11.        PROCEDURE LoadScreen;         (* holt Bildschirm zurueck *)
  12.          BEGIN  Move (SaveRAM,ScreenRAM,ScreenLen);  END;
  13.  
  14.  
  15.        PROCEDURE SetColors (f,b :INTEGER);      (* setzt Farben *)
  16.          BEGIN  TextColor (f);  TextBackGround (b);  END;
  17.  
  18.  
  19.        PROCEDURE ReadChar (VAR Key: CHAR);
  20.          BEGIN
  21.            Read (Kbd,Key);
  22.            IF (Key = ESC) AND KeyPressed THEN
  23.              BEGIN                     (* Die Cursor-Tasten des PC's *)
  24.                Read (Kbd,Key);         (* erzeugen zwei Zeichen:     *)
  25.                CASE Key OF             (* ESCape gefolgt vom eigent- *)
  26.                  'K': Key := CrsLeft;  (* lichen Code!               *)
  27.                  'M': Key := CrsRight;
  28.                  'H': Key := CrsUp;
  29.                  'P': Key := CrsDown
  30.                END
  31.              END
  32.          END;
  33.  
  34. (* --------------  Allgemeiner, hardwareunabhaengiger Teil  -------------- *)
  35.  
  36. PROCEDURE PullDown (    xpos,ypos  :INTEGER;        (* Bildschirmposition  *)
  37.                     VAR Menu       :MenuType;      (* das Menue            *)
  38.                         Display    :BOOLEAN;
  39.                     VAR Result     :INTEGER;      (* gewaehlter Menuepunkt *)
  40.                     VAR Key        :CHAR;
  41.                     VAR Extern     :InputStr);      (* externe Eingabe     *)
  42.  
  43.    VAR i,j,p,Len,xofs,yofs :INTEGER;
  44.        Quit  :BOOLEAN;
  45.  
  46.    PROCEDURE WriteItem (p :INTEGER; Selected :BOOLEAN);
  47.       VAR i,j :INTEGER;
  48.     BEGIN
  49.       WITH Menu DO
  50.       BEGIN
  51.         IF Selected THEN  SetColors (SelectText,SelectBack)
  52.         ELSE SetColors (NormalText,NormalBack);
  53.         IF vertical THEN
  54.           BEGIN
  55.             GotoXY (xpos+xofs,Pred(ypos)+yofs+p);  Write (Item[p])
  56.           END
  57.         ELSE
  58.           BEGIN
  59.             j := 0;
  60.             FOR i := 1 TO Pred(p) DO j := j + Length(Item[i]);
  61.             GotoXY (xpos+xofs+j,ypos+yofs);  Write (Item[p])
  62.           END
  63.       END
  64.     END;
  65.  
  66.    PROCEDURE MoveBar (d :INTEGER);                 (* bewegt SELECT-Balken *)
  67.       VAR i,j :INTEGER;
  68.     BEGIN
  69.       IF d <> 0 THEN  WriteItem (p,FALSE);
  70.       IF p+d > Menu.NoItems THEN  p := (p+d) MOD Menu.NoItems
  71.       ELSE IF p+d < 1 THEN  p := Menu.NoItems + (p+d)
  72.       ELSE p := p+d;
  73.       WriteItem (p,TRUE)
  74.     END;
  75.  
  76.    PROCEDURE DrawFrame (x1,y1,x2,y2 :INTEGER); (* Rahmen um Menue zeichnen *)
  77.       VAR i :INTEGER;
  78.     BEGIN
  79.       GotoXY (x1,y1); Write (LeftTop);
  80.       FOR i:=Succ(x1) TO Pred(x2) DO Write (Horizontal); Write (RightTop);
  81.       FOR i:=Succ(y1) TO Pred(y2) DO
  82.         BEGIN  GotoXY (x2,i); Write (vertical) END;
  83.       GotoXY (x2,y2); Write (RightBottom);
  84.       FOR i:=Succ(y1) TO Pred(y2) DO
  85.         BEGIN  GotoXY (x1,i); Write (vertical) END;
  86.       GotoXY (x1,y2); Write (LeftBottom);
  87.       FOR i:=Succ(x1) TO Pred(x2) DO Write (Horizontal);
  88.     END;
  89.  
  90.  BEGIN  (* PullDown *)
  91.    WITH Menu DO
  92.    BEGIN
  93.      xofs := 0;  yofs := 0;
  94.      IF Frame THEN  BEGIN  xofs := 1;  yofs := 1  END;
  95.      IF Display THEN
  96.        BEGIN
  97.          SaveScreen;   SetColors (FrameColor,NormalBack);
  98.          IF vertical THEN
  99.            BEGIN
  100.              Len := 0;
  101.              FOR i := 1 TO NoItems DO
  102.                IF Length(Item[i]) > Len THEN  Len := Length(Item[i]);
  103.              GotoXY (xpos,ypos);
  104.              IF Frame THEN  DrawFrame (xpos,ypos,xpos+Len+1,ypos+NoItems+1)
  105.            END
  106.          ELSE
  107.            BEGIN
  108.              Len := 0;
  109.              FOR i := 1 TO NoItems DO  Len := Len + Length(Item[i]);
  110.              GotoXY (xpos,ypos);
  111.              IF Frame THEN  DrawFrame (xpos,ypos,xpos+Len+1,ypos+2)
  112.            END;
  113.          FOR i := 1 TO NoItems DO  WriteItem (i,FALSE);
  114.        END;
  115.      p := LastItem;   MoveBar (0);    Result := 0;
  116.      REPEAT
  117.        IF Extern = '' THEN  ReadChar (Key)
  118.        ELSE  BEGIN  Key := Extern[1];  Delete (Extern,1,1)   END;
  119.        CASE Key OF
  120.           CrsLeft  : IF NOT vertical THEN MoveBar (-1);
  121.           CrsRight : IF NOT vertical THEN MoveBar (+1);
  122.           CrsUp    : IF     vertical THEN MoveBar (-1);
  123.           CrsDown  : IF     vertical THEN MoveBar (+1);
  124.           CR       : Result := p
  125.        END;
  126.        Quit := (vertical AND (Key IN [CR,ESC,CrsLeft,CrsRight])) OR (NOT
  127.                 vertical AND (Key IN [CR,ESC,CrsUp,CrsDown]))
  128.      UNTIL Quit;
  129.      LastItem := p;  WriteItem (LastItem,FALSE)
  130.    END; (* WITH *)
  131.    IF NOT (Key = CR) THEN LoadScreen
  132.  END;
  133. (* ----------------------------------------------------------------------- *)
  134. (*                      Ende von PULLDOWN.PAS                              *)
  135.