sendcommand.pas

这是一个正式的项目工程

unit SendCommand;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, Grids, ImgList, ExtCtrls, ActnList, CPortCtl,
  CPort,wsTypes,wsCores, CheckLst, Db, DBTables, Mask, Gauges,GaugeP,Sampling,  SyncObjs,
  Spin;


const
  WM_ThreadDoneMsg = WM_User + 100;
  PrepareOverflow = 6;
  DownloadOverflow = 6;

type
  TfrmSendCommand = class(TForm)
    PanelSecond: TPanel;
    Panel1: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    BitBtnSendCommand: TBitBtn;
    BitBtnGravity: TBitBtn;
    ImageListTreeView: TImageList;
    ActionListPRestrict: TActionList;
    ActionSetup: TAction;
    ActionSendCommand: TAction;
    ActionReverse: TAction;
    PanelFirst: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    BitBtnOK: TBitBtn;
    ActionOK: TAction;
    LabelProject: TLabel;
    LabelHourse: TLabel;
    ListBoxProject: TListBox;
    ListBoxHourse: TListBox;
    Label9: TLabel;
    Label10: TLabel;
    LabelCurrentProject: TLabel;
    LabelCurrentHourse: TLabel;
    Panel6: TPanel;
    TreeViewSelect: TTreeView;
    Splitter1: TSplitter;
    PanelMedium: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    ListBoxSelect: TListBox;
    Splitter2: TSplitter;
    Panel9: TPanel;
    BitBtnRight: TBitBtn;
    BitBtnDownLoad: TBitBtn;
    ActionDownLoad: TAction;
    BitBtnComPort: TBitBtn;
    ActionStop: TAction;
    RadioGroupSelect: TRadioGroup;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    ActionClearAll: TAction;
    ActionClearSelect: TAction;
    ActionRight: TAction;
    PanelProgress: TPanel;
    LabelProgress: TLabel;
    GaugeProgress: TGauge;
    TimerAutoCountrol: TTimer;
    ComDataPacket1: TComDataPacket;
    ComPort: TComPort;
    Panel11: TPanel;
    RadioGroupOperation: TRadioGroup;
    LabelHeight: TLabel;
    SpinEditHeight: TSpinEdit;
    Label11: TLabel;
    Splitter3: TSplitter;
    Panel10: TPanel;
    MemoStatus: TMemo;
    Panel12: TPanel;
    Panel13: TPanel;
    SpeedButton1: TSpeedButton;
    Panel14: TPanel;
    CheckBoxIQ: TCheckBox;
    RadioButtonHeight: TRadioButton;
    RadioButtonGravity: TRadioButton;
    Panel15: TPanel;
    LabelCommErr: TLabel;
    ComLed5: TComLed;
    ComLed6: TComLed;
    ComLed1: TComLed;
    labelOpen: TLabel;
    Label6: TLabel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
//    procedure ActionReverseExecute(Sender: TObject);
    procedure ActionSetupExecute(Sender: TObject);
    procedure ActionOKExecute(Sender: TObject);
    procedure ListBoxProjectClick(Sender: TObject);
    procedure ListBoxHourseClick(Sender: TObject);
    procedure ActionListPRestrictUpdate(Action: TBasicAction;
              var Handled: Boolean);
    procedure ActionDownLoadExecute(Sender: TObject);
    procedure ActionSendCommandExecute(Sender: TObject);
    procedure ActionClearAllExecute(Sender: TObject);
    procedure ActionClearSelectExecute(Sender: TObject);
    procedure ActionRightExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ActionStopExecute(Sender: TObject);
    procedure MaskEditHeightChange(Sender: TObject);
    procedure RadioGroupOperationClick(Sender: TObject);
