infinovamatrix.pas

AD矩阵控制协议封装的Delphi代码。用于控制AD矩阵矩阵RS232控制。包括云台转动及切换。

unit InfinovaMatrix;
{
 英飞拓矩阵控制协议.
}
interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, CPort;
const
  EndTransChar  = 'a';
  CommOverTime   = 5000;   //5秒
type
  TCommandKind = (CmUnknow,CmInMenu,CmOutMenu,CmSwMonitor,CmSwCamera);
  TControlEvent = procedure(Sender: TObject; InfoMsg:string) of object;
  TInfMatrixControl = class(Tcomponent)
  private
    FDeviceID:string;
    FDeviceName:string;
    FCommPort:string;
    FBaudRate:Dword;
    FComPort:TComPort;
    FMonitorID:integer;
    FCameraID:integer;
    FOnControlMsg:TControlEvent;
    FCurrentCmd:TCommandKind;
    FPTZSpeed:integer;
    procedure SetCommPort(Value: string);
    procedure SetBaudRate(Value: Dword);
  protected
    FReceiveLen:integer;
    FSendBuf:array[0..255] of char;
    FReceiveBuf:array[0..511] of char;
    procedure CommReceiveData(Sender: TObject; Count: Integer);    
    function SendCommData(SendBuffer:array of char; const SendLength:Integer):Boolean;
  public
    function LoginMenu:Boolean;
    function LogOutMenu:Boolean;
    function SwitchMonitor:Boolean;
    function SwitchCamera:Boolean;
    procedure SwitchMonitorAndCamera;
    procedure MoveDown;
    procedure MoveUp;
    procedure MoveLeft;
    procedure MoveRight;
    procedure IrisOpen;             //光圈打开
    procedure IrisClose;            //光圈关闭
    procedure FocusFar;             //远焦控制
    procedure FocusNear;            //近焦控制
    procedure ZoomWide;             //视角变宽
    procedure ZoomTele;             //视角变窄
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    function ControlStart: boolean; //开始控制
    procedure ControlEnd;           //结束控制
    //--辅助控制命令
  published
    property MonitorID:integer read FMonitorID write FMonitorID;
    property CameraID:integer read FCameraID write FCameraID;
    property PTZSpeed:integer read FPTZSpeed write FPTZSpeed;
    property DeviceID:string read FDeviceID write FDeviceID;
    property DeviceName:string read FDeviceName write FDeviceName;
    property ComPort:TComPort read FComPort Write FComPort;
    property CommPort:string read FCommPort write SetCommPort;
    property BaudRate:Dword read FBaudRate write SetBaudRate;
    property CurrentCmd:TCommandKind read FCurrentCmd;
    property OnControlMsg:TControlEvent read FOnControlMsg write FOnControlMsg; 

  end;

procedure Register;

implementation

uses Contnrs;

procedure Register;
begin
  RegisterComponents('GSMonitor', [TInfMatrixControl]);
end;

{ TInfMatrixControl }

procedure TInfMatrixControl.SetCommPort(Value: string);
begin
  if  Value <> FCommPort then
  begin
    FCommPort := Value;
  end;
end;

procedure TInfMatrixControl.SetBaudRate(Value: Dword);
begin
  if  Value <> FBaudRate then
  begin
    FBaudRate := Value;
  end;
end;

procedure TInfMatrixControl.ControlEnd;
begin
  if FComPort.Connected then
    FComPort.Close;
end;

function TInfMatrixControl.ControlStart: boolean;
var tmpResult : Boolean;
begin
  tmpResult := true;
  FComPort.BaudRate := brCustom;
  FComPort.CustomBaudRate := FBaudRate;
  FComPort.Port := FCommPort;
  FComPort.OnRxChar := CommReceiveData;
  try
    if not FComPort.Connected then
    FComPort.Open;
  except
    tmpResult := False;
  end;
  Result := tmpResult;
end;

constructor TInfMatrixControl.Create(AOwner: TComponent);
begin
  inherited Create( AOwner );
  FReceiveLen := 0;
  FBaudRate := 1200;
end;

