unit progreso;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
  StdCtrls, Gauges, ExtCtrls,DBTables,checa,conver,db,UnidMone;

type
  TFormaProgreso = class(TForm)
    Timer1: TTimer;
    Panel1: TPanel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Panel2: TPanel;
    Label2: TLabel;
    Cuadrito: TPanel;
    Cuadro: TShape;
    Mensaje: TLabel;
    BarraProgreso: TGauge;
    Label1: TLabel;
    procedure Panel2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
tiposcampo=record
c1,c2,c3,c4,c5,c6,c7,c8:String[25];
end;


var
  FormaProgreso: TFormaProgreso;
  avan:integer;
  TablaConcentrarA:TTable;
  rango1A,rango2A,campofechaA,fechainiA,fechafinA,campodeordenA,campodenombreA:string;
  concentrar1A,concentrar2A,concentrar3A,concentrar4A,concentrar5A,concentrar6A,concentrar7A,concentrar8A,crA:string;
  opA:char  ;
  vrA,tipoA:string;
  campo1,campo2,campo3:string;
  op1,op2,op3:char;
  valor1,valor2,valor3:string[15];
  tipo1,tipo2,tipo3:string[15];
  tipodato:tiposcampo;
  operador,variable:array[1..8]of String;

procedure progresando(avance:integer);

{****}
procedure concentrar(TablaConcentrar:TTable;rango1,rango2,campofecha,fechaini,fechafin,campodeorden,campodenombre:String;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string;op:char;vr,tipo:string);
procedure poneetiquetas(campodeorden,campodenombre:String;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string);
procedure PoneAnchos(ord,nom,concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:word);
procedure concentrarcadenas(TablaConcentrar:TTable;rango1,rango2,campofecha,fechaini,fechafin,campodeorden,campodenombre:string;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string;op:char;vr,tipo:string);
procedure condiciones(cam1:string;o1:char;val1,tip1:string;cam2:string;o2:char;val2,tip2:string;cam3:string;o3:char;val3,tip3:string);
procedure AsignaVariables(ope1,var1,ope2,var2,ope3,var3,ope4,var4,ope5,var5,ope6,var6,ope7,var7,ope8,var8:string);
procedure pormes;
procedure porano;
implementation

{$R *.DFM}

procedure AsignaVariables(ope1,var1,ope2,var2,ope3,var3,ope4,var4,ope5,var5,ope6,var6,ope7,var7,ope8,var8:string);
begin
 operador[1]:=ope1;
 operador[2]:=ope2;
 operador[3]:=ope3;
 operador[4]:=ope4;
 operador[5]:=ope5;
 operador[6]:=ope6;
 operador[7]:=ope7;
 operador[8]:=ope8;

variable[1]:=var1;
variable[2]:=var2;
variable[3]:=var3;
variable[4]:=var4;
variable[5]:=var5;
variable[6]:=var6;
variable[7]:=var7;
variable[8]:=var8;





end;



procedure pormes;
type
registros=record
orden:String[100];
nombre:string[100];
c1,c2,c3,c4,c5,c6,c7,c8:string[25]{Real};
end;

var
arch,arch2:File of Registros;
dato1:Registros;
i,regis:LongInt;
mes:array[1..12,1..4] of Currency;
noasignado:array[1..4] of Currency;
mesactual:word;
erro:integer;

begin
{****calcula los montos por mes*****}
AssignFile(arch,leeruta+'\tempo\final.tmp');
Reset(arch);
for i:=1 to 12 do mes[i][1]:=0;
for i:=1 to 12 do mes[i][2]:=0;
for i:=1 to 12 do mes[i][3]:=0;
for i:=1 to 12 do mes[i][4]:=0;
for i:=1 to 4 do noasignado[i]:=0;

while not Eof(arch) do
begin
Read(arch,dato1);
val(dato1.orden[4]+dato1.orden[5],mesactual,erro);
if erro=0 then
begin
mesactual:=StrToInt(dato1.orden[4]+dato1.orden[5]);
mes[mesactual][1]:=mes[mesactual][1]+Flotante(dato1.c1);
mes[mesactual][2]:=mes[mesactual][2]+Flotante(dato1.c2);
mes[mesactual][3]:=mes[mesactual][3]+Flotante(dato1.c3);
mes[mesactual][4]:=mes[mesactual][4]+Flotante(dato1.c4);
end
else
begin
noasignado[1]:=noasignado[1]+Flotante(dato1.c1);
noasignado[2]:=noasignado[2]+Flotante(dato1.c2);
noasignado[3]:=noasignado[3]+Flotante(dato1.c3);
noasignado[4]:=noasignado[4]+Flotante(dato1.c4);

end;
end;
CloseFile(arch);
{******termina calculo por mes******}
AssignFile(arch,leeruta+'\tempo\final.tmp');
Rewrite(arch);

for i:=1 to 12 do
begin
dato1.orden:=mesletra(i);
dato1.c1:=FloatToStr(mes[i][1]);
dato1.c2:=FloatToStr(mes[i][2]);
dato1.c3:=FloatTostr(mes[i][3]);
dato1.c4:=FloatToStr(mes[i][4]);
Write(arch,dato1);
end;
CloseFile(arch);

{Ordena la lista con stringlist***************}

end;




function numero(cad:string):LongInt;
var
aux:string[15];
i:integer;
begin

aux:='';
for i:=length(cad) downto 101 do
begin
aux:=cad[i]+aux;
end;
numero:=StrToInt(aux);

end;