//    procedure TimerSampleTimer(Sender: TObject);
    procedure TimerAutoCountrolTimer(Sender: TObject);
    procedure ComPortAfterClose(Sender: TObject);
    procedure ComPortAfterOpen(Sender: TObject);
    procedure TreeViewSelectChange(Sender: TObject; Node: TTreeNode);
    procedure CheckBoxIQClick(Sender: TObject);
    Procedure DisplayInfo(StatusInfo:String;StatusID:String);
    Procedure DisplayNo(strExtensionID:String;iFlag:Boolean);
    procedure SpeedButton1Click(Sender: TObject);
  private
    procedure ThreadDone(var AMessage : TMessage); message WM_ThreadDoneMsg; // Message to be sent back from thread when its done
    Procedure SendACommand(RawCommand:TRawCommand);
    Function  AppendExtension(Extension:String):Boolean;
    Function  IsExtensionExist(ExtensionID:String):Boolean;
    Procedure InItializeCheck();
    Function  ReadBuffer():TRawDataPacket;
    Procedure SendStopCommand();
//    Procedure SendReverseCommand(StrCommand:String);   //发送反转命令
    Procedure SendDownLoadCommand(StrExtensionID:String);
    Procedure SendAdjustCommand(StrExtensionID:String); //发送上升调节命令
//    Procedure SendDAdjustCommand(StrExtensionID:String); //发送下降调节命令
    Function  GetCondition1():Boolean;
    Function  GetCondition2():Boolean;
    Procedure SetStateInfo(i:Integer);
    procedure StartProgress(i:Integer);
    procedure StopProgress();
    procedure SetProgress(i:Integer);
    Function  GetSystemFlag():String;
    Function  GetState(iState:TSystemState):String;
    procedure StartSampling(i:Integer);
    procedure StopSampling();
    procedure PauseSampling();
    procedure ResumeSampling();
    Procedure InitializeFlag();
    Function  GetCurrentExtensionID():Byte;
    Function  MustStop(iExtension:Byte):Boolean;
    Function  MustAdjust(iExtension:Byte):Boolean;
    Function  DMustStop(iExtension:Byte):Boolean;
    Function  DMustAdjust(iExtension:Byte):Boolean;
    function  ExtensionPrepareFinish(ExtensionGroup:TCurrentOperationExtension):Boolean;
    function  ExtensionDownloadFinish(ExtensionGroup:TCurrentOperationExtension):Boolean;
    function  ExtensionNotFinish(ExtensionGroup:TCurrentOperationExtension):string;
    function  IsExtensionReset(ExtensionGroup:TCurrentOperationExtension):Boolean;
    procedure ErrorAnalysis(Status:TSystemState);

  public
    IsQuery      :Boolean;
    ProjectInfo  :TProject;
    Events: TComEvents;
    SaveInterval :Integer;
    HHeight      :Integer;
    StartHeight  :Integer;
    Event        :TEvent;
    SamplingThreadActive : boolean;
    FirstSamplingEnd:Boolean;
    GaugeThread : TGaugeThread;
    GaugeThreadActive : boolean;
    SamplingThread  :TSamplingThread;
    CurrentExtensionID :Byte;
    Procedure SaveData();
    procedure DisplayState(i:Integer);
    function CtrlHandler(CtrlType: LongWord): Boolean;
  Protected
    Function  NameToID(strName:String):String;
  end;

var
  frmSendCommand: TfrmSendCommand;
  MHeight     :Integer;
  ThreadHeight:Integer;
  CountPrepare:Integer;
  CountDownload:Integer;

implementation

uses MainDB, StandardGravity;

{$R *.DFM}
function TfrmSendCommand.CtrlHandler(CtrlType: LongWord): Boolean;
begin
  Event.SetEvent;
  Result := True;
end;

procedure TfrmSendCommand.ThreadDone(var AMessage: TMessage); // keep track of when and which thread is done executing
begin
  if ((GaugeThread <> nil) and (GaugeThread.ThreadID = cardinal(AMessage.WParam))) then
  begin
    GaugeThreadActive := False;
  end;
  if ((SamplingThread <> nil) and (SamplingThread.ThreadID = cardinal(AMessage.WParam))) then
  begin
    SamplingThreadActive := False;
    //test
    SamplingThreadActive :=True;
    if SamplingThreadActive=False then
    begin
      frmSendCommand.LabelCommErr.Visible:=True;
      LabelCommErr.Caption:=frmSendCommand.LabelCommErr.Caption+'ThreadDone';
    end;
    //test
  end;
