[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
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.
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]