Curso de Pascal. Tema 17.5: Turbo Vision - Ejemplo.
Esta versión está basada en la segunda de la agenda.
La apariencia que tendrá esta versión será ésta:
Y el fuente podría ser así:
{--------------------------}
{ Ejemplo en Pascal: }
{ }
{ Agenda: versión para }
{ Turbo Vision }
{ AGENDATV.PAS }
{ }
{ Este fuente procede de }
{ CUPAS, curso de Pascal }
{ por Nacho Cabanes }
{ }
{ Comprobado con: }
{ - Turbo Pascal 7.0 }
{--------------------------}
{ ========================================================
Ejemplito de Agenda, adaptado a Turbo Vision.
Basado en el segundo ejemplo (MiniAgenda2)
Nacho Cabanes, Junio 96, para CUPAS (Curso de Pascal)
======================================================== }
program MiniAgendaTV;
uses App, { Para objeto TApplication }
Drivers, { TEvent, por ejemplo }
Objects, { TRect, etc }
Menus, { Pues eso ;-) }
Views, { Vistas y hcXX }
MsgBox; { MessageBox, InputBox, etc }
{$V-}
{ Directiva de compilación: tamaño de strings no estricto (ver
ampliación 6). Para poder usar LeeValor con Strings de cualquier
tamaño }
const
nombref: string[12]='agenda.dat'; { Nombre del fichero }
longNOM = 20;
longDIR = 30;
longCIU = 15;
longCP = 5;
longTLF = 12;
longOBS = 40;
cmSaludo = 1001; { Las ordenes que podremos dar }
cmSalir = 1002;
cmNumero = 1005;
cmNuevo = 1006;
cmModifica = 1007;
cmBusca = 1008;
cmAnterior = 101; { Estas se podrán deshabilitar }
cmPosterior = 102;
type { Nuestro tipo de datos }
tipoagenda = record
nombre: string[ longNOM ];
direccion: string[ longDIR ];
ciudad: string[ longCIU ];
cp: string[ longCP ];
telef: string[ longTLF ];
observ: string[ longOBS ]
end;
programa = object (TApplication) { Nuestro programa }
{ Heredados }
procedure HandleEvent(var Event: TEvent); virtual; { Manj eventos }
procedure InitMenuBar; virtual; { Barra de menú }
procedure InitStatusLine; virtual; { Línea de estado }
{ Creados }
procedure Saludo; { Saludo al entrar }
procedure CreaInterior; { Ventana con el texto }
procedure Anterior; { Retrocede una ficha }
procedure Posterior; { Avanza una ficha }
procedure Numero; { Salta a una ficha }
procedure Modifica; { Modifica la actual }
procedure Nuevo; { Ficha nueva }
procedure Busca; { Busca un texto }
end;
PITexto = ^TITexto; { Texto con los datos: interior }
TITexto = object(TView)
constructor Init(var Limite: TRect);
procedure Draw; virtual;
end;
PVTexto = ^TVTexto; { Texto con los datos: ventana }
TVTexto = object(TWindow)
constructor Init(Limite: TRect; Titulo: String);
procedure MakeInterior(Limite: TRect);
{ Podría tener su propio HandleEvent y demás, pero dejo que la }
{ maneje el programa principal }
end;
var
prog: programa; { El programa en sí }
FichAgenda: file of tipoagenda; { Fichero }
ficha: TipoAgenda; { Guarda la ficha actual }
NumFicha: word; { El número de ficha actual }
Ultima: word; { Número de la última ficha }
VTexto: PVTexto; { La ventana de texto }
constructor TITexto.Init(var Limite: TRect);
begin
TView.Init(Limite);
GrowMode := gfGrowHiX + gfGrowHiY; { Para evitar problemas al redimensionar }
{ aunque dejaré la ventana fija }
Options := Options or ofFramed; { Con borde }
end;
procedure TITexto.Draw;
var
color1,color2: Byte;
temp1, temp2:string; { Para escribir el número de ficha y el total }
result: word;
procedure EscribeTexto(x,y:longint; cadena:string; color:byte);
var b: TDrawBuffer;
begin
MoveStr(b,cadena,color);
WriteLine(x,y,length(cadena),1,b);
end;
begin
{$I-}
reset( FichAgenda );
{$I+}
if ioresult<>0 then
begin { Si no hay fichero, lo creo }
rewrite(FichAgenda);
ficha.nombre:='Nacho Cabanes';
ficha.direccion:='Apartado 5234';
ficha.ciudad:='Alicante';
ficha.cp:='03080';
ficha.observ:='Creador de esto...';
write(FichAgenda,ficha);
NumFicha := 1;
end;
seek(FichAgenda, NumFicha -1);
read(FichAgenda,ficha);
ultima:=filesize(FichAgenda);
close(FichAgenda);
{ Habilito o deshabilito órdenes según donde me encuentre }
If NumFicha = 1 then DisableCommands([cmAnterior])
else EnableCommands([cmAnterior]);
If NumFicha = ultima then DisableCommands([cmPosterior])
else EnableCommands([cmPosterior]);
TView.Draw;
str(numFicha,temp1);
str(ultima,temp2);
with ficha do
begin
color1 := getcolor(1); color2 := getcolor(2);
EscribeTexto(60,1,'Ficha '+temp1+' de '+temp2,color1);
EscribeTexto(2,1,'Nombre:',color1);
EscribeTexto(4,2,Nombre,color2);
EscribeTexto(2,5,'Calle',color1);
EscribeTexto(4,6,direccion,color2);
EscribeTexto(2,8,'Ciudad',color1);
EscribeTexto(4,9,ciudad,color2);
EscribeTexto(36,8,'C.P.',color1);
EscribeTexto(38,9,cp,color2);
EscribeTexto(2,11,'Teléfono',color1);
EscribeTexto(4,12,telef,color2);
EscribeTexto(2,15,'Observaciones',color1);
EscribeTexto(4,16,observ,color2);
end;
end;
constructor TVTexto.Init(Limite: TRect; Titulo: String);
begin
TWindow.Init(Limite, Titulo, wnNoNumber);
Flags:= flags and not wfClose and not wfGrow
and not wfMove and not wfZoom; { Ventana fija, no redimensionable }
MakeInterior(Limite);
end;
procedure TVTexto.MakeInterior(Limite: TRect);
var
Interior: PITexto;
begin
GetExtent(Limite); { Leemos el tamaño disponible }
Limite.Grow(-1,-1); { Sera un poco más pequeño }
Interior := New(PITexto, Init(Limite)); { Y lo creamos }
Insert(Interior);
end;
procedure Programa.Saludo; { ----- Cartelito de presentación }
begin
MessageBox(
' MiniAgenda Turbo Vision'#13#13+
' ¡Bienvenido!'
, nil, mfOkButton+mfInformation);
end;
function LeeValor(rotulo, texto: string; { Auxiliar para leer datos }
var valor: string; longitud: byte): word;
var total:word;
r:trect;
Maximo: byte;
begin
Maximo:=longitud; { Hago la entrada más flexible }
if longitud>60 then longitud:=60; { que en InputBox: el tamaño }
total:=longitud+length(texto)+10; { de la línea de entrada (Input }
if total<30 then total:=30; { Line) y el de la ventana varían }
r.assign(0,0,total,9); { en cada caso. }
r.move(40-total div 2,7);
LeeValor:=InputBoxRect(R,rotulo,texto,
valor,maximo);
end;
procedure Programa.Modifica;
var
rotulo: string;
result: word;
begin
rotulo:='Modificar';
with ficha do begin
result:=LeeValor(rotulo,'Nombre',nombre,longNOM);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Dirección',direccion,longDIR);
if result=cmCancel then exit;
result:=Leevalor(rotulo,'Ciudad',ciudad,longCIU);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Código postal',cp,longCP);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Teléfono',telef,longTLF);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Observaciones',observ,longOBS);
if result=cmCancel then exit;
end;
reset(FichAgenda);
seek( FichAgenda, NumFicha-1 ); { Como siempre... :-) }
write( FichAgenda, ficha );
close(FichAgenda);
VTexto^.redraw;
end;
procedure Programa.Nuevo;
var
rotulo: string;
result: word;
ficha: TipoAgenda;
begin
rotulo:='Añadir datos';
fillchar(ficha, sizeof(Ficha), 0);
with ficha do begin
result:=LeeValor(rotulo,'Nombre',nombre,longNOM);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Dirección',direccion,longDIR);
if result=cmCancel then exit;
result:=Leevalor(rotulo,'Ciudad',ciudad,longCIU);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Código postal',cp,longCP);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Teléfono',telef,longTLF);
if result=cmCancel then exit;
result:=LeeValor(rotulo,'Observaciones',observ,longOBS);
if result=cmCancel then exit;
end;
NumFicha := Ultima + 1; { Hay que escribir al final }
reset(FichAgenda);
seek( FichAgenda, NumFicha-1 ); { Se sitúa }
write( FichAgenda,ficha ); { y escribe la ficha }
Ultima := Ultima + 1; { Ahora hay una más }
VTexto^.redraw;
end;
procedure Programa.Anterior;
begin
Dec(NumFicha);
VTexto^.redraw;
end;
procedure Programa.Posterior;
begin
Inc(NumFicha);
VTexto^.redraw;
end;
procedure Programa.Numero;
var
numeroStr: string[4]; { Numero como string }
numeroW: word; { Numero como word }
result: word; { Por si se cancela }
r: trect; { Rectángulo para la ventana }
cod: integer; { Para "val" }
begin
r.assign(0,0,68,9);
r.move(4,12);
NumeroStr:='';
result:=InputBoxRect(R,'Agenda: Número de Ficha',
'¿ Cual es el número de la ficha a la que quiere saltar ?',
NumeroStr,4);
if result=cmCancel then exit;
val (numeroStr, numeroW, cod);
if not (numeroW in [1..ultima]) then exit else NumFicha:=numeroW;
VTexto^.redraw;
end;
procedure Programa.CreaInterior;
var
R: TRect;
begin
GetExtent(r);
R.B.Y:=R.B.Y-2;
VTexto := New(PVTexto, Init(R, 'Agenda Turbo Vision'));
DeskTop^.Insert(VTexto);
end;
procedure Programa.Busca;
var
posAnterior: word; { Por si se cancela, volver a la anterior }
result: word; { Para comprobar si se cancela }
texto: string; { Texto a buscar }
i: word; { Bucles }
begin
posAnterior := numFicha;
texto := ''; { Posible mejora: conservar el texto buscado }
result := InputBox('Agenda: Buscar',
'¿ Qué texto quiere buscar ?',
Texto,15);
if result = cmCancel then exit;
reset(fichAgenda);
for i := numFicha to ultima do { Busca desde la actual }
begin
seek(FichAgenda, i-1);
read(FichAgenda, ficha);
with ficha do { Miro en todos los campos }
if (pos(texto, nombre) > 0) or (pos(texto, direccion) > 0) or
(pos(texto, ciudad) > 0) or (pos(texto, cp) > 0) or
(pos(texto, telef) > 0) or (pos(texto, observ) > 0)
then
begin
MessageBox(
#3'Encontrado'
, nil, mfOkButton+mfInformation);
numFicha := i;
vTexto^.redraw;
{close(fichAgenda);}
{ No hace falta cerrar el fichero: lo hago al redibujar }
exit;
end;
end;
MessageBox(
#3'No encontrado'
, nil, mfOkButton+mfInformation);
close(fichAgenda);
numFicha := posAnterior;
end;
procedure Programa.InitMenuBar;
var R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('AGENDA', hcNoContext, NewMenu(
NewItem('~A~cerca de...', '', kbNoKey, cmSaludo, hcNoContext,
NewLine(
NewItem('~T~erminar', 'Alt-T', kbAltT, cmQuit, hcNoContext,
nil)))),
NewSubMenu('~O~rdenes', hcNoContext, NewMenu(
NewItem('Anterior', 'Re.Pag.', kbPgUp, cmAnterior, hcNoContext,
NewItem('Posterior', 'Av.Pag.', kbPgDn, cmPosterior, hcNoContext,
NewItem('Número de ~f~icha', 'Alt-F', kbAltF, cmNumero, hcNoContext,
NewItem('Añadir ficha ~n~ueva', 'Alt-A', kbAltA, cmNuevo, hcNoContext,
NewItem('~M~odificar', 'Alt-M', kbAltM, cmModifica, hcNoContext,
NewItem('~B~uscar texto', 'Alt-B', kbAltB, cmBusca, hcNoContext,
nil))))))),
nil)))));
end;
procedure Programa.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('', kbF10, cmMenu,
NewStatusKey('~T~erminar', kbAltT, cmQuit,
NewStatusKey('', kbAltX, cmQuit, { Salir con Alt+T ó Alt+X }
NewStatusKey('~Re.Pag.~', kbPgUp, cmAnterior,
NewStatusKey('~Av.Pag.~', kbPgDn, cmPosterior,
NewStatusKey('~F~icha', kbAltF, cmNumero,
NewStatusKey('~N~uevo', kbAltN, cmNuevo,
NewStatusKey('~M~odificar', kbAltM, cmModifica,
NewStatusKey('~B~uscar', kbAltB, cmBusca,
NewStatusKey('', kbEsc, cmClose,
nil)))))))))),
nil)));
end;
procedure Programa.HandleEvent(var Event: TEvent);
begin
Inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmSaludo: Saludo;
cmAnterior: Anterior;
cmPosterior:Posterior;
cmNumero: Numero;
cmModifica: Modifica;
cmNuevo: Nuevo;
cmBusca: Busca;
else
Exit;
end;
ClearEvent(Event);
end;
end;
begin { ----- Cuerpo del programa ----- }
assign( FichAgenda, nombref );
NumFicha := 1;
Prog.Init;
Prog.Saludo;
Prog.CreaInterior;
Prog.Run;
Prog.Done;
writeln('Se acabó...');
end.