home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / ldm / wrlddemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-02  |  3.0 KB  |  105 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   WRLDDEMO.PAS                         *)
  3. (*           Demonstration der Unit WORLD.PAS             *)
  4. (*           (C) 1991 Hagen Lehmann & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM WrldDemo;
  7.  
  8. {$IFDEF VER40 }
  9.   {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L- }
  10. {$ELSE}
  11.   {$A+,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V- }
  12. {$ENDIF}
  13. {$M 16384,0,655360 }
  14.  
  15. USES Crt, Graph, World, Dos;             { Reihenfolge !!! }
  16.  
  17. VAR
  18.   Driver, Mode : INTEGER;
  19.   Loop, Worlds : WORD;
  20.   Key          : CHAR;
  21.   DriverPath   : STRING;
  22.  
  23.   PROCEDURE DrawLines;
  24.   BEGIN
  25.     Rectangle(0, 0, 719, 347);
  26.     FOR Loop := 0 TO 72 DO
  27.       Line(Loop*10, 0, 719-Loop*10, Loop*5);
  28.   END;
  29.  
  30.   PROCEDURE DrawWorld;
  31.   BEGIN
  32.     Rectangle(0, 0, 719, 347);
  33.  
  34.     { W zeichnen }
  35.     MoveTo(60, 100);
  36.     LineRel( 20, 0); LineRel(0,  100);
  37.     LineRel( 20, 0); LineRel(0,  -20);
  38.     LineRel( 20, 0); LineRel(0,   20);
  39.     LineRel( 20, 0); LineRel(0, -100);
  40.     LineRel( 20, 0); LineRel(0,  140);
  41.     LineRel(-40, 0); LineRel(0,  -20);
  42.     LineRel(-20, 0); LineRel(0,   20);
  43.     LineRel(-40, 0); LineRel(0, -140);
  44.  
  45.     { O zeichnen }
  46.     Rectangle(180, 100, 280, 240);
  47.     Rectangle(200, 120, 260, 220);
  48.  
  49.     { R zeichnen }
  50.     MoveTo(300, 100);
  51.     LineRel(100,  0); LineRel(  0,  80);
  52.     LineRel(-60,  0); LineRel( 60,  40);
  53.     LineRel(  0, 20); LineRel(-20,   0);
  54.     LineRel(-60,-40); LineRel(  0,  40);
  55.     LineRel(-20,  0); LineRel(  0,-140);
  56.     Rectangle(320, 120, 380, 160);
  57.  
  58.     { L zeichnen }
  59.     MoveTo(420, 100);
  60.     LineRel(  20, 0); LineRel(0, 120);
  61.     LineRel(  80, 0); LineRel(0,  20);
  62.     LineRel(-100, 0); LineRel(0,-140);
  63.  
  64.     { D zeichnen }
  65.     MoveTo(540, 100);
  66.     LineRel( 80,   0); LineRel( 20,  20);
  67.     LineRel(  0, 100); LineRel(-20,  20);
  68.     LineRel(-80,   0); LineRel(  0,-140);
  69.     MoveTo(560, 120);
  70.     LineRel( 40,  0); LineRel( 20,  20);
  71.     LineRel(  0, 60); LineRel(-20,  20);
  72.     LineRel(-40,  0); LineRel(  0,-100);
  73.   END;
  74.  
  75.  
  76. BEGIN
  77.   ClrScr;
  78.   DriverPath := GetEnv('BGIPATH');
  79.   Driver     := Detect;
  80.   InitGraph(Driver, Mode, DriverPath);
  81.  
  82.   SetBkColor(1);
  83.   SetColor(14);
  84.  
  85.   GivenWorld(719, 347);    { Koordinaten sind von HERCULES }
  86.  
  87.   DefineWorld(1, 0, 0, GetMaxX,       GetMaxY,       TRUE);
  88.   DefineWorld(2, 0, 0, GetMaxX DIV 2, GetMaxY DIV 2, TRUE);
  89.   DefineWorld(3, GetMaxX DIV 2, 0, GetMaxX,
  90.                  GetMaxY DIV 2,TRUE);
  91.   DefineWorld(4, 0, GetMaxY DIV 2, GetMaxX, GetMaxY, TRUE);
  92.  
  93.   FOR Worlds := 1 TO 4 DO BEGIN
  94.                                { alle Welten durchspielen  }
  95.     SelectWorld(Worlds);       { jeweilige Welt übernehmen }
  96.     ClearWorld;                { Weltinhalt löschen        }
  97.     DrawLines;  { Linien mit Herculeskoordinaten zeichnen  }
  98.     DrawWorld;  { "WORLD" mit Herculeskoordinaten zeichnen }
  99.     Key := ReadKey;
  100.   END;
  101.   CloseGraph;
  102. END.
  103. (* ------------------------------------------------------ *)
  104. (*                Ende von WRLDDEMO.PAS                   *)
  105.