virloop.pas

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

unit VirLoop;

interface

uses
  SysUtils, Classes,extinifile,Math;

const
  IMGWIDTH=768;
  IMGHEIGHT=288;

type
  TVLoop = class
  public
    constructor Create(id:integer);
    function VLD(idno,sharp,keepcnt:byte;var image:array of Byte;WIDTH,HEIGHT,lp_lft,lp_lft_b,lp_rt,lp_rt_b,lp_tp,lp_btm,cpt,drct:integer;
                param1,param2,param3,param4,param5,param6,param7,param8,param9,param10,
                param11,param12,param13,param14,param15,param16,param17,param18,param19,param20,param21:real):byte;
    //keepcnt挽救系数，当出现状态1（result=1）后，result=0的计数大于keepcnt，令result=2
    procedure SaveConfig();
    procedure LoadConfig();
  public

  private
    m_id:integer;

    m_img,m_img1:array [0..7,0..288-1,0..768-1] of byte; //存储前后两张全景中虚拟线圈区域中各像素点的平均亮度，最多允许8路同时检测
    m_tttt,m_ave_spi:array [0..7] of integer;
    m_clearflg:array [0..7] of integer; //状态清零标志当sm<lmt时，将m_tttt定位到线圈底部lp_btm,将m_carflg_loop1,m_carflg的状态清零

    m_count_keepstatus1:array [0..7] of integer;//

    m_carflg_loop1:array[0..7] of boolean;//车辆的tt进入线圈1的标志
    m_count_loop1:array [0..7] of integer;//车辆的tt在线圈1中的计数

    m_carflg1_width:array [0..7] of integer;//根据宽度判断是否有车
    m_count_losewidth:array [0..7] of integer;

    m_old_mi:array [0..7] of integer;//上一帧质心的位置
    m_bg_cnt:array [0..7] of integer;
    m_bg,m_bgsm,m_old_sm:array [0..7] of real;

  end;

var
  g_Loopiparam:array[1..10] of integer;//整数型参数
  g_LooprParam:array[1..21] of real;//实数型参数
  g_ConfigFile:string = '.\config\param.ini';
  g_lp_lft,g_lp_rt,g_lp_lft_b,g_lp_rt_b,g_lp_tp,g_lp_btm,g_cpt:integer;

  g_sm,g_bg:integer;
  
  g_carflg_width,g_carflg1,g_count_loop1,g_sp,g_tt:integer;
  g_carflg_loop1:boolean;
  //g_sm平均差分亮度
  //g_bg背景
  g_lmt:integer;
  g_tttt:integer;
  g_clearflg:integer;

  g_mi:integer; //质心的横纵坐标
  g_mj:integer;

  g_result:integer;
  g_keepcount:integer;

  g_rr1:integer;
  g_ll1:integer;
  g_ii1:integer;

  g_rr2:integer;
  g_ll2:integer;
  g_ii2:integer;

  g_image:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte; //用于显示差分后的原始图像
  g_image1:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;//用于显示图像处理后的效果
  g_image2:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;
  g_image3:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;
  g_imageTwo:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;//用于显示横向二值化后的图像
implementation

constructor TVLoop.Create(id:integer);
var
  i:Integer;
  gi:byte;
