home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 14 / drucker / druman.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-09-26  |  5.9 KB  |  208 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    DRUMAN.PAS                          *)
  3. (*      Druckermanager, speziell für Farbdrucker          *)
  4. (*        (c) 1988 by Karl Samanek und TOOLBOX            *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. {$R-,S-,I-,V-,B-}
  8. {$M 1024,0,0}
  9.  
  10. USES Dos, TSR, Crt;
  11.                 (* Unit TSR: siehe Pascal 6/7 1988, S.47  *)
  12.  
  13. TYPE  screentype = ARRAY [1..32000] OF BYTE;
  14.                 (* statt 32000 tun 16385 es auch,         *)
  15.                 (*        wenn man nur CGA Grafik benutzt *)
  16. CONST Hotkey     = $2500;             (* Auslöser : Alt-k *)
  17. VAR   fin,gm,a,b,
  18.       c,d,i,x,y  : INTEGER;
  19.       ch         : CHAR;
  20.       Code       : BYTE;
  21.       screen     : ^screentype;
  22.       savescreen : screentype;
  23.       videomode  : BYTE ABSOLUTE $0040:$0049;
  24.  
  25. {$F+}
  26.  
  27. PROCEDURE Druckermanager;
  28.  
  29. PROCEDURE ggm;         (* Alter Videomodus wird ermittelt *)
  30. VAR regs: registers;   (* und gesichert.                  *)
  31. BEGIN
  32.   regs.AH := $0F;
  33.   Intr (16,regs);
  34.   gm := regs.AL
  35. END;
  36.  
  37. PROCEDURE sgm;         (* Alter Videomodus wird wieder    *)
  38. VAR regs: registers;   (* hergestellt.                    *)
  39. BEGIN
  40.   regs.AL := gm;
  41.   regs.AH := 0;
  42.   Intr (16,regs);
  43. END;
  44.  
  45. Procedure sscreen;     (* Bildschirm wird gesichert       *)
  46. BEGIN
  47.   Move(screen^, savescreen, SizeOf(screentype));
  48. END;
  49.  
  50. PROCEDURE restorescreen;   (* Bildschirm wiederherstellen *)
  51. BEGIN
  52.   Move(savescreen, screen^, SizeOf(screentype));
  53. END;
  54.  
  55. PROCEDURE drawborder;
  56. BEGIN
  57.   ClrScr;
  58.   FOR i := 2 TO 78 DO BEGIN
  59.     GotoXY(i,2);
  60.     Write(#205);
  61.     GotoXY(i,24);
  62.     Write(#205);
  63.   END;
  64.   FOR i := 2 TO 24 DO BEGIN
  65.     GotoXY(2,i);
  66.     Write(#186);
  67.     GotoXY(78,i);
  68.     Write(#186);
  69.   END;
  70.   GotoXY(2,2);
  71.   Write(#201);
  72.   GotoXY(78,2);
  73.   Write(#187);
  74.   GotoXY(2,24);
  75.   Write(#200);
  76.   GotoXY(78,24);
  77.   Write(#188);
  78. END;
  79.  
  80. PROCEDURE writetable;
  81. BEGIN
  82.   GotoXY(15,8) ; Write('Prog.Ende');
  83.   GotoXY(15,9) ; Write('NLQ 1     ON');
  84.   GotoXY(15,10); Write('NLQ 2     ON');
  85.   GotoXY(15,11); Write('NLQ 3     ON');
  86.   GotoXY(15,12); Write('NLQ 4     ON');
  87.   GotoXY(15,13); Write('Sensor    ON');
  88.   GotoXY(15,14); Write('Condensed ON');
  89.   GotoXY(15,15); Write('Riesig    ON');
  90.   GotoXY(45,15); Write('Schwarz');
  91.   GotoXY(15,17); Write('Blau');
  92.   GotoXY(15,18); Write('Gelb');
  93.   GotoXY(15,19); Write('Grün');
  94.   GotoXY(45,8) ; Write('TESTAUSDRUCK');
  95.   GotoXY(45,9) ; Write('NLQ       OFF');
  96.   GotoXY(45,14); Write('Reset');
  97.   GotoXY(15,16); Write('ITALIC    ON');
  98.   GotoXY(45,12); Write('Italic    OFF');
  99.   GotoXY(45,13); Write('Sensor    OFF');
  100.   GotoXY(45,11); Write('Condensed OFF');
  101.   GotoXY(45,10); Write('Riesig    OFF');
  102.   GotoXY(45,16); Write('Rot');
  103.   GotoXY(45,17); Write('Violett');
  104.   GotoXY(45,18); Write('Orange');
  105.   GotoXY(20,5) ;
  106.   Write('Karls Druckermanager für Farbdrucker');
  107.   GotoXY(20,22);
  108.   Write('Auswahl mit Pfeiltasten, dann Enter');
  109.   GotoXY(45,19); Write('Prog.Ende');
  110. END;
  111.  
  112. PROCEDURE ende;
  113. BEGIN
  114.   ClrScr;
  115.   restorescreen;
  116. END;
  117.  
  118. PROCEDURE gkey;                        (* Tastaturabfrage *)
  119. BEGIN
  120.   IF y > 19 THEN y := 19;
  121.   IF y < 8  THEN y := 8 ;
  122.   IF x < 15 THEN x := 15;
  123.   IF x > 45 THEN x := 45;
  124.   GotoXY(x,y);
  125.   ch := ReadKey;
  126.   CASE ch OF
  127.     #72 : dec (y);
  128.     #80 : inc (y);
  129.     #75 : x := 15;
  130.     #77 : x := 45;
  131.     #13 : Exit;
  132.   END;
  133.   IF y > 19 THEN y := 19;
  134.   IF y < 8  THEN y := 8 ;
  135.   IF x < 15 THEN x := 15;
  136.   IF x > 45 THEN x := 45;
  137.   GotoXY(x,y);
  138.   gkey;
  139. END;
  140.  
  141. PROCEDURE checkexit;         (* Test, ob Programm beendet *)
  142. VAR Lst : Text;              (* werden soll               *)
  143. BEGIN
  144.   Assign(Lst,'Lpt1'); Rewrite(Lst);
  145.   IF (x+y) = 23  THEN fin := 13;     (* fin = 13 bedeutet *)
  146.   IF (x+y) = 64  THEN fin := 13;     (* Programmende      *)
  147.   IF (x+y) = 24  THEN Write(Lst,'((F))0');
  148.   IF (x+y) = 25  THEN Write(Lst,'((F))1');
  149.   IF (x+y) = 26  THEN Write(Lst,'((F))2');
  150.   IF (x+y) = 27  THEN Write(Lst,'((F))3');
  151.   IF (x+y) = 28  THEN Write(Lst,#27,'9');
  152.   IF (x+y) = 29  THEN Write(Lst,#15);
  153.   IF (x+y) = 30  THEN Write(Lst,'((S))3');
  154.   IF (x+y) = 60  THEN Write(Lst,'((C))0');
  155.   IF (x+y) = 32  THEN Write(Lst,'((C))2');
  156.   IF (x+y) = 33  THEN Write(Lst,'((C))4');
  157.   IF (x+y) = 34  THEN Write(Lst,'((C))6');
  158.   IF (x+y) = 53  THEN
  159.     WriteLn(Lst,'0123456789 ABCDEFG abcdefg ÄÖÜß äöüß');
  160.   IF (x+y) = 54  THEN Write(Lst,#27,'I',0);
  161.   IF (x+y) = 59  THEN Write(Lst,#27,'@');
  162.   IF (x+y) = 31  THEN Write(Lst,#28,'4');
  163.   IF (x+y) = 57  THEN Write(Lst,#28,'5');
  164.   IF (x+y) = 58  THEN Write(Lst,#27,'8');
  165.   IF (x+y) = 56  THEN Write(Lst,#18);
  166.   IF (x+y) = 55  THEN Write(Lst,'((S))0');
  167.   IF (x+y) = 61  THEN Write(Lst,'((C))1');
  168.   IF (x+y) = 62  THEN Write(Lst,'((C))3');
  169.   IF (x+y) = 63  THEN Write(Lst,'((C))5');
  170.   Close(Lst);
  171.   x := 15; y := 8;
  172.   GotoXY (15,8);
  173.   WriteLn(#7);
  174. END;
  175.  
  176. BEGIN                      (*  Hauptprogramm beginnt hier *)
  177.   sscreen;                 (*  Bildschirm retten          *)
  178.   ggm;                     (*  Alten Videomode retten     *)
  179.   TextMode(2);             (*  Textmodus setzen           *)
  180.   fin := 0;
  181.   drawborder;
  182.   writetable;
  183.   x := 15;  y := 8;
  184.   GotoXY (15,8);
  185.   WHILE fin <> 13 DO BEGIN
  186.     gkey;
  187.     checkexit;
  188.   END;
  189.   sgm;                   (* Alten Videomode setzen        *)
  190.   restorescreen;         (* Alten Bildschirm restaurieren *)
  191. END;                     (* Rücksprung zum Hauptprogramm  *)
  192.  
  193. {$F-}
  194.                     (* Hier beginnt der Installationsteil *)
  195. BEGIN
  196.   IF videomode = 7 THEN    (* CGA- oder Hercules-Karte ???*)
  197.     Screen := Ptr($B000,0)
  198.   ELSE
  199.     Screen := Ptr($B800,0);
  200.  ClrScr;
  201.  WriteLn('     Karls residenter Druckermanager ist ',
  202.          'installiert. Aufruf mit ALT-K');
  203.  MakeResident(@Druckermanager, Hotkey);
  204. END.
  205.  
  206. (* ------------------------------------------------------ *)
  207. (*                  Ende von DRUMAN.PAS                   *)
  208.