main.~pas

提取铁路的GPS数据通过串口

{*****************************************************************
*串口调试助手V1.0
*作    者：sky
*Email   : [e-mail]
*QQ      : 11116580
*版    本：V1.0
*编写时间：2005/12/19
*说    明：本程序完全参照龚建伟VC版《串口调试助手V2.2》编写而成。
           仅供学习测试之用。
******************************************************************}
{==================================================================
= 串口调试助手DELPHI SPCOMM V1.1
= 作者    ：谢利洪
= Email   : [e-mail]
= 版本    : V1.1
= 编写时间: 2006.10.21
= 说明    ：本版本由sky的1.0修改而成，本来只是用来学习SPCOMM控件的，想不到经过一
            个晚上的努力，程序已经近于完善了。就将我的成果共享出来吧。由于改用
            COMPORT控件为SPCOMM控件，整个代码已经经过大规模的改动，去除了Email等
            与程序应用不太相关的部分，改进了绝大部分算法，添加原未完成的功能 ，程序
            依然是参照龚建伟VC版《串口调试助手V2.2》来编写的。
===================================================================}

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, Spin, ExtCtrls, ImgList,
  Spcomm, shlobj;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    cbAutoSend: TCheckBox;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    btnSend: TButton;
    SpeedButton1: TSpeedButton;
    edStatus: TEdit;
    edRx: TEdit;
    edTx: TEdit;
    Button5: TButton;
    BitBtn1: TBitBtn;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    btnSwitch: TButton;
    cbRecHex: TCheckBox;
    cbAutoClean: TCheckBox;
    btnStopShow: TButton;
    Button8: TButton;
    Button9: TButton;
    edPath: TEdit;
    Timer1: TTimer;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    Comm1: TComm;
    ImageOff: TImage;
    ImageOn: TImage;
    Edit1: TEdit;
    cbTube: TCheckBox;
    cbStandard: TCheckBox;
    ledtLat: TLabeledEdit;
    ledtLong: TLabeledEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    procedure btnSwitchClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure cbAutoSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure Memo2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
  private
    { Private declarations }
    FShowText:Boolean;
    FRXNum:Integer;
    FTXNum:Integer;
    procedure ShowRX;
    procedure ShowTX;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;
  ReciveCount:LongInt;
  isReceive:boolean;
  StopTime:TDateTime;
  Sendtime,Sendtime1:LongInt;
  long,lat:double;
implementation

uses unitData;

const
  minWidth=627;
  minHeight=444;
  idAbout =$F200;

{$R *.dfm}

function SelectDirectory(Handle: hwnd; const Caption: string;
         const Root: WideString; out Directory: string): Boolean;
var lpBI: _BrowseInfo;
    Buf: array[0..MAX_PATH] of char;
    ID: IShellFolder;
    Eaten, Att: Cardinal;
    rt: pItemIDList;
    initdir: PWideChar;
begin
  Result := False;
  lpbi.hwndOwner := Handle;
  lpbi.lpfn := nil;
  lpbi.lpszTitle := PChar(Caption);
  lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
  SHGetDesktopFolder(ID);
  initdir := PWChar(Root);
  ID.ParseDisplayName(0, nil, InitDir, Eaten, rt, Att);
  lpbi.pidlRoot := rt;
  GetMem(lpbi.pszDisplayName, MAX_PATH);
  try
    Result := SHGetPathFromIDList(SHBrowseForFolder(lpbi), buf);
  except
    FreeMem(lpbi.pszDisplayName);
  end;
  if result then begin
    Directory := buf;
    if Length(Directory) <> 3 then
      Directory := Directory + '\';
  end;
end;


procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(
    HKEY_LOCAL_MACHINE,
    'HARDWARE\DEVICEMAP\SERIALCOMM',
    0,
    KEY_READ,
    KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
        KeyHandle,
        Index,
        PChar(ValueName),
        Cardinal(ValueLen),
        nil,
        @ValueType,
        PByte(PChar(Data)),
        @DataLen);

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          exit; //raise EComPort.Create(CError_RegError, ErrCode);

    until (ErrCode <> ERROR_SUCCESS) ;

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;

