virloop.pas

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

  rect1.Top:=Max(rect1.Top,m_top);
  rect1.Bottom:=Min(rect1.Bottom,m_btm);
  rect1.Left:=Max(rect1.Left,Min(m_la[rect1.Top],m_la[rect1.Bottom]));
  rect1.Right:=Min(rect1.Right,Max(m_ra[rect1.Top],m_ra[rect1.Bottom]));

  rect2.Left:=m_objectarray[objectindex].ll;
  rect2.Right:=m_objectarray[objectindex].rr;
  rect2.Top:=m_objectarray[objectindex].ii_t;
  rect2.Bottom:=m_objectarray[objectindex].ii_b;

  area1:=(rect1.Bottom-rect1.Top)*(rect1.Right-rect1.Left);
  area2:=(rect2.Bottom-rect2.Top)*(rect2.Right-rect2.Left);

  //求交集
  left:=max(rect1.Left,rect2.Left);
  right:=min(rect1.Right,rect2.Right);
  top:=max(rect1.Top,rect2.Top);
  bottom:=min(rect1.Bottom,rect2.Bottom);
  if ((right-left)>0) and ((bottom-top)>0) then
  begin
    area3:=(bottom-top)*(right-left);

    if (area3/area1 > m_AREAPERCENT) or (area3/area2 > m_AREAPERCENT) then result:=true;
  end;
end;

function TVLoop.Istotalmatch(listindex:integer;objectindex:integer):boolean;//根据两个矩形的交集面积分别占两个矩形面积的百分比，确定是否匹配
var
  area1,area2,area3:integer;
  left,right,top,bottom:integer;
  rect1,rect2:TRect;
  ACarObject:PCarObject;
begin
  result:=false;

  ACarObject:=m_CarList.Items[listindex];
  rect1.Left:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.vj;
  rect1.Right:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr+ACarObject^.vj;
  rect1.Top:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.vi;
  rect1.Bottom:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b+ACarObject^.vi;

  //判断是否超出边界
  rect1.Top:=Max(rect1.Top,m_top);
  rect1.Bottom:=Min(rect1.Bottom,m_btm);
  rect1.Left:=Max(rect1.Left,Min(m_la[rect1.Top],m_la[rect1.Bottom]));
  rect1.Right:=Min(rect1.Right,Max(m_ra[rect1.Top],m_ra[rect1.Bottom]));

  rect2.Left:=m_objectarray[objectindex].ll;
  rect2.Right:=m_objectarray[objectindex].rr;
  rect2.Top:=m_objectarray[objectindex].ii_t;
  rect2.Bottom:=m_objectarray[objectindex].ii_b;

  area1:=(rect1.Bottom-rect1.Top)*(rect1.Right-rect1.Left);
  area2:=(rect2.Bottom-rect2.Top)*(rect2.Right-rect2.Left);

  left:=max(rect1.Left,rect2.Left);
  right:=min(rect1.Right,rect2.Right);
  top:=max(rect1.Top,rect2.Top);
  bottom:=min(rect1.Bottom,rect2.Bottom);
  if ((right-left)>0) and ((bottom-top)>0) then
  begin
    area3:=(bottom-top)*(right-left);

    if (area3/area1 > m_AREAPERCENT) and (area3/area2 > m_AREAPERCENT) then result:=true;
  end;
end;

procedure TVLoop.merge(var listindexarray:array of integer;objectindex:integer);//合并
var
  ACarObject:PCarObject;
  iscar:boolean;
  i:integer;
  capflg:boolean;
  left,right,top,btm:integer;
  objleft,objright,objtop,objbtm:integer;
  maxleft,maxright,maxtop,maxbtm:integer;
  NewCenter_i,NewCenter_j,OldCenter_i,OldCenter_j:integer;