destructor TInfMatrixControl.Destroy;
begin
  inherited Destroy;
end;

function TInfMatrixControl.SendCommData(SendBuffer:array of char; const SendLength:Integer):Boolean;
begin
  Result := (FComPort.Write(SendBuffer,SendLength)= SendLength);
end;

procedure TInfMatrixControl.CommReceiveData(Sender: TObject; Count: Integer);
var BufferLength:integer;
begin
  //注意缓冲区益处的情况.
  //BufferLength:=ComPort.Read(FReceiveBuf[FReceiveLen],Count);
  //FReceiveLen := FReceiveLen + BufferLength;
end;

function TInfMatrixControl.LoginMenu: Boolean;
var
  StartTime,EndTime:Cardinal;
begin
  //发送.
  Result := False;
  FSendBuf[0]:= '1';
  FSendBuf[1]:= '2';
  FSendBuf[2]:= '9';
  FSendBuf[3]:= 'P';
  FSendBuf[4]:= EndTransChar;
  FCurrentCmd := CmInMenu;
  SendCommData(FSendBuf,5); 
  FReceiveLen := 0;
  StartTime := GetTickCount;
  EndTime := GetTickCount;
  repeat
    if FReceiveLen>80  then  //收到结束侦标记后进行处理
    begin
      FReceiveLen := 0;
      if (1=1) then          //接收到的结果正确.
        Result := True
      else
      begin
        if Assigned(FOnControlMsg) then
          FOnControlMsg(self,'进入菜单,接收数据格式错误!');
      end;
      Break;
    end;
    Sleep(10);
    Application.ProcessMessages;
    EndTime := GetTickCount;
  until (EndTime-StartTime>CommOverTime);
  if FReceiveLen<=80 then
  begin
    if Assigned(FOnControlMsg) then
      FOnControlMsg(self,'进入菜单,通信超时!');
  end;
end;

function TInfMatrixControl.LogOutMenu: Boolean;
var
  StartTime,EndTime:Cardinal;
begin
  //发送.
  Result := False;
  FSendBuf[0]:= '1';
  FSendBuf[1]:= '3';
  FSendBuf[2]:= '0';
  FSendBuf[3]:= 'P';
  FSendBuf[4]:= EndTransChar;
  FCurrentCmd := CmOutMenu;
  SendCommData(FSendBuf,5); 
  FReceiveLen := 0;
  StartTime := GetTickCount;
  EndTime := GetTickCount;
  repeat
    if FReceiveLen>80  then  //收到结束侦标记后进行处理
    begin
      FReceiveLen := 0;
      if (1=1) then     //接收到的结果正确.
        Result := True
      else
      begin
        if Assigned(FOnControlMsg) then
          FOnControlMsg(self,'离开菜单,接收数据格式错误!');
      end;
      Break;
    end;
    Sleep(10);
    Application.ProcessMessages;
    EndTime := GetTickCount;
  until (EndTime-StartTime>CommOverTime);
  if FReceiveLen<=80 then
  begin
    if Assigned(FOnControlMsg) then
      FOnControlMsg(self,'离开菜单，通信超时!');
  end;
end;

function TInfMatrixControl.SwitchMonitor: Boolean;
var
  StartTime,EndTime:Cardinal;
  tmpCmd:string;
begin
  //发送.
  Result := False;
  tmpCmd := IntTostr(FMonitorID)+'Ma';
  StrPCopy(FSendBuf, tmpCmd);
  FCurrentCmd := CmSwMonitor;
  SendCommData(FSendBuf,length(tmpCmd));
  FReceiveLen := 0;
  StartTime := GetTickCount;
  EndTime := GetTickCount;
  repeat
    if FReceiveLen>80  then  //收到结束侦标记后进行处理
    begin
      FReceiveLen := 0;
      if (1=1) then          //接收到的结果正确.
        Result := True
      else
      begin
        if Assigned(FOnControlMsg) then
          FOnControlMsg(self,'切换监视器,接收数据格式错误!');
      end;
      Break;
    end;
    Sleep(10);
    Application.ProcessMessages;
    EndTime := GetTickCount;
  until (EndTime-StartTime>CommOverTime);
  if FReceiveLen<=80 then
  begin
    if Assigned(FOnControlMsg) then
      FOnControlMsg(self,'切换监视器,通信超时!');
  end;