{*concen******************}
function ajuste(aux:String;n:Integer):string;
var i:integer;
valoraux:string[100];
begin
valoraux:=aux;
aux:=valoraux;
if length(aux)<n then
begin
for i:=length(aux) to n do
aux:=aux+' ';
end
else
begin
aux:='';
for i:=1 to n do
aux:=aux+valoraux[i];
aux:=aux+' ';
end;
aux:=aux;
ajuste:=aux;
end;



function checa(ca:string;op:char;va,ti:string):Boolean;
var
numero:Real;
error1:Integer;
begin

{sHOWmESSAGE(ca+'  '+op+'  '+va+'  '+ti);}

if ca<>'X' then
begin
if ti='ftString' then
begin
case op of
'=':if ca=va then checa:=True else checa:=False;
'<':if ca<va then checa:=True else checa:=False;
'>':if ca>va then checa:=True else checa:=False;
'X':if ca<>va then checa:=True else checa:=False;
'Y':if ca<=va then checa:=True else checa:=False;
'Z':if ca>=va then checa:=True else checa:=False;
end;

end;

if ti='ftDate' then
begin
if ca='' then ca:='01/01/1980';
case op of
'=':if StrToDateTime(ca)=StrToDateTime(va) then checa:=True else checa:=False;
'<':if StrToDateTime(ca)<StrToDateTime(va) then checa:=True else checa:=False;
'>':if StrToDateTime(ca)>StrToDateTime(va) then checa:=True else checa:=False;
'X':if StrToDateTime(ca)<>StrToDateTime(va) then checa:=True else checa:=False;
'Y':if StrToDateTime(ca)<=StrToDateTime(va) then checa:=True else checa:=False;
'Z':if StrToDateTime(ca)>=StrToDateTime(va) then checa:=True else checa:=False;
end;


end;

if (ti='ftFloat') or (ti='ftInteger') then
begin
val(ca,numero,error1);
if error1<>0 then
numero:=0;
if va='' then va:='0';
case op of
'=':if numero=StrToFloat(va) then checa:=True else checa:=False;
'<':if numero<StrToFloat(va) then checa:=True else checa:=False;
'>':if numero>StrToFloat(va) then checa:=True else checa:=False;
'X':if numero<>StrToFloat(va) then checa:=True else checa:=False;
'Y':if numero<=StrToFloat(va) then checa:=True else checa:=False;
'Z':if numero>=StrToFloat(va) then checa:=True else checa:=False;
end;

end;

end
else
checa:=True;

end;


function checacampos:boolean;
begin
checacampos:=False;
if (campo1<>'')or (campo2<>'')or (campo3<>'') then
checacampos:=True;
if (campo1='') then campo1:='X';
if (campo2='') then campo2:='X';
if (campo3='') then campo3:='X';

end;

procedure PoneAnchos(ord,nom,concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:word);
Type
Anchos=record
ord,nom,c1,c2,c3,c4,c5,c6,c7,c8:word;
end;

var
arch3:File of Anchos;
ancho:Anchos;

begin

AssignFile(arch3,leeruta+'\tempo\anchos.tmp');
ReWrite(arch3);
ancho.ord:=ord;
ancho.nom:=nom;
ancho.c1:=concentrar1;
ancho.c2:=concentrar2;
ancho.c3:=concentrar3;
ancho.c4:=concentrar4;
ancho.c5:=concentrar5;
ancho.c6:=concentrar6;
ancho.c7:=concentrar7;
ancho.c8:=concentrar8;

write(arch3,ancho);
CloseFile(arch3);

end;


procedure poneetiquetas(campodeorden,campodenombre:String;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string);
Type
eti=record
orden,nombre,c1,c2,c3,c4,c5,c6,c7,c8:String[25];
end;

var
arch2:File of Eti;
Etiquetas:Eti;

begin

AssignFile(arch2,leeruta+'\tempo\etique.tmp');
ReWrite(arch2);
Etiquetas.orden:=campodeorden;
Etiquetas.nombre:=campodenombre;
Etiquetas.c1:=concentrar1;
Etiquetas.c2:=concentrar2;
Etiquetas.c3:=concentrar3;
Etiquetas.c4:=concentrar4;
Etiquetas.c5:=concentrar5;
Etiquetas.c6:=concentrar6;
Etiquetas.c7:=concentrar7;
Etiquetas.c8:=concentrar8;

write(arch2,Etiquetas);
Etiquetas.c1:=tipodato.c1;
Etiquetas.c2:=tipodato.c2;
Etiquetas.c3:=tipodato.c3;
Etiquetas.c4:=tipodato.c4;
Etiquetas.c5:=tipodato.c5;
Etiquetas.c6:=tipodato.c6;
Etiquetas.c7:=tipodato.c7;
Etiquetas.c8:=tipodato.c8;
write(arch2,Etiquetas);

CloseFile(arch2);

end;

function operacion(val1,op,val2:string):Currency;
var
signo:Char;
begin
if val1='' then val1:='0';
if val2='' then val2:='0';
signo:=op[1];
case signo of
'*':operacion:=StrToCurr(val1)*StrToCurr(val2);
'/':operacion:=StrToCurr(val1)/StrToCurr(val2);
'+':operacion:=StrToCurr(val1)+StrToCurr(val2);
'-':operacion:=StrToCurr(val1)-StrToCurr(val2);
{'!':operacion:=StrToCurr(val1)<>StrToCurr(val2);}
else
operacion:=1;
end;
end;

function OperacionFuncion(val1,op,val2:string):Currency;
var
signo:Char;
numero:Currency;
auxi:string[6];
begin

{***checa si se trata de una funcion*******}

{***checa si se trata de una funcion*******}

