home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 05 / tricks / togherc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-06  |  4.0 KB  |  150 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    TOGHERC.PAS                         *)
  3. (*                                                        *)
  4. (*        (c) 1988 by Dirk Bringmann und TOOLBOX          *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM TogHerc;
  7.  
  8. {$M $4000,0,$4000}                 (* 16k Stack, 16k Heap *)
  9.  
  10. USES Dos, Crt, Graph;
  11.  
  12. VAR OldExitProc: Pointer;
  13.  
  14. {$F+}                               (* far call erzwingen *)
  15. PROCEDURE MyExitProc;
  16. BEGIN
  17.   ExitProc := OldExitProc;
  18. END;
  19. {$F-}
  20.  
  21. CONST Weiter = '  // Weiter mit Taste // ';
  22.  
  23. VAR Wert       : ARRAY[0..1023] OF REAL;
  24.     Graph_Wert : ARRAY[0..1023] OF REAL;
  25.  
  26. PROCEDURE DB_Grafik;
  27.  
  28. VAR GraphDriver: INTEGER; (* Nummer des Grafik-Treibers   *)
  29.     GraphMode  : INTEGER; (* Grafik-Modus                 *)
  30.     MaxX, MaxY : WORD;    (* Bildschirm-Koordinaten       *)
  31.     ErrorCode  : INTEGER; (* für Grafik-Fehlercodes       *)
  32.     OldExitProc: Pointer;
  33.     MaxColor   : WORD;    (* Nummer der höchsten Farbe    *)
  34.  
  35. PROCEDURE Init_G;
  36. BEGIN
  37.   GraphDriver := Detect;
  38.   InitGraph(GraphDriver, GraphMode,'');
  39.   ErrorCode := GraphResult;
  40.   IF ErrorCode <> grOK THEN BEGIN
  41.     WriteLn('Grafikfehler ', GraphErrorMsg(ErrorCode));
  42.     Halt(1);
  43.   END;
  44.   MaxColor := GetMaxColor;
  45.   MaxX := GetMaxX - 2;
  46.   MaxY := GetMaxY;
  47. END;
  48.  
  49. FUNCTION Int2Str(L: LONGINT): STRING;
  50. VAR s: STRING;
  51. BEGIN
  52.   Str(L, s);
  53.   Int2Str := s;
  54. END;
  55.  
  56. PROCEDURE Rahmen;
  57. VAR ViewPort: ViewPortType;
  58. BEGIN
  59.   SetColor(MaxColor);
  60.   SetLineStyle(SolidLn, 0, NormWidth);
  61.   GetViewSettings(ViewPort);
  62.   WITH ViewPort DO
  63.     Rectangle(0, 0, x2-x1, y2-y1);
  64. END;
  65.  
  66. PROCEDURE Standard_Fenster(Ueberschrift: STRING);
  67. BEGIN
  68.   SetColor(MaxColor);
  69.   ClearDevice;
  70.   SetTextStyle(DefaultFont, HorizDir, 1);
  71.   SetTextJustify(CenterText, TopText);
  72.   SetViewPort(0, 0, MaxX, MaxY, ClipON);
  73.   OutTextXY(MaxX DIV 2, 2, Ueberschrift);
  74.   SetViewPort(0, TextHeight('M')+4, MaxX,
  75.                          MaxY-(TextHeight('M')+4), ClipOn);
  76.   Rahmen;
  77.   SetViewPort(1, TextHeight('M')+5, MaxX-1,
  78.                          MaxY-(TextHeight('M')+5), ClipOn);
  79. END;
  80.  
  81. PROCEDURE Warte_bis_Taste;
  82. VAR ch: CHAR;
  83. BEGIN
  84.   REPEAT UNTIL KeyPressed;
  85.   ch := ReadKey;
  86. END;
  87.  
  88. PROCEDURE Fuss_Zeile(Msg: STRING);
  89. BEGIN
  90.   SetViewPort(0, 0, MaxX, MaxY, ClipON);
  91.   SetColor(MaxColor);
  92.   SetTextStyle(DefaultFont, HorizDir, 1);
  93.   SetTextJustify(CenterText, TopText);
  94.   SetLineStyle(SolidLn, 0, NormWidth);
  95.   SetFillStyle(EmptyFill, 0);
  96.   Bar(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
  97.   Rectangle(0, MaxY-(TextHeight('M')+4), MaxX, MaxY);
  98.   OutTextXY(MaxX DIV 2, MaxY-(TextHeight('M')+2), Msg);
  99.   SetViewPort(1, TextHeight('M')+5, MaxX-1,
  100.                          MaxY-(TextHeight('M')+5), ClipOn);
  101.   Warte_bis_Taste;
  102. END;
  103.  
  104. PROCEDURE Linie;
  105. VAR i: INTEGER;
  106. BEGIN
  107.   SetTextStyle(DefaultFont, HorizDir, 3);
  108.   SetTextJustify(leftText, TopText);
  109.   FOR i := 1 TO 5 DO BEGIN
  110.     OutTextXY(    40*i, 60*i, 'Hallo ');
  111.     OutTextXY(200+40*i, 60*i, 'Hallo ');
  112.     OutTextXY(400+40*i, 60*i, 'Hallo ');
  113.   END;
  114.   Delay(1000);
  115.   ClearViewPort;
  116.   SetColor(MaxColor);
  117.   SetLineStyle(SolidLn, 0, NormWidth);
  118.   Line(5, 5, MaxX-10, MaxY-30);
  119.   Fuss_Zeile('Diagonale von links oben nach rechts unten '+
  120.              Weiter);
  121. END;
  122.  
  123. BEGIN
  124.   Init_G;
  125.   Standard_Fenster('...Das ist das Standard-Fenster...');
  126.   Fuss_Zeile('Hier DB_Grafik -- vor dem Aufruf von LINIE '+
  127.               Weiter);
  128.   Linie;
  129.   CloseGraph;
  130.   Exec('C:\DOS\MODE.EXE', 'MONO');
  131.   DirectVideo := FALSE;
  132.   IF DosError <> 0 THEN
  133.     WriteLn('-> S. 118/2 /// DOS-Error = ', DosError);
  134.   Write('Hier ist wieder MODE MONO eingestellt ! ');
  135.   ReadLn;
  136.   ClrScr;
  137. END;
  138.  
  139. BEGIN
  140.   DirectVideo := FALSE;
  141.   OldExitProc := ExitProc;
  142.   ExitProc := @MyExitProc;
  143.   ClrScr;
  144.   DB_Grafik;
  145.   WriteLn('Wieder im Hauptprogramm ');
  146. END.
  147.  
  148. (* ------------------------------------------------------ *)
  149. (*                Ende von TOGHERC.PAS                    *)
  150.