virloop.pas

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

    setlength(ACarObject^.ObjectRecord,0);
    Dispose(ACarObject);
    m_CarList.Items[listindex]:=nil;
  end
  else //对象的位置没有在边界上，需要判断是删除还是保留
  begin
    //保留的判断和处理
    {inc(ACarObject^.unmatch);//没有匹配的次数加1
    if (ACarObject^.match>m_MATCHSUCCESS) and (ACarObject^.unmatch<m_RESERVENUM) then //判断匹配的次数和没有匹配的次数是否符合保留的条件
    begin
      //保留
      form1.memo1.Lines.Add(inttostr(g_count)+'+保留');
    end
    else
    begin }
      //删除
      form1.memo1.Lines.Add(inttostr(g_count)+'+删除');
      setlength(ACarObject^.ObjectRecord,0);
      Dispose(ACarObject);
      m_CarList.Items[listindex]:=nil;
    //end;
  end;
end;

procedure TVLoop.bijection(listindex:integer;objectindex:integer);//匹配
var
  ACarObject:PCarObject;
  NewCenter_i,OldCenter_i,NewCenter_j,OldCenter_j:integer;
  left,right,top,btm:integer;
begin
  ACarObject:=m_CarList.Items[listindex];

  if ACarObject^.FrameNum=length(ACarObject^.ObjectRecord) then
    setlength(ACarObject^.ObjectRecord,length(ACarObject^.ObjectRecord)*2);

  if IsTotalmatch(listindex,objectindex) then //完全匹配，直接进行更新
  begin
    form1.memo1.Lines.Add(inttostr(g_count)+'+完全匹配');
    
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=m_objectarray[objectindex].ll;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=m_objectarray[objectindex].rr;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=m_objectarray[objectindex].ii_t;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=m_objectarray[objectindex].ii_b;

    NewCenter_i:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t+ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b) div 2;
    NewCenter_j:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll+ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr) div 2;
    OldCenter_i:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b) div 2;
    OldCenter_j:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr) div 2;

    ACarObject^.FrameNum:=ACarObject^.FrameNum+1;

    //根据前后帧的中心位置计算运动速度和方向
    ACarObject^.vi:=NewCenter_i-OldCenter_i;
    ACarObject^.vj:=NewCenter_j-OldCenter_j;

    //如果中点跳变大于一定值
    //if ACarObject^.vi>round((m_btm-m_top)*m_JUMPTHR) then
    //底边跳变大于一定值
    if (ACarObject^.Capflg=true) and (ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b-ACarObject^.ObjectRecord[ACarObject^.FrameNum-2].ii_b>round((m_btm-m_top)*m_JUMPTHR)) then
    begin
      ACarObject^.Capflg:=false;
      ACarObject^.CapBeginFrame:=ACarObject^.FrameNum-1;
    end;

    //匹配计数加1
    inc(ACarObject^.match);
  end
  else//不完全匹配，有行人等的干扰，造成区域面积发生突变
  begin
    form1.memo1.Lines.Add(inttostr(g_count)+'+不完全匹配');

    //判断是否超出边界
    top:=Max(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.vi,m_top);
    btm:=Min(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b+ACarObject^.vi,m_btm);
    left:=Max(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.vj,Min(m_la[top],m_la[btm]));
    right:=Min(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr+ACarObject^.vj,Max(m_ra[top],m_ra[btm]));

    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=(left+m_objectarray[objectindex].ll) div 2;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=(right+m_objectarray[objectindex].rr) div 2;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=(top+m_objectarray[objectindex].ii_t) div 2;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=(btm+m_objectarray[objectindex].ii_b) div 2;


    NewCenter_i:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t+ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b) div 2;
    NewCenter_j:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll+ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr) div 2;
    OldCenter_i:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b) div 2;
    OldCenter_j:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr) div 2;


    ACarObject^.FrameNum:=ACarObject^.FrameNum+1;

    ACarObject^.vi:=NewCenter_i-OldCenter_i;
    ACarObject^.vj:=NewCenter_j-OldCenter_j;

    //如果中点跳变大于一定值
    //if ACarObject^.vi>round((m_btm-m_top)*m_JUMPTHR) then
    //底边跳变大于一定值
    if (ACarObject^.Capflg=true) and (ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b-ACarObject^.ObjectRecord[ACarObject^.FrameNum-2].ii_b>round((m_btm-m_top)*m_JUMPTHR)) then
    begin
      ACarObject^.Capflg:=false;
      ACarObject^.CapBeginFrame:=ACarObject^.FrameNum-1;
    end;
    
    inc(ACarObject^.match);
  end;
