Є & V: Criando um tipo de dado Avançado em Delphi

Dando sequência a serie de artigos Criando um tipo de dado Avançado em Delphi (confira aqui a parte1 a parte 2 e a parte 3 ), iremos implementar hoje a unit untTEAMDateTime que ira conter os tipos para se trabalhar com Date, Time e DateTime.

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

Adicione os tipos a seguir:

unit untTEAMDateTime;

interface

uses untTEAMString, untTEAMNumeric, DateUtils, SysUtils, Controls;

type

{$REGION 'TCSTDate '}

TCSTDate = record
  public
    Value: TDateTime;  

  end;

{$ENDREGION}

{$REGION 'TCSTTime'}

  TEAMTime = record
  public
    Value: TDateTime;  
  end;

{$ENDREGION}

implementation

end.

O campo "Value" nos dois records ira armazenar o conteúdo do nosso dado para que possamos aplicar as operações.
Como fizemos na unit untTEAMNumeric, vamos aproveitar aqui também os tipos TEAMString da untTEAMString e o TEAMInteger da untTEAMNumeric em alguns métodos. Vamos a listagem:

$REGION ' TEAMDate'}
  TEAMDate = record
  public
    Value: TDateTime;

    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function Date: TDate;
    function Formatar(Formato: string): TEAMString;
    function ToExtenco: TEAMString;
    function MesToExtenco: TEAMString;
    function DiaDaSemanaExtenco: TEAMString;
    function GetDia: TEAMinteger;
    function GetMes: TEAMinteger;
    function GetAno: TEAMinteger;
    function GetDiaSemana: TEAMinteger;
    function GetPrimeiroDiaMes: TEAMinteger;
    function GetUltimoDiaMes: TEAMinteger;
    procedure ADDMes(Meses: Integer);
    function DiasNoMes: TEAMinteger;
    function isAnoBiSexto: Boolean;
    function isFimDeSemana: Boolean;
    function INDates(DataInicial, DataFinal: Tdate): Boolean;
    procedure AddDias(NumDias: Integer);
    procedure SubDias(NumDias: Integer);
    procedure Encode(Dia, mes, ano: Word);
    procedure EncodeFromString(Data: string);
    procedure ReplaceTimer;
    procedure SetDateNow;

  end;
{$ENDREGION}

{$REGION ' TEAMTime'}
  TEAMTime = record
  public
    Value: TDateTime;
    function ToString: TEAMString;
    function DataHoraString: TEAMString;
    function Formatar(Formato: string): TEAMString;
    function GetHora: TEAMString;
    function GetMinutos: TEAMString;
    function GetSegundos: TEAMString;
    function ToExtenco: TEAMString;
    function ToMinutos: Integer;
  end;
{$ENDREGION}

A maioria dos métodos para Data/Hora estão presentes. Alguns muitos úteis como retornar o último dia do mês, adicionar dias a data, verificar se a data é final de semana, etc. Sinta-se a vontade para adicionar outros que achar nescessário. O próximo passo é a implementação dos métodos.
Veja a listagem completa da nossa unit:

unit untTEAMDateTime;

interface

uses untTEAMString, untTEAMNumeric, DateUtils, SysUtils, Controls;

type
{$REGION ' TEAMDate'}
  TEAMDate = record
  public
    Value: TDateTime;

    function ToString: TEAMString;
    function ToSqlServerFormat: TEAMString;
    function Date: TDate;
    function Formatar(Formato: string): TEAMString;
    function ToExtenco: TEAMString;
    function MesToExtenco: TEAMString;
    function DiaDaSemanaExtenco: TEAMString;
    function GetDia: TEAMinteger;
    function GetMes: TEAMinteger;
    function GetAno: TEAMinteger;
    function GetDiaSemana: TEAMinteger;
    function GetPrimeiroDiaMes: TEAMinteger;
    function GetUltimoDiaMes: TEAMinteger;
    procedure ADDMes(Meses: Integer);
    function DiasNoMes: TEAMinteger;
    function isAnoBiSexto: Boolean;
    function isFimDeSemana: Boolean;
    function INDates(DataInicial, DataFinal: Tdate): Boolean;
    procedure AddDias(NumDias: Integer);
    procedure SubDias(NumDias: Integer);
    procedure Encode(Dia, mes, ano: Word);
    procedure EncodeFromString(Data: string);
    procedure ReplaceTimer;
    procedure SetDateNow;

  end;
{$ENDREGION}

