home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / tiff / aus_crt.pas next >
Encoding:
Pascal/Delphi Source File  |  1990-06-15  |  3.5 KB  |  147 lines
  1. unit Aus_Crt;
  2. (* Gibt die PCL-Grafikdaten auf dem Bildschirm aus *)
  3.  
  4. interface
  5.  
  6. const MaxBuff  = 16000;  (* bietet viel Reserve für DIN A2 ... *)
  7. type BufferTyp = array[1..MaxBuff] of byte;
  8. var GrafikModus : boolean;
  9.  
  10. function B_to_Str(B_Param : boolean) : string;
  11. (* Hilfsfunktion für Fehlermeldungen etc. *)
  12.  
  13. function R_to_Str(R_Param : real) : string;
  14. (* Hilfsfunktion für Fehlermeldungen etc. *)
  15.  
  16. procedure Fehler(Meldung,Kennung: string);
  17. (* Gibt Fehlermeldungen aus *)
  18.  
  19. procedure AusgabeInit(Breite,Hoehe : integer;
  20.                       DateiName    : string;
  21.                       Aufloesung   : integer;
  22.                       Not_Used     : integer);
  23. (* Initialisiert die Werte für den Maßstab etc. *)
  24.  
  25. procedure AusgabeExit;
  26. (* Schaltet wieder auf Text um *)
  27.  
  28. procedure AusgabeDaten(Daten  : BufferTyp;
  29.                        Anzahl : integer;
  30.                        X_Pos  : integer;
  31.                        Y_Pos  : integer);
  32. (* Gibt eine Pixelzeile aus *)
  33.  
  34.  
  35. implementation
  36.  
  37. uses Crt, Graph;
  38.  
  39. var Max_X  : integer;
  40.     Max_Y  : integer;
  41.     Fak_X  : real;
  42.     Fak_Y  : real;
  43.     AnzPix : integer;
  44.  
  45. function B_to_Str(B_Param : boolean) : string;
  46. begin
  47.   if B_Param then B_to_Str := 'TRUE'
  48.   else B_to_Str := 'FALSE';
  49. end;
  50.  
  51. function R_to_Str(R_Param : real) : string;
  52. var R_Str : string;
  53. begin
  54.   if R_Param = int(R_Param) then str(R_Param:1:0,R_Str)
  55.   else str(R_Param:1:3,R_Str);
  56.   R_to_Str := R_Str;
  57. end;
  58.  
  59. procedure Fehler(Meldung,Kennung: string);
  60. begin
  61.   if GrafikModus then RestoreCRTMode;
  62.   writeln;
  63.   writeln('Fehler ',Meldung,': <',Kennung,'> [CR]');
  64.   readln;
  65.   if GrafikModus then SetGraphMode(GetGraphMode);
  66. end;
  67.  
  68. procedure AusgabeInit(Breite,Hoehe : integer;
  69.                       DateiName    : string;
  70.                       Aufloesung   : integer;
  71.                       Not_Used     : integer);
  72. var Treiber : integer;
  73.     Modus   : integer;
  74.     ErrorC  : integer;
  75. begin
  76.   DirectVideo := False;
  77.   Treiber := Detect;
  78.   InitGraph(Treiber,Modus,'D:\T55');
  79.   ErrorC := GraphResult;
  80.   if ErrorC <> 0 then
  81.   begin
  82.     Writeln('Grafikfehler : ', GraphErrorMsg(ErrorC));
  83.     Halt;
  84.   end;
  85.   GrafikModus := true;
  86.   Max_X := GetMaxX;
  87.   Max_Y := GetMaxY;
  88.   Fak_X := Max_X / Breite;
  89.   Fak_Y := Max_Y / Hoehe;
  90.   AnzPix := Aufloesung;
  91. end;
  92.  
  93. procedure AusgabeDaten(Daten  : BufferTyp;
  94.                        Anzahl : integer;
  95.                        X_Pos  : integer;
  96.                        Y_Pos  : integer);
  97. var Lauf : integer;
  98.     X_I  : integer;
  99.     D_B  : byte;
  100.  
  101.   procedure PaintByte(B : byte; X,Y,P : integer);
  102.   const Bits : array[0..7] of byte
  103.              = (128,64,32,16,8,4,2,1);
  104.   var P_X, P_Y : integer;
  105.       Lauf, PL : integer;
  106.   begin
  107.     if B > 0 then
  108.      for Lauf := 0 to 7 do
  109.     begin
  110.       if B and Bits[Lauf] > 0 then
  111.       begin
  112.         P_X := round((X + Lauf * P) * Fak_X);
  113.         P_Y := round(Y * Fak_Y);
  114.         for PL := 0 to pred(P)
  115.         do PutPixel(P_X + PL,P_Y,White);
  116.       end;
  117.     end;
  118.   end;
  119.  
  120.  
  121. begin
  122.   X_I := X_Pos;
  123.   for Lauf := 1 to Anzahl do
  124.   begin
  125.     D_B := Daten[Lauf];
  126.     if D_B > 0
  127.     then PaintByte(D_B,X_I,Y_Pos,AnzPix);
  128.     inc(X_I,8 * AnzPix);
  129.   end;
  130. end;
  131.  
  132. procedure AusgabeExit;
  133. begin
  134.   SetTextStyle(DefaultFont, HorizDir,1);
  135.   SetColor(Yellow);
  136.   OutTextXY(1,1,'Fertig');
  137.   readln;
  138.   CloseGraph;
  139.   GrafikModus := false;
  140. end;
  141.  
  142. begin (* Initialisierung der Unit *)
  143.   GrafikModus := false;
  144. end.
  145.  
  146. @bu = Diese Unit simuliert einen Laserdrucker am Bildschirm
  147.