Fórum Toledo 9094 #339069

unit UTToledo;

interface

uses
  Dialogs, SysUtils, Classes, Controls;

  function AbrePorta(const Porta, BaudRate, DataBits, Paridade: Integer): Integer; StdCall; External ´P05.DLL´;
  function PegaPeso(const OpcaoEscrita: Integer; Peso, Local: Pchar): Integer; StdCall; external ´P05.DLL´;
  function FechaPorta: Integer; StdCall; External ´P05.dll´;

type
  TPorta = (prCOM1, prCOM2, prCOM3, prCOM4, prCOM5, prCOM6, prCOM7, prCOM8, prCOM9);
  TBaudRate = (br2400, br4800, br9600);
  TDataBits = (db7Bits, db8Bits);
  TParidade = (pdNenhuma, pdImpar, pdPar, pdEspaco);

  TToledo = class(TComponent)
  protected
    function GetWeight: Real;

  private
    FPorta: TPorta;
    FBaudRate: TBaudRate;
    FDataBits: TDataBits;
    FParidade: TParidade;
    procedure SetPorta(const Value: TPorta);
    procedure SetBaudRate(const Value: TBaudRate);
    procedure SetDataBits(const Value: TDataBits);
    procedure SetParidade(const Value: TParidade);
  public
    function PegarPeso: Real;
    function AbrirPorta: Integer;    
  published
    property Porta: TPorta read FPorta write SetPorta;
    property DataBits: TDataBits read FDataBits write SetDataBits;
    property Paridade: TParidade read FParidade write SetParidade;
    property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Anderson´, [TToledo]);
end;

{ TToledo }

function TToledo.AbrirPorta: Integer;
var
  iPorta: Byte;
  iBaudRate: Byte;
  iDataBits: Byte;
  iParidade: Byte;
begin
  case Porta of
    prCOM1 : iPorta := 1;
    prCOM2 : iPorta := 2;
    prCOM3 : iPorta := 3;
    prCOM4 : iPorta := 4;
    prCOM5 : iPorta := 5;
    prCOM6 : iPorta := 6;
    prCOM7 : iPorta := 7;
    prCOM8 : iPorta := 8;
    prCOM9 : iPorta := 9;
  else
    iPorta := 1;
  end;

  case BaudRate of
    br2400 : iBaudRate := 0;
    br4800 : iBaudRate := 1;
    br9600 : iBaudRate := 2;
  else
    iBaudRate := 2;  
  end;

  case DataBits of
    db7Bits : iDataBits := 0;
    db8Bits : iDataBits := 1;
  else
    iDataBits := 0;
  end;

  case Paridade of
    pdNenhuma : iParidade := 0;
    pdImpar   : iParidade := 1;
    pdPar     : iParidade := 2;
    pdEspaco  : iParidade := 3;
  else
    iParidade := 3;
  end;

  Result := AbrePorta(iPorta, iBaudRate, iDataBits, iParidade )
end;

function TToledo.GetWeight: Real;
begin
  Result := StrToFloatDef(InputBox(´Peso na balança´, ´Informe o peso´,´0´),0);
end;

function TToledo.PegarPeso: Real;
var
  Retorno: Integer;
  Peso: array[0..5]of char;
begin
  repeat
    Retorno := AbrirPorta;
    Result := 0;
    if Retorno <> 1 then
      MessageDlg(´Erro na abertura da porta COM da Balança!´,mtError,[mbOk],0)
    else
      begin
        Retorno := PegaPeso( 1, Peso, ´´ );
        if Retorno = 1 then
          begin
            Result  := StrToFloatDef(StrPas(Peso),0);
            Result  := Result/1000;
//            Break;
          end;
        FechaPorta();
      end;

    if (Result <= 0) or (Retorno <> 1) then
      begin
        if MessageDlg(´*** ERRO NA LEITURA DO PESO DA BALANÇA *** ´                  + #13 + 13 +
            ´O Sistema não conseguiu ler o peso da Balança.´                 + 13 +
            ´Você pode retirar o peso e colocar novamente para nova tenta-´  + 13 +
            ´tiva de leitura do peso da balança. Caso não consiga ler o peso´+ 13 +
            ´da balança, você poder  digitar o peso do produto.´             + 13 + 13 + 13 +
            ´[SIM] -> Para digitar o peso do produto´                        + 13 +
            ´[NÃO] -> Para nova tentativa de ler o peso na balança´,
            MtWarning,[mbYes,mbNo],0) = MrYes then
          begin
            Result := GetWeight();
            Break;
          end;//-- if MessageDlg(´*** ERRO ...
      end//-- if (Result <= 0) or (Retorno <> 1) then
    else
      begin
        Break;
      end;
  until False

end;

procedure TToledo.SetBaudRate(const Value: TBaudRate);
begin
  FBaudRate := Value;
end;

procedure TToledo.SetDataBits(const Value: TDataBits);
begin
  FDataBits := Value;
end;

procedure TToledo.SetParidade(const Value: TParidade);
begin
  FParidade := Value;
end;

procedure TToledo.SetPorta(const Value: TPorta);
begin
  FPorta := Value;
end;

end.