这才是我当年写出的一个比较烂的程序 vt,X:3
\I]'6N=
Main2.bas eu;^h3u;b
S3f BZIPp
Attribute VB_Name = "SubMain" (*tJCz`Sj
Option Explicit t|lv6-Hy9
JN!YRcj
'采集文件与临时文件 WG n1pW
Public Const TmpFile As String = "d:\30-0600.dat" ^ j7pF.j
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 R 4;6Oi)
8uiQm;W
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long D bJ(N h
Public hBCFile As Long '记录采集参数的文件 zYsGI<4
Public Const TmpBMP As String = "d:\1.bmp" JTJ4a8DE
Public hTmpFile As Long 7h~M&\M
ovO^uWz`
hSH-Ck@ Qy
'采集窗口参数常量 2XpGgG`2`C
Public Const FrameH As Long = 280& Hua8/:![+
Public Const FrameW As Long = 768& ".4^?d_^VF
Public Const pFrameSize As Long = FrameW * FrameH 3
Gkw.
g!uhy}
'标志区范围，用于识别车辆 Ek0.r)Nw
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X ]CYe=m1<2Q
Public Const mkW As Integer = 28 '识别标志立柱宽度 z_TK
(;j
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) M}u2aW2]X
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) /2q
%'"x(
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 -9EbU7>!
'车缝检测位置常数 N~(}?'y9S
Public Const sSize As Long = 32& ?`$4ZDM
Public Const sPos As Long = 310& |/$#G0X; H
Public Const sPosL As Long = 200& fM{Vy] )J
Public Const sPosR As Long = 500& 7;{F"/A
'车缝检测框位置 ZW"J]"A
Public Slice(1 To sSize, 1 To FrameH) As Byte jF8l d5|_|
Public SliceL(1 To sSize, 1 To FrameH) As Byte 7Jk.U=vY
Public SliceR(1 To sSize, 1 To FrameH) As Byte #'P&L>6
;
Public avSL As Integer, avSLR As Integer, avSLL As Integer %94"e7Hy
=JkSq J)?
G39t'^ZK*#
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 '%N
p9 Iqt
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 i%2K%5{)$D
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 I%Z &i-33y
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long =Ju}{ bX
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte Pmb`05\
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 XJ+sm^`vOf
_QY "#
teb(\% ,
RB2u1]l
'一次连续采集的帧数
8:MYeE5
Public tFrames As Long dXhV]xK
o~B=[
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 b3H;Ea?^^<
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 f?QD# #~;
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize 3@PVUJ
0B|
0OXd*
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte kQ+5p Fo3
Public pBuffer(1 To FrameW * FrameH * 2) As Byte QPn c "!
Public pWorkSpace(1 To FrameW * FrameH) As Long E
J1:N*BA
Public Const pBufferSize As Long = FrameW * FrameH * 2 <:w7^m
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 UpbzH(?#
-}s?!Pg>
Public hBoard As Long '采集卡标识 (WC< X Kf
Public mBufferAddr As Long '缓存地址 QHK$
Public BufferSize As Long '缓存大小(字节) "P~>AXcq
Public iCurrentCard As Long -_+0[Nb .
Public CapStatus As Long y5 I7pbe
Public iFrames As Long % |V:F. f
Public currentBr As Byte, currentContr As Byte
tp"\
p-Ju&4fS
Public hMEM As Long, mStatus As Long R.@GLx_zpQ
Public Const hMemSize As Long = pFrameSize * 4 1mqFnVkf&+
Public hMemWork As Long _4+1c5Q!
Public Const hMemWorkSize As Long = pFrameSize * 5 )X FMlSx)
[
B
A l
5:wf"3%%
+7w>ujeeJA
'串口接收轨道衡数据 :>=,sLfJ
Public WeightFromCom As String = j -
Public bReceiveComplete As Boolean O?_
'6T
_>.%X45xi
cP,jC(<N
Public Type GrayBMPHeader FB""^IC?W
Tag As Integer p%BO:%v
FileLength As Long '文件大小 H;8(y4;
Reserve1 As Long #,sJd ^uI
DataOffset As Long '图像数据偏移量
SWt"QqBU
BMPHeaderSize As Long '文件头长 4p]Y`];U
'length of the bitmap info header used to describe the bitmap colors, compression,… jp|
wc,]!
'the following sizes are possible: Z:}^fZP
'28h - windows 3.1x, 95, nt, … |j;`;"+B
'0ch - os/2 1.x i~4Kek6,I
'f0h - os/2 2.x Q5ux**(Wr
<[Vr(.A
ImageWidth As Long '图像宽（像素数） ocvBKsfhE`
ImageHeight As Long '图像高(像素数) 8}&cE#@
PlaneNumber As Integer '图像层数 HhO $`YZ%>
bpp As Integer 'bits per pixels '1 - monochrome bitmap Rp#SqRy`
'4 - 16 color bitmap ETtR*5Y 5
'8 - 256 color bitmap 1EN5 ZN,
'16 - 16bit (high color) bitmap m(Oup=\%b}
'24 - 24bit (true color) bitmap -Ac^#/[ 0
'32 - 32bit (true color) bitmap b\?`721BG
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) N{'k
]&
'1 - rle 8-bit / pixel (also identified by bi_rle4) \hz)oC
'2 - rle 4-bit / pixel (also identified by bi_rle8) r?$\`,;
'3 - bitfields (also identified by bi_bitfields) 8cHZBM7'
IMAGESIZE As Long '图像数据字节数 T!n<ya!
hResolution As Long '水平分辩率 像素数/米 ^,3 >}PU
vResolution As Long '垂直分辩率 I('l )^m%
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 Q]\x O/
ImportantColors As Long 1{*x+ GC^/
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 LxbVRw
End Type h W-[omr0
R9HRbVBJf
G} p~VLf
2
Ug jH
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader <"- s
N
Public sRECT As RECT pT
<H&
|R4](
*m 7e>]-
Public conn As ADODB.Connection cWi2Sls
Public rsTrain As ADODB.Recordset xucV$[f
Public rsOperater As ADODB.Recordset ; - 3M
Public rsGoods As ADODB.Recordset uQDu<@5^[
Public rsGood2 As ADODB.Recordset `J C!u c
Public rsSender As ADODB.Recordset " H({kmR
Public rsReceover As ADODB.Recordset uBM1;9h
Public rsTrainTMP As ADODB.Recordset |laq y`D
N
4Ym[l
WrV|<%EQh
'打开采集卡 @[^H*^1|g
'设置参数 Rj8l]m6U9
'设置为实时单帧采集到缓存方式 XH/|jE.9^|
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 0
[s1!Cm!i
Y\rKw!u_!
|D \ ukml
Sub Main() |:AjQ&PM)
Dim i As Integer, status As Long '{|87kI
:c\NBKHv*
InitBMPinfo ?h5Y^}8 Qg
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件
t 6tqv
BMPHeader.Tag = &H4D42 `bi5 #xR
BMPHeader.ImageWidth = FrameW _ &T$0SZco
BMPHeader.ImageHeight = FrameH ]b[ 3 th*
BMPHeader.BMPHeaderSize = &H28 =<<\ Uo
BMPHeader.PlaneNumber = 1 `hbM 2cM
BMPHeader.bpp = 8 o , d:{tt
BMPHeader.Compression = 0 U|>Js!$
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 &CS= *)>$
BMPHeader.vResolution = &H1274 [wEx jLW
BMPHeader.ColorsinBMP = 256 te` 4*t
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP P?I"y,_ p
BMPHeader.DataOffset = Len(BMPHeader) pG
(8VteH
For i = 0 To 255 {uw]s<
6
BMPHeader.Pallate(i) = RGB(i, i, i) - na]P3 s
Next i FIuK X"XR
BMPHeader.IMAGESIZE = FrameH * FrameW 5\pizD/17
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE N7NK1<vw2
ow&R~_
3 TJNlS
MoveMemory BMP1, BMPHeader, Len(BMPHeader) (Lc%G~{
d"V^^I)yx&
BMP1.ImageWidth = FrameW d00r&Mc
BMP1.ImageHeight = FrameH * 2 _C##U; e!
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight V3UEuA
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE @? t) UE
4 :K9FqU
'确定标志位置,为pilarX, pilarY确定初始值 qRr;&M &t_
PilarW = mkW I?1^\s#L
PilarH = mkH '此两项为固定值 {5,C W
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) qU}[( 9~Ru
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 !l}es4~.a
B%,0zb+-L
wBr0s *1I
'连续采集记录文件 se?nx7~
' 建立一个缓冲区为页对齐方式的文件 4|~o<t8
If Dir(TmpFile) <> "" Then Mqna0"IYx*
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ :5dq<>~
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) %rf< YZ.\
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 F:n7y ey
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ~ >6(@~6
Else CkOd> Kn
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ (h
E^<jNR
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 6(eyUgnb
End If RW3&]l=
If hFile = 0 Then [ [Z*n/tr
MsgBox TmpFile & ": File Open Error", vbOKOnly H7uW
|'XWz
Exit Sub B$ {Q Y)t
End If 9Gy1T3y5"
'采集参数记录文件 KjhOz%Yt[o
hBCFile = FreeFile()
M; V2O;
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile c c@y
H:CwUFL
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 7{p,<Uz<"U
If hMEM = 0 Then n|8fdiK#}
fStatus = GetLastError ?O28 Q DUI
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ G-Y8<mEh
& "请向技术人员报告该错误代码。", vbOKOnly Q ml< JF
CloseHandle hFile V%"aU}
Exit Sub rx%lL
End If VlK W WQj
(*#S%4(YX
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) N ^O. P
If hMemWork = 0 Then Z/%>/
fStatus = GetLastError 0Rj_l:
d=
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ ]":PO4M$*
& "请向技术人员报告该错误代码。", vbOKOnly rK"x92P0
'释放已成功分配的内存 1%>/%eyn5
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) }4$UlT A'
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Y gg+*z
VLR W,lR9O
CloseHandle hFile w'}b 8m(L
Exit Sub /: B!hv
pw
End If ` CRW2^g
$[H3O(B0*
' Test writing R@;kY S
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& R+P1 +5
d}Q;CF3 m:
'初始化采集卡参数 0PZpE
"$X
iCurrentCard = -1 t1D6#J P(a
hBoard = okOpenBoard(iCurrentCard) t)5bHVx
Debug.Print hBoard b8Y-!] F
If hBoard = 0 Then xgfK0-T|[
ExitGrabber Qax=_[r
End 59GS:
End If 9OX&;O+
5
okGetBufferSize hBoard, mBufferAddr, BufferSize *S7<Q yVh
If mBufferAddr = 0 Then v&|o5om
MsgBox "缓存不存在！" UZqr6A(/H
ExitGrabber aCQAh[T
End If g$uj<"^
Debug.Print Hex(mBufferAddr), Hex(BufferSize) oh|Q&R
V4_ZBeWA
o4U9jU4 <"
currentBr = 128: currentContr = 128 t X)^$3A
'设置视频输入参数 wPyfne?~,
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 gd2cwnP
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input Y\s@'UoVN
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 |'.\}xt7
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 xse8 fGs
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 '};pu;GA7
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 Zhf+u
r
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） d tJ?J<m}
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) L_Z> *s&
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) yH irm|o
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 g%Eb{~v
]5wc8Kh"
'设置采集参数 rxt)l
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 y%f'7YZ4
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 H|5\c=
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 uq'T: d
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 d7A vx
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 VTS8IXz
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集
2>p>AvcK
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 ]e!9{\X,*
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 qEE
V&
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 rQCj^=cf;~
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 dxsPX =\:
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 }qxw Nmx
ht)J#Di
Ubv<3syR'
okCloseBoard hBoard +hGr2%*0f
Sleep 50 n {aD4&
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 z]K:Amp;Z
kyMWO*>|
'设置数据传送方式 8do-z"-
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 p4[cPt ~C
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 b{_J%p
Zh,(/-XN;
sRECT.Right = -1 '用于获得当前设置值 5*C#~gd& F
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) YB*I'm3q
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom RAPR-I;{
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 (" ?V |
sRECT.Left = 0 4 +Wti!s
sRECT.Top = 0 (/JiOg^cw
sRECT.Right = sRECT.Left + FrameW @w?hX K=
sRECT.Bottom = sRECT.Top + FrameH * 2 } Dp/K4
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) M $
CnaH
^i:%0"[*^i
sRECT.Right = -1 '检查新设置值 7 41Sd8
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) jhg0H2C8
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 5NH NnDhuL
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) ,Tjc\;~%
^O}` i
If TESTSignal = False Then OF-$*
'ExitGrabber Q3T@=z2j%
End If ^z)p@sk#
>We4F
2?
^- Bx zOp
22$M6Qof]n
'设为实时采集状态 _e:c
22T'
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) g\:(1oY
z&C z!HrS
&]tZ 6
'单帧采集 vL}e
1V:
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 ]2Zl\}GwY
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) ' >4 H#tu
okCaptureTo hBoard, BUFFER, 0, 1 'single >8PGyc*9
'Do While okGetCaptureStatus(hBoard, False) <> 0 H85J MPZ7
' Sleep 20 \xR1|M
'Loop EZypqe):/C
okGetCaptureStatus hBoard, True E+)3n
[G
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize XcL jUz ?
'写入768*576测试图象 MfQ 9d9
ArrayToBMP TmpBMP ir !/{IQx
](-zt9,
N;
'打开数据库 6fY-D qF!
Set conn = New ADODB.Connection vnc-
W3N
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 0o7*5| T4
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ MfNsor
"; Mode=Read|Write" F! ZE4S_
conn.Open
>cw%ckE
~Z-o2+xA
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) eb fT%_N
frmRecord.Visible = True wl7G6Y2
frmQuery.Visible = True Ht pZ5
Load frmReceiveFromComm ZMEU4?F
m9M#)< @*
'调试参数 n< 3qr}ZG^
If InStr(UCase(Command()), "/CAPTURE") > 0 Then :Y>FuE
SignalBox.Visible = True 4MUN1/DId`
End If KDxqz$14 -
If InStr(UCase(Command()), "/COMM") > 0 Then 9X/]O<i,Es
frmReceiveFromComm.Visible = True #p$iWY >e~
End If t\S=u y
PUcxlD/a}
End Sub =Z}$X:
$
kn %i#Fz
Sub ExitGrabber() i24t$7q
'关闭数据库 (X zy~l<
'关闭采集卡 x,L<{A`z
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Rq B 8g
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) /0 CS2mLC
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) zi%Ql|zI~
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 17la/7l<
okStopCapture hBoard TMJq-u51
okCloseBoard hBoard $Y`oqw?g+^
CloseHandle hFile e|>
5
R
Close #hBCFile gv\W I4"n
conn.Close Gu@n1/m@o
End #|8Ia:=s
End Sub m55|&Ux|
%>Q[j`9y
Function ArrayToBMP(ByVal File As String) z* k(` '
Dim BytesWrite As Long \w#)uYK{i_
[3 D*DyQt
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ <
#FxI
CREATE_ALWAYS, 0&, 0&) M47t(9krV
z;iNfs0i$
If hTmpFile = 0 Then 4]G J+a
ArrayToBMP = False Gn&=<q :H
Exit Function .7BJq?K.
End If Uhs/F:E[A
w#}[=jy
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN _59f.FsVR
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& ,i)wS1@
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN #;D@`.#\
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& ' 9u(9S
]}4JT
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 0#Ae<
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& ;-kC&GZf
4g+Dp&U
If BytesWrite < pFrameSize Then O#Ma Z.=
ArrayToBMP = False ` {/"? s|
End If "o)jB~ :L
)5Wt(p:T6_
CloseHandle hTmpFile Y#[xX2z9
u4x>gRz)
End Function Zz/
z7~ {
FRhHp(0}5
Function ArrayToBMP1(ByVal File As String) {:
] u 6l
g~p43sVV
Dim BytesWrite As Long 0uL*-/|
4 5Hbg
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 9$ f%
CREATE_ALWAYS, 0&, 0&) o wviIZFe
g286
P_a`*
If hTmpFile = 0 Then $ :|?z_@
ArrayToBMP1 = False 0 hg4y
Exit Function t # d{hEr
End If 8B! Mg NKV
A3^_
'K
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
Uz =OTM
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& zt;aB >jz#
^|%u%UR
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN LIE5of
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& "*< )pnJ
;W{2\ Es
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN w~4T.l#1
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& G , e!!J
#(7^V y&
If BytesWrite < pBufferSize Then [,L>5:T
ArrayToBMP1 = False O!se-h5mW8
End If >t#5eT`_ w
zb3,2D+ P
CloseHandle hTmpFile fU<_bg
F1*xY%Jv^M
End Function Yz)+UF,
/Bq4! n+
'使用该过程建立的文件要求在用后关闭 +\-cf,WkI
Public Function ArrayToBMP2(File As String) As Boolean v`
h n9O
AZ>F+@ d
Dim BytesWrite As Long R =kXf/y
% 0Ibi
ArrayToBMP2 = True (T!#7
#
Rhtaq9
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ @.)WS\Cv#E
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) W#&BU- |2
]w0_!Z&
If hTmpFile = 0 Then ',Y`\X
ArrayToBMP2 = False sm Kp3_r
Exit Function Gv&%cq1
End If 8 qlQC.VA[
dWTc3@xd
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN A01PEVd@A
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& J4 %"38l
f|6
Y
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN `ztp u
~?
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& pz= /A
^P|Zze
zwU
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN RiG]-K:
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& _1G;!e O
NY?pvb
If BytesWrite < pFrameSize Then tH=jaFJ
ArrayToBMP2 = False 4s9q Q8?
End If &'k
:?@J[
%
6\L^RP
CloseHandle hTmpFile < &kl :|
O1Ynl` }
End Function >
-,$
s2`} ~
Private Function TESTSignal() As Boolean h0] bIT{
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long vM?,#:5
U1Y0G[i)
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) cs9"0&JX
"[ieOFI
If extsign = 1 Then kho$At)V
TESTSignal = True uuQsK. S
Else RdB,;Um9f
If extsign = 0 Then MU4 BAN
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly j-d542"
TESTSignal = False WMS~Bk+!
Exit Function #+H3b!8=
End If 5 qMP u| A
End If !?" pnKb}
v} \Fbe
'测试视频输入类型 H#M;T jR
'video type A
p~6Vu
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 [HhaBy9
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) l{QlJ>%~{;
If videotype = 1 Then WDI3*
'"隔行信号(Interlaced)" #y'p4Xf
Else dVMLn4[,MA
If videotype = 0 Then v6 H!.0
'"逐行信号(Non-interlaced)" $9h^tP'CV
Else (coaGQ@d
If videotype = -1 Then P{HR='2
' "不支持" ymn@1BA8J
End If Gd`s0
1GKQ
End If hcpe~spz9|
End If &14xYpD<
nub!*)q
'测试垂直扫描线数 558 !?kx$
'video scanlines ,#bT
scanlines = -1 wlQ
@3RN>
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) ]E.\ |I(
If scanlines = -1 Then \ E
6 0
' "不支持" ;{Yr
|
Else kZ;Y/DH
'Trim(Str(ScanLines)) + " 行数/幅" -Un"z6*
End If I+QM":2
7pN&fAtj/
'测试帧频 Gzp*V r
'video field frequency "pO** z$Z
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) g 'Wr+( A_
If fieldfrq = -1 Then {mY=LaS<
'lblSignal(8) = "不支持" V/xjI< ,
Else 3e>U(ES
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" <kJ`qbOU
End If vR
(nd
End Function r)B55;*Fh
hY /qMK5
W6RjQ1
Sub PicIdentify() w4FYd
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 9VMk ?
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 vXZ
)
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 MAp#1+k
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 9rIv-&
7'm
^9]g5.z:
Dim fPTR As Long, cFrame As Long |tC= j.
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer nt@uV wfQ
?4#
]x66/O\0u
cFrame = 0 21my9Ui]
A @;{ #.O
*to#ZMR;!
Do While cFrame < tFrames e0]#vqdO
lt yhYPS
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) +Ht(_+To1
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) ] z]=?;ty%
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize g][n1$%
vsPIvW!V
frmRecord.RText.Text = Str(cFrame) a]J>2A@-I
frmRecord.RText.Refresh p q%inSY
4&%E?_M
If CheckMark = True Then h7 mk<
ArrayToBMP TmpBMP oN)I3wO$
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) W.59Al'
frmRecord.RText.Text = "第" & Str(cFrame) & "帧"
;I6C`N
d6ifJ
DrawSlice cG (%P$
vs>Pd |p;
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) #=72 /[
'If i = vbNo Then Ff d4c
' Exit Do 0>"y)T3
'End If r ?|(t?
'cFrame = cFrame + 1 % .wx]:o
pU<GI@gU
End If QVah4wFL*.
DoEvents P`S'F_IN
cFrame = cFrame + 1 t~
$8s G\
Loop C`uL
4r
End Sub P~V ^E fz{
@V&HE:P
{suQ"iv
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 5=fS^]- F
) NTpb
'如标志区模式反差存在则为TRUE，否则返回FALSE p&\DG
^Nt^.xi7
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long Nrq/Pkmy
CheckMark = True 8bf@<VTO _
ti 3S'K0t
'复制标志区 (=j/"Mb
For i = 1 To mkH fl4 0jo]
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW %L$ ?Mey
Next i O|+$ 9#,
a
p( PI?]X
For j = 1 To PilarW * PilarH / 2 7 #N
?{3i
mTop = mTop + MKpilar(j) e(FT4KD~
Next j [x-
9m\
h
rHqP[[4B'
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH \= $G94%
mBot = mBot + MKpilar(j) ftQ;$@
Next j 1r5Z$3t\
7+Nl)d:C J
mTop = mTop / PilarW / PilarH * 2 (!?%
"e
mBot = mBot / PilarW / PilarH * 2 =BbXSwv'(
wKoar
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 =iB$4d2
7jr+jNsowj
'平均值极值化 6W ~JM^F
For j = 1 To PilarH * PilarW qxcTY|&
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) 2@Q5Ta #h
Next j 9? ^0pR p
"Z~@"JLb%
mTop = 0: mBot = 0 .krEfY&
For j = 1 To PilarH * PilarW / 2 \w&R`;b8w
mTop = mTop + MKpilar(j) }2^qM^,0
Next j z@~mu
ZXf&
pqmG
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW $@w ,9J\
mBot = mBot + MKpilar(j) C' WX$!$d
Next j mR t/ d
Galh _;=
/> uE)R$
mTop = mTop / PilarH / PilarW * 3 U lCw{:#F
mBot = mBot / PilarH / PilarW * 3
m8 eoD{
F&
Rr&m
xZ* B}O{{H
If mBot > iWhite And mTop < iBlk Then +Y2D @K?)
CheckMark = True o5YL_= 7m
Else 9!0- ~,o
CheckMark = False I ]42R;Sc
End If ?T,a(m<i {
End Function Xc&J.Tw#4*
D( y
c
Sub Capture1Frame() B,` `2\B
okCaptureTo hBoard, BUFFER, 0, 1 'single LoSrXK~0~J
okGetCaptureStatus hBoard, True o=PW)37>
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize Hd TB[(
End Sub YRv}w3yQ
1;!dTh
sxdDI?W4
Sub CopyMark(iBlk As Integer, iWhite As Integer) crx%;R
'复制标志区并返回标志区暗区与亮区的亮度平均值 o)Px d
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 r=xec@R]*
mR|']^!SE
'复制标志区 K,+z^{Hvh
For i = 1 To mkH )`2ncb
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW &x4*YM h
Next i { D E4PE`
:G=
ol2Q
For j = 1 To mkW * mkH / 2
-
/cf3
mTotal = mTotal + MKpilar(j) ) r"7" i
Next j r1z +yx
n?S)H=
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 Hq&MePl[
:.f( }sCS
mTotal = 0 p9 !jM\(
For j = mkW * mkH / 2 + 1 To mkW * mkH G @]n(\7Y
mTotal = mTotal + MKpilar(j) |x=(}g
Next j ?;Da%VS3
] ki) (Bb
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 +i
}uRO
[#AI! -
'背景亮度 xa 967Ki9"
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW ,Ww.W'#P
For i = 1 To 4 * FrameW 1c *:"
k
bsTotal = bsTotal + BsLine(i) P,7R/-u 5D
Next i &'/bnN +R
bsAV = bsTotal / FrameW / 4 WpMm%G~'4t
zQ+
%^DT1
End Sub QtcYFf
g
$O fZp<M
!Q}Bz*Y
Sub AdjIMGbright(Optional bInit As Boolean = True) j'Gezx^.<e
iAeq%N1(0
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） + (`.pa z@
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 tVNFulcz$
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 AmUH ]+5KT
vrh2}biCR
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer @wVDe\% ,
M+)ENv e
'按标准亮度与对比度采集一帧，确定背景亮度 U}
Pr 1
currentContr = 128 '初始对比度 .3 SP# mI
currentBr = 128 '初始亮度 I9nm$ ,i]7
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 g6$\i
m
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 -I z,vd
DoEvents ^rGuyW#
Capture1Frame ) bd`U
'获得图像上缘4行象素 *ozXilO
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW d" a\`#
CopyMark iBlack, iBright '图像标志区亮度 =tX"aCW ~
For i = 1 To 4 * FrameW .eCUvX`$
bsTotal = bsTotal + BsLine(i) QVmJ_WT
Next i D+w ?
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 ti R i_
[(vV45(E
Select Case bsAV {@'#|]4y.
Case 0 To 60 '夜间通过灯光照明,完全没有背景 <"S`ZOn
currentBr = 150 cnDF`7xrT
currentContr = 60 g3 !<A*<
Case 61 To 80 '有可见背景 A6xN6{R!
currentBr = 140 D D 6K[\
currentContr = 70 DZ:$p.
Case 81 To 100 '有清晰背景 B"`86qc
currentBr = 128 Dwe
F8 c
currentContr = 80 !G<gp4Js+N
Case 100 To 150 '有明亮背景 p77=~s
currentBr = 140 '5:30-6:00钟实测数据 ;g?o~ev 8
currentContr = 50 1 l^ `
Case 151 To 180 zQB1C
currentBr = 130 k`\L-*:Ji
currentContr = 60 O7J V{ '?
Case 181 To 220 '背景全为白色 4F!%mMq
currentBr = 110 7c<_j55(
currentContr = 130 Y$fF"p G?
Case 221 To 255 '背景全为白色 hn$jI5*`
currentBr = 100 K]^Jl0
currentContr = 100 )
/z+W[t
End Select II\}84U2
.
7{V N27Fa_
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 <! *O[0s
Case 100 To 150 B9`_~~^U5
currentBr = currentBr - 10 R-2Aby ts2
Case 151 To 255 +JB*1dz>8
currentBr = currentBr - 20 &O5&pet
End Select I] Z"?T
RGBntp %
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 }{[p<pU$C
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 a!&m\+?
End Sub 51;Bc[)%
sD6vHX%
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) COxJ,v (
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long ,0?3 k
,8DjQz0ZPo
For i = 1 To 8 b8 6c[2
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& \=(U tro
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& J6nH
|s8
Next i xo( >nFjo
bOr6"nn
For j = 1 To 1024 X1Kze
L1 = L1 + LeftBK(j, 0) Hx9lQ8
L2 = L2 + LeftBK(j, 1) I@1VX5
R1 = R1 + RightBK(j, 0) $SzuUI
R2 = R2 + RightBK(j, 1) " "CNw-^t
Next j "msPH<D
diffL = Abs(L1 - L2) / 1024 >/.Ae8I)
diffR = Abs(R1 - R2) / 1024 L f;Uv[^c
End Sub R78P](1\>
B"t4{1/
Function CheckSlice() As Boolean _1jeaV9@
CopySlice avSL, avSLR, avSLL /~g.j1 g
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then !1
<>][F
CheckSlice = True C2L=i3R
Else +('=Ryo T
CheckSlice = False 8vj ]S5
End If g&/r =U
End Function JK'tdvs~
l 1BAW$
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) .G/RQn]x}
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long Zj)A%WTD,
For i = 1 To FrameH ;F/s!bupCM
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize oCK
n
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize Gd|jE
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize iH-(_ $f;
Next i `Tr !Gj_
For i = 1 To FrameH cejD(!MKe
For j = 1 To sSize .]; `
total = total + Slice(j, i) {y<E_y
x1
totalL = totalL + SliceL(j, i) p(y HB([8
totalR = totalR + SliceR(j, i) y p pZ@
Next j )<T2J0*
Next i T1RICIf 1F
avSL = total / FrameH / sSize QQ9 9sy
avSLR = totalR / FrameH / sSize h gdr\
F
avSLL = totalL / FrameH / sSize OV-# 8RXJ
End Sub )r
XUJ29.
LEAU3doK;
Sub DrawSlice() h 3p~\%^
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B 3\|PwA9fN8
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B 1R#1Fy%
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B rWp+kV[Ec>
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) u TmT'u:}
End Sub O5JG!bGE_F
Sub DrawMark(pic As Control) 7[M@;$
Dim i As Long, j As Long |W SvAM3
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B :eSwXDy&
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B &qm:36Y7Xg
For i = 1 To PilarH Pj7MR/AH
For j = 1 To PilarW F&OcI.OTXF
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) )!sjXiC!h
Next j k[1w] l8
Next i &Z+.FTo
End Sub %k k~qvW
? cD_\~
Function avIMG() As Integer (>-(~7PR
Dim i As Long, j As Long, totalIMG As Long [t]q#+Zs
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize sv#/ 78 ~|
For i = 1 To pFrameSize D Z=OZ.v
totalIMG = totalIMG + pBuffer(i) *#B"%;Ln
Next i gv,%5r0YOw
avIMG = totalIMG / pFrameSize ahw 0}S
End Function D ~NWP%H
? T>N vK F
Function avRegion(barCol As Integer, barWidth As Integer) As Integer 3 e|,Z'4}4
Dim i As Long, j As Long, totalIMG As Long M:%Ll3
For i = 1 To FrameH N&W7g# F
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth @Z@S;RWSU
Next i '~pZj"u y
For i = 1 To FrameH * barWidth _D1)_?`a@-
totalIMG = totalIMG + pBuffer(i) /$UWTq/C7
Next i eS2VLVxu
avRegion = totalIMG / pFrameSize f /i[?
gw
End Function 1tH#QZIT
