Category : Pascal Source Code
Archive   : PASS_ALL.ZIP
Filename : TI675.ASC

 
Output of file : TI675.ASC contained in archive : PASS_ALL.ZIP








PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : February 28, 1992 PAGE : 1/4

TITLE : Simple Pick List Example




{

The following example is to demonstrate the use of a Pick List.
This Pick List will read a line of data and validate the field
as well as keep a history of valid commands.

}
{$X+}
Program PickListExample;

uses Objects, App, Menus, Drivers, Views, Dialogs, MsgBox;

type
YourKeySet = set of char;

const
cmMakeDialog = 101;
ValidSet : YourKeySet = [#0..#31,'0'..'9'];

type

PFInputLine = ^TFInputLine;
TFInputLine = object(TInputLine)
ValidKeys : YourKeySet;
constructor Init(var Bounds: TRect; AMaxLen: integer;
ChrSet: YourKeySet);
procedure HandleEvent(var Event: TEvent); virtual;
procedure GetData(var Rec); virtual;
procedure SetData(var Rec); virtual;
function DataSize: word; virtual;
end;

PMyApp = ^TMyApp;
TMyApp = object(TApplication)
procedure InitMenuBar;virtual;
procedure InitStatusLine;virtual;
procedure MakeDialog;
procedure HandleEvent(var Event: TEvent);virtual;
end;

constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
ChrSet: YourKeySet);
begin













PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : February 28, 1992 PAGE : 2/4

TITLE : Simple Pick List Example




TInputLine.Init(Bounds,AMaxLen);
ValidKeys:= ChrSet;
end;

procedure TFInputLine.HandleEvent(var Event: TEvent);
{
Data validation handle event:
Please note that validation happens BEFORE the parent
is called. This ensures that the key is not trapped by
the parent method.
}

var
Number : longint;
Code : integer;
begin
case Event.What of
evKeyDown :
begin
if not(Event.CharCode in ValidKeys) then
ClearEvent(Event)
else
if Data^ <> '' then
begin
val(Data^, Number, Code);
if (Code <> 0) or (Number < 0) or (Number > 65535)
then
begin
Data^ := '';
MessageBox('Valid number is 0 to
65536.',nil,mfOkButton);
ClearEvent(Event);
end;
end;
end;
end;
TInputLine.HandleEvent(Event);
end;

procedure TFInputLine.GetData(var Rec);
var
Code : integer;
begin













PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : February 28, 1992 PAGE : 3/4

TITLE : Simple Pick List Example




Val(Data^,word(Rec), Code);
end;

procedure TFInputLine.SetData(var Rec);
begin
Str(word(Rec),Data^);
end;

function TFInputLine.DataSize: word;
begin
DataSize := SizeOf(word);
end;

procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~T~est', hcNoContext, NewMenu(
NewItem('~D~ialog','F2',kbF2,cmMakeDialog,hcNoContext,
NewLine(
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil)))),nil))));
end;

procedure TMyApp.MakeDialog;
var
R : TRect;
Dialog : PDialog;
InputLine : PInputLine;
Lable,Hist : PView;
begin
GetExtent(R);
R.Assign(10,5,60,15);
Dialog := New(PDialog,Init(R,'Demo Dialog'));
With Dialog^ do
begin
R.Assign(5,4,20,5);
InputLine := New(PFInputLine,Init(R,15,ValidSet));
Insert(InputLine);
R.Assign(5,3,20,4);
Lable := New(PLabel,Init(R,'InputLine',Inputline));













PRODUCT : Turbo Pascal NUMBER : 675
VERSION : 6.0
OS : MS/PC DOS
DATE : February 28, 1992 PAGE : 4/4

TITLE : Simple Pick List Example




Insert(Lable);
R.Assign(21,4,23,5);
Hist := New(PHistory,Init(R,InputLine,0));
Insert(Hist);
end;
Desktop^.ExecView(Dialog);
Dispose(Dialog,Done);
end;

procedure TMyApp.InitStatusLine;
var
R : TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine,Init(R,
NewStatusDef(0,$FFFF,
NewStatusKey('~A~lt-X',kbAltX,cmQuit,
nil),nil)));
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmMakeDialog: MakeDialog;
else
Exit;
end;
ClearEvent(Event);
end;
end;

var
MyApp: TMyApp;

begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.