TCollection e Generics no Free Pascal - Uma breve visão sobre lista de objetos com o Lazarus

O Free Pascal pode não ser tão poderoso quanto o C++, mas em seus termos, está bem madura e tem evoluído - e para aplicações simples pode representar um excelente custo benefício, numa prova de que com ele é possível conciliar recursos poderosos com simplicidade.

[ Hits: 29.425 ]

Por: Perfil removido em 05/05/2010


Interface e código completo do exemplo



Enfim, só pra ilustrar melhor o exemplo, segue a interface da janelinha que eu criei e o código completo da unit dela. Eu usei dois LabeledEdits pra entrar com os dados, um Button pra inserir e outro pra deletar, uma ListView pra mostrar os registros e um RadioGroup pra escolher qual tipo de lista usaremos, tudo na mesma tela pra ganhar tempo.
Linux: TCollection e Generics no Free Pascal - Uma breve visão sobre lista de objetos com o Lazarus
E o código com as 276 linhas da façanha:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls;

type

  { TAgendaTelefonicaObj }
  TAgendaTelefonicaObj = class
  private
    FCodigo: Integer;
    FNome: String;
    FTelefone: String;
  public
    property Codigo: Integer read FCodigo;
    property Nome: String read FNome write FNome;
    property Telefone: String read FTelefone write FTelefone;
  end;

  { TAgendaTelefonicaGeneric }
  generic TAgendaTelefonicaGeneric = class(TList)
  public
    function Add(Item: T): Integer;
    procedure DeleteByCodigo(Codigo: Integer);
  end;

  TAgendaTelefonicaListaGeneric = specialize TAgendaTelefonicaGeneric;

  TAgendaColecao = class;

  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    ListView1: TListView;
    RadioGroup1: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
  private
    { private declarations }
    Agenda: TAgendaColecao;
    AgendaTelefonicaLista: TAgendaTelefonicaListaGeneric;
    procedure ExibirLista();
  public
    { public declarations }
  end;

  TAgendaColecaoItem = class;

  { TAgendaColecao }
  TAgendaColecao = class(TCollection)
  private
    function GetItem(Index: Integer): TAgendaColecaoItem;
    procedure SetItem(Index: Integer; const Value: TAgendaColecaoItem);
  public
    constructor Create();
    destructor Destroy(); override;
    function Add: TAgendaColecaoItem; overload;
    procedure Add(const Nome: String; const Telefone: String);
    procedure DeleteByCodigo(Codigo: Integer); { Método customizado }
    property Items[Index: Integer]: TAgendaColecaoItem read GetItem write SetItem;
  end;

  { TAgendaColecaoItem }
  TAgendaColecaoItem = class(TCollectionItem)
  private
    FCodigo: Integer;
    FNome: String;
    FTelefone: String;
  public
    property Codigo: Integer read FCodigo;
    property Nome: String read FNome Write FNome;
    property Telefone: String read FTelefone write FTelefone;
  end;

var
  Form1: TForm1;

implementation

{ TAgendaColecao }

function TAgendaColecao.GetItem(Index: Integer): TAgendaColecaoItem;
begin
  Result := TAgendaColecaoItem(inherited Items[Index]);
end;

procedure TAgendaColecao.SetItem(Index: Integer; const Value: TAgendaColecaoItem);
begin
  inherited Items[Index] := Value;
end;

constructor TAgendaColecao.Create();
begin
  inherited Create(TAgendaColecaoItem);
end;

destructor TAgendaColecao.Destroy();
begin
  inherited Destroy();
end;

function TAgendaColecao.Add: TAgendaColecaoItem;
begin
  Result := TAgendaColecaoItem(inherited Add());
end;

procedure TAgendaColecao.Add(const Nome: String;
  const Telefone: String);
var
  I, Codigo: Integer;
  Item: TAgendaColecaoItem;
begin
  //Pega último código registrado e incrementa
  //pra obter o código interno pro novo item
  if Count > 0 then
  begin
    for I := 0 to Count - 1 do
      Codigo := Items[I].Codigo + 1;
  end
  else
    Codigo := 1;

  //Adiciona
  Item := Add();
  Item.FCodigo := Codigo;
  Item.FNome := Nome;
  Item.FTelefone := Telefone;
end;