end;

Procedure TfrmSendCommand.SendAdjustCommand(StrExtensionID:String);
begin
  RawCommand.ExtensionID:=StrExtensionID;
  RawCommand.CommandID:=CommandID[7];
  //RawCommand.Data:='000';
  SendACommand(RawCommand);
end;

{Procedure TfrmSendCommand.SendDAdjustCommand(StrExtensionID:String);
begin
  RawCommand.ExtensionID:=StrExtensionID;
  RawCommand.CommandID:=CommandID[7];
  RawCommand.Data:='000';
  SendACommand(RawCommand);
end;}

Procedure TfrmSendCommand.SendStopCommand();
var i:integer;
begin
  RawCommand.ExtensionID:='170';
  RawCommand.CommandID:=CommandID[9];
  //RawCommand.Data:='000';
  SendACommand(Rawcommand);
  StateInfo.SystemState:=ssNormal;
  for i:=0 to StateInfo.MaxExtensionCount-1 do
  begin
  AllExtension[i].Status:=ssNormal;
  end;
{  for i:=1 to 10 do
  begin
  SendACommand(RawCommand);
  sleep(100);
  end;}
end;

{Procedure TfrmSendCommand.SendReverseCommand(StrExtensionID:String);
begin
  RawCommand.ExtensionID:=StrExtensionID;
  RawCommand.CommandID:=CommandID[10];
  RawCommand.Data:='000';
  SendACommand(RawCommand);
end;}

Procedure TfrmSendCommand.SendDownLoadCommand(StrExtensionID:String);
begin
  RawCommand.ExtensionID:=StrExtensionID;
  RawCommand.CommandID:=CommandID[8];
  RawCommand.Data:='000';
  SendACommand(RawCommand);
  StateInfo.SystemState:=ssDownLoad;
end;

Procedure TfrmSendCommand.InItializeCheck();
var
  i:Integer;
  RawDataPacket  : TRawDataPacket;
begin
try
  StateInfo.SystemState:=ssInitialize;
  StartProgress(StateInfo.CurrentExtensionCount);
  for i:=0 to MaxExtensionCount-1 do
  begin
    if AllExtension[i].GroupID<>'' then
    begin
      RawCommand.ExtensionID:=AllExtension[i].ExtensionID;
      RawCommand.CommandID:=CommandID[0];
      RawCommand.Data:=FloatToStr(StandardG[StrToInt(RawCommand.ExtensionID)].Value);
      //RawCommand.Data:=StringOfChar('0',3-Length(Trim(RawCommand.Data)))+Trim(RawCommand.Data);
      SetProgress(i);
      SendACommand(RawCommand);
      RawDataPacket:=ReadBuffer();
      if RawDataPacket.Byte1=0 then
      begin
        RawDataPacket.Byte2:=StrToInt(AllExtension[i].ExtensionID);
        DisplayNo(FormExtensionID(RawDataPacket.Byte2),False);
        DisplayInfo('分机'+AllExtension[i].ExtensionID+'不在位','1');
      end
      else
      begin
        DisplayNo(FormExtensionID(RawDataPacket.Byte2),True);
      end;
    end;
  end;
  SetProgress(StateInfo.MaxValue);
finally
  StopProgress();
  StateInfo.SystemState:=ssNormal;
end;
end;

Function TfrmSendCommand.ReadBuffer():TRawDataPacket;
var
  RawDataPacket : TRawDataPacket;
  ReceiveData   : Array[0..5] of Byte;
  i:Integer;
