Criando um tipo de dado Avançado em Delphi - Parte 3

Dando sequência a serie de artigos Criando um tipo de dado Avançado em Delphi (confira aqui a parte1 e a parte 2 ), vamos implementar dois tipos numéricos: o TEAMDouble e o TEAMInteger (o nome é sugestivo) . Estes tipos vão nos ajudar  a trabalhar com os tipos inteiro e Double.

Abra o Delphi (neste artigo fora utilizado o Delphi 2007) e adicione uma nova unit e salve-a como untTEAMNumeric:

  Adicione os dois tipos a seguir:

unit untTEAMNumeric;

interface

uses SysUtils, Math, Graphics, Classes, UniTEAMString, WinTypes;

type

  TEAMDouble = record
    Value: Double;
  end;

  TEAMInteger = record
    Value: Integer;
  end;

implementation

end.

O campo "Value" nos dois records ira armazenar o conteúdo do nosso dado para que possamos aplicar as operações. Repare no uses a unit untTEAMNumeric, iremos usar o tipo TEAMString em alguns campos. veja a listagem:

 

TEAMDouble = record
    Value: Double;
    function Arredonda(inCasas: Integer): Double;
    function Trunca(inCasas: Integer): Double;
    function CalcularPercentual(Percent: Real): real;
    function CalculaProporcao(Valor: Real): Real;
    procedure CodigoBarras(Imagem: TCanvas);
    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function ToExtenco: TEAMString;
    function ToExtencoReais: TEAMString;
    function ToReias: TEAMString;
    procedure ADD(valor: Double);
    procedure inc;
    procedure Dec;
    procedure Clear;
    procedure Eval(Num: string);
  end;

  TEAMInteger = record
    Value: Integer;
    function ToString: TEAMString;
    function ToExtenco: TEAMString;
    procedure inc;
    procedure ADD(valor: integer);
    function NextValue: integer;
    function PriorValue: integer;
    procedure Dec;
    procedure Clear;
  end;

Retornar um TCSTString nos dara mais flexibilidade como veremos mais adiante. O próximo passo é a implementação dos métodos.
Veja a listagem completa da nossa unit:

unit untTEAMNumeric;

interface

uses SysUtils, Math, Graphics, Classes, untTEAMString, WinTypes;

type

  TEAMDouble = record
    Value: Double;
    function Arredonda(inCasas: Integer): Double;
    function Trunca(inCasas: Integer): Double;
    function CalcularPercentual(Percent: Real): real;
    function CalculaProporcao(Valor: Real): Real;
    procedure CodigoBarras(Imagem: TCanvas);
    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function ToExtenco: TEAMString;
    function ToExtencoReais: TEAMString;
    function ToReias: TEAMString;
    procedure ADD(valor: Double);
    procedure inc;
    procedure Dec;
    procedure Clear;
    procedure Eval(Num: string);
  end;

  TEAMInteger = record
    Value: Integer;
    function ToString: TEAMString;
    function ToExtenco: TEAMString;
    procedure inc;
    procedure ADD(valor: integer);
    function NextValue: integer;
    function PriorValue: integer;
    procedure Dec;
    procedure Clear;
  end;
implementation

resourcestring
  strNumeroForaIntervalo = 'TEAMDouble: O valor está fora do intervalo' +
    ' permitido.';

const
  Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco', 'Seis', 'Sete', 'Oito', 'Nove');
  Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze', 'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');
  Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta', 'Sessenta', 'Setenta', 'Oitenta', 'Noventa');
  Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos', 'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');
  MoedaSigular = 'Real';
  MoedaPlural = 'Reais';
  CentSingular = 'Centavo';
  CentPlural = 'Centavos';
  Zero = 'Zero';

  { TEAMDouble }

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ADD
  Arguments: valor: Double
  Result:    None
  Objetivo:  Adicioonar um valor
-------------------------------------------------------------------------------}

procedure TEAMDouble.ADD(valor: Double);
begin
  Self.Value := Self.Value + valor;
end;
{-------------------------------------------------------------------------------
    Procedure: TEAMDouble.Arredonda
    Arguments: inCasas: Integer
    Result:    Double
    Objetivo:  Arrendondar o valor de accordo com o numero de casas decimais
  -------------------------------------------------------------------------------}

function TEAMDouble.Arredonda(inCasas: Integer): Double;
var
  stValor: string;
  dlValor: Double;
begin
  dlValor := Value + (5 * Power(10, -(inCasas + 1)));
  stValor := Floattostr(dlValor);
  if pos(',', stvalor) = 0 then
    stValor := stValor + ',';
  stvalor := stvalor + '0000';
  stValor := Copy(stValor, 1, pos(',', stValor) + inCasas);
  Result := StrToFloat(stValor);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.CalculaProporcao
  Arguments: Valor: Real
  Result:    Real
  Objetivo:  Calcular a proporção do valor no numero passado
