这才是我当年写出的一个比较烂的程序 nH-V{=**
{XCf-{a]~
Main2.bas PnYBy| yl
g(4b
Ba9y
Attribute VB_Name = "SubMain" quxdG>8
Option Explicit 7'lZg<z{~j
mY7>(M{
'采集文件与临时文件 r@G#[.*A>
Public Const TmpFile As String = "d:\30-0600.dat" m#7*:i&@Y
'已有数据:30-0600.dat /30日早6点进车与6:30出车头 [1yq{n=
f 2YLk
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Ea $aUORm
Public hBCFile As Long '记录采集参数的文件 R.9V,R5
Public Const TmpBMP As String = "d:\1.bmp" c1XX~8
Public hTmpFile As Long YN/}9.
a;AzY'R
5*-3?
<)e
'采集窗口参数常量 &qM[g9
Public Const FrameH As Long = 280& 8V/L:h#7
Public Const FrameW As Long = 768& +9;2xya2
Public Const pFrameSize As Long = FrameW * FrameH >SbK.Q@ei
L=;
-x9
'标志区范围,用于识别车辆 sW@krBxMv
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X "sUyHt -&
Public Const mkW As Integer = 28 '识别标志立柱宽度 vX|UgK?2^
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) T^.Cc--c
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) /~p+j{0L3W
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 }T_Te?<&
'车缝检测位置常数 Wr?'$:
Public Const sSize As Long = 32& K }$&:nao
Public Const sPos As Long = 310& ca<"
Public Const sPosL As Long = 200& K%5"u'
Public Const sPosR As Long = 500& U9hS<}<Ki
'车缝检测框位置 4Y \wnwI
Public Slice(1 To sSize, 1 To FrameH) As Byte r(A.<`\
Public SliceL(1 To sSize, 1 To FrameH) As Byte #I*QX%(H#
Public SliceR(1 To sSize, 1 To FrameH) As Byte 4=8QZf0\
Public avSL As Integer, avSLR As Integer, avSLL As Integer d^E [|w;
/8'S1!zc
G
X{XdJD
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析,比使用二维数组更便于VB编译优化 uBrMk
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 iEyeX0nm
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 @R|'X
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long R:aa+
MX(1
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte qoMfSz"(
'前后帧左右上角128列*8行像素块,根据平均值差绝对值判断进车方向 J @IS\9O
gb|Q%LS9R
zbkMFD.{y
f .
}c7
'一次连续采集的帧数 WYcA8X/
Public tFrames As Long C~%
1w%nn
5VW|fI
'在采集卡申请的缓存中,是按帧为单位的,每一帧包含奇偶场两场的数据 nw:-J1kWR
'而该卡的硬件设置是按场采集,只需要读第一场的数据即可。 #U
mF-c
'所以要设置的缓存帧的大小是frameW*frameH*2,而一场的数据量为pFrameSize iA
}vKQ
9LJZ-/Wq
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte
t+uE
Public pBuffer(1 To FrameW * FrameH * 2) As Byte \*t~==WB
Public pWorkSpace(1 To FrameW * FrameH) As Long -V.d?A4"
Public Const pBufferSize As Long = FrameW * FrameH * 2 _HOIT
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 $.%rAa_H
f9$xk|2g
Public hBoard As Long '采集卡标识 E0n6$5Uc?
Public mBufferAddr As Long '缓存地址 G\d$x4CVGc
Public BufferSize As Long '缓存大小(字节) O[@q%&_
Public iCurrentCard As Long l `9t
}
Public CapStatus As Long yY).mxRN
Public iFrames As Long i yesD
Public currentBr As Byte, currentContr As Byte _l`e#XbG
/b#l^x:j
Public hMEM As Long, mStatus As Long OX]V)QHVZ
Public Const hMemSize As Long = pFrameSize * 4 I^\&y(LJF
Public hMemWork As Long >o,^b\
Public Const hMemWorkSize As Long = pFrameSize * 5 =@x`?oe v
R"v 3!P
),:c+~@@kT
o`S
?
'串口接收轨道衡数据 V N{NA+I
Public WeightFromCom As String rZXrT}Xh{W
Public bReceiveComplete As Boolean k44Q):ncY7
1Tp/MV/>
bPKOw<
Public Type GrayBMPHeader da!P
0x9p
Tag As Integer k;W@
LfP
FileLength As Long '文件大小 aW_oD[l
Reserve1 As Long nuQ]8- ,
DataOffset As Long '图像数据偏移量 x3+oAb@o/
BMPHeaderSize As Long '文件头长 hB;VCg8
'length of the bitmap info header used to describe the bitmap colors, compression,… -_OS%ARa
'the following sizes are possible: 9p* gU[
'28h - windows 3.1x, 95, nt, … Lo.rvt
'0ch - os/2 1.x 8)*2@-Rp
'f0h - os/2 2.x `
mfq
2bVc
x\e;+ubt}
ImageWidth As Long '图像宽(像素数) VSX@e|Nj
ImageHeight As Long '图像高(像素数) uP $Cj
PlaneNumber As Integer '图像层数 ,8'>R@o
bpp As Integer 'bits per pixels '1 - monochrome bitmap g^Yl TB
'4 - 16 color bitmap yM.IxpT#$
'8 - 256 color bitmap u^Ku;RQo
'16 - 16bit (high color) bitmap "ICC
B1N|
'24 - 24bit (true color) bitmap w8Q<r.
'32 - 32bit (true color) bitmap oTjyN\?H
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) 75T_Dx(H
'1 - rle 8-bit / pixel (also identified by bi_rle4) 9# 4Y1L S)
'2 - rle 4-bit / pixel (also identified by bi_rle8) E_z;s3AXQ
'3 - bitfields (also identified by bi_bitfields) <yA}i"-1W
IMAGESIZE As Long '图像数据字节数 Cs3^9m6;d
hResolution As Long '水平分辩率 像素数/米 :'L2J
vResolution As Long '垂直分辩率 ]va>ex$d
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 F'}'(t+oAm
ImportantColors As Long /wShUR{
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 q<W=#Sx
End Type EI~"L$?
Rgy-OA
g6t"mkMY
L
3chPY4~A
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader inb^$v
Public sRECT As RECT O4
3YY2
POI.]1i
INs!Ame2
Public conn As ADODB.Connection Ox!U8g8c
Public rsTrain As ADODB.Recordset %q
;jVj[
Public rsOperater As ADODB.Recordset QS.>0i/7l
Public rsGoods As ADODB.Recordset h5_G4J{1
Public rsGood2 As ADODB.Recordset g1E~+
@
Public rsSender As ADODB.Recordset @H
b'8F
Public rsReceover As ADODB.Recordset +yob)%
Public rsTrainTMP As ADODB.Recordset 1F8 W9b^D
\`<cH#
u6V/JI}g
'打开采集卡 WO5O?jo'
'设置参数 ~[o4a '
'设置为实时单帧采集到缓存方式 4BYE1
fUzd
'由另一线程查询采集状态,如果完成采集,传送至用户数组分析或保存 _ZB\L^j)
s.Y4pWd5@
\`V$
'B{.
Sub Main() %_-zWVJ
Dim i As Integer, status As Long Di_2Plo)4
Y/<lWbj*A
InitBMPinfo -ezY= 0Q&
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 sZWaV4
BMPHeader.Tag = &H4D42 /
O/`<
BMPHeader.ImageWidth = FrameW J&/lx${
BMPHeader.ImageHeight = FrameH B$3 ?K
BMPHeader.BMPHeaderSize = &H28 RgdysyB
BMPHeader.PlaneNumber = 1 +6$g!S5{
BMPHeader.bpp = 8 -$VZtex
BMPHeader.Compression = 0 ^mWybPqx
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 q LL,F
BMPHeader.vResolution = &H1274 `nXVE+E@
BMPHeader.ColorsinBMP = 256 h}_~y'^!
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP AmPMY:1i"
BMPHeader.DataOffset = Len(BMPHeader) 7\zZpPDV
For i = 0 To 255 G0 J4O!3
BMPHeader.Pallate(i) = RGB(i, i, i) AE`We
$!
Next i
9fnA
BMPHeader.IMAGESIZE = FrameH * FrameW i@5[FC
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE ]?1Y
e8>Y<
5Z/GK2[HL
o;a:Dd
MoveMemory BMP1, BMPHeader, Len(BMPHeader) \@3Qi8u//
cq&*.
BMP1.ImageWidth = FrameW GPhl4#'
BMP1.ImageHeight = FrameH * 2 _-!sBK+F
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight yH 9!GS#
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE PP~rn fE
/v|"0
'确定标志位置,为pilarX, pilarY确定初始值 ZoB*0H-
PilarW = mkW kd:$oS_*s
PilarH = mkH '此两项为固定值 m"\:o
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) W%2
80\h
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 1axQ)},o@p
1% F?B-k
&c(WE
RW?-
'连续采集记录文件 jCAC
`
' 建立一个缓冲区为页对齐方式的文件 7'-L
p@an
If Dir(TmpFile) <> "" Then >SN|?|2U/
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ r)9Dy,
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 4to% `)]
' 在95/98中,如果打开文件时没有声明overlapped方式,在读定文件时就不能使用overlapped参数项 PjT=$]
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 S d/?&
Else -!;l~#K=
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ H7Uli]e3
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) jc[_I&Oc_
End If ,ox
cq?7#4
If hFile = 0 Then )3YtIH_
MsgBox TmpFile & ": File Open Error", vbOKOnly =(a1+.O
Exit Sub s5.AW8X=?*
End If xqXDxJlns
'采集参数记录文件 _I`,Br:N
hBCFile = FreeFile() 5J)=} e
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Ok7t@l$
do-ahl,
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 "LYh7:0s!k
If hMEM = 0 Then o@]So(9f
fStatus = GetLastError H.<a`mm8
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ Q-Ux<#
& "请向技术人员报告该错误代码。", vbOKOnly 2$_9cF Wm
CloseHandle hFile JjpRHw8\
Exit Sub ?&LZB}1
R
End If `~eX55W
)k&a}u5y
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 9`jcC-;iv
If hMemWork = 0 Then ;4M><OS!
fStatus = GetLastError M/?KV9Xk2
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ R+q"_90_
& "请向技术人员报告该错误代码。", vbOKOnly )VCzn~uf
'释放已成功分配的内存 "'8KV\/D
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) kg][qn|>J]
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) x83
!C}4:
N"/-0(9[
CloseHandle hFile lkyzNy9R
Exit Sub G2LK]
End If ^=n+T7"J
I1X/Lj=
' Test writing (Rk_-9_E.
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ^JZ^>E~
f\+fo
'初始化采集卡参数 =cN&A_L(
iCurrentCard = -1 ~U(,TjJb
hBoard = okOpenBoard(iCurrentCard) L%v^s4@
Debug.Print hBoard L@75-T
If hBoard = 0 Then .6O"|
Mqb
ExitGrabber PkE5|d*,
End y-p70.'{U
End If gj\)CBOv
okGetBufferSize hBoard, mBufferAddr, BufferSize _LAS~x7,
If mBufferAddr = 0 Then ^_5L"F]sP
MsgBox "缓存不存在!" W"{v2x i
ExitGrabber IM$2VlC
End If /(.6bv
Debug.Print Hex(mBufferAddr), Hex(BufferSize) #po5_dE\*
>{eCh$L
zWpqJ
K
currentBr = 128: currentContr = 128 PiV7*F4qI.
'设置视频输入参数 e__@GBG
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 }>^Q'BW;65
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input E_F5(xSA
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 >e2<!#er|
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 {7cX#1
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 +$xeoxU>;
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 )&era` e[
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行(低字)同步开槽(高字) 6Ao%>;e*
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移,低字X偏移 (144/44经验值) ccC
zu6
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小:低字X高字Y (768/576采集卡最大值) -U<Upn)2
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 JGC=(;
Z3k(P
'设置采集参数 1:NrP'W^
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 O3N0YGhJ
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 Zh5RwQNE~
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 aK,z}l(N
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 @prG%vb"
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 t
E` cau
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 x}U8zt)yD3
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 BR'I
+lQ
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 *5zrZ]
^
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 j-CnT)W<
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 !zPG?q]3
'Buffer Block Size不用设置,而用okSetTargetRect函数进行动态调节 Tu{
h<Zy
Lb{e,JH
h2ZkCML
okCloseBoard hBoard 2j(h+?N7k
Sleep 50 nf1#tlIJd
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 nd;fy$<J\
ZYf2XI(_"
'设置数据传送方式 ,f}UGd[a
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 2^t#6XBk/
'该设置对本程序无意义,因为程序直接用CopyMemory方法读缓存,而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 -",=G\XZ
7
NC=*A~
sRECT.Right = -1 '用于获得当前设置值 -p-B2?)A
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) )$w*V9d
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 9ukg }_Hx
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 +\li*G]:J
sRECT.Left = 0 vHAg-Avc
sRECT.Top = 0 1)}=bhT
sRECT.Right = sRECT.Left + FrameW !R*-R.%
sRECT.Bottom = sRECT.Top + FrameH * 2 j1SMeDDM
~
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) =fm]D l9h*
bX.ja;;
sRECT.Right = -1 '检查新设置值 )uv=S;+
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) *A}cL
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom $Vc~/>
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) QKN<+,h!z>
kc7lc|'z
If TESTSignal = False Then o7B[R) 4
'ExitGrabber =#mTfJ
End If @
S <-d
9Rek4<5
>0{S
$?,a[79
'设为实时采集状态 7&KT0a*
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) Ngb(F84H?
/h
v4x9
2tROT][J%
'单帧采集 h25G/`
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 Rwr 2gMt7
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) aNyvNEV3C
okCaptureTo hBoard, BUFFER, 0, 1 'single f84:hXo6
'Do While okGetCaptureStatus(hBoard, False) <> 0 kc/{[ME
' Sleep 20 )}TLC 2%
'Loop \%
sVHt`c
okGetCaptureStatus hBoard, True h._nK\
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize @fuM)B1"
'写入768*576测试图象 t_ksvWUo
ArrayToBMP TmpBMP :K\mN/ x
Q'k\8'x
'打开数据库 o!:8nXw
Set conn = New ADODB.Connection `/Nm
2K
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ p8s:g~ W
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _
;> m"x
"; Mode=Read|Write" [^8n0{JiN
conn.Open L< zD<M
vP7K9Kx
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) -XRn~=5
frmRecord.Visible = True tO_H!kP
frmQuery.Visible = True 2+Px'U\
Load frmReceiveFromComm Y(\T-
bI
#fj/~[Ajv
'调试参数 !*2%"H*
If InStr(UCase(Command()), "/CAPTURE") > 0 Then qQ!1t>j+H
SignalBox.Visible = True #W.vX?-'0
End If ;q0uE:^S
If InStr(UCase(Command()), "/COMM") > 0 Then Qb8
KPpd
frmReceiveFromComm.Visible = True p3/*fH98
End If 2
_Wg!bq
pfx3C*
End Sub 6#j$GH *
@/r^%G
Sub ExitGrabber() d:G]1k;z
'关闭数据库 Ro2d,'
'关闭采集卡 R<i38/ ~G
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) AxxJk"v'y
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) DK0.R]&4(
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) &V>fYg
ui
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 3] 1-M
okStopCapture hBoard T[=S$n-'
okCloseBoard hBoard "EU{8b
CloseHandle hFile
"O8gJ0e
Close #hBCFile v/ *Y#(X
conn.Close >NB?&|
End
E7Cy(LO
End Sub X=8Y%
H:p Z-v*
Function ArrayToBMP(ByVal File As String) =8gHS[
Dim BytesWrite As Long B\g]({E
i{D=l7j|w
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ C"lJl k9g^
CREATE_ALWAYS, 0&, 0&) yL;M"L
9Lh|DK,nV/
If hTmpFile = 0 Then B2Xn?i3 l
ArrayToBMP = False ~}K5#<
Exit Function H3{GmV8
End If i(?,6)9
K78rg/`
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN -@>BHC
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& +n}$pM|NKU
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN e!fqXVEVR
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& 9w9jpe#
6<0n *&
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN (M
=Y&M'f
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& qS&%!
UD~p'^.m_
If BytesWrite < pFrameSize Then B3Jgd,
[
ArrayToBMP = False TpA\9N#$
End If PA6=wfc
T32BnmB{
CloseHandle hTmpFile _LwOOZj
[FUjnI
End Function (Qgde6
l"n{.aL
Function ArrayToBMP1(ByVal File As String) T5Dw0Y6u,
kt4d;4n
Dim BytesWrite As Long S4witIK5
S osj$9E
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ j@Qg0F
CREATE_ALWAYS, 0&, 0&) !ZDzEP*
10#oG{9
If hTmpFile = 0 Then Sx
ArrayToBMP1 = False O4<g%.HC6
Exit Function uP\lCqK,
End If Kb =@ =Xta
Bx[rC
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN /~4"No@
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& 2iu_pjj
Av0y?oGH
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN `Q+moX
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0&
{_RWVVVe
>:=|L%]s;\
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN -T6
(hT\
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ]d[ge6
?S
?2 0
If BytesWrite < pBufferSize Then >zkRcm
ArrayToBMP1 = False `V[!@b:
End If Ifk#/d
kP xa7
CloseHandle hTmpFile 5>J=YLq
7VK}Dy/Vvn
End Function 0?WcoPU
q
H"Gm
'使用该过程建立的文件要求在用后关闭 v){ .Z^_C
Public Function ArrayToBMP2(File As String) As Boolean ^$%Z!uz
H'
T
Dim BytesWrite As Long RFh"&0[
g<*BLF
ArrayToBMP2 = True B12$I:x
`
J8y0d1SG
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _
EkT."K
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) Iqs+r?
C@N1ljXJT
If hTmpFile = 0 Then mj?16\
|]
ArrayToBMP2 = False k%[3Q>5iM
Exit Function e6=]m#O9
End If y]%w )4PS
%AF5=
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN +l^LlqA
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& 6.t',LTB
R{,ooxH\J
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN */ G<!W
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& CukC6ub
BQ^H? jo
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN UN"(5a8.
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& Khh0*S8.K
7^}Ll@
If BytesWrite < pFrameSize Then |%~+2m
ArrayToBMP2 = False vi@Lz3}::
End If EL3|u64GO
(h']a!
CloseHandle hTmpFile B7\k< Nit0
q.Nweu!jQ
End Function 6)pH|d.FR
*%Qn{x
Private Function TESTSignal() As Boolean 61U<5:#l
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long lCW8<g^
rzp +:
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) C1T_9}L-A
b'zR 9V
If extsign = 1 Then !~_zm*CqbZ
TESTSignal = True ZxGP/D
Else }0,>2TTDN
If extsign = 0 Then y {q*s8NY
MsgBox "无视频输入信号,检查摄像机电源!", vbOKOnly uH3D{4
TESTSignal = False e
lG;jB
Exit Function 3cj3u4y
End If M>jtFP<S
End If $ _8g8r}
W"L&fV+3
'测试视频输入类型 {;2i.m1
'video type :hG
PTf
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 %iJ%{{f`
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) \b}~2oX
If videotype = 1 Then H7i$xWs
'"隔行信号(Interlaced)" ozsxXBh-`'
Else MJj4Hd
If videotype = 0 Then H1!iP$1#V
'"逐行信号(Non-interlaced)" %7Kooq(i
Else T+LJ*
I4
If videotype = -1 Then
>]'yK!a?
' "不支持" .@iFa3
End If `"vZ);i<
End If ck#"*],
End If }U@m*dEG
-
Xz?s
'测试垂直扫描线数 9>/wUQs!]
'video scanlines `SO|zz|'
scanlines = -1 %tA57Pn>
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) =TR,~8Z|
If scanlines = -1 Then S{',QO*D6
' "不支持" eUS
Else -{h
'Trim(Str(ScanLines)) + " 行数/幅" >#+IaKL7
End If Bs`$ i ;&
4Z[V uQng
'测试帧频 g%[n4
'video field frequency -ZW0k@5g
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) ,n2i@?NHZ
If fieldfrq = -1 Then J H.K.C(
'lblSignal(8) = "不支持" 0;,IKXK6X
Else 4LI0SwD#^/
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" SFH-^ly&D
End If ()PKw,pD
End Function Hy{
Q#fq
=1dI>M>tm
V+?]S
Sub PicIdentify() Z?MoJ{.!?R
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 ^"8G`B$r
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 {Hr$wa~
'判定标准:如果在立柱位置上有明显的模式反差,则视为车皮之间的间隔 r%Rs0)$yj
'方法:对立柱标志区进行平均值二值化,面积为32*40,亮区(255)与暗区(0)的亮度平均值理论差大于200倍,实际差值应不小于100倍 u%2<\:~j
XwM611
Dim fPTR As Long, cFrame As Long 59(U `X
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer elJ)4Em
h72UwJ2rw
`h;k2Se5
cFrame = 0 "s
W-_j]
o6"*4P|
!BU)K'mj
Do While cFrame < tFrames .AV)'j#6P
_9:@Vl]Q@
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) nW\(IkX\
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) Z: 2I/
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize lA>\Ko
R)!`JKeO/
frmRecord.RText.Text = Str(cFrame) /Tz85 [%6
frmRecord.RText.Refresh ,1Qd\8N9
4X
NxI1w)
If CheckMark = True Then '%v#v 3'
ArrayToBMP TmpBMP m9M
FwfZ
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) ,]R8(bD)
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" c*\<,n_
HOt>}x
DrawSlice 8:ggECD
U7
&x rif
'i = MsgBox("检测到立柱:第" & Str(cFrame) & "帧", vbYesNo) ^=cXo<6D
'If i = vbNo Then ba@ax3
' Exit Do ;??ohA"{5
'End If bM;`s5d
'cFrame = cFrame + 1 kfC0zd+
E_$z`or
End If p]W+eT
DoEvents 4{9d#[KW
cFrame = cFrame + 1 JU0]Wq <^[
Loop 4dH}g~[P9
End Sub ]TO/kl/
[n,?WwC
ETv9k g
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 8YY|;\F)J~
,KW;2t*IQ@
'如标志区模式反差存在则为TRUE,否则返回FALSE 8U~.\`H-PT
t
$^l<ppQ
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long "
oy\_1|
CheckMark = True jm>3bd
~WVO
'复制标志区 dOa!htx]
For i = 1 To mkH B7NtkMK
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW bC@k>yC-
Next i "YFls#4H-
)J/HkOj"V
For j = 1 To PilarW * PilarH / 2 x_@i(oQ:_
mTop = mTop + MKpilar(j) ;mm!0]V
Next j .uZ7 -l
9-h.|T2il
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH <*'cf2Q$Av
mBot = mBot + MKpilar(j) _3Q8n|
Next j (g/7yO(s
[nN7qG
mTop = mTop / PilarW / PilarH * 2 bggusK<
mBot = mBot / PilarW / PilarH * 2 5''*UFIF1
p5c8YfM
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 B_3QQtjAl
Y{Ap80'\6
'平均值极值化 pLoy
For j = 1 To PilarH * PilarW |oKu=/[K
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) ZIxRyo-i
Next j V7CoZnz
WbjF]b\
mTop = 0: mBot = 0 (VHND%7P
For j = 1 To PilarH * PilarW / 2 ?s}
%
mTop = mTop + MKpilar(j) Uv?'m&_
Next j D>ai.T%n
x49!{}
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW lpQP"%q
mBot = mBot + MKpilar(j) "#^MUQ!a
Next j P1 +"v*
a,'Cyv">
7r{qJ7$%
mTop = mTop / PilarH / PilarW * 3 #,f{Ok+
mBot = mBot / PilarH / PilarW * 3 6=|&tE
4dhqLVgL{
vg%QXaM
If mBot > iWhite And mTop < iBlk Then 2iXoj&3e
CheckMark = True f%^'P"R
Else :,]S}R
CheckMark = False L0Vgo
<A
End If /dHs &SU,
End Function >POO-8Q
=7[)'
Sub Capture1Frame() ESQ!@G/n
okCaptureTo hBoard, BUFFER, 0, 1 'single
5P^ U_
okGetCaptureStatus hBoard, True .e[Tu|qo
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize sn\;bq
End Sub $B\E.ml.
<3
@}Lj
tR`S#rk
Sub CopyMark(iBlk As Integer, iWhite As Integer) ~P1_BD(
'复制标志区并返回标志区暗区与亮区的亮度平均值 I{.HO<$7D}
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 K\=8eg93Z
='Oj4T
'复制标志区 J2Et-Cz 1
For i = 1 To mkH ;'kI/(;;C
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW QrjDF>
Next i kM*T$JqN
(*^DN{5
For j = 1 To mkW * mkH / 2 Vk<k +=7
mTotal = mTotal + MKpilar(j) vx 0UoKX
Next j u?Hb(xZtg=
?_4^le[;
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 %&] 1FhL
a#(U
2OP
mTotal = 0 M$#sc`4*
For j = mkW * mkH / 2 + 1 To mkW * mkH )y50Mb0+
mTotal = mTotal + MKpilar(j) ki\uTD`mf
Next j &W_th\%
G\Hq/4
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 /J%do]PDl
MZm'npRf
'背景亮度 (}H ,ng'4
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW &{^eU5
For i = 1 To 4 * FrameW 744=3v
bsTotal = bsTotal + BsLine(i) >Gd.&flSj
Next i ~^o=a?L`<
bsAV = bsTotal / FrameW / 4 z4Oo@3$\R
mX_)b>iW
End Sub _\AUQ{
>S&U.
N)OCSeh
Sub AdjIMGbright(Optional bInit As Boolean = True) 2bQ/0?.).-
?9?4p@
'自动调节亮度与对比度,此时处于无车辆状态(白天特别高,而夜间特别暗) n
E:'Zxj
'图像平均亮度白天不高于200(当车辆通过时可能会下降到100左右),不低于100 H:}}t]E
' 夜间不高于80(过高时通常是由于雪花噪声引起),但立柱不低于30 R8sck)k'}
}Jxq'B
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer `q?RF+
a+(j?_FyI
'按标准亮度与对比度采集一帧,确定背景亮度 O8 RzUg&
currentContr = 128 '初始对比度 *re 44
currentBr = 128 '初始亮度 a|x8=H
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 r#h {$iW
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 8GB]95JWwp
DoEvents 04-Zvp2
Capture1Frame =:K@zlO:
'获得图像上缘4行象素 Du_$C[
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW ZxSsR{
CopyMark iBlack, iBright '图像标志区亮度 +^Jwo)R'b
For i = 1 To 4 * FrameW d.}}s$Q
bsTotal = bsTotal + BsLine(i) 8]*Q79
Next i 8=H\?4)()Y
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 Lt<oi8'N
h)B!LAr
Select Case bsAV c>MY$-PD
Case 0 To 60 '夜间通过灯光照明,完全没有背景 |'w^ n
currentBr = 150 )mD\d|7f
currentContr = 60 az(5o
Case 61 To 80 '有可见背景 #tz8{o?ebN
currentBr = 140 !RMS+Mm?
currentContr = 70 _EKF-&Q6
Case 81 To 100 '有清晰背景 K+ehr
currentBr = 128 Qilj/x68
currentContr = 80 zGs|DB
Case 100 To 150 '有明亮背景 "@t-Cy:!O
currentBr = 140 '5:30-6:00钟实测数据 >}]H;&
l
currentContr = 50 #
cWHDRLX
Case 151 To 180 N du7nKG
currentBr = 130 HWtPLlNt
currentContr = 60 b.Su@ay@(^
Case 181 To 220 '背景全为白色 "Pdvmur
currentBr = 110 Q_lu`F|
currentContr = 130 RK)l8c}
Case 221 To 255 '背景全为白色 Q]i[.ME
currentBr = 100 ./iXyta
currentContr = 100 U>3
>Ex
End Select 6
o
lV+
/RF%1!M
K
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 n&7@@@cA
Case 100 To 150 ]7<m1Lg
currentBr = currentBr - 10 Sr7@ buF
Case 151 To 255 2]Fu
1
currentBr = currentBr - 20 @a;sV!S{
End Select gE=Wcb!
O]_={%
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 twbcuaCTW
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 yV_
L/,6}D
End Sub ABiC9[Q0
XARSGAuw
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) HD|sr{Z%
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long lZ a?Y@
w|G~Il
For i = 1 To 8 +FBi5h
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& NKh,z&
_5-
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& 59MR|Jt
Next i )<'yQW=6
`i4I!E
For j = 1 To 1024 32KR--mn%
L1 = L1 + LeftBK(j, 0) ,)uPGe"y
L2 = L2 + LeftBK(j, 1) .CmL7
5
R1 = R1 + RightBK(j, 0) .HD ebi
R2 = R2 + RightBK(j, 1) _W+Q3Jx-(
Next j
oP-;y&AS
diffL = Abs(L1 - L2) / 1024 d<Dn9,G
diffR = Abs(R1 - R2) / 1024 ^Ezcy?
End Sub 7,su f }=
{{zua-F
Function CheckSlice() As Boolean o[{&!t
CopySlice avSL, avSLR, avSLL R#fy60
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then /$*; >4=>f
CheckSlice = True It\BbG=
Else t'Htx1#Zc[
CheckSlice = False a@k.$
End If &Q+]t"OA!
End Function ]
zIfC>@R
#Y: ~UVV
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer)
Ys+N,:#R
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long (\uAAW"
For i = 1 To FrameH %JaE4&
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize V<W02\Hs
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize x 8M#t(hw
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize mS7E_A8
Next i ahoh9iJ
For i = 1 To FrameH h9Z[z73_a
For j = 1 To sSize z@n+7p`w
total = total + Slice(j, i) Zih
5/I
totalL = totalL + SliceL(j, i) okh0_4
totalR = totalR + SliceR(j, i) VVN#
$
Next j
u;(K34!)
Next i Ei~]
iZ}
avSL = total / FrameH / sSize aKOf;^@
avSLR = totalR / FrameH / sSize 0$?qoS
avSLL = totalL / FrameH / sSize o3= .T+B
End Sub FLEg0/m0
<[FS%2,0mb
Sub DrawSlice() JOgmF_(>Z
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B u=l0f6W
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B hgif]?:C<
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B kI]=&Rw
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) SNxz*`@4
End Sub YiBOi?h9
Sub DrawMark(pic As Control) s#`cX0L)
Dim i As Long, j As Long C &FN#B
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B X@eg<]'m
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B QS%,7'EG
For i = 1 To PilarH A ')(SGSc
For j = 1 To PilarW &0
i71!Oy
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) e18T(g_i
Next j Nq
U9/
Next i $uTlbAuv
End Sub gpsrw>nw
S#hu2\9D,
Function avIMG() As Integer &
]%\.m
Dim i As Long, j As Long, totalIMG As Long
B,:23[v
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize FBbm4NB
For i = 1 To pFrameSize n4XMN\:g{
totalIMG = totalIMG + pBuffer(i) Ol_/uy1r[
Next i B~BUWWMfp
avIMG = totalIMG / pFrameSize jUZ[`f;
End Function 7j95"mI
+}\29@{W
Function avRegion(barCol As Integer, barWidth As Integer) As Integer u4C1W|x
Dim i As Long, j As Long, totalIMG As Long b/G8Mr
For i = 1 To FrameH }o{!}g9
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth i!y\WaCp
Next i z.{HD9TD
For i = 1 To FrameH * barWidth y!BB7cK6
totalIMG = totalIMG + pBuffer(i) f5N<3 m=
Next i -
Ra\^uz
avRegion = totalIMG / pFrameSize Hq79/wKj
End Function V 3%Krn1'