end;

procedure TVLoop.arraydelete(var a:array of integer;index:integer);
var
  i:integer;
begin
  for i:=index to high(a)-1 do
  begin
    a[i]:=a[i+1];
  end;
end;

function TVLoop.linear(pointarray:array of TPoint;var a:real; var b:real):real;//y=ax+b
var
  avgx,avgy,sigmaxy,sigmaxx:real;
  i:integer;
begin
  avgx:=0;
  avgy:=0;
  for i:=low(pointarray) to high(pointarray) do
  begin
    avgx:=avgx+pointarray[i].X;
    avgy:=avgy+pointarray[i].Y;
  end;

  avgx:=avgx / length(pointarray);
  avgy:=avgy / length(pointarray);

  sigmaxy:=0;
  sigmaxx:=0;
  for i:=low(pointarray) to high(pointarray) do
  begin
    sigmaxy:=sigmaxy+(pointarray[i].X-avgx)*(pointarray[i].Y-avgy);
    sigmaxx:=sigmaxx+(pointarray[i].X-avgx)*(pointarray[i].X-avgx);
  end;
  a:=sigmaxy/sigmaxx;
  b:=avgy-avgx*a;
  result:=a;
end;

procedure TVLoop.RemoveShadow();
var
  SB,S2,B2,SSB,SS2,SB2: array [0..BLKHEIGHT-1,0..BLKWIDTH-1] of integer;
  x,y,l,tempSSB,tempSS2,tempSB2,mini:integer;
  cor,rc,gc,bc,rb,gb,bb,tc,tb,test:real;
  left,right,top,btm:integer;
