DP Tool Club 19/CD_ASCQ_19_010295.iso/dos/prg/pas/ktools/source/uimprim.pas

Pascal/Delphi Source File | 1994-10-31 | 15KB | 596 lines

Unit UIMPRIM;
{ Gestion de l'imprimante en mode texte }
{ Cette unité permet de gérer l'impression de textes avec des imprimantes
  IBM, Epson, DeskJet500, Canon BJ10E }
{ L'impression se fait avec marge, numérotation des pages et titre/entête.}
{ Des options permettent d'imprimer la date, les numéros de ligne et le
  nom du fichier. }
{ Pour obtenir un résultat correct dans la numération des pages, il
  faut indiquer une valeur correcte pour la variable HauteurPage qui est
  ici initialisée à 11 pouces, soit 66 lignes pour 6 lignes par pouces.
  Si la hauteur est donnée en nombre de lignes par page, il faut donc la
  diviser par 6. }

{ Kostrzewa Bruno }
{ septembre 1994 }

{$IFDEF debug}
 {$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
{$ELSE}
 {$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
{$ENDIF}

INTERFACE

Uses Printer,
     Dos;

Const
 { numéro maximal pour une imprimante }
 impMax     = 4;
 { numéros d'imprimantes }
 impASCII   = 0;    { pour toutes les imprimantes }
 impBJ10E   = 1;    { Canon BJ 10E }
 impIBM     = 2;    { émulation IBM }
 impEpson   = 3;    { émulation Epson }
 impDeskjet = 4;    { Deskjet 500 }

 { codes valables pour toutes les imprimantes }
 SautDeLigne = #$0D#$0A;
 SautDePage  = #$0C;

 { polices }
 pol10CPI = 0;      { 10 caractères par pouce }
 pol12CPI = 1;      { 12 caractères par pouce }
 pol17CPI = 2;      { 17 caractères par pouce }
 { interlignes }
 int8LPI  = 0;      { 8 lignes par pouce, interligne réduit }
 int6LPI  = 1;      { 6 lignes par pouce, interligne normal }
 { modefrappe }
 mBrouillon = 0;    { qualité brouillon }
 mCourrier  = 1;    { qualité courrier }

Const
 { nombre de codes gérés }
 NbCodes = 20;
 { numéros d'ordre }
 code10CPI            = 1;
 code12CPI            = 2;
 code17CPI            = 3;
 codeDoubleLargeur    = 4;
 codeFinDoubleLargeur = 5;
 code6LPI             = 6;
 code8LPI             = 7;
 codeBrouillon        = 8;
 codeCourrier         = 9;
 codeDoubleFrappe     = 10;
 codeFinDoubleFrappe  = 11;
 codeGras             = 12;
 codeFinGras          = 13;
 codeIndice           = 14;
 codeFinIndice        = 15;
 codeExposant         = 16;
 codeFinExposant      = 17;
 codeSouligne         = 18;
 codeFinSouligne      = 19;
 codeInit             = 20;

Type
 TCodeStr  = String[6];
 TImpCodes = array[1..NbCodes] of TCodeStr;

Const
 EpsonCodes:TImpCodes=
  (
   #18#27#80,         { code10CPI }
   #18#27#77,         { code12CPI }
   #18#27#80#15,      { code17CPI }
   #14,               { codeDoubleLargeur }
   #20,               { codeFinDoubleLargeur }
   #27#50,            { code6LPI }
   #27#48,            { code8LPI }
   #27#120#48,        { codeBrouillon }
   #27#120#49,        { codeCourrier }
   #27#71,            { codeDoubleFrappe }
   #27#72,            { codeFinDoubleFrappe }
   #27#69,            { codeGras }
   #27#70,            { codeFinGras }
   #27#83#49,         { codeIndice }
   #27#84,            { codeFinIndice }
   #27#83#48,         { codeExposant }
   #27#84,            { codeFinExposant }
   #27#45#49,         { codeSouligne }
   #27#45#48,         { codeFinSouligne }
   #27#64             { codeInit }
   );

 IBMCodes:TImpCodes=
  (
   #18 ,              { code10CPI }
   #18#27#58,         { code12CPI }
   #18#27#15,         { code17CPI }
   #14,               { codeDoubleLargeur }
   #20,               { codeFinDoubleLargeur }
   #27#50,            { code6LPI }
   #27#48,            { code8LPI }
   #27#73#0,          { codeBrouillon }
   #27#73#2,          { codeCourrier }
   #27#71,            { codeDoubleFrappe }
   #27#72,            { codeFinDoubleFrappe }
   #27#69,            { codeGras }
   #27#70,            { codeFinGras }
   #27#83#49,         { codeIndice }
   #27#84,            { codeFinIndice }
   #27#83#48,         { codeExposant }
   #27#84,            { codeFinExposant }
   #27#45#49,         { codeSouligne }
   #27#45#48,         { codeFinSouligne }
   #24                { codeInit }
   );

 DeskJetCodes:TImpCodes=
  (
   #27#40#115'10'#72,      { code10CPI }
   #27#40#115'12'#72,      { code12CPI }
   #27#40#115'17'#72,      { code17CPI }
   #27#40#115'5'#72,       { codeDoubleLargeur }
   #27#40#115'10'#72,      { codeFinDoubleLargeur }
   #27#38#108'6'#68,       { code6LPI }
   #27#38#108'8'#68,       { code8LPI }
   '',                     { codeBrouillon }
   '',                     { codeCourrier }
   '',                     { codeDoubleFrappe }
   '',                     { codeFinDoubleFrappe }
   #27#40#115#51#66,       { codeGras }
   #27#40#115#48#66,       { codeFinGras }
   '',                     { codeIndice }
   '',                     { codeFinIndice }
   '',                     { codeExposant }
   '',                     { codeFinExposant }
   #27#38#100#49#68,       { codeSouligne }
   #27#38#100#64,          { codeFinSouligne }
   #27#69                  { codeInit }
   );

Type
 TPrinterConfig=Record   { paramètres de configuration de l'imprimante }
  Police     : Byte;     { 10, 12 ou 17 CPI }
  Interligne : Byte;     { 6 ou 8 lignes par pouce }
  ModeFrappe : Byte;     { brouillon ou courrier }
  End;

 TPrinterFormat=Record   { choix d'impression }
  NomFichier : Boolean;
  NoLigne    : Boolean;
  Date       : Boolean;
  Titre      : String[30];
  End;

 TStr10=String[10];

Const
 CurConfig:TPrinterConfig=
      (Police     : 1;
       Interligne : 0;
       ModeFrappe : 0);

 PrinterFormat:TPrinterFormat=
      (NomFichier : false;
       NoLigne    : false;
       Date       : true;
       Titre      : '');

 { paramètres d'impression sous forme de constantes initialisées }
 HauteurPage    : Real    = 11;        { Hauteur de page en pouces }
 LargeurPage    : Real    = 8;         { Largeur de page en pouces }
 DeltaY         : Real    = 1/6;       { Espacement vertical }
 DeltaX         : Real    = 1/10;      { Espacement horizontal }
 PrintErrorFlag : Word    = 0;         { Indicateur d'erreurs }
 PrintFileName  : PathStr = '';        { Nom du fichier à imprimer }
 NumPrinter     : Byte    = impASCII;  { Imprimante sélectionnée }
 Marge          : Byte    = 6;         { Marge gauche }

Procedure NewLine;
{ passer à la ligne }

Procedure StartLine;
{ commencer une nouvelle ligne }

Procedure NewPage;
{ nouvelle page }

Procedure Page1;
{ première page }

Procedure PrintCode(S:String);
{ envoie une chaine de codes à l'imprimante sans tenir compte des problèmes
  de positionnement et décompte de lignes ou de pages }

Procedure PrintStr(S:String);
{ envoie une chaine de caractères en tenant compte des sauts de ligne et
  sauts de page }

Procedure PrintCar(Car:Char);
{ imprime un caractère en tenant compte des problèmes de sauts de ligne et
  sauts de page }

Function PrinterOK:Boolean;
{ teste si l'imprimante est prête }

Procedure PrintFile(NomDeFichier:PathStr);
{ impression d'un fichier texte }

Procedure StartPrint;
{ commence une impression }

Procedure EndPrint;
{ termine une impression }


IMPLEMENTATION

Var NumPage  : Integer;        { Numérotation de pages du texte }
    NumLigne : Integer;        { Numérotation de lignes du texte }
    XPage    : Real;           { abscisse dans la page }
    YPage    : Real;           { ordonnée dans la page }

{ utilitaires date }
Function Jour:TStr10;
{ retourne le nom du jour }
Var Year,Month,Day,DayOfWeek : Word;
Begin
 getdate(Year,Month,Day,DayOfWeek);
 case DayOfWeek of
   0: jour:= 'Dimanche';
   1: jour:= 'Lundi';
   2: jour:= 'Mardi';
   3: jour:= 'Mercredi';
   4: jour:= 'Jeudi';
   5: jour:= 'Vendredi';
   6: jour:= 'Samedi';
  end; { case }
End;

Function Date:TStr10;
{ retourne la date actuelle au format JJ.MM.AAAA }
Var Day,Month,Year,DayOfWeek : Word;
    S  : String;
    WS : TStr10;
Begin
 getdate(Year,Month,Day,DayOfWeek);
 str(Day:2,S);
 if S[1]=' ' then S[1]:='0';
 WS:=S+'.';
 str(Month:2,S);
 if S[1]=' ' then S[1]:='0';
 WS:=WS+S+'.';
 str(Year:4,S);
 WS:=WS+S;
 Date:=WS;
End;

{ utilitaire de transformation d'un entier en chaine de caractères }
Function IntToString(n:Longint):String;
Var S:String;
Begin
 Str(n,S);
 IntToString:=S;
End;

Function GetUserCode(num:Byte):TCodeStr;
Begin
 case NumPrinter of
  impBJ10E : GetUserCode:=IBMCodes[num];
  impIBM   : GetUserCode:=IBMCodes[num];
  impEpson : GetUserCode:=EpsonCodes[num];
  impDeskJet : GetUserCode:=DeskJetCodes[num];
  else GetUserCode:='';
  end;
End;

Procedure FixeInterLigne(num:Byte);
{ Interligne réduit (num=0) ou normal (num=1).                              }
Begin
 if (PrintErrorFlag<>0) or (NumPrinter=impASCII)
    then begin
          DeltaY:=1/6;
          exit;
         end;
 case num of
  0 : begin
       PrintCode(GetUserCode(code8LPI));
       DeltaY:=1/8;
      end;
  1 : begin
       PrintCode(GetUserCode(code6LPI));
       DeltaY:=1/6;
      end;
  end;
End;

Procedure FixePolice(NumPolice:Byte);
{ Fixe la police utilisée selon numpolice :      }
{     numpolice=0 donne 10cpi                    }
{     numpolice=1 donne 12cpi                    }
{     numpolice=2 donne 17cpi                    }
Begin
 if (PrintErrorFlag<>0) or (NumPrinter=impASCII)
    then begin
          DeltaX:=1/10;
          exit;
         end;
 case NumPolice of
  pol10CPI : begin
              PrintCode(GetUserCode(code10CPI));
              DeltaX:=1/10;
             end;
  pol12CPI : begin
              PrintCode(GetUserCode(code12CPI));
              DeltaX:=1/12;
             end;
  pol17CPI : begin
              PrintCode(GetUserCode(code17CPI));
              DeltaX:=1/17;
             end;
  end;
End;

Procedure DoubleLargeur(num:Byte);
{ num=0 pour finir et num=1 pour commencer }
Begin
 if (PrintErrorFlag<>0) or (NumPrinter=impASCII)
    then begin
          DeltaX:=1/10;
          exit;
         end;
 case num of
  0 : begin
       PrintCode(GetUserCode(codeFinDoubleLargeur));
       DeltaX:=1/10;
      end;
  1 : begin
       PrintCode(GetUserCode(codeDoubleLargeur));
       DeltaX:=2/10;
      end;
  end;
End;

Function PrinterOK:Boolean;
{ Vérifie si l'imprimante est prête et transmet le résultat True ou False. }
Var Reg:registers;
Begin
 Reg.ax:=$0200;
 Reg.dx:=0;
 intr($17,Reg);
 if Reg.ah=144
    then PrinterOk:=True
    else PrinterOk:=False;
End;

Procedure NewLine;
Begin
 if PrintErrorFlag<>0 then exit;
 YPage:=YPage+DeltaY;
 XPage:=0;
 if YPage >= HauteurPage  { changement de page ? }
    then NewPage
    else PrintCode(SautDeLigne);
End;

Procedure MargeVide;
Var i : Byte;
Begin
 if PrintErrorFlag<>0 then exit;
 for i:=1 to Marge do
  PrintCar(' ');
End;

Procedure StartLine;
{ commence une ligne de texte en mettant la marge ou le numéro de ligne }
Var S : String;
Begin
 if NumPrinter<>impASCII
    then FixePolice(pol10CPI);
 { numéro de ligne }
 Inc(NumLigne);
 if PrinterFormat.NoLigne
    then S:=IntToString(NumLigne)+' : '
    else S:='';
 if length(S)>Marge then S[0]:=chr(Marge);
 while length(S)< Marge do S:=' '+S;
 PrintStr(S);
 if NumPrinter<>impAscii
    then FixePolice(CurConfig.Police);
End;

Procedure NewPage;
{ commence une nouvelle page, sauf la première }
Var S : String;
Begin
 PrintCode(SautDePage);
 Inc(NumPage);
 YPage:=0;
 XPage:=0;
 FixePolice(pol10CPI);
 FixeInterligne(int6LPI);
 { passer une ligne }
 NewLine;
 MargeVide;
 { imprimer le titre }
 S:=PrinterFormat.Titre;
 while length(S)+Marge<60 do S:=S+' ';
 S:=S+ ' Page : '+IntToString(NumPage);
 PrintStr(S);
 NewLine;
 MargeVide;
 { tirer un trait }
 S:='';
 while length(S)+Marge<78 do S:=S+chr(196);
 PrintStr(S);
 NewLine;
 { reprendre la configuration choisie et passer une ligne }
 FixePolice(CurConfig.Police);
 FixeInterligne(CurConfig.Interligne);
 NewLine;
End;

Procedure Page1;
{ entête de la première page }
Var S : String;
Begin
 if PrintErrorFlag<>0 then exit;
 FixePolice(pol10CPI);
 FixeInterligne(int6LPI);
 YPage:=0;
 XPage:=0;
 { passer une ligne }
 NewLine;
 MargeVide;
 { titre en double largeur }
 if PrinterFormat.Titre <> ''
    then begin
          DoubleLargeur(1);
          PrintStr(PrinterFormat.Titre);
          DoubleLargeur(0);
          NewLine;
         end;
 NewLine;
 MargeVide;
 { nom de fichier }
 if PrinterFormat.NomFichier
    then begin
          S:='Nom du fichier : '+ PrintFileName;
          PrintStr(S);
          NewLine;
          MargeVide;
         end;
 { date d'impression }
 if PrinterFormat.Date
    then begin
          S:='Imprimé le     : '+jour+' '+Date;
          PrintStr(S);
          NewLine;
          MargeVide;
         end;
 { tirer un trait }
 S:='';
 While length(S)+Marge<78 do S:=S+chr(196);
 PrintStr(S);
 NewLine;
 { établir la configuration choisie et passer une ligne }
 FixePolice(CurConfig.Police);
 FixeInterligne(CurConfig.Interligne);
 NewLine;
 StartLine;
End;

Procedure PrintCode(S:String);
{ impression d'une chaine de caractères }
Begin
 if (S='') or (PrintErrorFlag<>0) then exit;
 {$I-}
 write(lst,S);
 {$I+}
 PrintErrorFlag:=IOResult;
End;

Procedure PrintCar(Car:Char);
{ impression d'un caractère avec prise en compte des retours chariots }
Begin
 if PrintErrorFlag<>0 then Exit;
 if XPage>LargeurPage
    then begin
          NewLine;
          MargeVide;
          PrintCode(car);
          XPage:=XPage+DeltaX;
         end;
 case Car of
  #10: begin
        NewLine;
        StartLine;
       end;
  #12: NewPage;
  #13: begin end;
  else begin
        PrintCode(car);
        XPage:=XPage+DeltaX;
       end;
  end;
End;

Procedure PrintStr(S:String);
{ imprime une chaine de caractères }
Var i : Byte;
Begin
 if (PrintErrorFlag<>0) or (S='') then exit;
 For i:=1 to length(S) do
  PrintCar(S[i]);
End;

Procedure StartPrint;
{ début d'impression }
Begin
 PrintCode(GetUserCode(codeInit));
 case CurConfig.ModeFrappe of
  mBrouillon : PrintCode(GetUserCode(codeBrouillon));
  mCourrier  : PrintCode(GetUserCode(codeCourrier));
  end;
 FixePolice(pol10CPI);
 FixeInterligne(int6LPI);
 NumPage:=1;
 NumLigne:=0;
 YPage:=0;
 XPage:=0;
 Page1;
End;

Procedure EndPrint;
{ fin d'impression }
Begin
 PrintCode(SautDePage);
 PrintCode(GetUserCode(codeInit));
End;

Procedure PrintFile(NomDeFichier:PathStr);
Var  f        : Text;           { Fichier texte }
     UneLigne : String;         { Une ligne de texte lue }
     N        : NameStr;
     D        : DirStr;
     E        : ExtStr;
     k        : Byte;
Begin
 if PrintErrorFlag<>0 then Exit;
 PrintFileName:=NomDeFichier;
 Assign(f,NomDeFichier);
 {$I-}
 Reset(f);    {Ouvrir le fichier}
 {$I+}
 PrintErrorFlag:=IOResult;
 FSplit(NomDeFichier,D,N,E);
 with PrinterFormat do
  begin
   Titre:=N+E;
   for k:=1 to length(Titre) do Titre[k]:=UpCase(Titre[k]);
   Date:=true;
   NomFichier:=false;
   NoLigne:=false;
  end;
 StartPrint;
 While (not Eof(f)) and (PrintErrorFlag=0) do
  begin
   Readln(f,UneLigne);
   PrintStr(UneLigne);
   NewLine;
   StartLine;
  end;
 {$I-}
 Close(f);
 {$I+}
 EndPrint;
End;

END.

{                        Fin du fichier UImprim.PAS                         }