mainform.pas

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

  //显示中线投影
  VideoWnd8.DrawImage(@g_imageTwo[0]);
  //画线圈
  VideoWnd8.MoveTo(lp_lft, lp_tp);
  VideoWnd8.LineTo(lp_rt,lp_tp,clRed);

  VideoWnd8.LineTo(lp_rt_b,lp_btm,clRed);

  VideoWnd8.LineTo(lp_lft_b,lp_btm,clRed);

  VideoWnd8.LineTo(lp_lft,lp_tp,clRed);

  VideoWnd8.MoveTo(cptll, cpt);
  VideoWnd8.LineTo(cptrr,cpt,clRed);
end;

procedure TForm1.showparam();
begin
  //测试程序运行时间
  MeMoTime.Lines.Add(inttostr(g_time));

  //对背景亮度进行显示，确定晚上和白天的差别
  MemoBright.Lines.Add(inttostr(g_BgBright));
end;

procedure TForm1.VideoDetect(image:PByte);//进行虚拟线圈分析
var
  rec:byte;
  filename:string;
  captime:TDateTime;
  frameoffset:integer;
  setparam:array[1..26] of real;//虚拟线圈参数
  i:integer;
  lp_lft,lp_lft_b,lp_rt,lp_rt_b,lp_tp,lp_btm,cpt:integer;
  pImgData : Pbyte;

begin
  Copymemory(@m_image[0],image,IMGWIDTH*IMGHEIGHT*3);

  lp_tp:=m_Loopparam[1];
  lp_lft:=m_Loopparam[2];
  lp_rt:=m_Loopparam[3];
  lp_btm:=m_Loopparam[4];
  lp_lft_b:=m_Loopparam[5];
  lp_rt_b:=m_Loopparam[6];
  cpt:=m_Loopparam[7];

  if g_BgBright=0 then
  begin
    for i:=Low(setparam) to High(setparam) do setparam[i]:=m_setparam1[i];
  end
  else if g_BgBright > m_setparam1[27] then //白天
  begin
    if m_daynight=1 then
    begin
      m_daynight:=0;
      RadioGroupTime.ItemIndex:=m_daynight;
      WriteSetParam();
    end;
    for i:=Low(setparam) to High(setparam) do setparam[i]:=m_setparam1[i];
  end
  else if g_BgBright <= m_setparam1[27] then //晚上
  begin
    if m_daynight=0 then
    begin
      m_daynight:=1;
      RadioGroupTime.ItemIndex:=m_daynight;
      WriteSetParam();
    end;
    for i:=Low(setparam) to High(setparam) do setparam[i]:=m_setparam2[i];
  end;

  
  rec:=m_VLoop.VLD(m_image,lp_lft,lp_lft_b,lp_rt,lp_rt_b,lp_tp,lp_btm,cpt,round(setparam[23]),boolean(round(setparam[24])),boolean(round(setparam[25])),boolean(round(setparam[26])),
                  setparam[1],setparam[2],setparam[3],setparam[4],setparam[5],setparam[6],
                  setparam[7],setparam[8],setparam[9],setparam[10],setparam[11],setparam[12],setparam[13],setparam[20],setparam[21],setparam[22]);

  if rec>0 then
  begin
    //真正检测到车，再采积第一张特写和全景，并存储文件
    beep;
    ShapeCap.Brush.Color:=clred;
    MemoFrameNum.Lines.Add(inttostr(rec));

    //根据从底边到抓拍线的帧数估算应该向前推移几张全景
    frameoffset:=round((rec*setparam[14])/FRAMERATE);
    frameoffset:=max(frameoffset,round(setparam[15]/FRAMERATE));
    frameoffset:=min(frameoffset,round(setparam[16]/FRAMERATE));

    //全景3
    if g_picid < frameoffset then
      Copymemory(@m_pic[3][0],@g_picbuff[25-frameoffset+g_picid][0],IMGWIDTH*IMGHEIGHT*3)
    else
      Copymemory(@m_pic[3][0],@g_picbuff[g_picid-frameoffset][0],IMGWIDTH*IMGHEIGHT*3);
    VideoWnd7.DrawImage(@m_pic[3][0]);

    ////////////////////////////////////////////////////////////////////////////////
    frameoffset:=round((rec*setparam[17])/FRAMERATE);
    frameoffset:=max(frameoffset,round(setparam[18]/FRAMERATE));
    frameoffset:=min(frameoffset,round(setparam[19]/FRAMERATE));

    //全景1
    if g_picid < frameoffset then
      Copymemory(@m_pic[0][0],@g_picbuff[25-frameoffset+g_picid][0],IMGWIDTH*IMGHEIGHT*3)
    else
      Copymemory(@m_pic[0][0],@g_picbuff[g_picid-frameoffset][0],IMGWIDTH*IMGHEIGHT*3);
    VideoWnd2.DrawImage(@m_pic[0][0]);


    //全景2
    Copymemory(@m_pic[1][0],@m_image[0],IMGWIDTH*IMGHEIGHT*3);
    VideoWnd3.DrawImage(@m_pic[1][0]);


    //采集特写
    m_TXCard.GetCurDib(@m_pic[2][0]);
    VideoWnd4.DrawImage(@m_pic[2][0]);

    //保存文件
   { if m_savefile then
    begin
      captime:=Now();

      filename:=GetImageFileName(captime,2);
      m_QJCard.SavePics(g_SavePath+filename,@m_pic[0][0],85);

      filename:=GetImageFileName(captime,3);
      m_QJCard.SavePics(g_SavePath+filename,@m_pic[1][0],85);

      filename:=GetImageFileName(captime,4);
      m_QJCard.SavePics(g_SavePath+filename,@m_pic[2][0],85);

      filename:=GetImageFileName(captime,1);
      m_QJCard.SavePics(g_SavePath+filename,@m_pic[3][0],85);

      filename:=GetDatFileName(captime);
      SaveDatFile(g_SavePath+filename,captime);
    end;    }
    ShapeCap.Brush.Color:=clwhite;
  end;
