⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 these are some texts and original program,they are very useful for transportation reserch.
💻 PAS
字号:
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VideoWnd, videocard, StdCtrls, ExtCtrls,VirLoop,DateUtils,
  ComCtrls, OleCtrls, VCFI, TeEngine, Series, TeeProcs, Chart, Math,extinifile;
  
type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    GroupBox3: TGroupBox;
    VideoWnd1: TVideoWnd;
    CheckBoxSave: TCheckBox;
    Label3: TLabel;
    TimerSave: TTimer;
    GroupBox1: TGroupBox;
    ButtonStart: TButton;
    ButtonEnd: TButton;
    Shape1: TShape;
    Label1: TLabel;
    EditQjCard: TEdit;
    EditSaveTime: TEdit;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonEndClick(Sender: TObject);
    procedure CheckBoxSaveClick(Sender: TObject);
    procedure TimerSaveTimer(Sender: TObject);
  private
    { Private declarations }
    m_QJCard:TVideoCard;
    m_nid:integer; //配置文件读写时的路数标号

    m_bmp:array[0..IMGWIDTH*IMGHEIGHT*3-1] of byte;
  protected
    procedure ConfigSave();//配置文件保存
    procedure ConfigLoad();//配置文件读取

    procedure ConfigRead();//从界面上读取配置文件
    procedure ConfigShow();//将配置文件显示在界面上

    procedure SavebmpFile(var image:array of byte;imgw,imgh:integer;filename:string);

    procedure DrawBmp(var bmp:array of byte;VideoWnd:TVideoWnd); //画位图
    procedure DrawImage(var img:array of byte;VideoWnd:TVideoWnd);overload; //画灰度图
    procedure DrawImage(var img:array of byte;rect:trect;VideoWnd:TVideoWnd);overload; //按区域画灰度图
  public
    { Public declarations }
    procedure HandleImage(image:PByte); //图像处理主程序

  end;

var
  Form1: TForm1;
  g_QjCard:integer = 0;
  g_Cs:TRTLCriticalSection;
implementation

{$R *.dfm}
procedure TForm1.ConfigLoad();
var
  inifile:TExtIniFile;
  section:String;
