virloop.pas

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

          showgrayimg[ki,kj]:=m_diff[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_image[(i*IMGWIDTH+j)*3]:=showgrayimg[i,j];
        g_image[(i*IMGWIDTH+j)*3+1]:=showgrayimg[i,j];
        g_image[(i*IMGWIDTH+j)*3+2]:=showgrayimg[i,j];
      end;
    end;
  end
  else if mode=1 then
  begin
    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_image[(i*IMGWIDTH+j)*3]:=m_diff[i,j];
        g_image[(i*IMGWIDTH+j)*3+1]:=m_diff[i,j];
        g_image[(i*IMGWIDTH+j)*3+2]:=m_diff[i,j];
      end;
    end;
  end;
end;

procedure TVLoop.dichotomy();//固定阈值二值化
var
  i,j,ll,rr:integer;
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
      if m_diffgray[i,j]>m_Thr then m_diff[i,j]:=255
      else m_diff[i,j]:=0;
    end;
  end;
end;

procedure TVLoop.RemoveNoise();//去噪
var
  i,j,ll,rr:integer;
  diff:array [0..IMGHEIGHT-1,0..IMGWIDTH-1] of byte; //前景和背景差分二值化后
  num:integer;
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
      diff[i,j]:=m_diff[i,j];
    end;
  end;

  for i:=m_top to m_btm do
  begin
    ll:=m_la[i];
    rr:=m_ra[i];
    for j:=ll to rr do
    begin
      if diff[i,j]=255 then
      begin
        num:=0;
        if diff[i-1,j-1]=255 then inc(num);
        if diff[i,j-1]=255 then inc(num);
        if diff[i+1,j-1]=255 then inc(num);
        if diff[i-1,j]=255 then inc(num);
        if diff[i+1,j]=255 then inc(num);
        if diff[i-1,j+1]=255 then inc(num);
        if diff[i,j+1]=255 then inc(num);
        if diff[i+1,j+1]=255 then inc(num);
        if num<m_NOISENUM then m_diff[i,j]:=0;
      end;
    end;
  end;
end;

//virtual loop detect虚拟线圈分析
function TVLoop.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;
var
  ll,rr,i,j,k,ki,kj:integer;
  r,g,b:byte;
  ACarObject:PCarObject;
  centerbegin_i,centerbegin_j,centerend_i,centerend_j:integer;
  tan1,tan2,vi,vj:real;
  blocksum:real;
  start_i,startframe:integer;//在计算车辆方向时在轨迹中向后查找谷值
  analysis:boolean; //标记是否可以进行分析
  oldgray,newgray,thr:byte;
begin
  result:=0;

  //主要的灵敏度参数区
  m_THRESHOLD:=round(THRESHOLD);
  m_PROJECTMAX:=PROJECTMAX;
  m_REREGIONWIDTH:=REREGIONWIDTH;
  m_REGIONDISTANCE:=REGIONDISTANCE;
  m_JUMPTHR:=JUMPTHR;
  m_AREAPERCENT:=AREAPERCENT;
  m_EDGESCALE:=EDGESCALE;
  m_RESERVENUM:=round(RESERVENUM);
  m_MATCHSUCCESS:=round(MATCHSUCCESS);
  m_BTMSTABLE:=BTMSTABLE;
  m_shadowL:=round(shadowL);
  m_Tfncc:=Tfncc;
  m_BRIGHTDIFF:=round(BRIGHTDIFF);
  m_ADDTHR:=ADDTHR;
  m_CAPFRAMENUM:=round(CAPFRAMENUM);
  m_NOISENUM:=round(NOISENUM);

  inc(g_count);//记录帧数
  if g_count=10 then g_count:=0;
  
  m_top_p:=lp_tp;
  m_btm_p:=lp_btm;
  m_cpt_p:=cpt;
  for i:=lp_tp to lp_btm do //线圈位置从上到下
  begin
    //根据斜率算出从上到下每一行的左边界点和右边节点
    m_la_p[i]:=lp_lft+(i-lp_tp)*(lp_lft_b-lp_lft) div (lp_btm-lp_tp);
    m_ra_p[i]:=lp_rt+(i-lp_tp)*(lp_rt_b-lp_rt) div (lp_btm-lp_tp);
    ll:=m_la_p[i];
    rr:=m_ra_p[i];

    for j:=ll to rr do
    begin
      b:=image[(i*IMGWIDTH+j)*3];
      g:=image[(i*IMGWIDTH+j)*3+1];
      r:=image[(i*IMGWIDTH+j)*3+2];

      if (mode=1) and (contrast=true) then //在帧差情况下才做图像增强
      begin
        ///////////////////////////////////////////////////////////////////////////
        //图像赠强算法 07-06-05
        oldgray:=(30*r+59*g+11*b) div 100;//R=G=B=0.30*R+0.59*G+0.11*B 加权平均值法
        if g_BgBright =0 then thr:=128
        else thr:=g_BgBright;

        if oldgray<thr then newgray:=round(oldgray*oldgray/thr)
        else newgray:=255-round((255-oldgray)*(255-oldgray)/(255-thr));
        
        m_img[i,j]:=newgray;
        //////////////////////////////////////////////////////////////////////////
      end
      else
      begin //线圈部分灰度图像
        m_img[i,j]:=(30*r+59*g+11*b) div 100;//R=G=B=0.30*R+0.59*G+0.11*B 加权平均值法
      end;
    end;
  end;

  //按块计算，根据斜率算出从上到下每一行的左边界点和右边节点
  m_top:=m_top_p div HBLOCKSIZE + 1; //加1的原因是保证顶边在线圈范围之内，因为整除使得顶边向上移了一个块
  m_btm:=m_btm_p div HBLOCKSIZE;
  m_cpt:=m_cpt_p div HBLOCKSIZE;
  for i:=m_top to m_btm do
  begin
    m_la[i]:=m_la_p[i*HBLOCKSIZE] div WBLOCKSIZE;
    m_ra[i]:=m_ra_p[i*HBLOCKSIZE] div WBLOCKSIZE;
  end;
  //保存线圈区域内的灰度块值m_grayblk
  for i:=m_top to m_btm do
  begin
    ll:=m_la[i];
    rr:=m_ra[i];
    for j:=ll to rr do
    begin
      blocksum:=0;
      for ki:=i*HBLOCKSIZE to i*HBLOCKSIZE+HBLOCKSIZE-1 do
      for kj:=j*WBLOCKSIZE to j*WBLOCKSIZE+WBLOCKSIZE-1 do
      begin
        blocksum:=blocksum+m_img[ki,kj];
      end;
      blocksum:=blocksum / (HBLOCKSIZE * WBLOCKSIZE);
      m_grayblk[i,j]:=round(blocksum);  //块的灰度值等于块内像素灰度平均
    end;
  end;

  //进行背景提取
  background();

  Analysis:=false;
  if mode=0 then
  begin
    //背景差值法
    if m_brunflg=true 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
          m_diffgray[i,j]:=abs(m_grayblk[i,j]-m_bgblkNow[i,j]);
        end;
      end;
      Analysis:=true;
    end;
  end
  else if mode=1 then
  begin
    m_top:=m_top_p; //加1的原因是保证顶边在线圈范围之内，因为整除使得顶边向上一了一个块
    m_btm:=m_btm_p;
    m_cpt:=m_cpt_p;
    for i:=m_top to m_btm do
    begin
      m_la[i]:=m_la_p[i];
      m_ra[i]:=m_ra_p[i];
    end;
    //帧差法
    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_diffgray[i,j]:=abs(m_img[i,j]-m_img1[i,j]);
        m_img1[i,j]:=m_img[i,j];
      end;
    end;
    Analysis:=true;
  end
  else exit;

  if Analysis=true then
  begin
    //将差分灰度图象进行二值化后显示
    //m_Thr:=GetThreshold(); //可变阈值法
    m_Thr:=m_THRESHOLD; //固定阈值法

    dichotomy();//二值化

    //去噪声
    if (mode=1) and (noise=true) then RemoveNoise();

    //去阴影
    if (mode=0) and (shadow=true) then RemoveShadow();

    showdiff(mode);//显示二值化后的图象

    //向中线投影
    for i:=m_top to m_btm do
    begin
      ll:=m_la[i];
      rr:=m_ra[i];

      m_projectleft[i]:=0;
      m_projectright[i]:=0;
      for j:=ll to (rr+ll)div 2 do
      begin
        if m_diff[i,j]=255 then inc(m_projectleft[i]);
      end;
      for j:=(rr+ll)div 2 to rr do
      begin
        if m_diff[i,j]=255 then inc(m_projectright[i]);
      end;
    end;

    showproject(mode);

    //根据在中线上的投影划分区域，如果每一行的投影大于一定宽度，则认为这一行有物体，同时查找连通区域的起点和终点
    region();

    //对距离很近的区域进行合并
    RegionMerge();

    //根据区域内的最大宽度对区域进行滤波，如果区域内的最大宽度过小，认为该区域不是车而是干扰，删除该区域
    RegionFilter();

    //在区域内进行水平投影，从而确定物体的位置
    RegionPlace();

    //在区域内再次投影精确位置
    ReRegion();

    //目标跟踪
    Trace();

    //抓拍限制
    for i:=0 to m_CarList.Count-1 do
    begin
      ACarObject:=m_CarList.Items[i];
      if (ACarObject^.Capflg=false) and (ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b<=m_cpt)then
      begin
        //beep(1000,20);
        if ACarObject^.FrameNum-ACarObject^.CapBeginFrame >m_CAPFRAMENUM then
        begin
          if (ACarObject^.ObjectRecord[ACarObject^.FrameNum-2].ii_b-ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b>0)  then
          begin
            //从底边轨迹顶端向下查找谷点，该谷点很接近底边的位置
            start_i:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b;
            startframe:=ACarObject^.FrameNum-1;
            for k:=ACarObject^.FrameNum-2 downto 0 do
            begin
              if ACarObject^.ObjectRecord[k].ii_b>start_i then
              begin
                start_i:=ACarObject^.ObjectRecord[k].ii_b;
                startframe:=k;
              end;
              if start_i>m_btm-round((m_btm-m_cpt)*m_BTMSTABLE) then break;
            end;

            centerbegin_i:=start_i;
            centerbegin_j:=(ACarObject^.ObjectRecord[startframe].ll+ACarObject^.ObjectRecord[startframe].rr) div 2;
            centerend_i:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b;
            centerend_j:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr) div 2;

            tan1:= (m_top-m_btm)/(m_la[m_top]-m_ra[m_btm]);
            tan2:= (m_top-m_btm)/(m_ra[m_top]-m_la[m_btm]);

            vi:=centerend_i-centerbegin_i;
            vj:=centerend_j-centerbegin_j;

            if vi<0 then
            begin
              if (vj<0) and (vi<tan1*vj) then
              begin
                ACarObject^.Capflg:=true;
                result:=ACarObject^.FrameNum-ACarObject^.CapBeginFrame;
                ACarObject^.CapBeginFrame:=ACarObject^.FrameNum;
              end
              else if (vj>0) and (vi<tan2*vj) then
              begin
                ACarObject^.Capflg:=true;
                result:=ACarObject^.FrameNum-ACarObject^.CapBeginFrame;
                ACarObject^.CapBeginFrame:=ACarObject^.FrameNum;
              end
              else if vj=0 then
              begin
                ACarObject^.Capflg:=true;
                result:=ACarObject^.FrameNum-ACarObject^.CapBeginFrame;
                ACarObject^.CapBeginFrame:=ACarObject^.FrameNum;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure TVLoop.Region();//根据在中线上的投影划分区域，如果每一行的投影大于一定宽度，则认为这一行有物体，同时查找连通区域的起点和终点
var
  i,prjwidth:integer;
begin
  m_regionnum:=0;

  prjwidth:=m_projectleft[m_top]+m_projectright[m_top];
  if prjwidth> 0 then
  begin
    m_regionstart[m_regionnum]:=m_top;
  end;

  for i:=m_top+1 to m_btm do
  begin
    prjwidth:=m_projectleft[i]+m_projectright[i];