end;

procedure TForm1.SaveDatFile(filename:string;time:TDateTime);
var
  F:TextFile;
  str,formatstr:string;
begin
  AssignFile(F,filename);
  try
    ReWrite(F);
    try
      DateTimeToString(formatstr,'yyyy-mm-dd',time);
      str:=formatstr+' ';

      formatstr:=Format('%-17s%-9s',[g_RoadName,g_Direct]);
      str:=str+formatstr;

      str:=str+StringOfChar(' ',9); //留出红灯开始时间的位置
      
      DateTimeToString(formatstr,'hh:nn:ss',time);
      str:=str+formatstr+' ';

      str:=str+StringOfChar(' ',44); //留出空格
      str:=str+'05';

      str:=str+' ';
      WriteLn(F,str);
    finally
      CloseFile(F);
    end;
  except
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  timeBeginPeriod(1);
  m_clicknum:=0;
  m_id:=0;

  m_VLoop:=TVLoop.Create(m_id);

  m_daynight:=RadioGroupTime.ItemIndex;//白天晚上判断
  m_savefile:=CheckBoxSave.Checked;//保存文件

  //读取配置文件
  LoadConfig;
  //将参数值写到界面上
  WriteLoopParam();
  WriteSetParam();
  CreateDir(g_SavePath);//创建存储路径

  m_QJCard:=nil;
  m_TXCard:=nil;

  //生成BITMAPINFOHEADER头
  FillChar(Bih, SizeOf(Bih), 0);
  Bih.biSize := SizeOf(BITMAPINFOHEADER);
  Bih.biPlanes := 1;
  Bih.biBitCount := 24;
  Bih.biCompression := BI_RGB;
  Bih.biWidth := IMGWIDTH;
  Bih.biHeight := IMGHEIGHT;


  setlength(imgconvert, IMGWIDTH*IMGHEIGHT*3);

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  timeEndPeriod(1);
  Timer1.Enabled:=false;

  ReadLoopParam();
  ReadSetParam();
  SaveConfig; //保存配置文件

  if m_QjCard<>nil then
  begin
    m_QjCard.StopCap;
    m_QJCard.Free;
  end;
  setlength(imgconvert, 0);
  if m_TXCard<>nil then m_TXCard.Free;
end;

procedure TForm1.VideoWnd1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inc(m_clicknum);
  if m_clicknum=6 then m_clicknum:=1;
  case m_clicknum of
  1:begin
      LabeledEditlooplt.Text:=inttostr(x);   //左上
      LabeledEditlooptp.Text:=inttostr(y);   //上
    end;
  2:LabeledEditlooprt.Text:=inttostr(x);     //右上
  3:begin
      LabeledEditlooplb.Text:=inttostr(x);  //左下
      LabeledEditloopbtm.Text:=inttostr(y); //下
    end;
  4:LabeledEditlooprb.Text:=inttostr(x);    //右下
  5:LabeledEditloopcpt.Text:=inttostr(y);   //中
  end;
end;

procedure TForm1.ButtonEditSetParamClick(Sender: TObject);
begin
  //ReadLoopParam();//读取线圈位置
  ReadSetParam();//读取线圈设置
  SaveConfig; //保存配置文件
end;

procedure TForm1.ButtonStartClick(Sender: TObject);
var
  QJCard,QJChannel,TXCard,TXChannel:integer;
