home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / JMICK11.ZIP / INTERWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-20  |  5.3 KB  |  205 lines
  1. Unit InterWin;
  2. { Interface window used as support for mickey mouse programs
  3.    INTERWIN revision history
  4.           v1.0  - Started November 21, 1989
  5.                   - First generation used by MICKEY v1.1
  6.  
  7. }
  8.  
  9. INTERFACE
  10. {$I MICKEY11.INC}
  11.   Procedure NiErrorWindow(TextMsg:StringVar); { Non Interactive ERROR window }
  12.   Function  YnErrorWindow(TextMsg:StringVar) : Boolean;
  13.                                     { Returns True for 'Yes' and False for 'no'}
  14.  
  15.  
  16. IMPLEMENTATION
  17. USES Crt,WritBox,Mouse;
  18.  
  19.  
  20. CONST
  21.   ROWSTART     = 6;
  22.   ROWEND       = 12;
  23.   COLSTART     = 6;
  24.   COLEND       = 50;
  25.   SCRSEG       = $B800;
  26.   SCROFF       = (ROWSTART-1)*160 + (COLSTART-1)*2;
  27.   TEXTROWSTART = 8;
  28.   TEXTCOLSTART = 7;
  29.   TEXTCOLEND   = 49;
  30.   TITLEROWSTART= 7;
  31.   TITLECOLSTART= 7;
  32.   TITLECOLEND  = 49;
  33.   CHROWSTART   = 9;
  34.   CHROWEND     = 11;
  35.   LCHCOLSTART  = 7;
  36.   LCHCOLEND    = 24;
  37.   RCHCOLSTART  = 32;
  38.   RCHCOLEND    = 49;
  39.   BOXCOLOR     = green;
  40.   BOXLEN       = 7;
  41.  
  42. Type
  43.   MchoiceLines = array [1..3] of StringVar;  { Mouse choices displayed }
  44.  
  45. Var
  46.   Box        : Array [1..BOXLEN] Of StringVar;
  47.   ScreenSave : Array [1..BOXLEN] of
  48.                array [1..(COLEND-COLSTART+1)] of Word;
  49.   OldTextAttr : Word;
  50.   OldMrow, OldMcol : Word;
  51.  
  52.  
  53. Procedure SaveScreen;
  54.   Var
  55.     I,O,L : Word;
  56.   Begin
  57.     GetTextMouseLocation(OldMrow,OldMcol);
  58.     O := SCROFF; { Start Here }
  59.     L := (COLEND-COLSTART+1)*2;
  60.     For I := 1 to BOXLEN do
  61.       begin
  62.         Move(Ptr(SCRSEG,O)^,ScreenSave[I],L);
  63.         Inc(O,160);  { Add to next area 80*2 }
  64.       end;
  65.     OldTextAttr := TextAttr;
  66.     TextAttr := BOXCOLOR;
  67.     WriteBox(BOX,BOXLEN,ROWSTART,COLSTART);
  68.   End;
  69.  
  70.  
  71. Procedure RestoreScreen;
  72.   Var
  73.     I,O,L : Word;
  74.   Begin
  75.     L := (COLEND-COLSTART+1)*2;
  76.     O := SCROFF;
  77.     For I := 1 to BOXLEN do
  78.       begin
  79.         Move(ScreenSave[I],Ptr(SCRSEG,O)^,L);
  80.         Inc(O,160);
  81.       end;
  82.     TextAttr := OldTextAttr;
  83.     SetTextMouseLocation(OldMrow,OldMcol);
  84.   End;
  85.  
  86.  
  87. Function StartCol(StartY, StrLen : Word) : Word;  { Centers string }
  88.   Begin
  89.     StartCol := ((COLEND-COLSTART+1) div 2) -
  90.                 (StrLen div 2) +
  91.                 (StartY - 1);
  92.   End;
  93.  
  94.  
  95. Procedure MouseChoices(Lines : MchoiceLines);
  96.   Begin
  97.     Box[4] := Lines[1];
  98.     Box[5] := Lines[2];
  99.     Box[6] := Lines[3];
  100.   End;
  101.  
  102.  
  103. Procedure WriteMsg(TextMsg : StringVar);
  104.   Var
  105.     OldColor : Word;
  106.     Wstart   : Word;
  107.   Begin
  108.     Wstart := StartCol(TEXTCOLSTART,Length(TextMsg));
  109.     GotoXY(Wstart,TEXTROWSTART);
  110.     OldColor := TextAttr;
  111.     TextAttr := BOXCOLOR;
  112.     WriteLn(TextMsg);
  113.     TextAttr := OldColor;
  114.   End;
  115.  
  116.  
  117.  
  118. Procedure NiErrorWindow(TextMsg : StringVar);
  119.   Const
  120.     ErrorTitle : StringVar = ' ERROR ';
  121.     SelectCh   : MchoiceLines = (
  122.                  '│          ░░░░░░░░░░░░░░░░░░░░░░           │',
  123.                  '│          ░░░░░░░Continue░░░░░░░           │',
  124.                  '│          ░░░░░░░░░░░░░░░░░░░░░░           │');
  125.     TitleColor = red;
  126.     DefaultRow = 10;
  127.     DefaultCol = 28;
  128.  
  129.   Var
  130.     TWriteStart : Word;
  131.     MWriteStart : Word;
  132.     Prs         : MouseButtons;
  133.   Begin
  134.     MouseChoices(SelectCh);      { Register screen def with possible choices }
  135.     SaveScreen;
  136.     TWriteStart := StartCol(TITLECOLSTART,Length(ErrorTitle));
  137.     GotoXY(TWriteStart,TITLEROWSTART);
  138.     TextAttr := TitleColor;
  139.     Write(ErrorTitle);
  140.     WriteMsg(TextMsg);
  141.     SetTextMouseLocation(DefaultRow,DefaultCol);
  142.     GotoXY(DefaultCol,DefaultRow);
  143.     Repeat
  144.       Prs := GetMouseButtonStatus;  { Get this }
  145.     Until Prs in [LeftPressed,RightPressed];
  146.     RestoreScreen;
  147.   End;
  148.  
  149.  
  150. Function YnErrorWindow(TextMsg : StringVar) : Boolean;
  151.   Const
  152.     SelectCh   : MchoiceLines = (
  153.                  '│░░░░░░░░░░░░░░░░░░       ░░░░░░░░░░░░░░░░░░│',
  154.                  '│░░░░░░░Yes░░░░░░░░       ░░░░░░░░░No░░░░░░░│',
  155.                  '│░░░░░░░░░░░░░░░░░░       ░░░░░░░░░░░░░░░░░░│');
  156.     CrowStart = 9;
  157.     CrowEnd   = 12;
  158.     YcolStart = 7;
  159.     YcolEnd   = 24;
  160.     NcolStart = 32;
  161.     NcolEnd   = 49;
  162.     DefRow    = 10;
  163.     DefCol    = 15;
  164.   Var
  165.     Prs  : MouseButtons;
  166.     R, C : Word;
  167.     L    : Byte;
  168.   Begin
  169.     MouseChoices(SelectCh);      { Register screen def with possible choices }
  170.     SaveScreen;
  171.     WriteMsg(TextMsg);
  172.     SetTextMouseLocation(DefRow,DefCol);
  173.     GotoXy(DefCol,DefRow);
  174.     Repeat
  175.       Repeat
  176.         Prs := GetMouseButtonStatus;
  177.       Until Prs in [LeftPressed,RightPressed];
  178.       GetTextMouseLocation(R,C);
  179.       If R in [CrowStart..CrowEnd]
  180.         then begin
  181.                case C of
  182.                  YcolStart..YcolEnd : L := 1;
  183.                  NcolStart..NcolEnd : L := 2;
  184.                else L := 0;
  185.                end;
  186.              end
  187.         else L := 0;
  188.     Until (L <> 0);
  189.     RestoreScreen;
  190.     YnErrorWindow := (L = 1);
  191.   End;
  192.  
  193.  
  194.  
  195.  
  196. Begin  { INTERWIN initialization }
  197.   Box[1] := '┌───────────────────────────────────────────┐';
  198.   Box[2] := '├───────────────────────────────────────────┤';
  199.   Box[3] := '│                                           │';
  200.   Box[4] := '│                                           │';
  201.   Box[5] := '│                                           │';
  202.   Box[6] := '│                                           │';
  203.   Box[7] := '└───────────────────────────────────────────┘';
  204. End.  { INTERWIN initialization }
  205.