home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / pastrick / drawbox / drawbox.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-09  |  2.2 KB  |  81 lines
  1. (* ------------------------------------------------- *)
  2. (*                     DRAW_BOX.PAS                  *)
  3. (*       (C) 1991 Timo Becker & DMV-Verlag           *)
  4. (*              Sprache: Turbo Pascal                *)
  5. (*-------------------------------------------------- *)
  6.  
  7. PROGRAM Draw_Box;
  8.  
  9. USES Crt;
  10.  
  11. CONST 
  12.   VidPortMono  = $03B4;
  13.   VidPortColor = $03D4;
  14.  
  15. VAR  
  16.   Columns       : WORD ABSOLUTE $40:$4A;
  17.   PageMem       : WORD ABSOLUTE $40:$4C;
  18.   VidPort       : WORD ABSOLUTE $40:$63;
  19.   s             : WORD;
  20.   yo, yu, xl, xr: BYTE;
  21.  
  22. FUNCTION Ofs(x,y: BYTE): WORD;
  23. BEGIN
  24.   Ofs := (y - 1) * Columns * 2 + (x - 1) * 2;
  25. END;
  26.  
  27. PROCEDURE DrawBox(xli, yob, xre, yun: BYTE;
  28.                   Title: STRING; TitleAttr: BYTE);
  29. VAR 
  30.   SaveAttr, i: BYTE;
  31. BEGIN
  32.   MemW[s:Ofs(xli, yob)] := 201 OR TextAttr SHL 8;
  33.   MemW[s:Ofs(xre, yob)] := 187 OR TextAttr SHL 8;
  34.   MemW[s:Ofs(xli, yun)] := 200 OR TextAttr SHL 8;
  35.   MemW[s:Ofs(xre, yun)] := 188 OR TextAttr SHL 8;
  36.   FOR i := xli + 1 TO xre - 1 DO BEGIN
  37.     MemW[s:Ofs(i, yob)] := 205 OR TextAttr SHL 8;
  38.     MemW[s:Ofs(i, yun)] := 205 OR TextAttr SHL 8;
  39.   END;
  40.   FOR i := yob + 1 TO yun - 1 DO BEGIN
  41.     MemW[s:Ofs(xli, i)] := 186 OR TextAttr SHL 8;
  42.     MemW[s:Ofs(xre, i)] := 186 OR TextAttr SHL 8;
  43.   END;
  44.   Window(xli, yob, xre, yun);
  45.   IF (Title <> '') AND 
  46.      (xre - xli - 1 >= Length(Title) + 2) THEN BEGIN
  47.     SaveAttr := TextAttr;
  48.     TextAttr := TitleAttr;
  49.     GotoXY((xre - xli + 1 - Length(Title)) DIV 2, 1);
  50.     Write(' ', Title, ' ');
  51.     TextAttr := SaveAttr
  52.   END;
  53.   Window(xli + 1, yob + 1, xre - 1, yun - 1);
  54.   ClrScr;
  55. END;
  56.  
  57. BEGIN
  58.   IF VidPort = VidPortColor THEN s := $B800 
  59.                             ELSE s := $B000;
  60.   TextAttr := White;
  61.   REPEAT
  62.     yo := 1;
  63.     yu := PageMem DIV (Columns * 2);
  64.     xl := 1;
  65.     xr := Columns;
  66.     REPEAT
  67.       DrawBox(xl, yo, xr, yu, 'DrawBox', 
  68.               White OR Blue SHL 4);
  69.       Inc(yo); Dec(yu); Inc(xl); Dec(xr);
  70.       Delay(20)
  71.     UNTIL yo > yu;
  72.     Inc(TextAttr)
  73.   UNTIL KeyPressed;
  74.   Window(1, 1, 80, 25);
  75.   TextAttr := White;
  76.   ClrScr
  77. END.
  78.  
  79. (* ------------------------------------------------- *)
  80. (*              Ende von DRAW_BOX.PAS                *)
  81.