这才是我当年写出的一个比较烂的程序 xG~-.
J'cE@(US
Main2.bas C t /6<
.f!'> _
Attribute VB_Name = "SubMain" @W+8z#xr'
Option Explicit FIn )O-<
Qvny$sr2
'采集文件与临时文件 KI< x`b
Public Const TmpFile As String = "d:\30-0600.dat" l$BKE{rg
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 ve#[LBOC8
~l+~ MB
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long )P1N X"A
Public hBCFile As Long '记录采集参数的文件 ]Gl_L7 u`
Public Const TmpBMP As String = "d:\1.bmp" >&<D.lx
Public hTmpFile As Long }J 5iY0
e /XOmv
z"5e3w
'采集窗口参数常量 ICo Z<;p
Public Const FrameH As Long = 280& ,[m4+6G5
Public Const FrameW As Long = 768& tSDp>0yZ3
Public Const pFrameSize As Long = FrameW * FrameH a vS 9 "e
oi3Ix7
'标志区范围，用于识别车辆 -NG9?sI\U
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X jbOzbxR?
Public Const mkW As Integer = 28 '识别标志立柱宽度 dkEnc
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) ^(xVjsHp#
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) AF{
o=@
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 i\36 s$ \
'车缝检测位置常数 17Q*
<iCs
Public Const sSize As Long = 32& P\c0Q;){h"
Public Const sPos As Long = 310& xT9+l1_
Public Const sPosL As Long = 200& !/&~F eb
Public Const sPosR As Long = 500& ! oV'
'车缝检测框位置 \@2sI
Public Slice(1 To sSize, 1 To FrameH) As Byte bVRxGn @l
Public SliceL(1 To sSize, 1 To FrameH) As Byte etW-gbr
Public SliceR(1 To sSize, 1 To FrameH) As Byte <.7W:s,f=
Public avSL As Integer, avSLR As Integer, avSLL As Integer 0g#?'sD
a(o[ bH.|;
RAyR&p
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 /7*qa G
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 n O}x,sG2'
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 1?+)T%"
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long h^9Ne/s ~
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte AM gvk`<f
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 If9!S}
wa
Q6Zh%\+h(
F7x< V=4{
hYCyc -W
'一次连续采集的帧数 RDG,f/L2
Public tFrames As Long `0ju=FP'u5
ZG)C#I1;O
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 XeBSHvO_
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 9.goO|~ B~
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize N_!Zn"J
b!37:V\#}
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte ;+qPV7Z
Public pBuffer(1 To FrameW * FrameH * 2) As Byte L3Q1az !Ct
Public pWorkSpace(1 To FrameW * FrameH) As Long q33!X!br
Public Const pBufferSize As Long = FrameW * FrameH * 2 ,KibP_<%&P
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 CQY/q@7
kLY9#p=X
Public hBoard As Long '采集卡标识 8&f"")m
Public mBufferAddr As Long '缓存地址 zGFW?|o<
Public BufferSize As Long '缓存大小(字节) I|[a
a $G
Public iCurrentCard As Long Y@%6*uTLa
Public CapStatus As Long ldoN!J
Public iFrames As Long NOmSLIgt7
Public currentBr As Byte, currentContr As Byte Df/f&;`
,v1-y
?kB
Public hMEM As Long, mStatus As Long 1/q iE{NW
Public Const hMemSize As Long = pFrameSize * 4 dR /UXzrc
Public hMemWork As Long J2#=`|t"
Public Const hMemWorkSize As Long = pFrameSize * 5 .yj=*N.
ZsPBs4<p
{&(bKQ
Ah2XwFg?
'串口接收轨道衡数据 [dL?N
Public WeightFromCom As String I p0@Q}^
Public bReceiveComplete As Boolean =09j1:''<d
Tf[-8H<
s?K4::@ Fv
Public Type GrayBMPHeader Mz{ Rh+gS
Tag As Integer :S7yM8 b`
FileLength As Long '文件大小 L {CHAV kV
Reserve1 As Long FkE CY
DataOffset As Long '图像数据偏移量 Pq7tNM E
BMPHeaderSize As Long '文件头长 >|I3h5\M
'length of the bitmap info header used to describe the bitmap colors, compression,… u& I ~%s
'the following sizes are possible: Y=rW.yK8
'28h - windows 3.1x, 95, nt, … I0jEhg%J Z
'0ch - os/2 1.x j'0*|f ^z
'f0h - os/2 2.x `Tsfsc N
vrW9<{
ImageWidth As Long '图像宽（像素数） v
DOeBw
=
ImageHeight As Long '图像高(像素数) m~NWY$oI9[
PlaneNumber As Integer '图像层数 ! xqG-rd
'
bpp As Integer 'bits per pixels '1 - monochrome bitmap 7erao-
'4 - 16 color bitmap &FvN z
'8 - 256 color bitmap GrQAho
'16 - 16bit (high color) bitmap 8QZk0
O
'24 - 24bit (true color) bitmap ?y45# Tk]
'32 - 32bit (true color) bitmap E.% F/mM
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) SS~Txt75m
'1 - rle 8-bit / pixel (also identified by bi_rle4) 7iJk0L$]x
'2 - rle 4-bit / pixel (also identified by bi_rle8) yb**|[By
'3 - bitfields (also identified by bi_bitfields) v <Ze$^ e&
IMAGESIZE As Long '图像数据字节数 U ._1'pW
hResolution As Long '水平分辩率 像素数/米 TuCOoz@d
vResolution As Long '垂直分辩率 RBgkC+2
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 #XY]@V\
ImportantColors As Long 5B CaE)J
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 3S2'JOTY
End Type J2[QHr&tn
s3kEux^
+[ }]a3)
\
T]"pE+8l
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader x!.VWG tb
Public sRECT As RECT 6k3l/ ~R
>qUO_>
( &hX8
Public conn As ADODB.Connection '}YX pB
Public rsTrain As ADODB.Recordset >% 3c 1
Public rsOperater As ADODB.Recordset >a-+7{};
Public rsGoods As ADODB.Recordset
u# UeJu O
Public rsGood2 As ADODB.Recordset ng <`2XgU
Public rsSender As ADODB.Recordset ez5 `B$$
Public rsReceover As ADODB.Recordset ta 6 WZu
Public rsTrainTMP As ADODB.Recordset 'IW+"o
246lFx G .
w./EJk KI
'打开采集卡 =<_5gR
'设置参数 `Zi #rr|)L
'设置为实时单帧采集到缓存方式 zXf+ie o
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 Yh%wf3
UEO
D\l.?<C
@ Q1j
H~t
Sub Main() g4$%)0x%
Dim i As Integer, status As Long a&ByV!%%+_
nG*6ic
InitBMPinfo &s;%(c04A
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 fY"28#
BMPHeader.Tag = &H4D42 XP;&iZ
J
BMPHeader.ImageWidth = FrameW < 5_Ys
BMPHeader.ImageHeight = FrameH RK3/!C`
BMPHeader.BMPHeaderSize = &H28 7ER 2 h*
BMPHeader.PlaneNumber = 1 tr /dd&(Y1
BMPHeader.bpp = 8 v!U# C[a^
BMPHeader.Compression = 0 O`0$ pn
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 Cw|S
Y
BMPHeader.vResolution = &H1274 (Mm{"J3uv
BMPHeader.ColorsinBMP = 256 \j;uN#)28
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP /#se>4]
BMPHeader.DataOffset = Len(BMPHeader) v#+w<gRq
For i = 0 To 255 6uXYZ.A
BMPHeader.Pallate(i) = RGB(i, i, i) E H "g`r
Next i dS&8R1\>1
BMPHeader.IMAGESIZE = FrameH * FrameW ,] { NZ9
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE KE3
/<0Z
W=\dsdnu*
*(MvNN*
MoveMemory BMP1, BMPHeader, Len(BMPHeader) _~(Xd@c(
0amz#VIB<u
BMP1.ImageWidth = FrameW G\p;
b UF
BMP1.ImageHeight = FrameH * 2 3ElpS^ 2W
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight +e:ZN
tr9
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE Mqtp}<*@-
udZ : OU<
'确定标志位置,为pilarX, pilarY确定初始值 q5W'P >
PilarW = mkW ?W|IC8~d')
PilarH = mkH '此两项为固定值 S7q & |nI
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) `pMI[pLZe
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 2,;t% GB
mfN@tMp
fBOPd =
'连续采集记录文件 D5m\u$~V
' 建立一个缓冲区为页对齐方式的文件 KJ) &(Yx
If Dir(TmpFile) <> "" Then 6qJB"_.
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ lmcDA, 7
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) XfrnM^oty
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 |\
( /dXXP
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 `s_TY%&_}g
Else h*9o_
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ ` ; =Se_
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ~+C#c,Nw
End If 9h(hx 7]
If hFile = 0 Then pi FQ7B
MsgBox TmpFile & ": File Open Error", vbOKOnly |)-: w?
Exit Sub G0Eq }MyF
End If ;2|H6IN"
'采集参数记录文件 V6{xX0'b*m
hBCFile = FreeFile() 7 f*_
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Aii[=x8
w;$ +7
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 8)! ;[G|
If hMEM = 0 Then FOA%( 5$ 4
fStatus = GetLastError ui{_w @ o
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ U.F65KaKF
& "请向技术人员报告该错误代码。", vbOKOnly M<srJ8|'
CloseHandle hFile KTEis!w
Exit Sub NGY I%:
End If kZ9pgdI
a !K;8#xc
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) r*wKYb
If hMemWork = 0 Then pzr-}>xrZ
fStatus = GetLastError rw2|1_AF
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 7&)F;;H
& "请向技术人员报告该错误代码。", vbOKOnly w$ {
'释放已成功分配的内存 JrAc]=
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) cj<@~[uw
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) %$x FnGb
9.=#4OH/
CloseHandle hFile =x'%zUgE
Exit Sub $
bosGG
End If -*M:O F"Zh
k >CtWV5B
' Test writing ex+A
T;o
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& m^.C(}
8!SiTOzR?
'初始化采集卡参数 swFOh5z
iCurrentCard = -1 jf/9]
`Hf
hBoard = okOpenBoard(iCurrentCard) \^4$}@* ]
Debug.Print hBoard B^?XE(.
If hBoard = 0 Then &zcj U+n
ExitGrabber ( `+Z'Y
End o {LFXNcg[
End If Vgn1I(Gj 4
okGetBufferSize hBoard, mBufferAddr, BufferSize <6~;-ZQY
If mBufferAddr = 0 Then fO>~V1
MsgBox "缓存不存在！" bVHi3=0{
ExitGrabber | ]cDz
End If b]#d04]
Debug.Print Hex(mBufferAddr), Hex(BufferSize) [;AcV73
8Q -F
F8Wq&X#r
currentBr = 128: currentContr = 128 AyO|9!F@A
'设置视频输入参数 \W^+vuD8
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 c7IR06E
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input Ig KAD#2a
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 y}HC\A77uD
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 }2,#[m M
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 @EZONKT
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 p ri{vveN@
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） PWu2;JF
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) q*nz4QTOE
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) Zwns|23n
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 p d3&AsU
UJ$:5*S=u
'设置采集参数 ~(/HgFLLu
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 a4RFn\4?
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ,P@-DDJ
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 Z|% 2495\
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 3rg ^R "&
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 y Wtr,
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 zpqNmxmF
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 9 %14k
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 a?~csP^ ?}
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 J6ShI Pc
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 c.Z4f
7
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 . b oizW1+
mm-UQ\h
-$
t,}3
okCloseBoard hBoard 3&fF Iab9
Sleep 50 <SZO-
-+lB
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 )6
<byO
p\;)^O4
'设置数据传送方式 4"x;XVNM[
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 W?
||9
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 WUS9zK
( v:ek_
sRECT.Right = -1 '用于获得当前设置值 u/'s d t
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Wb )l8[=
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom qjzW9yV+
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 =>\-ma+
sRECT.Left = 0 jsd]7C
sRECT.Top = 0 So.P @CCd
sRECT.Right = sRECT.Left + FrameW (x0
*(*A}
sRECT.Bottom = sRECT.Top + FrameH * 2 GP
Lt<K!<#
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) "nno)~)u
Z[S+L"0
sRECT.Right = -1 '检查新设置值 DF|s,J`98
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) TeCpT2!5j
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom
r;X0 B
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) cCGXB|9fYR
/'fDXSdP
If TESTSignal = False Then *;E+9^ :V
'ExitGrabber _j\=FJz[
End If @[lc0_ b
8V hck-wF
.r5oN +?e
89#0vG7m
'设为实时采集状态 $uK"@Mw
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) xe
vP2pYG:
M2Fj)w2
A'QGTT
'单帧采集 lV6[d8P
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 S} Cp&}G{P
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) fR%1FXpK&
okCaptureTo hBoard, BUFFER, 0, 1 'single WAXts]=
'Do While okGetCaptureStatus(hBoard, False) <> 0 %
`1CE\f
' Sleep 20 hUvuq,LH_
'Loop RL
OQ>vYY
okGetCaptureStatus hBoard, True EvQwGt1)P
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize 0(/D|
'写入768*576测试图象 ]~S+nl yd<
ArrayToBMP TmpBMP yPh2P5}H>
yL
x .#kx6
'打开数据库 >04>rn#},,
Set conn = New ADODB.Connection QsJW"4d
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ OrEuQ-,i@
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ DE\bYxJ
"; Mode=Read|Write" RrdtU7i
3
conn.Open q,+kPhHEgy
g+ 1=5g
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) ~!:S p_y
frmRecord.Visible = True aC~n :0 v
frmQuery.Visible = True ;GFB@I@
Load frmReceiveFromComm n,a5LR
'R d*X6dv
'调试参数 _<RR`
If InStr(UCase(Command()), "/CAPTURE") > 0 Then _pko]F|()
SignalBox.Visible = True l()MYuLNV
End If S50x0$%<W
If InStr(UCase(Command()), "/COMM") > 0 Then 6mpg&'>
frmReceiveFromComm.Visible = True +VLe'|
End If Dnm.!L8
]Zz G!7
End Sub 0$L0fhw.
oA ;Ty7s
Sub ExitGrabber() h<' 5q&y
'关闭数据库 A :
bPIXb
'关闭采集卡 ,o@~OTja*
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) R 4$
Q3vcH
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) ~J>gVg%66
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) -N8cj r4l
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) o;4e)tK
okStopCapture hBoard /E{dM2
okCloseBoard hBoard ' q<EZ {
CloseHandle hFile yC 7Vb
P
Close #hBCFile ) Zb` ~w
conn.Close `o8{qU,*]N
End DxKfWb5 R
End Sub G</ I%qM
Wd`
Q pW
Function ArrayToBMP(ByVal File As String) LX\*4[0%K
Dim BytesWrite As Long
SU%rWH
s'aV q B
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ ,)rZAI
CREATE_ALWAYS, 0&, 0&) tdnXPxn[
?(/j< ,m^
If hTmpFile = 0 Then l P$r
ArrayToBMP = False O
(D5A?tv!
Exit Function $rpTs?j*K$
End If iQ|,&K0 d]
S`@6c$y k
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Ly)(_Tp@+
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& yI.}3y{^5
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN *M&VqG4P9w
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& ;j>Vt?:Pw
' `]n _$f'
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 2 @3.xG
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& grCO-S|j^
Awa|rIM
If BytesWrite < pFrameSize Then 1KYbL8 c
ArrayToBMP = False xa{<R+LR
End If \YlF>{LVe
RHx+HBZ
CloseHandle hTmpFile I51oG:6fR?
71l"m^Z3zy
End Function !<=%;+
v-;XyVx
Function ArrayToBMP1(ByVal File As String) wHOlj)CZ
..q63d r
Dim BytesWrite As Long =qp}p'BYe
cF_
;hD|YZ
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 5&<d2EG6l'
CREATE_ALWAYS, 0&, 0&) 6/mkJj+"
Dpdn%8+Z
If hTmpFile = 0 Then @UpC{M--Wr
ArrayToBMP1 = False i,'Ka[6
Exit Function yD[zzEuQ
End If B]|6`UfB
^s2m\Q(
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 7O+Ij9+{n
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& ,zN3? /7
' o/N}E!Pt
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN jKj =#O
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& 6/[Z178m
1J-Qh<Q
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN (lN
;xT`=
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& )ew[ Ak|
OHHN Wg_5
If BytesWrite < pBufferSize Then NDRW
ArrayToBMP1 = False U
EEBWz H
End If $K?T=a;z
xi?P(s A
CloseHandle hTmpFile ke}Y 2sB
%9QMzz5
End Function e|b~[|;*=
WO.0K5nfk
'使用该过程建立的文件要求在用后关闭 {}g %"mi#
Public Function ArrayToBMP2(File As String) As Boolean ;v,9 v;T
bvip bf[m<
Dim BytesWrite As Long jB%"AvIX
%Ui{=920
ArrayToBMP2 = True /i{tS`[F2a
my\o P(e\
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ i5
L:L
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&)
:vYt Mp
_oJ2]f6KX
If hTmpFile = 0 Then *b Ci2mbm@
ArrayToBMP2 = False aJ6#=G61l
Exit Function , G[r+4|h
End If dNUR)X#e
kUn2RZ6$#
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN >P \h,1
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& *|L bbRu
.Na&I)udX.
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN D Hm[8 Qp
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& Q(I JD4
9u ?)vR[@e
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN ~*7 O(8
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& &r'{(O8$N
selP=Q!
If BytesWrite < pFrameSize Then / lLov .
ArrayToBMP2 = False 8ji^d1
G,
End If b|sc'eP#?
8"km_[JE e
CloseHandle hTmpFile aJ :A%+1
(ve+,H6w\
End Function "[jhaUAK
='dLsh4P2N
Private Function TESTSignal() As Boolean *?_qE
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long cW)Oi^q%o2
YVB %
kKv{
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) *.m{jgi1X
oe(9mYWKa6
If extsign = 1 Then Sc&)~h}YF
TESTSignal = True 6kt]`H`cfJ
Else 5c: '>
If extsign = 0 Then &GdL 9!hH
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly RDs,sj/Y9?
TESTSignal = False 1m
JbQ#5
Exit Function Kajkw>z
End If mb0n}I_AC
End If b:P\=k]8#
&l. x:eD
'测试视频输入类型 T!l
mO? Q
'video type wv , GBZ-f
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 `*e 4m
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) [ 8F
\;
If videotype = 1 Then 87^ :<\pp
'"隔行信号(Interlaced)" 8W~
lU~-
Else M!N`
Orz
If videotype = 0 Then {q&@nm40
'"逐行信号(Non-interlaced)" j|VXC(6 P,
Else DeOXM=&z
If videotype = -1 Then L]k*QIn:h
' "不支持" Ro'jM0(KE
End If -|m$YrzG
End If CN.6E<9'kK
End If
6Xdtr
koOy Z>
'测试垂直扫描线数 %{R _^Y8t
'video scanlines r0F_;
scanlines = -1 2c}B
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) 3<c*v/L{C\
If scanlines = -1 Then Q0V^P DF
' "不支持" O.*jR`l
Else |EF>Y 9
'Trim(Str(ScanLines)) + " 行数/幅" T>#TDMU#Fm
End If O6y @G
.+
<9ma(PFa
'测试帧频 +w "XNl
'video field frequency C
_8j:Z&
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) Bu7A{DRf
If fieldfrq = -1 Then 7{n\y l?
'lblSignal(8) = "不支持" p{NPc T%&
Else OuB2 x=B
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" zzX<?6M S
End If
L~*u4
End Function g-."sniP$g
3YR *
^
/@&(P#h
Sub PicIdentify() MWM
+hk1fs
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 c}\
' x5:o
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 n}19?K]g
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 R=`U 4Ml;
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 $ "Af y)Ir
3PfiQ|/b
Dim fPTR As Long, cFrame As Long QT#b>xV)1
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer VR "u*
XjX 2[*l
x.I][(}
cFrame = 0 qh%i5Mu
aS RjFL^
hzaU8kb
Do While cFrame < tFrames "?$L'!bM@
RNGO~:k?r
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) \WWG>OUh.U
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) +Dv 7:x7
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize !0` lu_ZN
T`
uDlo
frmRecord.RText.Text = Str(cFrame) GF&_~48GD
frmRecord.RText.Refresh #`/bQ~s
j*X jY[
If CheckMark = True Then avlqDi1l
ArrayToBMP TmpBMP f[x~)=
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) StEQ
-k
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" ^>-+@+(
r
x@h t x?
DrawSlice 21U&Ww
PmHd9 ^C
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) (FuEd11R
'If i = vbNo Then P"b8!k?
' Exit Do Ujf, 6=M
'End If +|6`E 3j%
'cFrame = cFrame + 1 $nj\\,(g
iBucT"d]
End If F av?,Q ,n
DoEvents ze&#i6S
cFrame = cFrame + 1 T-^0:@5o9
Loop ^Sw2xT$p{j
End Sub 5`"iq
"5Cf
UanEzx%
veV_be{i
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 2zhn`m
yKYl@&H/%
'如标志区模式反差存在则为TRUE，否则返回FALSE ( }G !np
L/ ~D<V
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long h{I`7X
CheckMark = True ?fV?|ZGZI
z ^'n* h
'复制标志区 a_J b> }
For i = 1 To mkH G(3;;F7 "
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW -!l^ ]MU
Next i GSP?X$E
GjEqU;XBi
For j = 1 To PilarW * PilarH / 2 >z QNHSi
mTop = mTop + MKpilar(j) SgiDh dE
Next j IAYACmlN&
DE%fF,Hk3
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH (i\)|c/a7
mBot = mBot + MKpilar(j) sa G8g
Next j w^ 3|(F
"9w}dQ
mTop = mTop / PilarW / PilarH * 2 hq L+_| DW
mBot = mBot / PilarW / PilarH * 2 p+$+MeBz
avg4K*v v
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 0 < g{ V
6F(hY !}5
'平均值极值化 \Dfm ( R
For j = 1 To PilarH * PilarW E30Ln_^o
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) ^_sQG
Next j 0*/kGvw`i
NddO *`8+)
mTop = 0: mBot = 0 [P{a_(
For j = 1 To PilarH * PilarW / 2 Y17hOKc`
mTop = mTop + MKpilar(j) " CM ucK
Next j 40u7fojg2
JRXRi*@
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW _C20 +PMO
mBot = mBot + MKpilar(j) u\f3qc,]F
Next j teAukE=}
YGETMIT(
d .p'p GL
mTop = mTop / PilarH / PilarW * 3 :<H8'4>
mBot = mBot / PilarH / PilarW * 3 9:Si]
Pp+S
;= a_B1"9u
z?4=h Sy
If mBot > iWhite And mTop < iBlk Then uxb:^d?D!
CheckMark = True 6AAswz'$P
Else _B3zRO
CheckMark = False #BsW
End If U9
bWU'
End Function #ra*f~G
`kFiH*5 %z
Sub Capture1Frame() okstY 4f'
okCaptureTo hBoard, BUFFER, 0, 1 'single 2 L:$aZ
okGetCaptureStatus hBoard, True "Kq>#I'%W
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize D^|9/qm$
End Sub ) &:L'N
g
rspt}
yPoSJzC=[
Sub CopyMark(iBlk As Integer, iWhite As Integer) 1 DqX:WM6
'复制标志区并返回标志区暗区与亮区的亮度平均值 `;$h'eI9
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 eeW`JG-E
>k;p.Pay%
'复制标志区 ET. dI.R 8
For i = 1 To mkH QXs8:;T
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW ywO mQc
Z
Next i W&YU^&`Yr
J'e]x[Y
For j = 1 To mkW * mkH / 2 FIS "Z(
mTotal = mTotal + MKpilar(j) V#L'7">VP
Next j DHv2&z
H
Lc|{aN
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 b1xpz1
pM9yOY
mTotal = 0 q*bt4,D&Es
For j = mkW * mkH / 2 + 1 To mkW * mkH |NJ}F@t/5
mTotal = mTotal + MKpilar(j) -%,"iaO
Next j P\ AqpQv
BZ+;n
|<r
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 |4fF T `
>'b=YlUL
'背景亮度 ~>g+2]Bn>$
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 2"X~ju
For i = 1 To 4 * FrameW Vm ,,u F
bsTotal = bsTotal + BsLine(i) ugLlI2 nJ
Next i o_$&XNC_
bsAV = bsTotal / FrameW / 4 ! ),t"Ae?>
) M:)y
End Sub I ]9 C_
N 9LgU)-Jt
9->q| E4
Sub AdjIMGbright(Optional bInit As Boolean = True) 8EI:(NE*J
/8c&Axuv
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） m*Cu-6&qd
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100
X{\jK]O
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 X#`dWNrN
QIK
9
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer v+6e;xl 8
)+EN$ *H
'按标准亮度与对比度采集一帧，确定背景亮度 ,[ l`zp
currentContr = 128 '初始对比度 orqJ[! u)`
currentBr = 128 '初始亮度 Oaa"T8t
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Jzex]_:1~
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 Z9[+'ZWt
DoEvents sJU`u'w
Capture1Frame )/ >A6A:
'获得图像上缘4行象素 ~=cmM
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
^2C>L}
CopyMark iBlack, iBright '图像标志区亮度 +qy
6d7 ^
For i = 1 To 4 * FrameW S-c ^eLzQ
bsTotal = bsTotal + BsLine(i) p!DP`Ouc3\
Next i g`[$Xi R
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 2 hq\n<
RB$
z]/=
Select Case bsAV >{nH v)
Case 0 To 60 '夜间通过灯光照明,完全没有背景 I Zrk1fh
currentBr = 150 q7_+}"i
currentContr = 60 ?lKhzH.T
Case 61 To 80 '有可见背景 (>7>3
currentBr = 140 ? JXa~.dA
currentContr = 70 nB ] Ia?
Case 81 To 100 '有清晰背景 :FHA]o ec1
currentBr = 128 5jZ iJw(
currentContr = 80 +~
35G:&:
Case 100 To 150 '有明亮背景 !YE zFU`L
currentBr = 140 '5:30-6:00钟实测数据 1m)M
;^_
currentContr = 50 t)a;/scT
Case 151 To 180 !%[S49s
currentBr = 130 _ck[&Q
currentContr = 60 !0" nx{7.
Case 181 To 220 '背景全为白色 tTuX\;G
currentBr = 110 i=rH 7k
currentContr = 130 bK*~ol
Case 221 To 255 '背景全为白色 [Y/:@t "2y
currentBr = 100 BJy ;-(JP
currentContr = 100 T1bd:mC}n
End Select
3+U]?7t
g
7n "
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 L l}yJ#3,
Case 100 To 150 & %,DZA`
currentBr = currentBr - 10 BC7 7<R!E)
Case 151 To 255 K Y.ZT2k
currentBr = currentBr - 20 ej^3Y Nh&
End Select q-_' W,
H=~9CJ+tc
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 k\aK?(.RC7
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 /tj$luls5
End Sub >5ChcefH
Ia4)uV8
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) _A'{la ~k
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long m3 -9b"
*C2R`gpBI
For i = 1 To 8 ?9xu{B>6
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& ^sClz*%?
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& d5!!Ut
Next i ZA820A>2!
,:GN;sIXg
For j = 1 To 1024 G;1?<3
L1 = L1 + LeftBK(j, 0) t'(1I|7
L2 = L2 + LeftBK(j, 1) LW:1/w&pv
R1 = R1 + RightBK(j, 0) M bA\pG'T
R2 = R2 + RightBK(j, 1) 75NRCXh.
Next j (
kw5>c7
diffL = Abs(L1 - L2) / 1024 PJ\0JR7 a
diffR = Abs(R1 - R2) / 1024 [Qj;/
End Sub |He=LQ }0
{vVTv SC
Function CheckSlice() As Boolean %!|O.xxRR
CopySlice avSL, avSLR, avSLL SSA W5 2xC
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then Ed-M7#wY
CheckSlice = True z]@6fM[
Else |.U)ll(c
CheckSlice = False Vw~\H Gs/~
End If h "W8N+e\
End Function {y-^~Q"z
w/m:{c Hk
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) -t-tn22
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long (.23rVvnT@
For i = 1 To FrameH 5kMWW*Xtf
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize =.Tv)/ea
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize ,D=fFp n
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize n7! H:{ L
Next i |FNCXlgZ
For i = 1 To FrameH XKU=oI0 \j
For j = 1 To sSize 6v 732;^
total = total + Slice(j, i) Nne o{j
totalL = totalL + SliceL(j, i) )^x K
totalR = totalR + SliceR(j, i) A)NkT`<)
Next j (f#b7O-Wn
Next i |yY`s6Uq
avSL = total / FrameH / sSize (K<9h L+X
avSLR = totalR / FrameH / sSize g0R[xOS|
avSLL = totalL / FrameH / sSize
uY#TEjGh]
End Sub 8dO?K*J,H'
i.y)mcB4
Sub DrawSlice() qoX@@ xr1
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B Q8nId<\(
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B ',=g;
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B r'4:)~]s
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) iiC!|`k"
End Sub 8e2?tmWM
Sub DrawMark(pic As Control) GbZ;#^S
Dim i As Long, j As Long A : e;k{J
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B z5 m>
H;P
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B
jNyoN1M
For i = 1 To PilarH l#qv 5f
For j = 1 To PilarW A9:NK Y{z
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) [V}, tO|
Next j PK2~fJB
Next i Da1aI]{I
End Sub \RG!@$i
Xm!-~n@-m7
Function avIMG() As Integer i$^ ZTb^
Dim i As Long, j As Long, totalIMG As Long Wf26
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize egR-w[{
For i = 1 To pFrameSize '7 )"
totalIMG = totalIMG + pBuffer(i) NXk!qGV2
Next i ^ c%N/V
\
avIMG = totalIMG / pFrameSize )"<8K}%!
End Function \>Zvev!s
osP\D iQ
Function avRegion(barCol As Integer, barWidth As Integer) As Integer ajH"Jy3A
Dim i As Long, j As Long, totalIMG As Long >U!*y4
For i = 1 To FrameH ftbpqp'
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth }
cN
W^4F
Next i l=m(mf?QBg
For i = 1 To FrameH * barWidth md Gwh7/3
totalIMG = totalIMG + pBuffer(i) MuI2?:~:*4
Next i SNpi=K!yn
avRegion = totalIMG / pFrameSize +j/~Af p5f
End Function Ud(`V:d
