这才是我当年写出的一个比较烂的程序 7oL l RU
7202N?a
{
Main2.bas EO'+r[Y
Flpl,|n
a
Attribute VB_Name = "SubMain" n)cc\JPQ
Option Explicit yT% <
t
1;./e&%%
'采集文件与临时文件 mn1!A`$
Public Const TmpFile As String = "d:\30-0600.dat" oBai9 [+
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 :fX61S6)
6R m d t
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long d+P<ce2 G
Public hBCFile As Long '记录采集参数的文件 q@1A2L\Om
Public Const TmpBMP As String = "d:\1.bmp" ajRht +{
Public hTmpFile As Long zhE4:g9v
M97+YM Y)
m?Jnb\0
'采集窗口参数常量 D3 +|Os)
Public Const FrameH As Long = 280& aEQrBs
Public Const FrameW As Long = 768& B7A.~' =
Public Const pFrameSize As Long = FrameW * FrameH rfdA?X{Q0
jY9 tq[~/
'标志区范围，用于识别车辆 QN;NuDHN
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X 56."&0
Public Const mkW As Integer = 28 '识别标志立柱宽度 g0
~m[[
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) +Rd\*b
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) , -d2wzhW
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 LVP6 vs
'车缝检测位置常数 L C RWC`%&
Public Const sSize As Long = 32& 4myikeUR_
Public Const sPos As Long = 310& G|?V}pZ
Public Const sPosL As Long = 200& :n <l0
Public Const sPosR As Long = 500& l+(B~v
'车缝检测框位置 (
K-7z
Public Slice(1 To sSize, 1 To FrameH) As Byte ; mV>k_AG
Public SliceL(1 To sSize, 1 To FrameH) As Byte :'t"kS
Public SliceR(1 To sSize, 1 To FrameH) As Byte z 4. |N
Public avSL As Integer, avSLR As Integer, avSLL As Integer ~&0lWa
N<( rP1)`v
E]{0lG` l
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 %xx;C{g;a
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 !
, ] Fx
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 4u p7 :?
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long !N:w?zsp
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte +CEt:KQ
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 HU
+27
1A8
?~^p:T
brE% /%! e
k?pNmKVJM
'一次连续采集的帧数 r +]a
Public tFrames As Long ,9:v2=C_
S-6i5H"B&
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 mV7_O//
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 t- //.
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize ctb
, w
ieEt C,U
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte $ ga,$G
Public pBuffer(1 To FrameW * FrameH * 2) As Byte * JW.ca}
Public pWorkSpace(1 To FrameW * FrameH) As Long w0>5#j q#r
Public Const pBufferSize As Long = FrameW * FrameH * 2 oPAc6ObOV~
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 I `{=[.c
y#ON= 8l
Public hBoard As Long '采集卡标识 M+=q"#&
Public mBufferAddr As Long '缓存地址 50S*_4R
Public BufferSize As Long '缓存大小(字节) '+|uv7|+v
Public iCurrentCard As Long ,=ju^_^sA
Public CapStatus As Long O> wGJ.
Public iFrames As Long @ bvWqMa
Public currentBr As Byte, currentContr As Byte kYS\TMt,C
) \
cnz
Public hMEM As Long, mStatus As Long
EA:_PBZ
Public Const hMemSize As Long = pFrameSize * 4 l 9 rN!Q|
Public hMemWork As Long bnp:J
|(ld
Public Const hMemWorkSize As Long = pFrameSize * 5 !vr
A\d
z1e +Ob&
}D
~m%%,
odeO(zuU
'串口接收轨道衡数据 >]bS"S
Public WeightFromCom As String ='/#G0W
Public bReceiveComplete As Boolean @$ )C pg
{=^< yK2q
F>u/ Lh!
Public Type GrayBMPHeader '~6l
6wi
Tag As Integer 78mJ3
/?rC
FileLength As Long '文件大小 o5z&sRZ
Reserve1 As Long S@L%X <Vm
DataOffset As Long '图像数据偏移量 s;[64ca]Q
BMPHeaderSize As Long '文件头长 &M\qVL%w
'length of the bitmap info header used to describe the bitmap colors, compression,… :d~&Dt<c
'the following sizes are possible: a- /p/
I-%
'28h - windows 3.1x, 95, nt, … G~lnX^46"
'0ch - os/2 1.x Mm^6*L]
'f0h - os/2 2.x %eu_Pr 6X
,(yaW d6
ImageWidth As Long '图像宽（像素数） n
u>6UjV
ImageHeight As Long '图像高(像素数) u vD*]zX
PlaneNumber As Integer '图像层数 j1@PfKh
bpp As Integer 'bits per pixels '1 - monochrome bitmap WdrMp
'4 - 16 color bitmap w^ $$'5=
'8 - 256 color bitmap Im`R2_( ]
'16 - 16bit (high color) bitmap T6,6lll
'24 - 24bit (true color) bitmap \y/0)NL\
'32 - 32bit (true color) bitmap J:;nN-\j
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) 6 1K:SXj
'1 - rle 8-bit / pixel (also identified by bi_rle4) . w~L0(
'2 - rle 4-bit / pixel (also identified by bi_rle8) xiQd[[(sM
'3 - bitfields (also identified by bi_bitfields) ^6 ,}*@
IMAGESIZE As Long '图像数据字节数 # 4sSt-s&
hResolution As Long '水平分辩率 像素数/米 kb*b|pWlO
vResolution As Long '垂直分辩率 s[*I210
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 0?g& < q
ImportantColors As Long G>^ _&(c@2
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 6nk.q|n:g
End Type $)O\i^T
R<>
uCF0
DV bY
m`3gNox
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader wlX
K2D
Public sRECT As RECT ?7* J4.
QRY7ck:N
28,HZaXhc
Public conn As ADODB.Connection u bi 6=
Public rsTrain As ADODB.Recordset ;xE1#ZT
Public rsOperater As ADODB.Recordset u7u1lx>S
Public rsGoods As ADODB.Recordset '^t(=02J
Public rsGood2 As ADODB.Recordset ^6^A/]
v
Public rsSender As ADODB.Recordset fVBu?<=d
Public rsReceover As ADODB.Recordset | i'w"Tz4
Public rsTrainTMP As ADODB.Recordset A%#."2vq~
0Szt^l 7
~!dO2\X+
'打开采集卡 s[/) v:
'设置参数 dC}4
Er
'设置为实时单帧采集到缓存方式 %aJ8wYj*
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 3D
rW[\
zU>bT20x/
y{qKb:~wv
Sub Main() EO.}{1m=hx
Dim i As Integer, status As Long Z@>WUw@ F
N EM C
InitBMPinfo FiN B$A
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 \o!B:Vb<
BMPHeader.Tag = &H4D42 }Mh`j $
BMPHeader.ImageWidth = FrameW $-]PD`wmY
BMPHeader.ImageHeight = FrameH +?[iB"F
BMPHeader.BMPHeaderSize = &H28 I#t# %!InH
BMPHeader.PlaneNumber = 1 CY.i0
BMPHeader.bpp = 8 cA
B^]j
BMPHeader.Compression = 0 C'0=eel [
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 ^$\#aTyFK
BMPHeader.vResolution = &H1274 oo,3mat2C
BMPHeader.ColorsinBMP = 256 1\Vp[^#Vx
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP 8F`799[p
BMPHeader.DataOffset = Len(BMPHeader) 0bMbM^xV6
For i = 0 To 255
ez *O'U
BMPHeader.Pallate(i) = RGB(i, i, i) jowR!rqf
Next i k
v3V|
BMPHeader.IMAGESIZE = FrameH * FrameW [IuF0$w=dj
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE P0szY"}
>:U{o!N`#_
a`Q KN rA2
MoveMemory BMP1, BMPHeader, Len(BMPHeader) }2_ i<4,L
WG*S: _?
BMP1.ImageWidth = FrameW UXV>#U?
BMP1.ImageHeight = FrameH * 2 Os|F
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight =Cr
F(wVO"
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE kv/m qKVr
4}=Z+tDu>
'确定标志位置,为pilarX, pilarY确定初始值 ehYGw2
PilarW = mkW h|&qWv
PilarH = mkH '此两项为固定值 h`p9H2}0
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) bMF`KRP2
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 xHdv?69,
r)t-_p37
2Y{r2m|o
'连续采集记录文件 {nmBI k2v
' 建立一个缓冲区为页对齐方式的文件 N u9+b"Wr
If Dir(TmpFile) <> "" Then
|/p2DU2
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 0Z~G:$O/i
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) Uv /?/;si
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 $P~Tt 4068
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ,n+~S ^r
Else ?t];GNU`
l
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ S QVyCxcX_
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) c`G~. paY|
End If E./Gt.
Na
If hFile = 0 Then -qndBS
MsgBox TmpFile & ": File Open Error", vbOKOnly |zSoA=7?
Exit Sub oQ8If$a}
End If FZhjI 8+,~
'采集参数记录文件 i/WiSwh:
hBCFile = FreeFile() RjCEo4b-.H
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile P&]
PJt5
GGwHz]1L
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 HTUY|^^D
If hMEM = 0 Then BnLE +X
fStatus = GetLastError < {dV =
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _
(
&Z`P
& "请向技术人员报告该错误代码。", vbOKOnly 9 l9|w4YJs
CloseHandle hFile 2 (sq*!tX
Exit Sub MDKiwT@#
End If xu0pY(n^r
k7Z 1Y!n7
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) ^c]lEo
If hMemWork = 0 Then ZnYoh/
fStatus = GetLastError ~w9ZSSb4
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ q'awV
5 y
& "请向技术人员报告该错误代码。", vbOKOnly | yow(2(F@
'释放已成功分配的内存 |G]M"3^
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) .9;wJ9Bw[
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) e!~x-P5M`
\?.Tq24
CloseHandle hFile
rN^P//
Exit Sub r6eApKZ>f6
End If 6*H F`@(
VjVL/SO/
' Test writing -( ,iwF b
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& |F#L{=B
LK[%}2me
'初始化采集卡参数 q+-Bl
iCurrentCard = -1 CK+_T }+-
hBoard = okOpenBoard(iCurrentCard) x?B 8b-*
Debug.Print hBoard O(Q JiS
If hBoard = 0 Then (t)a u
ExitGrabber m2$Qp{C6H
End DR6 OR B7
End If i^'Uod0d.
okGetBufferSize hBoard, mBufferAddr, BufferSize R+O[,UM^I~
If mBufferAddr = 0 Then UN*XLHio
MsgBox "缓存不存在！"
#/ Qe7:l
ExitGrabber j8ebVq
End If Mw+8p}E
Debug.Print Hex(mBufferAddr), Hex(BufferSize) (Q09$
[3QK BV1\
.)eX(2j\
currentBr = 128: currentContr = 128 !EQMTF= (
'设置视频输入参数 Hh1OD?N )
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 %@d~ )f
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input <+c6CM$#}V
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 p #95Q
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 K+_ $
WT_
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 "ewB4F[
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 _ mw(~r8R
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） BSu
]NOwe
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) ^ g56:j~?
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) WSW,}tFp"
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 )FrXD 3 p
4h[^!up.7
'设置采集参数 %v(\;&@
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 o!+jPwEU
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 4^O'K;$leD
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 c);(+b
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 lx&ME
#~
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 hVcV_
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 qrmJJSJ
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 \WeGO.i-
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 C}{$'#DV2
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 l1qWl
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000
B K1Aq3*)
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 M(2c{TT
Wg+fT{[f|
i`1QR@11
okCloseBoard hBoard )0:@T)G
Sleep 50 t~0}Emgp<(
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 n3kYVAgF
_ % HyXd
'设置数据传送方式 e/<Og\}P/
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 CL$ mK5u
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 ?g$dz?^CK&
U\ A*${
sRECT.Right = -1 '用于获得当前设置值 :8~*NSEFd
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) LAwl9YnG:
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom $fE$j {
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 "K 8 <X
sRECT.Left = 0 S?5z
sRECT.Top = 0 vK?{Z ^J][
sRECT.Right = sRECT.Left + FrameW &<P!o_+eb
sRECT.Bottom = sRECT.Top + FrameH * 2 QDC]g.x
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) v&EHp{8Qd
0#mu[
O
sRECT.Right = -1 '检查新设置值 @: s |X
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) G*|2qX"o
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom u&>o1!c*P
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) `8 Dgk}
i }5
#n
If TESTSignal = False Then {AY `\G
'ExitGrabber |h,a V(Q
End If n2+e C9I
`" E |
y8KJoVP iM
{]}}rx'|P
'设为实时采集状态 v?7.)2XcX
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) ^vmyiF
c!BiGw,;
>_y>["u6J#
'单帧采集 hD>O LoO
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 m"! !)
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) U9KnW]O%"
okCaptureTo hBoard, BUFFER, 0, 1 'single ;ml;{ <jI
'Do While okGetCaptureStatus(hBoard, False) <> 0 5"[Qs|VjA6
' Sleep 20 9* %Uoy:
'Loop Z=Oo%lM6B
okGetCaptureStatus hBoard, True DaW_-:@s
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize 46dh@&
U
'写入768*576测试图象 4V7{5:oa
ArrayToBMP TmpBMP Z;_WU
RJ%~=D
'打开数据库 /EOtK|E
Set conn = New ADODB.Connection \DE`tkV8
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ By 8C-jD
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ b7/1 ]
"; Mode=Read|Write" uL!{xuN
conn.Open y p=2nU"o
:LL>C)(f
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) g=;c*{
frmRecord.Visible = True he/UvMu
frmQuery.Visible = True yS#LT3>l
Load frmReceiveFromComm S) [`Bm
(l.`g@(L
'调试参数 SZCF db
If InStr(UCase(Command()), "/CAPTURE") > 0 Then or u.a
SignalBox.Visible = True sY t8NsQ
End If m#'2
3
If InStr(UCase(Command()), "/COMM") > 0 Then @^vVou_
frmReceiveFromComm.Visible = True > @ulvHL
End If V l!Z|}z
I hvL2 zB
End Sub uE>2 *u\
L44-: 3
Sub ExitGrabber() j`\} xDg
'关闭数据库 =J,aB p
'关闭采集卡 1@ H3!V4
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) mB$r>G/'
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) $b#"Rv
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) 0j1I
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) TZ q']Z)#
okStopCapture hBoard j+n1k^jC
okCloseBoard hBoard qPpC )6 -Q
CloseHandle hFile %cD7}o:u
Close #hBCFile EY(@R2~#J
conn.Close >Z?3dM~ [
End ti'a ^(
End Sub J*8fGR%
;fhFv&`mE
Function ArrayToBMP(ByVal File As String) /0 ,#c2aq
Dim BytesWrite As Long \)ac,i@fy
tLpDIA_8
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ w*ig[{
I
CREATE_ALWAYS, 0&, 0&) gU C v#:
m?_S&/+*
If hTmpFile = 0 Then tWi@_Rlx;
ArrayToBMP = False oSt-w{ !
Exit Function # Vanw !
End If i+&*W{Re
r}P{opn$t
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 74%,v|
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& Pb.-Z@
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN J%3%l5 /
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& Z8Fb
x+~"
S*:b\{[f>
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN i` Es7 }
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& #`/KF_a3\>
v"L<{HN
If BytesWrite < pFrameSize Then :JqH.Sq k
ArrayToBMP = False 7 [5 5
End If Jjz:-Uqq2
lhx6+w
CloseHandle hTmpFile 77OH.E|$
xv9Z~JwH
End Function <!&&Qd-d6H
!h2ZrT9
_
Function ArrayToBMP1(ByVal File As String) H~@E&qd
X LPO_ tD
Dim BytesWrite As Long " 7RQrz
fA f sKO*
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ^zQ;8) ng
CREATE_ALWAYS, 0&, 0&) gQ *0 Mk
v[ru }/4
If hTmpFile = 0 Then
u(SdjLf:
ArrayToBMP1 = False iwL\H a
Exit Function O'" &9
End If z4 8,{H6h
'u$$
scG t
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
Xi5ZQ o!t
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& LI?rz<H!D
lC.Yu$O5
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN {3C~cK{
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& L^)&"6oSa
&?*M+q34
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN Fy<dk}@
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& x9
<cT'
jR\T\r4
If BytesWrite < pBufferSize Then )k3zOKZ;
ArrayToBMP1 = False :a3Pnq$]E
End If "-vm=d~\
JcZs\ fl9
CloseHandle hTmpFile }@}jwi)l
j%b/1@I
End Function w/N.#s^
@
q2Yka
'使用该过程建立的文件要求在用后关闭 Fp-d69 Npo
Public Function ArrayToBMP2(File As String) As Boolean q?&vV`PG5
&-9wU Z
Dim BytesWrite As Long W z3y+I/&
(eN\s98)/
ArrayToBMP2 = True ow
~(k5k:
vI#\ Qe
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ]xA;*b;| h
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) Y ,B0=}
D2~e@J(K
If hTmpFile = 0 Then 7[:9vY
ArrayToBMP2 = False R1X9
Exit Function ~d 7!)c`z
End If ;]MHU/
DVRE ;+Jt
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN w:& m_z#M
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& b3x!tuQn
+is;$ 1rq
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN X # -U
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& U=p,drF,A
yuk64o2QE
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN ./)A6O*#
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& NZ'S~Lr
6 .2_UN^<
If BytesWrite < pFrameSize Then KQ xKU?b1
ArrayToBMP2 = False J
\1&3r|R
End If X<_(gg
&?/h#oF@\
CloseHandle hTmpFile xe2Ap[Y'M
'6fMF#X4F
End Function d$kGYMT"
"a; JQ:
Private Function TESTSignal() As Boolean {Os$Uui37\
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long "W|Sh#JF
Q! ]
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) IC/'<%k
7Rk eV
If extsign = 1 Then 4)-LlYS_d<
TESTSignal = True 3*3WO,9
Else YrjF1
hJ
If extsign = 0 Then G1vWHa7n;f
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly y:D|U!o2V
TESTSignal = False mK PyM<Q
Exit Function R|ViLt y
End If @ P4fR7
End If Ezm ~SY
^x4I
'测试视频输入类型 :p(3Ap2TY
'video type ^$24231^
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 b -@V R
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) MMD4b}p
If videotype = 1 Then .3A66 O~zT
'"隔行信号(Interlaced)" E:(flW=
Else )wo'i]#2:
If videotype = 0 Then \QstcsEt
'"逐行信号(Non-interlaced)" G#8HY VF
Else b|wCR%
If videotype = -1 Then SPe Se/
' "不支持" f$N
udG!S
End If NHUx- IqOX
End If sE-E\+
End If ^/2n[orl5
<u*~RYA2
'测试垂直扫描线数 !t{3IE
'video scanlines WL7R.!P
scanlines = -1 M/ 0!B_(R
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) D&/(Avx.
If scanlines = -1 Then E:f0NV3"1
' "不支持" EMmNlj6
Else v1QE|@
'Trim(Str(ScanLines)) + " 行数/幅" *n N;!*J
End If Gb<)U[Hfd
I7nt <l!
'测试帧频
"44VvpQC
'video field frequency UBrYN'QRNt
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) ~a4htj
If fieldfrq = -1 Then pRD8/7@(B{
'lblSignal(8) = "不支持" ,-&l er~[
Else }?^5\ot u
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" @/ wJW`` ;
End If #]oVVf_
End Function +T+f``RcK
1 +O - g
#q%xJ [
Sub PicIdentify() g9H~\w
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 D!ToCVo
s
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 OnC|9
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 {%'(IJ|5z
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 f:G Zb?Wyd
amK?LDf]
Dim fPTR As Long, cFrame As Long r
Ka 7[/
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer "Git@%80
ce/ Rzid
cV_nYcLkz
cFrame = 0 Lf&p2p ?~c
:O{`!&[>L
uR| Jn)/m(
Do While cFrame < tFrames `B"=\ 0
-wy$ ?Ha
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) @ O5-w
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) m\__F l
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize >o>r@;
.ZFs+8
qU>
frmRecord.RText.Text = Str(cFrame)
;M{ @23?`
frmRecord.RText.Refresh !ui
i|"
}>=k!l{
If CheckMark = True Then X5cl'J(j9
ArrayToBMP TmpBMP YW}q@A Y7
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) K~5Q L/=1
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" Bl 2y~fCA
[iwn"e
DrawSlice /-b )`%Q|Y
- ]~&Pi |
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) WQ<J<$$uu
'If i = vbNo Then ec[S?-
' Exit Do j08}5Eo
'End If :se o0 w ]
'cFrame = cFrame + 1 a=&
a)FR
G)';ucs:,
End If 13I
7ah
DoEvents '`#2'MX G
cFrame = cFrame + 1 scCO iK)
Loop Gmi4ffIb3
End Sub Ka&[
Oz<w
FRQ0tI p
j8$ *$|
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 3gaijVN
DmM<Kkg.J
'如标志区模式反差存在则为TRUE，否则返回FALSE b-'41d}Hn
DKAqQ?fS
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long WLQm|C,
CheckMark = True znw\Dn?g
K3$83%E
'复制标志区 mEm
znA
For i = 1 To mkH Pdmfn8I]%
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW P}KN*Hn.
Next i L"&j(|{
rJ4 O_a5/
For j = 1 To PilarW * PilarH / 2 57Q^ "sl
mTop = mTop + MKpilar(j) '^'vafs-/@
Next j CDQ}C=4
) C5<puh
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH Lo\+T+n
mBot = mBot + MKpilar(j) $*V:; -H
Next j :D 8V*F6P
a?.hvI
mTop = mTop / PilarW / PilarH * 2 [h+MA>%!
mBot = mBot / PilarW / PilarH * 2 ykH?;X u
Kgbgp mW
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 X #j-Ld{j
UJ 1iXV[h"
'平均值极值化 7c1xB.g
For j = 1 To PilarH * PilarW ?1K|.lr
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) !s0 6uh
Next j DnS#
cs~
fHC L sI
mTop = 0: mBot = 0 A,{X<mLFb
For j = 1 To PilarH * PilarW / 2 dq28Y$9~
mTop = mTop + MKpilar(j) 2--" @@
Next j Dj'aWyW'
a ?/GEfd
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW WLd{+y5#
mBot = mBot + MKpilar(j) %| }obiV)
Next j O6NgI2[O
R"EX$Zj^E
"~0m_brf
mTop = mTop / PilarH / PilarW * 3 .8S6;xnkC
mBot = mBot / PilarH / PilarW * 3 Q<3=s6@T
Q"n*`#Yt'
4
7ra`*
If mBot > iWhite And mTop < iBlk Then @tWyc%t
CheckMark = True q{HfT
d
Else OW- [#r
CheckMark = False bYGK}:T8U
End If Q0i.gE we
End Function abh='5H|^|
:3M2zV
cf
Sub Capture1Frame() @cA`del
okCaptureTo hBoard, BUFFER, 0, 1 'single Fd*)1FQKT
okGetCaptureStatus hBoard, True 4d# w}
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize x+x 6F
End Sub Z|K +{{C
{O9 CYP:
"rOe J~4 X
Sub CopyMark(iBlk As Integer, iWhite As Integer) v*SSc5gFG
'复制标志区并返回标志区暗区与亮区的亮度平均值 JziuwL5,
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 yT%"<m6Y*\
obKWnet
'复制标志区 tT'*Uu5
For i = 1 To mkH ?F1NZA[%t
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW U:ggZ`
.
Next i y Q-&+16^
%Sr/'7 K
For j = 1 To mkW * mkH / 2 Mo\LFxx>4{
mTotal = mTotal + MKpilar(j) @,F 8gv*
Next j wWv")dk3i
9>\P]:
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 I ugYlt
q{5wx8_U
mTotal = 0 ,f8<s-y4Sg
For j = mkW * mkH / 2 + 1 To mkW * mkH GoP,_sd\O
mTotal = mTotal + MKpilar(j) =T
;>$&qs
Next j ?Y 7'OlO
Kq@n BkO4
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 5@ecZ2`)+h
swJ3_WhbdT
'背景亮度 `m X bF
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
Dv Cs 5
For i = 1 To 4 * FrameW `,gGmh
bsTotal = bsTotal + BsLine(i) ")'
o5V
Next i u@ tJu'X
bsAV = bsTotal / FrameW / 4 &4Q(>"i
L4
{"$
Q' T
End Sub bmgK6OyVR
rVgz+'rFD[
D 's'LspQ
Sub AdjIMGbright(Optional bInit As Boolean = True) P,r9
<
9ot A5I^v
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） 4bLk+EY4A
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 aG.j0`)%
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 ~N2){0 j4
U]tbV<m %
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer k nrR%e;
2`hc 0
I E
'按标准亮度与对比度采集一帧，确定背景亮度 <NZ ^*]
currentContr = 128 '初始对比度 7cV9xIe^
currentBr = 128 '初始亮度 WPi^;c8
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ,e{( r0
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 0g}+%5]yg
DoEvents N WWag}
Capture1Frame .V G$ `g"
'获得图像上缘4行象素 < 7N 8L
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW -\6nT'P
CopyMark iBlack, iBright '图像标志区亮度 \]ouQR.t@\
For i = 1 To 4 * FrameW MG)wVS<d_
bsTotal = bsTotal + BsLine(i) H=Rqr
Next i {U1
j@pKm
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 GxE"q-G
<
3C ~<
Select Case bsAV ~SgW+sDF u
Case 0 To 60 '夜间通过灯光照明,完全没有背景 fmyyQ|]O"
currentBr = 150 $zS0]@Dj
currentContr = 60 {j
i;~9'Q
Case 61 To 80 '有可见背景 7?a@i; E<
currentBr = 140 h fT HP
currentContr = 70 "~j SG7h
Case 81 To 100 '有清晰背景 D%GB2-j R
currentBr = 128 _i{$5JJ+K2
currentContr = 80 ivg:`$a[
Case 100 To 150 '有明亮背景 qD=o;:~Km
currentBr = 140 '5:30-6:00钟实测数据 }1E'a>^|
currentContr = 50 ]H<5]({F
Case 151 To 180 =67dpQ'y
currentBr = 130 l*_%K}%?V
currentContr = 60 `##qf@ M
Case 181 To 220 '背景全为白色 5$Lo]H
*
currentBr = 110 t)P5bQ+$u9
currentContr = 130 SQ!
wq
Case 221 To 255 '背景全为白色 Tap=K|b ]
currentBr = 100 [ fvip_Pt
currentContr = 100 5[l9`Cn&A
End Select
ji
QJ{yY
M:x?I_JG8
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 ,_;+H*H>"
Case 100 To 150 u=NpL^6 s<
currentBr = currentBr - 10 sk !92mQ
Case 151 To 255 RzCC>-
currentBr = currentBr - 20 Z0*Lm+d9z
End Select f q(r,h=|
3Z=OUhn9
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 CBw/a0Uck
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 vFz%#zk>
End Sub Ylbh_ d~BU
'{=dEEi
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) PkA_uD hw
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long kXimJL_<g
?&$??r^i
For i = 1 To 8 R\k=
CoJJ
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& Y2709LWmP
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& 8:^`r w4a0
Next i ?&#z3c$}
Ncr38~;w
For j = 1 To 1024 Yoi M\gw
L1 = L1 + LeftBK(j, 0) a)J3=Z-
L2 = L2 + LeftBK(j, 1) *fyC@fI>
R1 = R1 + RightBK(j, 0) "8 MG[$Y
R2 = R2 + RightBK(j, 1) EOJ k7
Next j d'ddxT$GG
diffL = Abs(L1 - L2) / 1024 B;xw @:H
diffR = Abs(R1 - R2) / 1024 %"tLs%"7=P
End Sub W/_=S+C
vK
AffVah2o:
Function CheckSlice() As Boolean k[lYd k
CopySlice avSL, avSLR, avSLL [<SM*fQ>t
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then *lHI\5
CheckSlice = True d~+8ui{-U
Else y,&.<Yc
CheckSlice = False #;FHyKx
End If q jcy{@ j
End Function P \<dy?nZ
mUW|4zl i}
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) 9Fb|B
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long `L p3snS
For i = 1 To FrameH }YUUC q&
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize T \%{zz_(
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize Zwy8 SD'L
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize E^ua u=F
Next i [DrG;k ?
For i = 1 To FrameH rmpx8C Y"
For j = 1 To sSize "q@OM f
total = total + Slice(j, i) 3GVE/GtU
totalL = totalL + SliceL(j, i) o=i)s2
totalR = totalR + SliceR(j, i) {TT@Mkz_QC
Next j *>Sb4:
Next i (2J_Y*N~>
avSL = total / FrameH / sSize p ;E zmz
avSLR = totalR / FrameH / sSize '5xf?0@s.
avSLL = totalL / FrameH / sSize -L e:%q2
End Sub ?^]29p_
* :t]|$;E\
Sub DrawSlice() t}m6];
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B hnWo.5;$
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B o('W2Bs-o
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B *zoAD|0N
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) 8B ZTHlUB
End Sub wn *<.s
Sub DrawMark(pic As Control) )=VSERs
Dim i As Long, j As Long P| }~=2J
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B ghvF%-."1
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B N)'oX3?x
For i = 1 To PilarH =
7
U^pT
For j = 1 To PilarW ,4dES|)sP
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) }#~@H M>6Z
Next j MQ;c'?!5[!
Next i 0CXh|AU
End Sub p&1IK8i"
VB6EM|bphl
Function avIMG() As Integer S%KY%hUt
Dim i As Long, j As Long, totalIMG As Long klHOAb1
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize yNp
l0 d
For i = 1 To pFrameSize _4qP0LCa
totalIMG = totalIMG + pBuffer(i) i!
G^=N
Next i
C o6ghH7T
avIMG = totalIMG / pFrameSize vqh@)B+)
End Function (I3:u-A
J u5<wjQR\
Function avRegion(barCol As Integer, barWidth As Integer) As Integer s+Qm/ h2
Dim i As Long, j As Long, totalIMG As Long d>"t* >i]>
For i = 1 To FrameH gQy {OU
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth 8joJ e>9VJ
Next i _E q*
For i = 1 To FrameH * barWidth jR~2mf!h*e
totalIMG = totalIMG + pBuffer(i) ,arFR'u>
Next i
p x;X} Cd
avRegion = totalIMG / pFrameSize o6 f ^DG3*
End Function >XzCHtEP
