intercom.pas

Monitor.dfm Meter.dpr pasMain.pas

unit InterCom;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, MSCommLib_TLB, StdCtrls, ExtCtrls, Menus;

type
    TCommand = class(TForm)
    ListBox: TListBox;
    Panel1: TPanel;
    Bevel1: TBevel;
    Edit1: TEdit;
    Button2: TButton;
    Bevel2: TBevel;
    Button1: TButton;
    Timer1: TTimer;
    SaveDialog1: TSaveDialog;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure ListBoxDblClick(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
    Command: TCommand;
    timeout:integer;
implementation

uses pasMain, Global, Info, Promot;
{$R *.DFM}

procedure TCommand.FormCreate(Sender: TObject);
begin
    Left := 0;
    Top := frmMain.Height * 6 div 10;
    Width := frmInfo.Width;
    Height := frmMain.StatusBar.Top - frmMain.CoolBar1.Height
              - frmInfo.Height - 5;
end;

procedure TCommand.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
    if Key = chr(13) then Button2Click(Sender);
end;

procedure TCommand.Button2Click(Sender: TObject);
var
    Sbuf, Rbuf, rStr: String;
    maxwidth:integer;
begin
    ActiveCommand := TRUE;

    frmMain.MSComm.RThreshold := 0;
    frmMain.MSComm.InputLen := 1;

    Sbuf := Edit1.Text;
    ListBox.Items.Add(Sbuf);

    frmMain.MSComm.Output := Sbuf + Chr(13);

    Edit1.SelStart := 0;
    Edit1.SelLength := Length(Edit1.Text);
    Edit1.SetFocus;
    Timer1.Enabled := FALSE;
    TimeOut:= 0;

    while TRUE do
    begin
        Timer1.Enabled := TRUE;
        if not ActiveCommand then break;
        if TimeOut = 1 then
        begin
            Timer1.Enabled := FALSE;
            break;
        end;

        Application.ProcessMessages;
        //if not ActiveCommand then break;
        If frmMain.MSComm.InBufferCount >= 1 Then
        begin
            Rbuf := frmMain.MSComm.Input;
            rStr := rStr + Rbuf;
            If Rbuf = Chr(10) Then
            begin
                Timeout:=0;
                Timer1.Enabled := FALSE;
                ListBox.Items.Add(Copy(rStr, 1, Length(rStr) - 2));
                ListBox.ItemIndex := ListBox.Items.Count - 1;
                rStr := '';
                MaxWidth:=Listbox.Canvas.TextWidth(ListBox.Items.Strings[ListBox.ItemIndex]);
                if MaxWidth>ListBox.Width then
                SendMessage(ListBox.Handle,LB_SETHORIZONTALEXTENT,maxwidth+2,0);
          end;
        end;
    end;

end;


procedure TCommand.Button1Click(Sender: TObject);
begin
    frmPromot.Hide;
    frmPromot.Promot.Caption := '是否清除列表框内容?';
    if frmPromot.ShowModal <> mrOK then exit;
    //activecommand:=false;
    ListBox.Clear;

end;

procedure TCommand.Timer1Timer(Sender: TObject);
begin
        timeout:=1 ;
        //activecommand:=false;
end;

procedure TCommand.N1Click(Sender: TObject);
var
outputfile:textfile;
i:integer;
begin
savedialog1.Filter:='Text files (*.txt)|*.TXT';
if savedialog1.Execute then
begin

        assignfile(outputfile,savedialog1.filename);
        if fileexists(savedialog1.filename) then
        append(outputfile)
        else
        rewrite(outputfile);
        for i:=0 to  listbox.Items.Count-1 do
        writeln(outputfile,listbox.Items.Strings[i]);
        flush(outputfile);
        closefile(outputfile);
end;

end;

procedure TCommand.ListBoxDblClick(Sender: TObject);
begin
        edit1.Text:='';
        edit1.text:=ListBox.Items.Strings[ListBox.ItemIndex];

end;


procedure TCommand.FormClick(Sender: TObject);
begin
        frmMain.Dialog_TClick(Sender);
end;

end.