unit formato;

interface
uses
Windows, SysUtils, Graphics,DBTables,Printers,classes,conver,checa,dialogos,extctrls,Dialogs;
  {Printers,DBTables,SysUtils,graphics,Windows,dialogs,conver,checa;}
type
dato=record
x:integer;
y:integer;
texto:String[125];
tamoletra:integer;
letra:string[50];
color:String[8];
formato:String[25];
end;

var
sep,anc:integer;
sal:char;
formateo:string;
tipoletra:string[50];
tamano:integer;
colorletra:string[8];
variables:array[1..10]of Real;
cadenas:array[1..10]of String;
ListaInstrucciones:TStringlist;
mone:array[1..4] of String[30];
procedure forma(Tabla,TablaDeta:TTable;archivo: String;salida:char);
function traduce(cantidad:Real):String;
function iniciaimpresion:Boolean;
function terminaimpresion:Boolean;
procedure LeeEtiquetasMoneda(uno,dos,tres,cuatro:string);
implementation

procedure LeeEtiquetasMoneda(uno,dos,tres,cuatro:string);
begin
mone[1]:=uno;
mone[2]:=dos;
mone[3]:=tres;
mone[4]:=cuatro;

end;


function ChecaValido(ca:string;op:char;va,ti:string):Boolean;
var
numero:Real;
error1:Integer;
begin
{sHOWmESSAGE('entro a checa valido '+ca+'  '+op+'  '+va+'  '+ti);}
if ca<>'X' then
begin
if ti='ftString' then
begin
case op of
'=':if ca=va then checaValido:=True else checaValido:=False;
'<':if ca<va then checaValido:=True else checaValido:=False;
'>':if ca>va then checaValido:=True else checaValido:=False;
'X':if ca<>va then checaValido:=True else checaValido:=False;
'Y':if ca<=va then checaValido:=True else checaValido:=False;
'Z':if ca>=va then checaValido:=True else checaValido:=False;
end;

end;

if ti='ftDate' then
begin
if ca='' then ca:='01/01/1900';
case op of
'=':if StrToDateTime(ca)=StrToDateTime(va) then checaValido:=True else checaValido:=False;
'<':if StrToDateTime(ca)<StrToDateTime(va) then checaValido:=True else checaValido:=False;
'>':if StrToDateTime(ca)>StrToDateTime(va) then checaValido:=True else checaValido:=False;
'X':if StrToDateTime(ca)<>StrToDateTime(va) then checaValido:=True else checaValido:=False;
'Y':if StrToDateTime(ca)<=StrToDateTime(va) then checaValido:=True else checaValido:=False;
'Z':if StrToDateTime(ca)<=StrToDateTime(va) then checaValido:=True else checaValido:=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 checaValido:=True else checaValido:=False;
'<':if numero<StrToFloat(va) then checaValido:=True else checaValido:=False;
'>':if numero>StrToFloat(va) then checaValido:=True else checaValido:=False;
'X':if numero<>StrToFloat(va) then checaValido:=True else checaValido:=False;
'Y':if numero<=StrToFloat(va) then checaValido:=True else checaValido:=False;
'Z':if numero>=StrToFloat(va) then checaValido:=True else checaValido:=False;
end;
end;

end
else
checaValido:=True;
end;


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

function tipocampo(valorcampo:string):integer;
var i,tipo:integer;
aux:string;
begin
tipo:=-1;
if (length(valorcampo)>3)and(valorcampo[1]='[')and(valorcampo[5]=']') then
val(valorcampo[2]+valorcampo[3]+valorcampo[4],i,tipo);

if tipo<>0 then
begin

if (valorcampo='variable1')or (valorcampo='variable2')or (valorcampo='variable3')or (valorcampo='variable4')or (valorcampo='variable5')or (valorcampo='variable6') then
tipocampo:=-2
else

tipocampo:=-1;
end
else
begin

if (valorcampo[1]='[') and (valorcampo[5]=']') then
tipocampo:=i;


end;

end;


function operador(sim:char):Boolean;
begin
if (sim='=')or(sim='+')or(sim='-')or(sim='*')or(sim='/')or(sim='!')or(sim='<')or(sim='>') then
operador:=True
else
operador:=False;
end;


function evaluacondicion(lin:string;tabla:TTable):boolean;
var
cuenta:word;
aux:String;
val1,val2:String;
palab:array[1..4]of String;
tip1,tip2,i:integer;
begin

aux:='';
cuenta:=1;
{ShowMessage(lin);}

