home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 22 / vsms / crtdemo.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-01-04  |  3.8 KB  |  115 lines
  1. (* ----------------------------------------------------- *)
  2. (*                      CRTDEMO.PAS                      *)
  3. (*                                                       *)
  4. (* Dieses Programm demonstriert den Gebrauch des Objekts *)
  5. (* "VSMCrt" anhand des neuimplementierten Demoprogramm   *)
  6. (* "CrtDemo" von Turbo Pascal. Die Unterschiede und Neu- *)
  7. (* heiten sind im Listing gekennzeichnet.                *)
  8. (*                                                       *)
  9. (*          (c) 1991 by R.Reichert & toolbox             *)
  10. (* ----------------------------------------------------- *)
  11. PROGRAM CrtDemo;
  12.  
  13. USES ScrObj, CrtVar;
  14.  
  15. VAR
  16.   { Textmodi-Variablen entfallen ohne Ersatz }
  17.   LastCol, LastRow : BYTE;
  18.   Ch               : CHAR;
  19.   Finished         : BOOLEAN;
  20.     { ^^^ ursprünglich "Done", des gleichnamigen Destruk-
  21.           tors wegen umgetauft.                           }
  22.  
  23. PROCEDURE Initialize;
  24. BEGIN
  25.   WITH Crt^ DO BEGIN      {<-- zur Benutzung ansprechen   }
  26.     SetCheckBreak (Off);  {<-- Set..., keine Varzuweisung }
  27.     LastCol := GetWinMaxX;{<-- Methoden liefern Werte,    }
  28.     LastRow := GetWinMaxY;{    auch hier keine Varzugriffe}
  29.     GotoXY (1, LastRow);
  30.     SetTextBackground (Black);    { <-- nochmals dasselbe }
  31.     SetTextColor (White);
  32.     Write (' Ins-InsLine  '+          { <-- aus dem Komma }
  33.            'Del-DelLine  '+           { wurde ein "Plus"  }
  34.            #27#24#25#26'-Cursor  '+
  35.            'Alt-W-Window  '+
  36.            'Alt-R-Random  '+
  37.            'Esc-Exit');
  38.     Dec (LastRow);
  39.     Randomize;
  40.   END;
  41. END;
  42.  
  43. PROCEDURE MakeWindow;
  44.   VAR
  45.     x1, y1, Width, Height : BYTE;
  46. BEGIN
  47.   WITH Crt^ DO BEGIN
  48.     Width :=Random (LastCol - 2) + 2;
  49.     Height:=Random (LastRow - 2) + 2;
  50.     x1 := Random (LastCol - Width) + 1;
  51.     y1 := Random (LastRow - Height) + 1;
  52.     Window(x1, y1, x1+Width, y1+Height);
  53.     SetTextBackground (White);
  54.     SetTextColor (Black);
  55.     ClrScr;
  56.     Window (Succ (x1), Succ (y1),
  57.             Pred (x1+Width), Pred (y1+Height));
  58.     SetTextBackground (Black);
  59.     SetTextColor (White);
  60.     ClrScr;
  61.   END;
  62. END;
  63.  
  64. PROCEDURE RandomText;
  65. BEGIN
  66.   REPEAT
  67.     Crt^.Write (Chr (Random (256-32)+32));
  68.   UNTIL Crt^.KeyPressed;
  69. END;
  70.  
  71. BEGIN
  72.   Crt := New (VSMCrtPtr,
  73.               Init (New (ScreenObjPtr, Init (0, 0))));
  74.     { ^^^ Crt muss angelegt werden }
  75.   Crt^.ClrScr;
  76.   Initialize;
  77.   MakeWindow;
  78.   Finished := False;
  79.   WITH Crt^ DO
  80.     REPEAT
  81.       Ch := ReadKey;
  82.       CASE Ch OF
  83.         #0 : BEGIN
  84.                Ch := ReadKey;
  85.                CASE Ch OF
  86.                  #17: MakeWindow;                { Alt-W  }
  87.                  #19: RandomText;                { Alt-R  }
  88.                  #45: Finished := True;          { Alt-X  }
  89.                  #72: GotoXY (WhereX, WhereY-1); { Up     }
  90.                  #75: GotoXY (WhereX-1, WhereY); { Left   }
  91.                  #77: GotoXY (WhereX+1, WhereY); { Right  }
  92.                  #80: GotoXY (WhereX, WhereY+1); { Down   }
  93.                  #82: InsLine;                   { Ins    }
  94.                  #83: DelLine                    { Del    }
  95.                END
  96.              END;
  97.         #3 : Finished := True;                   { Ctrl-C }
  98.         #13: WriteLn ('');                       { Enter  }
  99.          { ^^^ für Zeilenvorschub braucht es "Leerstring" }
  100.  
  101.         #27: Finished := True;                   { Esc    }
  102.       ELSE
  103.         Write (Ch);
  104.         { ^^^ ACHTUNG: Spezialzeichen wie BackTab werden
  105.                        ausgegeben ! (das wär' doch was
  106.                        für'n Erben!)                      }
  107.       END;
  108.     UNTIL Finished;
  109.   Crt^.ClrScr;
  110.   Crt^.Done;            { <-- aufräumen nicht vergessen ! }
  111. END.
  112. (* ----------------------------------------------------- *)
  113. (*                 Ende von CRTDEMO.PAS                  *)
  114. (* ----------------------------------------------------- *)
  115.