exportfrm.pas

单片机典型系统设计实例精讲 第4章 PC机与数控机床通信系统

{
=====================================================================
* 软件名称：PC与数控机床通信程序
* 单元名称：发送数据到数控机床
* 单元作者：彭为 ([e-mail])
* 备    注：用到了线程进行发送
* 开发平台：PWin2000 SERVER + Delphi 7.0
* 兼容测试：PWin9X/2000/XP + Delphi 6/7
* 采用控件：Raize 3.12 ,SPCOMM
* 修改记录：V1.0  by pengwei
=====================================================================
}
unit ExportFrm; //本单元用来发送数据

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, RzTabs, RzButton, StdCtrls, RzLabel, RzBorder,
  Grids, ValEdit, RzPrgres, ScktComp, SPComm, DB, ADODB;
type
  TExportData = class(TForm)
    Panel1: TPanel;
    pgcMain: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    Image1: TImage;
    Panel2: TPanel;
    btnFinish: TRzBitBtn;
    btnNext: TRzBitBtn;
    btnPrior: TRzBitBtn;
    RzLabel1: TRzLabel;
    RzLabel2: TRzLabel;
    RzLabel3: TRzLabel;
    Image2: TImage;
    RzBorder1: TRzBorder;
    RzLabel4: TRzLabel;
    RzLabel5: TRzLabel;
    RzLabel6: TRzLabel;
    edtUser: TEdit;
    edtMemo: TEdit;
    TabSheet3: TRzTabSheet;
    Image4: TImage;
    RzLabel12: TRzLabel;
    RzBorder3: TRzBorder;
    Lbl1: TRzLabel;
    Lbl2: TRzLabel;
    Lbl3: TRzLabel;
    pgb1: TRzProgressBar;
    Lbl4: TRzLabel;
    LblErr: TRzLabel;
    Lbl5: TRzLabel;
    RzLabel7: TRzLabel;
    RzLabel8: TRzLabel;
    cboChannel: TComboBox;
    RzBorder4: TRzBorder;
    RzLabel9: TRzLabel;
    cboComm: TComboBox;
    Comm1: TComm;
    Query: TADOQuery;
    LblCommErr: TRzLabel;
    procedure FormCreate(Sender: TObject); //界面初始化代码
    procedure btnNextClick(Sender: TObject); //“下一步”按钮点击事件
    procedure btnPriorClick(Sender: TObject); //“上一步”按钮点击事件
    procedure btnFinishClick(Sender: TObject); //“完成”按钮点击事件
    procedure cboChannelEnter(Sender: TObject); //用户改变“设备”的事件
    procedure FormDestroy(Sender: TObject); //销毁对象时执行
    procedure Comm1ReceiveError(Sender: TObject; EventMask: Cardinal); //SPCOMM接收数据错误事件
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word); //SPCOMM接收数据事件（很关键）
    procedure FormShow(Sender: TObject);
  private
    Fid: Integer; //局部变量存放ID
    Channel: Integer; //
    SendText: Tstrings; //发送的内容(数据机床命令，存在TSTRINGS对象中）
    { Private declarations }
  public
    bStart: Boolean; //是否已开始发送标志（用于线程与主界面同步）
    TickCount: Longword; //机床号
    procedure showForm(const id: integer);
    constructor Create(const id: Integer); reintroduce; overload;
    { Public declarations }
  end;
  //发送数据的线程，系统启动发送后，其它的回复等由该线程进行

  TSendThread = class(TThread)
  private
    Pos, Len: LongWord; //当前位置，总长度
    CurrChar: Char; // 当前发送的字符
    FSendText: string; //全部长度
    procedure Ok; //发送完成后执行的过程
    procedure Percent; //显示百分比过程
  public
    constructor Create(SendText: string); //线程的构造过程
    procedure Execute; override; //线程的执行体
  end;

var
  ExportData: TExportData;
  SendThread: TSendThread;

implementation

uses Include, Mainfrm, ConfigFrm;

{$R *.dfm}

procedure TExportData.FormCreate(Sender: TObject);
begin
  Caption := sExportCaption; //sExportCaption是窗口名'发送数据至数控机床'
  SendText := TStringlist.Create; //构造临时变量

end;

procedure TExportData.btnNextClick(Sender: TObject);
var
  FileName, sTemp: string;
  BeginChar: Byte; //初始标志位
  BeginChannel: array[1..2] of Byte; //2位字节数组
