home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 09_10 / tricks / grwrite.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-31  |  4.8 KB  |  162 lines
  1. {$A+,B-,R-,S-,V-}
  2.  
  3. (* ------------------------------------------------------ *)
  4. (*                     GRWRITE.PAS                        *)
  5. (*                                                        *)
  6. (* Sprache : Turbo Pascal Version 5.50                    *)
  7. (*                                                        *)
  8. (* Macht WRITE bzw. WRITELN für den Grafikmodus nutzbar.  *)
  9. (* Ausgaben auf den Bildschirm können wie im Textmodus    *)
  10. (* vorgenommen werden. Zeichensatz, Rotation, Textgröße   *)
  11. (* werden berücksichtigt.                                 *)
  12. (*                                                        *)
  13. (* Anmerkung:                                             *)
  14. (*                                                        *)
  15. (* Der Cursor wird bei der Ausgabe nur dann in Schreib-   *)
  16. (* richtung versetzt, wenn                                *)
  17. (*                                                        *)
  18. (* a) der Text horizontal ausgegeben wird (SetTextStyle)  *)
  19. (*    und die horizontale Ausrichtung auf LeftText ge-    *)
  20. (*    setzt wurde (SetTextJustify), oder                  *)
  21. (*                                                        *)
  22. (* b) der Text vertikal ausgegeben wird (SetTextStyle)    *)
  23. (*    und die vertikale Ausrichtung auf BottomText ge-    *)
  24. (*    setzt wurde (SetTextJustify).                       *)
  25. (*                                                        *)
  26. (* D.h.: Die Ausgaben von mehreren hintereinanderfolgen-  *)
  27. (* den Write-Anweisungen (z.B: "Write('X'); Write('Y')")) *)
  28. (* erscheinen nur dann auch neben- bzw. untereinander auf *)
  29. (* dem Bildschirm, wenn a) oder b) zutrifft. Ansonsten    *)
  30. (* überschreibt die zweite Ausgabe die erste.             *)
  31. (*                                                        *)
  32. (*                                                        *)
  33. (*              1991       Ralf Homburg                   *)
  34. (* ------------------------------------------------------ *)
  35.  
  36.  
  37.  
  38. unit GRWRITE;
  39.  
  40.  
  41. interface
  42.  
  43.  
  44. uses
  45.   DOS,
  46.   Graph;
  47.  
  48.  
  49. const
  50.   HorizLineSpacing : byte = 2;  { Zeilenabstand bei hori-  }
  51.                                 { zontaler Ausgabe         }
  52.   VertLineSpacing  : byte = 2;  { Zeilenabstand bei verti- }
  53.                                 { kaler Ausgabe            }
  54.  
  55. procedure InstallGraphWrite;
  56.   { Installiert eine Treiberfunktion für die Standardaus-  }
  57.   { gabe zur Verwendung von WRITE(LN) im Grafikmodus.      }
  58.  
  59. procedure InstallCrtWrite;
  60.   { Installiert die normale Standardausgabe-Routine. Die   }
  61.   { Prozedur muß beim Verlassen des Grafikmodus aufgerufen }
  62.   { werden (auch wenn keine weiteren Ausgaben mehr erfol-  }
  63.   { gen!).                                                 }
  64.  
  65.  
  66. implementation
  67.  
  68.  
  69. var
  70.   OldOutputInOut : pointer;
  71.  
  72.  
  73. {$F+} function OutputInOut(var F:TextRec):integer; {$F-}
  74.  
  75. var
  76.   I        :integer;
  77.   St       :string;
  78.   Len      :byte absolute St;
  79.   TextInfo :TextSettingsType;
  80.   ViewPort :ViewPortType;
  81.  
  82. begin
  83.   Len := 0;
  84.   GetTextSettings(TextInfo);
  85.   with F do
  86.   begin
  87.     for I := 0 to BufPos-1 do
  88.       case byte(BufPtr^[I]) of
  89.         13: begin
  90.               if St <> '' then
  91.               begin
  92.                 OutText(St);
  93.                 St := '';
  94.               end;
  95.               if (TextInfo.Horiz = LeftText) and
  96.                  (TextInfo.Direction = HorizDir) then
  97.                 MoveTo(0,GetY)
  98.               else
  99.                 if (TextInfo.Direction = VertDir) and
  100.                    (TextInfo.Vert = BottomText) then
  101.                 begin
  102.                   GetViewSettings(ViewPort);
  103.                   MoveTo(GetX,ViewPort.Y2 -ViewPort.Y1);
  104.                 end;
  105.             end;
  106.         10: begin
  107.               if St <> '' then
  108.               begin
  109.                 OutText(St);
  110.                 St := '';
  111.               end;
  112.               if TextInfo.Direction = HorizDir then
  113.                 MoveRel(0,TextHeight('M') +HorizLineSpacing)
  114.               else
  115.                 MoveRel(TextWidth('M') +VertLineSpacing,0);
  116.             end;
  117.       else
  118.         begin
  119.           inc(Len);
  120.           St[Len] := char(BufPtr^[I]);
  121.         end;
  122.       end;
  123.     if St <> '' then
  124.     begin
  125.       OutText(St);
  126.       if (TextInfo.Direction = VertDir) and
  127.          (TextInfo.Vert = BottomText) then
  128.         MoveRel(0,-Len *TextHeight('M'));
  129.     end;
  130.     BufPos := 0;
  131.     BufEnd := 0;
  132.   end;
  133.   OutputInOut := 0;
  134. end;
  135.  
  136.  
  137. procedure InstallGraphWrite;
  138.  
  139. begin
  140.   with TextRec(Output) do
  141.   begin
  142.     InOutFunc := @OutputInOut;
  143.     FlushFunc := @OutputInOut;
  144.   end;
  145. end;
  146.  
  147.  
  148. procedure InstallCrtWrite;
  149.  
  150. begin
  151.   with TextRec(Output) do
  152.   begin
  153.     InOutFunc := OldOutputInOut;
  154.     FlushFunc := OldOutputInOut;
  155.   end;
  156. end;
  157.  
  158.  
  159. begin
  160.   OldOutputInOut := TextRec(Output).InOutFunc;
  161. end.
  162.