home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / tricks / prtunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-09-07  |  4.5 KB  |  171 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    PRTUNIT.PAS                         *)
  3. (*     Druckersteuerung außerhalb des Sourcecodes         *)
  4. (*      (C) 1989  Klaus Leonhardt  &  TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. UNIT PrtUnit;
  7.  
  8. INTERFACE USES Printer;
  9.  
  10. CONST
  11.   DefFileName = 'PRINTER.DEF';
  12.  
  13. TYPE
  14.   string50 = STRING[50];
  15.  
  16. VAR
  17.   pname       : STRING[20];
  18.   preset      : STRING[20];
  19.   nlq, notnlq : STRING[20];
  20.   underl      : STRING[20];
  21.   notunderl   : STRING[20];
  22.   gross       : STRING[20];
  23.   notgross    : STRING[20];
  24.   bold        : STRING[20];
  25.   notbold     : STRING[20];
  26.   super       : STRING[20];
  27.   sub         : STRING[20];
  28.   cancelsu    : STRING[20];
  29.   linehi      : STRING[20];
  30.  
  31.   PROCEDURE ChangePrt(codewort : string50);
  32.   { Code ist Hexcode für Druckereinstellungen              }
  33.   { Variablen s.o. enthalten nach korrekter Initialisierung}
  34.   { den Code. Dieser wird der externen ASCII-Datei         }
  35.   { PRINTER.DEF entnommen. Ohne PRINTER.DEF wird           }
  36.   { pname := 'noname' gesetzt.                             }
  37.  
  38.   PROCEDURE ChangePrtPlus(codewort : string50; p : BYTE);
  39.   { sendet Printercode und Parameter an den Drucker        }
  40.  
  41. IMPLEMENTATION
  42.  
  43. VAR
  44.   ok        : BOOLEAN;
  45.   deffile   : TEXT;
  46.   temp      : STRING[50];
  47.   shorttemp : STRING[20];
  48.   i, j      : BYTE;
  49.  
  50.   FUNCTION Convert(ch : CHAR) : BYTE;
  51.  
  52.   BEGIN
  53.     ch := UpCase(ch);
  54.     CASE ch OF
  55.       'A' :  Convert := 10;
  56.       'B' :  Convert := 11;
  57.       'C' :  Convert := 12;
  58.       'D' :  Convert := 13;
  59.       'E' :  Convert := 14;
  60.       'F' :  Convert := 15;
  61.     ELSE
  62.       Convert := Ord(ch) - 48;
  63.     END;
  64.   END;
  65.  
  66.   PROCEDURE ChangePrt(codewort : string50);
  67.   TYPE
  68.     setchtyp = SET OF CHAR;
  69.   VAR
  70.     l,i      : BYTE;
  71.     code     : BYTE;
  72.     ch, hich,
  73.     loch     : CHAR;
  74.     setch    : setchtyp;
  75.     flag     : BOOLEAN;
  76.   BEGIN
  77.     setch := ['0'..'9', 'A'..'F', 'a'..'f'];
  78.     i := 1;
  79.     l := Length(codewort);
  80.     WHILE i < l DO BEGIN
  81.       flag := FALSE;
  82.       REPEAT
  83.         hich := codewort[i];
  84.         Inc(i);
  85.       UNTIL hich IN setch;
  86.       IF ((i< l) AND (hich IN setch)) THEN flag := TRUE;
  87.       loch := codewort[i];
  88.       Inc(i);
  89.       IF loch IN setch THEN BEGIN
  90.         code := 16*Convert(hich) + Convert(loch);
  91.       END ELSE BEGIN
  92.         code := Convert(hich);
  93.       END;
  94.       IF flag THEN Write(LST, Chr(code));
  95.     END;
  96.   END;
  97.  
  98.   PROCEDURE ChangePrtPlus(codewort : string50; p : BYTE);
  99.   TYPE
  100.     setchtyp = SET OF CHAR;
  101.   VAR
  102.     l,i      : BYTE;
  103.     code     : BYTE;
  104.     ch, hich,
  105.     loch     : CHAR;
  106.     setch    : setchtyp;
  107.     flag     : BOOLEAN;
  108.   BEGIN
  109.     setch := ['0'..'9', 'A'..'F', 'a'..'f'];
  110.     i := 1;
  111.     l := Length(codewort);
  112.     WHILE i < l DO BEGIN
  113.       flag := FALSE;
  114.       REPEAT
  115.         hich := codewort[i];
  116.         Inc(i);
  117.       UNTIL hich IN setch;
  118.       IF ((i< l) AND (hich IN setch)) THEN flag := TRUE;
  119.       loch := codewort[i];
  120.       Inc(i);
  121.       IF loch IN setch THEN BEGIN
  122.         code := 16*Convert(hich) + Convert(loch);
  123.       END ELSE BEGIN
  124.         code := Convert(hich);
  125.       END;
  126.       IF flag THEN Write(LST, Chr(code));
  127.     END;
  128.     Write(LST, Chr(p));
  129.   END; { OF codeparam}
  130.  
  131. BEGIN
  132.   j := 0;
  133.   Assign(deffile, deffilename);
  134. {$I-}
  135.   Reset(deffile);
  136. {$I+};
  137.   ok := (IOResult = 0);
  138.   IF ok THEN BEGIN
  139.     WHILE NOT Eof(deffile) DO BEGIN
  140.       temp := '';
  141.       shorttemp := '';
  142.       ReadLn(deffile, temp);
  143.       FOR i:=1 TO Length(temp) DO BEGIN
  144.         shorttemp := shorttemp + temp[i];
  145.         IF temp[i] = ';' THEN i := Length(temp);
  146.       END;
  147.       Inc(j);          { zählt die übergebenen Steuercodes }
  148.       CASE j OF
  149.         1  :  pname     := shorttemp;
  150.         2  :  preset    := shorttemp;
  151.         3  :  nlq       := shorttemp;
  152.         4  :  notnlq    := shorttemp;
  153.         5  :  underl    := shorttemp;
  154.         6  :  notunderl := shorttemp;
  155.         7  :  gross     := shorttemp;
  156.         8  :  notgross  := shorttemp;
  157.         9  :  bold      := shorttemp;
  158.         10 :  notbold   := shorttemp;
  159.         11 :  super     := shorttemp;
  160.         12 :  sub       := shorttemp;
  161.         13 :  cancelsu  := shorttemp;
  162.         14 :  linehi    := shorttemp;
  163.       END;
  164.     END;
  165.     Close(deffile);
  166.   END ELSE
  167.     pname := 'noname'
  168. END.
  169. (* ------------------------------------------------------ *)
  170. (*                Ende von PRTUNIT.PAS                    *)
  171.