这才是我当年写出的一个比较烂的程序 liG3
G[[NDK
Main2.bas K)n0?
Q_>
}hX"A!0
Attribute VB_Name = "SubMain" Bl8&g]dk
Option Explicit Q =cbHDB
_<P~'IN+n
'采集文件与临时文件 MESPfS+
Public Const TmpFile As String = "d:\30-0600.dat" sow/JLlbC
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 C@q&0\HN
2z=GK V
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long { 1j[RE
Public hBCFile As Long '记录采集参数的文件 `@r #o&
Public Const TmpBMP As String = "d:\1.bmp" ^"\., Y
Public hTmpFile As Long lITZ|u
fP
5!`8
$ [-{Mm
'采集窗口参数常量 ^jMo?Zwy
Public Const FrameH As Long = 280&
tmf= 1M
Public Const FrameW As Long = 768& KqT~MP l
Public Const pFrameSize As Long = FrameW * FrameH DU:
sQS4
#$(w
fb9
'标志区范围，用于识别车辆 D:Y `{ {
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X X>6VucH{\
Public Const mkW As Integer = 28 '识别标志立柱宽度 rXR}]|;>
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) kzcD}?mSS
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) u #m(Py
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 Q WWoj[d#
'车缝检测位置常数 i WNTI
Public Const sSize As Long = 32& Y2 Y!^A89
Public Const sPos As Long = 310& V7
dAB,:
Public Const sPosL As Long = 200& )B' U_*
Public Const sPosR As Long = 500& Cb/?hT
'车缝检测框位置 ALY%
h!L
Public Slice(1 To sSize, 1 To FrameH) As Byte bU i@4S
Public SliceL(1 To sSize, 1 To FrameH) As Byte ,9;d"ce
Public SliceR(1 To sSize, 1 To FrameH) As Byte .1C|J
Public avSL As Integer, avSLR As Integer, avSLL As Integer Q`X 5W
*cn#W]AE
sw@* N
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 Bt^];DjH
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 Y)X58_En
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 C JNz J(
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long / +F|+1
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte G
]mX+?
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ^. i;,
lt&30nf=
lZup n?
e`Z3{H}
'一次连续采集的帧数 ~IE5j,SC
Public tFrames As Long >
AV
R3b
@5# RGM)5^
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 6uH1dsD
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 umWZ]8
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize {\HE' C/?
n! (g<"
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte _\Cd.
Public pBuffer(1 To FrameW * FrameH * 2) As Byte ^2PQ75V@.
Public pWorkSpace(1 To FrameW * FrameH) As Long ,-XJ@@2gM
Public Const pBufferSize As Long = FrameW * FrameH * 2 oFe flcSz
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 4';]fmf@[i
N#`aVW'{v2
Public hBoard As Long '采集卡标识 V-(LHv
Public mBufferAddr As Long '缓存地址 R.)U<`| |
Public BufferSize As Long '缓存大小(字节) 7l})`>
k
Public iCurrentCard As Long fJ3qL# '
Public CapStatus As Long ^(0tNX/XD
Public iFrames As Long K!9rH>`\
Public currentBr As Byte, currentContr As Byte {@u}-6:wAT
?JD\pYg [/
Public hMEM As Long, mStatus As Long cMEM}Qh
T
Public Const hMemSize As Long = pFrameSize * 4 [+st? ;"GF
Public hMemWork As Long 3*gWcPGe
Public Const hMemWorkSize As Long = pFrameSize * 5 |k4ZTr]?
].2it{gF?b
sE8.,\
}PY?
ZG
'串口接收轨道衡数据 rHtT>UE=
Public WeightFromCom As String 4l?98
Public bReceiveComplete As Boolean E4'D4@\W
\[+\JWJj
)LYj,do
Public Type GrayBMPHeader rS
4'@a
Tag As Integer 1% )M-io
FileLength As Long '文件大小 :6z0Ep"
Reserve1 As Long N2_ =^s7
DataOffset As Long '图像数据偏移量 Y e}y_W
BMPHeaderSize As Long '文件头长 Hvq< _&2
'length of the bitmap info header used to describe the bitmap colors, compression,… ku'%+svD
'the following sizes are possible: oLn| UWe_
'28h - windows 3.1x, 95, nt, … dM wVgc:
'0ch - os/2 1.x (;T; ?v`-
'f0h - os/2 2.x 5W!E.fz*
T
I fZaK([
ImageWidth As Long '图像宽（像素数） 2r~ Nh](
ImageHeight As Long '图像高(像素数) ;6 1m
PlaneNumber As Integer '图像层数 ~QsQ7SAs
bpp As Integer 'bits per pixels '1 - monochrome bitmap
1Nk}W!v
'4 - 16 color bitmap !P!| U/|c
'8 - 256 color bitmap I$`Vw >
'16 - 16bit (high color) bitmap B!le=V, @,
'24 - 24bit (true color) bitmap 7,e=|%7.
'32 - 32bit (true color) bitmap 1*r {%6
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) `q exEk@S
'1 - rle 8-bit / pixel (also identified by bi_rle4) #1zWzt|DW
'2 - rle 4-bit / pixel (also identified by bi_rle8) + +13m* fA
'3 - bitfields (also identified by bi_bitfields) ~::gLm+f
IMAGESIZE As Long '图像数据字节数 Dg#A b8
hResolution As Long '水平分辩率 像素数/米 gHlahg
vResolution As Long '垂直分辩率 f 41!+W=
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 ) :+H`Hcm
ImportantColors As Long Hf
%;FaJ=
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 g-% uw[pf
End Type /d > f
p
7q|(ZZa
8}Y(
@
%4
+WwQ!vWWd
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader _pNUI { De
Public sRECT As RECT
Te> 7I
Drlt xI)
ry x<^q
Public conn As ADODB.Connection &K^h'>t'
Public rsTrain As ADODB.Recordset F
,{nG[PL
Public rsOperater As ADODB.Recordset I01On>"@7
Public rsGoods As ADODB.Recordset T"Q4vk,3*J
Public rsGood2 As ADODB.Recordset @/JGC%!
Public rsSender As ADODB.Recordset 't{=n
[
Public rsReceover As ADODB.Recordset .#h ]_%
Public rsTrainTMP As ADODB.Recordset AX1'.
2 +GF:[$
;:9 x.IkxC
'打开采集卡 ){>; eky
'设置参数 hP,1 ;`[1
'设置为实时单帧采集到缓存方式 `>8|
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 L#u6_`XJ+
:7Vm]xd}do
kQI WD
N
Sub Main() XR\ iQ
Dim i As Integer, status As Long z PV/{)S
cx2s|@u0
InitBMPinfo nL+*
Ja
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件
SQ5*?u\
BMPHeader.Tag = &H4D42 igz:ek`
BMPHeader.ImageWidth = FrameW ;lAz@jr+
BMPHeader.ImageHeight = FrameH eS@RA2
BMPHeader.BMPHeaderSize = &H28 `bT{E.(T
BMPHeader.PlaneNumber = 1 B>Nxc@=D
BMPHeader.bpp = 8 YQN=.Wtc
BMPHeader.Compression = 0 %e%nsj6
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 aXC`yQ?
BMPHeader.vResolution = &H1274 XpH[SRUx
BMPHeader.ColorsinBMP = 256 -"a+<(Y
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP i%*x7zjY{
BMPHeader.DataOffset = Len(BMPHeader)
3 XfXMVm
For i = 0 To 255 @R2|
=ox
BMPHeader.Pallate(i) = RGB(i, i, i) 1}8e@`G0.]
Next i 6w}:w ?=6
BMPHeader.IMAGESIZE = FrameH * FrameW +n Mg QOs
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE ?EX'j
>
O:7y-r0i
+d6E)~qKL
MoveMemory BMP1, BMPHeader, Len(BMPHeader) [1nI%/</>
~*B1}#;
BMP1.ImageWidth = FrameW 5Cy)#Z
{
BMP1.ImageHeight = FrameH * 2 &9s6p6 eb
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight x\Sp~] o3C
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE |x<
']vX
'确定标志位置,为pilarX, pilarY确定初始值 2
yP#:T/z
PilarW = mkW m;
A BHq#
PilarH = mkH '此两项为固定值 )X^nzhZ2O"
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) &7DE$ S
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 dIO\ lL
=,@SZsM*B
5I j_$
a
'连续采集记录文件 +Kq> r|;
' 建立一个缓冲区为页对齐方式的文件 %q*U [vv
If Dir(TmpFile) <> "" Then c=
a+7>
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ ] K9 x<@!
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 1| gP
:t}
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 6xFZv
t
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ) edM@beY_
Else ~hvhT }lE
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ Y,(eu *Za
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) yJp& A
End If .X2 mEnh
If hFile = 0 Then <O>Q;}>gfc
MsgBox TmpFile & ": File Open Error", vbOKOnly 7OWiG,
Exit Sub Z@ws,f^e
End If %okEN !=
'采集参数记录文件 ao-C9|2>NU
hBCFile = FreeFile() i ^IvT
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile #Y18z5vo
bY>o%LL-
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 Q Hs]~Ja
If hMEM = 0 Then &6\rKOsn
fStatus = GetLastError R9CAw>s
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ %?wuKZLnc
& "请向技术人员报告该错误代码。", vbOKOnly ldX ]A#d .
CloseHandle hFile 6U /wFT!7$
Exit Sub t'Q48Q Ab?
End If D9L wYftZ
ZY/at/v
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) IeU.T@ $
If hMemWork = 0 Then >Le
mTr
fStatus = GetLastError sG VC+!E
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ |\_O 8=B%
& "请向技术人员报告该错误代码。", vbOKOnly X2e|[MWkp
'释放已成功分配的内存 2hu6
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) If&p$pAH?
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Pdn.c1[-a
Sej$x)Q\t
CloseHandle hFile {9l4 pT3
Exit Sub W;-Qze\D
End If , Xh4(Gn#b
T] v D ,I+
' Test writing _+;x 4K;
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& Zh(f2urKV
ttw@nv%
@
'初始化采集卡参数 r\Nn WS J
iCurrentCard = -1 hsE!3[[
hBoard = okOpenBoard(iCurrentCard) 2d>PN^x
Debug.Print hBoard -%N (X8
If hBoard = 0 Then *TXq
/
3g
ExitGrabber Qp=uiXs
End XW#4C*5?d
End If 7CIje=u.q
okGetBufferSize hBoard, mBufferAddr, BufferSize %eah=e
If mBufferAddr = 0 Then U50X`J
MsgBox "缓存不存在！" 8% |x)
ExitGrabber cKfYkJ)A'
End If uyA9`~p=#
Debug.Print Hex(mBufferAddr), Hex(BufferSize) <K0lS;@K
1_p'0lFe
q(r2 \
currentBr = 128: currentContr = 128 WWe.1A,
'设置视频输入参数 ^Ue.9#9T&g
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 c"z%AzUV'
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input Rp<Xu6r
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 SUVr&S6Nk
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 ~T-.k
7t
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 =az$WRV+7!
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 u3ZG;ykM
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） hW} ,%
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) m:41 zoV
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) /d=$,q1
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 53T2w,?
16+@#d%#p
'设置采集参数 B#DV<%GPl
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 k
Z3tz?Du
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 VC+\RB#:-
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 zyR pHM$E
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 <^~F~]wnH
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 RTU :J67E
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 aH$~':[93
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 lR( &Wc\j
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 ^$L/Mv+
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 .U3 p~M+
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 <7&b|f$CL
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 7RLh#D|
p>zE/Pw~
cn
c$^[c
okCloseBoard hBoard ~8X' p6
Sleep 50 z]WT>4
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 "D k:r/
CeJ|z {F\
'设置数据传送方式 +\ySx^vi
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 <Q0&[q;Z
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 vLke,MKW
2 <O8=I _
sRECT.Right = -1 '用于获得当前设置值 wLO/2V}/
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) !^7:Rr _
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom u<8Q [_E&
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 ;F+%{LgKl
sRECT.Left = 0 m88~
+o<G%
sRECT.Top = 0 P:=AD W c
sRECT.Right = sRECT.Left + FrameW f65Sr"qB3
sRECT.Bottom = sRECT.Top + FrameH * 2 q38; w~H
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ]@P*&FRcZ
Gt%kok
sRECT.Right = -1 '检查新设置值 +?<j
SmGW
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) t}tKm
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom Iu[EUi!"
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) /f[_]Le
V]
QXz!1o+"
If TESTSignal = False Then a9I8W Q
'ExitGrabber lrE0)B5F
End If zXD@M{
"+WR[-n>\
O92Y d$S
l}^#kHSyd
'设为实时采集状态 ?4Lo"igAA
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) 0%t|?@HoN
4 TKi)0
#7
G](K2=
'单帧采集 eXd(R>Mx
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 3pp
w_?k
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) cm3Y!p{p"
okCaptureTo hBoard, BUFFER, 0, 1 'single 4_Jdh48-d
'Do While okGetCaptureStatus(hBoard, False) <> 0 [Ok 8l='
' Sleep 20 st2>e1vg
'Loop $>UzXhf}\
okGetCaptureStatus hBoard, True s`B'vyoaa
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize hJ<2bgQo
'写入768*576测试图象 'YG`/@n;
ArrayToBMP TmpBMP _e 3'f:
w s=T R
'打开数据库 -^5R51
Set conn = New ADODB.Connection h$&X Qq0T
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ Dpd$&Wr0Y
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ U)!AH^{32
"; Mode=Read|Write" Esjv^* v9-
conn.Open E;4a(o]{t
v( ^ rq
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) O, {
(
frmRecord.Visible = True fz&}N`n
frmQuery.Visible = True p(G ?
Load frmReceiveFromComm kUt9'|9!
A-io-P7qyj
'调试参数 0o]K6 b
If InStr(UCase(Command()), "/CAPTURE") > 0 Then hF~B&^dd.
SignalBox.Visible = True 54{"ni 2a
End If J W\"S
If InStr(UCase(Command()), "/COMM") > 0 Then LTe7f8A
frmReceiveFromComm.Visible = True |- fx
0y
End If W24bO|>D
zi
,Rk.
End Sub %awS*
k +Oq$Pi
Sub ExitGrabber() *L RGfk+h
'关闭数据库 ]G B},
'关闭采集卡 ie!4z34
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) MUrY >FYgx
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) "!tB";n
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) }D^Gt)
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) I O#W#wW$M
okStopCapture hBoard 1I`D$Xq~:
okCloseBoard hBoard XbC8t &Q],
CloseHandle hFile ,ln uu
Close #hBCFile B<LavX >F
conn.Close 7N"Bbl
End $ZRN#x@
End Sub kTz
,&=`T 7i
Function ArrayToBMP(ByVal File As String) ;$QJnQ"R
Dim BytesWrite As Long rd )) H
r ieQ&Jt"
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ DR /) hAE
CREATE_ALWAYS, 0&, 0&) CnH
R&`
aK{\8L3]
If hTmpFile = 0 Then }W bN)
ArrayToBMP = False 1aE/_
Exit Function l.x }I"tf
End If co3 ,8\N0
arP+(1U
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN c)8wO=!
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& 1Q5<6*QL"
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN $D5U#
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& zmFFBf"<
u-_$?'l;~
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 8i lbX)O
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& cPcV[6)5K9
r!^\ Q7
If BytesWrite < pFrameSize Then }dUC^04
ArrayToBMP = False {nefS\# {
End If w8
$Qh%J'<
]3xa{ h~4
CloseHandle hTmpFile dYd~
9
PHvjsA%"
End Function p|d9 g
^
tZ^;{sM
Function ArrayToBMP1(ByVal File As String) <k](s
,NEs{!
T
Dim BytesWrite As Long ugB{2oq i
_6!/}Fm
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ `4 bd,
CREATE_ALWAYS, 0&, 0&) X{}#hyYk"
R3n&o%$*
If hTmpFile = 0 Then *f SM' q;
ArrayToBMP1 = False s8[9YfuW
Exit Function e<4z)
End If N o(f0g.
-ZP&zOsDr
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN gKN_~{{OD
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& \&5 @ yh
A#X.c=
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN j/D)UWkR
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& $>=Nb~t!/
`M ygDG+u
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN es[5B* 5
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& wW8
6rB
+^? -}v
If BytesWrite < pBufferSize Then CLEG'bZa,
ArrayToBMP1 = False Vb^s 'k
End If //lZmyP?
J'yN' 0
CloseHandle hTmpFile 0>
=)
s jI[Vq
End Function $`{q[ {
?d<:V.1U@
'使用该过程建立的文件要求在用后关闭 yZp:hs#
Public Function ArrayToBMP2(File As String) As Boolean k6 '#
\GvY`kt3
Dim BytesWrite As Long vvAk<[
Rr 4CcM
ArrayToBMP2 = True `E=rh3 L0o
15 o.j!S
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ;j U-<
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) xm|4\H&Bg
93IOG{OAY
If hTmpFile = 0 Then df6Ν4L
ArrayToBMP2 = False 'c0'P%[5A
Exit Function U;{,lS2l
End If 0 jP00
Y@H,Lk
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN W 8$=a
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& N!B Oq`#da
g[au-.:
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN )O@ ^H
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& Q
*]`t@ q
}c4E 2c
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN \'+{X(]
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 8TZ A T%4
x}<G!*3
If BytesWrite < pFrameSize Then I"so bZ`
ArrayToBMP2 = False 1qj%a%R
End If xd fvme[
P}9Y8$Y>U
CloseHandle hTmpFile &]6K]sWJK{
ZBR^[OXO
End Function p@8krOo`
CS5jJi"pD3
Private Function TESTSignal() As Boolean NzAtdcwR
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long {O kik}Oh
rtL9c w5
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) ^la i!uZVa
Mc7 <[a
If extsign = 1 Then IH bo w0'
TESTSignal = True 90iW-"l+[
Else h:jI
If extsign = 0 Then 7e4tUAiuU
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly 5u)^FIBj
TESTSignal = False 1mn$Rh&dO
Exit Function ru/zLj :
End If EO/cW<uV'
End If S~rVRC"<xo
"1!. ^ <V*
'测试视频输入类型 z]l-?>Zbg
'video type .;Utkf'I
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 8U<.16+5Q
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) i %h n
If videotype = 1 Then )_ b@~fC
'"隔行信号(Interlaced)" ( X
'FQ
Else oyN+pFVB:$
If videotype = 0 Then _UBJPb@=U
'"逐行信号(Non-interlaced)" 1s} ``1>
Else e,#+Xx0M
If videotype = -1 Then t66f 7 AR
' "不支持" bOxjm`B<
End If Gp ^ owr
End If S?nNZW\6[
End If ( #-=y~%
_N,KHxsG8B
'测试垂直扫描线数 ^mgI%_?1
'video scanlines GATP
scanlines = -1 1x\W52 1
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) 4-M6C 5#.
If scanlines = -1 Then dVVvG]
' "不支持" TFJ{fLG
Else 0$"Q&5 Y
'Trim(Str(ScanLines)) + " 行数/幅"
Z;Ir>^<
End If }U?gKlLg
c(Uj'uLc
'测试帧频 [2 QY
'video field frequency N
t>HztXd
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) R5NRCI
If fieldfrq = -1 Then tLXn?aNY
'lblSignal(8) = "不支持" UOLTCp?M;J
Else
e1`)3-f
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" ;ad9{":J#B
End If F`;TU"pDf
End Function uF ]D
}u vKE|umj
o^_W $4Fc
Sub PicIdentify() Ql#W
/x,e
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 f^6&Fb>
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ]O[+c* |w
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 M=\d_O#;Z
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 p9&gEW
^i`3cCFB<
Dim fPTR As Long, cFrame As Long !8
wid&
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer nz&b5Xb 2
z6FbM^;;
} `>J6y9
cFrame = 0 |%:q hs,
Z
M-/n>
t7*G91Hoq&
Do While cFrame < tFrames [al(>Wr 9
Gh$y#0qr
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) )WP ]{ W)r
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) Y uw
E 0
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize ;Z!~A"~$>
(!_X:+0_
frmRecord.RText.Text = Str(cFrame) rY[3_ NG%
frmRecord.RText.Refresh ui.QYAYaV
P,$ [|)[E
If CheckMark = True Then ,NaV
[ "9$
ArrayToBMP TmpBMP Bt*&L[&57
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 4 [5lX C
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" EbBv}9g
M 5T=Fj86
DrawSlice g/U$!d_
Imh2~rw;
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) 2\nBqCxR
'If i = vbNo Then }j5R@I6P
' Exit Do f*|8n$%
'End If 9LqMQv"xW
'cFrame = cFrame + 1 ] } 5I>l
{h vQ< 7b
End If >tmnj/=&
DoEvents q#Y g0w~
cFrame = cFrame + 1 EBj,pk5M
Loop (s V]UGrZ
End Sub -~( 0O
rS F;Lp)}
D y`W5_xSz
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean t3
uB
RR~sEUCo{
'如标志区模式反差存在则为TRUE，否则返回FALSE ]|C_`,ux
;Xfd1
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long k Z+ q
CheckMark = True dr,B\.|jC
q19k<BqR
'复制标志区 -+
]T77r
For i = 1 To mkH FhY{;-W(T
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW _:ZFCDO
Next i ,yHzo
v|4 STR
For j = 1 To PilarW * PilarH / 2 Z9J =vzsHE
mTop = mTop + MKpilar(j) u
n?j
Next j ?8wwd!)x%
*c ~'0|r
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH 1BMV=_
mBot = mBot + MKpilar(j) Q>}e IQ Y
Next j AMh37Xo
12:h49AP
mTop = mTop / PilarW / PilarH * 2 j{Yt 70Wv
mBot = mBot / PilarW / PilarH * 2 D Ga#d_I
`zElBD
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 8CP9DS
-(/2_&"
'平均值极值化 abTDa6 /`v
For j = 1 To PilarH * PilarW ]b0zkoD9<
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) :Bx+WW&P.i
Next j IL+ #ynC
5(iSOsb
mTop = 0: mBot = 0 B&%L`v2[
For j = 1 To PilarH * PilarW / 2 bK_0NrXP
mTop = mTop + MKpilar(j) 36kc4=
Next j z x\.2<K
l#2r.q^$|
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW 6o[0sM_ ];
mBot = mBot + MKpilar(j) ,-cpsN
Next j V!pq,!C$v
Xmf
p~Yy"Ec;p
mTop = mTop / PilarH / PilarW * 3 oglXW8
mBot = mBot / PilarH / PilarW * 3 u|_LR5S!j
EFa{O`_@U
"fX_gN?
If mBot > iWhite And mTop < iBlk Then 2cs?("8e%
CheckMark = True 4f{[*6 GX
Else 'WKu0Yi^'
CheckMark = False S 0R8'Y
End If 2|0Je^$|
End Function dxzvPgi ?
;-3h ~k
Sub Capture1Frame() q5:0&:m$4$
okCaptureTo hBoard, BUFFER, 0, 1 'single /gqqKUx
okGetCaptureStatus hBoard, True 9_ J!s
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize '|YtNhWZ?
End Sub [ -9)T
^w;o \G
L<f-Ed9|
Sub CopyMark(iBlk As Integer, iWhite As Integer) =Q
/w% 8G
'复制标志区并返回标志区暗区与亮区的亮度平均值 [<e n
1
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 jsk:fh0~M
_9 Dn \=g
'复制标志区 4 o3)*
For i = 1 To mkH ^G|w8t+^
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW
aNOAu/
Next i u4Y6B
]Q
Ap
F*a$),
For j = 1 To mkW * mkH / 2 ".~Mm F
mTotal = mTotal + MKpilar(j) ~=`f]IL
Next j !7:EE,W~
T!m42EvIvE
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 G
]L0eV
q=P
f^X p
mTotal = 0 -{yDk$"
For j = mkW * mkH / 2 + 1 To mkW * mkH 92P ,:2`a
mTotal = mTotal + MKpilar(j) bjM-Hd/K
Next j SBCL1aM
th.M.jas
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 'sm[CNzS
|Q5H9<*
'背景亮度 %-@'CN
P
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 17V\2=Io
For i = 1 To 4 * FrameW #W>x
\
bsTotal = bsTotal + BsLine(i) +l2e[P+q
A
Next i &
_ Cxv8
bsAV = bsTotal / FrameW / 4 lEO?kn .:z
g6rv`I $l
End Sub r\A@&5#q
p&k 0Rx0Q3
D u) B9s
Sub AdjIMGbright(Optional bInit As Boolean = True) [b7it2`dl
7j@^+rkr3f
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） #t"9TP
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 J>f
/u:.
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 +}Kk2Kg8
*)j@G:
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer +O|_P`HBoI
O]e6i%?
'按标准亮度与对比度采集一帧，确定背景亮度 XoDJzrL#
currentContr = 128 '初始对比度 Mq+viU&
currentBr = 128 '初始亮度 + 6x"trC
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ]h #WkcXQ
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 S[-.tvI;Q
DoEvents q1N4X7<_
Capture1Frame |RHO+J
'获得图像上缘4行象素 &M0o&C-1/
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW [WcS[](ob
CopyMark iBlack, iBright '图像标志区亮度
H "Q(2I
For i = 1 To 4 * FrameW N; rXl8
bsTotal = bsTotal + BsLine(i) 2"T8^r|U
Next i { M`
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 '4af
],
X?KGb{
Select Case bsAV ) v${& H
Case 0 To 60 '夜间通过灯光照明,完全没有背景 .LX?VD
currentBr = 150 =ied}a
:[
currentContr = 60 ,DE( 5iDS
Case 61 To 80 '有可见背景 Sp<hai
currentBr = 140 TZ^{pvBy
currentContr = 70 yQu vW $
Case 81 To 100 '有清晰背景 \1=T
sU&^
currentBr = 128 +V2C}NQ5R
currentContr = 80 hWe}' L-
Case 100 To 150 '有明亮背景 ,3 G$`
currentBr = 140 '5:30-6:00钟实测数据 -(6 eVI
currentContr = 50 -6u H.
Case 151 To 180 Nawp t%
currentBr = 130 pO\ S#GnX
currentContr = 60 }R`8h&J
Case 181 To 220 '背景全为白色 l0gH(28K
currentBr = 110 LTg?5GwD\j
currentContr = 130 dj?
G.-
Case 221 To 255 '背景全为白色 Vil@?Y"
currentBr = 100 kFS0i%Sr
currentContr = 100 EwTS!gL
End Select lKf Mp1
11i"nR|
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 9U!JK3d
Case 100 To 150 FpP\-+S l
currentBr = currentBr - 10 ^bF}_CSE
Case 151 To 255 s ;48v
currentBr = currentBr - 20 5? ^]1P_
End Select M#=Y~PU
u=(H#o<#
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 G! AICcP^
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度
$`^ H:Djr
End Sub ILNE 4 n
0v;ve
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) PqTYAN&F
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long -Bl/ 4p
` ff j8U
For i = 1 To 8 uEBQoP2
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& UP\8w#~
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& g;$E1U=R-E
Next i P1dN32H
o
w+Ad$4Pf"
For j = 1 To 1024 lTn;3'
L1 = L1 + LeftBK(j, 0) ^%-NPo<
L2 = L2 + LeftBK(j, 1) CKJAZ 2
R1 = R1 + RightBK(j, 0) )URwIe {
R2 = R2 + RightBK(j, 1) kJ/+IGV^v
Next j #o"tMh!f
diffL = Abs(L1 - L2) / 1024 aLV~|$: 2
diffR = Abs(R1 - R2) / 1024 ]a8 e Dy
End Sub RwUW;hU
}'u3U"9)
Function CheckSlice() As Boolean Y3D3.T6Q
CopySlice avSL, avSLR, avSLL S *;#'j)4+
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then H!p! sn
CheckSlice = True G?>qd}]y0L
Else a a4$'8s
CheckSlice = False %wOOzp`
End If 2q+la|1Cr
End Function uRP
Ff77
QxKAXq@)i
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) OdO{xG G@
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long [`q.A`Fd
For i = 1 To FrameH TLy ;4R2Nn
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize t9ER; .e
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize X )I/%{
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 4\v~ HFsv
Next i ggMUdlU
For i = 1 To FrameH _\p`4-.V
For j = 1 To sSize i"/ r) >"b
total = total + Slice(j, i) O2C6V>Q;
totalL = totalL + SliceL(j, i) QT_Srw@
totalR = totalR + SliceR(j, i) STv(k Q s
Next j $ H4=QVj6
Next i Xu6jHJ@ x
avSL = total / FrameH / sSize EH(tUwY%{
avSLR = totalR / FrameH / sSize ki#y&{v9Be
avSLL = totalL / FrameH / sSize g .3 f2w
End Sub Sz RL}} I
P;jlHZ 9?O
Sub DrawSlice() p#)e:/Qy
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B : g&>D#{
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B RTA %hCr!
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B VcP:}a< B\
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) eDuX"/kHA
End Sub [S%J*sz~
Sub DrawMark(pic As Control) O)l%OOv
Dim i As Long, j As Long &.hoC Po$
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B HTw#U2A;+
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B fH&zR#T7U4
For i = 1 To PilarH V!mWn|lf
For j = 1 To PilarW )#C_mB$- #
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) ;.\g-`jb
Next j ~'(9?81d
Next i T)`gm{T
End Sub r| M'TA~:
\Ph]*%
Function avIMG() As Integer @sN^BX`z
Dim i As Long, j As Long, totalIMG As Long k@7kN Ml
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 8:~b
& >
For i = 1 To pFrameSize ?b5H
2 W
totalIMG = totalIMG + pBuffer(i) ZHz^S)o\[s
Next i !TG r .R
avIMG = totalIMG / pFrameSize T{ok +$w 2
End Function vnDmFqel
z
@ ozm;
Function avRegion(barCol As Integer, barWidth As Integer) As Integer !`Le`c
Dim i As Long, j As Long, totalIMG As Long b"^\)|*4;
For i = 1 To FrameH ]XY0c 6
<
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth
Kf|0*c
Next i {JTmP `&l
For i = 1 To FrameH * barWidth CDJ$hu
totalIMG = totalIMG + pBuffer(i) S
q<3Rw
Next i 0Qt~K#mr/
avRegion = totalIMG / pFrameSize O
/vWd "
End Function be a|?lK