for i:=1 to length(lin) do
begin
if (lin[i]<>')')and(not operador(lin[i])) then
aux:=aux+lin[i];
if (operador(lin[i]))or (lin[i]='(') then
begin
palab[cuenta]:=aux;
cuenta:=cuenta+1;
if operador(lin[i]) then
begin
palab[cuenta]:=lin[i];
cuenta:=cuenta+1;
end;
aux:='';
end;
end;
palab[cuenta]:=aux;

{*****termino la separacion* inicia la evaluacion ****}
{ShowMessage('el resultado es %'+palab[1]+'% '+palab[2]+'%  '+palab[3]+'%');}

tip1:=tipocampo(palab[2]);
tip2:=tipocampo(palab[4]);
{ShowMessage(' valores de campo val1 '+IntToStr(tip1)+'val 2 '+IntToStr(tip2));}

if tip1<0 then
begin
val1:=palab[2];
val1:=palab[2];
end
else
val1:=Tabla.Fields[tip1].AsString;

if tip2<0 then
begin
val2:=palab[4];
val2:=palab[4];
end
else
val2:=Tabla.Fields[tip2].AsString;

{ShowMessage('valor de tabla '+Tabla.Fields[0].AsString);}
if ChecaValido(val1,palab[3][1],val2,'ftString') then
evaluacondicion:=True
{ShowMessage(val1+palab[3][1]+' '+val2+' '+' condicion verdadera')}
else
evaluacondicion:=False;
{ShowMessage(val1+palab[3][1]+' '+val2+' '+' condicion falsa');}

end;


{%%%%%%%%%%%%%%%%%inicia traduce %%%%%%%%%%%%%%%}


function VariableNumerica(ope:string):Word;
var
nume:word;
begin
nume:=0;
if ope='variable1' then nume:=1;
if ope='variable2' then nume:=1;
if ope='variable3' then nume:=1;
if ope='variable4' then nume:=1;
if ope='variable5' then nume:=1;
if ope='variable6' then nume:=1;

if ope='cadena1' then nume:=2;
if ope='cadena2' then nume:=2;
if ope='cadena3' then nume:=2;
if ope='cadena4' then nume:=2;
if ope='cadena5' then nume:=2;
if ope='cadena6' then nume:=2;

VariableNumerica:=nume;

end;

function valores(ope:string):String;
var
aux:string;
codi:integer;
num:Real;
nume:String;
begin
nume:='';
val(ope,num,codi);
if codi=0 then
valores:=ope
else
valores:='0';
{ShowMessage('valor de ope '+ope);}
if ope='variable1' then nume:=FloatToStr(variables[1]);
if ope='variable2' then nume:=FloatToStr(variables[2]);
if ope='variable3' then nume:=FloatToStr(variables[3]);
if ope='variable4' then nume:=FloatToStr(variables[4]);
if ope='variable5' then nume:=FloatToStr(variables[5]);
if ope='variable6' then nume:=FloatToStr(variables[6]);

if ope='cadena1' then nume:=cadenas[1];
if ope='cadena2' then nume:=cadenas[2];
if ope='cadena3' then nume:=cadenas[3];
if ope='cadena4' then nume:=cadenas[4];
if ope='cadena5' then nume:=cadenas[5];
if ope='cadena6' then nume:=cadenas[6];


valores:=nume;
{ShowMessage('valor '+FloatToStr(nume));}
end;

function AsignaVariable(ope:string;nume:Real):Boolean;
begin
AsignaVariable:=False;

if ope='variable1' then
begin
variables[1]:=nume;
AsignaVariable:=True;
end;
if ope='variable2' then
begin
variables[2]:=nume;
AsignaVariable:=True;
end;

if ope='variable3' then
begin
 variables[3]:=nume;
AsignaVariable:=True;
end;

if ope='variable4' then
begin
 variables[4]:=nume;
AsignaVariable:=True;
end;

if ope='variable5' then
begin
variables[5]:=nume;
AsignaVariable:=True;
end;

if ope='variable6' then
begin
variables[6]:=nume;
AsignaVariable:=True;
end;
end;

function AsignaVariableCadena(ope:string;cad:string):Boolean;
begin
AsignaVariableCadena:=False;

if ope='cadena1' then
begin
cadenas[1]:=cad;
AsignaVariableCadena:=True;
end;
if ope='cadena2' then
begin
cadenas[2]:=cad;
AsignaVariableCadena:=True;
end;

if ope='cadena3' then
begin
cadenas[3]:=cad;
AsignaVariableCadena:=True;
end;