if val1='' then val1:='0';
if val2='' then val2:='0';
signo:=op[1];
case signo of
'*':operacionFuncion:=StrToCurr(val1)*StrToCurr(val2);
'/':operacionFuncion:=StrToCurr(val1)/StrToCurr(val2);
'+':operacionFuncion:=StrToCurr(val1)+StrToCurr(val2);
'-':operacionFuncion:=StrToCurr(val1)-StrToCurr(val2);
{'!':operacion:=StrToCurr(val1)<>StrToCurr(val2);}
else
operacionFuncion:=1;
end;
end;



function formula(Tabla:TTable;formu:string):String{Real};
var
i,j,cuenta:integer;
aux:string;
parametro:array[1..10] of String[80];
suma:Currency;
begin
for i:=1 to 10 do
parametro[i]:='';

{sHOWmESSAGE(FORMU);}
aux:='';
cuenta:=1;
{*****}
for i:=2 to length(formu) do
begin

if formu[i]= '&' then
begin
parametro[cuenta]:=aux;
cuenta:=cuenta+1;
aux:='';
end
else
 aux:=aux+formu[i];
end;
{****}

for i:=1 to cuenta do
begin
aux:='';
if parametro[i][1]='%' then
begin
for j:=2 to length(parametro[i]) do
aux:=aux+parametro[i][j];
parametro[i]:=Tabla.FieldByName(aux).AsString;
end;
end;

for i:=cuenta-1 to 10 do
begin
if parametro[i]='' then
parametro[i]:='1';
end;

i:=2;
while i<=8 do
begin
if parametro[i]='1' then
parametro[i]:='*';
i:=i+2;
end;


{ShowMessage('5-'+parametro[5]+' 6-'+parametro[6]+' 7-'+parametro[7]+' 8-'+parametro[8]+' 9-'+parametro[9]+' 10-'+parametro[10]);}
{***}
suma:=0;
suma:=operacion(parametro[1],parametro[2],parametro[3]);
{ShowMessage('resultado 5,6,7 '+CurrToStr(operacion(parametro[5],parametro[6],parametro[7])));}
suma:=suma*operacion(parametro[5],parametro[6],parametro[7]);
{suma:=suma*StrToCurr(parametro[5]);}

{suma:=suma*operacion(parametro[5],parametro[6],parametro[7]);}

{***}
formula:=FloatToStr(suma);

end;



function periodo(campofecha,fechaini,fechafin:String):Boolean;
begin
periodo:=False;
if (fechaini<>'f')and (fechafin<>'f')and(fechaini<>'')and (fechafin<>'')and (campofecha<>'') then
begin
if (StrToDateTime(campofecha)>=StrToDateTime(fechaini))and (StrToDateTime(campofecha)<=StrToDateTime(fechafin)) then
periodo:=True
else
periodo:=False;
end
else
periodo:=False;

end;


function cumple(v1:string;ope:Char;v2:String):Boolean;
begin
case ope of
'=':begin
    if v1=v2 then cumple:=True else cumple:=False;
    end;
'<':begin
    if v1<v2 then cumple:=True else cumple:=False;
    end;
'>':begin
    if v1>v2 then cumple:=True else cumple:=False;
    end;
'!':begin
    if v1<>v2 then cumple:=True else cumple:=False;
    end;
'X':begin
    cumple:=True;
    end;
end;

end;




procedure concentraarchivo;
type
registros=record
orden:String[100];
nombre:String[100];
c1,c2,c3,c4,c5,c6,c7,c8:string[25]{Real};
end;
var
arch,arch2:File of Registros;
anterior,siguiente:Registros;
clave,nombre:string;
nreg,i:LongInt;
cn1,cn2,cn3,cn4,cn5,cn6,cn7,cn8:Real;
begin
anterior.orden:='';
anterior.nombre:='';
siguiente.orden:='';
siguiente.nombre:='';
AssignFile(arch,leeruta+'\tempo\orden.tmp');
AssignFile(arch2,leeruta+'\tempo\final.tmp');
Reset(arch);
Rewrite(arch2);
{***guarda tipos DE CAMPO****}
siguiente.c1:=tipodato.c1;siguiente.c2:=tipodato.c2;siguiente.c3:=tipodato.c3;siguiente.c4:=tipodato.c4;
siguiente.c5:=tipodato.c5;siguiente.c6:=tipodato.c6;siguiente.c7:=tipodato.c7;siguiente.c8:=tipodato.c8;
{write(arch2,siguiente);}
{***************************}
Read(arch,anterior);
{***calcula tamaņo de archivo****}
nreg:=FileSize(arch);
FormaProgreso.BarraProgreso.Progress:=0;
FormaProgreso.Mensaje.Caption:='Concentrando Datos';
i:=0;
{**************************}