begin
  if ButtonStart.Caption='采集' then
  begin
    GroupBoxVideoCard.Enabled:=false;
    QJCard:=ComboBoxQJCard.ItemIndex;
    QJChannel:=ComboBoxQJChannel.ItemIndex;
    TXCard:=ComboBoxTXCard.ItemIndex;
    TXChannel:=ComboBoxTXChannel.ItemIndex;

    if QjCard=TXCard then
    begin
      Showmessage('全景和特写卡号重复！');
    end
    else
    begin
      m_QJCard:=TVideoCard.Create(QjCard);
      m_TXCard:=TVideoCard.Create(TXCard);

      m_QJCard.SetChannel(QJChannel);
      m_TXCard.SetChannel(TXChannel);
      //m_QJCard.SetVideoInfo(0,86);//亮度
      //m_QJCard.SetVideoInfo(1,126);//对比度
      m_QjCard.StartCap;
      Timer1.Enabled:=True;
    end;
    ButtonStart.Caption:='停止';
  end
  else if ButtonStart.Caption='停止' then
  begin
    //结束
    GroupBoxVideoCard.Enabled:=true;
    Timer1.Enabled:=false;

    if m_QjCard<>nil then
    begin
      m_QjCard.StopCap;
      m_QJCard.Free;
      m_QJCard:=nil;
    end;

    if m_TXCard<>nil then
    begin
      m_TXCard.Free;
      m_TXCard:=nil;
    end;

    fillchar(g_image,sizeof(g_image),0);
    fillchar(g_imagebg,sizeof(g_imagebg),0);
    fillchar(g_imageTwo,sizeof(g_imageTwo),0);
    VideoWnd1.DrawImage(@g_image[0]);
    VideoWnd5.DrawImage(@g_image[0]);
    VideoWnd6.DrawImage(@g_imagebg[0]);
    VideoWnd8.DrawImage(@g_imagebg[0]);
    m_VLoop.clearbk();
    
    ButtonStart.Caption:='采集';
  end;
end;


procedure TForm1.ButtonBgClick(Sender: TObject);
var
  ll,rr,i,j,ki,kj:integer;
  r,g,b:byte;
  blocksum:real;
begin
  m_QjCard.GetCurDib(@m_bgimage[0]); //采集背景m_bgimage

  //按点计算，根据斜率算出从上到下每一行的左边界点和右边节点
  //并保存线圈区域内的灰度图m_grayimg
  for i:=m_VLoop.m_top_p to m_VLoop.m_btm_p do
  begin
    ll:=m_VLoop.m_la_p[i];
    rr:=m_VLoop.m_ra_p[i];

    for j:=ll to rr do
    begin
      b:=m_bgimage[(i*IMGWIDTH+j)*3];
      g:=m_bgimage[(i*IMGWIDTH+j)*3+1];
      r:=m_bgimage[(i*IMGWIDTH+j)*3+2];
      m_grayimg[i,j]:=(30*r+59*g+11*b) div 100; //R=G=B=0.30*R+0.59*G+0.11*B 加权平均值法
    end;
  end;

  //保存线圈区域内的灰度块值m_grayblk
  for i:=m_VLoop.m_top to m_VLoop.m_btm do
  begin
    ll:=m_VLoop.m_la[i];
    rr:=m_VLoop.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_grayimg[ki,kj];
      end;
      blocksum:=blocksum / (HBLOCKSIZE * WBLOCKSIZE);
      m_VLoop.m_bgblkNow[i,j]:=round(blocksum);
    end;
  end;
  m_VLoop.m_brunflg:=true;
  m_VLoop.showbg();
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  WriteLog(inttostr(g_BgBright));
end;

procedure TForm1.CheckBoxSaveClick(Sender: TObject);
begin
  m_savefile:=CheckBoxSave.Checked;//保存文件
end;

procedure TForm1.RadioGroupTimeClick(Sender: TObject);
begin
  m_daynight:=RadioGroupTime.ItemIndex;//白天晚上判断
  WriteSetParam();
end;

procedure TForm1.ButtonEditLoopParamClick(Sender: TObject);
begin
  ReadLoopParam();//读取线圈位置
  //ReadSetParam();//读取线圈设置
  SaveConfig; //保存配置文件

  fillchar(g_image,sizeof(g_image),0);
  fillchar(g_imagebg,sizeof(g_imagebg),0);
  fillchar(g_imageTwo,sizeof(g_imageTwo),0);
  VideoWnd1.DrawImage(@g_image[0]);
  VideoWnd5.DrawImage(@g_image[0]);
  VideoWnd6.DrawImage(@g_imagebg[0]);
  VideoWnd8.DrawImage(@g_imagebg[0]);
  m_VLoop.clearbk();
end;

end.