if ope='cadena4' then
begin
cadenas[4]:=cad;
AsignaVariableCadena:=True;
end;

if ope='cadena5' then
begin
cadenas[5]:=cad;
AsignaVariableCadena:=True;
end;

if ope='cadena6' then
begin
cadenas[6]:=cad;
AsignaVariableCadena:=True;
end;


end;



function EjecutaOperacionCadena(ope1:string;sim:char;ope2:string):String;
begin
if valores(ope1)<>'' then
ope1:=valores(ope1);
if valores(ope2)<>'' then
ope2:=valores(ope2);

EjecutaOperacionCadena:=ope1+ope2;


end;


Function EjecutaOperacion(ope1:String;sim:Char;ope2:string):Real;
var
valor,nume:Real;
codigo1,codigo2:integer;
begin


val(ope1,nume,codigo1);
val(ope2,nume,codigo2);

if (codigo1=0)and(codigo2=0) then
begin
case sim of

'+':valor:=StrToFloat(ope1)+StrToFloat(ope2);
'-':valor:=StrToFloat(ope1)-StrToFloat(ope2);
'*':valor:=StrToFloat(ope1)*StrToFloat(ope2);
'/':if StrToFloat(ope2)<>0 then
valor:=StrToFloat(ope1)/StrToFloat(ope2);
end;

EjecutaOperacion:=valor;
end
else
EjecutaOperacion:=0;
{ShowMessage('resultado  '+FloatToStr(valor));}
end;


function OperacionValida(cadena:string;Tabla:TTable):Boolean;
var
aux:string;
i,cuenta,cuentasim:integer;
simbolo,operando:Array[1..10]of String;
buf:Real;
sim:Char;
ope1,ope2:integer;
bufcad:String;
begin
cuenta:=1;
cuentasim:=1;

aux:='';
if cadena<>'' then
for i:=1 to Length(cadena) do
begin
if not operador(cadena[i]) then
begin
aux:=aux+cadena[i]
end
else
begin
simbolo[cuentasim]:=cadena[i];
operando[cuenta]:=aux;
{ShowMessage(aux+cadena[i]);}
aux:='';
cuenta:=cuenta+1;
cuentasim:=cuentasim+1;
end;
end;
if aux<>'' then
operando[cuenta]:=aux;

{***********prueba que este bien*****}
{if cuenta=5 then
begin}
sim:=simbolo[2][1];
{ShowMessage('simbolo '+sim);}
{*******separa por valores de cada variable******}
ope1:=tipocampo(operando[2]);
ope2:=tipocampo(operando[3]);
{ShowMessage('tipo 3 '+IntToStr(tipocampo(operando[3])));}

case ope1 of
-1:operando[2]:=operando[2];
-2:operando[2]:=valores(operando[2]);
-3:operando[2]:=operando[2];
else
operando[2]:=Tabla.Fields[ope1].AsString;
end;

case ope2 of
-1:operando[3]:=operando[3];
-2:operando[3]:=valores(operando[3]);
-3:operando[3]:=operando[3];
else
begin
operando[3]:=Tabla.Fields[ope2].AsString;
{ShowMessage(operando[3]);}
end;
end;

{*****************termina la asignacion**********}
{ShowMessage('los valores son '+operando[1]+' '+operando[2]+'  '+sim+'  '+operando[3]);}

if VariableNumerica(operando[1])=1 then
begin
buf:=EjecutaOperacion(operando[2],sim,operando[3]);
if AsignaVariable(operando[1],buf)then
OperacionValida:=True
else
OperacionValida:=False;
end;

if VariableNumerica(operando[1])=2 then
begin
bufcad:=EjecutaOperacionCadena(operando[2],sim,operando[3]);
AsignaVariableCadena(operando[1],bufcad);
{ShowMessage(bufcad);}
end;

{end;}
{ShowMessage(FloatToStr(buf));}
end;


function iniciaimpresion;
begin
Printer.BeginDoc;


end;


function terminaimpresion;
begin
Printer.EndDoc;
end;

function tipodepalabra(lin:string):Word;
var
l:string[3];
begin
l:='';
l:=lin;if l[1]='@' then tipodepalabra:=1;
{if l[1]='&' then palabra:=2;}
if l='col' then tipodepalabra:=3;
if l='tra' then tipodepalabra:=4;
if l='cua' then tipodepalabra:=5;
if l='tam' then tipodepalabra:=6;
if l='tip' then tipodepalabra:=7;
if l='log' then tipodepalabra:=8;
if l='dia' then tipodepalabra:=9;
if l='mes' then tipodepalabra:=10;
if l='año' then tipodepalabra:=11;
if l='tex' then tipodepalabra:=12;
if l='mon' then tipodepalabra:=13;
if l='est' then tipodepalabra:=14;
if l='for' then tipodepalabra:=16;
if l='fec' then tipodepalabra:=17;
if l='sep' then
begin
sep:=Trunc(StrToFloat(lin[8])*25);
end;
if (l='var')or(l='cad') then tipodepalabra:=18;
{if l='var' then tipodepalabra:=18;}


