home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / menu / overdriv / drawbox.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-03  |  2.6 KB  |  100 lines
  1. UNIT DRAWBOX;
  2. INTERFACE
  3.  USES CRT,IOSTUFF;
  4.  PROCEDURE Box(VAR X,Y:Integer);
  5. IMPLEMENTATION
  6. {=================================================================}
  7. PROCEDURE Box(VAR X,Y:Integer);
  8. CONST
  9.       LeftArrow   = #75;
  10.       RightArrow  = #77;
  11.       UpArrow     = #72;
  12.       DownArrow   = #80;
  13.       EnterKey    = #13;
  14.       EscKey      = #27;
  15. VAR
  16.       ExitDrawBox : Boolean;
  17.       XL,YL       : Integer;
  18.       DrawCh      : Char;
  19.       FunctKey    : Boolean;
  20. {===========================================}
  21. FUNCTION Patch1(X,Y:Integer):Char;
  22. VAR
  23.      Temp : Integer;
  24. BEGIN
  25.      Temp := 0;
  26.      If X > 1 then If GetCh(X-1,Y) in ['═','╔','╠','╚','╦','╬','╩']
  27.                       then Temp := Temp + 1;
  28.      If Y > 1 then If GetCh(X,Y-1) in ['║','╔','╦','╗','╠','╬','╣']
  29.                       then Temp := Temp + 2;
  30.      If X < 80 then If GetCh(X+1,Y) in ['═','╦','╬','╩','╗','╣','╝']
  31.                        then Temp := Temp + 4;
  32.      If Y < 25 then If GetCh(X,Y+1) in ['║','╠','╬','╣','╚','╩','╝']
  33.                        then Temp := Temp + 8;
  34.  
  35.   Case Temp of
  36.      0: Patch1 := ' ';
  37.      1: Patch1 := '═';
  38.      2: Patch1 := '║';
  39.      3: Patch1 := '╝';
  40.      4: Patch1 := '═';
  41.      5: Patch1 := '═';
  42.      6: Patch1 := '╚';
  43.      7: Patch1 := '╩';
  44.      8: Patch1 := '║';
  45.      9: Patch1 := '╗';
  46.      10: Patch1 := '║';
  47.      11: Patch1 := '╣';
  48.      12: Patch1 := '╔';
  49.      13: Patch1 := '╦';
  50.      14: Patch1 := '╠';
  51.      15: Patch1 := '╬';
  52.      End; {case}
  53. End;
  54. {==========================================================}
  55. BEGIN
  56.     ExitDrawBox := False;
  57.     If (X < 1) or (X > 80) then X := 1;
  58.     If (Y < 1) or (Y > 25) then Y := 1;
  59.     XL := X; YL := Y;
  60. Repeat
  61.       GoToXY(X,Y);
  62.       DrawCh := ReadKey;
  63.       If DrawCh <> #0 then FunctKey := False
  64.       else Begin
  65.         DrawCh := ReadKey;
  66.         FunctKey := true;
  67.       End;
  68.  
  69.       If not FunctKey then Case DrawCh of
  70.  
  71.          EnterKey : ExitDrawBox := True;
  72.          EscKey   : ExitDrawBox := True;
  73.          else Beep;
  74.  
  75.        End; {case}
  76.  
  77.       If FunctKey then Case DrawCh of
  78.  
  79.          LeftArrow  : If X > 1 then X := X - 1 else Beep;
  80.          RightArrow : If X < 80 then X := X + 1 else Beep;
  81.          UpArrow    : If Y > 1 then Y := Y - 1 else Beep;
  82.          DownArrow  : If Y < 25 then Y := Y + 1 else Beep;
  83.          else Beep;
  84.  
  85.       End;{ of case DrawCh}
  86.  
  87.          HideCursor;
  88.          If Y <> YL then WriteCh('║',X,Y);
  89.          If X <> XL then WriteCh('═',X,Y);
  90.          WriteCh(Patch1(XL,YL),XL,YL);
  91.          WriteCh(Patch1(X,Y),X,Y);
  92.  
  93.          XL:=X; YL:=Y;
  94.          ShowCursor;
  95.  
  96.  Until ExitDrawBox;
  97.  
  98. END;
  99.  
  100. END.