begin
  for i:=0 to 5 do
  begin
    ReceiveData[i]:=0;
  end;
  Events := [evRxChar];
  ComPort.WaitForEvent(Events, Event.Handle, 100);
  i:=0;
  i:=ComPort.Read(ReceiveData,6);
  if (i=6) and (ReceiveData[0]=255) then
  begin
    With RawDataPacket do
    begin
      RawDataPacket.Byte1:=ReceiveData[0];
      RawDataPacket.Byte2:=ReceiveData[1];
      RawDataPacket.Byte3:=ReceiveData[2];
      RawDataPacket.Byte4:=ReceiveData[3];
      RawDataPacket.Byte5:=ReceiveData[4];
      RawDataPacket.Byte6:=ReceiveData[5];
    end;
  end
  else
  begin
    RawDataPacket.Byte1:=0;
  end;
  Result:=RawDataPacket;
end;

Procedure TfrmSendCommand.DisplayNo(strExtensionID:String;iFlag:Boolean);
var
  SelectedNode,SecondLayer,ThirdLayer :TTreeNode;
begin
  SelectedNode:=TreeViewSelect.Items.GetFirstNode;
  SecondLayer:=SelectedNode.getFirstChild;
  While SecondLayer<>nil do
  begin
    ThirdLayer:=SecondLayer.getFirstChild;
    while ThirdLayer<>nil do
    begin
      if (GetID(ThirdLayer.Text)=strExtensionID) then
      begin
        if iFlag then
          ThirdLayer.ImageIndex:=3
        else
          ThirdLayer.ImageIndex:=4;
        Exit;
      end;
      ThirdLayer:=ThirdLayer.getNextSibling;
    end;
    SecondLayer:=SecondLayer.getNextSibling;
  end;
end;

Procedure TfrmSendCommand.SaveData();
var
  i       :Integer;
  DDate   :TDateTime;
  bFirst  :Boolean;

begin
  DDate:=Now();
  bFirst:=True;
  dmMainDB.MainDB.TransIsolation:=tiDirtyRead;
  try
  dmMainDB.MainDB.StartTransaction;
  try
  for i:=0 to MaxExtensionCount-1 do
  begin
    if (AllExtension[i].ExtensionID<>'') and (AllExtension[i].GroupID<>'')  then
    begin
     With  dmMainDB.tbOriginData do
     begin
       Append;
       FieldbyName('DDate').asDateTime:=DDate;
       FieldbyName('HourseID').asString:=ProjectInfo.HourseID;
       FieldbyName('ExtensionID').asString:=AllExtension[i].ExtensionID;
       FieldbyName('Gravity').asFloat:=AllExtension[i].Gravity;
       FieldbyName('Height').asFloat:=AllExtension[i].Height;
       FieldbyName('HorizonDiff').asFloat:=AllExtension[i].HorizonDiff;
       FieldbyName('StandardG').asFloat:=StandardG[i].Value;
       FieldbyName('AverageG').asFloat:=AllGroup[StrToInt(AllExtension[i].GroupID)].AverageG;
       FieldbyName('AverageH').asFloat:=AllGroup[StrToInt(AllExtension[i].GroupID)].AverageH;
       FieldbyName('State').asString:=GetState(AllExtension[i].Status);
       if bFirst then
       begin
         FieldbyName('Flag').asString:='S';
         bFirst:=False;
       end
       else
       begin
         FieldbyName('Flag').asString:='M';
       end;
       Post;
     end;
    end;
  end;
  dmMainDB.tbOriginData.ApplyUpdates;
  dmMainDB.MainDB.Commit;
  dmMainDB.tbOriginData.CommitUpdates;
  except
    dmMainDB.tbOriginData.CancelUpdates;
    dmMainDB.MainDB.Rollback;
  end;
  finally
    dmMainDB.MainDB.TransIsolation:=tiReadCommitted;
  end;
end;

Function TfrmSendCommand.AppendExtension(Extension:String):Boolean;
begin
  Result:=IsExtensionExist(GetID(Extension));
  if not Result then
  begin
    With ListBoxSelect do
    begin
      Items.BeginUpdate;
      Items.Append(Extension);