importfrm.pas

PC机控制数控机床程序

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

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
  TImport = 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;
    RzLabel8: TRzLabel;
    TabSheet3: TRzTabSheet;
    Image4: TImage;
    RzLabel12: TRzLabel;
    RzBorder3: TRzBorder;
    RzLabel13: TRzLabel;
    RzLabel14: TRzLabel;
    RzLabel7: TRzLabel;
    edtUser: TEdit;
    edtMemo: TEdit;
    cboChannel: TComboBox;
    cboComm: TComboBox;
    LblCommErr: TRzLabel;
    Lbl1: TRzLabel;
    Lbl2: TRzLabel;
    Lbl3: TRzLabel;
    Lbl4: TRzLabel;
    LblErr: TRzLabel;
    Lbl5: TRzLabel;
    RzBorder2: TRzBorder;
    Comm1: TComm;
    Query: TADOQuery;
    procedure FormCreate(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnPriorClick(Sender: TObject);
    procedure btnFinishClick(Sender: TObject);
    procedure Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormShow(Sender: TObject);
  private
    bStart: Boolean;
    TickCount: Longword;
    sMemo, sUser, sFileName: string;
    Channel: Integer;
    iRecvLength: Integer;
    RecvText: string;
    procedure SaveRecvText;
    { Private declarations }
  public
    procedure showForm;
    { Public declarations }
  end;

var
  Import: TImport;

implementation

uses Include, Mainfrm, ConfigFrm;

{$R *.dfm}

procedure TImport.FormCreate(Sender: TObject);
begin
  Caption := sImportCaption;
end;

procedure TImport.btnNextClick(Sender: TObject);
var
  sTemp: string;
  BeginChar: Byte;
  BeginChannel: array[1..2] of Byte;
begin
  case pgcmain.activepageindex of
    0:
      begin
        cboChannel.Clear;
        cboChannel.Items := Config.ChannelList;
        cboChannel.ItemIndex := 0;
        cboComm.ItemIndex := cboComm.Items.IndexOf(Config.CommName);
        edtUser.Clear;
        edtMemo.Clear;
        LblCommErr.Visible := False;
      end;
    1:
      begin
        sUser := edtUser.Text;
        sMemo := edtMemo.Text;
        Channel := cboChannel.ItemIndex + 1;
        Config.CommName := cboComm.Text;
        Comm1.CommName := cboComm.Text;
        Comm1.StopComm;
        try
          Comm1.StartComm;
        except
          LblCommErr.Visible := True;
          Exit;
        end;

        BeginChar := 01;
        sTemp := Format('%.2d', [channel]);
        BeginChannel[1] := Ord(sTemp[1]);
        BeginChannel[2] := Ord(sTemp[2]);

        //        ShowMessage(Format('%x %x %x', [beginchar[1], beginchar[2],
        //          beginchar[3]]));

        Sleep(100);
        Comm1.WriteCommData(@BeginChar, 1);
        Sleep(100);
        Comm1.WriteCommData(@BeginChannel, 2);

        bStart := False;

        Lbl1.Font.Style := [fsBold];
        Lbl2.Font.Style := [fsBold];
        Lbl3.Font.Style := [];
        Lbl4.Font.Style := [];
        Lbl5.Visible := False;
        LblErr.Visible := False;
      end;
  else
    ;
  end;

  pgcMain.ActivePageIndex := pgcMain.ActivePageIndex + 1;
  btnPrior.Enabled := True;
  if pgcMain.ActivePageIndex = pgcMain.PageCount - 1 then
    btnNext.Enabled := False;
end;

procedure TImport.btnPriorClick(Sender: TObject);
begin
  pgcMain.ActivePageIndex := pgcMain.ActivePageIndex - 1;
  btnNext.Enabled := True;
  if pgcMain.ActivePageIndex = 0 then
    btnPrior.Enabled := False;
end;

procedure TImport.showForm;
begin
  if Import = nil then
    Import := TImport.Create(self);
  Import.ShowModal;
end;

procedure TImport.btnFinishClick(Sender: TObject);
begin
  if bStart then
  begin
    if Length(RecvText) <> 0 then
    begin
      if MessageBox(Self.Handle, PChar(sBreak), PChar(sTitleAsk), MB_yesno +
        MB_ICONQUESTION) = idno then
        Exit;
      SaveRecvText;
    end;
    //中断发送数据线程
  end;
  Comm1.StopComm;
  Close;
end;

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

procedure TImport.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
    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 //床号正确//开始发送03，并发数据 置start为True
      SendChar := 03;
      Comm1.StopComm;
      Comm1.StartComm;
      Sleep(100);
      Comm1.WriteCommData(@SendChar, 1);

      bstart := True;
      //准备收数据
      Lbl3.Font.Style := [fsBold];
      RecvText := '';
      iRecvLength := 0;
      Lbl5.Visible := True;
      Lbl5.Caption := '接收到' + intTostr(iRecvLength) + '字节';
    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;
        //存储入文件
        SaveRecvText;

        LblErr.Caption := '数控机床设备返回错误信息，终止发送！';
        LblErr.Visible := True;
        Exit;
      end
      else if ReceivedBuf[i] = $17 then //完成了
      begin
        bStart := False;
        //存储入文件
        SaveRecvText;

        Lbl4.Font.Style := [fsbold];
        Lbl5.Caption := '接收到' + intTostr(iRecvLength) + '字节' + ' 花费时间:'
          +
          IntToStr(GetTickCount - TickCount) + '毫秒';
        btnFinish.Caption := '完成';
        Exit;
      end
      else //否则是正常的数据
      begin
        //存储入RecvText
        RecvText := RecvText + Chr(ReceivedBuf[i]);
        Inc(iRecvLength);

        Lbl5.Caption := '接收到' + intTostr(iRecvLength) + '字节';
      end;
    end;
end;

procedure TImport.SaveRecvText;
var
  BookMarker: Pointer;
  sList: TStrings;
begin
  try
    sList := TStringList.Create;
    try
      sList.Add(RecvText);
      sList.SaveToFile(sFilename);
      with Query do
      begin
        Close;
        SQL.Clear;
        SQL.Add('Insert into Data(Author,Filename,Timestr,Filesize,channel,smemo)values('''
          + sUser + ''',''' + sFileName + ''',''' + DateTimeTostr(now) +
          ''','''
          + IntToStr(Trunc(iRecvLength / 1024) + 1) + 'KB'',' + IntToStr(Channel)
          +
          ',''' +
          sMemo +
          ''')');
        ExecSQL;
        Close;
      end;
      with Main do
      begin
        BookMarker := Table.GetBookmark;
        Table.Close;
        Table.Open;
        Table.GotoBookmark(bookmarker);
      end;
    finally
      sList.Free;
    end;
  except
    ShowMsg('存储文件出现错误!');
    Exit;
  end;
  ;
end;

procedure TImport.FormShow(Sender: TObject);
begin

  pgcMain.ActivePageIndex := 0;
  pgcMain.ActivePageIndex := 0;
  btnPrior.Enabled := False;
  btnNext.Enabled := True;
  btnFinish.Caption := '取消';
  bstart := False;

  RecvText := '';
  sFileName := Main.getNewfilename;

end;

end.