begin
  CreateDir('.\config\');
  inifile:=TExtIniFile.Create(g_ConfigFile);

  section:=IntToStr(m_nid);
  g_QjCard:=inifile.ReadInteger(section,'全景卡号',g_QjCard);
  inifile.Free;
end;

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

  section:=IntToStr(m_nid);

  inifile.WriteInteger(section,'全景卡号',g_QjCard);

  inifile.Free;
end;

procedure TForm1.ConfigShow();
begin
  EditQjCard.Text := IntToStr(g_QjCard);
end;


procedure TForm1.ConfigRead();
begin
  g_QjCard := StrToInt(EditQjCard.Text);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  InitializeCriticalSection(g_Cs);
  m_nId:=0;

  ConfigLoad; //读取配置文件
  ConfigShow; //配置文件显示
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if m_QJCard <> nil then
  begin
    m_QJCard.StopCap;
    m_QJCard.Free;
  end;

  ConfigRead; //配置文件读取
  ConfigSave; //保存配置文件

  DeleteCriticalSection(g_Cs);
end;

procedure tform1.DrawBmp(var bmp:array of byte;VideoWnd:TVideoWnd); //画位图
begin
  VideoWnd.DrawImage(@bmp[0]);
end;

procedure tform1.DrawImage(var img:array of byte;VideoWnd:TVideoWnd); //画灰度图
var
  showbmp:array[0..IMGWIDTH*IMGHEIGHT*3-1] of byte;
  i,j:integer;
begin
  for j:=0 to IMGHEIGHT-1 do
  for i:=0 to IMGWIDTH-1 do
  begin
    showbmp[(j*IMGWIDTH+i)*3+0]:=img[j*IMGWIDTH+i];
    showbmp[(j*IMGWIDTH+i)*3+1]:=img[j*IMGWIDTH+i];
    showbmp[(j*IMGWIDTH+i)*3+2]:=img[j*IMGWIDTH+i];
  end;
  VideoWnd.DrawImage(@showbmp[0]);
end;

procedure tform1.DrawImage(var img:array of byte;rect:trect;VideoWnd:TVideoWnd); //按区域画灰度图
var
  showbmp:array[0..IMGWIDTH*IMGHEIGHT*3-1] of byte;
  i,j:integer;
begin
  for i:=low(showbmp) to high(showbmp) do showbmp[i]:=0;

  for j:=rect.Top to rect.Bottom do
  for i:=rect.Left to rect.Right do
  begin
    showbmp[(j*IMGWIDTH+i)*3+0]:=img[(j-rect.Top)*(rect.Right-rect.Left+1)+(i-rect.Left)];
    showbmp[(j*IMGWIDTH+i)*3+1]:=img[(j-rect.Top)*(rect.Right-rect.Left+1)+(i-rect.Left)];
    showbmp[(j*IMGWIDTH+i)*3+2]:=img[(j-rect.Top)*(rect.Right-rect.Left+1)+(i-rect.Left)];
  end;
  VideoWnd.DrawImage(@showbmp[0]);
end;


procedure tform1.HandleImage(image:PByte); //图像处理主程序
begin
  //读入图像
  CopyMemory(@m_bmp[0],image,IMGWIDTH*IMGHEIGHT*3);

  Drawbmp(m_bmp,videownd1); //画原图

  //在下面可以添加需要进行的图像处理相关算法




  
end;


procedure TForm1.ButtonStartClick(Sender: TObject);
begin
  m_QJCard:=TVideoCard.Create(g_QjCard);
  //m_QJCard.SetVideoInfo(0,86);//亮度
  //m_QJCard.SetVideoInfo(1,126);//对比度
  m_QjCard.StartCap;
end;

procedure TForm1.ButtonEndClick(Sender: TObject);
begin
  if m_QJCard <> nil then
  begin
    m_QJCard.StopCap;
    m_QJCard.Free;
    m_QJCard := nil;
  end;
end;

procedure TForm1.CheckBoxSaveClick(Sender: TObject);
begin
  TimerSave.Interval := strtoint(EditSaveTime.Text)*1000;
  TimerSave.Enabled := CheckBoxSave.checked;
end;

procedure TForm1.SavebmpFile(var image:array of byte;imgw,imgh:integer;filename:string); //保存位图文件
var
  PicBmp:Tbitmap;
  PicStream:TMemoryStream;
  bmphead:TBITMAPFILEHEADER;
  bmpinfo:TBITMAPINFOHEADER;
  bmpimage:array [0..IMGWIDTH*IMGHEIGHT*3-1]of Byte;
  i,j:integer;
begin
  bmphead.bfType:=$4D42;
  bmphead.bfSize:=imgw*imgh*3+54;
  bmphead.bfReserved1:=0;
  bmphead.bfReserved2:=0;
  bmphead.bfOffBits:=40;

  bmpinfo.biSize:=sizeof(TBITMAPINFOHEADER);
  bmpinfo.biWidth:=imgw;
  bmpinfo.biHeight:=imgh;
  bmpinfo.biPlanes:=1;
  bmpinfo.biBitCount:=24;
  bmpinfo.biCompression:=BI_RGB;
  bmpinfo.biSizeImage:=0;
  bmpinfo.biXPelsPerMeter:=0;
  bmpinfo.biYPelsPerMeter:=0;
  bmpinfo.biClrUsed:=0;
  bmpinfo.biClrImportant:=0;

  PicStream:=TMemoryStream.Create;
  PicBmp:=TBitmap.Create;

  //保存位图
  PicStream.Clear;
  PicStream.Write(bmphead,14);
  PicStream.Write(bmpinfo,40);

  for i:=0 to IMGHEIGHT-1 do
  for j:=0 to IMGWIDTH-1 do
  begin
    bmpimage[(i*IMGWIDTH+j)*3+0]:=image[((IMGHEIGHT-1-i)*IMGWIDTH+j)*3+0];
    bmpimage[(i*IMGWIDTH+j)*3+1]:=image[((IMGHEIGHT-1-i)*IMGWIDTH+j)*3+1];
    bmpimage[(i*IMGWIDTH+j)*3+2]:=image[((IMGHEIGHT-1-i)*IMGWIDTH+j)*3+2];
  end;

  PicStream.Write(bmpimage,imgw*imgh*3);
  PicStream.Seek(0,0);
  
  PicBmp.LoadFromStream(PicStream);
  PicBmp.SaveToFile(filename);

  PicStream.Free;
  PicBmp.Free;
end;

procedure TForm1.TimerSaveTimer(Sender: TObject);
var

  savetime:TDateTime;
  timename:string;
  bmpfile:string;
begin
  EnterCriticalSection(g_Cs);

  Shape1.Brush.Color := not Shape1.Brush.Color;

  if not DirectoryExists('.\pic\') then CreateDir('.\pic\');
  savetime:=Now;
  timename:=inttostr(YearOf(savetime))+'-'+inttostr(MonthOf(savetime))+'-'+inttostr(DayOf(savetime))+' '+
            inttostr(Hourof(savetime))+'-'+inttostr(MinuteOf(savetime))+'-'+inttostr(SecondOf(savetime));

  //保存BMP图
  bmpfile:='.\pic\'+timename+'.bmp';
  SavebmpFile(m_bmp,IMGWIDTH,IMGHEIGHT,bmpfile);

  LeaveCriticalSection(g_Cs);
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -