Tema: Sorteo
Ver Mensaje Individual
  #9  
Antiguo 25-08-2014
Valee Valee is offline
Miembro
NULL
 
Registrado: jul 2014
Posts: 19
Reputación: 0
Valee Va por buen camino
Me falto aclarar que realice un registro sin archivo, solo para poder separar los países elegidos en un registro aparte, y una vez almacenado en la cola se vuelve a reescribir dicho registro.. acá se los dejo

Código Delphi [-]
unit RegEquipo1;

interface

const
  _RangoInf= 1;
  _RangoSup=4;

type
  TipoPos= _RangoInf-1.. _RangoSup;
  RangoVector= _RangoInf.._RangoSup;
  TipoCad= string[20];
  TipoClave= string[3];

  TipoRegEquipo1= record
                    Clave: TipoClave;
                    Pais: TipoCad;
                  end;

  TipoVectorE1= array [RangoVector] of TipoRegEquipo1;

  MeEquipo1= record
              Vector1: TipoVectorE1;
              Ultimo: TipoPos;
              Maximo: TipoPos;
            end;

  procedure CrearMeEquipo1 (var Equipo1:MeEquipo1);
  procedure InsertarInfo1 (var Equipo1:MeEquipo1; Reg:TipoRegEquipo1);
  procedure EliminarInfo1 (var Equipo1:MeEquipo1; Pos:TipoPos);
  function Buscar1 (var Equipo1:MeEquipo1; clave:TipoClave;var Pos:tipoPos):boolean;
  function EstructuraLlena1 (var Equipo1:MeEquipo1):Boolean;
  function EstructuraVacia1 (var Equipo1:MeEquipo1):Boolean;
  Function PrimerElemento1 (var Equipo1:MeEquipo1):TipoPos;
  Function UltimoElemento1 (var Equipo1:MeEquipo1):TipoPos;
  Function ProximoElemento1 (var Equipo1:MeEquipo1;pos:tipopos):tipopos;
  function ElementoAnterior1 (var Equipo1:MeEquipo1;pos:tipopos):tipopos;
  procedure CapturarInfo1 (Var Equipo1:MeEquipo1;pos:tipopos;var Reg:TipoRegEquipo1);
  function MeOrdenado1 (var Equipo1:MeEquipo1):boolean;
  procedure OrdenarMe1 (var Equipo1:MeEquipo1);

implementation

procedure CrearMeEquipo1 (var Equipo1:MeEquipo1);
begin
  Equipo1.Ultimo:= _RangoInf-1;
  Equipo1.Maximo:= _RangoSup;
end;

procedure InsertarInfo1 (var Equipo1:MeEquipo1; Reg:TipoRegEquipo1);
begin
  Equipo1.Ultimo:= Equipo1.Ultimo+1;
  Equipo1.Vector1[Equipo1.Ultimo]:= Reg;//Inserta al final
end;

procedure EliminarInfo1 (var Equipo1:MeEquipo1; Pos:TipoPos);
begin
  Equipo1.Vector1[Pos]:= Equipo1.Vector1[Equipo1.Ultimo];
  Equipo1.Ultimo:= Equipo1.Ultimo-1;//Elimino por sustitucion
end;

function Buscar1 (var Equipo1:MeEquipo1; clave:TipoClave;var Pos:tipoPos):boolean;
var
  Enc:boolean;
  pos2:tipopos;
begin
  Enc:= false;
  pos:= _RangoInf;
  while (not Enc) and (Pos<=Equipo1.Ultimo) do
  begin
   if (Equipo1.Vector1[pos].Clave= clave)
   then
    enc:=true
   else
    pos:=pos+1;
  end;
  Buscar1:=Enc;
end;

function EstructuraLlena1 (var Equipo1:MeEquipo1):Boolean;
begin
EstructuraLlena1:= (Equipo1.Ultimo= Equipo1.Maximo);
end;

function EstructuraVacia1 (var Equipo1:MeEquipo1):Boolean;
begin
  EstructuraVacia1:= (Equipo1.Ultimo=_RangoInf-1);
end;

Function PrimerElemento1 (var Equipo1:MeEquipo1):TipoPos;
begin
  if Equipo1.Ultimo=_RangoInf-1
  then
   PrimerElemento1:= _RangoInf-1
  else
   PrimerElemento1:= _RangoInf;
end;

Function UltimoElemento1 (var Equipo1:MeEquipo1):TipoPos;
begin
  UltimoElemento1:= Equipo1.Ultimo;
end;

Function ProximoElemento1 (var Equipo1:MeEquipo1;pos:tipopos):tipopos;
begin
  if posthen
   ProximoElemento1:=pos+1
  else
   proximoElemento1:=_Rangoinf-1
end;

function ElementoAnterior1 (var Equipo1:MeEquipo1;pos:tipopos):tipopos;
begin   //Devuelve el elemento anterior de la pos buscada
  ElementoAnterior1:= pos-1;
end;

procedure CapturarInfo1 (Var Equipo1:MeEquipo1;pos:tipopos;var Reg:TipoRegEquipo1);
begin
  Reg:=Equipo1.Vector1[Pos];
end;

function MeOrdenado1 (var Equipo1:MeEquipo1):boolean;
var
  estaordenado: boolean;
  i:tipopos;
begin
  estaOrdenado:= true;
  i:= _Rangoinf;
  while (estaordenado) and (ido
  begin
   if (Equipo1.Vector1[i].clave<=Equipo1.Vector1[i+1].clave)
   then
    i:=i+1
   else
    estaordenado:=false;
   end;
  MeOrdenado1:= estaOrdenado;
end;

procedure OrdenarMe1 (var Equipo1:MeEquipo1);
var
  cantidad, pos,i: tipopos;
  ordenado: boolean;
  Aux: TipoRegEquipo1;
begin
  Ordenado:=false;
  cantidad:=1;

  while (not Ordenado) do
  begin
   pos:=1;
   Ordenado:=true;

   while (i<=Equipo1.Ultimo-cantidad) do
   begin

    if (Equipo1.Vector1[pos].clave>Equipo1.Vector1[pos+1].clave)
    then
      begin
        Aux:= Equipo1.Vector1[pos];
        Equipo1.Vector1[pos]:=Equipo1.Vector1[pos+1];
        Equipo1.Vector1[pos+1]:=aux;
        Ordenado:=false;
      end;
    pos:=pos+1;
   end;
   cantidad:=cantidad+1;
  end;
end;

end.
Responder Con Cita