begin
  iscar:=false;
  for i:=low(listindexarray) to high(listindexarray) do
  begin
    ACarObject:=m_CarList.Items[listindexarray[i]];
    if (PCarObject(m_CarList.Items[listindexarray[i]])^.match>ACarObject^.unmatch) and (ACarObject^.match>m_MATCHSUCCESS) then iscar:=true;
  end;

  if iscar then
  begin
    //几辆车在当前帧中合并成一个对象时（连车），应该不合并，unmatch加1
    form1.memo1.Lines.Add(inttostr(g_count)+'+不合并');

    //新方法,按照几个对象的预测大小在当前对象中的比例，进行分配，将当前值更新

    //求几个对象的最大外接矩形
    ACarObject:=m_CarList.Items[listindexarray[0]];
    maxleft:= ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.vj;
    maxright:= ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr+ACarObject^.vj;
    maxtop:= ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.vi;
    maxbtm:= ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b+ACarObject^.vi;

    //判断是否超出边界
    maxtop:=Max(maxtop,m_top);
    maxbtm:=Min(maxbtm,m_btm);
    maxleft:=Max(maxleft,Min(m_la[maxtop],m_la[maxbtm]));
    maxright:=Min(maxright,Max(m_ra[maxtop],m_ra[maxbtm]));

    for i:=low(listindexarray)+1 to high(listindexarray) do
    begin
      ACarObject:=m_CarList.Items[listindexarray[i]];

      maxleft:=min(maxleft,ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.vj);
      maxright:=max(maxright,ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr+ACarObject^.vj);
      maxtop:=min(maxtop,ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.vi);
      maxbtm:=max(maxbtm,ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b+ACarObject^.vi);

      //判断是否超出边界
      maxtop:=Max(maxtop,m_top);
      maxbtm:=Min(maxbtm,m_btm);
      maxleft:=Max(maxleft,Min(m_la[maxtop],m_la[maxbtm]));
      maxright:=Min(maxright,Max(m_ra[maxtop],m_ra[maxbtm]));
    end;

    objleft:=m_objectarray[objectindex].ll;
    objright:=m_objectarray[objectindex].rr;
    objtop:=m_objectarray[objectindex].ii_t;
    objbtm:=m_objectarray[objectindex].ii_b;

    for i:=low(listindexarray) to high(listindexarray) do
    begin
      ACarObject:=m_CarList.Items[listindexarray[i]];

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

      left:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.vj;
      right:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr+ACarObject^.vj;
      top:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.vi;
      btm:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b+ACarObject^.vi;

      //判断是否超出边界
      top:=Max(top,m_top);
      btm:=Min(btm,m_btm);
      left:=Max(left,Min(m_la[top],m_la[btm]));
      right:=Min(right,Max(m_ra[top],m_ra[btm]));

      ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=round((left-maxleft)*(objright-objleft)/(maxright-maxleft)+objleft);
      ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=round((right-maxleft)*(objright-objleft)/(maxright-maxleft)+objleft);
      ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=round((top-maxtop)*(objbtm-objtop)/(maxbtm-maxtop)+objtop);
      ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=round((btm-maxtop)*(objbtm-objtop)/(maxbtm-maxtop)+objtop);

      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^.vi:=NewCenter_i-OldCenter_i;
      ACarObject^.vj:=NewCenter_j-OldCenter_j;

      inc(ACarObject^.FrameNum);
      inc(ACarObject^.unmatch);
    end;
  end
  else //进行合并（同一车的两部分）
  begin
    form1.memo1.Lines.Add(inttostr(g_count)+'+合并');
    //保留第一个链
    ACarObject:=m_CarList.Items[listindexarray[0]];

    if ACarObject^.FrameNum=length(ACarObject^.ObjectRecord) then
      setlength(ACarObject^.ObjectRecord,length(ACarObject^.ObjectRecord)*2);
      
    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;

    inc(ACarObject^.FrameNum);
    inc(ACarObject^.unmatch);

    capflg:=ACarObject^.Capflg;
    //删除其他的
    for i:=1 to high(listindexarray) do
    begin
      ACarObject:=m_CarList.Items[listindexarray[i]];
      capflg:=capflg and ACarObject^.Capflg;

      setlength(ACarObject^.ObjectRecord,0);

      Dispose(ACarObject);
      m_CarList.Items[listindexarray[i]]:=nil;
    end;
    ACarObject:=m_CarList.Items[listindexarray[0]];
    ACarObject^.Capflg:=capflg;
  end;
