Unit escrita en Pascal con algunas operaciones sobre arrays

{ ----------------------------------------------------------------}
{ AUTOR: D'ACHARY Vladimiro Gaston                                            }
{ fecha: 30/12/2013                                                                                  }
{ Unidad PASCAL operaciones basicas sobre arrays unidimensionales  }
{-----------------------------------------------------------------}

unit untArrays;

{$mode objfpc}{$H+}

interface

uses crt;

const
  MAX = 5;

type

  RArr = record
    cod:integer;
    nom:string[15];
    rel:string[15];
    ed :byte;
  end;

  TArr = array [1..MAX] of RArr;

  function len(elArray:TArr):byte;

  function buscarPos(elArray:TArr; target:string):byte;

  function buscarBool(elArray:TArr; target:string):boolean;

  procedure inicializarRegistro(var reg:RArr);

  procedure agregarArr(var elArray:TArr; reg:RArr);

  procedure forzarEnArr(var elArray:TArr; reg:RArr; pos:byte);

  procedure insertarArr(var elArray:TArr; reg;RArr; pos:byte);

  procedure buscarInsertar(var elArray:TArr; reg:RArr; target:string);

  procedure buscarInsertarOrd(var elArray:TArr; reg:RArr; cod:integer);

  procedure ordenarBurbujeo(var elArray:TArr);

  procedure apilar(var elArray:TArr; reg:RArr);

  procedure desApilar(var elArray; reg:RArr);

  procedure encolar(var elArray:TArr; reg:RArr);

  procedure desEncolar(var elArray:TArr);

implementation

function len(elArray:TArr):byte;
var
  i:byte;
begin
  i:=1;
  while ( i<=MAX ) and ( elArray[i].cod>0 ) do begin
    i:=i+1
  end;
  len:=i;
end;

function buscarPos(elArray:TArr; target:string):byte;
var
  i:byte;
begin
  i:=1;

  while ( i<=MAX ) and ( elArray[i].nom<>target ) do begin
    i:=i+1
  end;

  if ( elArray[i]=target ) then begin
    buscarPos:=i
  end else begin
    buscarPos:=0
  end
end;

function buscarBool(elArray:TArr; target:string):boolean;
var
  existe:boolean;
  i:byte;
begin
  i:=1;
  existe:=false;

  while ( i<=MAX ) and ( existe=false ) do begin
    if ( elArray[i].nom=target ) then begin
      existe:=true
    end;
    i:=i+1
  end;

  buscarBool:=existe;
end;

procedure inicializarRegistro(var reg:RArr);
begin
  reg.cod:=0;
  reg.nom:='';
  reg.rel:='';
  reg.ed:=0;
end;

procedure agregarArr(var elArray:TArr; reg:RArr);
var
  i:byte;
begin
  i:=1;
  while ( i<=MAX ) and ( elArray[i].cod>0 ) do begin
    i:=i+1
  end;
  elArray[i]:=reg
end;

procedure forzarEnArr(var elArray:TArr; reg:RArr; pos:byte);
begin
  if ( pos<=MAX ) and ( pos>0 ) then begin
    elArray[pos]:=reg
  end;
end;

procedure insertarArr(var elArray:TArr; reg;RArr; pos:byte);
var
  i:byte;
begin
  for i:=len(elArray) downTo pos do begin
    elArray[i+1]:=elArray[i]
  end;
  elArray[pos]:=reg;
end;

procedure buscarInsertar(var elArray:TArr; reg:RArr; target:string; pos:byte);
begin
  if ( buscarBool(elArray,target)=false ) then begin
    insertarArr(elArray,reg,pos)
  end;
end;

procedure buscarInsertarOrd(var elArray:TArr; reg:RArr; cod:integer);
var
  i:byte;
begin
  if ( buscarBool(elArray,cod)=false ) then begin
    i:=i+1;
    while ( i<=MAX ) and ( elArray[i].cod<cod ) then begin
      i:=i+1;
    end;
    insertarArr(elArray,reg,i);
  end;
end;

procedure eliminarArr(var elArray:TArr; target:string);
var
  i:byte;
  pos:byte;
  aux:RArr;
begin
  pos:=buscarPos(elArray,target);
  if ( pos<>0 ) then begin
    for i:=pos to len(elArray) do begin
      elArray[pos]:=elArray[pos+1];
    end;
    elArray[len(elArray)]:=elArray[len(elArray)+1];
  end;

end.

procedure ordenarBurbujeo(var elArray:TArr);
var
  i,ii,largo:byte;
  aux:RArr;
begin
  largo:=len(elArray);
  for i:=1 to largo-1 do begin
    for ii:=1 to largo do begin
      if elArray[ii].cod>elArray[ii+1] then begin
        aux:=elArray[ii];
        elArray[ii]:=elArray[ii+1];
        elArray[ii+1]:=aux;
      end;
    end;
  end;
end.

procedure apilar(var elArray:TArr; reg:RArr);
begin
  if ( len(elArray)<MAX ) then begin
    agregarArr(elArray,reg);
  end;
end;

procedure desEnpilar(var elArray:TArr);
var
  ultimo:byte;
  aux:RArr
begin
  ultimo:=len(elArray);
  inicializarRegistro(aux);
  elArray[ultimo]:=aux;
end;

procedure encolar(var elArray:TArr; reg:RArr);
begin
  if ( len(elArray)<MAX ) then begin
    agregarArr(elArray,reg);
  end;
end;

procedure desEncolar(var elArray:TArr);
var
  i:byte;
  aux:RArr;
begin
  i:=1;

  for i:=1 to len(elArray) do begin
    elArray[i]:=elArray[i+1];
  end;
  inicializarRegistro(aux);
  elArray[len(elArray)):=aux;
end;

end.

Comentarios

Entradas populares de este blog

El juego del ahorcado, escrito en assembler i8086

Una posible implementacion en modo texto de una sopa de letras con python ( 2013 )

ayuda memoria sobre conversion dinamica descendente y polimorfismo