{$REGION ' TEAMTime'}
  TEAMTime = record
  public
    Value: TDateTime;
    function ToString: TEAMString;
    function DataHoraString: TEAMString;
    function Formatar(Formato: string): TEAMString;
    function GetHora: TEAMString;
    function GetMinutos: TEAMString;
    function GetSegundos: TEAMString;
    function ToExtenco: TEAMString;
    function ToMinutos: Integer;
  end;
{$ENDREGION}

implementation

{$REGION 'TEAMDate'}
{ TEAMDate }

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.AddDias
   Arguments: NumDias: Integer
  Result:    None
  Objetivo:  Adicionar dias para a data
-------------------------------------------------------------------------------}

procedure TEAMDate.AddDias(NumDias: Integer);
begin
  Self.Value := IncDay(Self.Value, NumDias);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.INDates
  Arguments: DataInicial, DataFinal: Tdate
  Result:    Boolean
  Objetivo:  Testar se uma data está em um intervalo
-------------------------------------------------------------------------------}

function TEAMDate.INDates(DataInicial, DataFinal: Tdate): Boolean;
begin
  Result := ((CompareDate(Self.Value, DataInicial) >= 0)
    and (CompareDate(Self.Value, DataFinal) <= 0));
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.DiaDaSemanaExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar o dia em extenço
-------------------------------------------------------------------------------}

function TEAMDate.DiaDaSemanaExtenco: TEAMString;
const
  semana: array[1..7] of string = ('Domingo', 'Segunda-feira', 'Terça-feira', 'Quarta-feira', 'Quinta-feira', 'Sexta-feira', 'Sábado');
begin
  Result.Text := semana[DayOfWeek(Self.Value)]
end;

function TEAMDate.Date: TDate;
begin
  result := Self.Value;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.DiasNoMes
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o numero de dias no mes
-------------------------------------------------------------------------------}

function TEAMDate.DiasNoMes: TEAMinteger;
const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result.Value := DaysInMonth[Self.GetMes.Value];
  if (Self.GetMes.Value = 2) and Self.isAnoBiSexto then
    Inc(Result.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.Encode
  Arguments: Ano mes e dia
  Result:    nenhum
  Objetivo:  Transforma o dia,mes e ano em uma data
-------------------------------------------------------------------------------}

procedure TEAMDate.Encode(Dia, mes, ano: Word);
begin
  Self.Value := EncodeDate(ano, mes, dia);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.EncodeFromString
  Arguments: Data: string
  Result:    None
  Objetivo:  Conveter uma string para uma data
-------------------------------------------------------------------------------}

procedure TEAMDate.EncodeFromString(Data: string);
begin
  Self.Value := StrToDate(data);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.Formatar
  Arguments: Formato: string
  Result:    TEAMString
  Objetivo:  Retornar a data formatada de acordo com o parametro passado
-------------------------------------------------------------------------------}

function TEAMDate.Formatar(Formato: string): TEAMString;
begin
  Result.Text := FormatDateTime(Formato, Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetAno
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o ano
-------------------------------------------------------------------------------}

function TEAMDate.GetAno: TEAMinteger;
var
  ano, mes, dia: Word;
begin
  DecodeDate(Self.Value, ano, mes, dia);
  Result.Value := ano;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetDia
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o dia
-------------------------------------------------------------------------------}

function TEAMDate.GetDia: TEAMinteger;
var
  ano, mes, dia: Word;
begin
  DecodeDate(Self.Value, ano, mes, dia);
  Result.Value := dia;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetDiaSemana
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o dia da semana
-------------------------------------------------------------------------------}

function TEAMDate.GetDiaSemana: TEAMinteger;
begin
  Result.Value := DayOfTheWeek(Self.Value)
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetMes
  Arguments: None
  Result:    Integer
  Objetivo:  Retornar o mes da data
-------------------------------------------------------------------------------}

function TEAMDate.GetMes: TEAMinteger;
var
  ano, mes, dia: Word;
begin
  DecodeDate(Self.Value, ano, mes, dia);
  Result.Value := mes;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetPrimeiroDiaMes
  Arguments: Nenhum
  Result:    Nenhum
  Objetivo:  Retornar o primeiro dia do mes
-------------------------------------------------------------------------------}

function TEAMDate.GetPrimeiroDiaMes: TEAMinteger;
begin
  Result.Value := 1;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.GetUltimoDiaMes
  Arguments: Nenhum
  Result:    Nenhum
  Objetivo:  Retornar o ultimo dia do mes