-------------------------------------------------------------------------------}

function TEAMDouble.CalculaProporcao(Valor: Real): Real;
begin
  Result := ((Self.Value * 100) / Valor);
end;

{-------------------------------------------------------------------------------
 Procedure: TEAMDouble.CalcularPercentual
 Arguments: Percent: Real
 Result:    real
 Objetivo:  Calcular o percent do
-------------------------------------------------------------------------------}

function TEAMDouble.CalcularPercentual(Percent: Real): real;
begin
  percent := percent / 100;
  result := value * Percent;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Clear
  Arguments: None
  Result:    None
  Objetivo:  inicializa  valor
-------------------------------------------------------------------------------}

procedure TEAMDouble.Clear;
begin
  Self.Value := 0;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.CodigoBarras
  Arguments: var Imagem: TCanvas
  Result:    None
  Objetivo:  Gerar o código de Barras do valor passado
-------------------------------------------------------------------------------}

procedure TEAMDouble.CodigoBarras(Imagem: TCanvas);
const
  digitos: array['0'..'9'] of string[5] = ('00110', '10001', '01001', '11000',
    '00101', '10100', '01100', '00011', '10010', '01010');
var
  s, codigo: string;
  i, j, x, t: Integer;
begin
  codigo := Self.ToString.Text;
  // Gerar o valor para desenhar o código de barras
  // Caracter de início
  s := '0000';
  for i := 1 to length(codigo) div 2 do
    for j := 1 to 5 do
      s := s + Copy(Digitos[codigo[i * 2 - 1]], j, 1) + Copy(Digitos[codigo[i * 2]], j, 1);
  // Caracter de fim
  s := s + '100';
  // Desenhar em um objeto canvas
  // Configurar os parâmetros iniciais
  x := 0;
  // Pintar o fundo do código de branco
  Imagem.Brush.Color := clWhite;
  Imagem.Pen.Color := clWhite;
  Imagem.Rectangle(0, 0, 2000, 79);
  // Definir as cores da caneta
  Imagem.Brush.Color := clBlack;
  Imagem.Pen.Color := clBlack;
  // Escrever o código de barras no canvas
  for i := 1 to length(s) do
  begin
    // Definir a espessura da barra
    t := strToInt(s[i]) * 2 + 1;
    // Imprimir apenas barra sim barra não (preto/branco - intercalado);
    if i mod 2 = 1 then
      Imagem.Rectangle(x, 0, x + t, 79);
    // Passar para a próxima barra
    x := x + t;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Dec
  Arguments: None
  Result:    None
  Objetivo:  Decementa o valor em 1
-------------------------------------------------------------------------------}

procedure TEAMDouble.Dec;
begin
  self.Value := Self.Value - 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Eval
  Arguments: Num: string
  Result:    None
  Objetivo:  Converte uma string para um double
-------------------------------------------------------------------------------}

procedure TEAMDouble.Eval(Num: string);
begin
  if Trim(num) <> '' then
    Self.Value := StrToFloat(Num)
  else
    self.value := 0;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.inc
  Arguments: None
  Result:    None
  Objetivo:  Incrementa o valor
-------------------------------------------------------------------------------}

procedure TEAMDouble.inc;
begin
  self.Value := Self.Value + 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para extenço
-------------------------------------------------------------------------------}

function TEAMDouble.ToExtenco: TEAMString;
var
  Texto, Milhar, Centena, Centavos: string;

  function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: string): string;
  begin
    if Expressao then
      Result := CasoVerdadeiro
    else
      Result := CasoFalso;
  end;

  function MiniExtenso(trio: string): string;
  var
    Unidade, Dezena, Centena: string;
  begin
    Unidade := '';
    Dezena := '';
    Centena := '';
    if (trio[2] = '1') and (trio[3] <> '0') then
    begin
      Unidade := Dez[strtoint(trio[3])];
      Dezena := '';
    end
    else
    begin
      if trio[2] <> '0' then
        Dezena := Dezenas[strtoint(trio[2])];
      if trio[3] <> '0' then
        Unidade := Unidades[strtoint(trio[3])];
    end;
    if (trio[1] = '1') and (Unidade = '') and (Dezena = '') then
      Centena := 'Cem'
    else if trio[1] <> '0' then
      Centena := Centenas[strtoint(trio[1])]
    else
      Centena := '';
    Result := Centena + ifs((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '')
      + Dezena + ifs((Dezena <> '') and (Unidade <> ''), ' e ', '') + Unidade;
  end;

begin
  if (self.value > 999999.99) or (self.value < 0) then
  begin
    raise Exception.Create(strNumeroForaIntervalo);
  end;
  if self.value = 0 then
  begin
    Result.Text := '';
    Exit;
  end;
  Texto := formatfloat('000000.00', self.value);
  Milhar := MiniExtenso(Copy(Texto, 1, 3));
  Centena := MiniExtenso(Copy(Texto, 4, 3));
  Centavos := MiniExtenso('0' + Copy(Texto, 8, 2));
  Result.Text := Milhar;
  if Milhar <> '' then
  begin
    Result.Text := Result.Text + ' Mil ';
  end;
  if (((copy(texto, 4, 2) = '00') and (Milhar <> '') and (copy(texto, 6, 1) <> '0'))) or (centavos = '') and (milhar <> '') then
    Result.Text := Result.Text + ' e ';
  if (Milhar + Centena <> '') then
    Result.Text := Result.Text + Centena;

  if Centavos = '' then
  begin
    Exit;
  end
  else
  begin
    if Milhar + Centena = '' then
      Result.Text := Centavos
    else
      Result.Text := Result.Text + ' e ' + Centavos;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToExtencoReais
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para extenço em reais
-------------------------------------------------------------------------------}

