CD Actual 13/CDA13.ISO/cdactual/demobin/share/program/Pascal/ANSIDRVR.ZIP/DEMOBOTH.PAS

Pascal/Delphi Source File | 1992-05-03 | 4.7 KB | 251 lines

{
Turbo Pascal ANSI Drivers
Version 1.12
Copyright (c) 1990 by Not So Serious Software

Original concept by Ian Silver
Design and implementation by Kevin Dean

Kevin Dean
Fairview Mall P.O. Box 55074
1800 Sheppard Avenue East
Willowdale, Ontario
CANADA    M2J 5B9
CompuServe ID: 76336,3114
}


{ This program demonstrates simple text I/O using the CONCOMIO unit }
program DemoANSIBoth;


uses
  ANSI, CONCOMIO;


var
  Result : integer;
  Name : string[20];
  BoxColor, DataColor, BkgndColor : byte;


{***}
procedure UpdateCursorPos;

var
  CurX, CurY, OldAttr : byte;

begin
CurX := WhereX;
CurY := WhereY;
OldAttr := TextAttr;

TextAttr := DataColor;
GotoXY(50, 13);
Write('(', CurX : 2, ',', CurY : 2, ')');

TextAttr := OldAttr;
GotoXY(CurX, CurY)
end;


{***}
procedure DrawBox;

var
  I : byte;

begin
TextAttr := BoxColor;

GotoXY(23, 9);
UpdateCursorPos;
Write('╔');

for I := 24 to 57 do
  begin
  UpdateCursorPos;
  Write('═')
  end;

UpdateCursorPos;
Write('╗');

for I := 10 to 15 do
  begin
  GotoXY(58, I);
  UpdateCursorPos;
  Write('║')
  end;

GotoXY(58, 16);
UpdateCursorPos;
Write('╝');

for I := 57 downto 24 do
  begin
  GotoXY(I, 16);
  UpdateCursorPos;
  Write('═')
  end;

GotoXY(23, 16);
UpdateCursorPos;
Write('╚');

for I := 15 downto 10 do
  begin
  GotoXY(23, I);
  UpdateCursorPos;
  Write('║')
  end
end;


{***}
procedure RunDemo;

begin
Randomize;

repeat
  BoxColor := Random(256);

  DrawBox;

  DataColor := Random(256);
  BkgndColor := Random(256);

  TextAttr := BkgndColor;
  GotoXY(24, 10);
  UpdateCursorPos;
  Write(' Your name:                       ');
  UpdateCursorPos;

  TextAttr := DataColor;
  GotoXY(36, 10);
  UpdateCursorPos;
  Write(Name);
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 11);
  UpdateCursorPos;
  Write(' Box color:       Data color:     ');
  UpdateCursorPos;

  TextAttr := DataColor;
  GotoXY(36, 11);
  UpdateCursorPos;
  Write(BoxColor : 3);
  UpdateCursorPos;
  GotoXY(54, 11);
  UpdateCursorPos;
  Write(DataColor : 3);
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 12);
  UpdateCursorPos;
  Write(' Background color:                ');
  UpdateCursorPos;

  TextAttr := DataColor;
  GotoXY(43, 12);
  UpdateCursorPos;
  Write(BkgndColor : 3);
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 13);
  UpdateCursorPos;
  Write(' Current cursor position:         ');
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 14);
  UpdateCursorPos;
  Write('                                  ');
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 15);
  UpdateCursorPos;
  Write(' Press any key to end demo.       ');
  UpdateCursorPos;
until KeyPressed
end;


{$F+}

{***}
{ Modem error handler - MUST BE COMPILED AS A FAR PROCEDURE }
procedure ModemError(var Error : word);

begin
{ Disable serial port by sending output to console only }
ActiveOutput := ConsoleActive;

if Error and ReceiveOverrun <> 0 then
  WriteLn('Error : Receive overrun');

if Error and TransmitOverrun <> 0 then
  WriteLn('Error : Transmit overrun');

if Error and ParityError <> 0 then
  WriteLn('Error : Parity error');

if Error and FramingError <> 0 then
  WriteLn('Error : Framing error');

if Error and BreakDetect <> 0 then
  WriteLn('Error : Break detect');

if Error and CommTimeOut <> 0 then
  WriteLn('Error : Modem time out');

if Error and NoCarrier <> 0 then
  WriteLn('Error : No carrier');

if Error and CtrlBreak <> 0 then
  WriteLn('Error : Ctrl-Break');

if Error and NotOnline <> 0 then
  WriteLn('Error : Not on-line');

Disconnect;
ReleaseCOM;
halt(1)
end;

{$F-}


{***}
begin
{ IF A BREAK COMES FROM THE KEYBOARD, AN INT 23h IS GENERATED AND THE
  COMMUNICATIONS INTERRUPTS MAY NOT BE UNLOADED, LEAVING YOUR COMPUTER IN AN
  UNKNOWN STATE.  SET CheckBreak TO FALSE TO PREVENT THIS. }
CheckBreak := false;

Result := InitCOM(1, 1200, 8, 'N', 1, NoInit, SyncTransmit, @ModemError);

{ It is very important to make an explicit call to either GotoXY or ClrScr at }
{ the start of your program.  If you do not do so, the internal cursor        }
{ position management will be unpredictable.                                  }
ClrScr;

WriteLn('This program demonstrates simple I/O using the ANSI, ANSI console,');
WriteLn('and ANSI communications units.  Among the features demonstrated are');
WriteLn('screen control, cursor control, text attribute control, input and');
WriteLn('output, and the delay counter.');
WriteLn;
Write('What is your name (maximum 20 characters)? ');
ReadLn(Name);

RunDemo;

{ ALWAYS MAKE SURE THAT YOU RELEASE THE COMMUNICATIONS PORT BEFORE EXITING }
ReleaseCOM
end.