这才是我当年写出的一个比较烂的程序 I!Mkss xc
KTwP.!<v
Main2.bas SLp nVD:'1
0uIBaW3s
Attribute VB_Name = "SubMain" s(e1kk}"
Option Explicit |?hsMN
irP*:QM
'采集文件与临时文件 4n1 g@A=y
Public Const TmpFile As String = "d:\30-0600.dat" `b%^_@Fb
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 F
Yb]9MX
N8=-=]0G
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long L+eK)Q
Public hBCFile As Long '记录采集参数的文件 'I :_}q
Public Const TmpBMP As String = "d:\1.bmp" 87m`K Str7
Public hTmpFile As Long Hs{x Z :
mx#)iHY
#%L_wJB-
'采集窗口参数常量 j?g#8L;W\w
Public Const FrameH As Long = 280& hegH^IN M
Public Const FrameW As Long = 768& T_# 8i^;D
Public Const pFrameSize As Long = FrameW * FrameH IRTWmT
jT
B?Rkz
'标志区范围，用于识别车辆 7xR:\FBa^
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X 8iM:ok
Public Const mkW As Integer = 28 '识别标志立柱宽度 n xR\tBv
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) nc1?c1s,f
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) .~T I%&#
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 F&B E+b/#
'车缝检测位置常数 jVHS1Vsei
Public Const sSize As Long = 32& W|(<z'S
Public Const sPos As Long = 310& y=jZ8+M
Public Const sPosL As Long = 200& }*O8] lG
Public Const sPosR As Long = 500& *SlWA)9 Y
'车缝检测框位置 O^ 5 C
Public Slice(1 To sSize, 1 To FrameH) As Byte =k
;
X}/
Public SliceL(1 To sSize, 1 To FrameH) As Byte (cV1Pmn
Public SliceR(1 To sSize, 1 To FrameH) As Byte |;^$IZSsz
Public avSL As Integer, avSLR As Integer, avSLL As Integer u9u'5xAO
7Jd&9&O U
[nlq(DGJhp
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 \ Co
Z+
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 t< RPDQ>
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 )-Z*/uF^
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long e@S\7Ks
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte A
PrrUo
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 :nfy=*M#
k ~F ,n
J)|I/8!#
U Ua@7|x
'一次连续采集的帧数 [xQ.qZ[h&
Public tFrames As Long 2izBB,# "
}lCQ+s !
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 pbIVj3-lY
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 <q Q@OUI
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize 5 +j):_
B~J63 Os/
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte ;e9&WEG_\
Public pBuffer(1 To FrameW * FrameH * 2) As Byte V|*3*W
Public pWorkSpace(1 To FrameW * FrameH) As Long 9l:[jsk<d
Public Const pBufferSize As Long = FrameW * FrameH * 2 XQ mg^x[,A
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 * P&lAyt6
ZwiXeD+4
Public hBoard As Long '采集卡标识 J3B+W D]
Public mBufferAddr As Long '缓存地址 2=%]Ax"R
Public BufferSize As Long '缓存大小(字节) }o\} qu*
Public iCurrentCard As Long `B,R+==G:
Public CapStatus As Long !89hO4 0r
Public iFrames As Long Ekh)l0
l
Public currentBr As Byte, currentContr As Byte fzAkUv
o
madb l0[y.
Public hMEM As Long, mStatus As Long TI0=nfj
Public Const hMemSize As Long = pFrameSize * 4 91DevizXx
Public hMemWork As Long {xTh!ih2 -
Public Const hMemWorkSize As Long = pFrameSize * 5 x}=Q)| )]
} :gi<#-:G
WP=
uH g
B}K<L\S
'串口接收轨道衡数据 Og?GYe^_
Public WeightFromCom As String <7zz "
R
Public bReceiveComplete As Boolean ,]y_[]636
Y{Lxo])e
/zr)9LQY0
Public Type GrayBMPHeader e AaS }g
0
Tag As Integer 0}|%pm Y`
FileLength As Long '文件大小 NLUO{'uUW
Reserve1 As Long '(ZT } N
DataOffset As Long '图像数据偏移量 =WEDQ\ c
BMPHeaderSize As Long '文件头长 m9 ]Ge]
'length of the bitmap info header used to describe the bitmap colors, compression,… JNP6qM
'the following sizes are possible: 0%,?z`UY
'28h - windows 3.1x, 95, nt, … 5KIhk`S
'0ch - os/2 1.x Hw6 2'%
'f0h - os/2 2.x ?s R(
l
)'*jZ
ImageWidth As Long '图像宽（像素数） z
sR5"Vi=
ImageHeight As Long '图像高(像素数) -Rr !J37
PlaneNumber As Integer '图像层数 ^upd:q
bpp As Integer 'bits per pixels '1 - monochrome bitmap c>Ri6=C
'4 - 16 color bitmap Ll VbY=EX7
'8 - 256 color bitmap S@y?E}
'16 - 16bit (high color) bitmap rV?@Kgxi
'24 - 24bit (true color) bitmap Vs
Z7 n~e
'32 - 32bit (true color) bitmap -. L )\
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) 6$zd2N?
'1 - rle 8-bit / pixel (also identified by bi_rle4) Vn\jUEC
'2 - rle 4-bit / pixel (also identified by bi_rle8) : )kHXOb.
'3 - bitfields (also identified by bi_bitfields) 2Uu!_n}tNF
IMAGESIZE As Long '图像数据字节数 g1]bI$;
hResolution As Long '水平分辩率 像素数/米 }wI +e Mr
vResolution As Long '垂直分辩率 2 OqEyXh
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 v yt|x 5
ImportantColors As Long tx Qr|\4k
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 B@ ms Gb C
End Type .CNwuN \
x5rLGt
W1ndb:
vj]h[=:
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader H^vA}F`
Public sRECT As RECT }([}A`@
bQ&%6'ck
&5[+p{ 2
Public conn As ADODB.Connection %c%`< y<~L
Public rsTrain As ADODB.Recordset g`tV^b")
Public rsOperater As ADODB.Recordset pRUQMPn (
Public rsGoods As ADODB.Recordset 8 @RJ>
Public rsGood2 As ADODB.Recordset Md8<IFi9]Q
Public rsSender As ADODB.Recordset SwaPRAF
Public rsReceover As ADODB.Recordset Y]5MM:mI
Public rsTrainTMP As ADODB.Recordset A]drNFE
1s(i\&B
q!~DCv df
'打开采集卡 T[c-E*{hR
'设置参数 d<WNN1f
'设置为实时单帧采集到缓存方式 8U7d d[
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 zz(EH<>
tCPK_Wws?Z
,}9
tJY@ E
Sub Main() 4]-
7S l,
Dim i As Integer, status As Long _j*I\
3\C +g{}e
InitBMPinfo hF`<I.z}
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 {+3g*s/HI
BMPHeader.Tag = &H4D42 AS[j)x !
BMPHeader.ImageWidth = FrameW T2
1?~jS
BMPHeader.ImageHeight = FrameH [/l&:)5W>
BMPHeader.BMPHeaderSize = &H28 \+0l #t$
BMPHeader.PlaneNumber = 1 p _3xW{I
BMPHeader.bpp = 8 ,) aUp4*
BMPHeader.Compression = 0 8!@}\ 6qM
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 nE2?3 S>
BMPHeader.vResolution = &H1274 d>Nh<PqH6
BMPHeader.ColorsinBMP = 256 <(yAat$H
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP A>H CX 4i
BMPHeader.DataOffset = Len(BMPHeader) x"cB8bZ!$
For i = 0 To 255 `O;4 b#!g
BMPHeader.Pallate(i) = RGB(i, i, i) }z|9F(I
Next i 5g$>J)Ry
BMPHeader.IMAGESIZE = FrameH * FrameW hTcU
%Nc
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE nHp(,'R/
={;+0Wjb8
t~44ub6GN`
MoveMemory BMP1, BMPHeader, Len(BMPHeader) ?IoA;GBg
W5~!)Ec
BMP1.ImageWidth = FrameW ;d_<6|*M
BMP1.ImageHeight = FrameH * 2 kLpq{GUv:
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight 6s
~!B {Q
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE dJdOh#8+Xi
nV`W0 r(f'
'确定标志位置,为pilarX, pilarY确定初始值 X\i;j!;d
PilarW = mkW {z;4t&5
PilarH = mkH '此两项为固定值 K8_\U0 K
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) c++q5bg@)
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 <s$T7Zk
8#o2 qQ2+
b ):aqRwP
'连续采集记录文件 Sq:J'%/z
' 建立一个缓冲区为页对齐方式的文件 1?.NJ<)F
If Dir(TmpFile) <> "" Then Kltqe5
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ tF./Jx]_
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) u`Y~r<?P(
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 B7 'yc`)H
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ELG9ts+5Uj
Else obPG]*3
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ y0/FyQs
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ]!a? Lr
End If p{ ``a=
If hFile = 0 Then ]&`=p{Z
MsgBox TmpFile & ": File Open Error", vbOKOnly U;" J8
Exit Sub _>?.MUPB
End If ASr@5uFR
'采集参数记录文件 s<a G
hBCFile = FreeFile() n.R
"n9v`
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile .j=mT[N,I
!$!%era`
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 PAx R?2m{
If hMEM = 0 Then ]<c\+9
fStatus = GetLastError b *{U O
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ ?5,I`9
& "请向技术人员报告该错误代码。", vbOKOnly
:Gx5vo
CloseHandle hFile tDfHO1pS
Exit Sub >J_ P[v
End If )UVe kkq>Q
XD_!5+\H1
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) |YfJ#Agm+
If hMemWork = 0 Then !@ y/{~Gu
fStatus = GetLastError /W LZyT2
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 3TS:H1n
& "请向技术人员报告该错误代码。", vbOKOnly F2EX7Crj
'释放已成功分配的内存 acQHqR
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) ,ei=w,O
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) \C$cbI =;+
HS\'{4 P
CloseHandle hFile eV }H
Exit Sub vL^ +X`.td
End If "pH;0[r]
D k8@x8
' Test writing h (4\k?C5
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& U}5]Vm$]
~ t N/
'初始化采集卡参数 rls{~ZRl
iCurrentCard = -1
dxtG3
hBoard = okOpenBoard(iCurrentCard) {y%@1q%"
Debug.Print hBoard XV`8Vb
If hBoard = 0 Then up0=Y
o@
ExitGrabber "}H2dn2n
End yF |+oTp
End If 8s-X
H
okGetBufferSize hBoard, mBufferAddr, BufferSize "ctZ"*
If mBufferAddr = 0 Then OK47Q{.gh
MsgBox "缓存不存在！" 4T
v=sP
ExitGrabber J |U FuD
End If (NJ .\m
Debug.Print Hex(mBufferAddr), Hex(BufferSize) *&
R|0I{>
}m7$,'C%P
^D9 w=f#a
currentBr = 128: currentContr = 128 DnW/q
'设置视频输入参数 0[N1SY\lj
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 { k[dg0UV
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input eX!yIqAR
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 _9R j,
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 9 - 24c
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 H\9ePo\b~
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 q(1hY"S"}b
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） GZY:EHuz[
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) lLglF4
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) mQ:YHtHE.F
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 {eQijW2Z3
BlcsDB =ka
'设置采集参数 ,]das
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 }1lZW"{e[
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ' m-5
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度
=Mxu,A
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 l
m(mY$B*_
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 9jNh%raG|
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 } qZ^S9
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 xh!T,|
IR
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 JLjs`oq h
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 aH8]$e8_,\
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 C',uY7}<
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 -9o7a_Z
>RpMw!NT
AI9922}*
okCloseBoard hBoard K,
*-Y)v2W
Sleep 50 YN
KvR
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 \$F#bIjC
Cn5;h(r
'设置数据传送方式 *O) i)["
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 y-gXGvZ
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 _u6MSRX[6$
/WK1( B:
sRECT.Right = -1 '用于获得当前设置值 I
}8b]
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) RUVrX`u*(
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 6VJS
l%X
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 Nei i$
sRECT.Left = 0 W{j(=<|<
sRECT.Top = 0 ]k+(0
qxG
sRECT.Right = sRECT.Left + FrameW KDA2
H>
sRECT.Bottom = sRECT.Top + FrameH * 2 ]&P 4QT)f
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Hc8!cATQ k
{/>uc,8O
sRECT.Right = -1 '检查新设置值 2:e7'}\D.
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) %,aSD#l`f
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom EV-# E
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) *m`x/_y +
'SrDc'?
If TESTSignal = False Then %P(2uesd
'ExitGrabber Dqd2e &a\
End If HYY+Fv5
8=?U7aw
%5@>
nC?`[
t"e %'dFv
'设为实时采集状态 (*V!V3E3#
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) kr!>rqN5
Ag8lI+
h
(<}?}{YX 0
'单帧采集 !:tr\L {
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 4-$kc wA
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) _?$w8 S%
okCaptureTo hBoard, BUFFER, 0, 1 'single D-x*RRkpp
'Do While okGetCaptureStatus(hBoard, False) <> 0 hPCSAo!|
' Sleep 20 v!3Oq.ot
'Loop M &H,`gm
okGetCaptureStatus hBoard, True 8+32hg@^F
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize ej=}OH4
'写入768*576测试图象 `G:hC
5B
ArrayToBMP TmpBMP G{Uqp'=G
Wc;N;K52
'打开数据库 h%v qt~0
Set conn = New ADODB.Connection @3FQMs4
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ $*Wa A`(U
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ 1|:;~9n<t
"; Mode=Read|Write"
gi)C5
J4
conn.Open fGe"1MfU
+~M.Vs X
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 7| j
rk
frmRecord.Visible = True %kgT=<E '
frmQuery.Visible = True C 20VSwd
Load frmReceiveFromComm r@wE ?hK
m#RMd,'X
'调试参数 TB84}
If InStr(UCase(Command()), "/CAPTURE") > 0 Then `49!di[
SignalBox.Visible = True ((^v sKT
End If |8
GLS4.]t
If InStr(UCase(Command()), "/COMM") > 0 Then ^BW8zu@=O
frmReceiveFromComm.Visible = True 1(% 6X*z
End If #cb9g
ejbtdU8N<
End Sub 8H8Q
r /HG{XH`
Sub ExitGrabber() Kq+vAp).
'关闭数据库 ?`6Mfpvj96
'关闭采集卡 ;<xPzf
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Vf=,@7
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) 'GO *6$/
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) u
bZ`Y$
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) J{L d)Q,^
okStopCapture hBoard Fx)><+-
okCloseBoard hBoard Ay% ]l| Gm
CloseHandle hFile ) M(//jX
Close #hBCFile P\z1fscnK
conn.Close g9d/ nR X&
End ~*Y/#kPY
End Sub lh!8u<yv*
o? K>ji!
Function ArrayToBMP(ByVal File As String) O
-P`HKr
Dim BytesWrite As Long .SSPJY(
*/$] kE
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ .G"T;w 6d
CREATE_ALWAYS, 0&, 0&) 5-S -r9
HW" 5MZ8E
If hTmpFile = 0 Then 'A1y~x#2B
ArrayToBMP = False -Hy>
z
Exit Function _) 4zm
End If A.r.tf}:
%>y!N!.F
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN x@pzgqi3
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& O(_f&a
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN s t#^pWL
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& mJH4M9WJ]
]5MT-qU
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN Q
t rU_c2k
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& + EKp*Vje
%+UTs
'I
If BytesWrite < pFrameSize Then zgn`@y 2
ArrayToBMP = False z(>:LX"xz
End If ]I;owk,
-OKXfN]
CloseHandle hTmpFile gI@nE:(m
IA}.{zY~|
End Function _eH@ G(W(
.v9i|E=<~
Function ArrayToBMP1(ByVal File As String) 3Gw*K -.
DQ0 UY
Dim BytesWrite As Long Q^?$2ck=
%O7?:#_
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ %%h.`p1
CREATE_ALWAYS, 0&, 0&)
;CV'
'[HU!8F
If hTmpFile = 0 Then )5o6*(Y
ArrayToBMP1 = False w[EE
A_\
Exit Function %z"$?Iv
End If PMvm4<
T ~p>Ed 9
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN kY'C'9p
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& x_/H
$%ww$3
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN $d&7q 5[
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& v^[!NygShs
2o W'B^-
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN &[yYgfsp
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& DLe>EU;vS
<\d2)I v
If BytesWrite < pBufferSize Then 2& A
X_#P
ArrayToBMP1 = False c]ga) A(
End If ~i>'3j0@k
V=Bm pg
CloseHandle hTmpFile ^nQJo"g\
eQqCRXx
End Function wGHVq
fm5
87KSV"IU8
'使用该过程建立的文件要求在用后关闭 "Zm
xHMf
Public Function ArrayToBMP2(File As String) As Boolean `;m0GU68
UM 0#S}
Dim BytesWrite As Long j2 >WHh
Cwji,*
ArrayToBMP2 = True \fYPz }wt
(@ O,U
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ @9 k/od@mW
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) zNEN[
?4R q +
If hTmpFile = 0 Then l9
H-N*Wx
ArrayToBMP2 = False 8Kn}o@Yd
Exit Function :
>$v @d
End If y Dpv+6(a
/~?[70B }E
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ?b(DDQMf
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& |;U3
pq)
Oj2=& uz
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN f.R;<V.)
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& ?~]mO
v>
";n%^I}
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN n~i^ +pD@
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& v)*eLX $
5\ }QOL
If BytesWrite < pFrameSize Then .l,NmF9
ArrayToBMP2 = False Ct3+ga$
End If !wro7ilMB
1D~B\=LL}
CloseHandle hTmpFile u =(.}
NG4@L1f%
End Function Vu<mOuh
s(MdjWw
Private Function TESTSignal() As Boolean q s9r$o.\l
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long
?9*[\m?-
Y
&i&H=U
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) ZMK1V)ohn
-W|~YK7e
If extsign = 1 Then S@4bpnhK
TESTSignal = True zT hut!O
Else -, $:^ 4
If extsign = 0 Then HEK ?z|Ne
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly bW3Ah ?0N
TESTSignal = False z
34+ 1d
Exit Function T%YN( f
End If ;\T~Hc}&;
End If ^vOEG;TR<-
B5;94YIN
'测试视频输入类型 e.!~ 7c_z?
'video type ZCf
d<NS?
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 oL9ELtb ]s
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) 1X?q 4D"
If videotype = 1 Then KkR.p,/
'"隔行信号(Interlaced)" S7R*R}
Else H;Fz Wcm
If videotype = 0 Then }F3}"Ik'L
'"逐行信号(Non-interlaced)" iciRlx.$c
Else QX. U:p5C
If videotype = -1 Then Z/;8eb*B7
' "不支持" g+ C~}M_7
End If ;*20b@
End If ya;(D 8x)
End If Nk9w ;
z&
T 7M
];@q
'测试垂直扫描线数 q+lCA#Sx
'video scanlines a6/E TQ
scanlines = -1 Ti#x62X{
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) Jp~[D m
If scanlines = -1 Then Y@b|/+
' "不支持" 7~H$p X
Else ~UsE"5
'Trim(Str(ScanLines)) + " 行数/幅" #"o`'5
End If QC fR2Nn}
SMQC/t]HT
'测试帧频 2n Sz0 .
'video field frequency ^4{{ +G)j
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) n+Ng7
If fieldfrq = -1 Then H\|H]: CE
'lblSignal(8) = "不支持" hXx:D3h
Else u$ ^r(.EV
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" eHyIFoaC/
End If g{m~TVm'
End Function 9*CRMkPrd
m`@~ZIa?>B
\Fu(IuD
Sub PicIdentify() z7Z!wIzJ
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 Uz `OAb
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 1 _G+sDw$
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 hCj8y.X|E(
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 ORfMp 'uP=
R ggZ'.\
Dim fPTR As Long, cFrame As Long )Qo^ Mz
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer H.[( `wi!I
!Jaj2mS.N
,Fu[o6x<^
cFrame = 0 ip*UujmNyR
.5#+)] l
!nF.
whq
Do While cFrame < tFrames R>,_C7]u
9}d^ll&
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) D:N\K/p
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) *
a VT
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize e&9v`8}
T<mP.T,$!
frmRecord.RText.Text = Str(cFrame) 1EliR uJ
frmRecord.RText.Refresh _
wZr
`E)
M7(]NQ\TQ
If CheckMark = True Then : p7PiqQ
ArrayToBMP TmpBMP @^b>S6d "
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) cvV8 ;
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" o~V Z%B
m!Aw,*m+*
DrawSlice BR~+CBH
Ja%i sIdh
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) }y%mG&KSz
'If i = vbNo Then _^F%$K6
' Exit Do $oi8 <8Y
'End If v0%FG9Gk
'cFrame = cFrame + 1 nA+gqY6 6|
$ Vsf? ID
End If 0 8nA} +k
DoEvents p4Xhs@.k
cFrame = cFrame + 1 Dh9C9<Ta:
Loop "s\himoa
End Sub NcIr;
}
XeAH.i<
G-DOI
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean Qgl5Jr.
Ys@\~?ym+
'如标志区模式反差存在则为TRUE，否则返回FALSE I"WmDC`1
P m| S >r
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long ban;HGGNG{
CheckMark = True qK&h$;~*y
2K{)8 ;^
'复制标志区 vVbS
4_
For i = 1 To mkH |b|bL 7nx
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 4/&.N]
Next i '5P:;zw
?a ~#`<
For j = 1 To PilarW * PilarH / 2 `Fb%v Y f
mTop = mTop + MKpilar(j) Mbtk:GuY
Next j PkF'#W%
n<>]
7-
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH RM!VAFH
mBot = mBot + MKpilar(j) F' njtrO3
Next j 3MHByT %
e]7J_9t@
mTop = mTop / PilarW / PilarH * 2 ^<Sy{KY
mBot = mBot / PilarW / PilarH * 2 ER<Z!*2
a &hj|
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 sTECNY=l
W0# VD e]>
'平均值极值化 va;fT+k=
For j = 1 To PilarH * PilarW x<
) T,c5Y
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) K`kWfPwp
Next j VCUsvhI
G5$YXNV
mTop = 0: mBot = 0 q>VvXUyK,
For j = 1 To PilarH * PilarW / 2 (KphAA8
mTop = mTop + MKpilar(j) PtOYlZTe?
Next j XC[bEp$
B|- W
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW {Ytqs(`
mBot = mBot + MKpilar(j) y~r
tYI
Next j l'"Ici#7Ls
V}q=!zz
2L7ogyrU/A
mTop = mTop / PilarH / PilarW * 3 ^FK-e;J
mBot = mBot / PilarH / PilarW * 3 sW@_q8lG
}[By N).
NO.5Vy
If mBot > iWhite And mTop < iBlk Then C*Dco{
EQ>
CheckMark = True J-~:W~Qx4N
Else _RG2I)P
CheckMark = False oBWa\N
End If r59BBW)M
End Function qD5)AdCGO
ajD/)9S
Sub Capture1Frame() #lx(F 3
okCaptureTo hBoard, BUFFER, 0, 1 'single ,<=_t{^
okGetCaptureStatus hBoard, True - !s=`9o
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize 3}i(i0+
End Sub _z& H O
3x
E^EXV
lD ?]D&
Sub CopyMark(iBlk As Integer, iWhite As Integer) ??g
=
`yH
'复制标志区并返回标志区暗区与亮区的亮度平均值 *6]_ 6xO
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long, mMid As Single, bsTotal As Long l gTw>r
/Au7X'}
'复制标志区 uS NlI78D
For i = 1 To mkH Kl*/{&,P
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW /m+.5Qz9)@
Next i ~@'DYZb-
H
7iH%1f
For j = 1 To mkW * mkH / 2 mUwGr_)wj
mTotal = mTotal + MKpilar(j) I <$m%
Next j #80r?,q
w;V+)r?w
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 ]{pH,vk-
||r Z +<
mTotal = 0 #(r1b'jfP
For j = mkW * mkH / 2 + 1 To mkW * mkH &=v5M9GR]
mTotal = mTotal + MKpilar(j) s"0Hz"[^=
Next j 8"J6(KS
4
_Idf
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 nb U?:=P
~> 5
'背景亮度 | <
- t
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW Trml ?zexD
For i = 1 To 4 * FrameW W^1)70<y
bsTotal = bsTotal + BsLine(i) 6i*LP(n
Next i ^ V8?6E
bsAV = bsTotal / FrameW / 4 QQX7p!~E
3aEO9v,n
End Sub
VKHzGfv
a O(&<
Cq<k(TKAX
Sub AdjIMGbright(Optional bInit As Boolean = True) h2o u ]
b
@)nB
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） O| 0} m
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 -|/*S]6kK
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 Rj
/ y.g
^a;412
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer WD?COUEox
J" yq)0
'按标准亮度与对比度采集一帧，确定背景亮度 vN`JP`IBx
currentContr = 128 '初始对比度 -y )g}D%
currentBr = 128 '初始亮度 DV jsz
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 + ZPn[|
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 w XU
gxa
DoEvents X6EnC5 7
Capture1Frame =_,j89E
'获得图像上缘4行象素 KvuM{UI5
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 3 bl l9Ey
CopyMark iBlack, iBright '图像标志区亮度 WlnS.P\+E
For i = 1 To 4 * FrameW C t9*T`Gl
bsTotal = bsTotal + BsLine(i) "$N 4S9U
Next i "l
1z@
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 C:
a</Sl
=42NQ{%@;
Select Case bsAV e2M jV8Bs
Case 0 To 60 '夜间通过灯光照明,完全没有背景 ^
&VN=Y6z
currentBr = 150 B3V+/o6
currentContr = 60 Eilo;-E
l
Case 61 To 80 '有可见背景 bODyJ7=[
currentBr = 140 $3{ I'r]
currentContr = 70 c$
R<j'7
Case 81 To 100 '有清晰背景 _qq>-{-Ym
currentBr = 128 Z}$ 1~uyw
currentContr = 80 U#F(%b-LC
Case 100 To 150 '有明亮背景 N PE7AdB8
currentBr = 140 '5:30-6:00钟实测数据 ]Kp -2KW
currentContr = 50 ^uWj#
Case 151 To 180 2B= +p8 3<
currentBr = 130 "AHuq%j
currentContr = 60 t$b {zv9C
Case 181 To 220 '背景全为白色 jI,?*n<
currentBr = 110 /
7yd&6`I
currentContr = 130 hquN+eIDH
Case 221 To 255 '背景全为白色 r*W&SU9Z
currentBr = 100 !i?aRI/6
currentContr = 100 SI/p8 ^
End Select S *K0OUq
&8QkGUbS<
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 d0N/!;
Case 100 To 150 K{]\}7+
currentBr = currentBr - 10 $ D(q
Case 151 To 255 q wHP8GU
currentBr = currentBr - 20 ;2 iDa
End Select aDjYT/`l
'V(9ein^Q
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 (,
2U?p
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 >Mk#19j[/
End Sub 8Z(\iZ5Rgj
e^Glgaf
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) b n
0Rv
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long 5tm:|.`SQ
t%]b`ad
For i = 1 To 8 iGsD!2
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128&
NUGiDJ+[
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& dZ'H'm;,!
Next i 6B`,^8Lp
}n$I #G}\/
For j = 1 To 1024 xX2/uxi8
L1 = L1 + LeftBK(j, 0) :V:siI
Dn
L2 = L2 + LeftBK(j, 1) )VFS&|#\
R1 = R1 + RightBK(j, 0) PZ O8< d
R2 = R2 + RightBK(j, 1)
!yf7y/qY
Next j =fy'w3m
diffL = Abs(L1 - L2) / 1024 o.KE=zp&z
diffR = Abs(R1 - R2) / 1024 mA0|W#
NB
End Sub !eGUiE=
tf?"AY4
Function CheckSlice() As Boolean </)QCl' d
CopySlice avSL, avSLR, avSLL y_N h5
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then CeW}z kcT
CheckSlice = True RWINdJZ
Else
'' Pfs<!
CheckSlice = False vB1nj<]&z
End If 5Z(#)sa0Og
End Function C+Pw
h9WyQl7
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) AWz|HF#-
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long F )hUT@
For i = 1 To FrameH pJ H@v
&a
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize be:=-B7!
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize 1c}LX.9 K
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize !vH={40 ]
Next i 3C(V<R?
For i = 1 To FrameH oq9gG)F
For j = 1 To sSize BZAF;j
total = total + Slice(j, i) .+dego:
totalL = totalL + SliceL(j, i) X16r$~Pb
totalR = totalR + SliceR(j, i) wGAeOD
Next j Q@? {|7:
Next i yU< "tg E
avSL = total / FrameH / sSize ) >8 k8E
avSLR = totalR / FrameH / sSize {
^
@c96&
avSLL = totalL / FrameH / sSize uw9w{3] 0f
End Sub C'xWRS DO
lxXIu8
Sub DrawSlice() fIm=^}?fwK
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B 1ppU
?#
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B P_%kYcX'
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B }- 15^2
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) u13v@<HGc
End Sub ,U#FtO e c
Sub DrawMark(pic As Control) 3pI )
Dim i As Long, j As Long E j/P: nB
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B .[>UkM0
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B %n:ymc
$}
For i = 1 To PilarH 95hdQ<W
For j = 1 To PilarW 7 DCu#Y[
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) 5!}fd/}Uk
Next j W,s
Pg\G 3
Next i @sLB
_f
End Sub k{w
_
cD-E.E%
Function avIMG() As Integer C+X- Cp
Dim i As Long, j As Long, totalIMG As Long )SsO,E+t=U
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize f^9 ntos|
For i = 1 To pFrameSize z) XI A)i6
totalIMG = totalIMG + pBuffer(i) pQ9~ ^
Next i xzOM\
Nq?O
avIMG = totalIMG / pFrameSize $%0A#&DVh
End Function X(fT[A_2C
^D O Q+
Function avRegion(barCol As Integer, barWidth As Integer) As Integer J#*R]LU|
Dim i As Long, j As Long, totalIMG As Long C &-]Rf
fA
For i = 1 To FrameH :` 20i*
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth F@
Cxjz
Next i G.sf>
.[
For i = 1 To FrameH * barWidth 8c0ugM
totalIMG = totalIMG + pBuffer(i) C#D8
E.W
Next i 6`U]%qx_I
avRegion = totalIMG / pFrameSize e{7 "7wn=
End Function |&0zAP"\