end;


procedure imprimedato(x,y:integer;texto,formatotexto:string;tamoletra:integer;letra:string);
var
arch:File of Dato;
dat:dato;
begin
if sal='i' then
Printer.Canvas.TextOut(x,y,texto)
else
begin
AssignFile(arch,leeruta+'\tempo\format.tmp');
Reset(arch);
Seek(arch, FileSize(arch));
dat.x:=x;
dat.y:=y;
dat.texto:=texto;
dat.tamoletra:=tamoletra;
{dat.letra:=tipoletra;}
dat.letra:=letra;
dat.color:=colorletra;
{if texto<>'moneda' then
dat.formato:=''
else}
{dat.formato:=formateo;}
Write(arch,dat);
CloseFile(arch);
end;
end;

procedure dibujabitmap(x,y,nombre:String);
var
  mapa: TPicture;
  rectangulo:TRect;
  a,b:integer;
  foto:Timage;
begin

if sal='i' then
begin
if (x<>'') and(y<>'')and FileExists(nombre) then
begin
  mapa := TPicture.Create;
  mapa.Bitmap.LoadFromFile(nombre);
  a:=StrToInt(x);
  b:=StrToInt(y);
  rectangulo.Left:=5+a;
  rectangulo.Top:=5+b;
  rectangulo.Right:=300+a;
  rectangulo.Bottom:=500+b;
  Printer.Canvas.StretchDraw(rectangulo,mapa.Graphic);
end
else
imprimedato(StrToInt(x),StrToInt(y),nombre,'',-1,'0');
end;

end;



{function tipocampo(valorcampo:string):integer;
var i,tipo:integer;
aux:string;
begin

val(valorcampo[2]+valorcampo[3]+valorcampo[4],i,tipo);

if tipo<>0 then
begin

if (valorcampo='variable1')or (valorcampo='variable2')or (valorcampo='variable3')or (valorcampo='variable4')or (valorcampo='variable5')or (valorcampo='variable6') then
tipocampo:=-2
else
tipocampo:=-1;

end
else
begin

if (valorcampo[1]='[') and (valorcampo[5]=']') then
tipocampo:=i;

end;

end; }

function procesa(triada,peso:integer):String;
var
unidad,decena,centena,decuni:word;
canti,letra:String;

begin
centena:=Trunc(triada/100);
decena:=Trunc((triada-(centena*100))/10);
unidad:=Trunc(triada-(centena*100)-(decena*10));
decuni:=Trunc(triada-(centena*100));
canti:='';
letra:='';
if (triada=100) and ((peso=1)or (peso=2)or (peso=3)) then
canti:=' cien'
else
case centena of
1: canti:=' ciento';
2: canti:=' doscientos';
3: canti:=' trescientos';
4: canti:=' cuatrocientos';
5: canti:=' quinientos';
6: canti:=' seiscientos';
7: canti:=' setecientos';
8: canti:=' ochocientos';
9: canti:=' novecientos';
end;
letra:=letra+canti;
canti:='';

if decuni>=30 then
case decena of
3: canti:=' treinta';
4: canti:=' cuarenta';
5: canti:=' cincuenta';
6: canti:=' sesenta';
7: canti:=' setenta';
8: canti:=' ochenta';
9: canti:=' noventa';
end;
letra:=letra+canti;
canti:='';

if (decuni<30) and (decuni>9) then
case decuni of
10: canti:=' diez';
11: canti:=' once';
12: canti:=' doce';
13: canti:=' trece';
14: canti:=' catorce';
15: canti:=' quince';
16: canti:=' dieciseis';
17: canti:=' diecisiete';
18: canti:=' dieciocho';
19: canti:=' diecinueve';
20: canti:=' veinte';
21: canti:=' veintiun';
22: canti:=' veintidos';
23: canti:=' ventitres';
24: canti:=' veinticuatro';
25: canti:=' veinticinco';
26: canti:=' veintiseis';
27: canti:=' veintisiete';
28: canti:=' veintiocho';
29: canti:=' veintinueve';
end;
letra:=letra+canti;
canti:='';