clave:=anterior.orden;
nombre:=anterior.nombre;
if (tipodato.c1='f')or(tipodato.c1='e') then cn1:=Flotante(anterior.c1);
if (tipodato.c2='f')or(tipodato.c2='e') then cn2:=Flotante(anterior.c2);
if (tipodato.c3='f')or(tipodato.c3='e') then cn3:=Flotante(anterior.c3);
if (tipodato.c4='f')or(tipodato.c4='e') then cn4:=Flotante(anterior.c4);
if (tipodato.c5='f')or(tipodato.c5='e') then cn5:=Flotante(anterior.c5);
if (tipodato.c6='f')or(tipodato.c6='e') then cn6:=Flotante(anterior.c6);
if (tipodato.c7='f')or(tipodato.c7='e') then cn7:=Flotante(anterior.c7);
if (tipodato.c8='f')or(tipodato.c8='e') then cn8:=Flotante(anterior.c8);
{cn1:=0;cn2:=0;cn3:=0;cn4:=0;cn5:=n0;cn6;=0;cn7:=0;cn8:=0;}
while not Eof(arch) do
begin
Read(arch,siguiente);
if clave=siguiente.orden then
begin
{concentra}
if (tipodato.c1='f')or(tipodato.c1='e') then cn1:=cn1+Flotante(siguiente.c1);
if (tipodato.c1='f')or(tipodato.c1='e') then cn2:=cn2+Flotante(siguiente.c2);
if (tipodato.c1='f')or(tipodato.c1='e') then cn3:=cn3+Flotante(siguiente.c3);
if (tipodato.c1='f')or(tipodato.c1='e') then cn4:=cn4+Flotante(siguiente.c4);
if (tipodato.c1='f')or(tipodato.c1='e') then cn5:=cn5+Flotante(siguiente.c5);
if (tipodato.c1='f')or(tipodato.c1='e') then cn6:=cn6+Flotante(siguiente.c6);
if (tipodato.c1='f')or(tipodato.c1='e') then cn7:=cn7+Flotante(siguiente.c7);
if (tipodato.c1='f')or(tipodato.c1='e') then cn8:=cn8+Flotante(siguiente.c8);

end
else
begin
{nuevo}
anterior.c1:=FloatToStr(cn1);
anterior.c2:=FloatToStr(cn2);
anterior.c3:=FloatToStr(cn3);
anterior.c4:=FloatToStr(cn4);
anterior.c5:=FloatToStr(cn5);
anterior.c6:=FloatToStr(cn6);
anterior.c7:=FloatToStr(cn7);
anterior.c8:=FloatToStr(cn8);
anterior.orden:=clave;
anterior.nombre:=nombre;

if FileSize(arch)<>FilePos(arch) then
write(arch2,anterior);
cn1:=Flotante(siguiente.c1);
cn2:=Flotante(siguiente.c2);
cn3:=Flotante(siguiente.c3);
cn4:=Flotante(siguiente.c4);
cn5:=Flotante(siguiente.c5);
cn6:=Flotante(siguiente.c6);
cn7:=Flotante(siguiente.c7);
cn8:=Flotante(siguiente.c8);

end;
clave:=siguiente.orden;
nombre:=siguiente.nombre;
i:=i+1;
FormaProgreso.BarraProgreso.Progress:=FormaProgreso.BarraProgreso.Progress+Trunc((i/nreg)*100);

end;
FormaProgreso.BarraProgreso.Progress:=100;
CloseFile(arch);
CloseFile(arch2);
end;



procedure ordenalista;
type
registros=record
orden:String[100];
nombre:string[100];
c1,c2,c3,c4,c5,c6,c7,c8:String[25]{Real};
end;

var
arch,arch2:File of Registros;
regaux,dato1,dato2:Registros;
nreg,i,regis:LongInt;
cadena:string;
ListaOrdenada:TStringlist;

begin
{Ordena la lista con stringlist***************}

AssignFile(arch2,leeruta+'\tempo\concen.tmp');
Reset(arch2);
{Read(arch2,dato2);}
{***calcula tamaņo de archivo****}
i:=FileSize(arch2);
FormaProgreso.BarraProgreso.Progress:=0;
FormaProgreso.Mensaje.Caption:='Leyendo Datos';
{**************************}


ListaOrdenada:=TStringList.Create;
ListaOrdenada.Sorted:=True;
ListaOrdenada.Duplicates:=dupAccept;	                             { create the list }
nreg:=0;
while not Eof(arch2) do
begin
Read(arch2,dato2);
{MismaCadena := TCadenaOrdenada(Lista.Items[i]);}
ListaOrdenada.Add(ajuste(dato2.orden,100)+IntToStr(nreg));
nreg:=nreg+1;
FormaProgreso.BarraProgreso.Progress:=FormaProgreso.BarraProgreso.Progress+Trunc((nreg/i)*100);
end;
FormaProgreso.BarraProgreso.Progress:=100;
CloseFile(arch2);

{****termina ordec******}


{AssignFile(arch,leeruta+'\tempo\orden.tmp');
AssignFile(arch2,leeruta+'\tempo\concen.tmp');

ReWrite(arch);
Reset(arch2);

while not Eof(arch2) do
begin
Read(arch2,dato2);
nreg:=0;
Seek(arch,0);

if FileSize(arch)>0 then
while not Eof(arch) do
begin
Read(arch,dato1);
if dato1.orden>dato2.orden then
begin
break;
end;
nreg:=nreg+1;
end;
dato1.orden:=dato2.orden;
dato1.nombre:=dato2.nombre;
dato1.c1:=dato2.c1;
dato1.c2:=dato2.c2;
dato1.c3:=dato2.c3;
dato1.c4:=dato2.c4;
dato1.c5:=dato2.c5;
dato1.c6:=dato2.c6;
dato1.c7:=dato2.c7;
dato1.c8:=dato2.c8;

if nreg<FileSize(arch) then
begin
Seek(arch,nreg);
Read(arch,regaux);
Seek(arch,nreg);
write(arch,dato1);
dato1:=regaux;
nreg:=FilePos(arch);
end;

if FileSize(arch)>0 then
while not Eof(arch) do
begin
Read(arch,regaux);
Seek(arch,FilePos(arch)-1);
Write(arch,dato1);
dato1:=regaux;
end;
write(arch,dato1);
end;

dato1.orden:='*';

dato1.c1:=0;
dato1.c2:=0;
dato1.c3:=0;
dato1.c4:=0;
dato1.c5:=0;
dato1.c6:=0;
dato1.c7:=0;
dato1.c8:=0;

write(arch,dato1);
write(arch,dato1);
write(arch,dato1);


CloseFile(arch);
CloseFile(arch2);}