begin
  case pgcmain.activepageindex of
    0: //如果是第一页
      begin
        //初始化第二页的控件
        //清空机床的列表框
        cboChannel.Clear;
        cboChannel.Items := Config.ChannelList;
        //从数据库中查询出要发送的文件的内容
        with Query do
        begin
          Close;
          SQL.Clear;
          SQL.Add('Select * from Data where id=' + IntToStr(Fid));
          Open;
          FileName := FieldByName('filename').AsString;
          if FileExists(FileName) then //如果文件存在的话
          begin
            Application.ProcessMessages;
            SendText.LoadFromFile(FileName);
            //如果内容是空的
            if Trim(SendText.Text) = '' then
            begin
              MessageBox(Self.Handle, PChar(sFileEmpty), PChar(sTitleErr), MB_OK
                +
                MB_ICONERROR);
              exit;
            end;
          end
          else
          begin //如果文件不存在
            MessageBox(Self.Handle, PChar(sNotFile), PChar(sTitleErr), MB_OK +
              MB_ICONERROR);
            exit;
          end;
          //初始化必要的信息
          edtUser.Text := FieldByName('Author').AsString;
          edtMemo.Text := FieldByName('sMemo').AsString;
          Channel := FieldByName('Channel').AsInteger;
          cboChannel.ItemIndex := Channel - 1;
          cboComm.ItemIndex := cboComm.Items.IndexOf(Config.CommName);
          Close;
        end;
        LblCommErr.Visible := False;
      end;
    1: //如果是第二页
      begin
        //初始化发送前的准备工作
        Config.CommName := cboComm.Text; //串口
        Channel := cboChannel.ItemIndex + 1; //机床号

        //启动SPCOMM控件COMM1
        Comm1.CommName := Config.CommName;
        //先关闭
        Comm1.StopComm;
        try
          //再打开
          Comm1.StartComm;
        except
          //捕获异常
          LblCommErr.Visible := True;
          Exit;
        end;
        //起始字节为01，具体请参看通讯协议
        BeginChar := 01;
        //把机床号变成2位的ASCII码
        sTemp := Format('%.2d', [channel]);
        //把它的ASCII值送到临时数组中去
        BeginChannel[1] := Ord(sTemp[1]);
        BeginChannel[2] := Ord(sTemp[2]);

        //        ShowMessage(Format('%x %x %x', [beginchar[1], beginchar[2],beginchar[3]]));
        Sleep(100); //如果不休眠100毫秒，可能会发生错误，因为打开串口需要时间，以下类同
        Comm1.WriteCommData(@BeginChar, 1); //用SPCOMM往端口发送启始位01H
        Sleep(100);
        Comm1.WriteCommData(@BeginChannel, 2); //用SPCOMM发送机床号（选床）

        //开始发送正式的数据标志置FALSE
        bStart := False;

        //界面代码，使界面上的字变粗显示表示当前进度
        Lbl1.Font.Style := [fsBold];
        Lbl2.Font.Style := [fsBold];
        Lbl3.Font.Style := [];
        Lbl4.Font.Style := [];
        Lbl5.Visible := False;
        LblErr.Visible := False;
        pgb1.Percent := 0;
      end;
  else
    ;
  end;
  //转下一页
  pgcMain.ActivePageIndex := pgcMain.ActivePageIndex + 1;
  btnPrior.Enabled := True;
  if pgcMain.ActivePageIndex = pgcMain.PageCount - 1 then
    btnNext.Enabled := False;
end;

procedure TExportData.btnPriorClick(Sender: TObject);
begin
  //转前一页
  pgcMain.ActivePageIndex := pgcMain.ActivePageIndex - 1;
  btnNext.Enabled := True;
  if pgcMain.ActivePageIndex = 0 then
    btnPrior.Enabled := False;
end;

procedure TExportData.showForm(const id: integer);
begin
  //显示窗体的函数（实际调用时用本函数即可）
  if ExportData = nil then
    ExportData := TExportData.Create(id);
  ExportData.ShowModal;
end;

procedure TExportData.btnFinishClick(Sender: TObject);
begin
  //点击了完成 或取消
  if bStart then
  begin
    // 如果正在发送，则关闭线程
    bStart := False;
    SendThread.Terminate;
    //中断发送数据线程
  end;
  //关闭串口
  Comm1.StopComm;
  Close;
end;

procedure TExportData.cboChannelEnter(Sender: TObject);
begin
  LblCommErr.Visible := False;
end;

procedure TExportData.FormDestroy(Sender: TObject);
begin
  //释放内存
  SendText.Free;
end;

procedure TExportData.Comm1ReceiveError(Sender: TObject;
  EventMask: Cardinal);
begin
  LblErr.Caption := '串口接收数据出现错误';
  LblErr.Visible := True;
end;

procedure TExportData.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  ReceivedBuf: array of Byte;
  stemp: string;
  BeginChar: array[1..2] of Byte;
  SendChar: Byte;
  i: Integer;
