virloop.pas

these are some texts and original program,they are very useful for transportation reserch.

unit VirLoop;

interface

uses
  SysUtils, Classes,Math,Types,Dialogs,Windows;

const
  //固定参数区
  IMGWIDTH=768;
  IMGHEIGHT=288;
  WBLOCKSIZE=4;
  HBLOCKSIZE=2;
  BLKWIDTH=IMGWIDTH div WBLOCKSIZE;
  BLKHEIGHT=IMGHEIGHT div HBLOCKSIZE;

    //背景提取相关的参数
  BGFRAMENUM=40; //采集计数，4分钟后更新出背景，以后每秒更新
  BGFRAMERATE=150;//每隔150帧采集一帧，即每隔6秒采一帧

  TRACELENGTH=1500;//轨迹长度1500帧，1分钟，超过后动态向后分配


  type
  TMoveObject = record //差分出来的当前帧的对象
    ll:integer;//左边位置
    rr:integer;//右边位置
    ii_b:integer;//底边位置
    ii_t:integer;//顶边位置
  end;

  type
  PCarObject = ^TCarObject;
  TCarObject = record
    ObjectRecord:array of TMoveObject;//记录车辆对象在每一帧的位置
    FrameNum:integer;//车辆通过线圈区域的帧数
    vi:integer;//纵向速度
    vj:integer;//横向速度
    match:integer;//记录匹配成功次数
    unmatch:integer;//记录匹配失败次数
    Capflg:boolean;//是否已经存图
    CapBeginFrame:integer;//记录抓拍时的起始帧数
  end;