{************GRABA EN ARCHIVO**********}


AssignFile(arch,leeruta+'\tempo\orden.tmp');
AssignFile(arch2,leeruta+'\tempo\concen.tmp');

ReWrite(arch);
Reset(arch2);

{***calcula tamaņo de archivo****}
nreg:=FileSize(arch2);
FormaProgreso.BarraProgreso.Progress:=0;
FormaProgreso.Mensaje.Caption:='Ordenando Datos';
{**************************}
dato2.c1:=tipodato.c1;dato2.c2:=tipodato.c2;dato2.c3:=tipodato.c3;dato2.c4:=tipodato.c4;
dato2.c5:=tipodato.c5;dato2.c6:=tipodato.c6;dato2.c7:=tipodato.c7;dato2.c8:=tipodato.c8;
{write(arch,dato2);}
for i:=0 to nreg-1 do
begin
cadena:=ListaOrdenada.Strings[i];
regis:=numero(cadena);
{ShowMessage(cadena);}
if regis<=nreg-1 then
begin
Seek(arch2,regis);
Read(arch2,dato2);
write(arch,dato2);

FormaProgreso.BarraProgreso.Progress:=FormaProgreso.BarraProgreso.Progress+Trunc((i/nreg)*100);

end
else
ShowMessage(IntToStr(regis));

end;
{***calcula tamaņo de archivo****}
FormaProgreso.BarraProgreso.Progress:=100;
{**************************}



dato2.orden:='*';
dato2.nombre:='';
dato2.c1:='0';
dato2.c2:='0';
dato2.c3:='0';
dato2.c4:='0';
dato2.c5:='0';
dato2.c6:='0';
dato2.c7:='0';
dato2.c8:='0';

write(arch,dato2);
write(arch,dato2);
write(arch,dato2);

CloseFile(arch);
CloseFile(arch2);
ListaOrdenada.Free;
{****TERMINA LA GRABACION******}
end;

{****concentra por aņo***}
procedure porano;
type
registros=record
orden:String[100];
nombre:string[100];
c1,c2,c3,c4,c5,c6,c7,c8:String[25]{Real};
end;

var
arch,arch2:File of Registros;
dato1:Registros;
cadena:string[4];
begin
{****calcula los montos por mes*****}
AssignFile(arch,leeruta+'\tempo\final.tmp');
Reset(arch);
while not Eof(arch) do
begin
cadena:='';
Read(arch,dato1);
if dato1.orden<>'N.A.' then
begin
cadena:=dato1.orden[7]+dato1.orden[8]+dato1.orden[9]+dato1.orden[10];
dato1.orden:=cadena;
end
else
dato1.orden:='N.A.';
Seek(arch,FilePos(arch)-1);
Write(arch,dato1);
end;
CloseFile(arch);

{******regresadatos******}
AssignFile(arch,leeruta+'\tempo\final.tmp');
Reset(arch);
AssignFile(arch2,leeruta+'\tempo\concen.tmp');
Rewrite(arch2);

while not Eof(arch) do
begin
Read(arch,dato1);
Write(arch2,dato1);
end;
CloseFile(arch);
CloseFile(arch2);

{***por ultimo ordena los nuevos datos}
ordenalista;
concentraarchivo;
end;




procedure condiciones(cam1:string;o1:char;val1,tip1:string;cam2:string;o2:char;val2,tip2:string;cam3:string;o3:char;val3,tip3:string);
begin
campo1:=cam1;
campo2:=cam2;
campo3:=cam3;
op1:=o1;
op2:=o2;
op3:=o3;
valor1:=val1;
valor2:=val2;
valor3:=val3;
tipo1:=tip1;
tipo2:=tip2;
tipo3:=tip3;
end;

procedure concentrar(TablaConcentrar:TTable;rango1,rango2,campofecha,fechaini,fechafin,campodeorden,campodenombre:string;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string;op:char;vr,tipo:string);
begin
{if fechaini='' then fechaini}

TablaConcentrarA:=TablaConcentrar;
rango1A:=rango1;
rango2A:=rango2;
campofechaA:=campofecha;
fechainiA:=fechaini;
fechafinA:=fechafin;
campodeordenA:=campodeorden;
campodenombreA:=campodenombre;
concentrar1A:=concentrar1;
concentrar2A:=concentrar2;
concentrar3A:=concentrar3;
concentrar4A:=concentrar4;
concentrar5A:=concentrar5;
concentrar6A:=concentrar6;
concentrar7A:=concentrar7;
concentrar8A:=concentrar8;
crA:=cr;
opA:=op;
vrA:=vr;
tipoA:=tipo;
FormaProgreso.Timer1.Enabled:=True;
FormaProgreso.ShowModal;

end;

procedure concentrar2(TablaConcentrar:TTable;rango1,rango2,campofecha,fechaini,fechafin,campodeorden,campodenombre:string;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string;op:char;vr,tipo:string);

type
registros=record
orden:String[100];
nombre:String[100];
c1,c2,c3,c4,c5,c6,c7,c8:String[25];
{c1,c2,c3,c4,c5,c6,c7,c8:Real;}
end;

eti=record
orden:String[25];
c1,c2,c3,c4,c5,c6,c7,c8:String[25];
end;



var
arch:File of registros;
arch2:File of Eti;
dato:registros;
etiquetas:Eti;
valor:string;
fechavalida,camposvalidos,checacondiciones:Boolean;
intervalo, intervalo2:real;
i,nreg:longint;
c1,c2,c3:string;