begin
  SetLength(ReceivedBuf, BufferLength);
  try
    //把接收到的字符放入BUFFER
    Move(Buffer^, Pchar(@ReceivedBuf[0])^, BufferLength);
  except
    ShowMsg(sErrReceive1);
    exit;
  end;
  if not bStart then
  begin //尚未开始，根据协议，接收到的应该就是具体的机床号与前面的机床号相同
    stemp := Format('%.2d', [Channel]);
    BeginChar[1] := Ord(sTemp[1]);
    BeginChar[2] := Ord(sTemp[2]);

    if ((ReceivedBuf[0] = BeginChar[1]) and (ReceivedBuf[1] = BeginChar[2])) then
    begin //床号正确//开始回发床号，并发数据 置start为True
      //根据协议，02H为发送数据的功能
      SendChar := 02;
      Comm1.WriteCommData(@SendChar, 1);
      bstart := True;
      //发数据
      Lbl3.Font.Style := [fsBold];
      pgb1.Percent := 0;
      //启动数据发送线程
      SendThread := TSendThread.Create(SendText.Text);
    end
    else
    begin //床号不正确，显示错误并返回
      LblErr.Caption := '设备号选择出错！';
      LblErr.Visible := True;
    end;
  end
  else
    //其它情况正在正在发送，检测是否是07H(错误)
    //设置停止标志终止线程的发送
    for i := 0 to BufferLength - 1 do
    begin
      if ReceivedBuf[i] = $07 then
      begin
        bStart := false;
        SendThread.Terminate;

        LblErr.Caption := '数控机床设备返回错误信息，终止发送！';
        LblErr.Visible := True;
        Exit;
      end
      else if ReceivedBuf[i] = $17 then //完成了
      begin
        bStart := False;
        pgb1.Percent := 100;
        Lbl4.Font.Style := [fsbold];
        Lbl5.Caption := '花费时间:' + IntToStr(GetTickCount - TickCount) +
          '毫秒';
        btnFinish.Caption := '完成';
        Exit;
      end;
    end;
end;

{ TSendThread }

constructor TSendThread.Create(SendText: string);
begin
  //线程的构造线程
  FSendText := Copy(SendText, 1, Length(SendText) - 2);
  inherited Create(False);
end;

procedure TSendThread.Execute;
var
  isSend: Boolean;
begin
  FreeOnTerminate := True; //控制线程空闲时自动中断
  ExportData.TickCount := GetTickCount; //时间戳（用来计算发送时间）

  if not TestEOF(FSendText) then //如果没有结束符加入结束符
    //TESTEOF的函数在INCLUDE单元中定义，请查看所有源代码
    FSendText := FSendText + Chr(26);

  //开始发送之前记载发送的总长度
  Len := Length(FSendtext);
  //当前位置是第一个字符
  Pos := 1;
  //当发送数据未完而且主窗口的bstart为True则发送（如果主界面要取消，只要置bstart为false即可）
  while (Pos <= Len) and ExportData.bstart do
  begin
    //检查是否发送该字节
    isSend := True;
    CurrChar := FSendText[pos];
    case CurrChar of
      'a'..'z': CurrChar := UpperCase(CurrChar)[1];
      'A'..'Z', '0'..'9', '+', '-', '/', '.', Chr(26), '%', Chr(00), Chr($0A): ;
    else
      isSend := False;
    end;

    if isSend then
    begin
      //暂停若干秒
      Sleep(Config.Delaytime);
      //发送
      ExportData.Comm1.WriteCommData(@CurrChar, 1);
    end;
    //当前位置增量
    Inc(Pos);
    //线程调用函数输出进度信息
    Synchronize(Percent);
  end;
  //如果发送完了
  if Pos = Len + 1 then
  begin
    CurrChar := Chr($17);
    Sleep(100);
    //输出结束标志17H，参看通讯协议
    ExportData.Comm1.WriteCommData(@CurrChar, 1);
    Synchronize(ok);
  end;
  //  Self.Terminate;
  //  PostMessage(Application.Handle, WM_QUIT, 0, 0); ;
end;

procedure TSendThread.Ok;
begin
  ExportData.pgb1.Percent := 100;
  ExportData.Lbl4.Font.Style := [fsbold];
  ExportData.Lbl5.Visible := True;
  ExportData.Lbl5.Caption := '花费时间:' + IntToStr(GetTickCount -
    ExportData.TickCount) +
    '毫秒';
  ExportData.btnFinish.Caption := '完成';
  ExportData.bstart := False;
end;

procedure TSendThread.Percent;
begin
  ExportData.pgb1.Percent := trunc((Pos / Len) * 100);
end;

procedure TExportData.FormShow(Sender: TObject);
begin
  //显示窗体时初始化
  pgcMain.ActivePageIndex := 0;
  btnPrior.Enabled := False;
  btnNext.Enabled := True;
  btnFinish.Caption := '取消';
  Comm1.StopComm;

  SendText.Clear;
end;

constructor TExportData.Create(const id: Integer);
begin
  inherited Create(Application);
  Fid := id;
end;

end.