Pascal Fans,
With a Free Vision validator such as:
Field^.SetValidator(New(PPXPictureValidator,
Init('&&&-####', True)));
I'm getting a runtime error 216 when attempting to validate the field if it
contains invalid data. I also get a runtime error 216 if I tab into the
field and type an invalid character for the first position while the
previous contents of the field is selected. If I delete the previous value
in the field before typing an invalid first character, the runtime error
doesn't occur.
This is an example from Chapter 5 - Creating a data-entry screen in the
Turbo Vision Version 2.0 Programming Guide. Example source code is
attached.
--
Kevin
http://www.RawFedDogs.net
http://www.Lassie.xyz
http://www.WacoAgilityGroup.org
Bruceville, TX
What's the definition of a legacy system? One that works!
Errare humanum est, ignoscere caninum.
Program Tutor08b;
Uses App, Objects, Menus, MsgBox, Editors, StdDlg, Dialogs, Drivers, Views,
Validate, Memory, TutConst;
Type
POrderWindow = ^TOrderWindow;
TOrderWindow = Object(TDialog) { Order "window" is a dialog }
Constructor Init;
Procedure HandleEvent(Var Event: TEvent); Virtual;
End;
POrder = ^TOrder;
TOrder = Record
OrderNum: String[8];
OrderDate: String[8];
StockNum: String[8];
Quantity: String[5];
Payment, Received, MemoLen: Word;
MemoText: Array[0..255] of Char;
End;
TTutorApp = Object(TApplication)
Var
ClipBoardWindow: PEditWindow;
OrderWindow: POrderWindow;
OrderInfo: TOrder;
Constructor Init;
Procedure InitStatusLine; Virtual; { Declare the new methods }
Procedure InitMenuBar; Virtual;
Procedure HandleEvent(Var Event: TEvent); Virtual;
Procedure DoAboutBox;
Procedure NewWindow;
Procedure OpenWindow;
Procedure SaveDesktop;
Procedure LoadDesktop;
Procedure OpenOrderWindow;
Procedure ShowOrder(AOrderNumber: Integer);
Procedure SaveOrderData;
End;
Procedure TutorStreamError(Var S: TStream);
Var ErrorMessage: String;
Begin
Case S.Status of
stError: ErrorMessage := 'Stream access error';
stInitError: ErrorMessage := 'Cannot initialize stream';
stReadError: ErrorMessage := 'Read beyond end of stream';
stWriteError: ErrorMessage := 'Cannot expand stream';
stGetError: ErrorMessage := 'Unregistered type read from stream';
stPutError: ErrorMessage := 'Unregistered type written to stream';
End;
ClearScreen;
PrintStr('Error: ' + ErrorMessage);
Halt(Abs(S.Status));
End;
Constructor TTutorApp.Init;
Var
R: TRect;
Begin
{ MaxHeapSize := 8192; x Set up the file edit buffer area above heap }
EditorDialog := @StdEditorDialog; { Use standard editor dialogs }
StreamError := @TutorStreamError;
RegisterObjects;
RegisterViews;
RegisterEditors;
RegisterApp;
Inherited Init;
Desktop^.GetExtent(R); { Get boundries for window }
ClipBoardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
If ValidView(ClipBoardWindow) <> Nil Then { Make sure it worked }
Begin
ClipBoardWindow^.Hide; { Hide clipboard window }
InsertWindow(ClipBoardWindow); { Insert hidden clipboard window }
Clipboard := ClipBoardWindow^.Editor; { Make editor clipboard }
Clipboard^.CanUndo := False; { Can't undo in clipboard }
End;
DisableCommands([cmStockWin, cmSupplierWin]);
With OrderInfo Do
Begin
OrderNum := '42';
StockNum := 'AAA-9999';
OrderDate := '01/15/61';
Quantity := '1';
Payment := 2;
Received := 0;
MemoLen := 0;
End;
End;
Procedure TTutorApp.InitStatusLine;
Var R: TRect;
Begin
GetExtent(R);
R.A.Y := R.B.Y -1;
New(StatusLine, Init(R,
NewStatusDef(0, $EFFF, { This is the "normal" range }
NewStatusKey('~F3~ Open', kbF3, cmOpen, { Bind F3 }
NewStatusKey('~F4~ New', kbF4, cmNew, { and F4}
NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose, { and Alt+F3 }
StdStatusKeys(Nil)))),
NewStatusDef($F000, $FFFF, { Define another range }
NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
StdStatusKeys(Nil))),
Nil))));
End;
Procedure TTutorApp.InitMenuBar;
Var R: TRect;
Begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R,
NewMenu(
NewSubMenu('~F~ile', hcNoContext,
NewMenu(StdFileMenuItems(Nil)),
NewSubMenu('~E~dit', hcNoContext,
NewMenu(
StdEditMenuItems(
NewLine(
NewItem('~S~how clipboard', '', kbNoKey, cmClipShow,hcNoContext,
Nil)))),
NewSubMenu('~O~rders', hcNoContext,
NewMenu(
NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
NewLine(
NewItem('Next', 'PgDn', KbPgDn, cmOrderNext, hcNoContext,
NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
Nil)))))),
NewSubMenu('O~p~tions', hcNoContext,
NewMenu(
NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
Nil)))),
NewSubMenu('~W~indow', hcNoContext,
NewMenu(
NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
NewLine(
StdWindowMenuItems(Nil)))))),
NewSubMenu('~H~elp', hcNoContext,
NewMenu(
NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
Nil)),
Nil)))))))));
End;
Procedure TTutorApp.HandleEvent(Var Event: TEvent);
Begin
Inherited HandleEvent(Event); { Call the inherited method first }
If Event.What = evCommand Then { If unhandled, check for commands }
Begin
Case Event.Command of { Check for known commands }
cmOptionsVideo:
Begin
{ SetScreenMode(ScreenMode xor smFont8x8); x Toggle mode bit }
ClearEvent(Event); { Mark the event as handled }
End;
cmAbout:
Begin
DoAboutBox;
ClearEvent(Event); { Mark the event as handled }
End;
cmNew:
Begin
NewWindow;
ClearEvent(Event); { Mark the event as handled }
End;
cmOpen:
Begin
OpenWindow;
ClearEvent(Event); { Mark the event as handled }
End;
cmClipShow:
With ClipBoardWindow^ Do
Begin
Select;
Show;
ClearEvent(Event); { Mark the event as handled }
End;
cmOptionsSave:
Begin
SaveDesktop;
ClearEvent(Event); { Mark the event as handled }
End;
cmOptionsLoad:
Begin
LoadDesktop;
ClearEvent(Event); { Mark the event as handled }
End;
cmOrderWin:
Begin
OpenOrderWindow;
ClearEvent(Event); { Mark the event as handled }
End;
cmOrderSave:
Begin
SaveOrderData;
ClearEvent(Event); { Mark the event as handled }
End;
End;
End;
End;
Procedure TTutorApp.DoAboutBox;
Begin
{ #3 centers a line, #13 is a line break }
MessageBox(#3'Turbo Vision Tutorial Application'#13 +
#3'Copyright 1992'#13#3'Borland International',
Nil, mfInformation or mfOKButton);
End;
Procedure TTutorApp.NewWindow;
Var
R: TRect;
TheWindow: PEditWindow;
Begin
R.Assign(0, 0, 60, 20); { Assign boundries for the window }
TheWindow := New(PEditWindow, { Construct the window }
Init(R, '', wnNoNumber));
InsertWindow(TheWindow); { Insert into the desktop }
End;
Procedure TTutorApp.OpenWindow;
Var
R: TRect; { Boundries for the edit window }
FileDialog: PFileDialog; { File selection dialong box }
TheFile: FNameStr; { String for the file name }
Const
FDOptions: Word = fdOKButton or fdOpenButton; { Dialog options }
Begin
TheFile := '*.*'; { Initial mask for file names }
New(FileDialog, Init(TheFile, 'Open File', '~F~ile name',
FDOptions, 1));
If ExecuteDialog(FileDialog, @TheFile) <> cmCancel Then
Begin
R.Assign(0, 0, 75, 20);
InsertWindow(New(PEditWindow, Init(R, TheFile, wnNoNumber)));
End;
End;
Procedure TTutorApp.SaveDesktop;
Var DesktopFile: TBufStream;
Begin
Desktop^.Delete(ClipBoardWindow);
DesktopFile.Init('Desktop.tut', stCreate, 1024);
DesktopFile.Put(Desktop);
DesktopFile.Done;
InsertWindow(ClipBoardWindow);
End;
Procedure TTutorApp.LoadDesktop;
Var
DesktopFile: TBufStream;
TempDesktop: PDesktop;
R: TRect;
Begin
DesktopFile.Init('Desktop.tut', stOpenRead, 1024);
TempDesktop := PDesktop(DesktopFile.Get);
DesktopFile.Done;
If ValidView(TempDesktop) <> Nil Then
Begin
Desktop^.Delete(ClipBoardWindow);
Delete(Desktop);
Dispose(Desktop, Done);
Desktop := TempDesktop;
Insert(Desktop);
GetExtent(R);
R.Grow(0, -1);
Desktop^.Locate(R);
InsertWindow(ClipBoardWindow);
End;
End;
Constructor TOrderWindow.Init;
Var
R: TRect;
Field: PInputLine; { Temporary variable for input fields }
Cluster: PCluster;
Memo: PMemo;
Begin
R.Assign(0, 0, 60, 17); { Assign the boundries }
Inherited Init(R, 'Orders'); { Construct the dialog box }
Options := Options or ofCentered; { Make sure it's centered }
HelpCtx := $F000; { Set a new help context }
Palette := wpBlueWindow;
{ Order Number Field }
R.Assign(13, 2, 23, 3); { Set boundries for input field }
Field := New(PInputLine, Init(R, 8)); { Construct it }
Field^.SetValidator(New(PRangeValidator,
Init(1, 9999))); { Order number is a positive integer }
Insert(Field); { Insert it }
R.Assign(2, 2, 12, 3); { Set boundries for label }
Insert(New(PLabel, Init(R,
'~O~rder #:', Field))); { Construct & insert, linking to field }
{ Order Date Field }
R.Assign(43, 2, 53, 3); { Set boundries for input field }
Field := New(PInputLine, Init(R, 8)); { Construct it }
Field^.SetValidator(New(PPXPictureValidator,
Init('{#[#]}/{#[#]}/{##[##]}', True))); { Date is MM/DD/YY }
Insert(Field); { Insert it }
R.Assign(26, 2, 41, 3); { Set boundries for label }
Insert(New(PLabel, Init(R,
'~D~ate of Order:', Field))); { Construct & insert, linking to field }
{ Stock Number Field }
R.Assign(13, 4, 23, 5); { Set boundries for input field }
Field := New(PInputLine, Init(R, 8)); { Construct it }
Field^.SetValidator(New(PPXPictureValidator,
Init('&&&-####', True))); { Stock number is three letters, -, four digits }
Insert(Field); { Insert it }
R.Assign(2, 4, 12, 5); { Set boundries for label }
Insert(New(PLabel, Init(R,
'~S~tock #:', Field))); { Construct & insert, linking to field }
{ Quantity Ordered Field }
R.Assign(46, 4, 53, 5); { Set boundries for input field }
Field := New(PInputLine, Init(R, 8)); { Construct it }
Field^.SetValidator(New(PRangeValidator,
Init(1, 99999))); { Quantity is a positive integer }
Insert(Field); { Insert it }
R.Assign(26, 4, 44, 5); { Set boundries for label }
Insert(New(PLabel, Init(R,
'~Q~uantity Ordered:', Field))); { Construct & insert, linking to field }
{ Payment Method Radio Button Cluster }
R.Assign(3, 7, 57, 8); { Set boundries for input field }
Cluster := New(PRadioButtons, Init(R, { Construct it }
NewSItem('Cash ',
NewSItem('Check ',
NewSItem('P.O. ',
NewSItem('Account', Nil))))));
Insert(Cluster); { Insert it }
R.Assign(2, 6, 21, 7); { Set boundries for label }
Insert(New(PLabel, Init(R,
'~P~ayment Method:', Cluster))); { Construct & insert, linking to field }
{ Received Check Box Cluster }
R.Assign(22, 8, 37, 9); { Set boundries for input field }
Cluster := New(PCheckBoxes, Init(R, { Construct it }
NewSItem('~R~eceived', Nil)));
Insert(Cluster); { Insert it }
{ Memo Field }
R.Assign(3, 10, 57, 13); { Set boundries for input field }
Memo := New(PMemo, Init(R, Nil, Nil, Nil, 255)); { Construct it }
Insert(Memo); { Insert it }
R.Assign(2, 9, 9, 10); { Set boundries for label }
Insert(New(PLabel, Init(R,
'~N~otes:', Memo))); { Construct & insert, linking to field }
R.Assign(2, 14, 12, 16);
Insert(New(PButton, Init(R, '~N~ew', cmOrderNew, bfNormal)));
R.Assign(13, 14, 23, 16);
Insert(New(PButton, Init(R, '~S~ave', cmOrderSave, bfDefault)));
R.Assign(24, 14, 34, 16);
Insert(New(PButton, Init(R, 'Re~v~ert', cmOrderCancel, bfNormal)));
R.Assign(35, 14, 45, 16);
Insert(New(PButton, Init(R, 'N~e~xt', cmOrderNext, bfNormal)));
R.Assign(46, 14, 56, 16);
Insert(New(PButton, Init(R, '~P~rev', cmOrderPrev, bfNormal)));
SelectNext(False);
End;
Procedure TOrderWindow.HandleEvent(Var Event: TEvent);
Begin
Inherited HandleEvent(Event); { Handle all normal dialog events }
If (Event.What = evBroadcast) and { Look for a broadcast... }
(Event.Command = cmFindOrderWindow) then { ...with this command }
ClearEvent(Event); { and clear it }
End;
Procedure TTutorApp.OpenOrderWindow;
Begin
If Message(Desktop, evBroadcast, cmFindOrderWindow, Nil) = Nil Then
Begin
OrderWindow := New(POrderWindow, Init); { Create a new instance }
InsertWindow(OrderWindow); { Insert it into the desktop }
End
Else
Begin
If PView(OrderWindow) <> Desktop^.TopView Then
OrderWindow^.Select;
End;
ShowOrder(0);
End;
Procedure TTutorApp.ShowOrder(AOrderNumber: Integer);
Begin
OrderWindow^.SetData(OrderInfo); { Set control values }
End;
Procedure TTutorApp.SaveOrderData;
Begin
If OrderWindow^.Valid(cmClose) Then
Begin
OrderWindow^.GetData(OrderInfo); { Get control values }
End;
End;
Var
TutorApp: TTutorApp;
Begin { Main }
TutorApp.Init;
TutorApp.Run;
TutorApp.Done;
End.
Unit TutConst;
{ Global constants for Turbo Vision Tutorial }
Interface
Const
cmOrderNew = 251;
cmOrderWin = 252;
cmOrderSave = 253;
cmOrderCancel = 254;
cmOrderNext = 255;
cmOrderPrev = 250;
cmClipShow = 240;
cmAbout = 241;
cmStockWin = 242;
cmSupplierWin = 243;
cmFindOrderWindow = 2000;
Const
cmOptionsVideo = 1502;
cmOptionsSave = 1503;
cmOptionsLoad = 1504;
Implementation
End.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