begin
TablaConcentrar.First;
{*****obtiene los tipos de cada campo*******}
dato.orden:='';dato.nombre:='';
dato.c1:='x';dato.c2:='x';dato.c3:='x';dato.c4:='x';
dato.c5:='x';dato.c6:='x';dato.c7:='x';dato.c8:='x';
if (concentrar1<>'')and (concentrar1[1]<>'&') then dato.c1:=tipocampo(TablaConcentrar.FieldByName(concentrar1).Datatype);
if (concentrar2<>'')and (concentrar2[1]<>'&') then dato.c2:=tipocampo(TablaConcentrar.FieldByName(concentrar2).Datatype);
if (concentrar3<>'')and (concentrar3[1]<>'&') then dato.c3:=tipocampo(TablaConcentrar.FieldByName(concentrar3).Datatype);
if (concentrar4<>'')and (concentrar4[1]<>'&') then dato.c4:=tipocampo(TablaConcentrar.FieldByName(concentrar4).Datatype);
if (concentrar5<>'')and (concentrar5[1]<>'&') then dato.c5:=tipocampo(TablaConcentrar.FieldByName(concentrar5).Datatype);
if (concentrar6<>'')and (concentrar6[1]<>'&') then dato.c6:=tipocampo(TablaConcentrar.FieldByName(concentrar6).Datatype);
if (concentrar7<>'')and (concentrar7[1]<>'&') then dato.c7:=tipocampo(TablaConcentrar.FieldByName(concentrar7).Datatype);
if (concentrar8<>'')and (concentrar8[1]<>'&') then dato.c8:=tipocampo(TablaConcentrar.FieldByName(concentrar8).Datatype);

if (concentrar1<>'')and(concentrar1[1]='&') then dato.c1:='f';
if (concentrar2<>'')and(concentrar2[1]='&') then dato.c2:='f';
if (concentrar3<>'')and(concentrar3[1]='&') then dato.c3:='f';
if (concentrar4<>'')and(concentrar4[1]='&') then dato.c4:='f';
if (concentrar5<>'')and(concentrar5[1]='&') then dato.c5:='f';
if (concentrar6<>'')and(concentrar6[1]='&') then dato.c6:='f';
if (concentrar7<>'')and(concentrar7[1]='&') then dato.c7:='f';
if (concentrar8<>'')and(concentrar8[1]='&') then dato.c8:='f';

tipodato.c1:=dato.c1;tipodato.c2:=dato.c2;tipodato.c3:=dato.c3;tipodato.c4:=dato.c4;
tipodato.c5:=dato.c5;tipodato.c6:=dato.c6;tipodato.c7:=dato.c7;tipodato.c8:=dato.c8;
{*****finaliza obtiene los tipos de cada campo*******}

{FormaProgreso.Show;}
{ShowMessage('entrando concentrar');}

intervalo2:=0;
AssignFile(arch,leeruta+'\tempo\concen.tmp');
ReWrite(arch);
write(arch,dato);
{ShowMessage('entro a progreso  '+IntToStr(TablaConcentrar.RecordCount))}

if (TablaConcentrar.RecordCount>0)or(TablaConcentrar.Filtered) then
begin

if (rango1<>'')and(rango2<>'')and(rango1<=rango2)then
TablaConcentrar.SetRange([rango1],[rango2])
else
TablaConcentrar.CancelRange;
{**muestra avnace*****}

{FormaProgreso.Timer1.Enabled:=True;}

{FormaProgreso.BringToFront;}
{FormaProgreso.Cuadro.Show;
FormaProgreso.Label1.Show;
FormaProgreso.Panel1.Show;}

{****************}

{for i:=1 to 1000000 do;}
if TablaConcentrar.RecordCount>0 then
intervalo:=100/TablaConcentrar.RecordCount;
nreg:=TablaConcentrar.RecordCount;
TablaConcentrar.First;

checacondiciones:=True;
camposvalidos:=False;
camposvalidos:=checacampos;
FormaProgreso.BarraProgreso.Progress:=0;
i:=1;

{ShowMessage('entro a progreso');}

while not TablaConcentrar.Eof do
begin
{ShowMessage('entro a base');}

{****evalua las condiciones******}
if (cr<>'') then
valor:=TablaConcentrar.FieldByName(cr).AsString;
{***evalua las fechas de los doc******}
if ((fechaini='')and(fechafin=''))or(campofecha='f') then
fechavalida:=True
else
begin
if (campofecha<>'')and (campofecha<>'f') then
fechavalida:=periodo(TablaConcentrar.FieldByName(campofecha).AsString,fechaini,fechafin);
end;
{***evalua las fechas de los doc******}

if camposvalidos then
begin
if campo1<>'X' then
c1:=TablaConcentrar.FieldByName(campo1).AsString
else
c1:='X';

if campo2<>'X' then
c2:=TablaConcentrar.FieldByName(campo2).AsString
else
c2:='X';

if campo3<>'X' then
c3:=TablaConcentrar.FieldByName(campo3).AsString
else
c3:='X';

checacondiciones:=checa(c1,op1,valor1,tipo1)and checa(c2,op2,valor2,tipo2)and checa(c3,op3,valor3,tipo3);

end;
{****fin de evaluacion***************}

{if cumple(valor,op,vr) then
ShowMessage('valido cumple');

if fechavalida then
ShowMessage('valido fecha');

if checacondiciones then
ShowMessage('valido checacondiciones');
}

if (cumple(valor,op,vr))and(fechavalida)and (checacondiciones) then
begin

