这才是我当年写出的一个比较烂的程序 T@|l@xm~L
-k&{nD|
Main2.bas 5)yOw|Bd
( s"iC:D6U
Attribute VB_Name = "SubMain" V+qJrZ ,i
Option Explicit @%<?GNS O
'yd@G QM&
'采集文件与临时文件 lmQ 6X
Public Const TmpFile As String = "d:\30-0600.dat" u5N y= Xm
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 yIIET
E
{KD gK
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long `<J#l;y
Public hBCFile As Long '记录采集参数的文件 3fxNV<
Public Const TmpBMP As String = "d:\1.bmp" ahtYSz_FM
Public hTmpFile As Long irs fJUr[V
o} =.
8* y
o7q&
'采集窗口参数常量 +%wWSZ<#
Public Const FrameH As Long = 280& sc8DY!|OYN
Public Const FrameW As Long = 768& UQ3@@:L_
Public Const pFrameSize As Long = FrameW * FrameH ~pevU`}Uqc
iS"8X#[]N
'标志区范围，用于识别车辆 `\jTpDV_W
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X Vd +Q:L
Public Const mkW As Integer = 28 '识别标志立柱宽度 'qV3O+@MF
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) YN@6}B#1
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) S9p?*
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 A/"}Y1#qX\
'车缝检测位置常数 'e]HP-Y
<
Public Const sSize As Long = 32& m1-\qt-yy
Public Const sPos As Long = 310& 0zbLc%
Public Const sPosL As Long = 200& G* \abL
Public Const sPosR As Long = 500& T;!ukGoFP
'车缝检测框位置 7%9)C[6NSs
Public Slice(1 To sSize, 1 To FrameH) As Byte JA)o@[l F
Public SliceL(1 To sSize, 1 To FrameH) As Byte >{m2E8U0
Public SliceR(1 To sSize, 1 To FrameH) As Byte RxZm/:yuJ.
Public avSL As Integer, avSLR As Integer, avSLL As Integer Cq
gk
1s`)yu^`v
>`89N'lZBm
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 -2\ZzK0tM
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 w,Z" W;|
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 0)AM-/"
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long gcg>Gjp
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte )4ilCS&
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 HK0::6n{
2L2 VVO
\&iil =H8!
W7L+ 8LU;
'一次连续采集的帧数 # SQvXMT
Public tFrames As Long vUYJf99B
~o@\
n
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 &xiOTkqB
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 8?7kIin
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize JoCA{F a}
i-,D_
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte .G}k/`a
Public pBuffer(1 To FrameW * FrameH * 2) As Byte EqnpMHF
Public pWorkSpace(1 To FrameW * FrameH) As Long dC` tN5
Public Const pBufferSize As Long = FrameW * FrameH * 2 bar0{!Y"
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 UP;Q= t
L)F 1NuR
Public hBoard As Long '采集卡标识 WRD
A `
Public mBufferAddr As Long '缓存地址 v**z$5x9
Public BufferSize As Long '缓存大小(字节) +2DE/wE]e+
Public iCurrentCard As Long W|d
pFh`
Public CapStatus As Long gF[6c`-s
Public iFrames As Long j1YH9T#|D
Public currentBr As Byte, currentContr As Byte 94|yvh.B
mz\NFC<
Public hMEM As Long, mStatus As Long ]U,CKJF%/
Public Const hMemSize As Long = pFrameSize * 4 @P:R~m2
Public hMemWork As Long gg-};0P-
Public Const hMemWorkSize As Long = pFrameSize * 5 )nwZ/&@
S
Pn8\2Cj
Xsd $*F@<
B6bOEPQ
'串口接收轨道衡数据 F aFp_P?
Public WeightFromCom As String r <*O
Public bReceiveComplete As Boolean oYz!O] j;a
{'h_'Y`bOQ
6F`qi: a+
Public Type GrayBMPHeader ~BZXt7DE
Tag As Integer $Z;B QJVH
FileLength As Long '文件大小 5"JU?e59M
Reserve1 As Long QCOLC2I
DataOffset As Long '图像数据偏移量 \=!H 2M
BMPHeaderSize As Long '文件头长 c>ad0xce6
'length of the bitmap info header used to describe the bitmap colors, compression,… Vkr`17`G
'the following sizes are possible: )O3jQ_q=
'28h - windows 3.1x, 95, nt, … p9-0?(]
'0ch - os/2 1.x X9fNGM1
'f0h - os/2 2.x -Z%F mv8
G#H 9g PY
ImageWidth As Long '图像宽（像素数） 3J
%V%}mD
ImageHeight As Long '图像高(像素数) 9 9e*]')A%
PlaneNumber As Integer '图像层数 RF_[?O)Q
bpp As Integer 'bits per pixels '1 - monochrome bitmap bj @xqAGl
'4 - 16 color bitmap 4'SaEsA~
'8 - 256 color bitmap qy_%~c87
'16 - 16bit (high color) bitmap 3;*z3;#}
'24 - 24bit (true color) bitmap NZ LXN
'32 - 32bit (true color) bitmap upypxC
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) Ge~q3"
'1 - rle 8-bit / pixel (also identified by bi_rle4) 3Y
z]8`C
'2 - rle 4-bit / pixel (also identified by bi_rle8) I%@e
@Dm,h
'3 - bitfields (also identified by bi_bitfields) ]9jZndgC
IMAGESIZE As Long '图像数据字节数 XGfzEld2"
hResolution As Long '水平分辩率 像素数/米 k(P3LJcYQ
vResolution As Long '垂直分辩率 Y@Y`gF6F
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 =fl%8" %N&
ImportantColors As Long *URdd,){i
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 R]u
(l+`
End Type sV u k
L[9OVD
90~*dNk
%}C9
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader H]s4% 9T
Public sRECT As RECT ?g2zm I!U
rA
,CQypo
<uZPqi||
Public conn As ADODB.Connection SIq1 X'7
Public rsTrain As ADODB.Recordset D?e"U_
Public rsOperater As ADODB.Recordset Sx 8l<X
Public rsGoods As ADODB.Recordset D g~
[#C-
Public rsGood2 As ADODB.Recordset J
O2xT#V
Public rsSender As ADODB.Recordset {j?7d; 'j
Public rsReceover As ADODB.Recordset 3bH~';<
Public rsTrainTMP As ADODB.Recordset -!c IesK;<
AD]e0_E
p8=|5.
'打开采集卡 9\ v.qo.
'设置参数 |rMq;Rgu?
'设置为实时单帧采集到缓存方式 u4Y M^* S.
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 S'o ]=&
k oM]S+
1
Xo Y7/&&
Sub Main() 2FGx _ Y
Dim i As Integer, status As Long R<_?W#$j
s~ ^*+kq
InitBMPinfo g a-{!$b*
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 rvic%bsk
BMPHeader.Tag = &H4D42 .Gh%p`<
BMPHeader.ImageWidth = FrameW a/~29gW8E\
BMPHeader.ImageHeight = FrameH &5u BNpH
BMPHeader.BMPHeaderSize = &H28 B{p4G`$i1
BMPHeader.PlaneNumber = 1 W;q+, Io
BMPHeader.bpp = 8 *Bs^NU.
BMPHeader.Compression = 0 ibJl;sJ
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0
EX:{EmaT
BMPHeader.vResolution = &H1274 ASW4,% cl
BMPHeader.ColorsinBMP = 256 !z MDP/V
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP lEHwZ< je
BMPHeader.DataOffset = Len(BMPHeader) cC%j!8!
For i = 0 To 255 zmI5"K"'F
BMPHeader.Pallate(i) = RGB(i, i, i) -#aZF2z
Next i &]< 3 ~ 6n
BMPHeader.IMAGESIZE = FrameH * FrameW 9?
2
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE WSLy}@`Vx
EJLQ&oH[
1}!L][(
MoveMemory BMP1, BMPHeader, Len(BMPHeader) UfR~%p>K
Z:@6Lv?CN
BMP1.ImageWidth = FrameW "cMNdR1^,y
BMP1.ImageHeight = FrameH * 2 3_W{T@T
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight )lh8
k {
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE S[mM4et|
<F7V=Er
'确定标志位置,为pilarX, pilarY确定初始值 V&i2L.{G)
PilarW = mkW |3;(~a)%
PilarH = mkH '此两项为固定值 Uky9zGa
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) R)+t]}
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 =_
y\Y@J
-`7$ Qu 2
7^MX l
'连续采集记录文件 M)JADX
' 建立一个缓冲区为页对齐方式的文件 VD$ Eb
If Dir(TmpFile) <> "" Then P16YS8$
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ Vl<9=f7 [
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) rJQ=9qn\
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 5Z{_m;I.
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 H4:ZTl_$
Else .x}gg \
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ }c%
pH{ HI
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) W"Q!|#;l.
End If ,r=re!QI7
If hFile = 0 Then *Y%Jl
o
MsgBox TmpFile & ": File Open Error", vbOKOnly ',ZF5T5z@
Exit Sub +TN^NE
End If FLZS K:3B]
'采集参数记录文件 DyfsTx
hBCFile = FreeFile() T%(C-Quh
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile =i>\2J%'R
QU T"z'
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 sTkkM9
If hMEM = 0 Then -[DWM2C$K4
fStatus = GetLastError l~J*' m2
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ cy|%sf`
& "请向技术人员报告该错误代码。", vbOKOnly \9)#l#m
CloseHandle hFile ?TpUf
Exit Sub Qz+sT6js-
End If CISO< z0
& [_ZXVva~
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) d(7NO;S8
If hMemWork = 0 Then 3qi_]*dD
fStatus = GetLastError
-7%X]
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ h^oH^moq<
& "请向技术人员报告该错误代码。", vbOKOnly |]W2EV ,b
'释放已成功分配的内存 %d; <2b0
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) } ptMjT{9
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) b5pMq$UVL
.9h )b f+
CloseHandle hFile `~h4D(n`
Exit Sub !][F
End If =e BmBn
{)@D`{
$
' Test writing 7,'kpyCj
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& gnLn7?
exDkq0u]
'初始化采集卡参数 Jdj?I'XtY
iCurrentCard = -1 LA4<#KP
hBoard = okOpenBoard(iCurrentCard) zizk7<?L .
Debug.Print hBoard +Ok%e.\ZM
If hBoard = 0 Then [2
zt ^
ExitGrabber oNM
?y:O
End {38\vX,I(w
End If _1|$P|$P.
okGetBufferSize hBoard, mBufferAddr, BufferSize y=a V=qD
If mBufferAddr = 0 Then ?Elg ?)os
MsgBox "缓存不存在！" 7I}P*%(f
ExitGrabber rh%m;i<b
End If "DQ'C% sL9
Debug.Print Hex(mBufferAddr), Hex(BufferSize) #@qN8J}R
|P~;C6sf
p
SfYu=#f
currentBr = 128: currentContr = 128 SfB8!V|;
'设置视频输入参数 *(QH{!-$s
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 S1b Au
<
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input i ]o"_=C
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 @dgH50 o[
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 s0 C:m
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 OBOw z4<
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 Q i9-z'
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） _xrwu;o0}
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) DlTR|(AL
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) \+nGOvM
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 :243 H
*:hy Y!x
'设置采集参数 A\$
> >Z
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 B,vOsa"x6`
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 4(cJ^]wb ^
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 t6lE#<xZV;
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 }Qr6 l/2
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 B4g8
~ f
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 idc4Cf+4
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 [} 2Z/
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 ,^$ |R32
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 7:Zt uc]
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 5`-UMz<]
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 osH Cg
o 3N] `xD'
]@
M5_%p
okCloseBoard hBoard Gy"%R-j7
Sleep 50 ?&X6:KJQ
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 7G9 3,dJ
Tu m_aI
'设置数据传送方式 S VWIEH0?
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 K84^ O
q
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 C#Bz >2;#
bRo|uJ:d
sRECT.Right = -1 '用于获得当前设置值 xT*d/Oa w
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) nJZ6?
V
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 1n=_y o
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 6bO~/mpWT~
sRECT.Left = 0 UM MB0(0D
sRECT.Top = 0 H !) =y
sRECT.Right = sRECT.Left + FrameW >v+ jh(^
sRECT.Bottom = sRECT.Top + FrameH * 2 @ -:]P8
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
CN
&
d=3 '?l`
sRECT.Right = -1 '检查新设置值 {1-V]h.<J
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Bh]!WMA w.
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom }-DE`c
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) i
L]'y\?lv
a|_p,_
If TESTSignal = False Then D'_Bz8H!p
'ExitGrabber @f1 *eo5f
End If @jy41eIo
C~4PE>YtTv
y\c" b-lQX
\7v)iG|#G&
'设为实时采集状态 TNwK da+
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) 1(#;&:$`i
Ykqyk')wm
f{&bOF v
'单帧采集 -db75=
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 y$W|~ H
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) @T-p2#&
okCaptureTo hBoard, BUFFER, 0, 1 'single ^%>kO,
'Do While okGetCaptureStatus(hBoard, False) <> 0 )3A{GZj#6
' Sleep 20 , 0N94pKy
'Loop jd-glE,Y/
okGetCaptureStatus hBoard, True {b)~V3rsY
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize </"4 zD|
'写入768*576测试图象 {+.r5py
ArrayToBMP TmpBMP qu |i;WZE
1wj:aD?g
'打开数据库 DcD{*t?x
Set conn = New ADODB.Connection g"_C,XN
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ T7*wS#z)h
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ :t("L-GPW
"; Mode=Read|Write" HMGB >
conn.Open ~I=Y{iM
d_z 59
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) FnFb[I@eu
frmRecord.Visible = True "3CJUr:Q
frmQuery.Visible = True K^l:MxO-X
Load frmReceiveFromComm ';B# Gx
/t%u"dP"T~
'调试参数 ]j<Bo4~Il
If InStr(UCase(Command()), "/CAPTURE") > 0 Then iw9Q18:I}
SignalBox.Visible = True 0s#K p49-
End If ^jE8+ h
If InStr(UCase(Command()), "/COMM") > 0 Then B4Y(?JT x
frmReceiveFromComm.Visible = True ;#/@+4@a&
End If ^K(^I*q
vH[47Cv G5
End Sub &&> tf%[
pB:$lS
Sub ExitGrabber() G}d-(X
'关闭数据库 RFaSw f,5n
'关闭采集卡 )
c2_b
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) p#P~Q/;
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Z|lU8`'5
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) eU@Cr7@,|
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE)
q2aYEuu,
okStopCapture hBoard 23\RJpKb
okCloseBoard hBoard ,m3e?j@;r
CloseHandle hFile Z.PBu| Kx
Close #hBCFile 9xI GV!
conn.Close K2)!h.W
End IM@tN
L
End Sub hqvE!Of
uQ1@b-e`5
Function ArrayToBMP(ByVal File As String) fwR_OB: $
Dim BytesWrite As Long &53]sFZ
|*5 =_vF
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ <O<LYN+(
CREATE_ALWAYS, 0&, 0&) G6 0S|d
u+m,b76
If hTmpFile = 0 Then `)iY}Iu
ArrayToBMP = False fx cc<h4
Exit Function -Z-f1.Dm5
End If 4,Ic}Cv
M
YZf6|
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ~&dyRt W4
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& dihjpI_
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN [Nm4sI 11
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& bUwn}_7b
kRJ4-n^@><
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN =8Jfgq9E
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& =wWpP-J&
eV^d6T$
If BytesWrite < pFrameSize Then :M3
oUE{
ArrayToBMP = False s ^Nw%KAv
End If D/y bFk
}L=/A7Nk >
CloseHandle hTmpFile rqPo)AL
H6*^Ga
End Function sic"pn],U
`r"+644
Function ArrayToBMP1(ByVal File As String) xM >W2
y&~w2{a
Dim BytesWrite As Long o G*5f
\>. LW9
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ :ue:QSt(u
CREATE_ALWAYS, 0&, 0&) /6uT6G+(z}
}|OaL*|u
If hTmpFile = 0 Then `4?~nbz
ArrayToBMP1 = False /*FH:T<V
Exit Function =ac_,]z
End If B q\F?zk<
2&mGT&HAVA
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 82{&# Vc
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& Jz ji&A~
C$h<Wt=<
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN MM_k
]-7
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& c,MOv7{x_
?
t& kb7
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN _9 .(a
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& <*ZJaBwWU~
tc ;'oMUP
If BytesWrite < pBufferSize Then `:8J46or
ArrayToBMP1 = False S^@S%Eg
End If {PP9$>4`l
Dr&('RZ4
CloseHandle hTmpFile a ] 17qMl
f
3V Dv9(
End Function \*hrW(
.~A*=
'使用该过程建立的文件要求在用后关闭 5^<h}u9
Public Function ArrayToBMP2(File As String) As Boolean B(a-k?
SvM6iZ]
Dim BytesWrite As Long !3n)|~r;K
?lGG|9J\
ArrayToBMP2 = True z}Q
wP ~Z
1J=.N|(@Q
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ b
\KL;H/
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) aim arU
}U ~6^2 .,
If hTmpFile = 0 Then L
sEXM-
ArrayToBMP2 = False ,_aM`%q?Fj
Exit Function lz#GbX n.
End If \J. .*,'
bK"SKV
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN u- D dq~;|
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& :o-,SrORM
XgN` 7!Z
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN v,-{Z1N%m
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& {N2g8W:
u@'0Vk0zGH
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN _/8FRk x
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& W :,4 : |3
K5ZC:Ks
If BytesWrite < pFrameSize Then ;h6v@)#GX
ArrayToBMP2 = False `pf4X/Py
End If [v 7^i_d
z?/1Kj}xG
CloseHandle hTmpFile ~LJY6A@y
00I}o%akO
End Function 'FlJpA}
s^0/"j |7
Private Function TESTSignal() As Boolean s4Sd>D 7
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long El_wdbbT
8KB>6[H!wE
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) Xp\/YJOibd
4
%PfrJ
If extsign = 1 Then <~}7Mxn%x@
TESTSignal = True h^,
8r d
Else >z;[2 n'
If extsign = 0 Then ~vmd XR`'T
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly E#J';tUQ
TESTSignal = False fx=Awba
Exit Function !-2R;yo12
End If 'w>_+jLT
End If S= R7`a<.5
]V %.I_
'测试视频输入类型 WV3|?,y]qm
'video type ](tx<3h
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 \P} p5k[
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) ZUz ^!d
If videotype = 1 Then <DKS +R
'"隔行信号(Interlaced)" 3~,d+P
Else bmN q[}
If videotype = 0 Then Y$N)^=7
'"逐行信号(Non-interlaced)" UDhG :
Else H gTUy[(
If videotype = -1 Then B] m@:|Q
' "不支持" I}e 3zf>
End If 9I 1tN
End If U~h'*nV&
End If !CX t*/~
[ U}+sTQ
'测试垂直扫描线数
3G.5724,
'video scanlines bfB\h *XO
scanlines = -1 *D o/+[Ae
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) IDkWGh
If scanlines = -1 Then F(4?tX T
' "不支持" +4[^!q*
H
Else 2LrJ>Mi
'Trim(Str(ScanLines)) + " 行数/幅" "|;:>{JC
End If Q~R
~xz
Fc~'TBf,,`
'测试帧频 bCref$
|
'video field frequency &PkLp4mQ
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ)
RZM"~ 0
If fieldfrq = -1 Then /?
r?it
'lblSignal(8) = "不支持" }I 3 gU
Else 4h5g'!9-g
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" L;gO;vO
End If Z3>N<u8)
End Function 5MFxo63
gu #-O
?B
F'g Vzf
Sub PicIdentify() O^/Maa/D1
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 ]k9)G*
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ]| N3eu
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 >fH=DOz$&
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 {x'GJtpb
a+hd(JX0~
Dim fPTR As Long, cFrame As Long Fk(JSiU
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer O: @}lK+H
`cPywn@uGZ
<;E
cFrame = 0 RoCfJ65
?$f)&O
;Yi4Xv a@
Do While cFrame < tFrames ;a-$D]Db
fLV"T_rk
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) V"p!B f
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) uOa26kE4
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 4}`
>zDF2Y[
frmRecord.RText.Text = Str(cFrame) ??n*2s@t
frmRecord.RText.Refresh (D@A74q\'
DI!V^M[~u
If CheckMark = True Then W@y J AQ
ArrayToBMP TmpBMP e[sK@jX6
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) q o<&J f
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" 66^yc ZCH
v9Xp97 J2
DrawSlice 763+uFx^
'9c2Q/
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) [tMZ G%h
'If i = vbNo Then 2X:4C C%5
' Exit Do 4iW'kuK
'End If R!l:O=[<
'cFrame = cFrame + 1 2o>)7^9|#<
IbcZ@'RSw
End If TCT57P#b
DoEvents }FzqW*4~
cFrame = cFrame + 1 -n'F v@U
Loop YF+n
b.0.
End Sub \*,=S52
Zy|Mz&
s p asB=E
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean K}6dg<
k}KC/d9.z
'如标志区模式反差存在则为TRUE，否则返回FALSE -s 6![eV
l>Ub!^;
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long GTHkY*
CheckMark = True k`GA\&zt
{.yStB. T
'复制标志区 3!5Ur&
For i = 1 To mkH ,39 aF*r1Q
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW E*# ]**
Next i _fZZ_0\Q
]7;\E\o
For j = 1 To PilarW * PilarH / 2 =]-j;#'&
mTop = mTop + MKpilar(j) *^([ ~[
Next j BTM),
w2
nF e%vu8a
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH 4t)%<4
mBot = mBot + MKpilar(j) )sho*;_o
Next j q>w )"Dd
}(egMx;"3J
mTop = mTop / PilarW / PilarH * 2 XUuu-wm:}
mBot = mBot / PilarW / PilarH * 2 }K8/-d6
{EdH$l>94
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 K |DWu8
#
O4gg
'平均值极值化 ' B
For j = 1 To PilarH * PilarW $lhC{&tBV
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) *D'$"@w3
Next j }du XC[ 6
c1%H4j4/
mTop = 0: mBot = 0 Z}|(F RVk
For j = 1 To PilarH * PilarW / 2 0\2\*I}?
mTop = mTop + MKpilar(j) fX
jG5Tv
Next j ;<0LXYL;
[
'%69dPh
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW gK OOHUCb
mBot = mBot + MKpilar(j) ~4?9a(>3
Next j U% h); !<
nenU)*o
Z3!f^vAi&
mTop = mTop / PilarH / PilarW * 3 V7TVt,-3
mBot = mBot / PilarH / PilarW * 3 O5H9Y}i]
e@ {i
N{- ]F|XX
If mBot > iWhite And mTop < iBlk Then F@R1:M9*
CheckMark = True 191&_*Xb
Else <cA/<3k)
CheckMark = False PvGDTYcKp
End If kNqH zo
End Function T97]P- }
tDr#H!2
3
Sub Capture1Frame() L28*1]\Jh
okCaptureTo hBoard, BUFFER, 0, 1 'single 1 { , F
okGetCaptureStatus hBoard, True t%530EB3
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize A>{p2?`+!
End Sub M>M`baM1
_ 0 gKK2
zD 3mX<sw
Sub CopyMark(iBlk As Integer, iWhite As Integer) EC|' l
'复制标志区并返回标志区暗区与亮区的亮度平均值 mrV! teP
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 +:3*
0euuT@_$
'复制标志区 "bDs2E+W
For i = 1 To mkH sBV 4)xM
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW uUKcB:
Next i >a3p >2
O$IjN x
For j = 1 To mkW * mkH / 2 YDGS}~m~Q
mTotal = mTotal + MKpilar(j) >J u]2++lx
Next j au,t%8AC
y^7}oH _
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 Jk0r&t7
<L&m4O#|
mTotal = 0 kD[ r.Dma
For j = mkW * mkH / 2 + 1 To mkW * mkH %r4 q8-
mTotal = mTotal + MKpilar(j) sl2@umR7%(
Next j Tr^nkD{
aTf`BG{kw
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 P,sj o u^
V^Hu3aUx8
'背景亮度
Bo5ZZY
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 7<H
|QL&
For i = 1 To 4 * FrameW .'a&3 3J
bsTotal = bsTotal + BsLine(i) ! ZU2{
Next i XT ;u<aJs
bsAV = bsTotal / FrameW / 4 Z@Ae$ '9H
r[?1
End Sub 'W
a,OFd\8
b=3H
\P1= 5rP
Sub AdjIMGbright(Optional bInit As Boolean = True) C{2xHd/*
qH['09/F6
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） 0j C3f T!n
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 oA1a /[#
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 <, 3ROo76
#M A4
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer
) G7=G+e;
%7O?JI [
'按标准亮度与对比度采集一帧，确定背景亮度 m~uOXb
currentContr = 128 '初始对比度 . " $
currentBr = 128 '初始亮度 XNgDf3T
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 f@co<iA
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 U \rh [0
DoEvents v`1,4,;,qs
Capture1Frame f-n z{U
'获得图像上缘4行象素 cWajrLw
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW )/t?!T.[
CopyMark iBlack, iBright '图像标志区亮度 \p%3vRwS%p
For i = 1 To 4 * FrameW h=_mNG>R)
bsTotal = bsTotal + BsLine(i) Ge d [#Q
Next i : a :
l
j
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 JF
/,K"J
r\;ut4 wy
Select Case bsAV k<+0o))
Case 0 To 60 '夜间通过灯光照明,完全没有背景 W5#61 1
currentBr = 150 sl*5Y#,|1
currentContr = 60 :$+-3_oLMQ
Case 61 To 80 '有可见背景 7^T^($+6s&
currentBr = 140 hR5_+cu Ip
currentContr = 70 S(:l+JP
Case 81 To 100 '有清晰背景 7)%+=@
currentBr = 128 2S' {!A
currentContr = 80 ^*\XgX
Case 100 To 150 '有明亮背景 h_
d<!
currentBr = 140 '5:30-6:00钟实测数据 ' H7x L
currentContr = 50 < 'G~8tA%v
Case 151 To 180 .G o{1[
currentBr = 130 `yF`x8
currentContr = 60 TY(bPq
Case 181 To 220 '背景全为白色 5[n(7 ;+gw
currentBr = 110 z4 E|Ai
currentContr = 130 U.{l;EL:T
Case 221 To 255 '背景全为白色 h~wi6^{&Y
currentBr = 100 {)AMw q
currentContr = 100 I}2P>)K
End Select ^ 9-&o
jmg!
Ml
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 =vT<EW}[
Case 100 To 150 n&A'C \
currentBr = currentBr - 10 mXUYQ 82
Case 151 To 255 Su 5>$
currentBr = currentBr - 20 CIVnCy z
End Select ](F#`zUQ
)J?{+3
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 /s];{m|>
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 -+t ]15
End Sub HHjt/gc}`
X\}Y
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) >3u ]OSb
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long DQwGUF'(
;60.l!
For i = 1 To 8 TE )gVE]
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& z6py"J@
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& Y
wkyq>Rv
Next i lg pW@ g
<W]g2>9o9
For j = 1 To 1024 .@
-$5Jw
L1 = L1 + LeftBK(j, 0) ~afg )[(
L2 = L2 + LeftBK(j, 1) -)vEW
n$3<
R1 = R1 + RightBK(j, 0) u {z``]
R2 = R2 + RightBK(j, 1) G^"Vo x4
Next j %&
_V0 R\k
diffL = Abs(L1 - L2) / 1024 0P>OJYFr'
diffR = Abs(R1 - R2) / 1024 T;L>P[hNn
End Sub hp"L8w
e|4&b@
Function CheckSlice() As Boolean
lWm'
CopySlice avSL, avSLR, avSLL O iDh
J
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then Dup;e&9g
CheckSlice = True 1N2,mo?2
Else #P#-xz
CheckSlice = False PQ|69*2G
End If &Z?ut *%S
End Function ! Q<>3 xZ
a?YCn!
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) c%*($)#
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long f&D]anf33
For i = 1 To FrameH 5PcJZi^.l
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize wv^rS^~
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize q.2(OP>(
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 2 &Nb
Next i %P;Q|v6/|
For i = 1 To FrameH mJB2)^33a
For j = 1 To sSize -*2Mf Mh
total = total + Slice(j, i) 0q\7C[R_
totalL = totalL + SliceL(j, i) i@NqC;~;
totalR = totalR + SliceR(j, i) 1c+]gI e
Next j m`6Yc:@E
Next i 1009ES7*
avSL = total / FrameH / sSize !EQ@#qW/
avSLR = totalR / FrameH / sSize oUQ07z\C
avSLL = totalL / FrameH / sSize L !4t[hhe=
End Sub 5X.e*;
a^5^gId5l!
Sub DrawSlice() ob_I]~^I?|
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B 0b91y3R+
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B |# l=
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B r}yG0c,
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) e"r)R 8
End Sub 1y^K/.5-
Sub DrawMark(pic As Control) F_uY{bg
Dim i As Long, j As Long D|qk_2R%
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B ?[x49Ux,P
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B /m _kn
For i = 1 To PilarH ;@h0qRXW:h
For j = 1 To PilarW 0u lt7s}
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) 7m#[!%D
Next j pdd/D
Next i Jw~( G9G
End Sub $(Ugtimdv
b%f[p/no
Function avIMG() As Integer *Ywpz^2?:
Dim i As Long, j As Long, totalIMG As Long /WPv\L
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 1+`l7'F
For i = 1 To pFrameSize R_sC! -
totalIMG = totalIMG + pBuffer(i) 0N=X74
Next i qz4^{
avIMG = totalIMG / pFrameSize 8vk..!7n}
End Function YC]L)eafo`
S]sk7
Function avRegion(barCol As Integer, barWidth As Integer) As Integer w<9>Q1(
Dim i As Long, j As Long, totalIMG As Long |+ge8uu?C
For i = 1 To FrameH }6 5s'JB
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth juBw5U <
Next i qC!&x,}3
For i = 1 To FrameH * barWidth :Sg_t Of
totalIMG = totalIMG + pBuffer(i) U }Hwto`R
Next i fx8EB8A7K7
avRegion = totalIMG / pFrameSize d7Ur$K\=y
End Function X}P$e mr7