function TEAMDouble.ToExtencoReais: TEAMString;
var
  Texto, Milhar, Centena, Centavos: string;
  ////////////////////////////////fucao auxiliar extenso////////////////////////////////
  function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: string): string;
  begin
    if Expressao then
      Result := CasoVerdadeiro
    else
      Result := CasoFalso;
  end;
  ////////////////////////////funcao auxiliar extenso/////////////////////////
  function MiniExtenso(trio: string): string;
  var
    Unidade, Dezena, Centena: string;
  begin
    Unidade := '';
    Dezena := '';
    Centena := '';
    if (trio[2] = '1') and (trio[3] <> '0') then
    begin
      Unidade := Dez[strtoint(trio[3])];
      Dezena := '';
    end
    else
    begin
      if trio[2] <> '0' then
        Dezena := Dezenas[strtoint(trio[2])];
      if trio[3] <> '0' then
        Unidade := Unidades[strtoint(trio[3])];
    end;
    if (trio[1] = '1') and (Unidade = '') and (Dezena = '') then
      Centena := 'Cem'
    else if trio[1] <> '0' then
      Centena := Centenas[strtoint(trio[1])]
    else
      Centena := '';
    Result := Centena + ifs((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '')
      + Dezena + ifs((Dezena <> '') and (Unidade <> ''), ' e ', '') + Unidade;
  end;

begin
  if (self.value > 999999.99) or (self.value < 0) then
  begin
    raise Exception.Create(strNumeroForaIntervalo);
  end;
  if self.value = 0 then
  begin
    Result.Text := '';
    Exit;
  end;
  Texto := formatfloat('000000.00', self.value);
  Milhar := MiniExtenso(Copy(Texto, 1, 3));
  Centena := MiniExtenso(Copy(Texto, 4, 3));
  Centavos := MiniExtenso('0' + Copy(Texto, 8, 2));
  Result.Text := Milhar;
  if Milhar <> '' then
  begin
    if copy(texto, 4, 3) = '000' then
      Result.Text := Result.Text + ' Mil Reais'
    else
      Result.Text := Result.Text + ' Mil ';
  end;
  if (((copy(texto, 4, 2) = '00') and (Milhar <> '') and (copy(texto, 6, 1) <> '0'))) or (centavos = '') and (milhar <> '') then
    Result.Text := Result.Text + ' e ';
  if (Milhar + Centena <> '') then
    Result.Text := Result.Text + Centena;
  if (Milhar = '') and (copy(texto, 4, 3) = '001') then
    Result.Text := Result.Text + ' Real'
  else if (copy(texto, 4, 3) <> '000') then
    Result.Text := Result.Text + ' Reais';
  if Centavos = '' then
  begin
    Result.Text := Result.Text + '.';
    Exit;
  end
  else
  begin
    if Milhar + Centena = '' then
      Result.Text := Centavos
    else
      Result.Text := Result.Text + ' e ' + Centavos;
  end;
  if (copy(texto, 8, 2) = '01') and (Centavos <> '') then
    Result.Text := Result.Text + ' Centavo.'
  else
    Result.Text := Result.Text + ' Centavos.';

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToReias
  Arguments: None
  Result:    TEAMString
  Objetivo:  Formata o valor para dinheiro
-------------------------------------------------------------------------------}

function TEAMDouble.ToReias: TEAMString;
begin
  Result.Text := FormatFloat('R$ 0.,00', Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToString
  Arguments: None
  Result:    string
  Objetivo:  Converter para no formato para ser garvado no  sqlsrever
-------------------------------------------------------------------------------}

function TEAMDouble.ToSqlServerFormat: TEAMString;
var
  Aux: TEAMString;
begin
  Aux.Text := FloatToStr(Self.Value);
  Result.Text := Aux.ReplaceChar(',', '.');
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o Valor para uma string
-------------------------------------------------------------------------------}