if TablaConcentrar.FieldByName(campodeorden).AsString='' then
dato.orden:='N.A.'
else
dato.orden:=TablaConcentrar.FieldByName(campodeorden).AsString;
if campodenombre<>'' then
dato.nombre:=TablaConcentrar.FieldByName(campodenombre).AsString
else
dato.nombre:='';


if concentrar1<>'' then
begin
if (concentrar1[1]='&') then
dato.c1:=formula(TablaConcentrar,concentrar1)
else
dato.c1:=TablaConcentrar.FieldByName(concentrar1).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[1]<>'' then
dato.c1:=CurrToStr(OperacionFuncion(dato.c1,operador[1],CurrToStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[1]).AsString))));

end
else
dato.c1:='0';


if concentrar2<>'' then
begin
if (concentrar2[1]='&') then
dato.c2:=formula(TablaConcentrar,concentrar2)
else
dato.c2:=TablaConcentrar.FieldByName(concentrar2).AsString{Float};

{****checa si se tiene que aplicar otra operacion*****}
if operador[2]<>'' then
dato.c2:=CurrToStr(OperacionFuncion(dato.c2,operador[2],CurrToStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[2]).AsString))));

end
else
dato.c2:='0';

if concentrar3<>'' then
begin
if (concentrar3[1]='&') then
dato.c3:=formula(TablaConcentrar,concentrar3)
else
dato.c3:=TablaConcentrar.FieldByName(concentrar3).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[3]<>'' then
dato.c3:=CurrToStr(OperacionFuncion(dato.c3,operador[3],CurrtoStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[3]).AsString))));

end
else
dato.c3:='0';

if concentrar4<>'' then
begin
if (concentrar4[1]='&') then
dato.c4:=formula(TablaConcentrar,concentrar4)
else
dato.c4:=TablaConcentrar.FieldByName(concentrar4).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[4]<>'' then
dato.c4:=CurrToStr(OperacionFuncion(dato.c4,operador[4],CurrtoStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[4]).AsString))));

end
else
dato.c4:='0';

if concentrar5<>'' then
begin
if (concentrar5[1]='&') then
dato.c5:=formula(TablaConcentrar,concentrar5)
else
dato.c5:=TablaConcentrar.FieldByName(concentrar5).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[5]<>'' then
dato.c5:=CurrToStr(OperacionFuncion(dato.c5,operador[5],CurrtoStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[5]).AsString))));

end
else
dato.c5:='0';

if concentrar6<>'' then
begin
{ShowMessage('buscando  '+concentrar6);}
if (concentrar6[1]='&') then
dato.c6:=formula(TablaConcentrar,concentrar6)
else
begin
dato.c6:=TablaConcentrar.FieldByName(concentrar6).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[6]<>'' then
dato.c6:=CurrToStr(OperacionFuncion(dato.c6,operador[6],CurrtoStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[6]).AsString))));

end;
end
else
dato.c6:='0';

if concentrar7<>'' then
begin
if (concentrar7[1]='&') then
dato.c7:=formula(TablaConcentrar,concentrar7)
else
dato.c7:=TablaConcentrar.FieldByName(concentrar7).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[7]<>'' then
dato.c7:=CurrToStr(OperacionFuncion(dato.c7,operador[7],CurrtoStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[7]).AsString))));

end
else
dato.c7:='0';

if concentrar8<>'' then
begin
if (concentrar8[1]='&') then
dato.c8:=formula(TablaConcentrar,concentrar8)
else
dato.c8:=TablaConcentrar.FieldByName(concentrar8).AsString{Float};
{****checa si se tiene que aplicar otra operacion*****}
if operador[8]<>'' then
dato.c8:=CurrToStr(OperacionFuncion(dato.c8,operador[8],CurrtoStr(ValorDivisaNombre(TablaConcentrar.FieldByName(variable[8]).AsString))));

end
else
dato.c8:='0';

write(arch,dato);
end;

Tablaconcentrar.Next;
i:=i+1;
{progresando(Trunc(FormaProgreso.BarraProgreso.Progress+intervalo2));}
FormaProgreso.BarraProgreso.Progress:=Trunc((i/nreg)*100);
end;
FormaProgreso.BarraProgreso.Progress:=100;

dato.orden:='*';
dato.c1:='0';
dato.c2:='0';
dato.c3:='0';
dato.c4:='0';
dato.c5:='0';
dato.c6:='0';
dato.c7:='0';
dato.c8:='0';

write(arch,dato);
CloseFile(arch);

{FormaProgreso.Close;}
{FormaProgreso.BarraProgreso.Progress:=100;}

if tipo='C' then
begin
DeleteFile(leeruta+'\tempo\final.tmp');
ordenalista;
concentraarchivo;
{DeleteFile(leeruta+'\tempo\final.tmp');
RenameFile(leeruta+'\tempo\orden.tmp',leeruta+'\tempo\final.tmp');
}
end;

if tipo='D' then
begin
DeleteFile(leeruta+'\tempo\final.tmp');
RenameFile(leeruta+'\tempo\concen.tmp',leeruta+'\tempo\final.tmp');
end;
end
else
begin
CloseFile(arch);
AssignFile(arch,leeruta+'\tempo\final.tmp');
ReWrite(arch);
CloseFile(arch);
end;
{****cirerra la forma*******}
FormaProgreso.Close;
TablaConcentrar.CancelRange;
end;
{******concentra cadenas******************}

procedure concentrarcadenas(TablaConcentrar:TTable;rango1,rango2,campofecha,fechaini,fechafin,campodeorden,campodenombre:string;concentrar1,concentrar2,concentrar3,concentrar4,concentrar5,concentrar6,concentrar7,concentrar8,cr:string;op:char;vr,tipo:string);
type
registros=record
orden:String[100];
nombre:String[100];
c1,c2,c3,c4,c5,c6,c7,c8:String[40];
end;

