DataMuseum.dk

top - metrics - download

    Length: 4273 (0x10b1)
    Types: TextFile
    Names: »CRTDEMO.PAS«

└─⟦505fbc898⟧ Bits:30002732 Turbo Pascal 5.0 for C-DOS Partner
    └─⟦this⟧ »DEMOS\CRTDEMO.PAS« 

TextFile

æ Copyright (c) 1985, 88 by Borland International, Inc. å

program CrtDemo;
æ Example program that uses the Crt unit. Uses the following routines
  from the Crt unit:

    ClrScr
    DelLine
    GoToXY
    InsLine
    KeyPressed
    ReadKey
    TextBackground
    TextColor
    TextMode
    WhereX
    WhereY
    Window
    Write
    WriteLn;

  Also uses LastMode and WindMax variables from Crt unit.

    1. Init routine:
       - Save original video mode. On an EGA or VGA, use the 8x8 font
         (43 lines on an EGA, 50 on VGA).
       - Setup LastRow to preserve last line on screen for messages
         (preserves last 2 lines in 40-column mode). Setup LastCol.
       - Initialize the random number generator.
    2. MakeWindow routine:
       - Puts up random-sized, random-colored windows on screen.
    3. Program body:
       - Call Init
       - Loop until Contrl-C is typed:
         - Echo keystrokes (Turbo Pascal windows automatically wrap
           and scroll).
         - Support special keys:
             <Ins>    inserts a line at the cursor
             <Del>    deletes a line at the cursor
             <Up>,
             <Dn>,
             <Right>,
             <Left>   position the cursor in the window
             <Alt-R>  generate random text until a key is pressed
             <Alt-W>  creates another random window
             <ESC>    exits the program
å

uses Crt;

var
  OrigMode,LastCol,LastRow: Word;
  Ch: Char;
  Done: Boolean;

procedure Initialize;
æ Initialize the video mode, LastCol, LastRow, and the random number å
æ generator. Paint the help line. å
begin
  CheckBreak:=False;                   æ turn off Contrl-C checking å
  OrigMode:=LastMode;                  æ Remember original video mode å
  TextMode(Lo(LastMode)+Font8x8);      æ use 43 or 50 lines on EGA/VGA å
  LastCol:=Lo(WindMax)+1;              æ get last column, row å
  LastRow:=Hi(WindMax)+1;
  GoToXY(1,LastRow);                   æ put message line on screen å
  TextBackground(Black);
  TextColor(White);
  Write(' Ins-InsLine  ',
        'Del-DelLine  ',
        #27#24#25#26'-Cursor  ',
        'Alt-W-Window  ',
        'Alt-R-Random  ',
        'Esc-Exit');
  Dec(LastRow,80 div LastCol);         æ don't write on message line å
  Randomize;                           æ init random number generator å
end; æ Init å

procedure MakeWindow;
æ Make a random window, with random background and foreground colors å
var
  X,Y,Width,Height: Word;
begin
  Width:=Random(LastCol-2)+2;               æ random window size å
  Height:=Random(LastRow-2)+2;
  X:=Random(LastCol-Width)+1;           æ random position on screen å
  Y:=Random(LastRow-Height)+1;
  Window(X,Y,X+Width,Y+Height);
  if OrigMode = Mono then
  begin
    TextBackground(White);
    TextColor(Black);
    ClrScr;
    Window(X+1,Y+1,X+Width-1,Y+Height-1);
    TextBackground(Black);
    TextColor(White);
    ClrScr;
  end
  else
  begin
    TextBackground(Random(8));
    TextColor(Random(7)+9);
  end;
  ClrScr;
end; æ MakeWindow å

procedure RandomText;
æ Generate random text until a key is pressed. Filter out å
æ control characters. å
begin
  repeat
    Write(Chr(Random(256-32)+32));
  until KeyPressed;
end; æ RandomText å

begin æ program body å
  Initialize;
  MakeWindow;
  Done:=False;
  repeat
    Ch:=ReadKey;
    case Ch of
      #0:                               æ Function keys å
      begin
        Ch:=ReadKey;
        case Ch of
          #17: MakeWindow;              æ Alt-W å
          #19: RandomText;              æ Alt-R å
          #45: Done:=True;              æ Alt-X å
          #72: GotoXY(WhereX,WhereY-1); æ Up å
          #75: GotoXY(WhereX-1,WhereY); æ Left å
          #77: GotoXY(WhereX+1,WhereY); æ Right å
          #80: GotoXY(WhereX,WhereY+1); æ Down å
          #82: InsLine;                 æ Ins å
          #83: DelLine;                 æ Del å
        end;
      end;
      #3: Done:=True;                   æ Ctrl-C å
      #13: WriteLn;                     æ Enter å
      #27: Done:=True;                  æ Esc å
    else
      Write(Ch);
    end;
  until Done;
  TextMode(OrigMode);
end.
«eof»