home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1200 / paperbgi.lzh / PASCAL / BEISPIEL / HPGLUTIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-28  |  4.5 KB  |  156 lines

  1. unit hpglutil;
  2.  
  3. {                       }
  4. { Copyright (C)   1990  }
  5. { Raimund Nisius        }
  6. { Software∙Entwicklung  }
  7. { Goethepark  13        }
  8. { 10627  Berlin         }
  9. {                       }
  10. { Diese Unit dürfen Sie Ihren eigenen Bedürfnissen anpassen. Sie dürfen }
  11. { den Quellcode nicht weitergeben!           }
  12.  
  13.  
  14. interface
  15.  
  16. uses
  17.     crt,
  18.     dos,
  19.     alloc,
  20.     params,
  21.     graph;
  22.  
  23.  
  24. procedure Plotter_Command(c : string);
  25. {
  26.   Übergibt den String c direkt an den Plotter.
  27.   Der String wird nicht interpretiert ! Sie sollten nur Befehle geben,
  28.   die mit den Turbo Graphikbefehlen nicht realisierbar sind. (z.B. 45°
  29.   Schrift)
  30. }
  31.  
  32. procedure serinit(comnr : integer); { Interaktiv die serielle Schnitstelle }
  33.                                     { initialisieren                       }
  34.  
  35.  
  36. implementation
  37.  
  38. procedure Plotter_Command(c : string);
  39. { Übergibt den String c direkt an den Plotter. Funktioniert nur wenn   }
  40. { die aktuelle Konfiguration.filehandle einen Wert > 0 hat! (d.h. der  }
  41. { HPGL-Treiber hat die Plotterausgabe eröffnet.)                       }
  42. { Der String wird nicht interpretiert ! Sie sollten nur Befehle geben, }
  43. { die mit den Turbo Graphikbefehlen nicht realisierbar sind. (z.B. 45° }
  44. { Schrift)                                                             }
  45.  
  46. var
  47.    regs :registers;
  48. var
  49.    hpgl_parameter : HPGL_Konfig_ptr;
  50.  
  51. begin
  52. hpgl_parameter := Treiber_konfiguration.plotter;
  53.  
  54. if hpgl_parameter^.filehandle <> 0 then { HPGL.BGI hat eine Ausgabe eröffnet.}
  55.    begin
  56.    regs.CX := length(c);                  { Stringlänge }
  57.    regs.DX := ofs(c[1]);                  { Stringadresse Offset  }
  58.    regs.DS := seg(c[1]);                  { Stringadresse Offset  }
  59.    regs.BX := hpgl_parameter^.filehandle;  { handle }
  60.    regs.AH := $40;                        { DOS Funktion write to file or device }
  61.    msdos(regs);                           { Enter DOS }
  62.    if (regs.Flags and 1) <> 0 then        { Carry Flag gesetzt -> Fehler }
  63.       begin
  64.       writeln('Direkter Befehl an Plotter hat nicht geklappt!');
  65.       writeln('DOS-Fehler ',regs.AX);
  66.       halt;
  67.       end;
  68.    end;
  69. end;
  70.  
  71. procedure serinit(comnr : integer); { Interaktiv die serielle Schnitstelle }
  72.                                     { initialisieren                       }
  73. var
  74.    regs      : registers;
  75.    baud      ,
  76.    parity    ,
  77.    stopbits  ,
  78.    datenbits ,
  79.    serkonfig : byte;
  80.    c         : char;
  81.    ypos      : byte;
  82.  
  83. type
  84.     string4 = string[4];
  85. const
  86.      baudname : array[1..8] of string4 = (
  87.                               ' 110',
  88.                               ' 150',
  89.                               ' 300',
  90.                               ' 600',
  91.                               '1200',
  92.                               '2400',
  93.                               '4800',
  94.                               '9600'
  95.                               );
  96.      pariname : array[0..3] of string4 = (
  97.                               'keine',
  98.                               ' Odd',
  99.                               'keine',
  100.                               'Even'
  101.                               );
  102. begin
  103. baud      := 8;
  104. parity    := 0;
  105. stopbits  := 1;
  106. datenbits := 8;
  107. ypos := wherey;
  108.  
  109. repeat
  110.    gotoxy(1,ypos);
  111.    clreol;
  112.    writeln('<B>audrate  ',baudname[baud]);
  113.    writeln('<P>arity    ',pariname[parity]);
  114.    writeln('<S>topbits  ',stopbits);
  115.    writeln('<D>atenbits ',datenbits);
  116.    writeln;
  117.    writeln('<O>k,  Schnittstelle initialisieren');
  118.    writeln('<Q>uit,Schnittstelle nicht initialisieren');
  119.    writeln;
  120.    writeln;
  121.    write('Bitte Tasten B,P,S,D,O oder Q drücken! ');
  122.    c := upcase(readkey);
  123.    case c of
  124.       'B' : begin
  125.             baud := 1 + baud mod 8;
  126.             end;
  127.       'P' : begin
  128.             parity := (1 + parity) mod 4;
  129.             end;
  130.       'S' : begin
  131.             stopbits := 1 + stopbits mod 2;
  132.             end;
  133.       'D' : begin
  134.             if datenbits = 7 then
  135.                datenbits := 8
  136.             else
  137.                datenbits := 7;
  138.             end;
  139.    end;  {case}
  140. until (c = 'O') or (c = 'Q');
  141. if c = 'O' then
  142.    begin
  143.    serkonfig := ((baud-1)     shl 5) +  { Konfigurationsbyte zusammenstellen }
  144.                 (parity       shl 3) +
  145.                 ((stopbits-1) shl 2) +
  146.                 2                    +
  147.                 ( (datenbits+1) and $1);
  148.    regs.ah := 0;           { INIT V24      }
  149.    regs.al := serkonfig;   { Initwerte     }
  150.    regs.dx := comnr-1;     { Schnittst. Nr.}
  151.    intr($14,regs);         { Interrupt     }
  152.    end;
  153. writeln;
  154. end;
  155. end.
  156.