procedure TAgendaColecao.DeleteByCodigo(Codigo: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Items[I].Codigo = Codigo then
    begin
      Delete(I);
      Break;
    end;
end;

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  Agenda := TAgendaColecao.Create();
  AgendaTelefonicaLista := TAgendaTelefonicaListaGeneric.Create();
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  ExibirLista();
end;

procedure TForm1.ExibirLista();
var
  I: Integer;
  Item: TListItem;
begin
  ListView1.BeginUpdate();

  ListView1.Clear();

  if RadioGroup1.ItemIndex = 0 then
  begin
    for I := 0 to Agenda.Count - 1 do
    begin
      Item := ListView1.Items.Add();
      Item.Caption := IntToStr(Agenda.Items[I].Codigo);
      Item.SubItems.Add(Agenda.Items[I].Nome);
      Item.SubItems.Add(Agenda.Items[I].Telefone);
    end;
  end
  else
  begin
    for I := 0 to AgendaTelefonicaLista.Count - 1 do
    begin
      Item := ListView1.Items.Add();
      Item.Caption := IntToStr(TAgendaTelefonicaObj(AgendaTelefonicaLista.Items[I]).Codigo);
      Item.SubItems.Add(TAgendaTelefonicaObj(AgendaTelefonicaLista.Items[I]).Nome);
      Item.SubItems.Add(TAgendaTelefonicaObj(AgendaTelefonicaLista.Items[I]).Telefone);
    end;
  end;

  ListView1.EndUpdate();
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  FreeAndNil(Agenda);
  FreeAndNil(AgendaTelefonicaLista);
  CloseAction := caFree;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  AgendaTelefonica: TAgendaTelefonicaObj;
begin
  if RadioGroup1.ItemIndex = 0 then
    Agenda.Add(LabeledEdit1.Text, LabeledEdit2.Text)
  else
  begin
    AgendaTelefonica := TAgendaTelefonicaObj.Create();
    AgendaTelefonica.Nome := LabeledEdit1.Text;
    AgendaTelefonica.Telefone := LabeledEdit2.Text;
    AgendaTelefonicaLista.Add(AgendaTelefonica);
  end;

  ExibirLista();

  //Limpar controles
  LabeledEdit1.Clear();
  LabeledEdit2.Clear();
  LabeledEdit1.SetFocus();
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ListView1.Selected <> nil then
    if RadioGroup1.ItemIndex = 0 then
      Agenda.DeleteByCodigo(StrToIntDef(ListView1.Selected.Caption, 0))
    else
    begin
      AgendaTelefonicaLista.DeleteByCodigo(StrToIntDef(ListView1.Selected.Caption, 0));
    end;

  ExibirLista();
end;

{ TAgendaTelefonicaGeneric }

function TAgendaTelefonicaGeneric.Add(Item: T): Integer;
var
  I: Integer;
begin
  //Pega a propriedade código do último objeto
  //e incrementa pra obter o código pro novo
  if Count = 0 then
    TAgendaTelefonicaObj(Item).FCodigo := 1
  else
  begin
    for I := 0 to Count - 1 do
      TAgendaTelefonicaObj(Item).FCodigo := TAgendaTelefonicaObj(Items[I]).Codigo + 1;
  end;

  //Insere
  Result := inherited Add(Item);
end;

procedure TAgendaTelefonicaGeneric.DeleteByCodigo(Codigo: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if TAgendaTelefonicaObj(Items[I]).Codigo = Codigo then
    begin
      Delete(I);
      Break;
    end;
end;

initialization
  {$I unit1.lrs}

end.

Página anterior    

Páginas do artigo
   1. Apresentação
   2. Coleções (TCollection)
   3. Usando generics
   4. Interface e código completo do exemplo
Outros artigos deste autor

Plugin MSofficeKey para OCS Inventory

Instalando o compiz no Arch Linux

Arquivos de configuração de rede - Parte I - /etc/hosts

Sistemas de arquivos EXT3 e ReiserFS no GNU/Linux

Atualizando o seu KDE sem dores de cabeça

Leitura recomendada

Criando uma aplicação que mostra os processos em execução

Cross-compile Lazarus: Gerando executáveis Win32 estando no Linux

Como fazer seu programa Kylix chamar uma aplicação externa

Criando aplicação para detectar informações do sistema em Kylix

Colocando aplicação Kylix no TrayIcon do KDE

  
Comentários
[1] Comentário enviado por barao em 06/05/2010 - 11:23h

Bom artigo Pedro, tambem gosto muito da linguagem pascal e do c ,mais com as facilidades que o Lazaros vem incroporando a cada dia ele fica melhor.
Meu blog www.blig.ig.com.br/mauriciobaron

[2] Comentário enviado por andrezc em 07/05/2010 - 20:02h

Parabéns pelo artigo! Mas serei sincero com você, odeio Pascal, rs, isso é mais pq eu não gostei da sintaze, foi odio a primeira vista, em um curso que eu fiz.

Um abraço, parabéns pelo artigo.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts