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.