end;


function TInfMatrixControl.SwitchCamera: Boolean;
var
  StartTime,EndTime:Cardinal;
  tmpCmd:string;
begin
  //发送.
  Result := False;
  tmpCmd := IntTostr(FCameraID)+'#a';
  StrPCopy(FSendBuf, tmpCmd);
  FCurrentCmd := CmSwCamera;
  SendCommData(FSendBuf,length(tmpCmd));
  FReceiveLen := 0;
  StartTime := GetTickCount;
  EndTime := GetTickCount;
  repeat
    if FReceiveLen>80  then  //收到结束侦标记后进行处理
    begin
      FReceiveLen := 0;
      if (1=1) then          //接收到的结果正确.
        Result := True
      else
      begin
        if Assigned(FOnControlMsg) then
          FOnControlMsg(self,'切换摄像机,接收数据格式错误!');
      end;
      Break;
    end;
    Sleep(10);
    Application.ProcessMessages;
    EndTime := GetTickCount;
  until (EndTime-StartTime>CommOverTime);
  if FReceiveLen<=80 then
  begin
    if Assigned(FOnControlMsg) then
      FOnControlMsg(self,'切换摄像机,通信超时!');
  end;
end;

procedure TInfMatrixControl.IrisClose;
begin
  FSendBuf[0] := 'O';
  FSendBuf[1] := 'a';
  SendCommData(FSendBuf,2);
end;

procedure TInfMatrixControl.IrisOpen;
begin
  FSendBuf[0] := 'C';
  FSendBuf[1] := 'a';
  SendCommData(FSendBuf,2);
end;

procedure TInfMatrixControl.FocusFar;
begin
  FSendBuf[0] := 'F';
  FSendBuf[1] := 'a';
  SendCommData(FSendBuf,2);
end;

procedure TInfMatrixControl.FocusNear;
begin
  FSendBuf[0] := 'N';
  FSendBuf[1] := 'a';
  SendCommData(FSendBuf,2);
end;

procedure TInfMatrixControl.ZoomTele;
begin
  FSendBuf[0] := 'T';
  FSendBuf[1] := 'a';
  SendCommData(FSendBuf,2);
end;

procedure TInfMatrixControl.ZoomWide;
begin
  FSendBuf[0] := 'W';
  FSendBuf[1] := 'a';
  SendCommData(FSendBuf,2);
end;

procedure TInfMatrixControl.MoveDown;
var
  tmpCmd:string;
begin
  tmpCmd := IntTostr(FPTZSpeed)+'Da';
  StrPCopy(FSendBuf, tmpCmd);
  SendCommData(FSendBuf,length(tmpCmd));
end;

procedure TInfMatrixControl.MoveLeft;
var
  tmpCmd:string;
begin
  tmpCmd := IntTostr(FPTZSpeed)+'La';
  StrPCopy(FSendBuf, tmpCmd);
  SendCommData(FSendBuf,length(tmpCmd));
end;

procedure TInfMatrixControl.MoveRight;
var
  tmpCmd:string;
begin
  tmpCmd := IntTostr(FPTZSpeed)+'Ra';
  StrPCopy(FSendBuf, tmpCmd);
  SendCommData(FSendBuf,length(tmpCmd));
end;

procedure TInfMatrixControl.MoveUp;
var
  tmpCmd:string;
begin
  tmpCmd := IntTostr(FPTZSpeed)+'Ua';
  StrPCopy(FSendBuf, tmpCmd);
  SendCommData(FSendBuf,length(tmpCmd));
end;

procedure TInfMatrixControl.SwitchMonitorAndCamera;
var  tmpCmd:string;
begin
  //发送.
  tmpCmd := IntTostr(FMonitorID)+'Ma'+IntTostr(FCameraID)+'#a';
  StrPCopy(FSendBuf, tmpCmd);
  SendCommData(FSendBuf,length(tmpCmd));
end;

end.