sampling.pas

这是一个正式的项目工程

unit Sampling;

interface

uses
  dialogs,Classes, comctrls, SysUtils,wsTypes,wsCores,Forms;

type
  TSamplingThread = class(TThread)
  private
    LDataPacket :TDataPacket;
    RCount:Integer;
    iExtension         :Byte;
    FirstByte          :Byte;
    RawSamplingData    :Array[0..6] of Byte;
    bHigh4,bLow4,bTemp :Byte;
    Char1,Char2,Char3,Char4  :String;
    WaitSuccess        :Boolean;
    FirstSamplingCount :Byte;

    procedure   InitSampling;
    procedure   SamplingData;
  protected
    procedure   Execute; override; // Main thread execution
  published
    constructor CreateIt(PriorityLevel: cardinal);
    destructor  Destroy; override;
  end;


implementation

uses
  windows, SendCommand,CPort;

Constructor TSamplingThread.CreateIt(PriorityLevel: cardinal);
begin
  inherited Create(true);
  FirstSamplingCount:=0;
  Priority :=tpTimeCritical;    //TThreadPriority(PriorityLevel);
  FreeOnTerminate := True;
  Synchronize(InitSampling);
  Suspended := False;
end;

destructor TSamplingThread.Destroy;
begin
  PostMessage(frmSendCommand.Handle,wm_ThreadDoneMsg,self.ThreadID,0);
  inherited destroy;
end;

procedure TSamplingThread.Execute;
begin
  frmSendCommand.SamplingThreadActive:=True;
  while (not Terminated) and (frmSendCommand.SamplingThreadActive)  do
  begin
//    Synchronize(SamplingData);
    SamplingData;
//    Application.ProcessMessages;
  end;
{  frmSendCommand.LabelCommErr.Visible:=True;
  if Terminated then frmSendCommand.LabelCommErr.Caption:='Terminated'
  else if not frmSendCommand.SamplingThreadActive then frmSendCommand.LabelCommErr.Caption:='Not Active';}
end;

procedure TSamplingThread.InitSampling();
begin
  iExtension:=0;
  bHigh4:=15;
  bHigh4:=bHigh4 shl 4;
  bLow4:=15;
  With LDataPacket do
  begin
    ExtensionID:='';
    Name:='';
    Gravity:=0;
    HeightDiff:=0;
    State:=0;
  end;
  With frmSendCommand do
  Begin
    While AllExtension[iExtension].ExtensionID='' do
    begin
      iExtension:=iExtension+1;
      if iExtension=120 then
        iExtension:=0;
    end;
  end;
end;

procedure TSamplingThread.SamplingData;
var
  iLimit,maxLimit:Integer;