end;

function TVLoop.divide(listindex:integer;var objectindexarray:array of integer):TList;//分裂
var
  ACarObject:PCarObject;
  left,right,top,bottom:integer;
  i,k:integer;
  NewCenter_i,OldCenter_i,NewCenter_j,OldCenter_j:integer;
  DivideList:TList;
  DivideCar:PCarObject;
begin
  ACarObject:=m_CarList.Items[listindex];
  if ACarObject^.FrameNum=length(ACarObject^.ObjectRecord) then
    setlength(ACarObject^.ObjectRecord,length(ACarObject^.ObjectRecord)*2);

  if (ACarObject^.match>ACarObject^.unmatch) and (ACarObject^.match>m_MATCHSUCCESS) then
  begin
    //如果是因为一个车分裂成两部分的情况，则不应该分裂
    form1.memo1.Lines.Add(inttostr(g_count)+'+不分裂');

    //求最大外接矩形
    left:=m_objectarray[objectindexarray[0]].ll;
    right:=m_objectarray[objectindexarray[0]].rr;
    top:=m_objectarray[objectindexarray[0]].ii_t;
    bottom:=m_objectarray[objectindexarray[0]].ii_b;

    for i:=1 to high(objectindexarray) do
    begin
      if m_objectarray[objectindexarray[i]].ll<left then left:=m_objectarray[objectindexarray[i]].ll;
      if m_objectarray[objectindexarray[i]].rr>right then right:=m_objectarray[objectindexarray[i]].rr;
      if m_objectarray[objectindexarray[i]].ii_t<top then top:=m_objectarray[objectindexarray[i]].ii_t;
      if m_objectarray[objectindexarray[i]].ii_b>bottom then bottom:=m_objectarray[objectindexarray[i]].ii_b;
    end;

    //预测值
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll+ACarObject^.vj;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr+ACarObject^.vj;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t+ACarObject^.vi;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b+ACarObject^.vi;

    //是否超出边界
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=Max(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t,m_top);
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=Min(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b,m_btm);
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=Max(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll,Min(m_la[ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t],m_la[ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b]));
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=Min(ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr,Max(m_ra[ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t],m_ra[ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b]));

    //当前值和预测值求平均
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll+left) div 2;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr+right) div 2;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t+top) div 2;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=(ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b+bottom) 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^.vi:=NewCenter_i-OldCenter_i;
    ACarObject^.vj:=NewCenter_j-OldCenter_j;

    inc(ACarObject^.FrameNum);
    inc(ACarObject^.unmatch);
    result:=nil;
  end
  else//分裂
  begin
    form1.memo1.Lines.Add(inttostr(g_count)+'+分裂');
    DivideList:=TList.Create;

    for i:=1 to high(objectindexarray) do
    begin
      New(DivideCar);
      setlength(DivideCar^.ObjectRecord,length(ACarObject^.ObjectRecord));

      for k:=0 to ACarObject^.FrameNum-1 do
        DivideCar^.ObjectRecord[k]:=ACarObject^.ObjectRecord[k];

      DivideCar^.FrameNum:=ACarObject^.FrameNum;
      DivideCar^.vi:=ACarObject^.vi;
      DivideCar^.vj:=ACarObject^.vj;
      DivideCar^.match:=ACarObject^.match;
      DivideCar^.unmatch:=ACarObject^.unmatch;
      DivideCar^.Capflg:=ACarObject^.Capflg;
      DivideCar^.CapBeginFrame:=ACarObject^.CapBeginFrame;
      DivideList.Add(DivideCar);
    end;

    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ll:=m_objectarray[objectindexarray[0]].ll;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].rr:=m_objectarray[objectindexarray[0]].rr;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_t:=m_objectarray[objectindexarray[0]].ii_t;
    ACarObject^.ObjectRecord[ACarObject^.FrameNum].ii_b:=m_objectarray[objectindexarray[0]].ii_b;
    inc(ACarObject^.FrameNum);
    inc(ACarObject^.unmatch);

    for i:=0 to DivideList.Count-1 do
    begin
      DivideCar:=DivideList.Items[i];

      DivideCar^.ObjectRecord[DivideCar^.FrameNum].ll:=m_objectarray[objectindexarray[i+1]].ll;
      DivideCar^.ObjectRecord[DivideCar^.FrameNum].rr:=m_objectarray[objectindexarray[i+1]].rr;
      DivideCar^.ObjectRecord[DivideCar^.FrameNum].ii_t:=m_objectarray[objectindexarray[i+1]].ii_t;
      DivideCar^.ObjectRecord[DivideCar^.FrameNum].ii_b:=m_objectarray[objectindexarray[i+1]].ii_b;

      inc(DivideCar^.FrameNum);
      inc(DivideCar^.unmatch);
    end;
    result:=DivideList;
  end;