if decuni>30 then
case unidad of
1: canti:=' y un';
2: canti:=' y dos';
3: canti:=' y tres';
4: canti:=' y cuatro';
5: canti:=' y cinco';
6: canti:=' y seis';
7: canti:=' y siete';
8: canti:=' y ocho';
9: canti:=' y nueve';
end;
letra:=letra+canti;
canti:='';

if decuni<10 then
case unidad of
1: canti:=' un';
2: canti:=' dos';
3: canti:=' tres';
4: canti:=' cuatro';
5: canti:=' cinco';
6: canti:=' seis';
7: canti:=' siete';
8: canti:=' ocho';
9: canti:=' nueve';
end;
letra:=letra+canti;
canti:='';

case peso of
2:begin
if (Triada<>0)then
 canti:=' mil';

 end;
3:begin
  if (decena=0) and (centena=0) and (unidad=1) then
    canti:=' millón'
  else
  begin
    canti:=' millones'
  end;
  end;
4:begin
canti:=' mil';
  end;

end;

letra:=letra+canti;
canti:='';

procesa:=letra;
end;

function traduce(cantidad:Real):String;
var
aux,letra,cifras,triada:String;
valores:array[1..10] of longint;
cifra:longint;
j,i,pos,ult,peso:integer;
deci:String[24];
begin
Str(cantidad:20:2,aux);
cantidad:=StrToFloat(aux);
aux:=intToStr(Trunc(cantidad));
j:=length(aux);
{MuestraMensaje('valor original   '+aux);}
letra:='';
cifras:='';
pos:=1;
for i:=length(aux) downto 1 do
begin
if pos=3 then
begin
cifras:=','+aux[i]+cifras;
pos:=1;
end
else
begin
cifras:=aux[i]+cifras;
pos:=pos+1;
end;

end;
if pos=2 then
cifras:=',00'+cifras;
if pos=3 then
cifras:=',0'+cifras;
pos:=1;
triada:='';
peso:=0;

{MuestraMensaje('*'+cifras);}
for i:=length(cifras) downto 1 do
begin
if cifras[i]=',' then
begin
peso:=peso+1;
{MuestraMensaje(triada);}
letra:=procesa(trunc(StrToFloat(triada)),peso)+letra;
{if trunc(StrToFloat(triada)=1 then
letra:=un;}
triada:='';
end
else
begin
triada:=cifras[i]+triada;

end;
end;
{MuestraMensaje(letra);}

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

Str(cantidad:20:2,deci);
deci:=deci[length(deci)-1]+deci[length(deci)];
if Trunc(cantidad)=0 then
letra:='cero ';

if Trunc(cantidad)=1 then
letra:=letra+' '+mone[1]+' '+deci+'/100 '+mone[4]
else
begin
if letra[length(letra)-3]+letra[length(letra)-2]+letra[length(letra)-1]+letra[length(letra)]='ones' then
letra:=letra+' '+mone[2]+' '+deci+'/100 '+mone[4]
else
letra:=letra+' '+mone[3]+' '+deci+'/100 '+mone[4] ;

end;
triada:='';
{MuestraMensaje(letra);}
traduce:='('+UpperCase(letra)+')';
end;

{*******termina cantidad con letra******}


procedure imprimelinea(Tabla,TablaDeta:TTable;li:string;tipo,y:integer;palabra:word);
var
l,j,i,conta,cod:integer;
aux:string;
valor:array[1..4] of string;
palabras:array[1..6]of string;
nume:Real;
a,m,d:Word;
ms:String[2];
begin
conta:=1;
i:=1;
palabras[1]:='';
palabras[2]:='';
palabras[3]:='';
palabras[4]:='';
palabras[5]:='';
palabras[6]:='';
if li[1]='@' then
begin
palabras[1]:='@';
conta:=2;
i:=2;
end;

{****separa la linea en palabrsa*****}
while (i<=length(li))and (conta<=6) do
begin
if ((li[i]=',')and (palabras[1]<>'formato'))or(li[i]='(')or(li[i]=')') then
conta:=conta+1

else
begin
if conta<7 then
begin
if (li[i]<>' ') and (li[i]<>')') then
palabras[conta]:=palabras[conta]+li[i];
end
else
if (li[i]<>'@') and (li[i]<>')') then
palabras[conta]:=palabras[conta]+li[i];
end;
i:=i+1;
end;
aux:='';

{ShowMessage(li);}

case palabra of
1:begin
{ShowMessage(palabras[1]+'**'+palabras[2]+'***'+palabras[3]+'***'+palabras[4]);}

if VariableNumerica(palabras[4])=0 then
begin
     if tipocampo(palabras[4])<>-1 then
     imprimedato(StrToInt(palabras[2])*anc,Trunc(sep*(StrToFloat(palabras[3])+y)),Tabla.Fields[tipocampo(palabras[4])].AsString,'',tamano,tipoletra)
     else
     begin
     if palabras[4]<>'' then
     case tipocampo(palabras[4]) of
     -1: imprimedato(StrToInt(palabras[2])*anc,Trunc(sep*(StrToFloat(palabras[3])+y)),Tabla.FieldByName(palabras[4]).AsString,'',tamano,tipoletra);
{     -2: imprimedato(StrToInt(palabras[2])*anc,Trunc(sep*(StrToFloat(palabras[3])+y)),valores(palabras[4]),'',tamano,tipoletra);}
     end;
      end;
end
else
begin

 imprimedato(StrToInt(palabras[2])*anc,Trunc(sep*(StrToFloat(palabras[3])+y)),valores(palabras[4]),'',tamano,tipoletra);

end;


end;

3:begin
if sal='i' then
begin
  if palabras[2]='rojo' then
  Printer.Canvas.Font.Color:=clRed;
  if palabras[2]='azul' then
  Printer.Canvas.Font.Color:=clBlue;
  if palabras[2]='verde' then
  Printer.Canvas.Font.Color:=clGreen;
  if palabras[2]='amarillo' then
  Printer.Canvas.Font.Color:=clYellow;
  if palabras[2]='negro' then
  Printer.Canvas.Font.Color:=clBlack;
end
else
begin
colorletra:=palabras[2];
formateo:='';
end;

end;

4:begin
    if tipocampo(palabras[4])>-1 then
     imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToInt(palabras[3])+y)),traduce(Tabla.Fields[tipocampo(palabras[4])].AsFloat),'',tamano,tipoletra)
     else
     begin
     case tipocampo(palabras[4]) of
     -1:imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToInt(palabras[3])+y)),traduce(Tabla.FieldByName(palabras[4]).AsFloat),'',tamano,tipoletra);
     -2: imprimedato(StrToInt(palabras[2])*anc,Trunc(sep*(StrToFloat(palabras[3])+y)),valores(palabras[4]),'',tamano,tipoletra);
     end;

     end;
  end;
