UNIT U123; {Soure PC MAG. DECEMBER 13 1988... and others}
{ YES ! I did it in TP seven years Ago !!!}
INTERFACE
{
This routines ARE simple to use as 123.. :-)
1) Open the file
2) Add what you want.. where you want
3) Close the File
}
PROCEDURE Open123(n:string);
PROCEDURE Close123;
PROCEDURE ColW123(c:integer; a:byte);
PROCEDURE Add123Int(c,f:integer; v:integer);
PROCEDURE Add123Rea(c,f:integer; v:double);
PROCEDURE Add123TXC(c,f:integer; v:string);
PROCEDURE Add123TXL(c,f:integer; v:string);
PROCEDURE Add123TXR(c,f:integer; v:string);
PROCEDURE Add123FML(c,f:integer; s:string);
{
Open123(n:string);
n = File Name WITHOUT EXTENSION it ALways add WK1
It didn't check for a valid File Name or Existing, is
YOUR responsability to do that
Close123;
Close the Open File .. Always DO THIS !
In the rest of PROCEDURES c=Column and f=Row
c and F begins with 0 (cero)
if you want to Add in cell A1, use c=0 f=0
if you want to Add in cell B2, use c=1 f=1
etc.
Add123Int(c,f:integer; v:integer);
Add a Integer value (v) in Col=c Row=f
Add123Rea(c,f:integer; v:double);
Add a Double value (v) in Col=c Row=f
Add123TXC(c,f:integer; v:string);
Add a Label (v) in Col=C Row=f
- Label CENTER -
Add123TXR(c,f:integer; v:string);
Add a Label (v) in Col=C Row=f
- Label at RIGHT -
Add123TXL(c,f:integer; v:string);
Add a Label (v) in Col=C Row=f
- Label at LEFT -
ColW123(c:integer; a:byte);
Change width of Col=c to size=a
Add123FML(c,f:integer; s:string);
Add Formula (s) at Col=c Row=f
Examples:
Add123FML(0,0,'A5+B2+A3*C5');
Add123FML(0,1,'@Sum(B1..B8)');
==========================================
THE ONLY VALID @ function is SUM !!!!
Sorry :-(
==========================================
}
{ The rest of Comments are in SPANISH ... Sorry again }
IMPLEMENTATION
CONST
C00 = $00;
CFF = $FF;
VAR
ALotus : File;
PROCEDURE Open123(n:string);
Type
Abre = record
Cod : integer;
Lon : integer;
Vlr : integer;
end;
Var
Formato : array[1..6] of byte;
Registro : Abre absolute Formato;
Begin
Assign(ALotus,n+'.WK1');
Rewrite(ALotus,1);
with Registro do
begin
Cod:=0;
Lon:=2;
Vlr:=1030;
end;
BlockWrite(ALotus,Formato[1],6);
End;
PROCEDURE Close123;
Type
Cierra = record
Cod : integer;
Lon : integer;
end;
Var
Formato : array[1..4] of byte;
Registro : Cierra absolute Formato;
Begin
with Registro do
begin
Cod:=1;
Lon:=0;
end;
BlockWrite(ALotus,Formato[1],4);
Close(ALotus);
End;
PROCEDURE ColW123(c:integer; a:byte);
Type
Ancho = record
Cod : integer;
Lon : integer;
Col : integer;
Anc : byte;
end;
Var
Formato : array[1..7] of byte;
Registro : Ancho absolute Formato;
Begin
with Registro do
begin
Cod:=8;
Lon:=3;
Col:=c;
Anc:=a;
end;
BlockWrite(ALotus,Formato[1],7);
End;
PROCEDURE Add123Int(c,f,v:integer);
Type
Entero = record
Cod : integer;
Lon : integer;
Frm : byte;
Col : integer;
Fil : integer;
Vlr : integer;
end;
Var
Formato : array[1..11] of byte;
Registro : Entero absolute Formato;
Begin
with Registro do
begin
Cod:=13;
Lon:=7;
Frm:=255;
Fil:=f;
Col:=c;
Vlr:=v;
end;
Blockwrite(ALotus,Formato[1],11);
End;
PROCEDURE Add123Rea(c,f:integer; v:double);
Type
Entero = record
Cod : integer;
Lon : integer;
Frm : byte;
Col : integer;
Fil : integer;
Vlr : double;
end;
Var
Formato : array[1..17] of byte;
Registro : Entero absolute Formato;
Begin
with Registro do
begin
Cod:=14;
Lon:=13;
Frm:=2 or 128;
Fil:=f;
Col:=c;
Vlr:=v;
end;
Blockwrite(ALotus,Formato[1],17);
End;
PROCEDURE GrabaTXT(c,f:integer; v:string; t:char);
Type
Entero = record
Cod : integer;
Lon : integer;
Frm : byte;
Col : integer;
Fil : integer;
Vlr : array[1..100] of char;
end;
Var
Formato : array[1..109] of byte;
Registro : Entero absolute Formato;
i : word;
Begin
with Registro do
begin
Cod:=15;
Lon:=length(v)+7;
Frm:=255;
Fil:=f;
Col:=c;
Vlr[1]:=t;
for i:=1 to
Length(v) do Vlr[i+1]:=v[i];
Vlr[i+2]:=chr(0);
end;
Blockwrite(ALotus,Formato[1],length(v)+11);
End;
PROCEDURE Add123TXL(c,f:integer; v:string);
begin
GrabaTXT(c,f,v,'''');
end;
PROCEDURE Add123TXC(c,f:integer; v:string);
begin
GrabaTXT(c,f,v,'^');
end;
PROCEDURE Add123TXR(c,f:integer; v:string);
begin
GrabaTXT(c,f,v,'"');
end;
PROCEDURE Add123FML(c,f:integer; s:string);
Type
Formula = record
Cod : integer;
{codigo}
Lon : integer;
{longitud}
Frm : byte;
{formato}
Col : integer;
{columna}
Fil : integer;
{fila}
Res : Double;
{resultado de formula}
Tma : integer;
{tamanio de formula en bytes}
Fml : array[1..2048] of byte; {formula}
end;
symbol = (cel,num,arr,mas,men,por,dvs,pot,pa1,pa2);
consym = set of symbol;
Var
Formato : array[1..2067] of byte;
Registro : Formula absolute Formato;
fabs : boolean;
{flag que indica si ffml es absoluta}
v,
{v = string 's' sin blancos}
nro : string;
{nro = numero de ffml}
cfml,
{cfml = valor de columna en formula}
ffml : word;
{ffml = " " fila
" " }
nfml,
{nfml = " " constante " "
}
i,
{i = indice de 'v' (formula) }
ii,
{ii = " " 's'
" }
index,
{index= " " Fml}
j,ret,
{usados para convertir a numeros}
len,
{len = longitud de 'v'}
lens : integer;
{lens = " " 's'}
sym : symbol;
{sym = ultimo simbolo leido}
symsig,
{usados para analizar formula para }
syminifac : consym;
{grabarla con notacion posfija }
z : byte;
{indice para inicializar array}
Procedure CalculaDir(var Reg : Formula);
var
veces : integer;
(* Primero, se decide si
cfml es absoluta o relativa. Si es absoluta
calcula
el valor real. Si es relativa primero chequea si cfml<col.
Si cfml<col
le resta cfml a 49152 (C000); este numero es usado por
Lotus
para calcular la direccion de una celda a la izquierda de
donde
esta parado. Si col<=cfml le suma cfml a 32768 para encender
el MSB
que indica que es relativa (la C tambien lo prende).
Segundo,
se procede de la misma manera con ffml para determinar si
es absoluta
o relativa, y despues se calcula la direccion en base
a eso
y a la relacion de ffml con fil.
*)
begin
with Reg do
begin
if v[i]='$' then
{calcula la columna (cfml)}
begin
inc(i);
cfml:=ord(v[i])-ord('A');
inc(i);
while (v[i] in ['A'..'Z']) and (len>=i) do
begin
cfml:=(cfml+1)*26+ord(v[i])-ord('A');
inc(i);
end;
end
else
begin
if (ord(v[i])-ord('A') < col) then
begin
cfml:=49152-col+(ord(v[i])-ord('A'));
inc(i);
veces:=1;
while (v[i] in ['A'..'Z']) and (len>=i) do
begin
cfml:=49152-col+(26*veces)+(ord(v[i])-ord('A'));
cfml:=cfml+((ord(v[i-1])-ord('A'))*26);
inc(i);
inc(veces);
end;
end
else
begin
cfml:=ord(v[i])-ord('A');
inc(i);
while (v[i] in ['A'..'Z']) and (len>=i) do
begin
cfml:=(cfml+1)*26+ord(v[i])-ord('A');
inc(i);
end;
cfml:=cfml+32768-col;
end;
end;
Fml[index]:=Lo(cfml); {graba
cfml}
inc(index);
{que posee }
Fml[index]:=Hi(cfml); {dos bytes
}
inc(index);
if v[i]='$' then
{calcula la fila (ffml)}
begin
inc(i);
fabs:=true;
end
else
fabs:=false;
j:=i;
while (v[i] in ['0'..'9']) and (len>=i) do
begin
inc(i);
end;
nro:=copy(v,j,i-j);
val(nro,ffml,ret);
if fabs then
{siempre se resta 1 por estar en base 0}
begin
if ffml>0 then ffml:=ffml-1;
end
else
begin
if fil<ffml then
begin
ffml:=32768+abs(ffml-fil)-1;
end
else
begin
ffml:=49152-abs(ffml-fil)-1;
end;
end;
Fml[index]:=Lo(ffml); {graba
ffml}
inc(index);
{que posee }
Fml[index]:=Hi(ffml); {dos bytes
}
inc(index);
end;
end;
Procedure CalculaNum(var Reg : Formula);
var
VDoble : array[1..8] of byte;
dfml : Double absolute
VDoble;
d
: real;
esreal : boolean;
k
: byte;
numero : longint;
codigo : integer;
begin
with Reg do
begin
esreal:=false;
j:=i;
while (v[i] in ['0'..'9','.']) and (len>=i) do
begin
if v[i]='.' then esreal:=true;
inc(i);
end;
nro:=copy(v,j,i-j);
{R-}
val(nro,numero,codigo);
{R+}
if (codigo=0) and (numero>=-32768) and (numero<=32767) then
esreal:=false
else
esreal:=true;
if esreal then
begin
val(nro,d,ret);
{convierte en real doble}
dfml:=d;
{ConvRD(d,dfml);}
Fml[index]:=0;
{0 = indica que sigue una constante}
inc(index);
{ real doble precision (8 bytes)}
for k:=1 to 8 do
begin
Fml[index]:=VDoble[k]; {graba dfml}
inc(index);
{son ocho bytes}
end;
end
else
begin
val(nro,nfml,ret);
{convierte en entero}
Fml[index]:=5;
{5 = indica que sigue una constante }
inc(index);
{ entera con signo (2 bytes)
}
Fml[index]:=Lo(nfml); {graba nfml}
inc(index);
{son dos bytes}
Fml[index]:=Hi(nfml);
inc(index);
end;
dec(i);
end;
end;
Procedure CalculaRan(var Reg : Formula);
begin
with Reg do
begin
Fml[index]:=2;
{2 = codigo de rango; le sigue 8 bytes}
inc(index);
{ que son (col1fil1..col2fil2)
}
CalculaDir(Reg);
{calcula col1fil1}
i:=i+2;
{salta los 2 .. }
CalculaDir(Reg);
{calcula col2fil2}
end;
end;
Procedure CalculaArr(var Reg : Formula);
{** SOLO CODIFICA @TRUE,@FALSE,@SUM(COL1FIL1..COL2FIIL2) **}
var
func,dir : string;
{func = string del @}
{dir = del rango}
N_arg,nc : byte;
{N_arg = cantidad de argumentos}
{nc = numero de codigo (T,F,S)}
begin
with Reg do
begin
inc(i);
case v[i] of
'F' : nc:=51;
'T' : nc:=52;
'S' : nc:=80;
end;
while (v[i] in ['A'..'Z']) and (len>=i) do inc(i);
inc(i);
if nc=80 then
begin
CalculaRan(Reg); {calcula el
rango (col1fil1..col2fil2}
N_arg:=1;
{hay un solo argumento}
end;
Fml[index]:=nc;
inc(index);
if nc=80 then
begin
Fml[index]:=N_arg; {graba numero de argumentos}
inc(index);
end;
end;
end;
Procedure TraerChar;
begin
inc(i);
{carga el simbolo para }
if len>=i then
{la recursividad }
begin
case v[i] of
'A'..'Z','$' : sym:=cel;
'0'..'9','.' : sym:=num;
'@' : sym:=arr;
'+' : sym:=mas;
'-' : sym:=men;
'*' : sym:=por;
'/' : sym:=dvs;
'^' : sym:=pot;
'(' : sym:=pa1;
')' : sym:=pa2;
end;
end;
end;
Procedure Expresion(symsig : consym; var Reg : Formula);
var
opsuma:symbol;
Procedure Termino(symsig : consym; var Reg : Formula);
var
opmul:symbol;
Procedure Factor(symsig : consym; var Reg : Formula);
var
opexp:symbol;
Procedure Exponente(symsig : consym; var Reg : Formula);
begin{Exponente}
while (sym in syminifac)
and (len>=i) do
begin
case sym of
num : begin
CalculaNum(Registro);
TraerChar;
end;
cel : begin
Reg.Fml[index]:=1;
inc(index);
CalculaDir(Registro);
dec(i);
TraerChar;
end;
arr : begin
CalculaArr(Registro);
TraerChar;
end;
else
begin
if sym=pa1 then
begin
TraerChar;
Expresion([pa2]+symsig,Registro);
if sym=pa2 then
begin
Reg.Fml[index]:=4; {4 = simbolo '('
}
inc(index);
TraerChar;
end;
end;
end;
end;
end;
end;{Exponente}
begin{Factor}
Exponente(symsig+[pot],Registro);
while (sym=pot) and (len>=i)
do
begin
opexp:=sym;
TraerChar;
Exponente(symsig+[pot],Registro);
if opexp=pot then
begin
Reg.Fml[index]:=13;
{13 = simbolo '^' }
inc(index);
end;
end;
end;{Factor}
begin{Termino}
Factor(symsig+[por,dvs],Registro);
while (sym in [por,dvs])
and (len>=i) do
begin
opmul:=sym;
TraerChar;
Factor(symsig+[por,dvs],Registro);
if (opmul=por) or (opmul=dvs) then
begin
if opmul=por then Reg.Fml[index]:=11 {11 = simbolo '*' }
else
Reg.Fml[index]:=12;
{12 = simbolo '/' }
inc(index);
end;
end;
end;{Termino}
begin{Expresion}
(* Este es el primero de
cuatro procedimientos recursivos (Expresion,
Termino,
Factor y Exponente) que se usan para transformar la formula
en una
expresion en notacion posfija, tal como se debe grabar. La
tecnica
consiste en retrasar la transmision del operador aritmetico.
Ejemplo:
a+(b*c)^d ==> abc*(d^+ .
Expresion
analiza si es suma o resta. Luego llama a Termino. Al
volver
trae el proximo dato y llama otra vez a Termino. Al volver
genera
el codigo de suma o resta si hubo.
Termino
llama a Factor. Al volver trae el proximo dato y llama otra
vez a
Factor. Al volver genera el codigo de multiplicacion o division
si hubo.
Factor
llama a Exponente. Al volver trae el proximo dato y llama
otra vez
a Exponente. Cuando vuele genera el codigo de exponenciacion
si hubo.
Exponente
analiza si el valor es un numero, una celda, un arroba o
un parentesis.
Si es un parentesis, vuelve a llamar a Expresion para
calcular
el contenido este; sino genera el codigo correspondiente.
*)
if sym in [mas,men] then
begin
opsuma:=sym;
TraerChar;
Termino(symsig+[mas,men],Registro);
if opsuma=men then
begin
Reg.Fml[index]:=8;
{8 = simbolo '-' unario}
inc(index);
end;
end
else
Termino(symsig+[mas,men],Registro);
while (sym in [mas,men])
and (len>=i) do
begin
opsuma:=sym;
TraerChar;
Termino(symsig+[mas,men],Registro);
if (opsuma=mas) or (opsuma=men) then
begin
if opsuma=mas then Reg.Fml[index]:=9 { 9 = simbolo '+' }
else
Reg.Fml[index]:=10;
{10 = simbolo '-' }
inc(index);
end;
end;
end;{Expresion}
Begin
with Registro do
begin
Cod:=16;
{16= formula}
Col:=c;
Fil:=f;
Frm:=0;
{Comienzo con 0}
(*
if p=true then
Frm:=Frm+128; {Si se protege se prende el MSB}
ch:=UpCase(ch);
{Veo que formato se quiere y prendo }
{los bits respectivos
}
case ch of
'F' : Frm:=Frm+ 0; {'F' ==> decimales fijos }
'S' : Frm:=Frm+ 16; {'S' ==> notacion cientifica}
'C' : Frm:=Frm+ 32; {'C' ==> moneda corriente }
'P' : Frm:=Frm+ 48; {'P' ==> porcentaje
}
'M' : Frm:=Frm+ 64; {',' ==> miles con comas }
'O' : Frm:=Frm+112; {'O' ==> otros
}
end;
Frm:=Frm+d;
{Si ch<>'O' ==> d= cant. de decimales}
{Si ch= 'O' ==> d= 1 --> general }
{
2 --> DD/MMM/AA }
{
3 --> DD/MMM }
{
4 --> MM/AA }
{
5 --> texto }
{
6 --> hidden }
{
7 --> date; HH-MM-SS}
{
8 --> date; HH-MM }
{
9 --> date; int'l 1 }
{
10 --> date; int'l 2 }
{
11 --> time; int'l 1 }
{
12 --> time; int'l 2 }
{
13-14 --> no utilizado}
{
15 --> default }
*)
Res:=C00;
{ for z:=1 to
8 do Res[z]:=C00;} {se modifica automaticamente cuando se recalcula y regraba}
lens:=length(s);
{convierto todo a mayusculas}
for ii:=1 to
lens do s[ii]:=UpCase(s[ii]);
i:=1;
v:='';
for ii:=1 to
lens do {paso el string
's' al string 'v' }
begin
{eliminando los espacios en blanco}
if s[ii]<>' ' then
begin
v:=v+s[ii];
inc(i);
end;
end;
len:=i-1;
i:=0;
index:=1;
syminifac:=[cel,num,arr,pa1];
symsig:=syminifac;
TraerChar;
{toma el primer caracter de formula}
Expresion(symsig,Registro);
{analiza y graba toda la formula}
Fml[index]:=3;
{3 = fin de formula}
Tma:=index;
{tamanio de Fml}
Lon:=15+Tma;
{longitud de dato}
BlockWrite(ALotus,Formato[1],19+index);
end;
End;
END.