home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 040A / WSC4D20.ZIP / TERM_PGM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-17  |  20.4 KB  |  793 lines
  1. unit Term_pgm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus,
  8.   ExtCtrls, StdCtrls,
  9.   wsc, mio, xydrive;
  10. const
  11.   MaxRow = 15;
  12.   MaxCol = 65;
  13.   NAK = $15;
  14.   CR = 13;
  15.   LF = 10;
  16.   BS = 8;
  17.   DebugLevel = 0; (* XY Driver debug level [0,1,2] *)
  18.   XMODEM = 0;
  19.   YMODEM = 1;
  20. type
  21.   TTerm = class(TForm)
  22.     MainMenu: TMainMenu;
  23.     menuLine: TMenuItem;
  24.     menuOnLine: TMenuItem;
  25.     menuOffline: TMenuItem;
  26.     menuExit: TMenuItem;
  27.     menuChange: TMenuItem;
  28.     menuPort: TMenuItem;
  29.     menuBaud: TMenuItem;
  30.     menuDataBits: TMenuItem;
  31.     menuParity: TMenuItem;
  32.     menuStopBits: TMenuItem;
  33.     menuDial: TMenuItem;
  34.     menuSend: TMenuItem;
  35.     menuCOM1: TMenuItem;
  36.     menuCOM2: TMenuItem;
  37.     menuCOM3: TMenuItem;
  38.     menuCOM4: TMenuItem;
  39.     menu300: TMenuItem;
  40.     menu1200: TMenuItem;
  41.     menu2400: TMenuItem;
  42.     menu4800: TMenuItem;
  43.     menu9600: TMenuItem;
  44.     menu19200: TMenuItem;
  45.     menu38400: TMenuItem;
  46.     menu57600: TMenuItem;
  47.     menuSeven: TMenuItem;
  48.     menuEight: TMenuItem;
  49.     menuNone: TMenuItem;
  50.     menuEven: TMenuItem;
  51.     MenuOdd: TMenuItem;
  52.     menuOne: TMenuItem;
  53.     menuTwo: TMenuItem;
  54.     Timer: TTimer;
  55.     AboutPanel: TPanel;
  56.     AboutOK: TButton;
  57.     AboutMemo: TMemo;
  58.     menuReceive: TMenuItem;
  59.     RXMODEM: TMenuItem;
  60.     RYMODEM: TMenuItem;
  61.     menuBreak: TMenuItem;
  62.     menuAbout: TMenuItem;
  63.     SXMODEM: TMenuItem;
  64.     SYMODEM: TMenuItem;
  65.     AcceptPanel: TPanel;
  66.     AcceptBox: TEdit;
  67.     AcceptMemo: TMemo;
  68.     AcceptOK: TButton;
  69.     menuDebug: TMenuItem;
  70.     procedure IncrCol;
  71.     procedure IncrRow;
  72.     procedure DisplayChar(TheChar : Char);
  73.     procedure DisplayString(Text : String);
  74.     procedure DisplayLine(Text : String);
  75.     procedure ErrorText(Code : Integer);
  76.     procedure FormCreate(Sender: TObject);
  77.     procedure menuOnLineClick(Sender: TObject);
  78.     procedure menuOfflineClick(Sender: TObject);
  79.     procedure menuCOM1Click(Sender: TObject);
  80.     procedure menuCOM2Click(Sender: TObject);
  81.     procedure menuCOM3Click(Sender: TObject);
  82.     procedure menuCOM4Click(Sender: TObject);
  83.     procedure menuExitClick(Sender: TObject);
  84.     procedure menu300Click(Sender: TObject);
  85.     procedure menu1200Click(Sender: TObject);
  86.     procedure menu2400Click(Sender: TObject);
  87.     procedure menu4800Click(Sender: TObject);
  88.     procedure menu9600Click(Sender: TObject);
  89.     procedure menu19200Click(Sender: TObject);
  90.     procedure menu38400Click(Sender: TObject);
  91.     procedure menu57600Click(Sender: TObject);
  92.     procedure menuSevenClick(Sender: TObject);
  93.     procedure menuEightClick(Sender: TObject);
  94.     procedure menuNoneClick(Sender: TObject);
  95.     procedure menuEvenClick(Sender: TObject);
  96.     procedure MenuOddClick(Sender: TObject);
  97.     procedure menuOneClick(Sender: TObject);
  98.     procedure menuTwoClick(Sender: TObject);
  99.     procedure TimerTimer(Sender: TObject);
  100.     procedure KeyPress(Sender: TObject; var Key: Char);
  101.     procedure AboutOKClick(Sender: TObject);
  102.     procedure menuAboutClick(Sender: TObject);
  103.     procedure menuDialClick(Sender: TObject);
  104.     procedure AcceptOKClick(Sender: TObject);
  105.     procedure menuBreakClick(Sender: TObject);
  106.     procedure SXMODEMClick(Sender: TObject);
  107.     procedure SYMODEMClick(Sender: TObject);
  108.     procedure RXMODEMClick(Sender: TObject);
  109.     procedure RYMODEMClick(Sender: TObject);
  110.     procedure XY(Sender: TObject);
  111.   private
  112.     { Private declarations }
  113.     LastPacket : Integer;
  114.     NewState : Integer;
  115.     mioState : Integer;
  116.     xyState  : Integer;
  117.     LastChar : Char;
  118.     Row : Integer;
  119.     Col : Integer;
  120.     RowBase : Integer;
  121.     CharWidth  : Integer;
  122.     CharHeight : Integer;
  123.     Port : Integer;
  124.     Baud : Integer;
  125.     Parity : Integer;
  126.     DataBits : Integer;
  127.     StopBits : Integer;
  128.     ScreenBuffer : array [0..MaxRow] of string;
  129.     BlankLine : string;
  130.   public
  131.     { Public declarations }
  132.   end ;
  133.  
  134. var
  135.   Term: TTerm;
  136.  
  137. implementation
  138.  
  139. {$R *.DFM}
  140.  
  141. procedure TTerm.IncrRow;
  142. var
  143.   I : Integer;
  144. begin
  145.   Col := 0;
  146.   Inc(Row);
  147.   if Row > MaxRow then
  148.     begin
  149.       (* scroll ScreenBuffer *)
  150.        for I := 0 to MaxRow-1 do
  151.           ScreenBuffer[I] := ScreenBuffer[I+1];
  152.        ScreenBuffer[MaxRow] := '';
  153.        (* re-display *)
  154.        for I := 0 to MaxRow-1 do
  155.          begin
  156.            Canvas.TextOut(0,(I*CharHeight),ScreenBuffer[I]+BlankLine);
  157.          end;
  158.        (* position on last line *)
  159.        Row := MaxRow;
  160.        Canvas.TextOut(0,MaxRow*CharHeight,BlankLine);
  161.        Canvas.MoveTo(0,MaxRow*CharHeight)
  162.     end
  163. end;
  164.  
  165. procedure TTerm.IncrCol;
  166. begin
  167.   Inc(Col);
  168.   if Col > MaxCol then
  169.     begin
  170.       IncrRow;
  171.     end;
  172. end;
  173.  
  174. procedure TTerm.DisplayChar(TheChar : Char);
  175. var
  176.    TheString : String;
  177. begin
  178.    if TheChar <> Chr(LF) then
  179.      begin
  180.        if TheChar = Chr(CR) then
  181.          begin
  182.           IncrRow;
  183.          end
  184.        else
  185.          begin
  186.            if Ord(TheChar) = BS Then TheChar := '~';
  187.            (* save char in ScreenBuffer *)
  188.            ScreenBuffer[Row] := ScreenBuffer[Row] + TheChar;
  189.            (* display char on screen *)
  190.            Canvas.TextOut((Col*CharWidth),(Row*CharHeight),''+TheChar);
  191.            IncrCol;
  192.          end;
  193.      end;
  194. end;
  195.  
  196. procedure TTerm.DisplayString(Text : String);
  197. var
  198.   I   : Integer;
  199.   Len : Integer;
  200.   S   : String;
  201. begin
  202.   Len := Length(Text);
  203.   if Len > 0 then
  204.     begin
  205.       (* save string in ScreenBuffer *)
  206.       ScreenBuffer[Row] := ScreenBuffer[Row] + Text;
  207.       (* display on screen *)
  208.       Canvas.TextOut((Col*CharWidth),(Row*CharHeight),Text);
  209.       IncrCol
  210.     end
  211. end;
  212.  
  213. procedure TTerm.DisplayLine(Text : String);
  214. begin
  215.   DisplayString(Text);
  216.   DisplayChar(chr(CR))
  217. end;
  218.  
  219. procedure TTerm.ErrorText(Code : Integer);
  220. var
  221.    Text : String;
  222. begin
  223.   if Code <0 then
  224.     begin
  225.       case Code of
  226.         IE_BADID: Text := 'Bad port ID';
  227.         IE_OPEN:  Text := 'Cannot open port';
  228.         IE_NOPEN: Text := 'Port already open';
  229.         IE_MEMORY:   Text := 'Cannot allocate memory';
  230.         IE_DEFAULT:  Text := 'Error in default parameters';
  231.         IE_HARDWARE: Text := 'Hardware error';
  232.         IE_BYTESIZE: Text := 'Unsupported byte size';
  233.         IE_BAUDRATE: Text := 'Unsupported baud rate';
  234.         WSC_RANGE:   Text := 'Parameter out of range';
  235.         WSC_ABORTED: Text := 'Shareware version corrupted';
  236. {$IFDEF WIN32}
  237.         WSC_WIN32ERR:
  238.             Text := Format('Win32 error %d',[SioWinError]);
  239. {$ENDIF}
  240.         WSC_EXPIRED: Text := 'Shareware version expired';
  241.         else Text := 'Unknown error';
  242.       end;
  243.       DisplayLine(Text);
  244.     end
  245. end;
  246.  
  247. procedure TTerm.FormCreate(Sender: TObject);
  248. var
  249.   I    : Integer;
  250.   Code : Integer;
  251. begin
  252.   (* initialize canvas *)
  253.   menuBreak.Enabled := False;
  254.   RowBase := 0;
  255.   Row := 0; Col := 0;
  256.   CharWidth := Canvas.TextWidth('A');
  257.   CharHeight := Canvas.TextHeight('A');
  258.   for I := 0 to MaxRow do ScreenBuffer[I] := '';
  259.   BlankLine := '';
  260.   for I := 0 to MaxCol do BlankLine := BlankLine + ' ';
  261.   (* initialize parameters *)
  262.   Port := COM1;
  263.   Baud := Baud19200;
  264.   Parity := NoParity;
  265.   DataBits := WordLength8;
  266.   StopBits := OneStopBit;
  267.   (* initialize menu settings *)
  268.   menuOffLine.Checked := true;
  269.   menuCOM1.Checked := true;
  270.   menu19200.Checked := true;
  271.   menuNone.Checked := true;
  272.   menuEight.Checked := true;
  273.   menuOne.Checked := true;
  274.   (* initialize state variables *)
  275.   mioState := 0;
  276.   xyState := 0;
  277.   xyDebug(DebugLevel);
  278.   DisplayLine('FORM created');
  279. end;
  280.  
  281. procedure TTerm.menuOnLineClick(Sender: TObject);
  282. var      
  283.   Code : Integer;
  284. begin
  285.   (* initialize WSC *)
  286.   Code := SioReset(Port,2048,2048);
  287.   if Code < 0 then
  288.     begin
  289.       DisplayLine(Format('Error %d: Cannot reset port',[Code]));
  290.       ErrorText(Code);
  291.       exit
  292.     end;
  293.   (* set hardware flow control *)
  294.   Code := SioFlow(Port,'H');
  295.   DisplayLine('Waiting for DSR...');
  296.   (* attach XYDRIVER *)
  297.   Code := xyAcquire(Port);
  298.   (* update menu settings *)
  299.   Term.Caption := 'Term: COM' + Chr($31+Port) + ' Online';
  300.   menuOnLine.Checked := true;
  301.   menuOffLine.Checked := false;
  302.   menuChange.Enabled := false;
  303.   menuSend.Enabled := true;
  304.   menuReceive.Enabled := true;
  305.   menuDial.Enabled := true;
  306.   Code := SioBaud(Port,Baud);
  307.   Code := SioParms(Port, Parity, StopBits);
  308.   Code := SioDTR(Port,'S');
  309.   Code := SioRTS(Port,'S')
  310. end;
  311.  
  312. procedure TTerm.menuOfflineClick(Sender: TObject);
  313. var
  314.   Code : Integer;
  315. begin
  316.   Term.Caption := 'Term: Offline';
  317.   DisplayString('Shutting down COM port');
  318.   menuOnLine.Checked := false;
  319.   menuOffLine.Checked := true;
  320.   menuChange.Enabled := true;
  321.   menuSend.Enabled := false;
  322.   menuReceive.Enabled := false;
  323.   menuDial.Enabled := false;
  324.   Code := xyRelease(Port);
  325.   Code := SioDone(Port)
  326. end;
  327.  
  328. procedure TTerm.menuCOM1Click(Sender: TObject);
  329. begin
  330.   menuCOM1.Checked := true;
  331.   menuCOM2.Checked := false;
  332.   menuCOM3.Checked := false;
  333.   menuCOM4.Checked := false;
  334.   Port := COM1
  335. end;
  336.  
  337. procedure TTerm.menuCOM2Click(Sender: TObject);
  338. begin
  339.   menuCOM1.Checked := false;
  340.   menuCOM2.Checked := true;
  341.   menuCOM3.Checked := false;
  342.   menuCOM4.Checked := false;
  343.   Port := COM2
  344. end;
  345.  
  346. procedure TTerm.menuCOM3Click(Sender: TObject);
  347. begin
  348.   menuCOM1.Checked := false;
  349.   menuCOM2.Checked := false;
  350.   menuCOM3.Checked := true;
  351.   menuCOM4.Checked := false;
  352.   Port := COM3
  353. end;
  354.  
  355. procedure TTerm.menuCOM4Click(Sender: TObject);
  356. begin
  357.   menuCOM1.Checked := false;
  358.   menuCOM2.Checked := false;
  359.   menuCOM3.Checked := false;
  360.   menuCOM4.Checked := true;
  361.   Port := COM4
  362. end;
  363.  
  364. procedure TTerm.menuExitClick(Sender: TObject);
  365. var
  366.   Code : Integer;
  367. begin
  368.   Code := SioDone(Port);
  369.   Application.Terminate;
  370. end;
  371.  
  372. procedure TTerm.menu300Click(Sender: TObject);
  373. begin
  374.   menu300.Checked := true;
  375.   menu1200.Checked := false;
  376.   menu2400.Checked := false;
  377.   menu4800.Checked := false;
  378.   menu9600.Checked := false;
  379.   menu19200.Checked := false;
  380.   menu38400.Checked := false;
  381.   menu57600.Checked := false;
  382.   Baud := Baud300
  383. end;
  384.  
  385. procedure TTerm.menu1200Click(Sender: TObject);
  386. begin
  387.   menu300.Checked := false;
  388.   menu1200.Checked := true;
  389.   menu2400.Checked := false;
  390.   menu4800.Checked := false;
  391.   menu9600.Checked := false;
  392.   menu19200.Checked := false;
  393.   menu38400.Checked := false;
  394.   menu57600.Checked := false;
  395.   Baud := Baud1200
  396. end;
  397.  
  398. procedure TTerm.menu2400Click(Sender: TObject);
  399. begin
  400.   menu300.Checked := false;
  401.   menu1200.Checked := false;
  402.   menu2400.Checked := true;
  403.   menu4800.Checked := false;
  404.   menu9600.Checked := false;
  405.   menu19200.Checked := false;
  406.   menu38400.Checked := false;
  407.   menu57600.Checked := false;
  408.   Baud := Baud2400
  409. end;
  410.  
  411. procedure TTerm.menu4800Click(Sender: TObject);
  412. begin
  413.   menu300.Checked := false;
  414.   menu1200.Checked := false;
  415.   menu2400.Checked := false;
  416.   menu4800.Checked := true;
  417.   menu9600.Checked := false;
  418.   menu19200.Checked := false;
  419.   menu38400.Checked := false;
  420.   menu57600.Checked := false;
  421.   Baud := Baud4800
  422. end;
  423.  
  424. procedure TTerm.menu9600Click(Sender: TObject);
  425. begin
  426.   menu300.Checked := false;
  427.   menu1200.Checked := false;
  428.   menu2400.Checked := false;
  429.   menu4800.Checked := false;
  430.   menu9600.Checked := true;
  431.   menu19200.Checked := false;
  432.   menu38400.Checked := false;
  433.   menu57600.Checked := false;
  434.   Baud := Baud9600
  435. end;
  436.  
  437. procedure TTerm.menu19200Click(Sender: TObject);
  438. begin
  439.   menu300.Checked := false;
  440.   menu1200.Checked := false;
  441.   menu2400.Checked := false;
  442.   menu4800.Checked := false;
  443.   menu9600.Checked := false;
  444.   menu19200.Checked := true;
  445.   menu38400.Checked := false;
  446.   menu57600.Checked := false;
  447.   Baud := Baud19200
  448. end;
  449.  
  450. procedure TTerm.menu38400Click(Sender: TObject);
  451. begin
  452.   menu300.Checked := false;
  453.   menu1200.Checked := false;
  454.   menu2400.Checked := false;
  455.   menu4800.Checked := false;
  456.   menu9600.Checked := false;
  457.   menu19200.Checked := false;
  458.   menu38400.Checked := true;
  459.   menu57600.Checked := false;
  460.   Baud := Baud38400
  461. end;
  462.  
  463. procedure TTerm.menu57600Click(Sender: TObject);
  464. begin
  465.   menu300.Checked := false;
  466.   menu1200.Checked := false;
  467.   menu2400.Checked := false;
  468.   menu4800.Checked := false;
  469.   menu9600.Checked := false;
  470.   menu19200.Checked := false;
  471.   menu38400.Checked := false;
  472.   menu57600.Checked := true;
  473.   Baud := Baud57600
  474. end;
  475.  
  476. procedure TTerm.menuSevenClick(Sender: TObject);
  477. begin
  478.   menuSeven.Checked := true;
  479.   menuEight.Checked := false;
  480.   DataBits := WordLength7
  481. end;
  482.  
  483. procedure TTerm.menuEightClick(Sender: TObject);
  484. begin
  485.   menuSeven.Checked := false;
  486.   menuEight.Checked := true;
  487.   DataBits := WordLength8
  488. end;
  489.  
  490. procedure TTerm.menuNoneClick(Sender: TObject);
  491. begin
  492.   menuNone.Checked := true;
  493.   menuEven.Checked := false;
  494.   menuOdd.Checked := false;
  495.   Parity := NoParity
  496. end;
  497.  
  498. procedure TTerm.menuEvenClick(Sender: TObject);
  499. begin
  500.   menuNone.Checked := false;
  501.   menuEven.Checked := true;
  502.   menuOdd.Checked := false;
  503.   Parity := EvenParity
  504. end;
  505.  
  506. procedure TTerm.MenuOddClick(Sender: TObject);
  507. begin
  508.   menuNone.Checked := false;
  509.   menuEven.Checked := false;
  510.   menuOdd.Checked := true;
  511.   Parity := OddParity
  512. end;
  513.  
  514. procedure TTerm.menuOneClick(Sender: TObject);
  515. begin
  516.   menuOne.Checked := true;
  517.   menuTwo.Checked := false;
  518.   StopBits := OneStopBit
  519. end;
  520.  
  521. procedure TTerm.menuTwoClick(Sender: TObject);
  522. begin
  523.   menuOne.Checked := false;
  524.   menuTwo.Checked := true;
  525.   StopBits := TwoStopBits
  526. end;
  527.  
  528. procedure TTerm.TimerTimer(Sender: TObject);
  529. var
  530.   I     : Integer;
  531.   Code  : Integer;
  532.   Result: Integer;
  533.   Ptr   : PChar;
  534.   Text  : String;
  535.   Count : Integer;
  536.   C     : Char;
  537.   Packet  : Integer;
  538.   ErrorState : Integer;
  539. begin
  540.   if xyState <> 0 then
  541.     begin
  542.       case xyState of
  543.      10: begin (* XM Send *)
  544.            GetMem(Ptr,32);
  545.            StrPCopy(Ptr,AcceptBox.Text);
  546.            Code := xyStartTx(Port,Ptr,0,XMODEM);
  547.            xyState := 50;
  548.            FreeMem(Ptr,32);
  549.          end;
  550.      20: begin  (* YM Send *)
  551.            GetMem(Ptr,32);
  552.            StrPCopy(Ptr,AcceptBox.Text);
  553.            Code := xyStartTx(Port,Ptr,0,YMODEM);
  554.            xyState := 50;
  555.            FreeMem(Ptr,32)
  556.          end;
  557.      30: begin  (* XM Receive *)
  558.            GetMem(Ptr,32);
  559.            StrPCopy(Ptr,AcceptBox.Text);
  560.            Code := xyStartRx(Port,Ptr,CHR(NAK),XMODEM);
  561.            xyState := 50;
  562.            FreeMem(Ptr,32)
  563.          end;
  564.      40: begin   (* YM Receive *)
  565.            GetMem(Ptr,32);
  566.            StrPCopy(Ptr,'');
  567.            Code := xyStartRx(Port,Ptr,'C',YMODEM);
  568.            xyState := 50;
  569.            LastPacket := -1;
  570.            FreeMem(Ptr,32)
  571.          end;
  572.      50: begin   (* xyDriver *)
  573.            GetMem(Ptr,90);
  574.            while true do
  575.              begin
  576.                if xyGetMessage(Ptr,90) <> 0 then
  577.                  begin
  578.                    Text := StrPas(Ptr);
  579.                    DisplayLine(Text)
  580.                  end
  581.                else break;
  582.              end;
  583.            FreeMem(Ptr,90);
  584.            if xyDriver(Port) = MIO_IDLE then
  585.              begin
  586.                (* xy state driver is idle *)
  587.                xyState := 0;
  588.                menuBreak.Enabled := false;
  589.                menuDial.Enabled := true;
  590.                ErrorState := xyGetParameter(Port,XY_GET_ERROR_CODE);
  591.                if ErrorState <> 0 then
  592.                  begin
  593.                    DisplayLine(Format('File transfer fails (%d)',[ErrorState]));
  594.                  end
  595.                else DisplayLine('File transfer complete');
  596.                (* restore menu buttons *)
  597.                menuSend.Enabled := true;
  598.                menuReceive.Enabled := true;
  599.                menuBreak.Enabled := false
  600.              end
  601.            else
  602.              begin
  603.                (* xy state driver is running *)
  604.                Packet := xyGetParameter(Port,XY_GET_PACKET);
  605.                if (Packet <> LastPacket) and (DebugLevel = 0) then
  606.                  begin
  607.                    (*DisplayChar(Chr(CR));*)
  608.                    DisplayLine( Format('Packet %d',[Packet]) );
  609.                    LastPacket := Packet
  610.                  end
  611.              end;
  612.           end;
  613.       else
  614.         xyState := 0;
  615.       end
  616.     end
  617.   else if mioState <> 0 then
  618.     begin
  619.       case mioState of
  620.       1: begin
  621.            if Length(AcceptBox.Text) = 0 then
  622.              begin
  623.                DisplayLine('Missing phone number');
  624.                mioState := 0;
  625.              end
  626.            else
  627.              begin
  628.                menuBreak.Enabled := true;
  629.                menuDial.Enabled := false;
  630.                Text := '!ATDT' + AcceptBox.Text + '!';
  631.                DisplayLine(Text);
  632.                GetMem(Ptr,32);
  633.                StrPCopy(Ptr,Text);
  634.                mioSendTo(Port,100,Ptr);
  635.                FreeMem(Ptr,32);
  636.                mioState := 2
  637.              end
  638.          end;
  639.       2: begin
  640.            if mioDriver(Port) = MIO_IDLE then
  641.              begin
  642.                Text := 'CONNECT';
  643.                GetMem(Ptr,5);
  644.                StrPCopy(Ptr,Text);
  645.                mioWaitFor(Port,60000,Ptr);
  646.                FreeMem(Ptr,5);
  647.                mioState := 3
  648.              end
  649.          end;
  650.       3: begin
  651.            if mioDriver(Port) = MIO_IDLE then
  652.            begin
  653.              mioState := 0;
  654.              menuBreak.Enabled := false;
  655.              menuDial.Enabled := true;
  656.              if mioResult(Port) <> 0 then DisplayLine('[CONNECT was received]')
  657.              else
  658.                begin
  659.                  DisplayLine('[CONNECT was NOT received]')
  660.                end
  661.            end
  662.          end
  663.       end (* case *)
  664.     end (* else(mioState<>0) *)
  665.   else
  666.     begin
  667.       (* get all serial input *)
  668.       repeat
  669.         Code := SioGetc(Port);
  670.         if Code >= 0 then DisplayChar(Chr(Code))
  671.       until Code < 0;
  672.     end
  673. end;
  674.  
  675. procedure TTerm.KeyPress(Sender: TObject; var Key: Char);
  676. var
  677.   Code : Integer;
  678. begin
  679.   Code := SioPutc(Port,Key);
  680.   if(Code<WSC_NO_DATA)
  681.   then DisplayLine(Format('SioPutc error %d',[Code]));
  682. end;
  683.  
  684. procedure TTerm.AboutOKClick(Sender: TObject);
  685. begin
  686.    AboutPanel.Visible := False
  687. end;
  688.  
  689. procedure TTerm.menuAboutClick(Sender: TObject);
  690. begin
  691.      AboutPanel.Visible := True
  692. end;
  693.  
  694. procedure TTerm.menuDialClick(Sender: TObject);
  695. begin
  696.    AcceptMemo.Lines.Clear;
  697.    AcceptMemo.Lines.Add('Enter phone number');
  698.    AcceptPanel.Visible := true;
  699.    NewState := 1
  700. end;
  701.  
  702. procedure TTerm.AcceptOKClick(Sender: TObject);
  703. begin
  704.   AcceptPanel.Visible := false;
  705.   DisplayLine(AcceptBox.Text);
  706.   (* set state variable after get Accept text *)
  707.   if NewState = 1 then mioState := 1
  708.   else xyState := NewState;
  709.   NewState := 0;
  710. end;
  711.  
  712. procedure TTerm.menuBreakClick(Sender: TObject);
  713. begin
  714.    mioState := 0;
  715.    xyState := 0;
  716.    mioBreak(Port);
  717.    xyAbort(Port);
  718.    menuSend.Enabled := true;
  719.    menuReceive.Enabled := true
  720. end;
  721.  
  722. procedure TTerm.SXMODEMClick(Sender: TObject);
  723. begin
  724.   AcceptMemo.Lines.Clear;
  725.   AcceptMemo.Lines.Add('XMODEM file name');
  726.   AcceptPanel.Visible := true;
  727.   menuBreak.Enabled := true;
  728.   NewState := 10
  729. end;
  730.  
  731. procedure TTerm.SYMODEMClick(Sender: TObject);
  732. begin
  733.   AcceptMemo.Lines.Clear;
  734.   AcceptMemo.Lines.Add('YMODEM file name');
  735.   AcceptPanel.Visible := true;
  736.   menuBreak.Enabled := true;
  737.   NewState := 20
  738. end;
  739.  
  740. procedure TTerm.RXMODEMClick(Sender: TObject);
  741. begin
  742.   AcceptMemo.Lines.Clear;
  743.   AcceptMemo.Lines.Add('XMODEM file name');
  744.   AcceptPanel.Visible := true;
  745.   menuBreak.Enabled := true;
  746.   NewState := 30
  747. end;
  748.  
  749. procedure TTerm.RYMODEMClick(Sender: TObject);
  750. begin
  751.   (* set xy state variable directly *)
  752.   menuBreak.Enabled := true;
  753.   xyState := 40
  754. end;
  755.  
  756. procedure TTerm.XY(Sender: TObject);
  757. var
  758.   Ptr : PChar;
  759.   Text : String;
  760.   Parm : LongInt;
  761. begin
  762.   GetMem(Ptr,80);
  763.   while true do
  764.   begin
  765.     if xyGetMessage(Ptr,80) <> 0 then
  766.       begin
  767.         Text := StrPas(Ptr);
  768.         DisplayLine(Text)
  769.       end
  770.     else break;
  771.   end;
  772.   FreeMem(Ptr,80);
  773.   (* display current state *)
  774.   Parm := xyGetParameter(Port,XY_GET_STATE);
  775.   DisplayString('STATE =');
  776.   DisplayLine(Format('%d',[Parm]));
  777.   (* display error code *)
  778.   Parm := xyGetParameter(Port,XY_GET_ERROR_CODE);
  779.   if Parm <> 0 then
  780.     begin
  781.       DisplayLine(Format('ERROR Code = %d',[Parm]));
  782.       DisplayLine(Format('ERROR State = %d',
  783.                     [xyGetParameter(Port,XY_GET_ERROR_STATE)] ));
  784.     end;
  785.   (* display driver count *)
  786.   Parm := xyGetParameter(Port,XY_GET_DRIVER_COUNT);
  787.   DisplayLine( Format('xyDriver Count = %d',[Parm]) );
  788.   (* Display state variables *)
  789.   DisplayLine( Format('xyState = %d',[xyState]) );
  790. end;
  791.  
  792. end.
  793.