home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
t
/
tvcom.zip
/
TVCOM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-12-06
|
22KB
|
730 lines
{
TVCOM - a program that demonstrates one way of using Async Professional
within a Turbo Vision program.
This program provides a TTerminalWindow object derived from TWindow. The
interior of this object is derived TTerminal. Such an object offers a handy
way of adding text to the end of a scroller and navigating (using cursor
keys or mouse) around the scroller.
We also derive a new application object from TApplication called TComApp.
The actual application, TMyApp is then derived from TComApp. In your
programs, you might want to consolidate TComApp and TMyApp into one object.
We broke it into two objects in case you wanted to move TComApp and
TTerminalWindow objects into their own units.
Serial port output is handled by TTerminalWindow's interior. Whenever it
receives a evKeyDown message it sends that character to the serial port with
PutChar.
Serial port input is handled by TComApp's Idle method. Each time that method
is called (which is once for every generated message) it checks the com port
for characters waiting in the input buffer. If it finds that a character is
ready, it will retreive that character, format an event record with a custom
event code of evComChar and passes that event directly to the
TTerminalWindow's HandleEvent method. It will process up to 10 characters
each time Idle is called (speeding things up a bit whenever a large block of
characters arrives at the serial port).
TTerminalWindow's TInterior is the object that actually processes the
evComChar event. To do so, it calls TTerminal's CharWrite method to add that
character to the end of the scroller buffer and display it.
Note this is a rather "bare bones" implementation. The TTerminal ancestor of
TTerminalWindow's interior doesn't have the necessary methods to easily add
terminal emulation (which would need to modify colors, position the cursor
anywhere within the scroller buffer, etc.). To add emulation, you'll either
need to add methods to TTerminalWindow's interior, or perhaps, choose a
different ancestor than Turbo Vision's TTerminal.
Additionally, this example gives little consideration to performance. You
may want to consider processing characters in blocks rather than generating
an event for each character. That is, the TComApp Idle method would collect
a block of input characters, place a pointer to that block in the event
record's InfoPtr field, and have the TTerminalWindow's HandleEvent method
process that entire block at once.
Released to the public domain
Written by Terry Hughes, TurboPower Software
Version 1.0 - 6-10-91
initial release
1.01 - 8-24-92 : wasn't releasing comport memory when terminal window closed
1.02 - 12-5-92 : updated for BP7
}
{$X+}
program TVCom;
uses
{.................rtl}
Dos,
{.................turbo vision}
Objects,
Drivers,
Memory,
Views,
TextView,
Menus,
Dialogs,
StdDlg,
MsgBox,
App,
{$IFNDEF VER70} {!!.02}
Buffers,
{$ENDIF} {!!.02}
Editors,
{.................async professional}
ApMisc,
ApPort,
ApUart,
OoCom;
const
{Change these parameters for the comport you're using}
ComPort = Com2;
ComBaud = 9600;
evComChar = $1000; {Character received at serial port}
HeapSize = 32 * (1024 div 16);
cmOpen = 100;
cmNew = 101;
cmChangeDir = 102;
cmDosShell = 103;
cmCalculator = 104;
cmShowClip = 105;
cmTermOpen = 106;
cmTermStart = 107;
cmTermStop = 108;
cmComChar = 109;
type
PInterior = ^TInterior;
TInterior = object(TTerminal)
AP : AbstractPortPtr; {Pointer to port object}
SWidth : Byte; {Logical screen width}
constructor Init(var Bounds : TRect;
AHScrollBar, AVScrollBar : PScrollBar;
ABufSize : Word; APort : AbstractPortPtr);
{-Instantiate the interior view of the TerminalWindow}
procedure HandleEvent(var Event: TEvent); virtual;
{-Custom event handler -- also transmits keystrokes out com port}
procedure CharWrite(C : Char);
{-Add and display one character (handle line wrapping)}
end;
PTerminalWindow = ^TTerminalWindow;
TTerminalWindow = object(TWindow)
constructor Init(Bounds: TRect; WinTitle: String;
WindowNo: Word; ABufSize: Word;
APort : AbstractPortPtr);
{-Instantiate a TerminalWindow}
destructor Done; virtual;
{-Destroy the TTerminalWindow}
function MakeInterior(Bounds: TRect; ABufSize: Word;
APort : AbstractPortPtr): PInterior;
{-Make an interior subview}
end;
PComApp = ^TComApp;
TComApp = object(TApplication)
TW : PTerminalWindow; {Pointer to a TerminalWindow}
UP : UartPortPtr; {Pointer to the port object}
DoComEvents : Boolean; {True if a TermWin is open}
constructor Init;
{-Instantiate the com application}
procedure Idle; virtual;
{-Override Idle to handle incoming characters}
end;
PMyApp = ^TMyApp;
TMyApp = object(TComApp)
constructor Init;
{-Instantiate the main application}
procedure HandleEvent(var Event : TEvent); virtual;
{-Override HandleEvent to process custom desktop commands}
procedure InitMenuBar; virtual;
{-Insert a custom menu bar}
procedure InitStatusLine; virtual;
{-Insert a custom status line}
procedure OutOfMemory; virtual;
{-Insert an outofmemory handler}
end;
var
MyMain: TMyApp;
ClipWindow: PEditWindow;
{TInterior}
constructor TInterior.Init(var Bounds: TRect;
AHScrollBar, AVScrollBar : PScrollBar;
ABufSize : Word; APort : AbstractPortPtr);
begin
TTerminal.Init(Bounds, AHScrollBar, AvScrollBar, ABufSize);
EventMask := EventMask or evComChar;
AP := APort;
SWidth := 80;
end;
procedure TInterior.CharWrite(C : Char);
var
CurPos : Word;
ScreenLines: Word;
Count : Byte;
procedure InsertChar(C : Char);
var
I : Word;
begin
if QueFront+1 > BufSize then begin
Buffer^[0] := C;
QueFront := 1;
end else begin
Buffer^[QueFront] := C;
Inc(QueFront);
end;
end;
begin
{Don't store received line feeds}
if C = cLF then
Exit;
{Handle end-of-line (TTextDevice requires cLFs)}
ScreenLines := Limit.Y;
if C = cCR then begin
C := cLF;
Inc(ScreenLines);
end;
{Make sure there's room for at least two more characters}
while not CanInsert(2) do begin
QueBack := NextLine(QueBack);
Dec(ScreenLines);
end;
{Get current horizontal cursor position}
CurPos := PrevLines(QueFront, 1);
if CurPos <= QueFront then
CurPos := QueFront - CurPos
else
CurPos := BufSize - (CurPos - QueFront);
{Force a new line if we are at the end of the current line}
if CurPos > SWidth then begin
InsertChar(cLF);
Inc(ScreenLines);
CurPos := 1;
end;
{Add this character to the buffer}
InsertChar(C);
if C = cLF then
CurPos := 0
else
Inc(CurPos);
{Get length of longest line and recalibrate the scroll bar limits}
SetLimit(CalcWidth, ScreenLines);
{Scroll to the last line and move to the current horiz cursor position}
ScrollTo(0, ScreenLines+1);
SetCursor(CurPos, ScreenLines-Delta.Y-1);
{Update the view}
DrawView;
end;
procedure TInterior.HandleEvent(var Event: TEvent);
var
S : TextBuf;
begin
TTerminal.HandleEvent(Event);
if (Event.What = evKeyDown) or (Event.What = evComChar) then begin
if Event.CharCode <> #0 then begin
{Send the character out the serial port}
if Event.What = evKeyDown then
AP^.PutChar(Event.CharCode);
{Add it to the terminalwindow's buffer}
CharWrite(Event.CharCode);
ClearEvent(Event);
end;
end;
end;
{TTerminalWindow}
constructor TTerminalWindow.Init(Bounds: TRect; WinTitle: String;
WindowNo: Word; ABufSize: Word;
APort : AbstractPortPtr);
var
Interior : PInterior;
begin
TWindow.Init(Bounds, WinTitle, WindowNo);
{Instantiate the internal scroller and insert it into the TerminalWindow}
Interior := MakeInterior(Bounds, ABufSize, APort);
Insert(Interior);
{Tell the application to start getting com events}
Message(Application, evBroadCast, cmTermStart, nil);
{Consider com events as focused events}
FocusedEvents := FocusedEvents or evComChar;
EventMask := EventMask or evComChar;
end;
destructor TTerminalWindow.Done;
{-Tell the application to stop getting com events}
begin
TWindow.Done;
Message(Application, evBroadCast, cmTermStop, nil);
end;
function TTerminalWindow.MakeInterior(Bounds: TRect; ABufSize: Word;
APort : AbstractPortPtr): PInterior;
begin
GetExtent(Bounds);
Bounds.Grow(-1, -1);
MakeInterior := New(PInterior, Init(Bounds,
StandardScrollBar(sbHorizontal + sbHandleKeyboard),
StandardScrollBar(sbVertical + sbHandleKeyboard),
ABufSize, APort));
end;
{TComApp}
constructor TComApp.Init;
begin
{Do parent init}
TApplication.Init;
{Don't get com events yet}
TW := nil;
DoComEvents := False;
end;
procedure TComApp.Idle;
{-Override Idle to handle incoming characters}
const
ReleaseCnt = 10;
var
C : Char;
Event : TEvent;
Cnt : Byte;
begin
TApplication.Idle;
if DoComEvents then begin
Cnt := 1;
while UP^.CharReady and (Cnt < ReleaseCnt) do begin
Inc(Cnt);
UP^.GetChar(C);
if AsyncStatus = ecOk then begin
Event.What := evComChar;
Event.CharCode := C;
Event.ScanCode := $FF;
TW^.HandleEvent(Event);
end;
end;
end;
end;
function ExecDialog(P: PDialog; Data: Pointer): Word;
var
Result: Word;
begin
Result := cmCancel;
P := PDialog(Application^.ValidView(P));
if P <> nil then
begin
if Data <> nil then P^.SetData(Data^);
Result := DeskTop^.ExecView(P);
if (Result <> cmCancel) and (Data <> nil) then P^.GetData(Data^);
Dispose(P, Done);
end;
ExecDialog := Result;
end;
function CreateFindDialog: PDialog;
var
D: PDialog;
Control: PView;
R: TRect;
begin
R.Assign(0, 0, 38, 12);
D := New(PDialog, Init(R, 'Find'));
with D^ do
begin
Options := Options or ofCentered;
R.Assign(3, 3, 32, 4);
Control := New(PInputLine, Init(R, 80));
Insert(Control);
R.Assign(2, 2, 15, 3);
Insert(New(PLabel, Init(R, '~T~ext to find', Control)));
R.Assign(32, 3, 35, 4);
Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
R.Assign(3, 5, 35, 7);
Insert(New(PCheckBoxes, Init(R,
NewSItem('~C~ase sensitive',
NewSItem('~W~hole words only', nil)))));
R.Assign(14, 9, 24, 11);
Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
Inc(R.A.X, 12); Inc(R.B.X, 12);
Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
SelectNext(False);
end;
CreateFindDialog := D;
end;
function CreateReplaceDialog: PDialog;
var
D: PDialog;
Control: PView;
R: TRect;
begin
R.Assign(0, 0, 40, 16);
D := New(PDialog, Init(R, 'Replace'));
with D^ do
begin
Options := Options or ofCentered;
R.Assign(3, 3, 34, 4);
Control := New(PInputLine, Init(R, 80));
Insert(Control);
R.Assign(2, 2, 15, 3);
Insert(New(PLabel, Init(R, '~T~ext to find', Control)));
R.Assign(34, 3, 37, 4);
Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
R.Assign(3, 6, 34, 7);
Control := New(PInputLine, Init(R, 80));
Insert(Control);
R.Assign(2, 5, 12, 6);
Insert(New(PLabel, Init(R, '~N~ew text', Control)));
R.Assign(34, 6, 37, 7);
Insert(New(PHistory, Init(R, PInputLine(Control), 11)));
R.Assign(3, 8, 37, 12);
Insert(New(PCheckBoxes, Init(R,
NewSItem('~C~ase sensitive',
NewSItem('~W~hole words only',
NewSItem('~P~rompt on replace',
NewSItem('~R~eplace all', nil)))))));
R.Assign(17, 13, 27, 15);
Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
R.Assign(28, 13, 38, 15);
Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
SelectNext(False);
end;
CreateReplaceDialog := D;
end;
function DoEditDialog(Dialog: Integer; Info: Pointer): Word; far;
var
R: TRect;
T: TPoint;
begin
case Dialog of
edOutOfMemory:
DoEditDialog := MessageBox('Not enough memory for this operation.',
nil, mfError + mfOkButton);
edReadError:
DoEditDialog := MessageBox('Error reading file %s.',
@Info, mfError + mfOkButton);
edWriteError:
DoEditDialog := MessageBox('Error writing file %s.',
@Info, mfError + mfOkButton);
edCreateError:
DoEditDialog := MessageBox('Error creating file %s.',
@Info, mfError + mfOkButton);
edSaveModify:
DoEditDialog := MessageBox('%s has been modified. Save?',
@Info, mfInformation + mfYesNoCancel);
edSaveUntitled:
DoEditDialog := MessageBox('Save untitled file?',
nil, mfInformation + mfYesNoCancel);
edSaveAs:
DoEditDialog := ExecDialog(New(PFileDialog, Init('*.*',
'Save file as', '~N~ame', fdOkButton, 101)), Info);
edFind:
DoEditDialog := ExecDialog(CreateFindDialog, Info);
edSearchFailed:
DoEditDialog := MessageBox('Search string not found.',
nil, mfError + mfOkButton);
edReplace:
DoEditDialog := ExecDialog(CreateReplaceDialog, Info);
edReplacePrompt:
begin
{ Avoid placing the dialog on the same line as the cursor }
R.Assign(0, 1, 40, 8);
R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
Desktop^.MakeGlobal(R.B, T);
Inc(T.Y);
if TPoint(Info).Y <= T.Y then
R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
DoEditDialog := MessageBoxRect(R, 'Replace this occurence?',
nil, mfYesNoCancel + mfInformation);
end;
end;
end;
function OpenEditor(FileName: FNameStr; Visible: Boolean): PEditWindow;
var
P: PView;
R: TRect;
begin
DeskTop^.GetExtent(R);
P := Application^.ValidView(New(PEditWindow, Init(R, FileName, wnNoNumber)));
if not Visible then
P^.Hide;
DeskTop^.Insert(P);
OpenEditor := PEditWindow(P);
end;
constructor TMyApp.Init;
var
H: Word;
begin
{$IFNDEF VER70} {!!.02}
{Init edit buffers}
H := PtrRec(HeapEnd).Seg - PtrRec(HeapPtr).Seg;
if H > HeapSize then
BufHeapSize := H - HeapSize
else
BufHeapSize := 0;
InitBuffers;
{$ENDIF} {!!.02}
{Do parent init}
TComApp.Init;
{Make a clipboard from an editor}
DisableCommands([cmSave, cmSaveAs, cmCut, cmCopy, cmPaste, cmClear,
cmUndo, cmFind, cmReplace, cmSearchAgain]);
EditorDialog := DoEditDialog;
ClipWindow := OpenEditor('', False);
if ClipWindow <> nil then begin
Clipboard := ClipWindow^.Editor;
Clipboard^.CanUndo := False;
end;
end;
procedure TMyApp.HandleEvent(var Event: TEvent);
procedure FileOpen;
var
FileName: FNameStr;
begin
FileName := '*.*';
if ExecDialog(New(PFileDialog, Init('*.*', 'Open file',
'~N~ame', fdOpenButton, 100)), @FileName) <> cmCancel then
OpenEditor(FileName, True);
end;
procedure FileNew;
begin
OpenEditor('', True);
end;
procedure ChangeDir;
begin
ExecDialog(New(PChDirDialog, Init(cdNormal, 0)), nil);
end;
{$IFNDEF VER70} {!!.02}
procedure DosShell;
begin
DoneSysError;
DoneEvents;
DoneVideo;
DoneMemory;
SetMemTop(Ptr(BufHeapPtr, 0));
PrintStr('Type EXIT to return to TVEDIT...');
SwapVectors;
Exec(GetEnv('COMSPEC'), '');
SwapVectors;
SetMemTop(Ptr(BufHeapEnd, 0));
InitMemory;
InitVideo;
InitEvents;
InitSysError;
Redraw;
end;
{$ENDIF} {!!.02}
procedure ShowClip;
begin
ClipWindow^.Select;
ClipWindow^.Show;
end;
{$IFNDEF VER70} {!!.02}
procedure Tile;
var
R: TRect;
begin
Desktop^.GetExtent(R);
Desktop^.Tile(R);
end;
procedure Cascade;
var
R: TRect;
begin
Desktop^.GetExtent(R);
Desktop^.Cascade(R);
end;
{$ENDIF} {!!.02}
procedure TermOpen;
var
R : TRect;
begin
{Open up the serial port}
New(UP, InitCustom(ComPort, ComBaud, NoParity, 8, 1, 1000, 1000, DefPortOptions));
if UP = nil then begin
WriteLn('Failed to open port: ', AsyncStatus);
Halt;
end;
{Instantiate the TerminalWindow object}
R.Assign(10, 1, 70, 18);
TW := New(PTerminalWindow, Init(R, 'Terminal', wnNoNumber, 8192, UP));
TW := PTerminalWindow(Application^.ValidView(TW));
Desktop^.Insert(TW);
{Start com events}
DoComEvents := True;
end;
begin
TApplication.HandleEvent(Event);
case Event.What of
evCommand :
case Event.Command of
cmOpen : FileOpen;
cmNew : FileNew;
cmChangeDir : ChangeDir;
cmDosShell : DosShell;
cmShowClip : ShowClip;
cmTile : Tile;
cmCascade : Cascade;
cmTermOpen : TermOpen;
else Exit;
end;
evBroadCast :
case Event.Command of
cmTermStart : DoComEvents := True;
cmTermStop :
begin
DoComEvents := False;
TW := nil;
Dispose(UP, Done); {!!.01}
end;
else Exit;
end;
else
Exit;
end;
ClearEvent(Event);
end;
procedure TMyApp.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(
NewItem('~O~pen...', 'F3', kbF3, cmOpen, hcNoContext,
NewItem('~N~ew', '', kbNoKey, cmNew, hcNoContext,
NewItem('~S~ave', 'F2', kbF2, cmSave, hcNoContext,
NewItem('S~a~ve as...', '', kbNoKey, cmSaveAs, hcNoContext,
NewLine(
NewItem('~C~hange dir...', '', kbNoKey, cmChangeDir, hcNoContext,
NewItem('~D~OS shell', '', kbNoKey, cmDosShell, hcNoContext,
NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
nil))))))))),
NewSubMenu('~E~dit', hcNoContext, NewMenu(
NewItem('~U~ndo', '', kbNoKey, cmUndo, hcNoContext,
NewLine(
NewItem('Cu~t~', 'Shift-Del', kbShiftDel, cmCut, hcNoContext,
NewItem('~C~opy', 'Ctrl-Ins', kbCtrlIns, cmCopy, hcNoContext,
NewItem('~P~aste', 'Shift-Ins', kbShiftIns, cmPaste, hcNoContext,
NewItem('~S~how clipboard', '', kbNoKey, cmShowClip, hcNoContext,
NewLine(
NewItem('~C~lear', 'Ctrl-Del', kbCtrlDel, cmClear, hcNoContext,
nil))))))))),
NewSubMenu('~S~earch', hcNoContext, NewMenu(
NewItem('~F~ind...', '', kbNoKey, cmFind, hcNoContext,
NewItem('~R~eplace...', '', kbNoKey, cmReplace, hcNoContext,
NewItem('~S~earch again', '', kbNoKey, cmSearchAgain, hcNoContext,
nil)))),
NewSubMenu('~W~indows', hcNoContext, NewMenu(
NewItem('~S~ize/move','Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
NewItem('~T~ile', '', kbNoKey, cmTile, hcNoContext,
NewItem('C~a~scade', '', kbNoKey, cmCascade, hcNoContext,
NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
NewItem('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
NewLine(
NewItem('Ca~l~culator', '', kbNoKey, cmCalculator, hcNoContext,
nil)))))))))),
NewSubMenu('~T~erminal', hcNoContext, NewMenu(
NewItem('~O~pen', '', kbNoKey, cmTermOpen, hcNoContext,
NewItem('~C~lose', '', kbNoKey, cmClose, hcNoContext,
nil))),
nil))))))));
end;
procedure TMyApp.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~F2~ Save', kbF2, cmSave,
NewStatusKey('~F3~ Open', kbF3, cmOpen,
NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
NewStatusKey('~F5~ Zoom', kbF5, cmZoom,
NewStatusKey('~F6~ Next', kbF6, cmNext,
NewStatusKey('~F10~ Menu', kbF10, cmMenu,
NewStatusKey('', kbCtrlF5, cmResize,
nil))))))),
nil)));
end;
procedure TMyApp.OutOfMemory;
begin
MessageBox('Not enough memory for this operation.', nil, mfError+mfOkButton);
end;
begin
{$IFDEF VER70} {!!.02}
{$IFNDEF Dpmi} {!!.02}
MaxHeapSize := (MaxAvail div 16) - 8192;
{$ENDIF} {!!.02}
{$ENDIF} {!!.02}
MyMain.Init;
MyMain.Run;
MyMain.Done;
end.