procedimiento de asignación genérico

[[Al González]]

Empezado por egostar

Es una nueva clase generada desde la ghClone

Salud OS

Ah, siendo así, más bien sería una nueva instancia.

[[egostar]]

Empezado por Al González

Ah, siendo así, más bien sería una nueva instancia.

Ah si, perdón, no se que estaba pensando

Salud OS

[gushynet]

El mensaje es el siguiente ya que aqui tuve problemas con el formateo del codigo

[gushynet]

buenas de nuevo. Antes que nada pedir discupas por no haber presentado al nuevo usuario AI Gonzalez


Creo que lo mejor llegados a este punto, como sugiere un compañero que ha participado en este hilo(el nombre lo dejamos, que no quiero cambiarselo a mas nadie ) es poner parte del codigo.

Primero pondre parte de la jerarquia de clases cuya clase base es TElemento.

A continuacion pondre la clase TContenedor que es la clase base de la jerarquia de contenedores que quiero implementar.

Vamos pues:

Clase TElemento

Código Delphi [-]
unit Clase_TElemento;

interface

  type TElemento = class(TObject)

    protected
      ResultOp : boolean;
      
    public
      function Comparar(E:TElemento):boolean;virtual;abstract;
      procedure Asignar(E:TElemento);virtual;abstract;
      function Resultado():boolean;
  end;
  type TElementoClass = class of TElemento;
implementation

  //----------------------------------------------------------------------------
  function TElemento.Resultado():boolean;
  begin
    Result := ResultOp;
  end;
  //----------------------------------------------------------------------------
  
end.

Clase TParrafo

Código Delphi [-]
unit Clase_TParrafo;

interface
  uses Clase_TElemento;

  type TParrafo = class(TElemento)

    protected
      parrafo:AnsiString;
      ResultOp:boolean;
    private
      procedure SetContenido(p:AnsiString);
    public
      property contenido:AnsiString read parrafo write SetContenido;
      constructor create();virtual;
      function Comparar(E:TElemento):boolean;override;
      procedure Asignar(E:TElemento);override;
      
  end;

implementation

  //----------------------------------------------------------------------------
  constructor TParrafo.Create();
  begin
    inherited create();
    parrafo := '';
    ResultOp := false;
  end;
  //----------------------------------------------------------------------------
  function TParrafo.Comparar(E:TElemento):boolean;
  begin
    ResultOp := false;
    if parrafo = TParrafo(E).parrafo then
      ResultOp := true;
    Result := ResultOp;
  end;
  //----------------------------------------------------------------------------
  procedure TParrafo.Asignar(E:TElemento);
  begin
    ResultOp := false;
    if parrafo <> TParrafo(E).parrafo then
    begin
      parrafo := TParrafo(E).parrafo;
      ResultOp := true;
    end;
  end;
  //----------------------------------------------------------------------------
  procedure TParrafo.SetContenido(p: string);
  begin
    parrafo := p;
  end;
  //----------------------------------------------------------------------------
end.

Clase TPregunta

Código Delphi [-]
unit Clase_TPregunta;

interface
  uses Clase_TParrafo;
  type TPregunta = class(TParrafo)
  
  end;
implementation

end.

Clase TRespuesta

Código Delphi [-]
unit Clase_TRespuesta;

interface

  uses Clase_TParrafo;

  type TRespuesta = class(TParrafo)

  end;
  
implementation

end.

Clase TTematica

Código Delphi [-]
unit Clase_TTematica;

interface

  uses Clase_TElemento,Clase_TParrafo;

  type TTematica = class(TParrafo)

    private
      descr:AnsiString;
      procedure SetDescripcion(d:AnsiString);
    public
      property descripcion:AnsiString read descr write SetDescripcion;
      constructor create();overload;override;
      constructor create(p:AnsiString;d:AnsiString);overload;
      function Comparar(E:TElemento):boolean;override;
      procedure Asignar(E:TElemento);override;
  end;
implementation

  //----------------------------------------------------------------------------
  constructor TTematica.create();
  begin
    inherited create();
    descr := '';
  end;
  //----------------------------------------------------------------------------
  constructor TTematica.create(p: string; d: string);
  begin
    parrafo := p;
    descr := d;
  end;
  //----------------------------------------------------------------------------
  function TTematica.Comparar(E: TElemento):boolean;
  begin
    ResultOp := false;
    if (parrafo = TTematica(E).parrafo)and(descr = TTematica(E).descr) then
      ResultOp := true;
    Result := ResultOp;
  end;
  //----------------------------------------------------------------------------
  procedure TTematica.Asignar(E: TElemento);
  begin
    ResultOp := false;
    if (parrafo <> TTematica(E).parrafo)or(descr<>TTematica(E).descr) then
    begin
      parrafo := TTematica(E).parrafo;
      descr := TTematica(E).descr;
      ResultOp := true;
    end;
  end;
  //----------------------------------------------------------------------------
  procedure TTematica.SetDescripcion(d: string);
  begin
    descr := d;
  end;
  //----------------------------------------------------------------------------