begin
  top:=m_top;
  btm:=m_btm;
  left:=min(m_la[top],m_la[btm]);
  right:=max(m_ra[top],m_ra[btm]);

  l:=m_shadowL;
  //计算SB,S2,B2
  //SB 当前帧灰度*背景灰度
  //S2 当前帧灰度平方
  //B2 背景灰度平方
  for x:=left to right do
    for y:= top to btm do
    begin
      if m_diff[y,x] <> 0 then
      begin
        SB[y,x]:=m_grayblk[y,x]*m_bgblkNow[y,x];
        S2[y,x]:=m_grayblk[y,x]*m_grayblk[y,x];
        B2[y,x]:=m_bgblkNow[y,x]*m_bgblkNow[y,x];
      end
      else
      begin
        SB[y,x]:=0;
        S2[y,x]:=0;
        B2[y,x]:=0;
      end;
    end;

  //计算SSB,SS2,SB2
  //SSB[y,x]:= SB[y,x]+SSB[y-1,x]+SSB[y,x-1]-SSB[y-1,x-1];
  //其余依次类推
  SSB[top,left]:=SB[top,left];
  SS2[top,left]:=S2[top,left];
  SB2[top,left]:=B2[top,left];
  for x:=left+1 to right do
  begin
    SSB[top,x]:=SB[top,x]+SSB[top,x-1];
    SS2[top,x]:=S2[top,x]+SS2[top,x-1];
    SB2[top,x]:=B2[top,x]+SB2[top,x-1];
  end;
  for y:=top+1 to btm do
  begin
    SSB[y,left]:=SB[y,left]+SSB[y-1,left];
    SS2[y,left]:=S2[y,left]+SS2[y-1,left];
    SB2[y,left]:=B2[y,left]+SB2[y-1,left];
  end;
  for x:=left+1 to right do
    for y:=top+1 to btm do
    begin
      SSB[y,x]:=SB[y,x]+SSB[y-1,x]+SSB[y,x-1]-SSB[y-1,x-1];
      SS2[y,x]:=S2[y,x]+SS2[y-1,x]+SS2[y,x-1]-SS2[y-1,x-1];
      SB2[y,x]:=B2[y,x]+SB2[y-1,x]+SB2[y,x-1]-SB2[y-1,x-1];
    end;

  //根据相关度除阴影
  //模板和计算方法: l=模板半宽度
  //Stemp[y,x]=S[y+l,x+l]-S[y-l-1,x+l]-S[y+l,x-l-1]+S[y-l-1,x-l-1];
  for x:=left to right do
    for y:=top to btm do
      if ((m_diff[y,x] <> 0)and(m_grayblk[y,x]<m_bgblkNow[y,x])and(m_diffgray[y,x]<m_BRIGHTDIFF)) then
      begin
        if x<left+l+1 then
        begin
          if y<top+l+1 then //左上角
          begin
            cor:=SSB[y+l,x+l]*SSB[y+l,x+l]/(SS2[y+l,x+l]*SB2[y+l,x+l])
          end
          else if y+l>btm then //左下角 减上部值
          begin
            tempSSB:=SSB[btm,x+l]-SSB[y-l-1,x+l];
            tempSS2:=SS2[btm,x+l]-SS2[y-l-1,x+l];
            tempSB2:=SB2[btm,x+l]-SB2[y-l-1,x+l];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end
          else //左侧 减上部值
          begin
            tempSSB:=SSB[y+l,x+l]-SSB[y-l-1,x+l];
            tempSS2:=SS2[y+l,x+l]-SS2[y-l-1,x+l];
            tempSB2:=SB2[y+l,x+l]-SB2[y-l-1,x+l];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end;
        end
        else if x+l>right then
        begin
          if y<top+l+1 then  //右上角  减左侧值
          begin
            tempSSB:=SSB[y+l,right]-SSB[y+l,x-l-1];
            tempSS2:=SS2[y+l,right]-SS2[y+l,x-l-1];
            tempSB2:=SB2[y+l,right]-SB2[y+l,x-l-1];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end
          else if y+l>btm then  //右下角 减左,上侧值 加左上值
          begin
            tempSSB:=SSB[btm,right]-SSB[btm,x-l-1]-SSB[y-l-1,right]+SSB[y-l-1,x-l-1];
            tempSS2:=SS2[btm,right]-SS2[btm,x-l-1]-SS2[y-l-1,right]+SS2[y-l-1,x-l-1];
            tempSB2:=SB2[btm,right]-SB2[btm,x-l-1]-SB2[y-l-1,right]+SB2[y-l-1,x-l-1];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end
          else //右侧 减左,上侧值 加左上值
          begin
            tempSSB:=SSB[y+l,right]-SSB[y+l,x-l-1]-SSB[y-l-1,right]+SSB[y-l-1,x-l-1];
            tempSS2:=SS2[y+l,right]-SS2[y+l,x-l-1]-SS2[y-l-1,right]+SS2[y-l-1,x-l-1];
            tempSB2:=SB2[y+l,right]-SB2[y+l,x-l-1]-SB2[y-l-1,right]+SB2[y-l-1,x-l-1];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end;
        end
        else
        begin
          if y<top+l+1 then  //上侧 减左侧值
          begin
            tempSSB:=SSB[y+l,x+l]-SSB[y+l,x-l-1];
            tempSS2:=SS2[y+l,x+l]-SS2[y+l,x-l-1];
            tempSB2:=SB2[y+l,x+l]-SB2[y+l,x-l-1];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end
          else if y+l>btm then  //下侧 减左,上侧值 加左上侧值
          begin
            tempSSB:=SSB[btm,x+l]-SSB[btm,x-l-1]-SSB[y-l-1,x+l]+SSB[y-l-1,x-l-1];
            tempSS2:=SS2[btm,x+l]-SS2[btm,x-l-1]-SS2[y-l-1,x+l]+SS2[y-l-1,x-l-1];
            tempSB2:=SB2[btm,x+l]-SB2[btm,x-l-1]-SB2[y-l-1,x+l]+SB2[y-l-1,x-l-1];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end
          else //中部 减左,上侧值 加左上侧值
          begin
            tempSSB:=SSB[y+l,x+l]-SSB[y+l,x-l-1]-SSB[y-l-1,x+l]+SSB[y-l-1,x-l-1];
            tempSS2:=SS2[y+l,x+l]-SS2[y+l,x-l-1]-SS2[y-l-1,x+l]+SS2[y-l-1,x-l-1];
            tempSB2:=SB2[y+l,x+l]-SB2[y+l,x-l-1]-SB2[y-l-1,x+l]+SB2[y-l-1,x-l-1];
            cor:=tempSSB/tempSS2*tempSSB/tempSB2;
          end;
        end;
        if cor > m_Tfncc then m_diff[y,x]:=0;
      end;