function TEAMDouble.ToString: TEAMString;
begin
  Result.Text := FloatToStr(Self.Value);
end;
{-------------------------------------------------------------------------------
  Procedure: TEAMDouble.Trunca
  Arguments: inCasas: Integer
  Result:    Double
  Objetivo:  Truncar o valor com determinado numero de casas decimais
-------------------------------------------------------------------------------}

function TEAMDouble.Trunca(inCasas: Integer): Double;
var
  stValor: string;
begin
  stValor := Floattostr(Value);
  if pos(',', stvalor) = 0 then
    stValor := stValor + ',';
  stvalor := stvalor + '0000';
  stValor := Copy(stValor, 1, pos(',', stValor) + inCasas);
  Result := StrToFloat(stValor);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.ADD
  Arguments: valor: integer
  Result:    None
  Objetivo:  Incrementa o valor  em 1
-------------------------------------------------------------------------------}

procedure TEAMInteger.ADD(valor: integer);
begin
  Self.Value := self.Value + valor;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.Clear
  Arguments: None
  Result:    None
  Objetivo:  Apaga o conteudo
-------------------------------------------------------------------------------}

procedure TEAMInteger.Clear;
begin
  Self.Value := 0;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.Dec
  Arguments: None
  Result:    None
  Objetivo:  Decrementa o valor em 1
-------------------------------------------------------------------------------}

procedure TEAMInteger.Dec;
begin
  Self.Value := Self.Value - 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.inc
  Arguments: None
  Result:    None
  Objetivo:  incrementa o valor em 1
-------------------------------------------------------------------------------}

procedure TEAMInteger.inc;
begin
  Self.Value := Self.Value + 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.NextValue
  Arguments: None
  Result:    integer
  Objetivo:  Retorna qual será o próximo valor
-------------------------------------------------------------------------------}

function TEAMInteger.NextValue: integer;
begin
  Result := self.Value + 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.PriorValue
  Arguments: None
  Result:    integer
  Objetivo:  Retorna qual será o valor anterior
-------------------------------------------------------------------------------}

function TEAMInteger.PriorValue: integer;
begin
  result := self.value - 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para extenço
-------------------------------------------------------------------------------}

function TEAMInteger.ToExtenco: TEAMString;
var
  Num: TEAMDouble;
begin
  Num.Value := Self.Value;
  Result := Num.ToExtenco;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMInteger.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte o valor para string
-------------------------------------------------------------------------------}

function TEAMInteger.ToString: TEAMString;
begin
  Result.Text := IntToStr(Self.Value);
end;

end.

Vamos aos teste: adicione alguns edits e um botão como abaixo

Adicione a unit untTEAMNumeric ao formulário:

unit untTEAMNumeric;

No ovento onClick do botão escreva o seguinte código:

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMDouble:TEAMDouble;
  EAMInteger:TEAMInteger;
begin
 EAMDouble.Value := 99.989;
 EAMInteger.Value := 88;

  edtValorDouble.Text := EAMDouble.ToString.Text;
  edtArredonda.Text := FloatToStr(EAMDouble.Arredonda(1));
  edtTrunca.Text := FloatToStr(EAMDouble.Trunca(2));
  edtSqlServerFormat.Text := EAMDouble.ToSqlServerFormat.Text;
  edtExtencoReias.Text := EAMDouble.ToExtencoReais.Text;
  edtCalculaPercentual.Text := FloatToStr(EAMDouble.CalcularPercentual(50));

  edtValorInteger.Text := EAMInteger.ToString.Text;
  edtToString.Text := EAMInteger.ToString.Text;
  edtPriorValue.Text := IntToStr(EAMInteger.PriorValue);
  edtNextValue.Text := IntToStr(EAMInteger.NextValue);
  edtToExtencoInteger.Text := EAMInteger.ToExtenco.Text;


end;

Execute e confira o resultado:

Adicionar o tipo TEAMString nos novos tipos que criamos, nos fez poupar algum tempo nas conversões dos dados, isso sem mencionar que poderíamos realizar outras operações como realizar um hash.
Como exemplo adicone mais 2 edits no formulário de teste e o seguinte código no evento onClick do botão :

edtHashInteger.Text := EAMInteger.ToString.Hash;
 edtHashDouble.Text := EAMDouble.ToString.Hash;

Execute e confira o resultado:

Todos os métodos da listagem foram documentados para facilitar o entendimento da sua finalidade. Fique a vontade para adicionar novos métodos e procedures. :)

Observação: Algumas das procedure e functions usadas neste artigo são uma compilação de códigos encontrados na internet. se você econtrar aqui algum código de sua autoria, entre em contato para que possamos dar-lhe o devido crédito.

Confira aqui o próximo post