type
  TVLoop = class
  public
    constructor Create(id:integer);
    function VLD(var image:array of Byte;lp_lft,lp_lft_b,lp_rt,lp_rt_b,lp_tp,lp_btm,cpt:integer;mode:integer;shadow,noise,contrast:boolean;
                  THRESHOLD, PROJECTMAX, REREGIONWIDTH, REGIONDISTANCE, JUMPTHR, AREAPERCENT, EDGESCALE,
                  RESERVENUM, MATCHSUCCESS, BTMSTABLE, shadowL, Tfncc, BRIGHTDIFF, ADDTHR, CAPFRAMENUM,NOISENUM:real):byte;
  {//主要的灵敏度参数区
  THRESHOLD=30;//1二值化阈值
  PROJECTMAX=0.4;//2每一行的几分之一宽度（region投影的最大宽度必须大于该值，则认为该区域有车）
  REREGIONWIDTH=0.5;//3再次准确确定对象位置时，底边的宽度必须大于宽度的百分比，去除单个人引起的干扰。
  REGIONDISTANCE=0.2;//4两个区域之间的距离小于该值，将两个区域进行合并
  JUMPTHR=0.2;//5中点跳变的范围不应该大于高度乘以该值，若大于该值在不完全匹配时将capflg置为false,从而能够挽救连漏车的情况
  AREAPERCENT=0.7;//6交集占区域面积的百分比
  EDGESCALE=0.125;//7边界区域占整个区域的比例
  RESERVENUM=25*0.2;//8允许车辆在线圈内停留（消失）的时间
  MATCHSUCCESS=25*0.4;//9匹配成功的次数大于该值，认为已经准确跟踪了一辆车
  BTMSTABLE=0.1;//10底边稳定限制

  //去阴影的参数
  shadowL=5;//11去阴影时搜索窗口的半宽度
  Tfncc=0.95;//12相似度
  BRIGHTDIFF=90;//13前景和背景的亮度差必须小于该值，才认为是阴影}

    procedure Region();//根据投影划分区域
    procedure RegionMerge();//对距离很近的区域进行合并
    procedure RegionFilter();//根据宽度对区域进行滤波
    procedure RegionPlace();//在区域内进行水平投影，从而确定物体的位置
    procedure Trace();//目标跟踪
    function  IsMatch(listindex:integer;objectindex:integer):boolean;//根据两个矩形的交集面积分别占两个矩形面积的百分比判断两个矩形是否匹配
    function  IstotalMatch(listindex:integer;objectindex:integer):boolean;//根据两个矩形的交集面积分别占两个矩形面积的百分比判断两个矩形是否匹配
    function  IsEdge(listindex:integer):integer;//检查对象是否在线圈的边缘，处于哪个边缘
    procedure ReRegion();//再次通过投影确定区域

    procedure merge(var listindexarray:array of integer;objectindex:integer);//合并

    function  divide(listindex:integer;var objectindexarray:array of integer):TList;//分裂

    function  add(objectindex:integer):PCarObject;
    procedure remove(listindex:integer);//删除或保留
    procedure bijection(listindex:integer;objectindex:integer);//匹配

    procedure arraydelete(var a:array of integer;index:integer);

    function linear(pointarray:array of TPoint;var a:real; var b:real):real;//线性拟和

    function Getthreshold():integer;//动态计算二值化阈值

    procedure background();//背景提取
    procedure clearbk();//背景清零，重新开始采集
    procedure SelectMiddle(var a:array of byte);
    procedure showbg();//显示背景
    procedure dichotomy();//固定阈值的二值化
    procedure showdiff(mode:integer);//显示差分结果
    procedure showproject(mode:integer);//显示投影结果
    procedure RemoveShadow();//去阴影
    procedure RemoveNoise();
  public
    //线圈位置
    m_top_p,m_btm_p,m_cpt_p:integer;
    m_top,m_btm,m_cpt:integer;
    m_la_p,m_ra_p:array [0..IMGHEIGHT-1] of Integer;//虚拟线圈区域在每一行的左边界和右边界
    m_la,m_ra:array [0..IMGHEIGHT-1] of Integer;//按照块划分的区域 left adge by block

    m_grayblk:array [0..BLKHEIGHT-1,0..BLKWIDTH-1] of byte; //存储基于块的灰度图像
    m_bgblkNow:array [0..BLKHEIGHT-1,0..BLKWIDTH-1] of byte;//提取出的当前背景

    //最终分割的对象及数量
    m_objectarray:array [0..IMGHEIGHT div 2-1] of TMoveObject;
    m_objectnum:integer;

    m_CarList:TList;//车辆跟踪的目标链

    m_brunflg:boolean; //第一次背景学习是否结束，可以开始检测
    m_Thr:integer;//二值化阈值
  private
    m_img:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte; //存储前后两张全景中虚拟线圈区域中各像素点的平均亮度，最多允许8路同时检测
    m_img1:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte; //存储上一帧灰度图像
    m_diffgray:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte; //前景和背景差分的灰度图
    m_diff:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte; //前景和背景差分二值化后

    m_bgcount:integer;//用于统计的背景帧计数
    m_bgFrameCount:integer;//抽帧采集，1s抽取一帧
    m_bgblklist:array [0..BGFRAMENUM-1,0..BLKHEIGHT-1,0..BLKWIDTH-1] of byte;//用于背景提取的背景帧序列
    m_gray:array [0..255] of integer;

    m_projectleft,m_projectright:array [0..IMGHEIGHT-1] of integer; //投影
    m_regionstart,m_regionend,m_regionstart1,m_regionend1:array [0..IMGHEIGHT div 2 -1] of Integer;//区域划分的起点和终点
    m_regionnum,m_regionnum1:integer;//划分的区域个数

    //主要的灵敏度参数区
    m_THRESHOLD:integer;    //30 1二值化阈值
    m_PROJECTMAX:real;      //0.4 2每一行的几分之一宽度（region投影的最大宽度必须大于该值，则认为该区域有车）
    m_REREGIONWIDTH:real;   //0.5 3再次准确确定对象位置时，底边的宽度必须大于宽度的百分比，去除单个人引起的干扰。
    m_REGIONDISTANCE:real;  //0.2 4两个区域之间的距离小于该值，将两个区域进行合并
    m_JUMPTHR:real;         //0.2 5中点跳变的范围不应该大于高度乘以该值，若大于该值在不完全匹配时将capflg置为false,从而能够挽救连漏车的情况
    m_AREAPERCENT:real;     //0.7 6交集占区域面积的百分比
    m_EDGESCALE:real;       //0.125 7边界区域占整个区域的比例
    m_RESERVENUM:integer;   //25*0.2 8允许车辆在线圈内停留（消失）的时间
    m_MATCHSUCCESS:integer; //25*0.4 9匹配成功的次数大于该值，认为已经准确跟踪了一辆车
    m_BTMSTABLE:real;       //0.1 10底边稳定限制
    m_shadowL:integer;      //5 11去阴影时搜索窗口的半宽度
    m_Tfncc:real;           //0.95 12相似度
    m_BRIGHTDIFF:integer;   //90 13前景和背景的亮度差必须小于该值，才认为是阴影
    m_ADDTHR:real;          //0.1-1,新增对象的条件,为1时只要底边小于抓拍线的都可以添加,不易漏车,但是很容易有行人干扰
    m_CAPFRAMENUM:integer;  //2、3 ,抓拍时车辆在虚拟线圈内的帧数必须大于该值才能抓拍，避免行人等干扰引起的跳变
    m_NOISENUM:integer;     //4 （范围为0-8）在去噪时，该点周围3*3的领域内（共8个点）其中为255的点如果小于该值，则本点为噪点，被去掉
  end;

var
  g_image:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte; //用于显示差分后的原始图像
  g_imagebg:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;//用于显示背景图像

  g_imageTwo:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;//用于显示投影的图像


  g_SavePath:string = 'd:\datafile\';
  g_BgBright:integer;
  g_count:integer=0;
implementation
uses
  MainForm;

constructor TVLoop.Create(id:integer);
begin
  m_CarList:=TList.Create;

  m_brunflg:=false;

  m_bgcount:=0;
  m_bgFrameCount:=0;

  m_objectnum:=0;
end;


function TVLoop.Getthreshold():integer;
var
  i,j,k,k1:integer;
  ll,rr,maxcount,maxgray,mincount,mingray,ThrCount:integer;
begin
  //建立直方图
  fillchar(m_gray, sizeof(m_gray),0);
  for i:= m_top to m_btm do
  begin
    ll:=m_la[i];
    rr:=m_ra[i];
    for j:= ll to rr do
    begin
      inc(m_gray[m_diff[i,j]]);
    end;
  end;

  //查找峰值
  maxcount:=0;
  maxgray:=0;
  for k:=0 to 255 do
  begin
    if m_gray[k] > maxcount then
    begin
      maxcount:=m_gray[k];
      maxgray:=k;
    end;
  end;

  //查找谷值
  mincount:=maxcount;
  mingray:=maxgray;
  for k:=255 downto maxgray do
  begin
    if m_gray[k]>0 then
    begin
      mincount := m_gray[k];
      mingray := k;
      break;
    end;
  end;

  ThrCount:=mincount+(maxcount-mincount)div 20;
  
  k1:=0;
  for k:=mingray downto maxgray do
  begin
    if (m_gray[k-1] > ThrCount) and (m_gray[k] <= ThrCount) then
    begin
      k1:=k;
      break;
    end;

  end;
  Result:=max(m_THRESHOLD,k1);
end;

procedure TVLoop.SelectMiddle(var a:array of byte);
var
  i,j,t:integer;
begin
  for i:=Low(a) to High(a)-1 do
    for j:=High(a) downto Low(a) do
      if a[i]>a[j] then
      begin
        t:=a[i];
        a[i]:=a[j];
        a[j]:=t;
      end;
end;

procedure TVLoop.clearbk();
begin
  m_bgcount:=0;
  m_bgFrameCount:=0;
  m_brunflg:=false;
  m_CarList.Clear;
end;

procedure TVLoop.background();//背景提取的新算法，取每点在一段时间内的灰度中值
var
  i,j,k,ll,rr,BgBright,n:integer;
  bgblklist:array [0..BGFRAMENUM-1] of byte;
begin
  //背景预测，根据BGFRAMERATE进行抽帧
  inc(m_bgFrameCount);
  if m_bgFrameCount=BGFRAMERATE then //抽帧进行统计
  begin
    m_bgFrameCount:=0;

    for i:=m_top to m_btm do
    begin
      ll:=m_la[i];
      rr:=m_ra[i];
      for j:=ll to rr do
      begin
        m_bgblklist[m_bgcount mod BGFRAMENUM,i,j]:=m_grayblk[i,j];
      end;
    end;
    
    inc(m_bgcount);
    if m_bgcount>=BGFRAMENUM then
    begin
      for i:=m_top to m_btm do
      begin
        ll:=m_la[i];
        rr:=m_ra[i];
        for j:=ll to rr do
        begin
          for k:=0 to BGFRAMENUM-1 do
          begin
            bgblklist[k]:=m_bgblklist[((m_bgcount+k) mod BGFRAMENUM),i,j];
          end;

          SelectMiddle(bgblklist);
          m_bgblkNow[i,j]:=bgblklist[BGFRAMENUM div 2];
        end;
      end;

      if m_brunflg=false then m_brunflg:=true;//初始化背景预测完成，可以开始车辆检测

      //显示背景
      showbg();
    end;
  end;

  //计算背景平均亮度
  BgBright:=0;
  n:=0;
  for i:=m_top to m_btm do
  begin
    ll:=m_la[i];
    rr:=m_ra[i];
    for j:=ll to rr do
    begin
      BgBright:=BgBright+m_bgblkNow[i,j];
      inc(n);
    end;
  end;
  BgBright:=BgBright div n;
  g_BgBright:= BgBright;
end;

procedure TVLoop.showbg();
var
  i,j,ki,kj,ll,rr:integer;
  showgrayimg:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte;
begin
  //用于在窗口中显示背景
  for i:=m_top to m_btm do
  begin
    ll:=m_la[i];
    rr:=m_ra[i];
    for j:=ll to rr do
    begin
      for ki:=i*HBLOCKSIZE to i*HBLOCKSIZE+HBLOCKSIZE-1 do
      for kj:=j*WBLOCKSIZE to j*WBLOCKSIZE+WBLOCKSIZE-1 do
        showgrayimg[ki,kj]:=m_bgblkNow[i,j];
    end;
  end;

  for i:=m_top_p to m_btm_p do
  begin
    ll:=m_la_p[i];
    rr:=m_ra_p[i];

    for j:=ll to rr do
    begin
      g_imagebg[(i*IMGWIDTH+j)*3]:=showgrayimg[i,j];
      g_imagebg[(i*IMGWIDTH+j)*3+1]:=showgrayimg[i,j];
      g_imagebg[(i*IMGWIDTH+j)*3+2]:=showgrayimg[i,j];
    end;
  end;
end;


procedure TVLoop.showdiff(mode:integer);
var
  i,j,ki,kj,ll,rr:integer;
  showgrayimg:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte;
begin
  if mode=0 then
  begin
    for i:=m_top to m_btm do
    begin
      ll:=m_la[i];
      rr:=m_ra[i];
      for j:=ll to rr do
      begin
        for ki:=i*HBLOCKSIZE to i*HBLOCKSIZE+HBLOCKSIZE-1 do
        for kj:=j*WBLOCKSIZE to j*WBLOCKSIZE+WBLOCKSIZE-1 do