end;

procedure TVLoop.showproject(mode:integer);//显示投影结果
var
  i,ih,ll,rr,jv,j:integer;
begin
  fillchar(g_imageTwo,sizeof(g_imageTwo),0);
  if mode=0 then
  begin
    //投影显示
    for i:=m_top to m_btm do
    begin
      for ih:=0 to HBLOCKSIZE-1 do
      begin
        ll:=m_la[i];
        rr:=m_ra[i];

        for jv:=0 to WBLOCKSIZE-1 do
        begin
          for j:=ll to (rr+ll)div 2 -m_projectleft[i]-1 do
          begin
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3]:=0;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+1]:=0;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+2]:=0;
          end;

          for j:=(rr+ll)div 2 -m_projectleft[i] to (rr+ll)div 2 do
          begin
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3]:=255;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+1]:=255;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+2]:=255;
          end;
          for j:=(rr+ll)div 2 to (rr+ll)div 2 + m_projectright[i]  do
          begin
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3]:=255;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+1]:=255;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+2]:=255;
          end;
          for j:=(rr+ll)div 2 + m_projectright[i]+1 to rr  do
          begin
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3]:=0;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+1]:=0;
            g_imageTwo[((i*HBLOCKSIZE+ih)*IMGWIDTH+j*WBLOCKSIZE+jv)*3+2]:=0;
          end;
        end;
      end;
    end;
  end
  else if mode=1 then
  begin
    //投影显示
    for i:=m_top to m_btm do
    begin
      ll:=m_la[i];
      rr:=m_ra[i];

      for j:=ll to (rr+ll)div 2 -m_projectleft[i]-1 do
      begin
        g_imageTwo[(i*IMGWIDTH+j)*3]:=0;
        g_imageTwo[(i*IMGWIDTH+j)*3+1]:=0;
        g_imageTwo[(i*IMGWIDTH+j)*3+2]:=0;
      end;

      for j:=(rr+ll)div 2 -m_projectleft[i] to (rr+ll)div 2 do
      begin
        g_imageTwo[(i*IMGWIDTH+j)*3]:=255;
        g_imageTwo[(i*IMGWIDTH+j)*3+1]:=255;
        g_imageTwo[(i*IMGWIDTH+j)*3+2]:=255;
      end;
      for j:=(rr+ll)div 2 to (rr+ll)div 2 + m_projectright[i]  do
      begin
        g_imageTwo[(i*IMGWIDTH+j)*3]:=255;
        g_imageTwo[(i*IMGWIDTH+j)*3+1]:=255;
        g_imageTwo[(i*IMGWIDTH+j)*3+2]:=255;
      end;
      for j:=(rr+ll)div 2 + m_projectright[i]+1 to rr  do
      begin
        g_imageTwo[(i*IMGWIDTH+j)*3]:=0;
        g_imageTwo[(i*IMGWIDTH+j)*3+1]:=0;
        g_imageTwo[(i*IMGWIDTH+j)*3+2]:=0;
      end;
    end;
  end;
end;
end.