这才是我当年写出的一个比较烂的程序 BKN]DxJ6
ieObo foD
Main2.bas -QRKDp
oI^iL\\2h
Attribute VB_Name = "SubMain" BV<LIrAS
Option Explicit fz:F*zT1
*G=n${'
'采集文件与临时文件 ek.L(n,J|
Public Const TmpFile As String = "d:\30-0600.dat" 'Y[\[]3[8
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 *rA! `e*
nuvz!<5\{
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long m0 `w mM
Public hBCFile As Long '记录采集参数的文件 uu(.,11`
Public Const TmpBMP As String = "d:\1.bmp" ]E`DG
Public hTmpFile As Long py)V7*CgH
0evG
, "DkMK4%
'采集窗口参数常量 ] $5r h8
Public Const FrameH As Long = 280& L -Z1Xs
Public Const FrameW As Long = 768& %!WQ;(
Public Const pFrameSize As Long = FrameW * FrameH 8R)*8bb
'*K/K],S]
'标志区范围，用于识别车辆
}UX >O
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X |gT$M _}
Public Const mkW As Integer = 28 '识别标志立柱宽度 [ 3j]r{0I
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) a-hF/~84S:
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) Q}G
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 olh|.9Kdj}
'车缝检测位置常数 Hd4&"oeY
Public Const sSize As Long = 32& :V`q;g
Public Const sPos As Long = 310& I 5
Public Const sPosL As Long = 200&
[j&>dE
Public Const sPosR As Long = 500& x *(pr5k
'车缝检测框位置 T1D7H~ \lG
Public Slice(1 To sSize, 1 To FrameH) As Byte #B54p@.}
Public SliceL(1 To sSize, 1 To FrameH) As Byte K2 NnA
Public SliceR(1 To sSize, 1 To FrameH) As Byte zVp| %&
Public avSL As Integer, avSLR As Integer, avSLL As Integer WWD\E DnS
lO<Ujb#"R
_))_mxV{
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 BHa!jw_~o
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 w)hJ0k
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 (xq25;|Y
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long W/fM0=!
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte pS51fF9
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 &bTadd%0
~bg FU
)5bhyzSZI
SdN|-'qf
'一次连续采集的帧数 T?Gi;ld7
Public tFrames As Long .0Cp qn,[
;Iw C`!(#
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 ^M8\ 3G
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 ^m?h .
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize +>{{91mN
$vicxE~-E
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte BoFJ8Ukq|
Public pBuffer(1 To FrameW * FrameH * 2) As Byte az7L0
pp
Public pWorkSpace(1 To FrameW * FrameH) As Long eml(F
Public Const pBufferSize As Long = FrameW * FrameH * 2 oU67<jq
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 C}wmoYikV
aMT&}3
Public hBoard As Long '采集卡标识 I/fERnHM/+
Public mBufferAddr As Long '缓存地址 Rg+V;C
C~
Public BufferSize As Long '缓存大小(字节) L
k`0z
Public iCurrentCard As Long 0YW<>Y`6
Public CapStatus As Long d[jxU/.p;
Public iFrames As Long TqCzpf&&h/
Public currentBr As Byte, currentContr As Byte /SSl $
i |cSO2O+
Public hMEM As Long, mStatus As Long Zb3E-'G+
Public Const hMemSize As Long = pFrameSize * 4 *|MPYxJ<
Public hMemWork As Long ?f:Fmg Qk
Public Const hMemWorkSize As Long = pFrameSize * 5 =U2`]50
tXwnK[~x
ar R)]gk
7
}[? X%=
'串口接收轨道衡数据 ZCV&v47\p_
Public WeightFromCom As String 5q@o,d
Public bReceiveComplete As Boolean jR*1%.Ng
~u7a5 0
2#ypM 9
Public Type GrayBMPHeader P 3 );R>j
Tag As Integer pl'n
0L<l
FileLength As Long '文件大小 zPZy#7/A
Reserve1 As Long e> X& [\T
DataOffset As Long '图像数据偏移量 t4
$cMf
BMPHeaderSize As Long '文件头长 Q_]O[Kx
'length of the bitmap info header used to describe the bitmap colors, compression,… ^?w 6
'the following sizes are possible: Z-Zox-I1}-
'28h - windows 3.1x, 95, nt, … (7&[!PS
'0ch - os/2 1.x iw<+rh*C
'f0h - os/2 2.x .z)& #2E
?;! l-D y
ImageWidth As Long '图像宽（像素数） !y `wAm>n
ImageHeight As Long '图像高(像素数) ga0W;Vq&X
PlaneNumber As Integer '图像层数 BPtU]Bv-
bpp As Integer 'bits per pixels '1 - monochrome bitmap a'W-& j
'4 - 16 color bitmap q=Q 5s?sQc
'8 - 256 color bitmap ;IE|XR(
'16 - 16bit (high color) bitmap |G!-FmIK
'24 - 24bit (true color) bitmap #*XuU8q?
'32 - 32bit (true color) bitmap *b ~$|H-\
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) R 8?Xz5
'1 - rle 8-bit / pixel (also identified by bi_rle4) bv-s}UP0
'2 - rle 4-bit / pixel (also identified by bi_rle8) 0vf2wBK'T
'3 - bitfields (also identified by bi_bitfields) Ol Q7Yi>
IMAGESIZE As Long '图像数据字节数 e
&#qj^
hResolution As Long '水平分辩率 像素数/米 V(w2k^7) F
vResolution As Long '垂直分辩率 ?tg(X [h{S
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 @<r
;>G
ImportantColors As Long 8.F]&D0p8
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 (?;Fnq
End Type m'@NF--#Oq
px" .pYr0
tBp dKJn##
h {qB \aK
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader JM@MNS_||(
Public sRECT As RECT d 6j '[
ut fD$8UI
j 8 _WEjG
Public conn As ADODB.Connection ?kISAA4 x
Public rsTrain As ADODB.Recordset u 6$fF=
Public rsOperater As ADODB.Recordset ['e8Xz0
Public rsGoods As ADODB.Recordset yIO oVi\m
Public rsGood2 As ADODB.Recordset ]t(;bD hT
Public rsSender As ADODB.Recordset WR%x4 \,d#
Public rsReceover As ADODB.Recordset U_B"B;ng+
Public rsTrainTMP As ADODB.Recordset =; `+^
fMP$o3;
Ks7DoXCvE
'打开采集卡 eBlVb*nmq
'设置参数 !*'uPw:l2
'设置为实时单帧采集到缓存方式 l0l2fwz(
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 4F^(3RKZ|
s^)wh v`C
rK 9X68)
Sub Main() pk:YjJs
Dim i As Integer, status As Long 5W(G~m?jC6
":tQYo]d
InitBMPinfo oX8e}
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 {?$-p%CF`8
BMPHeader.Tag = &H4D42 cEhwv0f!qS
BMPHeader.ImageWidth = FrameW lL/|{A|-j
BMPHeader.ImageHeight = FrameH ?1JS*LQ$
BMPHeader.BMPHeaderSize = &H28 s: ~3|D][
BMPHeader.PlaneNumber = 1 [2WJ>2r}6
BMPHeader.bpp = 8 uF/l,[0v
BMPHeader.Compression = 0 ej4xW ~_
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 ;n?H/(6X8>
BMPHeader.vResolution = &H1274 wspZ Eu>C;
BMPHeader.ColorsinBMP = 256 2*ZB[ 5_V
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP $& OoxC
BMPHeader.DataOffset = Len(BMPHeader) g k1I1)p
For i = 0 To 255 7 &DhEI ^
BMPHeader.Pallate(i) = RGB(i, i, i) j:0(=H!#
Next i .r[kNh@
b%
BMPHeader.IMAGESIZE = FrameH * FrameW @Q
8E)k@
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE !:'%'@uc
vdyLwBz:
5~5d%C^3k
MoveMemory BMP1, BMPHeader, Len(BMPHeader) G n>#Mvq
^
`!5!|
BMP1.ImageWidth = FrameW g/'CX}g`
BMP1.ImageHeight = FrameH * 2 'x$>h)t]
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight YQ :F Bj
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE 8F9sKRq|rO
Cu R.a
'确定标志位置,为pilarX, pilarY确定初始值 k}(C.`.
PilarW = mkW ]_G!(`Udh
PilarH = mkH '此两项为固定值 Hw-,sze j"
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) :} i
#ODJ
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 )`, Bt
[y F>W$Bn%
%ZDo;l+<F6
'连续采集记录文件 + vY8HQ|v
' 建立一个缓冲区为页对齐方式的文件 7`9J.L&,;
If Dir(TmpFile) <> "" Then /{gCf
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ gf$5pp-
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 0R z'#O32V
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 .BuXg<`
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ]k-<[Z;I,
Else w)2X0ev"
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ FZ)_WaqG f
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) H.3+5 po
End If 7j8nDX<
If hFile = 0 Then :<=A1>&8
MsgBox TmpFile & ": File Open Error", vbOKOnly &!x!j ,nT
Exit Sub N< }{oIsZ+
End If eZ'J,;
'采集参数记录文件 c!{v/zOz
hBCFile = FreeFile() B b_R~1
l
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Ei2hI
Vcm9:,Xlw
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 mR\rK&'6
If hMEM = 0 Then S:
"R/EE(
fStatus = GetLastError {9S= :
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ XT~!dq5
& "请向技术人员报告该错误代码。", vbOKOnly f| P%
CloseHandle hFile 'Y B z?l9
Exit Sub wxYB-Wh<
End If 7A@]t_83Y
Yw&{.<sL
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) zZ@]Kq;.s
If hMemWork = 0 Then @*`9!K%
fStatus = GetLastError kC"lO'
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ By%
mJ%$~
& "请向技术人员报告该错误代码。", vbOKOnly t2Q40'
`
'释放已成功分配的内存 (,z0
V+ !
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) v1*Lf/
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) >AX&PMb`
)u ) ]#z
CloseHandle hFile 35|F?Jx.r
Exit Sub @Fv"j9j-3G
End If i"V2=jTeBv
}d? "i@[
' Test writing ;-Fr^|do y
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& X458%)G!(K
x%I vd
'初始化采集卡参数 E2+x?Sc+
iCurrentCard = -1 ]k
&Y )
hBoard = okOpenBoard(iCurrentCard) o&g- 0!"
Debug.Print hBoard B! $
a Y
If hBoard = 0 Then 5v<X-8"
ExitGrabber V4@ HIM
End mltG4R
?
End If {ULy B$\-
okGetBufferSize hBoard, mBufferAddr, BufferSize Z#0hh%E"|y
If mBufferAddr = 0 Then
)GhM M
MsgBox "缓存不存在！" ^LO=&Cq
ExitGrabber BIovPvq;i
End If !*JE%t
Debug.Print Hex(mBufferAddr), Hex(BufferSize) ~ ?T*D*
+ o^b , !
@62QDlt;
currentBr = 128: currentContr = 128 k<x
%
'设置视频输入参数 *8y kE
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 Lx6C f R
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input a7KP_[_(
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 [ }-CXB
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 Ss ;C1:
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 cyu)YxT
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 %P05 k
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） ZU\TA|
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) R -CFF
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) b~uz\%' 3
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 9U$n;uA
m/ vwM"
'设置采集参数 ;[9 WB<t
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 EA_6L\+8&
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 a M I\gCB/
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 K.'II9-{
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 C QO gR GW
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 J}a 8N.S
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 8JvF4' zx
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 0].* eM
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 "_dh6naZX
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 :j2G0vHIl(
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 `hJSo?G>
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 94Wf ]
]"? +R +
>5G2!Ns'
okCloseBoard hBoard H=
S y.
Sleep 50 lrQ +G@#
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 CDOqdBQ
B^`'2$3
'设置数据传送方式 c@iP^;D
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 sY,q*}SLD
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 ,I# X[^/
N]qX^RSb
sRECT.Right = -1 '用于获得当前设置值
|_7 nvck
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
;/.ZjTRw
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom CtItzp
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 g!%C_AI
sRECT.Left = 0 9*wS}A&Jh
sRECT.Top = 0 5 7W4E{A
sRECT.Right = sRECT.Left + FrameW lB_&Lq 8G
sRECT.Bottom = sRECT.Top + FrameH * 2 H3<
`
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) e}e|??'(\
Q?]307g7
sRECT.Right = -1 '检查新设置值 Gc6`]7 s
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) #SWL$Vm>
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 2pa:
3O
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) DSiI%_[Ud
A#t #c*
If TESTSignal = False Then cEzWIS?pp\
'ExitGrabber =fy~-FN_
End If cu&td
g^q
1QkAFSl3
96M?tTa
T 9lk&7W
'设为实时采集状态 ^3`CP4DT
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) [;O 6)W
:$eg{IXC"
7/^` y')
'单帧采集 'uAH, .B
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 G+Vlaa/7
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) pi`sx[T@{Z
okCaptureTo hBoard, BUFFER, 0, 1 'single z=q
'Do While okGetCaptureStatus(hBoard, False) <> 0 ~]t/|xe
p
' Sleep 20 #IH7WaN
'Loop > 9KQWeD
okGetCaptureStatus hBoard, True eLC}h %
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize PP{ 2{
'写入768*576测试图象 h|z{ (v
ArrayToBMP TmpBMP Zr!he$8(2
O}VI8O B(&
'打开数据库 GMLDmT V
Set conn = New ADODB.Connection er
G@8CG
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 'J*)o<%
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ GS1Vcav
<
"; Mode=Read|Write" CH
h] v.V
conn.Open tTa" JXG
OG}auM4
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) /y2 upu*!
frmRecord.Visible = True X[pk9mh
a
frmQuery.Visible = True G}.t !"
Load frmReceiveFromComm \g|u|Y.2[
p_z_d6?
'调试参数 &j2fh !\4
If InStr(UCase(Command()), "/CAPTURE") > 0 Then 9D
2B 8t"a
SignalBox.Visible = True l+ $ e|F
End If b.Wf*I?
If InStr(UCase(Command()), "/COMM") > 0 Then -.#He
frmReceiveFromComm.Visible = True .^]=h#[e
End If ?9<byEO%M
Id->F0x0
End Sub WHh=ht s\
C/nzlp~
Sub ExitGrabber() iM'{,~8R5
'关闭数据库 n|,kL!++.
'关闭采集卡 -t28"jyj
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 3PS( 1
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) =l&A9 >\
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) RJMrSz$
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) XsE] Z4
okStopCapture hBoard E2f9J{ Ki=
okCloseBoard hBoard gm;6v30e
CloseHandle hFile 'MEO?]Tf.^
Close #hBCFile b Y6y)l
conn.Close /*B^@G |]'
End k:D;C3vJd
End Sub Q{9 #Am^6w
+/id q
Function ArrayToBMP(ByVal File As String) ==d@0`
Dim BytesWrite As Long oe1Dm
U?dd+2^};t
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ Yjo$^q
CREATE_ALWAYS, 0&, 0&) !M]_CPh]
gwFHp .mE
If hTmpFile = 0 Then +f)Nf)
\q
ArrayToBMP = False h#p1wK;N
Exit Function jtWI@04o09
End If ;dq AmBG{8
!Pmv
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN x @EEMO1_"
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& =1D* JU
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN |Tz/9t
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& \qPgQsy4
u#tLY/KA
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN G
~Oj}rn
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& ? cQ
S9Kay'.aJ(
If BytesWrite < pFrameSize Then ,~@0IKIA
Q
ArrayToBMP = False gHS;RF9
End If 7X | M\WUq
c" mRMDg%
CloseHandle hTmpFile - QaS/ WO_
UYu 54`'kg
End Function 0q%=Vs~@g
Vab+58s5
Function ArrayToBMP1(ByVal File As String) HRF4
R o
LGb.>O^
Dim BytesWrite As Long v5i?4?-Z
/?b<}am
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ wg?
:jK
CREATE_ALWAYS, 0&, 0&) ,^JP0Vc*
Q^q G=
If hTmpFile = 0 Then Z4#lZS`'A
ArrayToBMP1 = False >j]*=&,7
Exit Function @21G[!%J
End If #v N \ ]e
%;,D:Tv=&
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN GnbXS>
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& oh{!u!L`]
Q!D Q!;Br6
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN w} Q|*!?_
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& ~5aq.hF1,A
n*\AB=|X
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN xe)< )y
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& =Ewa}$-
c9e
}P
If BytesWrite < pBufferSize Then #+Lo&%p#3
ArrayToBMP1 = False ldJ eja~Xl
End If 7QiJ1P.z
1a {~B#
CloseHandle hTmpFile 1KxtHLLU
H9)$ #r6i
End Function 3mWd?!+m=
= U3,P%
'使用该过程建立的文件要求在用后关闭 A{hwT,zV:
Public Function ArrayToBMP2(File As String) As Boolean 7Kx3G{5ja
^=)? a;V
Dim BytesWrite As Long >M7e'}0 ;
)i; y4 S
ArrayToBMP2 = True `m5cU*@D
Hl&]r'bK
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 9\W~5J<7
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) D]+t r%
i>bFQ1Rdx
If hTmpFile = 0 Then "HR
&Rf k
ArrayToBMP2 = False ;D_6u(IC4:
Exit Function S\<]|tM:x
End If 7M: 0%n$
8a{FxCBw
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ;F@dN,Y
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& VHsNz WI
k07 JMS?
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN & o/&T{t}
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& &,':@OQ
Rs;
,_
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN F]Zg9c{#
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& hB:R8Y^?H
Q!>
8E4Z
If BytesWrite < pFrameSize Then x@ bZ(( w
ArrayToBMP2 = False Jrlc%
,pZ
End If >u5}5O
P7
F' ZLN]"{
CloseHandle hTmpFile whP>'9t.w
6 USet`#
End Function 5v8&C2Jy@
Xmy(pV!PF
Private Function TESTSignal() As Boolean 9s) YPlD z
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long (mHFyEG
d87pQ3e:&
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) B\bIMjX
V
hIa@J EIt
If extsign = 1 Then D@ H'8C\
TESTSignal = True 9;;1 "^4/
Else DSix(bs9
If extsign = 0 Then *>.~ f<V
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly ->vfQwBFd
TESTSignal = False 6<A \U/
Exit Function 'w.:I
TJf
End If aisX56Lc
End If w&;\}IS
}vO^%Gd
'测试视频输入类型 ?,|_<'$4T
'video type /B!"\0G/,
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 5} e-~-
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) Zl"h-~31
If videotype = 1 Then nLkC-+$t M
'"隔行信号(Interlaced)"
K)GC&%_$O
Else iXC/?
EK4
If videotype = 0 Then ?|^1-5l3
'"逐行信号(Non-interlaced)" o
<LA2 q`T
Else {Z;W |w1t
If videotype = -1 Then (J Fa
' "不支持" _p{ag
1gP
End If +7+
VbsFG
End If hmkcW
r`
End If T$%u=$E%F
d
QA J`9B
'测试垂直扫描线数 FQi"OZHq
'video scanlines ?A Y596
scanlines = -1 +u _mT$|T
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) e,I-u'mLQs
If scanlines = -1 Then _*Vq 1D ]C
' "不支持" BU:s&+LYUv
Else M 0- >
'Trim(Str(ScanLines)) + " 行数/幅" vzaxi;S<
End If L~ V
63K
ik~hL/JD\
'测试帧频 s4SR6hBO
'video field frequency h b j^!0m
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) %{/0
K<M
If fieldfrq = -1 Then UeE& 8{=d
'lblSignal(8) = "不支持" Uk ?V7
?&
Else =]7|*-
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" 7K9+7I&C
End If c#9 zw[y-L
End Function wr*A
%:
`Y.RAw5LrE
cJ:BEe
Sub PicIdentify() Q}]:lmqH
'本程序完成从文件中按顺序读出一幅图像并完成图像识别
u4o%qK
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 O\OG~`HBN
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 ) !ZA.sx
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 wlKpHd*
C bG"8F|4
Dim fPTR As Long, cFrame As Long hFa \x5I5
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer \{?v|%n=/i
L0|Vc9
/]]\jj#^
cFrame = 0 & A9psc(,&
ZH:#~Zyj
*Gu Cv3|
Do While cFrame < tFrames Q+ G =f
Jb $P lOQ
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) 3 SQ
5C' E
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) iO#H_&L.p
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize x)#k$ QU
w SV[nK
frmRecord.RText.Text = Str(cFrame) biGaP#"0
frmRecord.RText.Refresh U $VTk
:'GTCo$3
If CheckMark = True Then ?h>mrj
ArrayToBMP TmpBMP | c 8p{)
frmRecord.Picture1.Picture = LoadPicture(TmpBMP)
=sG (l
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" E_?3<)l)RI
u[ 2R>=
DrawSlice *
JO"8iLw
7F?^gMi
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) !^q<)!9<EO
'If i = vbNo Then 2%vw C]A
' Exit Do RWTv,p LK
'End If 9FV#@uA}D
'cFrame = cFrame + 1 "h og A5=
/q='~t
End If dJNY
uTZ'
DoEvents
aDza"Ln
cFrame = cFrame + 1 Mw 'd<{
Loop >&?wo{b
End Sub )IZ$R*Y{
:
Np&G4IM>
WKxJ`r \
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean !;CY
@=
=NJb9S&8A
'如标志区模式反差存在则为TRUE，否则返回FALSE $BH 0W{S
shn`>=0.&
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long @292;q i
CheckMark = True L/nz95
5+%BZ
'复制标志区 LZ&C GV"Z-
For i = 1 To mkH L1)? 5D
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW m/Yi;>I(
Next i =K8`[i H
L ?KEe>;r
For j = 1 To PilarW * PilarH / 2 GUat~[lUrj
mTop = mTop + MKpilar(j) |7%$+g
Next j , {z$M
ew?UHV
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH >47,Hq:2
mBot = mBot + MKpilar(j) FIU( 2
Next j
NX)7g }S
by6E
"7%
mTop = mTop / PilarW / PilarH * 2 9M01 }
mBot = mBot / PilarW / PilarH * 2 qLYv=h$,
NqqLRgMOR'
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 kV6>O C&^
9 lTA/-
'平均值极值化 wm2Q(l*HH
For j = 1 To PilarH * PilarW ~sSB.g
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) MiOSSl};
Next j 5W<BEcV\
:sT<<LtI-
mTop = 0: mBot = 0 e4CG=K3s
For j = 1 To PilarH * PilarW / 2 =t)eT0
mTop = mTop + MKpilar(j) o'Tqqrr
Next j e1&c_"TOih
!2&h=;i~V
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW mg >oB/,'Z
mBot = mBot + MKpilar(j) , st4K;-
Next j I8^z\ef&
&V gjd>
u> >t"w
mTop = mTop / PilarH / PilarW * 3 8 -8=
\
mBot = mBot / PilarH / PilarW * 3 \UB<'~z6!
d G:=tf&1R
L**!$k"{5
If mBot > iWhite And mTop < iBlk Then B)^]V<l(w
CheckMark = True |C a$>]?
Else V i#(x9.
CheckMark = False }3[ [ONA
End If 2?-}(F;Z
End Function v/yk T9@;
R4V>_\D/
Sub Capture1Frame() A ;kAAM
okCaptureTo hBoard, BUFFER, 0, 1 'single $ HUCp9
okGetCaptureStatus hBoard, True M5) 6|T
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize >!WJ{M0
End Sub iQa Q"s
pm )A*][s
pM
VeUK?
Sub CopyMark(iBlk As Integer, iWhite As Integer) 7^Onq0ym T
'复制标志区并返回标志区暗区与亮区的亮度平均值 Pi*,&D>{7
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 $g| g}>Sc
]Dx?HBM"DC
'复制标志区 lBh {8a|2W
For i = 1 To mkH &] z2=\^e
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW RI*Q-n{
Next i O Zt 'ovY
V<nzThM\
For j = 1 To mkW * mkH / 2 3U:0 ,-j"
mTotal = mTotal + MKpilar(j) ;#xhlR* ~
Next j R!$j_H
SxT:k ,ji
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 n }MG
pbm4C0W}
mTotal = 0 SZwfYY!ft0
For j = mkW * mkH / 2 + 1 To mkW * mkH 'w9tZO\2
mTotal = mTotal + MKpilar(j) K{|;'N- 1
Next j c yN_Sg
xOu
cZ+
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 kP;Rts8JD
>) S
a#w;
'背景亮度 VJr ?`
eY4
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW D]oS R7h
For i = 1 To 4 * FrameW @ $(4;ar
bsTotal = bsTotal + BsLine(i) yobi$mnsy!
Next i 'm/b+9?.
bsAV = bsTotal / FrameW / 4 hZzsZQ`
iwmXgsRa9}
End Sub j@9nX4Z
i1G}m Yz_
OB$A"XGAEV
Sub AdjIMGbright(Optional bInit As Boolean = True) H
uE*jQ
UJ6WrO5#kB
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） [9+M/O|Vs
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 `C!Pe84(
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 \*_a#4a
6 'wP?=
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer 3rR(>}:[V
! B )Em
'按标准亮度与对比度采集一帧，确定背景亮度 }){h
Qt7
currentContr = 128 '初始对比度 n!tC z<v
currentBr = 128 '初始亮度 Bq@G@Q i
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 lXz<jt@5
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 )(!vd!p5
DoEvents bt
j\v[D
Capture1Frame D % 5 0
'获得图像上缘4行象素 }:h dAZ+z
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW msoE8YK&tg
CopyMark iBlack, iBright '图像标志区亮度 +JQN=nTA
For i = 1 To 4 * FrameW 45-pJf8F
bsTotal = bsTotal + BsLine(i) ^Y'>3o21f
Next i ,[ Y tl
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 a<\m`
Es=
;wvV hQ
Select Case bsAV Z)?"pBv'
Case 0 To 60 '夜间通过灯光照明,完全没有背景 p(x[zn+%Y
currentBr = 150 ,g\.C+.S
currentContr = 60 TUk1h\.q
Case 61 To 80 '有可见背景 '-v~HwC+/T
currentBr = 140 kF\ QO
[
currentContr = 70 ZGp8$Y>r
Case 81 To 100 '有清晰背景 fk",Y tS*
currentBr = 128 V25u'.'v
currentContr = 80 \j K ?R
6
Case 100 To 150 '有明亮背景 H3b@;&` &
currentBr = 140 '5:30-6:00钟实测数据 C(gH}N4
currentContr = 50 8H{@0_ M
Case 151 To 180 \{~x< <qFd
currentBr = 130 .eeM& n;c
currentContr = 60 i.by Hz?
/
Case 181 To 220 '背景全为白色 a{u)~: /G
currentBr = 110 +5T0]!
currentContr = 130 ZMx<:0ai
Case 221 To 255 '背景全为白色 LL,~&5{
currentBr = 100 >)VrbPRuA
currentContr = 100 7qh_URt@
End Select oHa6fi
da 2BQ;
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 * |,V$
Case 100 To 150 K,
3 5*
currentBr = currentBr - 10 g\jdR_/
Case 151 To 255 4 QDF%#~q^
currentBr = currentBr - 20 ("9)=x *5
End Select }S4 2.f.p
K): )bL(B
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Wxg|jP$~
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 khEHMvVH
End Sub lR-4"/1|y
0c`wJktWK
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) W~7q&||;C
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long r<b g->lX
Z& } 94
For i = 1 To 8 Y*7.3 +#
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& @w|~:>/g
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& ^,`yt^^A
Next i / ?Q@Pn
#U6Wv1H{Lp
For j = 1 To 1024 *J%+zH
L1 = L1 + LeftBK(j, 0) Aal yEn&>
L2 = L2 + LeftBK(j, 1) *.~M#M 9c
R1 = R1 + RightBK(j, 0) %_/_klxnO
R2 = R2 + RightBK(j, 1) q=6M3OnS>
Next j |:
EUh
diffL = Abs(L1 - L2) / 1024 4l z9z>J.V
diffR = Abs(R1 - R2) / 1024 D%BV83S
End Sub CP={|]>+S
g4~{#P^i
Function CheckSlice() As Boolean 5SK.R;mn
CopySlice avSL, avSLR, avSLL &Wn!W
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then A).wjd(_,
CheckSlice = True <GR]A| P
Else 8cW ]jm
CheckSlice = False ]p$fEW g
End If t(s']r
End Function @s@r5uR9B
`@Qq<T}V
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) rgOB0[
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long Pu}2%P)p
For i = 1 To FrameH ]C'r4 Ch^
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize <K2 )v~
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize 0gn
r@9,X
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize ,NVQ C=
Next i &0
N 3 p
For i = 1 To FrameH ]i{-@Ven
For j = 1 To sSize G2e m>W_n
total = total + Slice(j, i) # &$4tTl
totalL = totalL + SliceL(j, i) ;%Z)$+Z_)<
totalR = totalR + SliceR(j, i) XLOk + Fn
Next j M'[J0*ip
Next i LdRLKE<'e
avSL = total / FrameH / sSize ThF
I=K
avSLR = totalR / FrameH / sSize h],
_1!0
avSLL = totalL / FrameH / sSize Q+#, VuM
End Sub q`qbaX\J3
6rR }qV,+{
Sub DrawSlice() a7M8sZ?"
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B RJSNniYr7
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B XV!P8 n
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B PY) 74sa
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) ! WQEv_G@
End Sub )C <sj
Sub DrawMark(pic As Control) $@DXS~ UQA
Dim i As Long, j As Long hL&z"_`
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B ^#_@Kq% th
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B U?.VY@
For i = 1 To PilarH 3ne=7Mj
For j = 1 To PilarW 38JvJR yK}
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) * 78TT \q<
Next j AC
3 ;i
Next i J/)Q{*`_
End Sub m:K/ )v*
m}8c.OJ>K`
Function avIMG() As Integer
1vQ*Br
Dim i As Long, j As Long, totalIMG As Long H hIa=,VY
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize ,.DU)Wi?}
For i = 1 To pFrameSize C/lp Se
totalIMG = totalIMG + pBuffer(i) M|e @N
Next i CbwQ'c$}
avIMG = totalIMG / pFrameSize R{Cj]:
Ky
End Function edbzg #wy
!v $hqNt7
Function avRegion(barCol As Integer, barWidth As Integer) As Integer a N_M
Dim i As Long, j As Long, totalIMG As Long Y2Y/laD
For i = 1 To FrameH V>z8 *28S.
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth QDLtilf :
Next i W${0#qq
For i = 1 To FrameH * barWidth ^gD&Nb P8
totalIMG = totalIMG + pBuffer(i) _jP]ifu`
Next i ^F_c'
avRegion = totalIMG / pFrameSize nww,y
End Function d+z8^$z"