end;


procedure TFrmMain.btnSwitchClick(Sender: TObject);
var BaudRate :integer;
begin
if btnSwitch.Caption = '打开串口' then
  begin
  if not TryStrToInt(ComboBox2.Text,BaudRate) then
     begin
     Application.MessageBox('波特率设定有误'+#13+
                             ' 请重新输入','警告',MB_ICONWARNING or MB_OK);
     ComboBox2.SetFocus;
     exit;
     end;

  Comm1.StartComm;
  btnSwitch.Caption := '关闭串口';
  ComboBox1.Enabled := false;
  ComboBox2.Enabled := false;
  ComboBox3.Enabled := false;
  ComboBox4.Enabled := false;
  ComboBox5.Enabled := false;
  btnSend.Enabled   := true;
  ImageOff.Visible  := false;
  ImageOn.Visible   :=true;
  end
else //if Button1.Caption = '关闭串口' then
  begin
  Comm1.StopComm;
  btnSwitch.Caption := '打开串口';
  ComboBox1.Enabled := true;
  ComboBox2.Enabled := true;
  ComboBox3.Enabled := true;
  ComboBox4.Enabled := true;
  ComboBox5.Enabled := true;
  btnSend.Enabled   := false;
  ImageOn.Visible   := false;
  ImageOff.Visible  :=true;
  end;
  Timer1.Enabled := cbAutoSend.Checked;
end;

procedure TFrmMain.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FShowText:=True;
  FRXNum:=0;
  FTXNum:=0;
  EnumComPorts(ComboBox1.Items);    //得到串口列表
  ComboBox1.ItemIndex := 0;
  Comm1.CommName := ComboBox1.Text;
  ComboBox2.ItemIndex := 6;
  Comm1.BaudRate := StrToInt(ComboBox2.Text);
  ComboBox3.ItemIndex := 0;
  Comm1.Parity := None;
  ComboBox4.ItemIndex := 3;
  Comm1.ByteSize := _8;
  ComboBox5.ItemIndex := 0;
  Comm1.StopBits := _1;
  isReceive := True;
  Sendtime := 0;
  Sendtime1 := 1;
end;

procedure TFrmMain.ShowRX;
begin
end;

procedure TFrmMain.ShowTX;
begin
  edTx.Text:='Tx:'+IntTostr(FTXNum);
end;

procedure TFrmMain.Button5Click(Sender: TObject);
begin
  FRXNum:=0;
  FTXNum:=0;
  ShowRX;
  ShowTX;
end;

procedure TFrmMain.SpinEdit1Change(Sender: TObject);
begin
  Timer1.Interval:=SpinEdit1.Value;
end;

procedure TFrmMain.cbAutoSendClick(Sender: TObject);
begin
  Timer1.Enabled:=cbAutoSend.Checked;
  SpinEdit1.Enabled := not cbAutoSend.Checked;
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
    btnSend.Click;
end;