5:begin
if sal='i' then
  Printer.Canvas.Rectangle(StrToInt(palabras[2]),StrToInt(palabras[3]),StrToInt(palabras[4]),StrToInt(palabras[5]));
  end;

6:begin
tamano:=StrToInt(palabras[2]);
if sal='i' then
Printer.Canvas.Font.Size:=StrToInt(palabras[2]);

end;


7:begin
tipoletra:=Palabras[2];

if sal='i' then
  begin

  Printer.Canvas.Font.Name:=Palabras[2];
  end;
end;

8:begin

  if (palabras[1]='logo') then
  begin
{  MuestraMensaje(palabras[2]);}
  dibujabitmap(palabras[2],palabras[3],palabras[6]);

  end;
  end;

9:begin
  if (palabras[1]='dia') then
  begin
  if tipocampo(palabras[4])>-1 then
  begin
    if tipocampo(palabras[4])>-1 then
     DecodeDate(Tabla.Fields[tipocampo(palabras[4])].AsDateTime,a,m,d)
     else
     DecodeDate(Tabla.FieldByName(palabras[4]).AsDateTime,a,m,d);

  end
  else
  begin
    if tipocampo(palabras[4])>-1 then
    DecodeDate(Tabla.Fields[tipocampo(palabras[4])].AsDateTime,a,m,d)
     else
    DecodeDate(Tabla.FieldByName(palabras[4]).AsDateTime,a,m,d);
  end;
  end;
  if d<10 then ms:='0'+IntToStr(d)
  else ms:=IntToStr(d);
  imprimedato(anc*StrToInt(palabras[2])+y*50,Trunc(sep*StrToFloat(palabras[3])),ms,'',tamano,tipoletra);

  end;
10:begin
  if (palabras[1]='mes') then
  begin
  if tipocampo(palabras[4])>-1 then
   DecodeDate(Tabla.Fields[tipocampo(palabras[4])].AsDateTime,a,m,d)
   else
   DecodeDate(Tabla.FieldByName(palabras[4]).AsDateTime,a,m,d);
  end;
  if m<10 then ms:='0'+IntToStr(m)
  else ms:=IntToStr(m);
  imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*StrToFloat(palabras[3])+y*50),ms,'',tamano,tipoletra);
  end;