begin
  RawSamplingData[0]:=0;
  RawSamplingData[1]:=0;
  RawSamplingData[2]:=0;
  RawSamplingData[3]:=0;
  RawSamplingData[4]:=0;
  RawSamplingData[5]:=0;
  RawSamplingData[6]:=0;
  With LDataPacket do
  begin
    ExtensionID:='';
    Name:='';
    Gravity:=0;
    HeightDiff:=0;
    //State:=0;
  end;
  With frmSendCommand do
  begin
    iLimit:=0;
    if not AllExtension[iExtension].Adjusting then maxLimit:=3
    else maxLimit:=10;
    repeat
      {//ComPort.ClearBuffer(True,False);}
      //while  bSampling do begin end;

      bSampling:=True;

      With ComPort do
      begin
        if iLimit>0 then
          begin
          frmSendCommand.LabelCommErr.Caption:='Err'+IntToStr(iExtension);
          frmSendCommand.LabelCommErr.Visible:=True;
          end
        else
          frmSendCommand.LabelCommErr.Visible:=False;
        BeginUpdate;
        Parity.Check:=False;
        Parity.Bits:=prMark;
        EndUpdate;
        Write(iExtension,1);
        Sleep(3);
        BeginUpdate;
        Parity.Bits:=prSpace;
        EndUpdate;
        bTemp:=0;
        Write(bTemp,1);
        bTemp:=FormBCD(FloatToStr(StandardG[iExtension].Value));
        Write(bTemp,1);
      end;
      bSampling:=False;

      RCount:=0;
      Events := [evRxChar];
      ComPort.WaitForEvent(Events, Event.Handle, 100);
      RCount:=ComPort.Read(RawSamplingData,7);
      iLimit:=iLimit+1;
    until (((RCount=7) and (RawSamplingData[0]=255)) or (iLimit>maxLimit));

    AllExtension[iExtension].Adjusting:=False;

    if FirstSamplingCount<StateInfo.MaxExtensionCount then
    begin
      FirstSamplingCount:=FirstSamplingCount+1;
      if FirstSamplingCount=StateInfo.MaxExtensionCount then
        frmSendCommand.FirstSamplingEnd:=True;
    end;

    if (RCount=7) and (RawSamplingData[0]=255) then
    begin
//      ReceiveCount:=ReceiveCount+1;
      With LDataPacket do
      begin
        State:=RawSamplingData[2];
        bTemp:=RawSamplingData[3] and bHigh4;
        bTemp:=bTemp Shr 4;
        Char1:=IntToStr(bTemp);
        bTemp:=RawSamplingData[3] and bLow4;
        Char2:=IntToStr(bTemp);
        bTemp:=RawSamplingData[4] and bHigh4;
        bTemp:=bTemp Shr 4;
        Char3:=IntToStr(bTemp);
        bTemp:=RawSamplingData[4] and bLow4;
        Char4:=IntToStr(bTemp);
        Char1:=Trim(Char1)+Trim(Char2)+'.'+Trim(Char3)+Trim(Char4);
        try
          Gravity:=StrToFloat(Char1);
        except
          Gravity:=0;
        end;
        {bTemp:=RawSamplingData[5] and bHigh4;
        bTemp:=bTemp Shr 4;
        Char1:=IntToStr(bTemp);
        bTemp:=RawSamplingData[5] and bLow4;
        Char2:=IntToStr(bTemp);
        Char1:=Trim(Char1)+Trim(Char2);
        try
          HeightDiff:=StrToInt(Char1);
        except
          HeightDiff:=0;
        end;}
        if RawSamplingData[6]>15 then HeightDiff:=RawSamplingData[6]-15
        else HeightDiff:=RawSamplingData[5]+RawSamplingData[6]*256;
        LDataPacket.HeightDiff:=LDataPacket.HeightDiff*0.067;
      end;
      With AllExtension[iExtension] do
      begin
        Gravity:=LDataPacket.Gravity;
        case StateInfo.HeightAcc of
        0:
          Height:=Height+LDataPacket.HeightDiff;
        1:
          Height:=Height-LDataPacket.HeightDiff;
        end;
        if not FirstComm then
        begin
          if (Flag=$FF) and (LDataPacket.State<>$FF) then FirstComm:=True;
        end;
        Flag:=LDataPacket.State;
        CommErr:=False;
        //frmSendCommand.LabelCommErr.Visible:=False;
      end;
      CalcAverage();
    end
    else
    begin
      With AllExtension[iExtension] do
      begin
        Gravity:=0;
        //Height:=0;
        if Not CommErr then
        begin
          CommErr:=True;
          DisplayInfo('分机'+AllExtension[iExtension].ExtensionID+'不在位','1');
        end;
        frmSendCommand.DisplayNo(AllExtension[iExtension].ExtensionID,False);
        //frmSendCommand.LabelCommErr.Caption:='通讯故障';
        //frmSendCommand.LabelCommErr.Visible:=True;
      end;
    end;
    iExtension := iExtension + 1;
    if iExtension=MaxExtensionCount then
      iExtension:=0;
    While AllExtension[iExtension].ExtensionID='' do
    begin
      iExtension := iExtension + 1;
      if iExtension=MaxExtensionCount then
        iExtension:=0;
    end;
  end;
end;

end.