Impressao - imprimindo codigo de barras na impressora MECAF IM432T

// Imprimindo código de barras na impressora "MECAF IM432T"

// O componente CodBarra está mais abaixo no fonte

var

  CodBarra     : TMecafCodBarra;

begin

  CodBarra     := TMecafCodBarra.Create(Self);

  CodBarra.AbrePorta;

  // se existir o logo, imprime este, senão imprime o do parametro

  if FileExists('c:\logo.bmp') then CodBarra.ImprimeBitmap('c:\logo.bmp');

  // mensagem abaixo do logo

  CodBarra.ResetaFormatos;

  CodBarra.Imprime(AlinhaCentro(TiraAcentos(MensagemStr), 48));

  CodBarra.AvancaLinhas;

  // data e hora

  CodBarra.EnfatizadoOn;

  CodBarra.Imprime(AlinhaCentro(TiraAcentos(FormatDateTime('DDDD, DD "de" MMMM "de" YYYY, HH:NN:SS', Now)), 48));

  CodBarra.EnfatizadoOff;

  CodBarra.AvancaLinhas;

  // mensagem

  for I := 0 to Msg.Count-1 do CodBarra.Imprime(AlinhaCentro(TiraAcentos(Msg[I]),48));

  // codigo de barras

  CodBarra.AvancaLinhas;

  CodBarra.CodigoBarras(Codigo);

  // tabela de precos

  CodBarra.ResetaFormatos;

  if Livre then

  begin

    CodBarra.DuplaAltOn;

    CodBarra.ExpandidoOn;

    CodBarra.Imprime(AlinhaCentro('*** PASSAGEM LIVRE ***', 24));

    CodBarra.DuplaAltOff;

    CodBarra.ExpandidoOff;

    CodBarra.AvancaLinhas;

  end

  else

  begin

    CodBarra.AvancaLinhas;

    PrecosTb.First;

    while not PrecosTb.Eof do

    begin

      S := RepeteStr(#32, 9);

      if PrecosTbDe.asString = '00:00' then

        S := S + AlinhaEsq('ATE', 6) + '  '

      else

        S := S + AlinhaEsq(PrecosTbDe.asString, 6) + '- ';

      S := S + AlinhaEsq(PrecosTbAte.asString, 6) + ' = ';

      if PrecosTbValor.asFloat = 0 then

        S := S + ' LIVRE'

      else

        S := S + AlinhaDir(PrecosTbValor.asFloat, 6) + ' p/hora';

      CodBarra.Imprime(S);

      CodBarra.AvancaLinhas;

      PrecosTb.Next;

    end;

  end;

  // rodape

  if Rodape <> '' then

  begin

    CodBarra.ItalicoOn;

    CodBarra.AvancaLinhas;

    CodBarra.EnfatizadoOn;

    CodBarra.Imprime(AlinhaCentro(TiraAcentos(Rodape), 48));

    CodBarra.EnfatizadoOff;

    CodBarra.ItalicoOff;

  end;

  // imprime nossa propaganda

  CodBarra.CondensadoOn;

  CodBarra.Imprime(RepeteStr('-', 64));

  CodBarra.Imprime(AlinhaCentro('MARKET AUTOMACOES LTDA - (48) 436-1323 - www.market.com.br', 64));

  CodBarra.CondensadoOff;

  // finish him

  CodBarra.Cutter;

  CodBarra.FechaPorta;

  CodBarra.Free;

end;

{-----------------------------------------------------------------------------------------

  Componente feito por Flavio Junior.

  Utilizado para impressão de código de barras na impressora paralela MECAF IM432T

  PARALELA

  04 setembro 2003 - Born

        >\\\!/<

        !_"""_!

        (O) (o)

------ooo-----ooo------------------------------------------------------------------------}

unit MecafCodBarra;

interface

uses Classes, ARotinasUnit, Graphics, SysUtils, Math;

type

  TMecafCodBarra = class(TComponent)

  private

    FArq       : TextFile;

    FPorta     : string;

    // variaveis para setar os comandos de impressao

    ci_Linha   : string;

    ci_Cutter  : string;

    ci_AExpand : string;

    ci_DExpand : string;

    ci_AConden : string;

    ci_DConden : string;

    ci_Reset   : string;

    ci_AItalic : string;

    ci_DItalic : string;

    ci_AEnfat  : string;

    ci_DEnfat  : string;

    ci_CancelA : string;

    ci_ADuplaA : string;

    ci_DDuplaA : string;

    ci_CodBarra: string;

    ci_cbEAN13 : string;

    ci_cb2of5  : string;

    procedure SetPorta(const Value: string);

    procedure EnviaComando(const Comando: string);

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    // métodos publics para setar fontes/tamanhos/etc...

    procedure ExpandidoOn;

    procedure ExpandidoOff;

    procedure CondensadoOn;

    procedure CondensadoOff;

    procedure ItalicoOn;

    procedure ItalicoOff;

    procedure EnfatizadoOn;

    procedure EnfatizadoOff;

    procedure DuplaAltOn;

    procedure DuplaAltOff;

    procedure Cutter;

    procedure ResetaFormatos;

    procedure AvancaLinhas(Linhas: Integer = 1);

    procedure CodigoBarras(const Codigo: string);

    // métodos abrir/fechar porta

    procedure AbrePorta;

    procedure FechaPorta;

    procedure Imprime(const Texto: string);

    procedure ImprimeBitmap(const Arquivo: string);

  published

    property Porta: string read FPorta write SetPorta;

  end;

implementation

function BinToInt(const Value: string): LongInt;

var

  i,Size: Integer;

begin

   Result := 0;

   Size   := Length(Value);

   for i := (Size - 1) downto 0 do

     Result := Result + Trunc(StrToInt(Copy(Value, Size - i, 1)) * Power(2,I));

end;

constructor TMecafCodBarra.Create(AOwner: TComponent);

begin

  inherited;

  ci_Linha    := #10;       // avanco de linha...

  ci_Cutter   := #17;       // acionar guilhotinea

  ci_AExpand  := #14;       // ativa expandido

  ci_DExpand  := #20;       // desativa expandido

  ci_AConden  := #15;       // ativa condensado

  ci_DConden  := #18;       // desativa condensado

  ci_Reset    := #27'P';    // reseta tudo

  ci_AItalic  := #27'4';    // ativa italico

  ci_DItalic  := #27'5';    // desativa italico

  ci_AEnfat   := #27'E';    // ativa enfatizado

  ci_DEnfat   := #27'F';    // desativa enfatizado

  ci_CancelA  := #27'H';    // cancela todos os atributos de impressao

  ci_ADuplaA  := #27'd'#01; // ativa dupla altura

  ci_DDuplaA  := #27'd'#00; // ativa dupla altura

  ci_CodBarra := #27'|';    // codigo de barras (necessita mais parametros)

  ci_cbEAN13  := '0';       // EAN-13

  ci_cb2of5   := '1';       // Interleave 2 of 5

  FPorta      := 'LPT1';

end;

destructor TMecafCodBarra.Destroy;

begin

//  FechaPorta; // garante o fechamento da porta...

  inherited;

end;

procedure TMecafCodBarra.SetPorta(const Value: string);

begin

  FPorta := Value;

end;

///////////////////////////////////////////// Abre e fechar porta

procedure TMecafCodBarra.AbrePorta;

begin

  {$I-}

  AssignFile(FArq, FPorta);

  Rewrite(FArq);

  if IOResult <> 0 then;

  {$I+}

end;

procedure TMecafCodBarra.FechaPorta;

begin

  {$I-}

  CloseFile(FArq);

  if IOResult <> 0 then;

  {$I+}

end;

///////////////////////////////////////////// comandos de impressao

procedure TMecafCodBarra.Imprime(const Texto: string);

begin

  {$I-}

  Write(FArq, Texto);

  if IOResult <> 0 then

    msgErro('Erro ao imprimir "' + Texto + '" em ' + FPorta);

  {$I+}

end;

procedure TMecafCodBarra.EnviaComando(const Comando: string);

begin

  {$I-}

  Write(FArq, Comando);

  if IOResult <> 0 then

    msgErro('Erro ao imprimir em ' + FPorta);

  {$I+}

end;

procedure TMecafCodBarra.AvancaLinhas(Linhas: Integer = 1);

var

  I: Integer;

begin

  for I := 1 to Linhas do

    EnviaComando(ci_Linha);

end;

procedure TMecafCodBarra.CodigoBarras(const Codigo: string);

begin

//  EnviaComando(ci_CodBarra + ci_cbEAN13 + #150 + #4 + #2 + '789284080271'); EAN13

  EnviaComando(ci_CodBarra + ci_cb2of5 + #150 + #3 + #2 + Chr(Length(Codigo)) + Codigo);

end;

/////////////////////////////////////////////////////// condensado

procedure TMecafCodBarra.CondensadoOn;

begin

  EnviaComando(ci_AConden);

end;

procedure TMecafCodBarra.CondensadoOff;

begin

  EnviaComando(ci_DConden);

end;

/////////////////////////////////////////////////////// cutter

procedure TMecafCodBarra.Cutter;

begin

  EnviaComando(ci_Cutter);

end;

/////////////////////////////////////////////////////// dupla-altura

procedure TMecafCodBarra.DuplaAltOn;

begin

  EnviaComando(ci_ADuplaA);

end;

procedure TMecafCodBarra.DuplaAltOff;

begin

  EnviaComando(ci_DDuplaA);

end;

/////////////////////////////////////////////////////// enfatizado

procedure TMecafCodBarra.EnfatizadoOn;

begin

  EnviaComando(ci_AEnfat);

end;

procedure TMecafCodBarra.EnfatizadoOff;

begin

  EnviaComando(ci_DEnfat);

end;

/////////////////////////////////////////////////////// expandido

procedure TMecafCodBarra.ExpandidoOn;

begin

  EnviaComando(ci_AExpand);

end;

procedure TMecafCodBarra.ExpandidoOff;

begin

  EnviaComando(ci_DExpand);

end;

/////////////////////////////////////////////////////// italico

procedure TMecafCodBarra.ItalicoOn;

begin

  EnviaComando(ci_AItalic);

end;

procedure TMecafCodBarra.ItalicoOff;

begin

  EnviaComando(ci_DItalic);

end;

/////////////////////////////////////////////////////// imprime bitmap

procedure TMecafCodBarra.ImprimeBitmap(const Arquivo: string);

var

  B: TBitmap;

  S, St: string;

  Y, X, L: Integer;

begin

  msgInformaAbort(not FileExists(Arquivo), 'O arquivo ' + Arquivo + ' não encontrado!');

  B := TBitmap.Create;

  B.LoadFromFile(Arquivo);

  // a largura do bitmap = 288 e a altura deve ser multiplo de 8...

  if (B.Width = 288) and (B.Height mod 8 = 0) then

  begin

    EnviaComando(#27#51#24); // este comando coloca a "entre linha" = 0

    St := '';

    Y := 1;

    while Y <= b.Height do

    begin

      for X := 1 to b.Width do

      begin

        S := '';

        for L := Y to Y + 8 do

          if b.Canvas.Pixels[X, L] = clBlack then S := S + '1' else S := S + '0';

        St := St + Chr(BinToInt(S));

      end;

      EnviaComando(#27'Y' + Chr(Length(St)) + #1 + St);

      Inc(Y, 8);

      St := '';

    end;

    EnviaComando(#27'2'); // isso "reseta" o espacamento vertical (entre-linha)

  end

  else

  begin

    if (B.Width = 288) then

      msgErro('A altura da imagem deve ser múltiplo de`8'#13'A imagem: ' + Arquivo + #13 + 'tem ' + IntToStr(B.Height) + ' pixels')

    else

      msgErro('A imagem deve ter 288 pixels de largura'#13'A imagem: ' + Arquivo + #13 + 'tem ' + IntToStr(B.Width) + ' pixels');

  end;

  B.Free;

end;

/////////////////////////////////////////////////////// reseta os formatos de fonte

procedure TMecafCodBarra.ResetaFormatos;

begin

  EnviaComando(ci_Reset);

end;

end.