11:begin
  if (palabras[1]='año') then
  begin
  if tipocampo(palabras[4])>-1 then
  DecodeDate(Tabla.Fields[tipocampo(palabras[4])].AsDateTime,a,m,d)
  else
  DecodeDate(Tabla.FieldByName(palabras[4]).AsDateTime,a,m,d);
  imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToFloat(palabras[3])+y)),IntToStr(a),'',tamano,tipoletra);
  end;
  end;

12:begin
  if (palabras[1]='texto') then
  imprimedato(anc*StrToInt(palabras[2])+y*50,Trunc(sep*StrToFloat(palabras[3])),palabras[4],'',tamano,tipoletra);
  end;

13:begin
  Printer.Canvas.Font.Name:='Courier New';

  if (palabras[1]='moneda') then
  if tipo=1 then
  begin
   if tipocampo(palabras[4])>-1 then
   imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToFloat(palabras[3])+y)),convierte(formateo,TablaDeta.Fields[tipocampo(palabras[4])].AsString,{StrToInt}(palabras[5])),formateo,tamano,'Courier New')
   else
   begin
   case tipocampo(palabras[4]) of
   -1:imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToFloat(palabras[3])+y)),convierte(formateo,TablaDeta.FieldByName(palabras[4]).AsString,{StrToInt}(palabras[5])),formateo,tamano,'Courier New');
   -2:imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToFloat(palabras[3])+y)),convierte(formateo,valores(palabras[4]),{StrToInt}(palabras[5])),formateo,tamano,'Courier New');
   end;
   end;

   Printer.Canvas.Font.Name:=tipoletra;
  end
    else
    begin
    if tipocampo(palabras[4])>-1 then
    imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*StrToFloat(palabras[3])+y*50),convierte(formateo,Tabla.Fields[tipocampo(palabras[4])].AsString,{StrToInt}(palabras[5])),formateo,tamano,'Courier New')
    else
    begin
    case tipocampo(palabras[4]) of
    -1:imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*StrToFloat(palabras[3])+y*50),convierte(formateo,Tabla.FieldByName(palabras[4]).AsString,{StrToInt}(palabras[5])),formateo,tamano,'Courier New');
    -2:imprimedato(anc*StrToInt(palabras[2]),Trunc(sep*(StrToFloat(palabras[3])+y)),convierte(formateo,valores(palabras[4]),{StrToInt}(palabras[5])),formateo,tamano,'Courier New');
    end;

    end;
    end;
    Printer.Canvas.Font.Name:=tipoletra;
  end;

14:begin
  if palabras[1]='estilo' then
  begin
  if sal='i' then
  begin
  case StrToInt (Palabras[2]) of
  0: Printer.Canvas.Font.Style:=[];
  1: Printer.Canvas.Font.Style:=[FsBold];
  2: Printer.Canvas.Font.Style:=[FsItalic];
  3: Printer.Canvas.Font.Style:=[FsUnderLine];
  4: Printer.Canvas.Font.Style:=[FsStrikeOut];
  end;
  end;
  end;
  end;
15:begin
  if (palabras[1]='separa') then
  sep:=Trunc(25*StrToFloat(palabras[2]));
  end;

16:begin
{   MuestraMensaje(palabras[2]);}
   if (palabras[1]='formato') then
     formateo:=palabras[2];
   end;

18:begin
{ShowMessage(li);}
if OperacionValida(li,Tabla) then
begin
{ShowMessage('operacion valida');}
end;

end;

19:begin
   OperacionValida(palabras[1],Tabla);
   end;

{***terminan las opciones***********}
end;

end;

procedure imprimedetalle(Tabla,TablaDeta:TTable);
var
arch2:TextFile;
lin:string;
tipo,y:integer;
palabra:Word;
bloquecierto:Boolean;
inicio,cuenta,termino:integer;
begin
ListaInstrucciones:=TStringList.Create;
TablaDeta.First;
y:=0;
while not TablaDeta.Eof do
begin
AssignFile(arch2,leeruta+'\consulta\detatmp.tmp');
reset(arch2);
tipo:=1;
while not Eof(arch2) do
begin
readln(arch2,lin);
{***evalua la condicion******}

