这才是我当年写出的一个比较烂的程序 1+_`^|eK
bQg c8/
Main2.bas 5TH~.^`Fi
f z'@_4hg
Attribute VB_Name = "SubMain" 0yk] o5a++
Option Explicit Z F!h<h&,
g];!&R-
'采集文件与临时文件 0"jY.*_EW
Public Const TmpFile As String = "d:\30-0600.dat" Kn5~d(:
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 ^9v4O UG
ER%^!xA
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long `KZm0d{H
Public hBCFile As Long '记录采集参数的文件 ~[t[y~Hup
Public Const TmpBMP As String = "d:\1.bmp" d[iQ` YW5
Public hTmpFile As Long 3#LlDC_WC
S|Q@:r"
uy>q 7C
'采集窗口参数常量 KjD/o?JUr
Public Const FrameH As Long = 280& is?{MJZ_
Public Const FrameW As Long = 768& }7b %HTF=
Public Const pFrameSize As Long = FrameW * FrameH *3+4[WT0]a
w'>p Y
'标志区范围，用于识别车辆 ; 5*&x z
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X =Qy<GeY
Public Const mkW As Integer = 28 '识别标志立柱宽度 !z\h| wU+
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) j` {?OYD
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) q`Go`v
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 Hus)c3Ty7
'车缝检测位置常数 'g}!
Public Const sSize As Long = 32& T^zXt?
Public Const sPos As Long = 310& E^ B'4
Public Const sPosL As Long = 200& sA+ }TNhq
Public Const sPosR As Long = 500& ?qb}?&1
'车缝检测框位置 ( >LF( ll
Public Slice(1 To sSize, 1 To FrameH) As Byte wW Lj?;bx
Public SliceL(1 To sSize, 1 To FrameH) As Byte u+
9hL4
Public SliceR(1 To sSize, 1 To FrameH) As Byte l0|5t)jF-
Public avSL As Integer, avSLR As Integer, avSLL As Integer tH
U 2/V:R
0CHH)Bku
Ki;*u_ 4{
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 #]\Uk,mhZB
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 A kq2 d;
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 /J]5H
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long ) ;EB z
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte /!0={G
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 P0;n9>g
on4HKeO
{ a =#B)6
|Tv#4st
'一次连续采集的帧数 mVj9 , q0
Public tFrames As Long ld[I}88$
KYB `D.O
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 y'3rNa] G1
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 a1T' x~ '
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize = }~hWL
s U=H &D99
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte #$.;'#u'so
Public pBuffer(1 To FrameW * FrameH * 2) As Byte =O~_Q-
Public pWorkSpace(1 To FrameW * FrameH) As Long D, k6$`
Public Const pBufferSize As Long = FrameW * FrameH * 2 w2?3wrP3
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 bTI|F]^!
_qF+tm
Public hBoard As Long '采集卡标识 z}.e]|b^H
Public mBufferAddr As Long '缓存地址 dB{Q" !
Public BufferSize As Long '缓存大小(字节) '6DBs8>1
Public iCurrentCard As Long p'Y^ X
Public CapStatus As Long !Lu2
Public iFrames As Long CT&|QH{
Public currentBr As Byte, currentContr As Byte ,V7nzhA2
V.U|
#n 5
Public hMEM As Long, mStatus As Long -M\ <nx
Public Const hMemSize As Long = pFrameSize * 4 S;Fi? M
Public hMemWork As Long wi!?BCse q
Public Const hMemWorkSize As Long = pFrameSize * 5 x[cL
Bc<
9=s<Ld
4VHn
\
zrvF]|1UP
'串口接收轨道衡数据 kXViWOXU^
Public WeightFromCom As String jVEGj5F;N
Public bReceiveComplete As Boolean "fb[23g%@k
[C Y9^N
:a!^
Public Type GrayBMPHeader ~]sc^[
Tag As Integer t$` r4Lb9/
FileLength As Long '文件大小 P?%s
#I:
Reserve1 As Long 49eD1h3'X[
DataOffset As Long '图像数据偏移量 ez7A4>/
BMPHeaderSize As Long '文件头长
\ __i
'length of the bitmap info header used to describe the bitmap colors, compression,… M$ wC=b
'the following sizes are possible: { 4l8}w
'28h - windows 3.1x, 95, nt, … :@ yEQ#nFp
'0ch - os/2 1.x ~$ c\JKH-
'f0h - os/2 2.x ${DUCud,kY
A@`}c,G
ImageWidth As Long '图像宽（像素数） \<bx [ ,?
ImageHeight As Long '图像高(像素数) VM ZMG$C
PlaneNumber As Integer '图像层数 ]>!K
3kB
bpp As Integer 'bits per pixels '1 - monochrome bitmap & w\{TZ{
'4 - 16 color bitmap aHD]k8 m z
'8 - 256 color bitmap Lw1Yvtn
'16 - 16bit (high color) bitmap 9p]QM)M
'24 - 24bit (true color) bitmap G0Iw-vf
'32 - 32bit (true color) bitmap !M(xG%M-V
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) s9
mx
'1 - rle 8-bit / pixel (also identified by bi_rle4) Ao 'l"-
'2 - rle 4-bit / pixel (also identified by bi_rle8) :'Vf
g[Uq
'3 - bitfields (also identified by bi_bitfields) 28-RC>,@}
IMAGESIZE As Long '图像数据字节数 T9=I $@/
hResolution As Long '水平分辩率 像素数/米 TP*
hd
vResolution As Long '垂直分辩率 <NMEGit
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 X;$+,&M"
ImportantColors As Long 7P } W
*
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 #`^ }PuQ
End Type ' B |JAi?
5=-Q4d
[+^1.N
u* eV@KK!
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader
_O?`@g?i
Public sRECT As RECT "MeVE#O
GblA9F7
`>o{P/ HN
Public conn As ADODB.Connection "69s) ~
Public rsTrain As ADODB.Recordset -E[Kml~U
Public rsOperater As ADODB.Recordset *;W+>W
Public rsGoods As ADODB.Recordset :@Pl pF K
Public rsGood2 As ADODB.Recordset Zpt\p7WQ
Public rsSender As ADODB.Recordset U4'#T%*
Public rsReceover As ADODB.Recordset !t"4!3
Public rsTrainTMP As ADODB.Recordset poE0{HOU
{ qk1_yP
b1I]>\
'打开采集卡 10Q ]67
'设置参数
XPc^Tq
'设置为实时单帧采集到缓存方式 p%ki>p )E|
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 i$Ul(?
PI { bmZ
,~U>'&M
;
Sub Main() wLIMv3 ;k
Dim i As Integer, status As Long H_7/%noS5
n9\TO9N
InitBMPinfo g b1V ~
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 1 C+13LE$U
BMPHeader.Tag = &H4D42 KYm0@O>;
BMPHeader.ImageWidth = FrameW {p2!|A&a
BMPHeader.ImageHeight = FrameH %UrueMEO
BMPHeader.BMPHeaderSize = &H28 hE{K=Tz$
BMPHeader.PlaneNumber = 1 RH W]Z
Pr<
BMPHeader.bpp = 8 g&L!1<,
p
BMPHeader.Compression = 0 70d 1ReQ
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 HZE#A b*L
BMPHeader.vResolution = &H1274 f_OQ./ `
BMPHeader.ColorsinBMP = 256 :
$1?i)
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP =IZT(8
BMPHeader.DataOffset = Len(BMPHeader) G[ PtkPSJ
For i = 0 To 255 M/f<A$xx_
BMPHeader.Pallate(i) = RGB(i, i, i) @?s Rj&w
Next i 38 B2|x
BMPHeader.IMAGESIZE = FrameH * FrameW z(O Nv#}p
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE @mCEHI{P
= jN.1}
&u
."A3(
MoveMemory BMP1, BMPHeader, Len(BMPHeader) .^` {1%
As&Sq-NWf
BMP1.ImageWidth = FrameW `v!urE/gg%
BMP1.ImageHeight = FrameH * 2 u,ho7ht3(
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight yZY \MB/
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE h,:m~0gmj
:U|1 xgB
'确定标志位置,为pilarX, pilarY确定初始值 LBeF&sb6
PilarW = mkW .vf'YNQ%
PilarH = mkH '此两项为固定值 e+7"/icK
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) Pm6p v
;WK
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 [>I<#_^~
NWESP U):w
(XTG8W sN
'连续采集记录文件 J3V=
46Yc
' 建立一个缓冲区为页对齐方式的文件
>Er|Jxy
If Dir(TmpFile) <> "" Then HQdxL*N%^
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ ;?Tbnn Wn
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) I9A~Ye
5O&
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项
z _$% -6
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 n` _{9R
Else | l^uEtG
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 3DX*gsx(
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) dl) Y'DI
End If 7~h<$8Y(T
If hFile = 0 Then Qp5VP@t
MsgBox TmpFile & ": File Open Error", vbOKOnly n&4N[Qlv,
Exit Sub -m zIT4
End If ma]F7dZ5
'采集参数记录文件 XX TL..
hBCFile = FreeFile() l 'rja.\
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile ,Fl)^Gl8?
#lo6c;*m5
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容
?>:g?. +
If hMEM = 0 Then =ZznFVJ`={
fStatus = GetLastError 0 ] ,r0
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ e*kpdS~U&
& "请向技术人员报告该错误代码。", vbOKOnly 4\N ;2N
CloseHandle hFile :`#d:.@]o@
Exit Sub P bn*_/H
End If y-b%T|p9
/{ J4:N'B>
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) VBlYvZ;$*
If hMemWork = 0 Then L<cx:Vz
fStatus = GetLastError n+9=1Oo"
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ H7Rx>h_
& "请向技术人员报告该错误代码。", vbOKOnly NN{?z!
'释放已成功分配的内存 C3f' {}
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) eb{nWP
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) .NC!7+1m
)AtD}HEv
CloseHandle hFile 9<?M 8_
Exit Sub !PlEO 2at
End If M]
%?>G
x j)F55e?
' Test writing [85spub&}
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& O `kl\K*R7
8NJqV+jn)t
'初始化采集卡参数 e2Pcm_Ahv*
iCurrentCard = -1 }"H,h)T
hBoard = okOpenBoard(iCurrentCard) {w O|)|
Debug.Print hBoard .hb:s,0mP
If hBoard = 0 Then yxQ1`'[CR
ExitGrabber iq8<ov
End ?4
} h&/
End If &m7]v,&
okGetBufferSize hBoard, mBufferAddr, BufferSize ub0.J#j@
If mBufferAddr = 0 Then i^&~? 2
MsgBox "缓存不存在！" sE<V5`Z=
ExitGrabber <$$yw=ef
End If Ml{
,
Debug.Print Hex(mBufferAddr), Hex(BufferSize) H2 {+)
_.Nbt(mz
2 a)xTA#
currentBr = 128: currentContr = 128 x _}:D *aI
'设置视频输入参数 ^Z+?h &%%
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 &BLJT9Frx
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input h2A <" w
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 gs[uD5oo <
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 76Cl\rV
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 k"%~" 9
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 7F7 {)L
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） eKgBy8tNS0
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) :pY/-Cgv
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) W(Fv
l
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 ;`4&Rm9n?
+o{R _
'设置采集参数 Rok7n1gW
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧
DPxM'7
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 [ S%_In
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 Xl{P8L
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 ?3,:-"(@p
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 UhWNl]Z
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 | j`@eF/"
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 ZQsJL\x[UK
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 HWrO"b*tO
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 ~W '{p
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 ZU4nc 3__
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 e]"W!K cD9
Yl
Q=5u^+
\)904W5R
okCloseBoard hBoard {4}yKjW%z
Sleep 50 .G. 0WR/2
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 /Iy]DU8
SM#]H-3
'设置数据传送方式 -HbC!w v
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 RD i]2
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 o Q 2Fj j
AaOu L,l
sRECT.Right = -1 '用于获得当前设置值 NjScc%@y
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) )gIK H{JYL
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom ,/%=su x
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 Ad8n<zt|
sRECT.Left = 0 Xm}/0g&7
sRECT.Top = 0 *8Xh(`
Mj7
sRECT.Right = sRECT.Left + FrameW ;>yxNGV`
sRECT.Bottom = sRECT.Top + FrameH * 2 _\G"9,)u '
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) y/{fX(aV
}Yzco 52
sRECT.Right = -1 '检查新设置值 nZyX|SPk
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) * [Tz![|
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom YMcD|Kb p
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) Y@vTaE^w3
H3 ^},.
If TESTSignal = False Then Y|f[bw
'ExitGrabber /QWvW=F2<
End If , , OW
Qf+\;@
4<Utm r
gMmaK0uhS
'设为实时采集状态 c
/HHy,
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) VcO0sa f`
x b~yM%*c
L: j<c5
'单帧采集 G L#u p
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 5h-SCB>P
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) ^z IW+:
okCaptureTo hBoard, BUFFER, 0, 1 'single m bxZL<ua
'Do While okGetCaptureStatus(hBoard, False) <> 0 O)*+="Rg
' Sleep 20 2!m /
'Loop 9gDkT
Ykj
okGetCaptureStatus hBoard, True xp)sBM7A
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize 2B[X,rL.pX
'写入768*576测试图象 ;kQhx6Z
ArrayToBMP TmpBMP ?m}s 4a
9igiZmM
'打开数据库 @[<><uTH
Set conn = New ADODB.Connection /{aj}M0kN
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ dI(@ZV{
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ Y-_`23x`
"; Mode=Read|Write" L-WT]&n_
conn.Open jh%Eq+#S
m@2QnA[ 4
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) z6=Z\P +
frmRecord.Visible = True '(f* 2eE:
frmQuery.Visible = True RuA*YV
Load frmReceiveFromComm ,+DG2u
@ $ ;q ;
'调试参数 O7m(o:t x3
If InStr(UCase(Command()), "/CAPTURE") > 0 Then { ]{/t-=
SignalBox.Visible = True ^R7lom.
End If i {NzV
If InStr(UCase(Command()), "/COMM") > 0 Then QL&Z jSN
frmReceiveFromComm.Visible = True :'-/NtV)o?
End If 5y [Oj^
v5#j Z $<F
End Sub ^e _hLX\SW
D9=KXo^
Sub ExitGrabber() feDlH[ $
'关闭数据库 wr/"yQA]
'关闭采集卡 H?vdr:WlTN
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) RQ'9m^
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) |!3DPA(_
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) v!6
c0a
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) C=L>zOZ
okStopCapture hBoard w !-gJmX>
okCloseBoard hBoard DS(}<HK{
CloseHandle hFile 5oW!YJ g
Close #hBCFile F3@phu${
conn.Close s4y73-J^.v
End P|tO<t6/9*
End Sub p YZmz
%~H-)_d20
Function ArrayToBMP(ByVal File As String) KE5kOU;
Dim BytesWrite As Long ?W?c 1>
a`E#F]
Z
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ (ylTp]~mR-
CREATE_ALWAYS, 0&, 0&)
F2LLN
p
Z|V
3
If hTmpFile = 0 Then
!Y0V id
ArrayToBMP = False M#4p E_G
Exit Function (l~AV9!m:
End If i( %W_d !
!* d I|k
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN _?m(V=z>
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& TOB-a AO
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN XH 4
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& SumF
2
r xvx
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN eCU
:Q
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& {tuYs:
ifMRryN4
If BytesWrite < pFrameSize Then .PIL
+x*]N
ArrayToBMP = False S"bg9o
End If np"\1 9^
o4F2%0 gJ
CloseHandle hTmpFile ~F|+o}a `
a
od-3"7[
End Function A@!qv#'
3</_c1~
Function ArrayToBMP1(ByVal File As String) zII|9y
-8ywO
"6
Dim BytesWrite As Long )
<[XtK
u^ +7hkk
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ HSE!x_$
CREATE_ALWAYS, 0&, 0&) X"|['t
N]Y d9tn{
If hTmpFile = 0 Then B
dj!ia;H
ArrayToBMP1 = False P6
'1.
R
Exit Function dC3o9
End If T= y}y
h,u, ^ r
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 8yR.uMI$/
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& UJAv`yjG
B[Ku\A6&
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN Db}j?ik/
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& / |;RV"
Xv5wJ
lc!d
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN Fx_z 6a
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& 17%,7P9pg
_/s$ZCd
If BytesWrite < pBufferSize Then |PCm01NU!
ArrayToBMP1 = False ~zJbK. _
End If p?%y82E
:1. L}4"gg
CloseHandle hTmpFile Olt ?~}
ul6]! Iy
End Function mA}TJz
,*TmIPNK
'使用该过程建立的文件要求在用后关闭 ?4#Li~q
Public Function ArrayToBMP2(File As String) As Boolean p SH=%u>
B:yGS*.tu
Dim BytesWrite As Long K *vt;L
^+>laOzC`8
ArrayToBMP2 = True J@HtoTDO 3
@ s
u^0 9n
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ hc(#{]].
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) O'p9u@kc
b5dD/-Vj
If hTmpFile = 0 Then ios&n)W&
ArrayToBMP2 = False hP%M?M KC
Exit Function KI iO
End If r4b 6 c
a8e6H30Sm
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN O-0x8 O^B
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& ed{ - /l~j
Tj` ,Z5vy
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN f M :]&
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& .]Y$o^mf
>-RQ] ?^
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN B?gOHG*vd>
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 4<w.8rR:A
x*\Y)
9Vgy
If BytesWrite < pFrameSize Then Af~$TyX
ArrayToBMP2 = False +;(c:@>@,
End If zOAd~E
`t>l:<@
%
CloseHandle hTmpFile
,h m\
A7Cm5>Y _S
End Function 9IdA%RM~mH
lV3x *4O=
Private Function TESTSignal() As Boolean Ytp(aE:
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long #K_ii)n
Wq D4YG N
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) !OhC/f(GBZ
HT
v2#
If extsign = 1 Then d=$Mim
TESTSignal = True }z'8Bu
Else } ^ ~F|
If extsign = 0 Then PfAgM1
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly 1APe=tJ
TESTSignal = False p}z<Fdu 0
Exit Function $D~0~gn~
End If b4%??"&<Y
End If >W=,j)MA
W s3)gvpPA
'测试视频输入类型 DZ 3wCLQtK
'video type L^/5ux
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 13$%,q )
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) }1L4 "}L.
If videotype = 1 Then hE'-is@7
'"隔行信号(Interlaced)" R3)~?X1n
Else 3 8Mv
25N
If videotype = 0 Then )
yi
E@
X
'"逐行信号(Non-interlaced)" >;aWz%-
Else a_^\=&?'
If videotype = -1 Then P-9)38`5
' "不支持" n:I,PS0H<
End If HYD'.uj
End If z> 1Pz(
End If ^KnU4sD
]`!> 6/[
'测试垂直扫描线数 X&.ArXn*
'video scanlines pGP7nw_g
scanlines = -1 <[a=ceL]|
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) 8rAg \H3E
If scanlines = -1 Then D# 9m\o_
' "不支持" _P#|IAq*
Else > y m,{EHK
'Trim(Str(ScanLines)) + " 行数/幅" wy<S;
End If z}77 Eh<
A_"w^E{P
'测试帧频 0I-9nuw,^;
'video field frequency q<x/Ha t)
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) b"<liGh"n-
If fieldfrq = -1 Then Hs;4lSyUO
'lblSignal(8) = "不支持" + B,}Q r
Else W
@M:a
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" %vn"{3y>rF
End If Pf")e,u$
End Function 6fE7W>la
j1Y~_
e-})6)XgA
Sub PicIdentify() P8 OaoPj
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 R"/GQ`^AqA
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 U#7#aeI
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 K C*e/J
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 {Y(zd [
x xHY+(m
Dim fPTR As Long, cFrame As Long "=HA Y
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer Z\bmW%av
XAD- 'i
Si4!R+4w
cFrame = 0 G{As,`{
r(>@qGN
4 @+`q *
Do While cFrame < tFrames gMi0FO '
VD;01" #'
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) $8)+XmsCr
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) ch* 8
B(:
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize *nT<m
\C6
^2:p|:Bz!l
frmRecord.RText.Text = Str(cFrame) { T/[cu<
frmRecord.RText.Refresh ;>%r9pz ~
OR P\b
If CheckMark = True Then \i>?q
ArrayToBMP TmpBMP XW 2b| %T
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) CImWd.W9~
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" o "s)eh
].avItg
DrawSlice Y,qI@n<
k& M;,e3v6
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) np|S
y;:
'If i = vbNo Then v 4a8}G
' Exit Do ]? c
B:}
'End If YH }'s>xZz
'cFrame = cFrame + 1 r5S[-`s;
ydEoC$?0
End If ^) /0yB
DoEvents ^ox=H
NV
cFrame = cFrame + 1 ?.m bK
Loop v4!V r I
End Sub + )AG *
x;O[c3 I
d(ZO6Nr Q
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean L8@f-Kk
~ gJwW+
'如标志区模式反差存在则为TRUE，否则返回FALSE z#9aP&8 Q
R+
hU 8 pu
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long C#.->\
CheckMark = True Po+.&7F
~p6 V,Q
'复制标志区 i'<[DjMDlm
For i = 1 To mkH %_H<:uGO%
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW &C5_g$Ma.Z
Next i F@D`N0Pte
wA ,6bj
For j = 1 To PilarW * PilarH / 2 +zqn<<9
mTop = mTop + MKpilar(j) RT4x\ &q
Next j ~f2z]JLr:
B&M%I:i
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH V5@:#BIs
mBot = mBot + MKpilar(j) 1 &jc/*Z"
Next j ZuzEg *lb
+uF>2b6'
mTop = mTop / PilarW / PilarH * 2 RXMISt3+{y
mBot = mBot / PilarW / PilarH * 2 ,C\i^>=
tH@Erh|%
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 8L=HW G!1
DaQ?\uq
'平均值极值化 j<m(PHS e
For j = 1 To PilarH * PilarW l
K{hVqpt
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) c1(R
uP:S
Next j etDk35!h~,
o+iiST JEe
mTop = 0: mBot = 0 BiLY(1,
For j = 1 To PilarH * PilarW / 2 soB,j3#p'*
mTop = mTop + MKpilar(j) +yG~T
Next j (Bb5? fw
>a<.mU|#
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW /obfw ^
mBot = mBot + MKpilar(j) AG
nxYV"p
Next j wq`s-qZu
fC d&D
P7bMI e
mTop = mTop / PilarH / PilarW * 3
RF$eQzW
mBot = mBot / PilarH / PilarW * 3 ;J( 8
L
5:[0z5Hww
.<0ye_S'y
If mBot > iWhite And mTop < iBlk Then 3lL-)<
0A(
CheckMark = True 88O8wJN
Else =`oCLsz=
CheckMark = False ](]i 'fE>
End If dw>C@c#"
End Function 0@0w+&*"@
BGZ# wr u
Sub Capture1Frame() KJUH(] >F
okCaptureTo hBoard, BUFFER, 0, 1 'single =osk+uzzG
okGetCaptureStatus hBoard, True d A }-]
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize C\3rJy(VJ
End Sub & GO}|W
Ys9[5@7
] Jg&VXrH
Sub CopyMark(iBlk As Integer, iWhite As Integer) >{n,L6_ t
'复制标志区并返回标志区暗区与亮区的亮度平均值 _IHV7*u{;
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 FBX'.\@`
IxN9&xa
'复制标志区 aH(
J,XY
For i = 1 To mkH kOrZv,qFG[
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW f1RWP@iar
Next i wYXQlxd y
Ux!p8
For j = 1 To mkW * mkH / 2 5J.bD)
yrP
mTotal = mTotal + MKpilar(j) Vi$~-6n&
Next j IVnHf_PzF
4}baSV
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 U BU=9a5
m#Jmdb_
mTotal = 0 w>&aEv/f
For j = mkW * mkH / 2 + 1 To mkW * mkH h|9L5
mTotal = mTotal + MKpilar(j) HXC ;N p
Next j dh\'<|\K
\[i1JG
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 8P\G }
7vKK%H_P
'背景亮度 m]0;"jeL
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 8}x:`vDK
For i = 1 To 4 * FrameW 1p3z1_wrs
bsTotal = bsTotal + BsLine(i) e `_
LEv
Next i y3Q
sv
bsAV = bsTotal / FrameW / 4 |-67 \p]
ij `w} V
End Sub 1Faf$J~7|
dm0R[[ 7
z]y.W`i
Sub AdjIMGbright(Optional bInit As Boolean = True) u(.e8~s8
wo{gG? B
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） =!A_^;NQf
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 &{n.]]%O.
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 A1$TXr
+4~_Ei[ i
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer vkV0On
\~mT]
'5
'按标准亮度与对比度采集一帧，确定背景亮度 Lnl(2x D
currentContr = 128 '初始对比度 2DDtu [}
currentBr = 128 '初始亮度 \;,+
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 @l5"nBs<_:
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 H [\o RId
DoEvents oG?Xk%7&\
Capture1Frame CI 0C1/:@
'获得图像上缘4行象素 /)>3Nq4Zx
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 9wUkh}s
CopyMark iBlack, iBright '图像标志区亮度 |$Sedzj'
For i = 1 To 4 * FrameW r.&Vw|*>
bsTotal = bsTotal + BsLine(i) !;v|' I
Next i ? pmHFlx
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 # $07:UJ
(_]~wi-,
Select Case bsAV 3,3N^nSD
Case 0 To 60 '夜间通过灯光照明,完全没有背景 R$<&ie6UQ
currentBr = 150 .p3,O6y2(F
currentContr = 60 9d659i C
Case 61 To 80 '有可见背景 `:KY\
currentBr = 140 Xz a(k
currentContr = 70 Tn e4
Case 81 To 100 '有清晰背景 7hcYD!DS
currentBr = 128 &-6Gc;f8
currentContr = 80 :6
R\OeH+
Case 100 To 150 '有明亮背景 ;?i W%:_,
currentBr = 140 '5:30-6:00钟实测数据 9ULQrq$?
currentContr = 50 20 h, ^
Case 151 To 180 ,AFu C <
currentBr = 130 WIxy}3_to
currentContr = 60 g}{aZ$sta
Case 181 To 220 '背景全为白色 %JBz5G
currentBr = 110 (NU
NHxi5B
currentContr = 130 ; 7V%#-
Case 221 To 255 '背景全为白色 R4cM%l_#W
currentBr = 100 `5.'_3
currentContr = 100 c
( C%Hld
End Select `i*E~'
ql{ OETn#
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 '@KEi%-^>
Case 100 To 150 n0 {i&[I~+
currentBr = currentBr - 10 %)W2H^
Case 151 To 255 3z?> j]
currentBr = currentBr - 20 OX!tsARC@
End Select
Do7T j
D2 eckLT
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 I; |B.j
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 xGg )Y#
End Sub }@+0/
W?\.
_S1>j7RQo
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) :U%W%
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long 5coyr`7mP
x~~|.C ,
For i = 1 To 8 Y eo]]i{
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& }!r|1$,kL
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& dn+KH+v
Next i ^"2
J]&x`G
\'D0'\:vz
For j = 1 To 1024 ?Ep [M:,q
L1 = L1 + LeftBK(j, 0) 5 L%'@`mX
L2 = L2 + LeftBK(j, 1) Qd$nH8ED Y
R1 = R1 + RightBK(j, 0) n
M*%o-
R2 = R2 + RightBK(j, 1) mxC;?s;~
Next j =s2*H8]
diffL = Abs(L1 - L2) / 1024 /nNN,hz
diffR = Abs(R1 - R2) / 1024 ,!y$qVg'\f
End Sub f }f9@>.
Y"aJur=`
Function CheckSlice() As Boolean #OD/$f_
CopySlice avSL, avSLR, avSLL S`0(*A[W*
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then
?P`K7
CheckSlice = True & l& :`nsJ
Else %T%sGDCV
CheckSlice = False oW*16>IN9l
End If i%]EEVmN
End Function 9} <ile7^
6SkaH<-&K
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) +gtbcF@rx
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long
xF'EiX ~
For i = 1 To FrameH vJ[^ K
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize ,/F~ Y&1I
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize Yuji qi]J;
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize .j0$J
\:i
Next i ]Ie 0S~
For i = 1 To FrameH )23H 1
For j = 1 To sSize v MH
total = total + Slice(j, i) )~ J Hgl
totalL = totalL + SliceL(j, i) "(~^w=d:$
totalR = totalR + SliceR(j, i) )'#A$ Fj
Next j 6j]0R*B7`Q
Next i 7' V@+5
avSL = total / FrameH / sSize f+,qNvBY/
avSLR = totalR / FrameH / sSize k fY}S
avSLL = totalL / FrameH / sSize EgCAsSx(
End Sub '8H4shYg
<)c)%'v
Sub DrawSlice() m@v \(rT.
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B Fj3a.'
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B ;))+>%SGCt
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B )U:m:cr<
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) h2]P]@nW;W
End Sub K!Y71_#
Sub DrawMark(pic As Control) u?(d gJ
Dim i As Long, j As Long !ons]^km
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B Vaw+.sG`AP
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B k 2 t F}
For i = 1 To PilarH :>f )g
For j = 1 To PilarW
:KP @RZm
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) )lqAD+9Q
Next j FbFPJ !fb
Next i hRCJv#]HC
End Sub b J {'<J
K;H&n1
Function avIMG() As Integer "_NN3lD)X
Dim i As Long, j As Long, totalIMG As Long '$(^W@ M#6
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 8^+%I/S$
For i = 1 To pFrameSize : bq8N@P/
totalIMG = totalIMG + pBuffer(i) ~-Qw.EdC
Next i rcG"o\
g@+
avIMG = totalIMG / pFrameSize A[{yCn `tM
End Function C XMLt
'yEHI
Function avRegion(barCol As Integer, barWidth As Integer) As Integer ^%{7}g&$u
Dim i As Long, j As Long, totalIMG As Long g@!V3V
For i = 1 To FrameH }!.(n=idZ
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth D.u{~
Next i 08\, <9
For i = 1 To FrameH * barWidth 0-Ku7<a
totalIMG = totalIMG + pBuffer(i) v w/J8'
Next i aSQ#k;T[
avRegion = totalIMG / pFrameSize O-
hAFKx
End Function G}raA%