begin
  m_id:=id;
  for i:=Low(g_Loopiparam) to High(g_Loopiparam) do
  begin
    g_Loopiparam[i]:=0;
  end;
  g_Loopiparam[1] := 370;//lp_lft
  g_Loopiparam[2] := 388;//lp_lft_b
  g_Loopiparam[3] := 490;//lp_rt
  g_Loopiparam[4] := 594;//lp_rt_b
  g_Loopiparam[5] := 180;//lp_tp
  g_Loopiparam[6] := 284;//lp_btm
  g_Loopiparam[7] := 254;//lp_cpt
  g_Loopiparam[8] := 1;//drct 0:all up,1:no left,2:no right,3:no both l&r

  g_Loopiparam[9] := 1;//sharp 锐化开关
  g_Loopiparam[10] := 0;//cnt 挽救漏车系数(0/12)， 0不挽救，非0挽救（建议取值10~15，如12）

  for i:=Low(g_LooprParam) to High(g_LooprParam) do
  begin
    g_LooprParam[i]:=0.0;
  end;
	g_LooprParam[1] := 0.6; // 向下搜索的深度， 数越大越不易误抓（但可能抓得太晚）
 	g_LooprParam[2] := 0.5; // 在多大范围内判断有车状态，值越大越不易漏抓
 	g_LooprParam[3] := 0.2; // 控制抓拍第一幅全景的时机，值越小抓得越早
 	g_LooprParam[4] := 2; // 用于判断车辆面积的一个量（1~4），值越大越松、越小越严
 	g_LooprParam[5] := 0.4;// 用于判断车辆面积的一个量（0~1），值越大越严、越小越松
 	g_LooprParam[6] := 4;  // 允许特征丢失的次数，值越大越松
 	g_LooprParam[7] := 0.6; // 用于判断车仍在虚拟线圈内的一个量，越大越不易漏车（但车可能出去得太多）
 	g_LooprParam[8] := 3;  // 用于判断车辆面积的一个量（1~5），值越大越严
 	g_LooprParam[9] := 0.3;// 用于判断车辆面积的一个量（0~1），值越大越严
 	g_LooprParam[10] := 6.5;// 用于判断车辆行驶方向的一个量（3~8），值越小越方向越准（但可靠性低）
 	g_LooprParam[11] := 10; // 用于判断车辆行驶方向的一个量（5~15），值越大越方向越准（但可靠性低）
 	g_LooprParam[12] := 20; // 用于判断车辆行驶方向的一个量（5~80），值越大可靠性越高
 	g_LooprParam[13] := 0.4;// 用于判断车辆行驶方向的一个量（0~1），值越大越严
 	g_LooprParam[14] := 0.25;// 用于抑制车尾阴影的系数（0~1），值越大抑制越厉害
  g_LooprParam[15] := 0.1; // 用于背景过暗时的补偿系数（0~1），越大补偿越强烈
  g_LooprParam[16] := 10; // 背景阈值
  g_LooprParam[17] := 0.9;// 背景偏差
  g_LooprParam[18] := 0.5;// 阈值的浮动系数
  g_LooprParam[19] := 4;  // 阈值的基准值
  g_LooprParam[20] := 6;  // 背景下限
  g_LooprParam[21] := 10; // 背景上限

  for gi:=0 to 7 do
  begin
    m_tttt[gi]:=0;

    m_clearflg[gi]:=0;

    m_carflg_loop1[gi]:=false;
    m_count_loop1[gi]:=0;

    m_carflg1_width[gi]:=0;
    m_count_losewidth[gi]:=0;

    m_old_sm[gi]:=0;
    m_bg_cnt[gi]:=0;
    m_bgsm[gi]:=0;
    m_bg[gi]:=4;
  end;
end;

procedure TVLoop.SaveConfig();
var
  inifile:TExtIniFile;
  section:string;