if lin[1]+lin[2]='si' then
begin
bloquecierto:=evaluacondicion(lin,TablaDeta);
inicio:=cuenta;
repeat
ListaInstrucciones.Add('%'+lin);
cuenta:=cuenta+1;
if bloquecierto then
begin
palabra:=tipodepalabra(lin);
{imprimelinea(TablaDeta,TablaDeta,lin,0,0,palabra);}
imprimelinea(TablaDeta,TablaDeta,lin,1,y,palabra);
end;
readln(arch2,lin);
until (lin='terminacondicion');

termino:=cuenta;
if lin='terminacondicion' then
ListaInstrucciones.Add('%'+lin);
end;
{****termina evalua condicion*************}
palabra:=tipodepalabra(lin);
{***trata de imprimir la linea*******}
try
imprimelinea(TablaDeta,TablaDeta,lin,1,y,palabra);
except
MuestraMensaje('Error en el Formato Revise su Estructura');
MuestraMensaje('Linea Afectada '+lin);
end;
{**************************************}
end;
Closefile(arch2);
{*****parametros para hoja nueva******}
y:=y+1;
if (y>53) then{linea maxima}
begin
y:=0;
if sal='i' then Printer.NewPage;

end;
{***********************************}
TablaDeta.Next;

end;

end;

procedure imprimeformato(Tabla,TablaDeta:TTable;archivo:String);
var
arch,arch2:TextFile;
lin:string[100];

tipo,y,inicio,termino,cuenta:integer;
palabra:word;
caso:char;
bloquecierto:Boolean;
begin

AssignFile(arch,archivo);
reset(arch);
if sal='i' then
begin
Printer.BeginDoc;
sep:=Trunc(Printer.PageHeight/55);
anc:=Trunc(Printer.PageWidth/80);
end
else
begin
sep:=1;
anc:=1;
end;
{Printer.Canvas.Font.Pitch:=fpFixed;}
{lineaf(TablaFacturaE,'nada');}
{ListaInstrucciones.Free;}
ListaInstrucciones:=TStringList.Create;
cuenta:=0;
while not Eof(arch) do
begin
readln(arch,lin);

{lin:=LowerCase(lin);}
{MuestraMensaje('lineaimprimir     '+lin);}

if lin[1]='&' then caso:='&'  {detalle}
else
if lin[1]+lin[2]='si' then caso:='%' {bloque condicional}
else
caso:='#'; {encabezado}

case caso of
'&':begin
AssignFile(arch2,leeruta+'\consulta\detatmp.tmp');
ReWrite(arch2);
repeat
readln(arch,lin);
if lin[1]<>'&' then
Writeln(arch2,lin);
Listainstrucciones.Add('&'+lin);
cuenta:=cuenta+1;
until (lin[1]='&');
CloseFile(arch2);
imprimedetalle(Tabla,TablaDeta);
end;

'%':begin
{***evalua la condicion******}
if lin[1]+lin[2]='si' then
begin
bloquecierto:=evaluacondicion(lin,Tabla);
end;
{*****************************}

inicio:=cuenta;

repeat
ListaInstrucciones.Add('%'+lin);
cuenta:=cuenta+1;
if bloquecierto then
begin
palabra:=tipodepalabra(lin);
imprimelinea(Tabla,TablaDeta,lin,0,0,palabra);
end;
readln(arch,lin);
until (lin='terminacondicion');

termino:=cuenta;
if lin='terminacondicion' then
ListaInstrucciones.Add('%'+lin);

end;

'#':begin
palabra:=tipodepalabra(lin);
try
ListaInstrucciones.Add('#'+lin);
cuenta:=cuenta+1;
imprimelinea(Tabla,TablaDeta,lin,0,0,palabra);
except
MuestraMensaje('Error en el Formato Revise su Estructura');
MuestraMensaje('Linea Afectada '+lin);
end;


end;

end;{termina el case}


end;

{ShowMessage(ListaInstrucciones.Text);}
if sal='i' then
Printer.EndDoc;
closefile(arch);

end;

{****terminan pocedimientos para formatos***************}





procedure forma(tabla,TablaDeta:TTable;archivo:String;salida:char);
var
arch:File of Dato;
dat:dato;
y:integer;
begin
for y:=1 to 10 do
begin
variables[y]:=0;
cadenas[y]:='';
end;

sal:=salida;

if sal='p' then
begin
AssignFile(arch,leeruta+'\tempo\format.tmp');
ReWrite(arch);
CloseFile(arch);
end;
formateo:='###,###,##0.00';
tipoletra:='Arial';
tamano:=9;
colorletra:='negro';
{imprimedato(10,800,'Prueba de impresion con unidad');}
imprimeformato(tabla,tablaDeta,archivo);
end;

end.