unit1.pas

采用JAVA语言实现的出租车计价器的程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, MSCommLib_TLB, ExtCtrls, StdCtrls, ComCtrls, Db, ADODB;

type
  TMainForm = class(TForm)
    MSComm: TMSComm;
    tmrSend: TTimer;
    cmbbxComNum: TComboBox;
    cmbbxBaud: TComboBox;
    cmbbxDataNum: TComboBox;
    cmbbxStopBit: TComboBox;
    cmbbxCheckBit: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    btnSerial: TButton;
    chckbxTimer: TCheckBox;
    btnSend: TButton;
    edtTime: TEdit;
    Label6: TLabel;
    shpSerial: TShape;
    Label7: TLabel;
    Button1: TButton;
    Label48: TLabel;
    Label49: TLabel;
    Label50: TLabel;
    ListView1: TListView;
    Label13: TLabel;
    ADOQuery1: TADOQuery;
    ADOConnection1: TADOConnection;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnSerialClick(Sender: TObject);
    procedure chckbxTimerClick(Sender: TObject);
    procedure MSCommComm(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure tmrSendTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    HexShow:Boolean;
    HexSend:Boolean;
    SendNumber:integer;
    HaveShow:integer;
    e2:string;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses Unit2, Unit3, Unit4, Unit5;

{$R *.DFM}
function hex(c:char):Integer ;
var
      x:integer;
begin
     if c=' ' then
        x:=0
     else if (Ord(c)>=ord('0')) and (Ord(c)<=ord('9')) then
        x:=Ord(c)-Ord('0')
     else if (Ord(c)>=ord('a')) and (Ord(c)<=ord('f')) then
        x:=Ord(c)-Ord('a')+10
     else if (Ord(c)>=ord('A')) and (Ord(c)<=ord('F')) then
        x:=Ord(c)-Ord('A')+10
     else
        //输入错误
        x:=-1;        
      Result:=x;
end;

//该函数接收1个至2个字符
//转换成功.输出对应16进制数的值
//转换失败.输出-1。
function HexToInt(S:String): Integer;
var
    tmpInt1,tmpInt2:Integer ;
begin
   if Length(S)=1 then
   begin
      Result:=hex(S[1]);
   end
   else if Length(S)=2 then
   begin
      tmpInt1:=hex(S[1]);
      tmpInt2:=hex(S[2]);
      if (tmpInt1=-1) or (tmpInt2=-1) then
          Result:=-1
      else
          Result:= tmpInt1*16+tmpInt2;
      end
    else
        //输入错误，转换失败
        Result:=-1;
end;
//该函数接收4个字符
//转换成功.输出对应10进制数的值
//转换失败.输出-1。
function HexStrToInt(S:String): Integer;
var
    tmpInt1,tmpInt2,tmpInt3,tmpInt4:Integer ;
begin
      tmpInt1:=hex(S[1]);
      tmpInt2:=hex(S[2]);
      tmpInt3:=hex(S[3]);
      tmpInt4:=hex(S[4]);
      if (tmpInt1=-1) or (tmpInt2=-1) or (tmpInt3=-1) or (tmpInt4=-1)then
          Result:=-1
      else
          Result:= tmpInt1*16*16*16+tmpInt2*16*16+tmpInt3*16+tmpInt4;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
    cmbbxComNum.ItemIndex:=1;
    shpSerial.Brush.Color:=clWhite;
    MSComm.InputMode:=1;
    HexShow:=True;
    HexSend:=True;
    SendNumber:=1;
    HaveShow:=0;
end;
procedure TMainForm.btnSerialClick(Sender: TObject);
var
    ComSetting:String;
    
begin
    if not MSComm.PortOpen then
    begin
        //打开串口
        MSComm.CommPort :=cmbbxComNum.ItemIndex +1;
        //默认值为 '4800,N,8,1'
        ComSetting:=cmbbxBaud.Text;
        ComSetting:=ComSetting+','+cmbbxCheckBit.Text;
        ComSetting:=ComSetting+','+cmbbxDataNum.Text;
        ComSetting:=ComSetting+','+cmbbxStopBit.Text;
        MSComm.Settings:=ComSetting;
        MSComm.PortOpen:=True;

        //变换各个组件的状态
        shpSerial.Brush.Color:=clRed; //指示灯变红
        btnSerial.Caption :='关闭串口';
    end
    else  begin
        //关闭串口
        //变换各个组件的状态
        MSComm.PortOpen:=False;
        shpSerial.Brush.Color:=clWhite;//指示灯变白
        btnSerial.Caption :='打开串口';

    end;
end;

procedure TMainForm.chckbxTimerClick(Sender: TObject);
begin
    if chckbxTimer.Checked then
    begin
        tmrSend.Interval:=StrToInt(edtTime.Text);
        tmrSend.Enabled:=True;
        btnSend.Enabled:=False;
    end
    else begin
        tmrSend.Enabled:=False;
        btnSend.Enabled:=True;
    end;
end;

procedure TMainForm.MSCommComm(Sender: TObject);
var
    i,InputLen:Integer;
    tmpInt:Integer;
    tmpvar:Variant;
    InputString:String;
    tmpstr:String;
    listitem:TListItem;
    strSQL,e1,e3,e4,e5,e6,e7,e8,e9:string;
begin
    if MSComm.CommEvent=ComEvReceive then
    begin
        InputLen:=MSComm.InBufferCount;

        //接收二进制数据，转换为十六进制显示
        if HexShow then
        begin
          tmpvar:=MSComm.Input;
          InputString:='';
          for i:= 0 to InputLen-1 do
          begin
            tmpInt:=tmpvar[i];
            InputString:=InputString+''+LowerCase(IntToHex(tmpInt,2));
          end;
       end
        //直接接收字符
        else begin
            InputString:=MSComm.Input;

        end;
        if (Copy(InputString,5,4)='4545') then
        begin
            SendNumber:=1;
        end;
        if SendNumber=2 then
        begin
        e2:='辽'+UpperCase(Copy(InputString,6,1)+Copy(InputString,8,1)
        +Copy(InputString,10,1)+Copy(InputString,12,1)
        +Copy(InputString,14,1)+Copy(InputString,16,1)
        +Copy(InputString,18,1));
        Label50.Caption := e2;
        end;
        if SendNumber=3 then
        begin       
           //Label9.Caption:= '金额 :  '+FloatToStr(StrToInt(Copy(InputString,5,6))/10)+'元  ';
           //Label10.Caption:= '行驶里程:'+ FloatToStr(StrToInt(Copy(InputString,11,6))/10)+'公里          ';
           //Label12.Caption:= '载客行驶里程:'+FloatToStr(StrToInt(Copy(InputString,17,6))/10)+'公里       ';
           //Label17.Caption:= '侯时:'+ IntToStr(StrToInt(Copy(InputString,23,4)))+'小时'+
                             //IntToStr(StrToInt(Copy(InputString,27,2)))+'分   ';
        end;
        if SendNumber=4 then
        begin
           if HaveShow=0  then
           begin
           //Label52.Caption:= '金额 :  '+FloatToStr(StrToInt(Copy(InputString,5,8))/10)+'元   ';
           //Label53.Caption:='行驶里程:'+ FloatToStr(StrToInt(Copy(InputString,13,8))/10)+'公里           ';
           //Label54.Caption:='载客行驶里程:'+FloatToStr(StrToInt(Copy(InputString,21,8))/10)+'公里       ';
           //Label55.Caption:= '侯时:'+IntToStr(StrToInt(Copy(InputString,29,4)))+'小时'+
                        //IntToStr(StrToInt(Copy(InputString,33,2)))+'分   ';
           HaveShow:=1;
           end;
        end;
        if SendNumber=5 then
        begin
           listitem:=ListView1.Items.Add;
           e1:= IntToStr(HexStrToInt(Copy(InputString,39,4)));
           listitem.Caption:= e1;
           //e3:= '20'+Copy(InputString,37,2)+'.'
                              //+ IntToStr(StrToInt(Copy(InputString,5,2)))
                              //+ '.'+ IntToStr(StrToInt(Copy(InputString,7,2)));
           e3:= '20'+Copy(InputString,37,2)+Copy(InputString,5,2)+Copy(InputString,7,2);
           listitem.SubItems.Add(e3);
           e4:= IntToStr(StrToInt(Copy(InputString,9,2)))+':'+
               IntToStr(StrToInt(Copy(InputString,11,2)));
           listitem.SubItems.Add(e4);
           e5:= IntToStr(StrToInt(Copy(InputString,33,2)))+':'+
                                  IntToStr(StrToInt(Copy(InputString,35,2)));
           listitem.SubItems.Add(e5);
           e6:= IntToStr(StrToInt(Copy(InputString,21,2)))+':'+
                                  IntToStr(StrToInt(Copy(InputString,23,2)));
           listitem.SubItems.Add(e6);
           e7:= FloatToStr(StrToInt(Copy(InputString,13,4))/100);
           listitem.SubItems.Add(e7);
           e8:= FloatToStr(StrToInt(Copy(InputString,17,4))/10);
           listitem.SubItems.Add(e8);
           e9:= FloatToStr(StrToInt(Copy(InputString,27,6))/100);
           listitem.SubItems.Add(e9);
           strSQL:='insert into yyjl values('''+e1+''','''+e2+''', '''+e3+''','''+e4+''','''+e5+''','''+e6+''','''+e7+''','''+e8+''','''+e9+''')';
           with TADOQuery.Create(nil) do
           begin
           try
           Close;
           Connection:=MainForm.ADOConnection1;
           SQL.Clear;
           SQL.Add(strSQL);
           ExecSQL;
           finally
           Free;
           end;
           end;
        end;
    end
end;
procedure TMainForm.btnSendClick(Sender: TObject);
var
    Len:Integer;
    i,count,tmpInt:Integer;
    tmpVar:Variant;
    tmpStr,Output:String;
    
begin
    if not MSComm.PortOpen then
    begin
        showmessage('没有打开串口！');
        Exit;
    end
    else begin
        //发送二进制数，需要使用Variant变量矩阵，矩阵大小自动调节
        if HexSend then
        begin
        if SendNumber=1 then
            begin
               Output:='f1';
               MSComm.RThreshold:=10;
            end
        else  if SendNumber=4 then
            begin
               Output:='f2';
               MSComm.RThreshold:=23;
            end
        else  if SendNumber=2 then
            begin
               Output:='f5';
               MSComm.RThreshold:=21;
            end
        else  if SendNumber=3 then
            begin
               Output:='f6';
               MSComm.RThreshold:=21;
            end
        else  SendNumber:=4;
            Len:=Length(Output);
            if Len>0 then
            begin
               i:=1;
               count:=1;
               //创建一个Variant数组
               tmpVar:=VarArrayCreate([1,1],varByte);
               while(i<Len) do
               begin
                  //每3个字符串中截取2个字符，转换为16进制
                  tmpStr:=Copy(Output,i,2);
                  tmpStr:=LowerCase(tmpStr);
                  tmpInt:=HexToInt(tmpStr);
                  if tmpInt=-1 then
                  begin
                      showmessage('发送的数据格式有问题！');
                      exit;
                  end
                  else begin
                      tmpVar[Count]:=tmpInt;
                      Inc(count);
                     //增大Variant数组
                      VarArrayRedim(tmpVar,count);
                  end;
                  i:=i+3;
               end;
               MSComm.Output :=tmpVar;
               SendNumber:=SendNumber+1;
            end;
        end
    end;
end;

procedure TMainForm.tmrSendTimer(Sender: TObject);
begin
      if MSComm.PortOpen then
        btnSendClick(sender);
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
         Close;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
        Form2.show;
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
       Form3.show;
end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
        Form4.show;
end;

procedure TMainForm.Button5Click(Sender: TObject);
begin
        Form5.show;
end;

end.