unit1.pas

一个简单的聊天程序－－聊天机器人

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UnitBitmapRgn, ExtCtrls, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    chatroom: TRichEdit;
    say: TEdit;
    sayb: TButton;
    procedure sayKeyPress(Sender: TObject; var Key: Char);
    procedure saybClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    index:integer;
    function modifystring(s:string):string;
    function getans(s:string):string;
  end;

var
  Form1: TForm1;

implementation

uses OkCancl1;

{$R *.DFM}
function tform1.modifystring(s:string):string;
var
tmp:string;
begin
  tmp:=stringreplace(s,' ','',[rfReplaceAll]);
  tmp:=stringreplace(tmp,'-','',[rfReplaceAll]);
  tmp:=stringreplace(tmp,'_','',[rfReplaceAll]);
  tmp:=stringreplace(tmp,'-','',[rfReplaceAll]);
  tmp:=stringreplace(tmp,'——','',[rfReplaceAll]);
  result:=tmp;
end;


function tform1.getans(s:string): string;
var
i:integer;
tmp,tmp1,tmp2:string;
begin
  result:='';
  if s='123newguystart' then
    begin
      result:=setup.Memo1.Lines.Strings[index];
      setup.Memo2.Lines.Add('goodgood tmdniu');
      index:=1;
      exit;
    end;
  tmp2:=modifystring(s);
  if (pos(' ',s)>0)and(tmp2='') then
    begin
      result:='不要尽是敲空格了，很无聊的。';
      exit;
    end;
  if index>setup.Memo1.Lines.Count then
    begin
      exit;
    end;
  tmp:='';
  for i:=0 to setup.Memo2.Lines.Count-1 do
    begin
      application.ProcessMessages;
      tmp1:=copy(setup.Memo2.Lines.Strings[i],
                             1,pos(' ',setup.Memo2.Lines.Strings[i])-1);
      if pos(tmp1,tmp2)>0 then
        begin
          tmp1:=setup.Memo2.Lines.Strings[i];
          delete(tmp1,1,pos(' ',tmp1));
          tmp:=tmp1;
          break;
        end;
    end;
  if tmp='' then
    begin
      tmp:=setup.Memo1.Lines.Strings[index];
      inc(index);
    end;
  result:=tmp;
end;


procedure TForm1.sayKeyPress(Sender: TObject; var Key: Char);
begin
  if ord(key)=VK_RETURN then
     begin
       if say.Text='123testsetup' then
          begin
            say.Text:='';
            setup.ShowModal;
            say.SetFocus;
          end
       else
          sayb.Click;
     end;
end;

procedure TForm1.saybClick(Sender: TObject);
begin
  if say.text='' then
    begin
      chatroom.SelAttributes.Color:=clred;
      chatroom.Lines.Add('笨笨说： 你认为这样有意义吗！');
      say.Text:='';
      say.SetFocus;
      exit;
    end;
  chatroom.SelAttributes.Color:=clblue;
  chatroom.Lines.Add('我说：   '+say.text);
  chatroom.SelAttributes.Color:=clred;
  chatroom.Lines.Add('笨笨说： '+getans(say.text));
  say.Text:='';
  say.SetFocus;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  index:=0;
  chatroom.Lines.Add('笨笨说： '+getans('123newguystart'));
end;

end.