function HexStrToStr(const S:string):string;
//16进制字符串转换成字符串
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin   
    while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
      inc(t);
    if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$'+S[t]
    else
      ts:='$'+S[t]+S[t+1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result+Chr(M);
    inc(t,2);
  end;
end;

procedure TFrmMain.btnSendClick(Sender: TObject);
var
  SendBuffer: array [0..5] of char;
  i:integer;
begin
  long := 0;
  lat := 0;
  Inc(Sendtime);
  btnSend.Enabled := False;
  SendBuffer[0] := 'c';
  SendBuffer[1] := 'd';
  SendBuffer[2] := '1';
  SendBuffer[3] := chr(01);
  SendBuffer[4] := '0';
  SendBuffer[5] := '1';
  Comm1.WriteCommData(SendBuffer,6);
  btnSend.Enabled := True;
end;

function StrToHexStr(const S:string):string;
//字符串转换成16进制字符串
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result+' '+IntToHex(Ord(S[I]),2);
  end;
end;

procedure TFrmMain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  ReceiveBuffer: array[0..39] of char;
  i: Integer;
  Longitude: array [0..9] of char;
  Latitude: array[0..8] of char;
begin
//  if Sendtime1 < 4 then
  begin
    inc(Sendtime1);
    Move(Buffer^,ReceiveBuffer,BufferLength);
    if BufferLength = 40 then
    begin
      if ReceiveBuffer[32] = 'A' then
      begin
        for i:=0 to 8 do
        begin
          Longitude[i] := ReceiveBuffer[i + 15];
          Latitude[i] := ReceiveBuffer[i + 5];
        end;
        Longitude[9] := ReceiveBuffer[24];

        ledtLong.Text := LongiTude;
        ledtLat.Text := Latitude;

        long := long + StrtoFloat(Longitude);
        lat := lat + StrtoFloat(Latitude);
        //if Sendtime1 = 4 then
        begin
          dm.tblRailwayGPS.Append;
          dm.tblRailwayGPS.FieldByName('经度').AsString := LongiTude;//FloatToStr(long);
          dm.tblRailwayGPS.FieldByName('纬度').AsString := Latitude;//FloatToStr(lat);

          if cbTube.Checked then
            dm.tblRailwayGPS.FieldByName('隧道').AsString := '隧道';

          if cbStandard.Checked then
          begin
            dm.tblRailwayGPS.FieldByName('标志').AsString := '标称点';
            dm.tblRailwayGPS.FieldByName('里程').AsFloat := StrToFloat(edit1.Text);
          end;
          dm.tblRailwayGPS.Post;
          Sendtime1 := 1;
        end;
        edit3.Font.Color := clWindowText;
        edit3.Text := '定位'
      end
      else begin
        edit3.Font.Color := ClRed;
        edit3.Text := '未定位'
      end;
    end;
  end;
  Inc(ReciveCount);
  Edit2.Text := IntToStr(ReciveCount);
end;


procedure TFrmMain.ComboBox1Change(Sender: TObject);
begin
  Comm1.CommName:=ComboBox1.Text;
end;

procedure TFrmMain.ComboBox2Change(Sender: TObject);
var  BaudRate : Integer;
begin
  if ComboBox2.Text = 'Custom' then
    begin
      ComboBox2.Style := csDropDown;
      ComboBox2.SetFocus;
    end
  else begin
    if  ComboBox2.ItemIndex >0 then
      ComboBox2.Style := csDropDownList;
    if TryStrToInt(ComboBox2.Text,BaudRate) then
           Comm1.BaudRate := BaudRate;
  end;
end;

procedure TFrmMain.ComboBox3Change(Sender: TObject);
begin
  //TParity = ( None, Odd, Even, Mark, Space );
  Comm1.Parity := TParity(ComboBox3.ItemIndex);
end;

procedure TFrmMain.ComboBox4Change(Sender: TObject);
begin
   //TByteSize = ( _5, _6, _7, _8 );
   Comm1.ByteSize :=  TByteSize(ComboBox4.ItemIndex);
end;

procedure TFrmMain.ComboBox5Change(Sender: TObject);
begin
  //TStopBits = ( _1, _1_5, _2 );
  Comm1.StopBits := TStopBits(ComboBox5.ItemIndex);
end;

procedure TFrmMain.ComboBox2KeyPress(Sender: TObject; var Key: Char);
begin
 if not (Key in ['0'..'9',#8]) then Key := #0;
end;

procedure TFrmMain.Memo2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if (Shift=[ssAlt]) and (key=Ord('S')) and (btnSend.Enabled) then   //快捷键 ALT + S
   btnSend.Click;
end;


procedure TFrmMain.Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
begin
  comm1.StopComm;
  comm1.StartComm;
end;

end.