eti=record
orden:String[25];
c1,c2,c3,c4,c5,c6,c7,c8:String[25];
end;

var
arch:File of registros;
arch2:File of Eti;
dato:registros;
etiquetas:Eti;
valor:string;
fechavalida:Boolean;
intervalo, intervalo2:real;

begin
{MuestraMensaje(leeruta+'\tempo\concen.tmp');}
intervalo2:=0;
AssignFile(arch,leeruta+'\tempo\concen.tmp');
ReWrite(arch);
if TablaConcentrar.RecordCount>0 then
begin

if (rango1<>'')and(rango2<>'')then
TablaConcentrar.SetRange([rango1],[rango2])
else
TablaConcentrar.CancelRange;
FormaProgreso.Show;

intervalo:=100/TablaConcentrar.RecordCount;
TablaConcentrar.First;

while not TablaConcentrar.Eof do
begin
if (cr<>'') then
valor:=TablaConcentrar.FieldByName(cr).AsString;
fechavalida:=True;

if (campofecha<>'')and (campofecha<>'f') then
fechavalida:=periodo(TablaConcentrar.FieldByName(campofecha).AsString,fechaini,fechafin);

if (cumple(valor,op,vr))and(fechavalida) then
begin
if TablaConcentrar.FieldByName(campodeorden).AsString='' then
dato.orden:='N.A.'
else
dato.orden:=TablaConcentrar.FieldByName(campodeorden).AsString;
if campodenombre<>'' then
dato.nombre:=TablaConcentrar.FieldByName(campodenombre).AsString
else
dato.nombre:='';

if concentrar1<>'' then
begin
dato.c1:=TablaConcentrar.FieldByName(concentrar1).AsString;
end
else
dato.c1:='';

if concentrar2<>'' then
begin
dato.c2:=TablaConcentrar.FieldByName(concentrar2).AsString;
end
else
dato.c2:='';

if concentrar3<>'' then
begin
dato.c3:=TablaConcentrar.FieldByName(concentrar3).AsString;
end
else
dato.c3:='';

if concentrar4<>'' then
begin
if (concentrar4[1]='&') then
dato.c4:=TablaConcentrar.FieldByName(concentrar4).AsString;
end
else
dato.c4:='';

if concentrar5<>'' then
begin
dato.c5:=TablaConcentrar.FieldByName(concentrar5).AsString;

end
else
dato.c5:='';

if concentrar6<>'' then
begin
dato.c6:=TablaConcentrar.FieldByName(concentrar6).AsString;
end
else
dato.c6:='';

if concentrar7<>'' then
begin
dato.c7:=TablaConcentrar.FieldByName(concentrar7).AsString;
end
else
dato.c7:='';

if concentrar8<>'' then
begin
dato.c8:=TablaConcentrar.FieldByName(concentrar8).AsString;
end
else
dato.c8:='';

write(arch,dato);
end;

Tablaconcentrar.Next;
intervalo2:=intervalo2+intervalo;
FormaProgreso.BarraProgreso.Progress:=Trunc(FormaProgreso.BarraProgreso.Progress+intervalo2);

end;
dato.orden:='*';
dato.c1:='';
dato.c2:='';
dato.c3:='';
dato.c4:='';
dato.c5:='';
dato.c6:='';
dato.c7:='';
dato.c8:='';

write(arch,dato);

CloseFile(arch);


FormaProgreso.Close;
FormaProgreso.BarraProgreso.Progress:=0;
if tipo='C' then
begin
{ordenalista;
concentraarchivo;}
{DeleteFile(leeruta+'\tempo\final.tmp');
RenameFile(leeruta+'\tempo\orden.tmp',leeruta+'\tempo\final.tmp');
}
end;

if tipo='D' then
begin
DeleteFile(leeruta+'\tempo\final.tmp');
RenameFile(leeruta+'\tempo\concen.tmp',leeruta+'\tempo\final.tmp');
end;
end
else
begin
CloseFile(arch);
AssignFile(arch,leeruta+'\tempo\final.tmp');
ReWrite(arch);
CloseFile(arch);

{****cirerra la forma*******}
FormaProgreso.Close;

end;
end;


{*****************************************}



{**termina concen*********}





procedure progresando(avance:integer);
begin
with FormaProgreso do
begin
if not FormaProgreso.Visible then
FormaProgreso.Show;
avan:=avance;
end;
end;

procedure TFormaProgreso.Panel2Click(Sender: TObject);
begin
Close;
end;




procedure TFormaProgreso.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:=False;
Mensaje.Caption:='Espere por Favor';
concentrar2(TablaConcentrarA,rango1A,rango2A,campofechaA,fechainiA,fechafinA,campodeordenA,campodenombreA,concentrar1A,concentrar2A,concentrar3A,concentrar4A,concentrar5A,concentrar6A,concentrar7A,concentrar8A,crA,opA,vrA,tipoA);
condiciones('','X','','','','X','','','','X','','');
end;

procedure TFormaProgreso.FormCreate(Sender: TObject);
begin
avan:=0;
end;

procedure TFormaProgreso.FormShow(Sender: TObject);
begin

FormaProgreso.BringToFront;

end;

procedure TFormaProgreso.FormActivate(Sender: TObject);
var
i:integer;
begin
for i:=0 to 10000 do;
end;

procedure TFormaProgreso.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
FormaProgreso.BarraProgreso.Progress:=0;
end;

end.