begin
  CreateDir('.\config\');
  inifile:=TExtIniFile.Create(g_ConfigFile);

  section:=IntToStr(m_id);
  inifile.WriteIntegerArray(section,'虚拟线圈参数1',g_Loopiparam,10);
  inifile.WriteRealArray(section,'虚拟线圈参数2',g_LooprParam,21);

  inifile.Free;
end;

procedure TVLoop.LoadConfig();
var
  inifile:TExtIniFile;
  section:String;
begin
  CreateDir('.\config\');
  inifile:=TExtIniFile.Create(g_ConfigFile);

  section:=IntToStr(m_id);
  inifile.ReadIntegerArray(section,'虚拟线圈参数1',g_Loopiparam,g_Loopiparam,10);
  inifile.ReadRealArray(section,'虚拟线圈参数2',g_LooprParam,g_LooprParam,21);
  inifile.Free;
end;

//virtual loop detect虚拟线圈分析
function TVLoop.VLD(idno,sharp,keepcnt:byte;var image:array of Byte;WIDTH,HEIGHT,lp_lft,lp_lft_b,lp_rt,lp_rt_b,lp_tp,lp_btm,cpt,drct:integer;
                param1,param2,param3,param4,param5,param6,param7,param8,param9,param10,
                param11,param12,param13,param14,param15,param16,param17,param18,param19,param20,param21:real):byte;
procedure 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;

var
  la,ra:array [0..288-1] of Integer;//虚拟线圈区域在每一行的左边界和右边界
  diff,diff1:array [0..288-1,0..768-1] of byte; //差分运算
  projct,smooth:array [0..288-1] of byte;
  ll,rr,num,lll,rrr:integer;
  i,j,ki,kj:integer;
  dif,tt,proj:integer;
  di,valuemax,valuemin:byte;
  temp,temp1,temp2:byte;
  old_carflg1_width:integer;//根据宽度判断车辆在线圈1中
  carflg2_width:integer;//根据宽度判断车辆在线圈2中，还没有出去
  mi,ttbgn,new_spi:integer;
  nol,nor:integer;
  drct_cdt:boolean;
  sm,lmt,thr,no,www:real;

  r,g,b:byte;
  gray:array [0..8] of byte;//用于中值滤波的数组
  gray1:array [0..2] of byte;//用于中值滤波的数组
  gray_v,gray_h:byte;

  label do_loop1,exit1;
  label do_loop2,exit2;
  label ret;

begin
  result:=0;

  g_rr1:=0;
  g_ll1:=0;
  g_ii1:=0;

  g_rr2:=0;
  g_ll2:=0;
  g_ii2:=0;


  for i:=lp_tp to lp_btm do
  begin
    //根据斜率算出从上到下每一行的左边界点和右边节点
    la[i]:=lp_lft+(i-lp_tp)*(lp_lft_b-lp_lft) div (lp_btm-lp_tp);
    ra[i]:=lp_rt+(i-lp_tp)*(lp_rt_b-lp_rt) div (lp_btm-lp_tp);
    ll:=la[i];
    rr:=ra[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];

      //m_img[idno,i,j]:=(r+g+b) div 3;//(R+B+G)/3计算平均亮度

      m_img[idno,i,j]:=(30*r+59*g+11*b) div 100; //R=G=B=0.30*R+0.59*G+0.11*B 加权平均值法

      {//R=G=B=max(R,G,B)最大值法
      if r>g then m_img[idno,i,j]:=r
      else m_img[idno,i,j]:=g;
      if b>m_img[idno,i,j] then m_img[idno,i,j]:=b;}

      //存储全景中虚拟线圈区域中各像素点的平均亮度，最多允许8路同时检测
      //m_img[idno,i,j]:=(image[(i*IMGWIDTH+j)*3]+image[(i*IMGWIDTH+j)*3+1]+image[(i*IMGWIDTH+j)*3+2]) div 3; //(R+B+G)/3计算平均亮度
      temp1:=m_img1[idno,i,j];
      temp2:=m_img[idno,i,j];
      di:=abs(m_img1[idno,i,j]-m_img[idno,i,j]); //前后两帧作差值，取绝对值
      diff[i,j]:=di;
      temp:=round(di*(1+param15*(255/(m_img1[idno,i,j]+m_img[idno,i,j]+0.0001)-1))); //差分运算 param15=0.1 用于背景过暗时的补偿系数（0-1），越大补偿越厉害
      diff[i,j]:=temp;
      //diff[i,j]:=round(di*(1+param15*(255/(m_img1[idno,i,j]+m_img[idno,i,j]+0.0001)-1))); //差分运算 param15=0.1 用于背景过暗时的补偿系数（0-1），越大补偿越厉害
      diff1[i,j]:=diff[i,j];
    end;
  end;

  for i:=lp_tp to lp_btm do
  begin
    ll:=la[i];
    rr:=ra[i];

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

  case sharp of
  0:
    begin
    end;
  1:
    begin
      //if sharp=1 then //sharp为1时进行锐化
      for i:=lp_tp+1 to lp_btm-1 do
      begin
        ll:=la[i];
        rr:=ra[i];
        for j:=ll+1 to rr-1 do
        begin
          valuemax:=0;
          valuemin:=255;
          for ki:=i-1 to i+1 do
          for kj:=j-1 to j+1 do
          begin
            if diff1[ki,kj]>valuemax then valuemax:=diff1[ki,kj];
            if diff1[ki,kj]<valuemin then valuemin:=diff1[ki,kj];
          end;
          if valuemax-diff1[i,j]<diff1[i,j]-valuemin-1 then diff[i,j]:=valuemax
          else
          if valuemax-diff1[i,j]>diff1[i,j]-valuemin+1 then diff[i,j]:=valuemin;//valuemax
        end;
      end;

      for i:=lp_tp to lp_btm do
      begin
        ll:=la[i];
        rr:=ra[i];

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

    end;
  2:
    begin
      //中值滤波
      for i:=lp_tp+1 to lp_btm-1 do
      begin
        ll:=la[i];
        rr:=ra[i];
        for j:=ll+1 to rr-1 do
        begin
          gray[0]:= diff1[i-1,j-1];
          gray[1]:= diff1[i-1,j];
          gray[2]:= diff1[i-1,j+1];
          gray[3]:= diff1[i,j-1];
          gray[4]:= diff1[i,j];
          gray[5]:= diff1[i,j+1];
          gray[6]:= diff1[i+1,j-1];
          gray[7]:= diff1[i+1,j];
          gray[8]:= diff1[i+1,j+1];

          SelectMiddle(gray);
          diff[i,j]:=gray[4];
        end;
      end;
      for i:=lp_tp to lp_btm do
      begin
        ll:=la[i];
        rr:=ra[i];

        for j:=ll to rr do
        begin
          diff1[i,j]:=diff[i,j];
        end;
      end;

      //横向增强
      for i:=lp_tp to lp_btm do
      begin
        ll:=la[i];
        rr:=ra[i];
        for j:=ll+1 to rr-1 do
        begin
          gray1[0]:= diff1[i,j-1];
          gray1[1]:= diff1[i,j];
          gray1[2]:= diff1[i,j+1];
          SelectMiddle(gray1);
          diff[i,j]:=gray1[2];
        end;
      end;

      for i:=lp_tp to lp_btm do
      begin
        ll:=la[i];
        rr:=ra[i];

        for j:=ll to rr do
        begin
          diff1[i,j]:=diff[i,j];
        end;
      end;

      //sobel边缘检测
      for i:=lp_tp+1 to lp_btm-1 do
      begin
        ll:=la[i];
        rr:=ra[i];
        for j:=ll+1 to rr-1 do
        begin
          //[-1,-1,-1]
          //[ 0, 0, 0]
          //[+1,+1,+1]
          gray_h:=Min(255,Max(0,(-diff1[i-1,j-1]-diff1[i-1,j]-diff1[i-1,j+1]+diff1[i+1,j-1]+diff1[i+1,j]+diff1[i+1,j+1])));
          //[+1, 0,-1]
          //[+2, 0,-2]
          //[+1, 0,-1]
          gray_v:=Min(255,Max(0,(diff1[i-1,j-1]+2*diff1[i,j-1]+diff1[i+1,j-1]-diff1[i-1,j+1]-2*diff1[i,j+1]-diff1[i+1,j+1])));

          diff[i,j]:=Max(gray_h,gray_v);
        end;
      end;

      for i:=lp_tp to lp_btm do
      begin
        ll:=la[i];
        rr:=ra[i];

        for j:=ll to rr do
        begin
          diff1[i,j]:=diff[i,j];
        end;
      end;


      for i:=lp_tp to lp_btm do
      begin
        ll:=la[i];
        rr:=ra[i];

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

    end;
  3:
    begin
      //形态学的开运算，先膨胀后腐蚀
      //膨胀
      for i:=lp_tp+1 to lp_btm-1 do
      begin