Category : Pascal Source Code
Archive   : PASS_ALL.ZIP
Filename : TI675.ASC
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.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/