comm.pas

所有delphi的入门例子

unit comm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SPComm,  ExtCtrls, ComCtrls, Menus,
  ToolWin, ImgList, ActnList, DB, ADODB, Grids, DBGrids, IdBaseComponent,
  IdComponent, IdTCPServer  ;

type
  TForm1 = class(TForm)
    Comm4: TComm;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Memo1: TMemo;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    MainMenu1: TMainMenu;
    N0: TMenuItem;
    N1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N01: TMenuItem;
    N02: TMenuItem;
    N6: TMenuItem;
    N03: TMenuItem;
    N04: TMenuItem;
    N9: TMenuItem;
    N05: TMenuItem;
    N051: TMenuItem;
    N11: TMenuItem;
    N06: TMenuItem;
    Label2: TLabel;
    Label3: TLabel;
    N2: TMenuItem;
    N5: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    ADOCommand1: TADOCommand;
    Button4: TButton;
    StringGrid1: TStringGrid;
    ADODataSet1: TADODataSet;
    PopupMenu1: TPopupMenu;
    xu1: TMenuItem;
    N12: TMenuItem;
    StringGrid2: TStringGrid;
    N13: TMenuItem;
    IdTCPServer1: TIdTCPServer;
    Memo2: TMemo;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Comm4ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure StringGrid1Click(Sender: TObject);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N12Click(Sender: TObject);
    procedure N01Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    procedure setClassRoom();
  end;

var
  Form1: TForm1;
  rbuf:array[1..2048] of byte;
  viewstring:string;
  Ltime:integer = 0;
  strClassRoom:string;
  strInsOrEdStudent:integer;

implementation

uses ClassInformation,addStudent, monitor;

{$R *.dfm}
procedure TForm1.setClassRoom();
begin
    Label3.caption := strClassRoom;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Ltime:= 0;
    Comm4.StartComm;

end;

procedure TForm1.Comm4ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
    pc:^char;
    i:integer;
begin
    //label1.caption := inttostr(BufferLength);
    viewstring:='';
    pc:=@rbuf;
    move(buffer^,pc^,BufferLength);
    //move(buffer^,pchar(@rbuf^),bufferlength);

    for i:=1 to bufferlength do
      //memo1.lines.add(inttostr(rbuf[i]));
      viewstring:=viewstring+chr(rbuf[i])+' ';//inttohex(rbuf[i],2)+'';
      viewstring:='接收'+viewstring;
      memo1.lines.add(viewstring);
      //memo1.lines.add(chr(13));
      sleep(1000);
      memo1.Text := '';

    end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  {
  Ltime := Ltime + 1;
  label1.Caption := inttostr(Ltime);
  }
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   //关闭端口
   IdTCPServer1.Active :=false;
   comm4.StopComm;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
   strInsOrEdStudent := 2;
   OKRightDlg.show;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  i:integer;
begin
  //更新班级ID
  label3.Caption := strClassroom;
  //更新
  StringGrid1.ColCount := 3;
  StringGrid1.RowCount := 2;
  StringGrid1.ColWidths[1] :=0;

  StringGrid1.Cells[0, 0] := '状态';
  StringGrid1.Cells[1, 0] := 'ID';
  StringGrid1.Cells[2, 0] := '姓 名';

  Button4.Click ;

end;

procedure TForm1.N5Click(Sender: TObject);
begin
     OKRightDlg1.show;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  strConect,strSQL : string;
  i,j :integer;
begin
  strSQL := 'select ID,classroomid,name,email from student';
  //ADODataSet1.Active :=false;
  ADODataSet1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=F:\Tech.mdb;Persist Security Info=False';
  ADODataSet1.CommandText :=strSQL;
  ADODataSet1.Active :=true;
  ADODataSet1.ExecuteOptions ;
  j:=ADODataSet1.RecordCount;

  StringGrid1.RowCount := 2;
  StringGrid1.ColCount := 3;
  StringGrid1.Cells[0, 0] := '状态';
  StringGrid1.Cells[1, 0] := 'ID';
  StringGrid1.Cells[2, 0] := '姓 名';
  StringGrid1.ColWidths[1] :=0;

  if j <> 0 then
  begin
    StringGrid1.RowCount := j+1;
    ADODataSet1.First;
    for i:=1 to j do
    begin
      StringGrid1.Cells[0, i]:=inttostr(i);
      StringGrid1.Cells[1, i]:=ADODataSet1.FieldValues['ID'];
      StringGrid1.Cells[2, i]:=ADODataSet1.FieldValues['name'];
      ADODataSet1.Next;
    end;
  end;
  //刷型控件
  StringGrid1.Refresh ;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  sql : string ;
begin
  sql := 'delete from student';
  ADOCommand1.CommandText := sql;
  ADOCommand1.Execute ;
end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
  showmessage('fsfsf');
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  //showmessage(string(stringGrid1.selection.));
  //benCellSelect := true;
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Point: TPoint;
begin
  GetCursorPos(Point);
  if (Button = mbRight)  then
  begin
    PopupMenu1.Popup(Point.X,Point.Y);
  end;

end;

procedure TForm1.N12Click(Sender: TObject);
var
   strID,strSQL :string;
begin
   strID := StringGrid1.Cells[1,StringGrid1.Row];
   strSQL := 'delete from student where id ='+strID;
   ADOCommand1.CommandText := strsql;
   ADOCommand1.Execute ;

   Button4.Click;
end;

procedure TForm1.N01Click(Sender: TObject);
begin
   //增加班级ID
   strInsOrEdStudent := 1;
   OKRightDlg.show;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
  form2.show;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  cmd: string; //接收到客户端的字符串信息
begin
  with AThread.Connection do //已经连街上的一个进程
  begin
    //收到的字符串,客户端发送的命令字符串
    cmd := UpperCase(ReadLn);
    memo2.text := cmd + char(13);
    //回复的字符串
    WriteLn('it is OK');
  end;

//  edit4.Text := IdTCPClient1.ReadLn;

end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  //服务器准备好连接
  IdTCPServer1.DefaultPort := 9925;//StrToIntDef(Edit2.Text, 9925);
  if not IdTCPServer1.Active then IdTCPServer1.Active := True;

end;

end.