-------------------------------------------------------------------------------}

function TEAMDate.GetUltimoDiaMes: TEAMinteger;
var
  ano, mes, dia: word;
  temp: TDate;
begin
  DecodeDate(Self.Value, ano, mes, dia);

  mes := mes + 1;
  if mes = 13 then
  begin
    mes := 1;
    ano := ano + 1;
  end;
  temp := EncodeDate(ano, mes, 1) - 1;

  Result.Value := DayOf(temp);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ADDMes
  Arguments: Meses: Integer
  Result:    None
  Objetivo:  Adicionar um numero de meses a data
-------------------------------------------------------------------------------}

procedure TEAMDate.ADDMes(Meses: Integer);
begin
  Self.Value := IncMonth(Self.Value, Meses);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.isAnoBiSexto
  Arguments: None
  Result:    Boolean
  Objetivo:  Retornar se o ano é bissexto
-------------------------------------------------------------------------------}

function TEAMDate.isAnoBiSexto: Boolean;
begin
  Result := (Self.GetAno.Value mod 4 = 0) and ((Self.GetAno.Value mod 100 <> 0) or (Self.GetAno.Value mod 400 = 0));
end;

{-------------------------------------------------------------------------------
 Procedure: TEAMDate.isFimDeSemana
  Arguments: None
  Result:    Boolean
  Objetivo:  Retorna se a data é um fim de semana
-------------------------------------------------------------------------------}

function TEAMDate.isFimDeSemana: Boolean;

{Verifica se uma data informada cai em um final de semana}
begin
  if DayOfWeek(Self.Value) in [1, 7] then
    result := true
  else
    result := false;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.MesToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar o mês por extenco
-------------------------------------------------------------------------------}

function TEAMDate.MesToExtenco: TEAMString;
begin
  case Self.GetMes.Value of
    1: Result.Text := 'Janeiro';
    2: Result.Text := 'Fevereiro';
    3: Result.Text := 'Março';
    4: Result.Text := 'Abril';
    5: Result.Text := 'Maio';
    6: Result.Text := 'Junho';
    7: Result.Text := 'Julho';
    8: Result.Text := 'Agosto';
    9: Result.Text := 'Setembro';
    10: Result.Text := 'Outubro';
    11: Result.Text := 'Novembro';
    12: Result.Text := 'Dezembro';
  else
    Result.Text := '';
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ReplaceTimer
  Arguments: None
  Result:    None
  Objetivo:  Apaga a hora
-------------------------------------------------------------------------------}

procedure TEAMDate.ReplaceTimer;
var
  newTime: TDateTime;
begin
  newTime := EncodeTime(0, 0, 0, 0);
  ReplaceTime(self.Value, newTime);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.SetDateNow
  Arguments: None
  Result:    None
  Objetivo:  seta a dataHora para o horario atual
-------------------------------------------------------------------------------}

procedure TEAMDate.SetDateNow;
begin
  Self.Value := Now;
end;
{-------------------------------------------------------------------------------
 Procedure: TEAMDate.SubDias
 Arguments: NumDias: Integer
 Result:    None
 Objetivo:  Subtrair um numero de dias da data
-------------------------------------------------------------------------------}

procedure TEAMDate.SubDias(NumDias: Integer);
begin
  NumDias := (NumDias * -1);
  Self.AddDias(NumDias);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar a data por extenço
-------------------------------------------------------------------------------}

function TEAMDate.ToExtenco: TEAMString;
begin
  Result.Text := FormatDateTime('dddddd', Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retornar a data em string
-------------------------------------------------------------------------------}

function TEAMDate.ToString: TEAMString;
begin
  Result.Text := DateToStr(Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMDate.ToSqlServerFormat
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converter para o formato de data do sqlServer
-------------------------------------------------------------------------------}

function TEAMDate.ToSqlServerFormat: TEAMString;
begin
  Result.Text := FormatDateTime('YYYY-MM-DD', Self.Value);
end;

{$ENDREGION}

{$REGION 'TEAMTime'}
{ TEAMTime }

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.DataHoraString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna a data e a hora em uma string
-------------------------------------------------------------------------------}

function TEAMTime.DataHoraString: TEAMString;
begin
  Result.Text := DateTimeToStr(Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.Formatar
  Arguments: Formato: string
  Result:    TEAMString
  Objetivo:  Formata a hora de acordo com o formato passado
-------------------------------------------------------------------------------}

