Delphi XE10编写的《海康摄像机SDK测试DEMO》

type
  TShowStr = record
    X: Word;
    Y: Word;
    S: array [0 .. 43] of AnsiChar;
  end;

type
  TCamera = record
    pHWND: HWND;
  strict private
    aCam: LongInt;
    g_nPort: LongInt;
    struDeviceInfo: NET_DVR_DEVICEINFO_V30;
    lRealHandle: LongInt;
    struPlayInfo: NET_DVR_CLIENTINFO;
    pUser: Pointer;
    dwRet: Integer;
  public
    property ErrCode: Integer read dwRet;
    procedure HCLogin(IP, User, Psd: String; Port: Word);
    procedure HCPlay(aHWND: HWND);
    procedure HCAddChar(str: TArray);
    procedure HCAddChar_V30(str: TArray);
    function HCGetJpeg(JpgName: String; JpgSize: Word = 0;
      JpgQua: Word = 19): Boolean;
    procedure HCStop;
    procedure HCLogout;
  end;

{$ENDIF}

implementation

procedure TCamera.HCLogin(IP, User, Psd: String; Port: Word);
begin
  NET_DVR_Init();
  lRealHandle := -1;
  dwRet := 0;
  aCam := NET_DVR_Login_V30(PAnsiChar(ansistring(IP)), Port,
    PAnsiChar(ansistring(User)), PAnsiChar(ansistring(Psd)), @struDeviceInfo);
  dwRet := NET_DVR_GetLastError;
end;

procedure TCamera.HCPlay(aHWND: HWND);
begin
  struPlayInfo.lChannel := 1;
  struPlayInfo.lLinkMode := 0;
  struPlayInfo.sMultiCastIP := NIL;
  struPlayInfo.hPlayWnd := aHWND;
  lRealHandle := NET_DVR_RealPlay_V30(aCam, @struPlayInfo, nil, pUser, true);
  dwRet := NET_DVR_GetLastError;
end;

procedure TCamera.HCAddChar(str: TArray);
var
  i: Integer;
  aStr: NET_DVR_SHOWSTRING;
begin
  if length(str) > MAX_STRINGNUM then
  begin
    setlength(str, MAX_STRINGNUM);
  end;
  for i := 0 to length(str) - 1 do
  begin
    aStr.struStringInfo[i].wShowString := 1;
    aStr.struStringInfo[i].wStringSize := length(str[i].S);
    aStr.struStringInfo[i].wShowStringTopLeftX := str[i].X;
    aStr.struStringInfo[i].wShowStringTopLeftY := str[i].Y;
    move(str[i].S[0], aStr.struStringInfo[i].sString[0], length(str[i].S));
  end;
  aStr.dwSize := sizeof(aStr);
  NET_DVR_SetDVRConfig(aCam, NET_DVR_SET_SHOWSTRING, 1, @aStr,
    sizeof(NET_DVR_SHOWSTRING));
  dwRet := NET_DVR_GetLastError;
end;

procedure TCamera.HCAddChar_V30(str: TArray);
var
  i: Integer;
  aStr: NET_DVR_SHOWSTRING_V30;
begin
  if length(str) > MAX_STRINGNUM_V30 then
  begin
    setlength(str, MAX_STRINGNUM_V30);
  end;
  for i := 0 to length(str) - 1 do
  begin
    aStr.struStringInfo[i].wShowString := 1;
    aStr.struStringInfo[i].wStringSize := length(str[i].S);
    aStr.struStringInfo[i].wShowStringTopLeftX := str[i].X;
    aStr.struStringInfo[i].wShowStringTopLeftY := str[i].Y;
    move(str[i].S[0], aStr.struStringInfo[i].sString[0], length(str[i].S));
  end;
  aStr.dwSize := sizeof(aStr);
  NET_DVR_SetDVRConfig(aCam, NET_DVR_SET_SHOWSTRING_V30, 1, @aStr,
    sizeof(NET_DVR_SET_SHOWSTRING_V30));
  dwRet := NET_DVR_GetLastError;
end;

function TCamera.HCGetJpeg(JpgName: String; JpgSize: Word = 0;
  JpgQua: Word = 19): Boolean;
var
  aJpg: NET_DVR_JPEGPARA;
begin
  aJpg.wPicSize := JpgSize;
  aJpg.wPicQuality := JpgQua;
  if aCam >= 0 then
  begin
    result := NET_DVR_CaptureJPEGPicture(aCam, 1, aJpg,
      PAnsiChar(ansistring(JpgName)));
    dwRet := NET_DVR_GetLastError();
  end
  else
    result := false;
  dwRet := NET_DVR_GetLastError;
end;

procedure TCamera.HCStop;
begin
  if lRealHandle >= 0 then
  begin
    NET_DVR_StopRealPlay(lRealHandle);
    lRealHandle := -1;
  end;
  PlayM4_CloseStream(g_nPort);
  PlayM4_FreePort(g_nPort);
end;

procedure TCamera.HCLogout;
begin
  if lRealHandle > -1 then
  begin
    HCStop;
  end;
  if aCam >= 0 then
  begin
    NET_DVR_Logout_V30(aCam);
    aCam := -1;
  end;
  NET_DVR_Cleanup();
end;