home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 040A / WSC4D20.ZIP / MODM_PGM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-17  |  14.4 KB  |  596 lines
  1. unit Modm_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.   TModm = class(TForm)
  14.     MainMenu: TMainMenu;
  15.     menuLine: TMenuItem;
  16.     menuOnLine: TMenuItem;
  17.     menuOffline: TMenuItem;
  18.     menuExit: TMenuItem;
  19.     menuChange: TMenuItem;
  20.     menuPort: TMenuItem;
  21.     menuBaud: TMenuItem;
  22.     menuDataBits: TMenuItem;
  23.     menuParity: TMenuItem;
  24.     menuStopBits: TMenuItem;
  25.     menuAbout: TMenuItem;
  26.     menuCOM1: TMenuItem;
  27.     menuCOM2: TMenuItem;
  28.     menuCOM3: TMenuItem;
  29.     menuCOM4: TMenuItem;
  30.     menu300: TMenuItem;
  31.     menu1200: TMenuItem;
  32.     menu2400: TMenuItem;
  33.     menu4800: TMenuItem;
  34.     menu9600: TMenuItem;
  35.     menu19200: TMenuItem;
  36.     menu38400: TMenuItem;
  37.     menu57600: TMenuItem;
  38.     menuSeven: TMenuItem;
  39.     menuEight: TMenuItem;
  40.     menuNone: TMenuItem;
  41.     menuEven: TMenuItem;
  42.     menuOdd: TMenuItem;
  43.     menuOne: TMenuItem;
  44.     menuTwo: TMenuItem;
  45.     Timer: TTimer;
  46.     AboutPanel: TPanel;
  47.     AboutOK: TButton;
  48.     AboutMemo: TMemo;
  49.     menuStatus: TMenuItem;
  50.     menuControl: TMenuItem;
  51.     menuFlowControl: TMenuItem;
  52.     menuHardware: TMenuItem;
  53.     menuSoftware: TMenuItem;
  54.     menuNoFlow: TMenuItem;
  55.     menuDTR: TMenuItem;
  56.     menuRTS: TMenuItem;
  57.     menuDTRset: TMenuItem;
  58.     menuDTRclear: TMenuItem;
  59.     menuRTSset: TMenuItem;
  60.     menuRTSclear: TMenuItem;
  61.     procedure IncrCol;
  62.     procedure IncrRow;
  63.     procedure DisplayChar(TheChar : Char);
  64.     procedure DisplayString(Text : String);
  65.     procedure DisplayLine(Text : String);
  66.     procedure FormCreate(Sender: TObject);
  67.     procedure menuOnLineClick(Sender: TObject);
  68.     procedure menuOfflineClick(Sender: TObject);
  69.     procedure menuCOM1Click(Sender: TObject);
  70.     procedure menuCOM2Click(Sender: TObject);
  71.     procedure menuCOM3Click(Sender: TObject);
  72.     procedure menuCOM4Click(Sender: TObject);
  73.     procedure menuExitClick(Sender: TObject);
  74.     procedure menu300Click(Sender: TObject);
  75.     procedure menu1200Click(Sender: TObject);
  76.     procedure menu2400Click(Sender: TObject);
  77.     procedure menu4800Click(Sender: TObject);
  78.     procedure menu9600Click(Sender: TObject);
  79.     procedure menu19200Click(Sender: TObject);
  80.     procedure menu38400Click(Sender: TObject);
  81.     procedure menu57600Click(Sender: TObject);
  82.     procedure menuSevenClick(Sender: TObject);
  83.     procedure menuEightClick(Sender: TObject);
  84.     procedure menuNoneClick(Sender: TObject);
  85.     procedure menuEvenClick(Sender: TObject);
  86.     procedure menuOddClick(Sender: TObject);
  87.     procedure menuOneClick(Sender: TObject);
  88.     procedure menuTwoClick(Sender: TObject);
  89.     procedure TimerTimer(Sender: TObject);
  90.     procedure KeyPress(Sender: TObject; var Key: Char);
  91.     procedure menuAboutClick(Sender: TObject);
  92.     procedure Status(Sender: TObject);
  93.     procedure AboutOKClick(Sender: TObject);
  94.     procedure menuDTRsetClick(Sender: TObject);
  95.     procedure menuRTSsetClick(Sender: TObject);
  96.     procedure menuDTRclearClick(Sender: TObject);
  97.     procedure menuRTSclearClick(Sender: TObject);
  98.     procedure menuHardwareClick(Sender: TObject);
  99.     procedure menuSoftwareClick(Sender: TObject);
  100.     procedure menuNoFlowClick(Sender: TObject);
  101.   private
  102.     { Private declarations }
  103.     LastChar : Char;
  104.     Row : Integer;
  105.     Col : Integer;
  106.     RowBase : Integer;
  107.     CharWidth : Integer;
  108.     CharHeight : Integer;
  109.     Port : Integer;
  110.     Baud : Integer;
  111.     Parity : Integer;
  112.     DataBits : Integer;
  113.     StopBits : Integer;
  114.     ScreenBuffer : array [0..MaxRow] of string;
  115.     BlankLine : string;
  116.   public
  117.     { Public declarations }
  118.   end ;
  119.  
  120. var
  121.   Modm: TModm;
  122.  
  123. implementation
  124.  
  125. {$R *.DFM}
  126.  
  127. procedure TModm.IncrRow;
  128. var
  129.   I : Integer;
  130. begin
  131.   Col := 0;
  132.   Inc(Row);
  133.   if Row > MaxRow then
  134.     begin
  135.       (* scroll ScreenBuffer *)
  136.        for I := 0 to MaxRow-1 do
  137.           ScreenBuffer[I] := ScreenBuffer[I+1];
  138.        ScreenBuffer[MaxRow] := '';
  139.        (* re-display *)
  140.        for I := 0 to MaxRow-1 do
  141.          begin
  142.            Canvas.TextOut(0,(I*CharHeight),ScreenBuffer[I]+BlankLine);
  143.          end;
  144.        (* position on last line *)
  145.        Row := MaxRow;
  146.        Canvas.TextOut(0,MaxRow*CharHeight,BlankLine);
  147.        Canvas.MoveTo(0,MaxRow*CharHeight)
  148.     end
  149. end;
  150.  
  151. procedure TModm.IncrCol;
  152. begin
  153.   Inc(Col);
  154.   if Col > MaxCol then
  155.     begin
  156.       IncrRow;
  157.     end;
  158. end;
  159.  
  160. procedure TModm.DisplayChar(TheChar : Char);
  161. var
  162.    TheString : String;
  163. begin
  164.    if TheChar <> Chr(10) then
  165.      begin
  166.        if TheChar = Chr(13) then
  167.          begin
  168.           IncrRow;
  169.          end
  170.        else
  171.          begin
  172.            ScreenBuffer[Row] := ScreenBuffer[Row] + TheChar;
  173.            Canvas.TextOut((Col*CharWidth),(Row*CharHeight),''+TheChar);
  174.            IncrCol;
  175.          end;
  176.      end;
  177. end;
  178.  
  179. procedure TModm.DisplayString(Text : String);
  180. var
  181.   I   : Integer;
  182.   Len : Integer;
  183.   S:String;
  184. begin
  185.   Len := Length(Text);
  186.   if Len > 0 then
  187.     for I := 1 to Len do
  188.        begin
  189.          DisplayChar(Text[I])
  190.        end;
  191. end;
  192.  
  193. procedure TModm.DisplayLine(Text : String);
  194. begin
  195.   DisplayString(Text);
  196.   DisplayChar(chr(13))
  197. end;
  198.  
  199. procedure TModm.FormCreate(Sender: TObject);
  200. var
  201.   I    : Integer;
  202.   Code : Integer;
  203. begin
  204.   (* initialize canvas *)
  205.   RowBase := 0;
  206.   CharWidth := Canvas.TextWidth('A');
  207.   CharHeight := Canvas.TextHeight('A');
  208.   for I := 0 to MaxRow do ScreenBuffer[I] := '';
  209.   BlankLine := '';
  210.   for I := 0 to MaxCol do BlankLine := BlankLine + ' ';
  211.   {
  212.   (* clear screen *)
  213.   for I := 0 to MaxRow do
  214.     Canvas.TextOut(0,(I*CharHeight),BlankLine);
  215.   Canvas.MoveTo(0,0);
  216.   }
  217.   (* initialize parameters *)
  218.   Port := COM1;
  219.   Baud := Baud19200;
  220.   Parity := NoParity;
  221.   DataBits := WordLength8;
  222.   StopBits := OneStopBit;
  223.   (* initialize menu settings *)
  224.   menuOffLine.Checked := true;
  225.   menuCOM1.Checked := true;
  226.   menu19200.Checked := true;
  227.   menuNone.Checked := true;
  228.   menuEight.Checked := true;
  229.   menuOne.Checked := true
  230. end;
  231.  
  232. procedure TModm.menuOnLineClick(Sender: TObject);
  233. var
  234.   Code : Integer;
  235. begin
  236.   (* initialize WSC *)
  237.   Code := SioReset(Port,1024,256);
  238.   if Code < 0 then
  239.     begin
  240.       DisplayString(Format('Error %d: Cannot reset port',[Code]));
  241.       exit
  242.     end;
  243.   (* update menu settings *)
  244.   Modm.Caption := 'Modem: COM' + Chr($31+Port) + ' Online';
  245.   menuOnLine.Checked := true;
  246.   menuOffLine.Checked := false;
  247.   menuChange.Enabled := false;
  248.   menuStatus.Enabled := true;
  249.   menuControl.Enabled := true;
  250.   menuFlowControl.Enabled := true;
  251.   menuNoFlow.Checked := true;
  252.   Code := SioBaud(Port,Baud);
  253.   Code := SioParms(Port, Parity, StopBits);
  254.   Code := SioDTR(Port,'S');
  255.   Code := SioRTS(Port,'S');
  256.   Code := SioFlow(Port,'N')
  257. end;
  258.  
  259. procedure TModm.menuOfflineClick(Sender: TObject);
  260. var
  261.   Code : Integer;
  262. begin
  263.   Modm.Caption := 'Modem: Offline';
  264.   DisplayString('Shutting down COM port');
  265.   menuOnLine.Checked := false;
  266.   menuOffLine.Checked := true;
  267.   menuChange.Enabled := true;
  268.   menuStatus.Enabled := false;
  269.   menuControl.Enabled := false;
  270.   menuFlowControl.Enabled := false;
  271.   Code := SioDone(Port)
  272. end;
  273.  
  274. procedure TModm.menuCOM1Click(Sender: TObject);
  275. begin
  276.   menuCOM1.Checked := true;
  277.   menuCOM2.Checked := false;
  278.   menuCOM3.Checked := false;
  279.   menuCOM4.Checked := false;
  280.   Port := COM1
  281. end;
  282.  
  283. procedure TModm.menuCOM2Click(Sender: TObject);
  284. begin
  285.   menuCOM1.Checked := false;
  286.   menuCOM2.Checked := true;
  287.   menuCOM3.Checked := false;
  288.   menuCOM4.Checked := false;
  289.   Port := COM2
  290. end;
  291.  
  292. procedure TModm.menuCOM3Click(Sender: TObject);
  293. begin
  294.   menuCOM1.Checked := false;
  295.   menuCOM2.Checked := false;
  296.   menuCOM3.Checked := true;
  297.   menuCOM4.Checked := false;
  298.   Port := COM3
  299. end;
  300.  
  301. procedure TModm.menuCOM4Click(Sender: TObject);
  302. begin
  303.   menuCOM1.Checked := false;
  304.   menuCOM2.Checked := false;
  305.   menuCOM3.Checked := false;
  306.   menuCOM4.Checked := true;
  307.   Port := COM4
  308. end;
  309.  
  310. procedure TModm.menuExitClick(Sender: TObject);
  311. var
  312.   Code : Integer;
  313. begin
  314.   Code := SioDone(Port);
  315.   Application.Terminate;
  316. end;
  317.  
  318. procedure TModm.menu300Click(Sender: TObject);
  319. begin
  320.   menu300.Checked := true;
  321.   menu1200.Checked := false;
  322.   menu2400.Checked := false;
  323.   menu4800.Checked := false;
  324.   menu9600.Checked := false;
  325.   menu19200.Checked := false;
  326.   menu38400.Checked := false;
  327.   menu57600.Checked := false;
  328.   Baud := Baud300
  329. end;
  330.  
  331. procedure TModm.menu1200Click(Sender: TObject);
  332. begin
  333.   menu300.Checked := false;
  334.   menu1200.Checked := true;
  335.   menu2400.Checked := false;
  336.   menu4800.Checked := false;
  337.   menu9600.Checked := false;
  338.   menu19200.Checked := false;
  339.   menu38400.Checked := false;
  340.   menu57600.Checked := false;
  341.   Baud := Baud1200
  342. end;
  343.  
  344. procedure TModm.menu2400Click(Sender: TObject);
  345. begin
  346.   menu300.Checked := false;
  347.   menu1200.Checked := false;
  348.   menu2400.Checked := true;
  349.   menu4800.Checked := false;
  350.   menu9600.Checked := false;
  351.   menu19200.Checked := false;
  352.   menu38400.Checked := false;
  353.   menu57600.Checked := false;
  354.   Baud := Baud2400
  355. end;
  356.  
  357. procedure TModm.menu4800Click(Sender: TObject);
  358. begin
  359.   menu300.Checked := false;
  360.   menu1200.Checked := false;
  361.   menu2400.Checked := false;
  362.   menu4800.Checked := true;
  363.   menu9600.Checked := false;
  364.   menu19200.Checked := false;
  365.   menu38400.Checked := false;
  366.   menu57600.Checked := false;
  367.   Baud := Baud4800
  368. end;
  369.  
  370. procedure TModm.menu9600Click(Sender: TObject);
  371. begin
  372.   menu300.Checked := false;
  373.   menu1200.Checked := false;
  374.   menu2400.Checked := false;
  375.   menu4800.Checked := false;
  376.   menu9600.Checked := true;
  377.   menu19200.Checked := false;
  378.   menu38400.Checked := false;
  379.   menu57600.Checked := false;
  380.   Baud := Baud9600
  381. end;
  382.  
  383. procedure TModm.menu19200Click(Sender: TObject);
  384. begin
  385.   menu300.Checked := false;
  386.   menu1200.Checked := false;
  387.   menu2400.Checked := false;
  388.   menu4800.Checked := false;
  389.   menu9600.Checked := false;
  390.   menu19200.Checked := true;
  391.   menu38400.Checked := false;
  392.   menu57600.Checked := false;
  393.   Baud := Baud19200
  394. end;
  395.  
  396. procedure TModm.menu38400Click(Sender: TObject);
  397. begin
  398.   menu300.Checked := false;
  399.   menu1200.Checked := false;
  400.   menu2400.Checked := false;
  401.   menu4800.Checked := false;
  402.   menu9600.Checked := false;
  403.   menu19200.Checked := false;
  404.   menu38400.Checked := true;
  405.   menu57600.Checked := false;
  406.   Baud := Baud38400
  407. end;
  408.  
  409. procedure TModm.menu57600Click(Sender: TObject);
  410. begin
  411.   menu300.Checked := false;
  412.   menu1200.Checked := false;
  413.   menu2400.Checked := false;
  414.   menu4800.Checked := false;
  415.   menu9600.Checked := false;
  416.   menu19200.Checked := false;
  417.   menu38400.Checked := false;
  418.   menu57600.Checked := true;
  419.   Baud := Baud57600
  420. end;
  421.  
  422. procedure TModm.menuSevenClick(Sender: TObject);
  423. begin
  424.   menuSeven.Checked := true;
  425.   menuEight.Checked := false;
  426.   DataBits := WordLength7
  427. end;
  428.  
  429. procedure TModm.menuEightClick(Sender: TObject);
  430. begin
  431.   menuSeven.Checked := false;
  432.   menuEight.Checked := true;
  433.   DataBits := WordLength8
  434. end;
  435.  
  436. procedure TModm.menuNoneClick(Sender: TObject);
  437. begin
  438.   menuNone.Checked := true;
  439.   menuEven.Checked := false;
  440.   menuOdd.Checked := false;
  441.   Parity := NoParity
  442. end;
  443.  
  444. procedure TModm.menuEvenClick(Sender: TObject);
  445. begin
  446.   menuNone.Checked := false;
  447.   menuEven.Checked := true;
  448.   menuOdd.Checked := false;
  449.   Parity := EvenParity
  450. end;
  451.  
  452. procedure TModm.menuOddClick(Sender: TObject);
  453. begin
  454.   menuNone.Checked := false;
  455.   menuEven.Checked := false;
  456.   menuOdd.Checked := true;
  457.   Parity := OddParity
  458. end;
  459.  
  460. procedure TModm.menuOneClick(Sender: TObject);
  461. begin
  462.   menuOne.Checked := true;
  463.   menuTwo.Checked := false;
  464.   StopBits := OneStopBit
  465. end;
  466.  
  467. procedure TModm.menuTwoClick(Sender: TObject);
  468. begin
  469.   menuOne.Checked := false;
  470.   menuTwo.Checked := true;
  471.   StopBits := TwoStopBits
  472. end;
  473.  
  474. procedure TModm.TimerTimer(Sender: TObject);
  475. var
  476.   Code : Integer;
  477. begin
  478.   repeat
  479.     Code := SioGetc(Port);
  480.     if Code >= 0 then DisplayChar(Chr(Code))
  481.   until Code < 0
  482. end;
  483.  
  484. procedure TModm.KeyPress(Sender: TObject; var Key: Char);
  485. var
  486.   Code : Integer;
  487. begin
  488.   {
  489.   if Key = Chr(13) then
  490.     begin
  491.       DisplayChar(CHR(10))
  492.     end
  493.   else
  494.     begin
  495.       DisplayChar(Key)
  496.     end;
  497.     }
  498.   Code := SioPutc(Port,Key);
  499. end;
  500.  
  501. procedure TModm.menuAboutClick(Sender: TObject);
  502. begin
  503.    AboutPanel.Visible := True
  504. end;
  505.  
  506. procedure TModm.Status(Sender: TObject);
  507. var
  508.   Code : Integer;
  509.   Text : String;
  510. begin
  511.   if SioDSR(Port) = 0 then DisplayLine('[DSR is clear]')
  512.   else DisplayLine('[DSR is set]');
  513.   if SioCTS(Port) = 0 then DisplayLine('[CTS is clear]')
  514.   else DisplayLine('[CTS is set]');
  515.   Code := SioStatus(Port,$ffff);
  516.   (* DisplayLine(Format('%x',[Code])) *)
  517.   if(WSC_RXOVER AND Code) <> 0 then DisplayLine('[RX queue overflow]');
  518.   if(WSC_OVERRUN AND Code) <> 0 then DisplayLine('[UART overrun]');
  519.   if(WSC_FRAME AND Code) <> 0 then DisplayLine('[Framing error]');
  520.   if(WSC_BREAK AND Code) <> 0 then DisplayLine('[BREAK detected]');
  521.   if(WSC_TXFULL AND Code) <> 0 then DisplayLine('[TX queue full]')
  522. end;
  523.  
  524. procedure TModm.AboutOKClick(Sender: TObject);
  525. begin
  526.    AboutPanel.Visible := False
  527. end;
  528.  
  529. procedure TModm.menuDTRsetClick(Sender: TObject);
  530. var
  531.   Code : Integer;
  532. begin
  533.   Code := SioDTR(Port,'S');
  534.   menuDTRset.Checked := true;
  535.   menuDTRclear.Checked := false
  536. end;
  537.  
  538. procedure TModm.menuRTSsetClick(Sender: TObject);
  539. var
  540.   Code : Integer;
  541. begin
  542.   Code := SioRTS(Port,'S');
  543.   menuRTSset.Checked := true;
  544.   menuRTSclear.Checked := false
  545. end;
  546.  
  547. procedure TModm.menuDTRclearClick(Sender: TObject);
  548. var
  549.   Code : Integer;
  550. begin
  551.   Code := SioDTR(Port,'C');
  552.   menuDTRclear.Checked := true;
  553.   menuDTRset.Checked := false
  554. end;
  555.  
  556. procedure TModm.menuRTSclearClick(Sender: TObject);
  557. var
  558.   Code : Integer;
  559. begin
  560.   Code := SioRTS(Port,'C');
  561.   menuRTSclear.Checked := true;
  562.   menuRTSset.Checked := false
  563. end;
  564.  
  565. procedure TModm.menuHardwareClick(Sender: TObject);
  566. var
  567.   Code : Integer;
  568. begin
  569.   Code := SioFlow(Port,'H');
  570.   menuHardware.Checked := true;
  571.   menuSoftware.Checked := false;
  572.   menuNoFlow.Checked := false
  573. end;
  574.  
  575. procedure TModm.menuSoftwareClick(Sender: TObject);
  576. var
  577.   Code : Integer;
  578. begin
  579.   Code := SioFlow(Port,'S');
  580.   menuHardware.Checked := false;
  581.   menuSoftware.Checked := true;
  582.   menuNoFlow.Checked := false
  583. end;
  584.  
  585. procedure TModm.menuNoFlowClick(Sender: TObject);
  586. var
  587.   Code : Integer;
  588. begin
  589.   Code := SioFlow(Port,'N');
  590.   menuHardware.Checked := false;
  591.   menuSoftware.Checked := false;
  592.   menuNoFlow.Checked := true
  593. end;
  594.  
  595. end.
  596.