function TEAMTime.Formatar(Formato: string): TEAMString;
begin
  Result.Text := FormatDateTime(Formato, Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.GetHora
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna a hora
-------------------------------------------------------------------------------}

function TEAMTime.GetHora: TEAMString;
var
  hora, minutos, segundos, mcsegundos: Word;
begin
  Decodetime(Self.Value, hora, minutos, segundos, mcsegundos);
  Result.Text := intToStr(hora);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.GetMinutos
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna os minutos
-------------------------------------------------------------------------------}

function TEAMTime.GetMinutos: TEAMString;
var
  hora, minutos, segundos, mcsegundos: Word;
begin
  Decodetime(Self.Value, hora, minutos, segundos, mcsegundos);
  Result.Text := intToStr(minutos);

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.GetSegundos
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna os segundos
-------------------------------------------------------------------------------}

function TEAMTime.GetSegundos: TEAMString;
var
  hora, minutos, segundos, mcsegundos: Word;
begin
  Decodetime(Self.Value, hora, minutos, segundos, mcsegundos);
  Result.Text := intToStr(segundos);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.ToString
  Arguments: None
  Result:    TEAMString
  Objetivo:  Converte para string
-------------------------------------------------------------------------------}

function TEAMTime.ToString: TEAMString;
begin
  Result.Text := TimeToStr(Self.Value);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.ToExtenco
  Arguments: None
  Result:    TEAMString
  Objetivo:  Retorna a hora em extenço
-------------------------------------------------------------------------------}

function TEAMTime.ToExtenco: TEAMString;
var
  Hora, Minuto, Segundo: TEAMinteger;

begin
  Hora.Value := self.GetHora.ToInt;
  Minuto.Value := self.GetMinutos.Toint;
  Segundo.Value := self.GetSegundos.Toint;

  Result.Text := Hora.ToExtenco.Text + ' hora';
  if Hora.Value > 1 then
    Result.Text := Result.Text + 's';
  if Minuto.Value > 0 then
  begin
    Result.Text := Result.Text + ', ' + Minuto.ToExtenco.Text + ' minuto';
    if Minuto.Value > 1 then
      Result.Text := Result.Text + 's'
  end;

  if Segundo.Value > 0 then
  begin
    Result.Text := Result.Text + ' e ' + Segundo.ToExtenco.Text + ' segundo';
    if Segundo.Value > 1 then
      Result.Text := Result.Text + 's'
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMTime.ToMinutos
  Arguments: None
  Result:    Integer
  Objetivo:  Converte Para Minutos
-------------------------------------------------------------------------------}

function TEAMTime.ToMinutos: Integer;
begin
  Result := (StrToInt(Copy(Self.ToString.Text, 1, 2)) * 60) + StrToInt(Copy(Self.ToString.Text, 4, 2));
end;

{$ENDREGION}

end.

Agora podemos iniciar o testes. Adione a unit untTEAMDateTime ao formulário:

unit untTEAMDateTime;

Adicione alguns edits e um botão como abaixo:

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

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMDateTime: TEAMDate;
  EAMTime: TEAMTime;
begin
  EAMDateTime.SetDateNow;

  edtValue.Text := EAMDateTime.ToString.Text;
  edtToExtenco.Text := EAMDateTime.ToExtenco.Text;
  edtGetDia.Text := EAMDateTime.GetDia.ToString.Text;
  edtGetMes.Text := EAMDateTime.GetMes.ToString.Text;
  edtGetAno.Text := EAMDateTime.GetAno.ToString.Text;
  edtGetUltimoDiaMes.Text := EAMDateTime.GetUltimoDiaMes.ToString.Text;
  edtHashDateTime.Text := EAMDateTime.ToString.Hash;


  EAMTime.Value := Now;

  edtTimeValue.Text := EAMTime.Formatar('HH:MM:SS').Text;
  edtTimeToExtenco.Text := EAMTime.ToExtenco.Text;
  edtGetSegundos.Text := EAMTime.GetSegundos.Text;
  edtGetHora.Text := EAMTime.GetHora.Text;
  edtGetMinutos.Text := EAMTime.GetMinutos.Text;
   edtHashTime.Text := EAMTime.ToString.Hash;
end

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. :)

Confira aqui o próximo post

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

Є & V

sexta-feira, 5 de agosto de 2011

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

0 comentários:

Postar um comentário

Mais Populares

Sobre

Tags

Arquivos do Blog

Marcadores

Marcadores

Pages

Arquivos

Seguidores