end;

function TVLoop.add(objectindex:integer):PCarObject;//新增
var
  ACarObject:PCarObject;
begin
  result:=nil;

  //if m_objectarray[objectindex].ii_b>m_cpt then //底边在抓拍线以下
  if m_objectarray[objectindex].ii_b>m_btm-round((m_btm-m_cpt)*m_ADDTHR) then //底边在底边和抓拍线之间
  begin
    New(ACarObject);
    setlength(ACarObject^.ObjectRecord,TRACELENGTH);
    
    ACarObject^.ObjectRecord[0].ll:=m_objectarray[objectindex].ll;
    ACarObject^.ObjectRecord[0].rr:=m_objectarray[objectindex].rr;
    ACarObject^.ObjectRecord[0].ii_t:=m_objectarray[objectindex].ii_t;
    ACarObject^.ObjectRecord[0].ii_b:=m_objectarray[objectindex].ii_b;

    ACarObject^.FrameNum:=1;
    ACarObject^.vi:=0;
    ACarObject^.vj:=0;
    ACarObject^.match:=0;
    ACarObject^.unmatch:=0;
    ACarObject^.Capflg:=false;
    ACarObject^.CapBeginFrame:=0;
    
    result:=ACarObject;
    form1.memo1.Lines.Add(inttostr(g_count)+'+新增');
  end
  else
  begin
    form1.memo1.Lines.Add(inttostr(g_count)+'+不新增');
  end;
end;

function  TVLoop.IsEdge(listindex:integer):integer;//检查对象是否在线圈的边缘，处于哪个边缘
var
  ACarObject:PCarObject;
  left,right,top,bottom:integer;
  center_i,center_j:integer;
begin
  ACarObject:=m_CarList.Items[listindex];
  left:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ll;
  right:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].rr;
  top:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_t;
  bottom:=ACarObject^.ObjectRecord[ACarObject^.FrameNum-1].ii_b;
  center_i:=(top+bottom) div 2;
  center_j:=(left+right) div 2;

  if center_i<=(m_top+round((m_btm-m_top) * m_EDGESCALE)) then result:=1
  else if center_j<=(m_la[center_i]+round((m_ra[center_i]-m_la[center_i]) * m_EDGESCALE)) then result:=2
  else if center_j>=(m_ra[center_i]-round((m_ra[center_i]-m_la[center_i]) * m_EDGESCALE)) then result:=3
  else result:=0;
end;

procedure TVLoop.remove(listindex:integer);//删除或保留
var
  ACarObject:PCarObject;
  EdgeIndex:integer;
begin
  //查找对象是否处于边界，如果处于边界则删除
  EdgeIndex:=IsEdge(listindex);
  ACarObject:=m_CarList.Items[listindex];

  if EdgeIndex>0 then//如果对象位于边界上，则删除
  begin
    form1.memo1.Lines.Add(inttostr(g_count)+'+删除');