home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 040A / WSC4D20.ZIP / SELF_PGM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-06  |  7.7 KB  |  312 lines
  1. unit Self_pgm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus,
  8.   wsc, ExtCtrls, StdCtrls;
  9. const
  10.   MaxRow = 15;
  11.   MaxCol = 65;
  12. type
  13.   TSelf = class(TForm)
  14.     MainMenu: TMainMenu;
  15.     menuPort: TMenuItem;
  16.     Test: TMenuItem;
  17.     menuCOM1: TMenuItem;
  18.     menuCOM2: TMenuItem;
  19.     menuCOM3: TMenuItem;
  20.     menuCOM4: TMenuItem;
  21.     Instructions: TMenuItem;
  22.     menuInstruct: TMenuItem;
  23.     menuExit: TMenuItem;
  24.     procedure IncrCol;
  25.     procedure IncrRow;
  26.     procedure DisplayChar(TheChar : Char);
  27.     procedure DisplayString(Text : String);
  28.     procedure DisplayLine(Text : String);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure menuCOM1Click(Sender: TObject);
  31.     procedure menuCOM2Click(Sender: TObject);
  32.     procedure menuCOM3Click(Sender: TObject);
  33.     procedure menuCOM4Click(Sender: TObject);
  34.     procedure KeyPress(Sender: TObject; var Key: Char);
  35.     procedure InstructionsClick(Sender: TObject);
  36.     procedure TestClick(Sender: TObject);
  37.     procedure menuExitClick(Sender: TObject);
  38.   
  39.   private
  40.     { Private declarations }
  41.     LastChar : Char;
  42.     Row : Integer;
  43.     Col : Integer;
  44.     RowBase : Integer;
  45.     CharWidth : Integer;
  46.     CharHeight : Integer;
  47.     Port : Integer;
  48.     Baud : Integer;
  49.     Parity : Integer;
  50.     DataBits : Integer;
  51.     StopBits : Integer;
  52.     ScreenBuffer : array [0..MaxRow] of string;
  53.     BlankLine : string;
  54.     TestText : string;
  55.   public
  56.     { Public declarations }
  57.   end ;
  58.  
  59. var
  60.   Self: TSelf;
  61.  
  62. implementation
  63.  
  64. {$R *.DFM}
  65.  
  66. procedure TSelf.IncrRow;
  67. var
  68.   I : Integer;
  69. begin
  70.   Col := 0;
  71.   Inc(Row);
  72.   if Row > MaxRow then
  73.     begin
  74.       (* scroll ScreenBuffer *)
  75.        for I := 0 to MaxRow-1 do
  76.           ScreenBuffer[I] := ScreenBuffer[I+1];
  77.        ScreenBuffer[MaxRow] := '';
  78.        (* re-display *)
  79.        for I := 0 to MaxRow-1 do
  80.          begin
  81.            Canvas.TextOut(0,(I*CharHeight),ScreenBuffer[I]+BlankLine);
  82.          end;
  83.        (* position on last line *)
  84.        Row := MaxRow;
  85.        Canvas.TextOut(0,MaxRow*CharHeight,BlankLine);
  86.        Canvas.MoveTo(0,MaxRow*CharHeight)
  87.     end
  88. end;
  89.  
  90. procedure TSelf.IncrCol;
  91. begin
  92.   Inc(Col);
  93.   if Col > MaxCol then
  94.     begin
  95.       IncrRow;
  96.     end;
  97. end;
  98.  
  99. procedure TSelf.DisplayChar(TheChar : Char);
  100. var
  101.    TheString : String;
  102. begin
  103.    if TheChar <> Chr(10) then
  104.      begin
  105.        if TheChar = Chr(13) then
  106.          begin
  107.           IncrRow;
  108.          end
  109.        else
  110.          begin
  111.            ScreenBuffer[Row] := ScreenBuffer[Row] + TheChar;
  112.            Canvas.TextOut((Col*CharWidth),(Row*CharHeight),''+TheChar);
  113.            IncrCol;
  114.          end;
  115.      end;
  116. end;
  117.  
  118. procedure TSelf.DisplayString(Text : String);
  119. var
  120.   I   : Integer;
  121.   Len : Integer;
  122.   S:String;
  123. begin
  124.   Len := Length(Text);
  125.   if Len > 0 then
  126.     for I := 1 to Len do
  127.        begin
  128.          DisplayChar(Text[I])
  129.        end;
  130. end;
  131.  
  132. procedure TSelf.DisplayLine(Text : String);
  133. begin
  134.   DisplayString(Text);
  135.   DisplayChar(chr(13))
  136. end;
  137.  
  138. procedure TSelf.FormCreate(Sender: TObject);
  139. var
  140.   I    : Integer;
  141.   Code : Integer;
  142. begin
  143.   (* initialize canvas *)
  144.   RowBase := 0;
  145.   CharWidth := Canvas.TextWidth('A');
  146.   CharHeight := Canvas.TextHeight('A');
  147.   for I := 0 to MaxRow do ScreenBuffer[I] := '';
  148.   BlankLine := '';
  149.   for I := 0 to MaxCol do BlankLine := BlankLine + ' ';
  150.   (* initialize parameters *)
  151.   Port := COM1;
  152.   Baud := Baud19200;
  153.   Parity := NoParity;
  154.   DataBits := WordLength8;
  155.   StopBits := OneStopBit;
  156.   Self.Caption := 'Selftest: COM' + Chr($31+Port);
  157.   menuCOM1.Checked := true;
  158.   TestText := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  159. end;
  160.  
  161. procedure TSelf.menuCOM1Click(Sender: TObject);
  162. begin
  163.   Self.Caption := 'Selftest: COM' + Chr($31+Port);
  164.   menuCOM1.Checked := true;
  165.   menuCOM2.Checked := false;
  166.   menuCOM3.Checked := false;
  167.   menuCOM4.Checked := false;
  168.   Port := COM1
  169. end;
  170.  
  171. procedure TSelf.menuCOM2Click(Sender: TObject);
  172. begin
  173.   Self.Caption := 'Selftest: COM' + Chr($32+Port);
  174.   menuCOM1.Checked := false;
  175.   menuCOM2.Checked := true;
  176.   menuCOM3.Checked := false;
  177.   menuCOM4.Checked := false;
  178.   Port := COM2
  179. end;
  180.  
  181. procedure TSelf.menuCOM3Click(Sender: TObject);
  182. begin
  183.   Self.Caption := 'Selftest: COM' + Chr($33+Port);
  184.   menuCOM1.Checked := false;
  185.   menuCOM2.Checked := false;
  186.   menuCOM3.Checked := true;
  187.   menuCOM4.Checked := false;
  188.   Port := COM3
  189. end;
  190.  
  191. procedure TSelf.menuCOM4Click(Sender: TObject);
  192. begin
  193.   Self.Caption := 'Selftest: COM' + Chr($34+Port);
  194.   menuCOM1.Checked := false;
  195.   menuCOM2.Checked := false;
  196.   menuCOM3.Checked := false;
  197.   menuCOM4.Checked := true;
  198.   Port := COM4
  199. end;
  200.  
  201.  
  202. procedure TSelf.KeyPress(Sender: TObject; var Key: Char);
  203. var
  204.   Code : Integer;
  205. begin
  206.   Code := SioPutc(Port,Key);
  207. end;
  208.  
  209. procedure TSelf.InstructionsClick(Sender: TObject);
  210. begin
  211.    DisplayLine('SELFTEST tests a single port for functionality.');
  212.    DisplayLine('The port must terminate with a loopback adapter.');
  213.    DisplayLine('See LOOPBACK.DOC for more information.')
  214. end;
  215.  
  216. procedure TSelf.TestClick(Sender: TObject);
  217. var
  218.   Code : Integer;
  219.   I, N : Integer;
  220.   Loop : Integer;
  221.   Size : Integer;
  222.   Ch   : Char;
  223.   Hr,Mn,ms : Word;
  224.   Sec1,Sec2: Word;
  225.   MaxRxQue : Integer;
  226.   MaxTxQue : Integer;
  227. begin
  228.   (* initialize WSC *)
  229.   Code := SioReset(Port,1024,1024);
  230.   if Code < 0 then
  231.     begin
  232.       DisplayString(Format('Error %d: Cannot reset port',[Code]));
  233.       exit
  234.     end;
  235.   (* update menu settings *)
  236.   Code := SioBaud(Port,Baud);
  237.   Code := SioParms(Port, Parity, StopBits);
  238.   Code := SioDTR(Port,'S');
  239.   Code := SioRTS(Port,'S');
  240.   Code := SioFlow(Port,'N');
  241.   (* display the test string *)
  242.   Size := Length(TestText);
  243.   DisplayString('Test string "');
  244.   DisplayString(TestText);
  245.   DisplayLine('"');
  246.   (* send TestText 16 times *)
  247.   DisplayString('  Sending: ');
  248.   for Loop := 1 to 16 do
  249.     begin
  250.       DisplayString(Format('%d ',[Loop]));
  251.       (* send test string *)
  252.       for I := 1 to Size do Code := SioPutc(Port,TestText[i]);
  253.     end;
  254.   MaxRxQue := SioRxQue(Port);
  255.   MaxTxQue := SioTxQue(Port);
  256.   DisplayLine(' ');
  257.   (* receive echo *)
  258.   DisplayString('Receiving: ');
  259.   for Loop := 1 to 16 do
  260.     begin
  261.       DisplayString(Format('%d ',[Loop]));
  262.       (* get response *)
  263.       for N := 1 to Size do
  264.         begin
  265.           (* expect character Ch *)
  266.           Ch := TestText[N];
  267.           DecodeTime(Time,Hr,Mn,Sec1,ms);
  268.           (* get next incoming character *)
  269.           repeat
  270.             (* fetch serial character *)
  271.             Code := SioGetc(Port);
  272.             if Code >= 0 then
  273.               begin
  274.                 (* is it the character expected? *)
  275.                 if Ch <> char(code) then
  276.                   begin
  277.                     DisplayLine(Format('Expected %c not %c',[Ch,chr(Code)]));
  278.                     Code := SioDone(Port);
  279.                     Application.Terminate
  280.                   end
  281.               end
  282.             (* no incoming character *)
  283.             else DecodeTime(Time,Hr,Mn,Sec2,ms);
  284.           until (Code>0) or (Sec2 = (Sec1 + 2) mod 60);
  285.           (* did we time out? *)
  286.           if Code < 0 then
  287.             begin
  288.               DisplayLine('Timed out waiting for serial input');
  289.               Code := SioDone(Port);
  290.               Application.Terminate
  291.             end
  292.         end
  293.     end;
  294.   DisplayLine(' ');
  295.   DisplayLine(Format('RX queue size = %d',[MaxRxQue]));
  296.   DisplayLine(Format('TX queue size = %d',[MaxTxQue]));
  297.   SioRxClear(Port);
  298.   (* close down *)
  299.   DisplayLine('Shutting down COM port');
  300.   Code := SioDone(Port)
  301. end;
  302.  
  303. procedure TSelf.menuExitClick(Sender: TObject);
  304. var
  305.   Code : Integer;
  306. begin
  307.   Code := SioDone(Port);
  308.   Application.Terminate;
  309. end;
  310.  
  311. end.
  312.