这才是我当年写出的一个比较烂的程序 tID=I0D
t76 B 0L{
Main2.bas a4&Aw7"X
9Cz|?71
Attribute VB_Name = "SubMain" 6aKfcvf &
Option Explicit hsHbT^Qm
B [s
'采集文件与临时文件 +_1sFH`
Public Const TmpFile As String = "d:\30-0600.dat" *RM 3 _
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 2ElZ&(RZJF
hgK
4;R
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long /B <QYvv
Public hBCFile As Long '记录采集参数的文件 u N4e n,
Public Const TmpBMP As String = "d:\1.bmp" ~P BJ~j+G
Public hTmpFile As Long CE
@[Z
89x;~D1
g OK
'采集窗口参数常量 "0 $UnR
Public Const FrameH As Long = 280& UM<!bNz`
Public Const FrameW As Long = 768& DY\~O
Public Const pFrameSize As Long = FrameW * FrameH Z& of-[)
8"}8Nrb0
'标志区范围，用于识别车辆
cH6++r
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X '
eh }t
Public Const mkW As Integer = 28 '识别标志立柱宽度 GfV#^qi
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) [@_W -rA
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) +c$:#9$ |
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 a}Z+"D
'车缝检测位置常数 d7S?"JpV
Public Const sSize As Long = 32& e2yCWolmTS
Public Const sPos As Long = 310&
b|-S;cw
Public Const sPosL As Long = 200& m/3,;P.6
Public Const sPosR As Long = 500& Eh*(N (`
'车缝检测框位置 xqb*;TBh*
Public Slice(1 To sSize, 1 To FrameH) As Byte
`|2g &Vn
Public SliceL(1 To sSize, 1 To FrameH) As Byte SuXeUiK.[
Public SliceR(1 To sSize, 1 To FrameH) As Byte c 2gi 3
Public avSL As Integer, avSLR As Integer, avSLL As Integer 8Si3
aq3
<H npI
;0lY_ii
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 Ab6R ?mUM
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 IG OEqUw*
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 jyB
Ys& v
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long i1S cXKO
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte =!\Y;rk
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ;I?x; lH
GOOm] ]I
Xe&p.v
H?rC I S0
'一次连续采集的帧数 ey6ujV7!
Public tFrames As Long EbG&[v
us E%e F]
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 ?a-5^{{
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 (K_{a+$[
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize 03c8VKp'p
Iz[ohn!f
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte c \;_ jg
Public pBuffer(1 To FrameW * FrameH * 2) As Byte ?,i}Qr [Q
Public pWorkSpace(1 To FrameW * FrameH) As Long ~ dk9 7Z8
Public Const pBufferSize As Long = FrameW * FrameH * 2 m}7Nu
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 qOy0QZ#0
]h,iyWSs
Public hBoard As Long '采集卡标识 A*g-pJ h
Public mBufferAddr As Long '缓存地址 pI_dV44W
Public BufferSize As Long '缓存大小(字节) Y,Lx6kU
Public iCurrentCard As Long c:[ ZknnCe
Public CapStatus As Long W{c
Z7$d
Public iFrames As Long &->ngzg
Public currentBr As Byte, currentContr As Byte m(D+!I9
hr ! '
Public hMEM As Long, mStatus As Long fejC ,H4I
Public Const hMemSize As Long = pFrameSize * 4 1|m%xX,[
Public hMemWork As Long e/&^~ $h
Public Const hMemWorkSize As Long = pFrameSize * 5 }3_ >
m% =*3gH]&
3m| C8:
_u] %K-_
'串口接收轨道衡数据 ] GO=8$Z
Public WeightFromCom As String O?O=]s
u
Public bReceiveComplete As Boolean mV^~
4fL`.n1^
N=\weuED
Public Type GrayBMPHeader BO WOH
Tag As Integer VVDW= G
FileLength As Long '文件大小 bO bsj]
Reserve1 As Long B77`a zwF
DataOffset As Long '图像数据偏移量 dI|D c
BMPHeaderSize As Long '文件头长 d^f rKPB
'length of the bitmap info header used to describe the bitmap colors, compression,… 9F[_xe@
'the following sizes are possible: r
sq?4+\
'28h - windows 3.1x, 95, nt, … fm L8n<1
'0ch - os/2 1.x s94 *uZ(C/
'f0h - os/2 2.x Gt+rVJ=v
6bPl(.(3
ImageWidth As Long '图像宽（像素数） ia (`3r
ImageHeight As Long '图像高(像素数) 5YneoM]Q
PlaneNumber As Integer '图像层数
M i;Pv*
bpp As Integer 'bits per pixels '1 - monochrome bitmap #; f50j!r
'4 - 16 color bitmap K?Sy ?Kz
'8 - 256 color bitmap P) cEYk
'16 - 16bit (high color) bitmap F0~<p[9Nx
'24 - 24bit (true color) bitmap }'*6 A
'32 - 32bit (true color) bitmap }V[ORGzox
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) MT7B'hd
'1 - rle 8-bit / pixel (also identified by bi_rle4) \VA*3U^ @
'2 - rle 4-bit / pixel (also identified by bi_rle8) Ch\__t*v!
'3 - bitfields (also identified by bi_bitfields) K:^0*5Y-k
IMAGESIZE As Long '图像数据字节数 skBD 2V4
hResolution As Long '水平分辩率 像素数/米 ITg<u?z_
vResolution As Long '垂直分辩率 Q'qX`K+@`
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 xP,b/T #a
ImportantColors As Long +H28 F_ #
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 R1*4
End Type Y2;2Exp^
|-;VnC&UY
tHAe
[(gXjt-
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader r?IBmatK/
Public sRECT As RECT ({Pjz;xM
YRo,wsj
^,,}2dsb>
Public conn As ADODB.Connection xK_oV+
Public rsTrain As ADODB.Recordset C$0g2X
Public rsOperater As ADODB.Recordset x
FWhr#5,
Public rsGoods As ADODB.Recordset !JyY &D~`
Public rsGood2 As ADODB.Recordset 'y=N_/+s
Public rsSender As ADODB.Recordset ,ryL( "G
Public rsReceover As ADODB.Recordset tJ
2GSZ`
Public rsTrainTMP As ADODB.Recordset Le:(;:eL>t
u`&lTJgF/O
tbWf m5
$
'打开采集卡 >,E^ R `y
'设置参数 YM};85 K
'设置为实时单帧采集到缓存方式 !-.GfI:q
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 4"_`Mu_%
b\"w/'XX
hf^<lJh~=
Sub Main() [F'|KcE3
Dim i As Integer, status As Long !sSq
4K
'_^T]f r}
InitBMPinfo :PtZKt; ~X
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 &
+*OV:[;
BMPHeader.Tag = &H4D42 wYg!H>5
BMPHeader.ImageWidth = FrameW X6",Xr! {
BMPHeader.ImageHeight = FrameH :W5W
@8Y
BMPHeader.BMPHeaderSize = &H28 <N1wET-
BMPHeader.PlaneNumber = 1 Z %Ozzp/
BMPHeader.bpp = 8 dFF=-_O>
BMPHeader.Compression = 0 uKd4+Km
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 /isalOT
BMPHeader.vResolution = &H1274 &w#!
BMPHeader.ColorsinBMP = 256 ]8}51 y8
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP Fs]. Fa
BMPHeader.DataOffset = Len(BMPHeader)
?C#E_
For i = 0 To 255 AYgXqmH~+
BMPHeader.Pallate(i) = RGB(i, i, i) N0.|Mb"?t
Next i #c5jCy}n
BMPHeader.IMAGESIZE = FrameH * FrameW DU0/if9.
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE R(`:~@ 3\6
Pc_aEBq
^ lAM /
MoveMemory BMP1, BMPHeader, Len(BMPHeader) tAF?. \x"g
}f]Y^>-Ux
BMP1.ImageWidth = FrameW tq}45{FH3
BMP1.ImageHeight = FrameH * 2 ,zltNbu\.(
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight -(t7
>s
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE :
n QlS
0/b
_T
'确定标志位置,为pilarX, pilarY确定初始值 ]%)<9 ]}
PilarW = mkW | 1RVm?~i
PilarH = mkH '此两项为固定值 #{vC =m73
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) y TD4![
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 d 8DU[p
r!+{In+Z
UXs)$
'连续采集记录文件 T*f/M
' 建立一个缓冲区为页对齐方式的文件 wWy; dma#
If Dir(TmpFile) <> "" Then xEp?|Q$
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ xbm%+
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) fEX=csZ86
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 !t^DN\\#
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 l6y}>]
Else ocFk#FW
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ qh:Bc$S
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) nuXL{ tg6
End If Aeb(b+=
If hFile = 0 Then 3f] ;y<Km
MsgBox TmpFile & ": File Open Error", vbOKOnly sVK?sBs]
Exit Sub #3QPcoxa
End If USEb} M`
'采集参数记录文件 IQRuqp KL
hBCFile = FreeFile() iN[x
*A|h
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Jsysk $R
B*
,)@ h
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 68Gywk3]=u
If hMEM = 0 Then \gk.[={^P
fStatus = GetLastError d<6F'F^w.7
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ C/IF~<B
& "请向技术人员报告该错误代码。", vbOKOnly mAtqF
%V
CloseHandle hFile PDuc;
RG
Exit Sub D2?H"PH
End If ^>?=L\[
@Fb1D"!
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) dP
wyiV0
If hMemWork = 0 Then %'yrI R
fStatus = GetLastError :-B+W9'5
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ .VCY|KZ
& "请向技术人员报告该错误代码。", vbOKOnly {]< G =]'
'释放已成功分配的内存 N+=|WeZ
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) EUi 70h +
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) ,|{`(y/v
[/ CGV8+
CloseHandle hFile E4L?4>V@\
Exit Sub ,^1zG
End If b,E ?{uG
W
&IG,7tr
' Test writing ;^5k _\
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& y
%Q. (
{ aUnOyX_
'初始化采集卡参数 ch8a
iCurrentCard = -1 + cfEyiub
hBoard = okOpenBoard(iCurrentCard) y%SxQA +\
Debug.Print hBoard qcS.=C j?)
If hBoard = 0 Then wQSye*ec
ExitGrabber kFv*>>X`
End [b:&y(
End If IWQ0I&tzdx
okGetBufferSize hBoard, mBufferAddr, BufferSize N2v/<
If mBufferAddr = 0 Then rG}e\ziKuj
MsgBox "缓存不存在！" =~GP;=6
ExitGrabber c]PTU2BB8
End If x,!Dd
Debug.Print Hex(mBufferAddr), Hex(BufferSize) .9 r YBy
c3^!S0U
YV<y-,Io
currentBr = 128: currentContr = 128 nt#9j',6Rn
'设置视频输入参数 gSz<K.
CT
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 #$I@V4O;#
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input wqb4w7%
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 -> 8Kd1^F
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 a%T`c/ C
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 P.'.KZJ:WD
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 ;!MQ@Fi^
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） >u?.gJm ~
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) V4n~Z+k
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) #h5lz%2g
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 r D].=.?1
DB5J3r81
'设置采集参数 uiVN z8H
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 Nmj)TOEPW
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 R}ki% i5|
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 dU$VRgP/
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 *M1GVhW(+
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 :A8}x=K
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 eQuu\/z*H
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 0O9b
7F
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 fQJ`&9m*BF
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 Vx h39eW
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 \8 `7E1d
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 d:@+dS
apo) cR
H<(F$7Q!\
okCloseBoard hBoard >R+-mP!nj
Sleep 50
/MGapmqV9
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 j
u A@"SG
{^WK#$]
'设置数据传送方式 ~U0%}Bbh
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 tk&AZb,sP
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 |ia5Mr"t
X 0G,tl
sRECT.Right = -1 '用于获得当前设置值 )G/bP!^+(
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) }a7d(7
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom N1a]y/
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 m/KaWrw/)
sRECT.Left = 0 f#0HiE!
sRECT.Top = 0 c*;oR$VW
sRECT.Right = sRECT.Left + FrameW
Ghgn<YG
sRECT.Bottom = sRECT.Top + FrameH * 2 #\0m(v
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) IZ=Z=k{
yQ$i rS?
sRECT.Right = -1 '检查新设置值 BJj'91B[d
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) S,c{LTL
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom ~_
\Ra%
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) E^1yU
U.e!:f4{
If TESTSignal = False Then ] pn
U"
'ExitGrabber YThVG0I =
End If !l (Vk
x>yqEdR=o
,/\`Rc^n
(?jK|_
'设为实时采集状态 (S~kyU!)0
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) h>/teHy /
n<.7tr0 f\
r&{8/ 5 "
'单帧采集 A2|Bbqd
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 FDMQ Lx f
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) @d WA1tM
okCaptureTo hBoard, BUFFER, 0, 1 'single V<QpC5
'Do While okGetCaptureStatus(hBoard, False) <> 0 Uwc% '=@
' Sleep 20 : _8K8Sa
'Loop )|~&
(+Q?]
okGetCaptureStatus hBoard, True g\q .
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize GV0\+A"vD
'写入768*576测试图象 |_;kQ(,
ArrayToBMP TmpBMP \@gV$+{9
_:r8UVAT.
'打开数据库 e~]P _53
Set conn = New ADODB.Connection UP-eKK'z
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ f%]@e9dD
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ]9oj,k
"; Mode=Read|Write" <= 4$.2ym
conn.Open uf6egm5 ]
1bFZyD"
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) . g#}2
:3
frmRecord.Visible = True %;[D Mc/
frmQuery.Visible = True .] v>LsbhF
Load frmReceiveFromComm K4Q{U @ZJ
b)diYsTH
'调试参数 w2s`9
If InStr(UCase(Command()), "/CAPTURE") > 0 Then &FXf]9
_X
SignalBox.Visible = True MntmBj-T
End If T3wTMbZ!VK
If InStr(UCase(Command()), "/COMM") > 0 Then 3:,%># "
frmReceiveFromComm.Visible = True 2(eO5.FYF
End If q" VmuQ
X-\$<DiJGv
End Sub Y&
6 jFT_
o? baiO kH
Sub ExitGrabber() QVT0.GzR
'关闭数据库 7{#p'.nc5
'关闭采集卡 '12m4quO
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) w
<r*&
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) q8{Bx03m6
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) y\FQt]; z)
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) xV >
.]
okStopCapture hBoard Z",0 $Gxu
okCloseBoard hBoard #{6VdWZ
CloseHandle hFile REh"/d
Close #hBCFile +^AdD8U
conn.Close * ~P B
End Et 0gPX-
End Sub 2*cNd}qr
S5).\1m h[
Function ArrayToBMP(ByVal File As String)
3f`Uoh+
Dim BytesWrite As Long q[U pP`Z%
G*=HjLmZg
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ )I%M]K]F
CREATE_ALWAYS, 0&, 0&) V IzIl\<aM
sp\6-*F
If hTmpFile = 0 Then #Pd9i5~N
ArrayToBMP = False T"g_a|7Tj
Exit Function ~VsN\! G
End If `oxBIn*BD
d
n h qg3Y
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN v}DNeIh~
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& )z7CT|h7S
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN NS[ Z@ @
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& @K"$M>n$Z
1uo- ?k
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN gq('8*S
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& O60T.MM`
XRPJPwes]
If BytesWrite < pFrameSize Then OLG)D#m(4/
ArrayToBMP = False JI@iT6.%IX
End If $O |Xq7dp
i+`8$ uz
CloseHandle hTmpFile *d8
%FQ
[J 2evi?
End Function nAP*w6m0j
L1kn="5
Function ArrayToBMP1(ByVal File As String) B&MDn']fV/
g2f"tu_/%
Dim BytesWrite As Long WI1Y P0V
CEj_{uf|
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ +Z"Wa0w
A
CREATE_ALWAYS, 0&, 0&) ;6 V~yB
=c6d $
If hTmpFile = 0 Then upMs yLp(
ArrayToBMP1 = False G? SPz
Exit Function }9 ulHiR
End If )u(,.O[cw
!!.@F;]W
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN b'O/u."O
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& \; XJ$~>
JAxzXAsAR
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN w"v96%"Y
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& c4 4s @ E
C^$E#|E9 N
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN Jq ^[^
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& Ku'a,\7z
iZ]^JPU}
If BytesWrite < pBufferSize Then (6f D5XtS
ArrayToBMP1 = False t ]BG) ]
End If K"l~bFCZ8
Sst
z_t
CloseHandle hTmpFile ub?dfS9$_
3ML^ d Z'
End Function Bl>m`/\
1i
q>%B @'
'使用该过程建立的文件要求在用后关闭 \(??Ytc<B
Public Function ArrayToBMP2(File As String) As Boolean Dc xT6 [
Y M o 8C(
Dim BytesWrite As Long O]I AIM
%R5- 6
ArrayToBMP2 = True gYt=_+-
>:.c?{%g*
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ BD"Dz q
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) +P))*0(c_
X}GX6qAdt
If hTmpFile = 0 Then remc_}`w
ArrayToBMP2 = False 4l0>['K&{
Exit Function zeGWM,!
End If OI Fjc0
56Lxr{+X
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN xjp0w7L)J
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& PVi;h%>Y
"C}<umJ'
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN W2<' b05
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& OTYkJEC8\N
(%6 fZ
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 5]G%MB/|$
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& _E9[4%f
y_: {p5u
If BytesWrite < pFrameSize Then VK/L}^=GOO
ArrayToBMP2 = False 7b~uU@L`
End If ^4IJL",
%]F/!n
CloseHandle hTmpFile ,tXI*R
WReHep
End Function Wt%Wpb8
` { Ox=+]M
Private Function TESTSignal() As Boolean 0s8fF"$
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long I?1 BGaAA
N(i.E5& 9
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) /\e_B6 pF<
o5]-Kuw`
If extsign = 1 Then vAP1PQX;
TESTSignal = True q>+!Ete1p
Else %S%UMA.
If extsign = 0 Then y:E$n!
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly
qbc= kP
TESTSignal = False gR/?MJ(v
Exit Function U^ }7DJ
End If yF m
88
End If q"269W:
k/F#-},Q.
'测试视频输入类型 zSA"f_ e
'video type 9<&*iIrM
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 sC"w{_D@*4
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) .8'c
c8
If videotype = 1 Then \E c*Gq?.
'"隔行信号(Interlaced)" otaR
A
Else # ,H!<X;SS
If videotype = 0 Then MHp:".1
'"逐行信号(Non-interlaced)" w.rcY ywI
Else e6 *,MnqBh
If videotype = -1 Then z jH8 S
' "不支持" J<0sT=/2$
End If xm=Gt$>.o
End If d v4~CW%Td
End If 7Tp +]"bL
D<70
rBf2
'测试垂直扫描线数 n+
H2cl }
'video scanlines C\{ KB@C\*
scanlines = -1 U
`lp5 6
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) H{*rV>%
If scanlines = -1 Then 0OlT^
' "不支持" X+{brvM<
Else P\@kqf~p C
'Trim(Str(ScanLines)) + " 行数/幅" jjrE8[
End If zv"N bN
Kf?
:dF
'测试帧频 {.U:Ce
'video field frequency Xtz29
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) UOj*Gt&
If fieldfrq = -1 Then K:13t
|
'lblSignal(8) = "不支持" aQHR=.S]X
Else jc3Q3Th/zn
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" k v_t6 (qd
End If ^$`mS&3/q
End Function 2asRJ97qES
;mI^J=V3
KO`dAB F}
Sub PicIdentify() $J<WFDn9
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 %O!x rA{
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 pq_U?_5Z'r
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 \>9^(N
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 3;jx Io$,
ES^J R X
Dim fPTR As Long, cFrame As Long 3{qB<*!p"G
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer 9 7HI9R
du0o4~-
u-j V@Tz
cFrame = 0 -~RGjx
Ne;0fk O
K#6@sas
Do While cFrame < tFrames 2W LL I8
EajJv>X7
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) "1\GU1x
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) e1b?TF@lz
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 3
[#Rm>,Vu
r=37Q14v
frmRecord.RText.Text = Str(cFrame) @8w[Z o~
frmRecord.RText.Refresh %Cj_z
tYgHJ~1L*
If CheckMark = True Then 8 mOGEx
ArrayToBMP TmpBMP =i}lh }(
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) K8&) kfyI
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" Z0M,YSn z
Aua}.Fl,
DrawSlice P
B-x_D
fVZ9 2Xw
B
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) CL`+\
.
'If i = vbNo Then ?x 0gI
' Exit Do v2r|) c,h
'End If @#^Y#
rxb
'cFrame = cFrame + 1 n2 _;:=
z&c}
End If "J*>g(H53
DoEvents /]0SF_dZ
cFrame = cFrame + 1 }Z\S__\9
Loop | aU8 WRq
End Sub M* c F'go
mcid A%
cDYO Ju.
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean OV xg9
_PGd\>Ve
'如标志区模式反差存在则为TRUE，否则返回FALSE RnC+]J+?4
Ul NiH
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long V$FZVG/@#
CheckMark = True J8@ .qC'!
g9;s3qXiG
'复制标志区 [zq2h3r
For i = 1 To mkH sZ7,7E|_
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW `t9k!y!
GV
Next i Kwm_ Y5`A
hwvi tD!0
For j = 1 To PilarW * PilarH / 2 a * }>yad
mTop = mTop + MKpilar(j) S~H>MtX(<
Next j B1Pi+ -t
y8C8~ -&OK
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH -da: j-_
mBot = mBot + MKpilar(j) M/lC&F(
Next j G$KQgUN~[
3.P7GbN
mTop = mTop / PilarW / PilarH * 2 y$di_)&g
mBot = mBot / PilarW / PilarH * 2 [+l
6x1Am
1he5Zevm}
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 v:Gy>&
Jqgm>\y
'平均值极值化 rtbV* @Z
For j = 1 To PilarH * PilarW G=Lg5`3;,
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) l{]KA4
Next j _E8Cvaob
9Nna-}e?W
mTop = 0: mBot = 0 }/\`'LQ
For j = 1 To PilarH * PilarW / 2 Gj%q:[r
mTop = mTop + MKpilar(j) d@$bPQQ$,
Next j [n&ES
\o#(
+Q"~2_q5/;
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW F?jD5M08t/
mBot = mBot + MKpilar(j) h-O;5.m-P
Next j bJ9*z~z)e
!Ea9
fe
?7lW@U0
mTop = mTop / PilarH / PilarW * 3 O# ):*II`9
mBot = mBot / PilarH / PilarW * 3 `'5vkO>
av5a2r 0W1
HCkfw+gaV
If mBot > iWhite And mTop < iBlk Then a[z $ae7
CheckMark = True !%t2Z QJq
Else 3b#L*-
CheckMark = False \Wg_ g A
End If aO(iKlZ$
End Function 4Z=`;
H2Z
e\c
Sub Capture1Frame() oC}
u
okCaptureTo hBoard, BUFFER, 0, 1 'single O0
Uh
okGetCaptureStatus hBoard, True ,uNJz -B8
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize /s+IstW
End Sub A)j!Wgs^z
g]N'6La
;/pI@C k
Sub CopyMark(iBlk As Integer, iWhite As Integer) 2 A";o E
'复制标志区并返回标志区暗区与亮区的亮度平均值 cX4]ViXSr
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 KXl!VD,#`=
Z]tQm V8 e
'复制标志区 {_L l'S
For i = 1 To mkH ]9 _}S
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW MwQ4&z#wh
Next i oD9L5c)
5D<ZtsXE
For j = 1 To mkW * mkH / 2 _!vy|,w@e
mTotal = mTotal + MKpilar(j) CCt\[hl
Next j .# iot(g
| N)),/R_
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 h 6IXD N
E
y9rH _
mTotal = 0 Q@PDhISa
For j = mkW * mkH / 2 + 1 To mkW * mkH 6ce-92n
mTotal = mTotal + MKpilar(j) NOkgG0Z
Next j |'P$z MAF
T>b"Gj
/
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 .}Xf<G&
k?L2L IB<
'背景亮度 -&]!ig5v
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW @TXLg2
For i = 1 To 4 * FrameW qP&:9eL
bsTotal = bsTotal + BsLine(i) D :IG;R sc
Next i ~Ma r
bsAV = bsTotal / FrameW / 4 $%'3w~h`
f)a0 !U 44
End Sub KZcmNli&A
wD$UShnm9-
@- xvdntx
Sub AdjIMGbright(Optional bInit As Boolean = True) 7hu7r WY`E
}(XKy!G6
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） FIVC~LDd
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 kw#-\RR_c
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 :?y Ma$
RP+)sCh
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer Fsx<Sa
YAe F*vP
'按标准亮度与对比度采集一帧，确定背景亮度 Wi!"V cn
currentContr = 128 '初始对比度 E,K>V:P*
currentBr = 128 '初始亮度 .oLV\'HAR
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Y6)o7t
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 P,3w
b
DoEvents rev*G:
Capture1Frame |Ox='.oIb
'获得图像上缘4行象素 |#SZd Xg
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW 4 83rU
CopyMark iBlack, iBright '图像标志区亮度 Y.tT#J^=
For i = 1 To 4 * FrameW $?k]KD
bsTotal = bsTotal + BsLine(i) dkDPze9l
Next i Q[q`)~|
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 D `V.gV]
q~W:W}z
Select Case bsAV U1lqg?KO
Case 0 To 60 '夜间通过灯光照明,完全没有背景 UuF(n$B
currentBr = 150 ;b1B*B
currentContr = 60 "dDrw ]P;
Case 61 To 80 '有可见背景 Z _S{$D
currentBr = 140 T,>L
currentContr = 70 7m]J7 +4
Case 81 To 100 '有清晰背景 0WSZhzNyY
currentBr = 128 lQ!OD& 6
currentContr = 80 |S |'o*u
Case 100 To 150 '有明亮背景 aH @-"Wi
currentBr = 140 '5:30-6:00钟实测数据 t& [<Dl/L
currentContr = 50 H|w P8uQC
Case 151 To 180 O1t$]k:
currentBr = 130 H=f| X<8
currentContr = 60 "8 cI]~ V
Case 181 To 220 '背景全为白色 `=,emP&(H&
currentBr = 110 mK"s*t D
currentContr = 130 vlEW{B;)Z
Case 221 To 255 '背景全为白色 s/C'f4
currentBr = 100 5E~^-wX
currentContr = 100 eM FxdtH
End Select _'L16@q
@@{5]Y
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 |KS,k|).
Case 100 To 150 J>nBTY,_<
currentBr = currentBr - 10 m_Q&zp["
Case 151 To 255 mb 1c9
currentBr = currentBr - 20 V q{3:QBR
End Select q-_!&kDK"
3b]M\ F9
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 NV9JMB{q
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 nu-&vX
End Sub +DR$ >a
6'@ {
*
u
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) \M._x"
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long t8xXGWk0
E!mv}
For i = 1 To 8 NT5' U
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& J,u-)9yBA<
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& 02*qf:kTnA
Next i $o f2 lA
rvd%z7Z1o
For j = 1 To 1024 vW vu&3tx
L1 = L1 + LeftBK(j, 0) cgQ6b.
L2 = L2 + LeftBK(j, 1) S7PWP< 9
R1 = R1 + RightBK(j, 0) qdv O>k3
R2 = R2 + RightBK(j, 1) 66"
6>
Next j yrfV&C%=n
diffL = Abs(L1 - L2) / 1024
$8HiX 6r
diffR = Abs(R1 - R2) / 1024 2E!~RjxSY
End Sub Yb/*2iWX
2ag8?#
Function CheckSlice() As Boolean nQ_{IO8/6W
CopySlice avSL, avSLR, avSLL &TA{US3~
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then P cU~1m1
CheckSlice = True 6(4d3}F
Else 650qG$
CheckSlice = False Q3&q%n|<
End If T :m"
eD;
End Function
HDZl ;=
kC
6*An_f
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) h"0)spF"d
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long 324XoMO
For i = 1 To FrameH hEsi AbTyF
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize "opMS/a"7
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize <.gDg?'3
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 7X/t2Vih@
Next i p@4GI[ 4
For i = 1 To FrameH p e+h8
For j = 1 To sSize $ GG aR x
total = total + Slice(j, i) 7dACbqba
totalL = totalL + SliceL(j, i) 9jEH "`qqk
totalR = totalR + SliceR(j, i) fPPP|
Next j rZaO^}u]
Next i 0*rD'?)K+
avSL = total / FrameH / sSize YE{t?Y\5
avSLR = totalR / FrameH / sSize +s"6[\H1d
avSLL = totalL / FrameH / sSize ]SRpMZ
End Sub `V\?YS}
@v#P u_
Sub DrawSlice() <EN9s
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B H;=Fq+
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B :Ez, GA k
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B 3)\fZYu)
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) DR:$urU$
End Sub ,bd jk (
Sub DrawMark(pic As Control) )S2yU<6oOt
Dim i As Long, j As Long xLO
Qu.
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B h3k>WNT7
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B 0.n[_?< (
For i = 1 To PilarH pxd=a
!(
For j = 1 To PilarW Kob,}NgqZ
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) d,JDfG)
Next j mOn_#2=KF
Next i Y-YuY
End Sub *pS 7,Hm
DyGls8<\!
Function avIMG() As Integer E 8}evi
Dim i As Long, j As Long, totalIMG As Long ` K
{k0_{
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize (A6~mi r!
For i = 1 To pFrameSize x6 s|al
totalIMG = totalIMG + pBuffer(i) 0Q_*Z (
Next i IY#:v%U
avIMG = totalIMG / pFrameSize $Emu*'
End Function 'D
?o^
@y`xFPB
Function avRegion(barCol As Integer, barWidth As Integer) As Integer u ij^tN
%
Dim i As Long, j As Long, totalIMG As Long |.UY' B
For i = 1 To FrameH ZDR@VYi+~
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth ! +^'Ej)z
Next i Hy[: _E
For i = 1 To FrameH * barWidth /+SLq`'u)
totalIMG = totalIMG + pBuffer(i) ZqVbNIY
Next i B<m0YD?>~>
avRegion = totalIMG / pFrameSize Y6 sX|~Zy
End Function
BrwC 9:
