Curso de Pascal. Tema 17.2: Turbo Vision - Ventanas estándar.
Dentro de nuestra aplicación realizada con Turbo Vision podemos emplear fácilmente una serie de ventanas predefinidas. En la lección anterior vimos como crear "cajas de mensaje" (MessageBox). Ahora vamos a comenzar por usar escribir mensajes que ocupen un poco más:. {--------------------------}
{ Ejemplo en Pascal: }
{ }
{ Turbo Vision - 5 }
{ TV5.PAS }
{ }
{ Este fuente procede de }
{ CUPAS, curso de Pascal }
{ por Nacho Cabanes }
{ }
{ Comprobado con: }
{ - Free Pascal 2.2.0w }
{ - Turbo Pascal 7.0 }
{--------------------------}
program TV5;
uses App, Objects, Menus, Drivers, Views, MsgBox;
const
cmAyuda = 100; { Una orden que vamos a crear }
cmAunNo = 101; { Y otra }
type Programa = object (TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Suceso: TEvent); virtual;
end;
procedure Programa.InitStatusLine;
var
R: TRect; { Rectángulo de pantalla }
begin
GetExtent(R); { Miramos cuando ocupa }
R.A.Y := R.B.Y - 1; { Nos quedamos la línea inferior }
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-S~ Salir', kbAltS, cmQuit,
NewStatusKey('~F1~ Ayuda', kbF1, cmAyuda,
nil)),
nil)));
end;
procedure Programa.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~A~rchivo', hcNoContext, NewMenu(
NewItem('~A~yuda', 'F1', kbF1, cmAyuda, hcNoContext,
NewItem('~S~alir', 'Alt-S', kbAltS, cmQuit, hcNoContext,
nil))),
NewSubMenu('~E~dición', hcNoContext, NewMenu(
NewItem('~P~rimera opción', '', kbnoKey, cmAunNo, hcNoContext,
NewItem('~S~egunda opción', '', kbNoKey, cmAunNo, hcNoContext,
NewLine(
NewItem('Tercera Opcion', 'Alt-T', kbAltT, cmAunNo, hcNoContext,
nil))))),
nil)))));
end;
procedure Programa.HandleEvent(var Suceso: TEvent);
var
R: TRect;
begin
inherited HandleEvent(Suceso); { Primero que mire el "padre" }
if Suceso.What = evCommand then { Si es una orden }
case Suceso.Command of { Miramos qué orden es }
cmAyuda:
MessageBox('¡Aún no hay ayuda disponible!',
nil, mfWarning or mfOKButton);
cmAunNo:
MessageBox('Esta opción no funciona'#13
+'y además ni siquiera'#13
+'cabe en la ventana.'#13
+'Esta línea aún se ve'#13
+'y esta ya no se ve.',
nil, mfInformation or mfOkCancel);
end;
end;
var Prog: Programa;
begin
Prog.Init;
Prog.Run;
Prog.Done;
end.Hemos puesto 5 líneas de texto y hemos desbordado la capacidad de la ventana. Por supuesto, debe haber alguna forma de evitar esto. Pues sí, la hay, y además es sencilla (todavía ;-)
Vamos a crear un "rectángulo" del tamaño que nos interese:
{--------------------------}
{ Ejemplo en Pascal: }
{ }
{ Turbo Vision - 6 }
{ TV6.PAS }
{ }
{ Este fuente procede de }
{ CUPAS, curso de Pascal }
{ por Nacho Cabanes }
{ }
{ Comprobado con: }
{ - Free Pascal 2.2.0w }
{ - Turbo Pascal 7.0 }
{--------------------------}
program TV6;
uses App, Objects, Menus, Drivers, Views, MsgBox;
const
cmAyuda = 100; { Una orden que vamos a crear }
cmAunNo = 101; { Y otra }
type Programa = object (TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Suceso: TEvent); virtual;
end;
procedure Programa.InitStatusLine;
var
R: TRect; { Rectángulo de pantalla }
begin
GetExtent(R); { Miramos cuando ocupa }
R.A.Y := R.B.Y - 1; { Nos quedamos la línea inferior }
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-S~ Salir', kbAltS, cmQuit,
NewStatusKey('~F1~ Ayuda', kbF1, cmAyuda,
nil)),
nil)));
end;
procedure Programa.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~A~rchivo', hcNoContext, NewMenu(
NewItem('~A~yuda', 'F1', kbF1, cmAyuda, hcNoContext,
NewItem('~S~alir', 'Alt-S', kbAltS, cmQuit, hcNoContext,
nil))),
NewSubMenu('~E~dición', hcNoContext, NewMenu(
NewItem('~P~rimera opción', '', kbnoKey, cmAunNo, hcNoContext,
NewItem('~S~egunda opción', '', kbNoKey, cmAunNo, hcNoContext,
NewLine(
NewItem('Tercera Opcion', 'Alt-T', kbAltT, cmAunNo, hcNoContext,
nil))))),
nil)))));
end;
procedure Programa.HandleEvent(var Suceso: TEvent);
var
R: TRect;
begin
inherited HandleEvent(Suceso); { Primero que mire el "padre" }
if Suceso.What = evCommand then { Si es una orden }
case Suceso.Command of { Miramos qué orden es }
cmAyuda:
MessageBox('¡Aún no hay ayuda disponible!',
nil, mfWarning or mfOKButton);
cmAunNo:
begin
R.Assign(10,10,40,21);
MessageBoxRect(R,'Esta opción no funciona'#13
+'y además ni siquiera'#13
+'cabe en la ventana.'#13
+'Esta línea aún se ve'#13
+'y esta... ¡también! :-)',
nil, mfInformation or mfOkCancel);
end;
end;
end;
var Prog: Programa;
begin
Prog.Init;
Prog.Run;
Prog.Done;
end.Esta vez no hemos usado cosas como R.A.Y := R.B.Y - 1 para cambiar el tamaño de la ventana (aunque no se trate de toda la pantalla, como vimos, sino sólo de "un trozo", R.A sigue representado la esquina superior izquierda y R.B la inferior derecha), sino que directamente le hemos dado un tamaño con R.Assign(xMin,yMin,xMax,yMax): indicamos las coordenadas x e y de principio y de fin.
Nos puede parecer más intuitivo indicar el tamaño y la posición: pensar "quiero una ventana de 30x12, situada en la posición (5,5)". Pues entonces fijamos el tamaño con R.Assign, y la posición con R.Move. Nuestro programa quedaría:
{--------------------------}
{ Ejemplo en Pascal: }
{ }
{ Turbo Vision - 7 }
{ TV7.PAS }
{ }
{ Este fuente procede de }
{ CUPAS, curso de Pascal }
{ por Nacho Cabanes }
{ }
{ Comprobado con: }
{ - Free Pascal 2.2.0w }
{ - Turbo Pascal 7.0 }
{--------------------------}
program TV7;
uses App, Objects, Menus, Drivers, Views, MsgBox;
const
cmAyuda = 100; { Una orden que vamos a crear }
cmAunNo = 101; { Y otra }
type Programa = object (TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Suceso: TEvent); virtual;
end;
procedure Programa.InitStatusLine;
var
R: TRect; { Rectángulo de pantalla }
begin
GetExtent(R); { Miramos cuando ocupa }
R.A.Y := R.B.Y - 1; { Nos quedamos la línea inferior }
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-S~ Salir', kbAltS, cmQuit,
NewStatusKey('~F1~ Ayuda', kbF1, cmAyuda,
nil)),
nil)));
end;
procedure Programa.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~A~rchivo', hcNoContext, NewMenu(
NewItem('~A~yuda', 'F1', kbF1, cmAyuda, hcNoContext,
NewItem('~S~alir', 'Alt-S', kbAltS, cmQuit, hcNoContext,
nil))),
NewSubMenu('~E~dición', hcNoContext, NewMenu(
NewItem('~P~rimera opción', '', kbnoKey, cmAunNo, hcNoContext,
NewItem('~S~egunda opción', '', kbNoKey, cmAunNo, hcNoContext,
NewLine(
NewItem('Tercera Opcion', 'Alt-T', kbAltT, cmAunNo, hcNoContext,
nil))))),
nil)))));
end;
procedure Programa.HandleEvent(var Suceso: TEvent);
var
R: TRect;
begin
inherited HandleEvent(Suceso); { Primero que mire el "padre" }
if Suceso.What = evCommand then { Si es una orden }
case Suceso.Command of { Miramos qué orden es }
cmAyuda:
MessageBox('¡Aún no hay ayuda disponible!',
nil, mfWarning or mfOKButton);
cmAunNo:
begin
R.Assign(0,0,30,12);
R.Move(5,5);
MessageBoxRect(R,'Esta opción no funciona'#13
+'y además ni siquiera'#13
+'cabe en la ventana.'#13
+'Esta línea aún se ve'#13
+'y ésta... ¡también! :-)',
nil, mfInformation or mfOkCancel);
end;
end;
end;
var Prog: Programa;
begin
Prog.Init;
Prog.Run;
Prog.Done;
end.La unit MsgBox es la que nos ha dado esta posibilidad de crear ventanas de aviso con facilidad, pero también nos permite hacer otras cosas muy frecuentes...
Vamos a ver cómo "preguntar cosas" a los usuarios de nuestros programas. Para ello usaremos la función InputBox, que tiene el formato:
function InputBox(Titulo: String; Etiqueta: String;
var S: String; Limite: Byte): Word;
En nuestro caso, vamos a leer el nombre, de 40 letras, y a ver cómo comprobar si se ha cancelado la operación:
{--------------------------}
{ Ejemplo en Pascal: }
{ }
{ Turbo Vision - 8 }
{ TV8.PAS }
{ }
{ Este fuente procede de }
{ CUPAS, curso de Pascal }
{ por Nacho Cabanes }
{ }
{ Comprobado con: }
{ - Free Pascal 2.2.0w }
{ - Turbo Pascal 7.0 }
{--------------------------}
program TV8;
uses App, Objects, Menus, Drivers, Views, MsgBox;
const
cmAyuda = 100; { Una orden que vamos a crear }
cmAunNo = 101; { Y otra }
cmNombre = 102; { Y otra más }
type Programa = object (TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Suceso: TEvent); virtual;
procedure PideNombre;
end;
procedure Programa.InitStatusLine;
var
R: TRect; { Rectángulo de pantalla }
begin
GetExtent(R); { Miramos cuando ocupa }
R.A.Y := R.B.Y - 1; { Nos quedamos la línea inferior }
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-S~ Salir', kbAltS, cmQuit,
NewStatusKey('~F1~ Ayuda', kbF1, cmAyuda,
nil)),
nil)));
end;
procedure Programa.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~A~rchivo', hcNoContext, NewMenu(
NewItem('~A~yuda', 'F1', kbF1, cmAyuda, hcNoContext,
NewItem('~S~alir', 'Alt-S', kbAltS, cmQuit, hcNoContext,
nil))),
NewSubMenu('~E~dición', hcNoContext, NewMenu(
NewItem('~P~rimera opción', '', kbnoKey, cmAunNo, hcNoContext,
NewItem('~S~egunda opción', '', kbNoKey, cmAunNo, hcNoContext,
NewLine(
NewItem('Tercera Opcion', 'Alt-T', kbAltT, cmAunNo, hcNoContext,
nil))))),
NewSubMenu('~N~ombre', hcNoContext, NewMenu(
NewItem('~I~ntroducir Nombre', 'Alt-I', kbAltI, cmNombre,
hcNoContext,
nil)),
nil))))));
end;
procedure Programa.HandleEvent(var Suceso: TEvent);
begin
inherited HandleEvent(Suceso); { Primero que mire el "padre" }
if Suceso.What = evCommand then { Si es una orden }
case Suceso.Command of { Miramos qué orden es }
cmAyuda:
MessageBox('¡Aún no hay ayuda disponible!',
nil, mfWarning or mfOKButton);
cmAunNo:
MessageBox('Esta opción aún no está lista',
nil, mfWarning or mfOKButton);
cmNombre:
PideNombre;
end;
end;
procedure Programa.PideNombre;
var
nombre: string; { El nombre que leeremos }
result: word; { El resultado de la petición }
result2: word; { y el de la confirmación }
correcto: boolean; { Para repetir mientras queramos }
begin
nombre := 'Nacho'; { Valor por defecto }
repeat
correcto := true; { Suponemos que todo va bien }
result := InputBox( 'Petición de datos',
'Su nombre es:', nombre, 20);
if result = cmCancel then { Si cancelamos, pide confirmación }
begin
result2 := MessageBox('Confirme que quiere cancelar',
nil, mfWarning or mfYesButton or mfNoButton);
if result2 = cmNo then correcto := false;
end;
until correcto;
end;
var Prog: Programa;
begin
Prog.Init;
Prog.Run;
Prog.Done;
end.
Con esto hemos visto de paso cómo interpretar las respuestas que nos devuelven las ventanas de avisos o de entrada de datos.
Eso sí, si probais a escribir mensajes largos, vereis que limita la longitud de los datos a 20 letras, como esperábamos, pero el recuadro azul es más grande, y eso desconcierta un poco. Lo ideal sería que el recuadro azul fuese también del tamaño adecuado, para darnos una idea de cuanto podemos escribir.
Pero eso, junto con la forma de traducir las ventanas, lo veremos en el siguiente apartado.
En último lugar, pero no por ello menos importante, vamos a ver otra ventana estándar, esta vez de la unidad StdDlg. No comento lo que es para obligaros a probarlo primero:
{--------------------------}
{ Ejemplo en Pascal: }
{ }
{ Turbo Vision - 9 }
{ TV9.PAS }
{ }
{ Este fuente procede de }
{ CUPAS, curso de Pascal }
{ por Nacho Cabanes }
{ }
{ Comprobado con: }
{ - Free Pascal 2.2.0w }
{ - Turbo Pascal 7.0 }
{--------------------------}
program TV9;
uses App, Objects, Menus, Drivers, Views, Dialogs, MsgBox, StdDlg;
const
cmAbrir = 100; { Una orden que vamos a crear }
cmAunNo = 101; { Y otra }
type Programa = object (TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent(var Suceso: TEvent); virtual;
procedure Abre;
end;
procedure Programa.InitStatusLine;
var
R: TRect; { Rectángulo de pantalla }
begin
GetExtent(R); { Miramos cuando ocupa }
R.A.Y := R.B.Y - 1; { Nos quedamos la línea inferior }
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-S~ Salir', kbAltS, cmQuit,
NewStatusKey('~F3~ Abrir', kbF3, cmAbrir,
nil)),
nil)));
end;
procedure Programa.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~A~rchivo', hcNoContext, NewMenu(
NewItem('~A~brir', 'F3', kbF3, cmAbrir, hcNoContext,
NewItem('~S~alir', 'Alt-S', kbAltS, cmQuit, hcNoContext,
nil))),
NewSubMenu('~E~dición', hcNoContext, NewMenu(
NewItem('~P~rimera opción', '', kbnoKey, cmAunNo, hcNoContext,
NewItem('~S~egunda opción', '', kbNoKey, cmAunNo, hcNoContext,
nil))),
nil)))));
end;
procedure Programa.HandleEvent(var Suceso: TEvent);
begin
inherited HandleEvent(Suceso); { Primero que mire el "padre" }
if Suceso.What = evCommand then { Si es una orden }
case Suceso.Command of { Miramos qué orden es }
cmAbrir: Abre;
cmAunNo:
MessageBox('Esta opción aún no está lista',
nil, mfWarning or mfOKButton);
end;
end;
procedure Programa.Abre;
var
Nombre: string;
Dlg: PDialog;
begin
nombre := '*.*';
Dlg := New(PFileDialog, Init(nombre, 'Selección de ficheros',
'~N~ombre', fdOpenButton, 100));
ExecuteDialog( Dlg, @nombre);
if nombre <> '*.*' then
MessageBox(#3'Ha escogido '+nombre,
nil, mfInformation or mfOKButton);
end;
var Prog: Programa;
begin
Prog.Init;
Prog.Run;
Prog.Done;
end.
Esta vez hemos creado una ventana de diálogo predefinida, que es la que se encarga de mostrar la lista de ficheros, pero la hemos creado de una forma distinta, más general.
Como esa forma de crear ventanas la veremos en el próximo apartado, no cuento nada más... }:-)