end.

Ahora la clase TContenedor

Código Delphi [-]
unit Clase_TContenedor;

interface

  uses Clase_TElemento;

  type TContenedor = class(TObject)

    protected
      PrimerE : Pointer;
      ActualE : Pointer;
      ResultOp : boolean;
      NumElementos : cardinal;
      function ObtenerID():cardinal;virtual;abstract;

    public
      constructor create();
   
      procedure Add(E:TElemento);virtual;abstract;
      procedure Modificar(E1:TElemento;E2:TElemento);virtual;abstract;
      procedure Eliminar(E:TElemento);virtual;abstract;

      function Esta(E:TElemento):boolean;virtual;abstract;

      procedure Actual(E:TElemento);virtual;abstract;
      procedure Primero();
      procedure Ultimo();virtual;abstract;
      procedure Siguiente();virtual;abstract;
      procedure Anterior();virtual;abstract;

      function NElementos():cardinal;

      procedure Iniciar();virtual;abstract;

      function Resultado():boolean;


  end;

  type TObjectClass = class of TObject;
implementation

  //----------------------------------------------------------------------------
  constructor TContenedor.create();
  begin     PrimerE := nil;
    ActualE := nil;
    ResultOp := false;
    NumElementos := 0;
  end;  
  //----------------------------------------------------------------------------
  procedure TContenedor.Primero();
  begin     
        ResultOp := false;     
        if PrimerE<>nil then     
        begin       
           ActualE := PrimerE;      
           ResultOp := true;     
       end;
  end;
  //----------------------------------------------------------------------------
  function TContenedor.NElementos:cardinal;
  begin     result := NumElementos;   end;
  //----------------------------------------------------------------------------
  function TContenedor.Resultado():boolean;
  begin     result := ResultOp;   end;
  //----------------------------------------------------------------------------
end.

Y ahora la clase TListaSimple que desciende de TContenedor y dos métodos ya que esto se ha hecho demasiado largo

Código Delphi [-]
uses Clase_TElemento,Clase_TContenedor,Clase_TParrafo;

  type PTNodo = ^TNodo;
    TNodo = record
      Id : cardinal;
      Elemento : TElemento;
      siguiente : PTNodo;
    end;

  type TListaSimple = class(TContenedor)

    protected
      function ObtenerID():cardinal;override;

    public

      destructor destroy();override;//
      
      procedure Add(E:TElemento);override;
      procedure Modificar(EAnt:TElemento;ENuevo:TElemento);override;
      procedure Eliminar(E:TElemento);override;

      function Esta(E:TElemento):boolean;override;

      procedure  Actual(E:TElemento);override;

      procedure Ultimo();override;
      procedure Siguiente();override;
      procedure Anterior();override;

      procedure Iniciar();override;

  end;

Y ahora los dos proedimientos: Add y Actual

Procedimiento Add

Código Delphi [-]
procedure TListaSimple.Add(E: TElemento);
  var
    nuevo,actual,anterior:PTNodo;
    Elemento : TElemento;
    s:string;
  begin
    if Esta(E) = false then
    begin
      s := E.ClassName;
      Elemento := TElementoClass(E.ClassType).Create(); 
      TElementoClass en lugar de poner directamente
      //la clase base TElemento
      Elemento.Asignar(E);
      new(nuevo);
      nuevo.Id := ObtenerID();
      nuevo.Elemento := Elemento;
      nuevo.siguiente := nil;

      nuevo.Elemento := Elemento;
      if PrimerE = nil then
        PrimerE := nuevo
      else
      begin
        actual := PrimerE;
        anterior := nil;
        while  (actual<>nil) and (actual.Id < nuevo.Id) do
        begin
          anterior := actual;
          actual := actual.Siguiente;
        end;
        if anterior = nil then // va el primero
        begin
          nuevo.Siguiente := PrimerE;
          PrimerE := nuevo;
        end
        else
        begin
          if actual = nil then //va al final
            anterior.Siguiente := nuevo
          else //va entre dos nodos
          begin
            nuevo.Siguiente := actual;
            anterior.Siguiente := nuevo;
          end;
        end;
      end;
      NumElementos := NElementos + 1;
      ResultOp := true;
    end
    else
      ResultOp := false;
  end;

Procedimiento Actual

Código Delphi [-]
procedure TListaSimple.Actual(E:TElemento);
  begin
    ResultOp := true;
    if PrimerE <> nil then
    begin
      if ActualE <> nil then
        E.Asignar(PTNodo(PrimerE).Elemento);
    end
    else
    begin
      ResultOp := false;
    end;
  end;

Espero que ahora se entienda mejor la historia que tengo entre manos aunque entendere que despues de los largo que se ha hecho espereis a la pelicula para ver como se resuelve el problema

Un saludo y gracias por las respuestas, las anteriores a este mensaje y las posibles despues de ese mensaje