这才是我当年写出的一个比较烂的程序
hWxT ! JD&U}dJ Main2.bas
#:
hVF/ jsW X 6(= Attribute VB_Name = "SubMain"
U"x~Jb3]O Option Explicit
pTE T%)3 on5 0+)uN '采集文件与临时文件
)
> $^
wT Public Const TmpFile As String = "d:\30-0600.dat"
Q7k. +2 '已有数据：30-0600.dat /30日早6点进车与6：30出车头
zPBfiK_hV b;{h?xc6 Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long
#JS
`e_3Rr Public hBCFile As Long '记录采集参数的文件
gb_X?j%p7 Public Const TmpBMP As String = "d:\1.bmp"
@XBH.A^7r Public hTmpFile As Long
JN^bo(kb coAW9=o}
E\! n49 '采集窗口参数常量
_80n s&q Public Const FrameH As Long = 280&
kH2oK
:lN Public Const FrameW As Long = 768&
+S0u=u65 Public Const pFrameSize As Long = FrameW * FrameH
t?.\|2 [d:@1yc '标志区范围，用于识别车辆
pzSqbgfrQ Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X
b7v dk Public Const mkW As Integer = 28 '识别标志立柱宽度
nP
u`;no Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白)
1*c>I@I; Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白)
0BXs&i-TP5 Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标
H5p5S\g-) '车缝检测位置常数
A\g % Public Const sSize As Long = 32&
Oxj(g;} Public Const sPos As Long = 310&
vz
y!3Hiw Public Const sPosL As Long = 200&
wT % "5: Public Const sPosR As Long = 500&
Y- ~;E3( '车缝检测框位置
'a_s%{BJXg Public Slice(1 To sSize, 1 To FrameH) As Byte
}} # be Public SliceL(1 To sSize, 1 To FrameH) As Byte
g< )72-h Public SliceR(1 To sSize, 1 To FrameH) As Byte
^H'kH l'F Public avSL As Integer, avSLR As Integer, avSLL As Integer
%yhI;M^ f !!P u\w 2S4c Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化
|D(&w+( '该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别
Lupy:4AD Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围
"OJr*B
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long
^Y<M~K972 Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte
AA.Ys89V '前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向
Mk "vv k L5C 2ng> w`-$-4i ML eX;He '一次连续采集的帧数
}{=8& gA0 Public tFrames As Long
TU- c9"7M~ {g@A> '在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据
%O_t`wz '而该卡的硬件设置是按场采集，只需要读第一场的数据即可。
%^U"Spv; '所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize
vnVZJ}]w\ _/ Tlqzp Public pFRAME(1 To FrameW, 1 To FrameH) As Byte
oVEAlBm^v Public pBuffer(1 To FrameW * FrameH * 2) As Byte
\bRy(Z) Public pWorkSpace(1 To FrameW * FrameH) As Long
-$m@*L Public Const pBufferSize As Long = FrameW * FrameH * 2
tx)OJY Public pGray(0 To 255) As Long '整幅图像的灰度直方图
#'iPDRYy H9:%6sds Public hBoard As Long '采集卡标识
khS/'b Public mBufferAddr As Long '缓存地址
DUo0w f#D^ Public BufferSize As Long '缓存大小(字节)
q xSs
~Qc Public iCurrentCard As Long
Vku#;:yUb^ Public CapStatus As Long
j8 8=f#< Public iFrames As Long
<vLdBfw&N Public currentBr As Byte, currentContr As Byte
\gP . \ xfes_v"" Public hMEM As Long, mStatus As Long
c
_p[yS Public Const hMemSize As Long = pFrameSize * 4
i\vpGlx Public hMemWork As Long
F 7V6-V{_ Public Const hMemWorkSize As Long = pFrameSize * 5
A`Q
>h{ w Oj88J) nHVPMi> ;YM]K R; '串口接收轨道衡数据
Nkoo fhZ Public WeightFromCom As String
O sB?1;: Public bReceiveComplete As Boolean
QA! #s\ F`3^wHw^ 6~3jn+K$1 Public Type GrayBMPHeader
c-`37. J Tag As Integer
$>(9~Yh0 FileLength As Long '文件大小
}M?|,N6 Reserve1 As Long
h-,?a_ DataOffset As Long '图像数据偏移量
Md?a
cWE*L BMPHeaderSize As Long '文件头长
_y"a2M 'length of the bitmap info header used to describe the bitmap colors, compression,…
0QM
aM 'the following sizes are possible:
Ri[S<GOMii '28h - windows 3.1x, 95, nt, …
? 4MSgu '0ch - os/2 1.x
|y U3Kt 'f0h - os/2 2.x
R @OSqEnr ysl8LK
ImageWidth As Long '图像宽（像素数）
A{M+vsL ImageHeight As Long '图像高(像素数)
6."PS4}: PlaneNumber As Integer '图像层数
]qMH=>pOsj bpp As Integer 'bits per pixels '1 - monochrome bitmap
&p )@8HY '4 - 16 color bitmap
g@}6N.]# '8 - 256 color bitmap
i#tbdx# '16 - 16bit (high color) bitmap
!^]q0x '24 - 24bit (true color) bitmap
+`9yZOaC# '32 - 32bit (true color) bitmap
C|9[Al Compression As Long '压缩方法 '0 - none (also identified by bi_rgb)
|[DV\23{G '1 - rle 8-bit / pixel (also identified by bi_rle4)
l_ZO^E~D_ '2 - rle 4-bit / pixel (also identified by bi_rle8)
L1rA T '3 - bitfields (also identified by bi_bitfields)
5U3qr*/ ;m IMAGESIZE As Long '图像数据字节数
InP[yFV-z hResolution As Long '水平分辩率 像素数/米
MN\i-vAL8 vResolution As Long '垂直分辩率
)FV6, ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100
,,Jjr[A_j ImportantColors As Long
B3eNFS Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数
s9G)Bd 8 End Type
+R9%~Z.= X;(oz]tr$ & b!vWX1N Fdr*xHx$P Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader
U-1VnX9m Public sRECT As RECT
Mc!2mE%47m f@h2;An$w nZ541o@t9 Public conn As ADODB.Connection
QYH."7X
> Public rsTrain As ADODB.Recordset
48:liR Public rsOperater As ADODB.Recordset
$\0 TD7p Public rsGoods As ADODB.Recordset
(;C$gnr.C Public rsGood2 As ADODB.Recordset
7
T mK Public rsSender As ADODB.Recordset
qT"drgpi3 Public rsReceover As ADODB.Recordset
A0UV+ -PP Public rsTrainTMP As ADODB.Recordset
p8$\uo 9YQ cB _pyX9Z 8B_0!U& ] '打开采集卡
~K_ ]N/ > '设置参数
x<Iy<v7- '设置为实时单帧采集到缓存方式
XRtyC4f
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存
CH55K [{< gj[z ka0_ wG;}TxrLS Sub Main()
k"5 `
: qL Dim i As Integer, status As Long
WI0Q LR' g(KK9Unu InitBMPinfo
I7A7X* '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件
h)7v1,;w' BMPHeader.Tag = &H4D42
%-\FVKX BMPHeader.ImageWidth = FrameW
sC!1B6: BMPHeader.ImageHeight = FrameH
7KeXWW/ d BMPHeader.BMPHeaderSize = &H28
F9F" F BMPHeader.PlaneNumber = 1
4v0dd p BMPHeader.bpp = 8
SQKi2\8w BMPHeader.Compression = 0
Tw}@
+- BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0
Ko4 )0& BMPHeader.vResolution = &H1274
Tm%WWbc BMPHeader.ColorsinBMP = 256
vNPfUEn A BMPHeader.ImportantColors = BMPHeader.ColorsinBMP
?<Z)*CF) BMPHeader.DataOffset = Len(BMPHeader)
;,mBT[_ZO For i = 0 To 255
v*smI7aH BMPHeader.Pallate(i) = RGB(i, i, i)
H ]VsOr Next i
K?$ 9N}+ BMPHeader.IMAGESIZE = FrameH * FrameW
)nJzSN=>$ BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE
-e
&$,R>; ^dheJ]n=k U.Pa7tn MoveMemory BMP1, BMPHeader, Len(BMPHeader)
sE^ns\&QP= r^fxyN2V BMP1.ImageWidth = FrameW
-|6V}wHg~ BMP1.ImageHeight = FrameH * 2
E1^aA lVSD BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight
/L)?> tg BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE
0&.LBv8 B,r5kQI4 '确定标志位置,为pilarX, pilarY确定初始值
Nz3zsP$ PilarW = mkW
$xLEA \s PilarH = mkH '此两项为固定值
KSF5)CZ5 PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX)
M\9 at\$ PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整
F1 9;RaP+ H]Y#pL u| "L ^TT2 '连续采集记录文件
9qnuR'BDu ' 建立一个缓冲区为页对齐方式的文件
~K4k'
If Dir(TmpFile) <> "" Then
*iPs4Es- hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _
TlM'g6SQS 0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&)
mgk64}K [n ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项
gkSGRshf ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。
L -`(!j Else
jG
= (w 4+ hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _
Z`^
K%P= 0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&)
7ytm .lU End If
X77A; US If hFile = 0 Then
Xs{/}wc.q; MsgBox TmpFile & ": File Open Error", vbOKOnly
aIQr b Exit Sub
3 7J\i ] End If
<m~T>Q l 1 '采集参数记录文件
k,a,h^ {}j hBCFile = FreeFile()
u4go*# Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile
"ugX
/r$_ BT&rp%NO6l hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容
}P 05eI If hMEM = 0 Then
>|v=Ba6R0 fStatus = GetLastError
<+ -V5O^ MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _
3s3
a> & "请向技术人员报告该错误代码。", vbOKOnly
t^`<*H CloseHandle hFile
~l;yr
@ Exit Sub
I[tAT[ < End If
We[<B J o4 s4!|v`+$M hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE)
0Ei\VVK> If hMemWork = 0 Then
*K]>} fStatus = GetLastError
#&;m<
% MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _
z~GVvgd & "请向技术人员报告该错误代码。", vbOKOnly
C
}x4#bNK '释放已成功分配的内存
rdORNlK& mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT)
]R97 n|s_ mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE)
2 q2p=H>& 'hxs((['\ CloseHandle hFile
%{N>c:2I$ Exit Sub
& gY;`*< End If
'=KuJ0`nE9 L+v8E/W ' Test writing
(k 7; 'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0&
HR/k{"8W4Q $ iX^p4v '初始化采集卡参数
9m<wcZ iCurrentCard = -1
, LCH2r hBoard = okOpenBoard(iCurrentCard)
#N<s^KYG- Debug.Print hBoard
R1]v}f _I" If hBoard = 0 Then
nL 1I S ExitGrabber
>:3xi{ End
0SAG6k~x End If
p=:7 atE okGetBufferSize hBoard, mBufferAddr, BufferSize
##SLwrg If mBufferAddr = 0 Then
oA(. vr MsgBox "缓存不存在！"
43UJ#r
F ExitGrabber
i n[n A a End If
:7HVBH Debug.Print Hex(mBufferAddr), Hex(BufferSize)
NTXws
4'D n,C D4Nv '?&B5C currentBr = 128: currentContr = 128
wJ; 9),fL '设置视频输入参数
-0=}|$H. okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2
{LR#(q$1 ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input
=g{ _^^n okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度
wxdh?sQ okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光
>qSO,$ okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式
:6\-9m8JM okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式
tXssejiE% okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字）
^4n2
-DvG okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值)
&. |;yt%v okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值)
dbf^A1HI okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号
j<.
<S { + TP bIRA '设置采集参数
sg'Y
4 okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧
6Y0/i,d* okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式
m] +X }| okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度
@\x, ;!N@ okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换
{jj]K.& okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式
^N*pIVLC okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集
\ #h})` okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值
J>,'P^ okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数
8cYuzt].. okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回
34&u]4=L) 'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000
gJWlWVeq$ 'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节
$bF`PGR_ mafAC73 (H|%?F;{l okCloseBoard hBoard
BDv|~NHs Sleep 50
fS;m+ D!j@ hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效
8eg2o$k_,# &4ug3 '设置数据传送方式
n?TO!5RZK 'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行
17MN8SfQ '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。
$i1>?pb3 f ~n' Ki+' sRECT.Right = -1 '用于获得当前设置值
,*9#c*'S iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
&F@t mM~ Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom
<8F->k1"3 Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000
; /6:lL sRECT.Left = 0
_*OaiEL+: sRECT.Top = 0
20SF< V sRECT.Right = sRECT.Left + FrameW
|THkS@B r sRECT.Bottom = sRECT.Top + FrameH * 2
"6|'& 6& iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
E
6>1Fm8%V /NPl2\ o. sRECT.Right = -1 '检查新设置值
Jgi{7J iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
oT9XJwqnv Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom
E-*> f"<h Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1))
^*$WZM MJ1 UgOGBj,&5W If TESTSignal = False Then
1Ud
t9$~T 'ExitGrabber
$G^H7|PzdC End If
HQ-N!pf9 f_z2#,g yKX:Z4I/ ]ly)z[is"] '设为实时采集状态
zWKrt.Dg 'iFrames = okCaptureActive(hBoard, BUFFER, 0&)
s5_ 1}KKCs bi4^ zaCEE K284R=j -& '单帧采集
J8 `1V `$ 'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1
ss
|6_H = 'iFrames = okCaptureSingle(hBoard, BUFFER, 0&)
m \[email protected] okCaptureTo hBoard, BUFFER, 0, 1 'single
bKZAJLnd 'Do While okGetCaptureStatus(hBoard, False) <> 0
;&7qw69k ' Sleep 20
K4K3< Pg 'Loop
3RTB~K8:{ okGetCaptureStatus hBoard, True
+#i ,87 MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize
(AyRs7Dkn '写入768*576测试图象
P~b%;*m}8 ArrayToBMP TmpBMP
+E""8kW- Z #U6/@l) '打开数据库
9fr&Yb=_o@ Set conn = New ADODB.Connection
r`mzsO-' conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
DI2S
%N l "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _
o$qFa9|Ec? "; Mode=Read|Write"
b_)QBE9 conn.Open
.q'FSEkMJ qqO10~Xc frmRecord.Picture1.Picture = LoadPicture(TmpBMP)
&L[8Mju6 frmRecord.Visible = True
6 ^6uK frmQuery.Visible = True
v]d?6g Load frmReceiveFromComm
y7}~T!UyfF B <|q{D$N/ '调试参数
7 @e[:>e If InStr(UCase(Command()), "/CAPTURE") > 0 Then
f6/\JVi) - SignalBox.Visible = True
JY;#]'T\; End If
N?`GZ +5 If InStr(UCase(Command()), "/COMM") > 0 Then
Ed ?Yk*
4 frmReceiveFromComm.Visible = True
6w .iE b End If
`"bRjC"f] [8o
m9
Z3 End Sub
R, (+NT$ /M{)k_V Sub ExitGrabber()
:">~(Rd ZH '关闭数据库
CM@"lV_ '关闭采集卡
&`\kb2uep mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT)
s>"WQ|; 6 mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE)
k^vmRe<lk mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT)
$D2Ain1 mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE)
4^jZv$l5 okStopCapture hBoard
,rvZW}= okCloseBoard hBoard
c+\Gd}IJq CloseHandle hFile
U`vt/#j
1 Close #hBCFile
Z)Xq!]~/g conn.Close
~k:>Xo[|O End
9R t(G_' End Sub
Di5Op(S(( y+~Aw"J} Function ArrayToBMP(ByVal File As String)
H~1? MAX Dim BytesWrite As Long
/ fcwz 5~ l*V72!Mv hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _
sB*h`vs0T CREATE_ALWAYS, 0&, 0&)
s3f
G X|; PHB \)/ If hTmpFile = 0 Then
'KW+Rr~tZn ArrayToBMP = False
@)M.u3{\ Exit Function
N]<~NG:6b End If
;*85'WcS X~/ 9Vd g SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
Ov{B-zCA WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0&
.jG.90 SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
sjVl/t`l WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0&
f|HgLFx ES:p^/ =* SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN
=,} !Ns{k WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0&
:L+zUlsf 36 D,el In If BytesWrite < pFrameSize Then
hF{mm(qyv ArrayToBMP = False
"}
azC |:5 End If
5D q{"@E EzY
scX.[ CloseHandle hTmpFile
m<VL19o>R >=RHE @ End Function
s*A|9u f5 Lh5+fk~i~8 Function ArrayToBMP1(ByVal File As String)
*TMM:w|1 h^3Vd K, Dim BytesWrite As Long
<P
Z\qE*+y X#\ P.$ hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _
| Y,X=Ed CREATE_ALWAYS, 0&, 0&)
EWvid4QEi I?xhak1)lu If hTmpFile = 0 Then
W1M/Z[h6)5 ArrayToBMP1 = False
7C 6BZ$( Exit Function
BRQ5 End If
4 9+}OIX 9"l%tq_ SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
uma9yIk WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0&
s t 3]Yy Zq6ebj SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
C8%nBa / WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0&
:d/:Ga5v! 4h2bk\z- SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN
^c:eXo U WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0&
#IciNCIrG Q0oDl8~ If BytesWrite < pBufferSize Then
,1 9" [:WN ArrayToBMP1 = False
hc~#l # End If
DW;.R<
8 q?b)zeJ CloseHandle hTmpFile
)7 BNzj"~ PeR<FSF ,i End Function
;kcFQed\w ]`+"o[ '使用该过程建立的文件要求在用后关闭
r|sy_Sk/{ Public Function ArrayToBMP2(File As String) As Boolean
i OA3x 8J U S~JLJI Dim BytesWrite As Long
c9 TkIe A_dYN?^?| ArrayToBMP2 = True
9cHNwgD>v s!zr>N" hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _
z8MpE CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&)
s?gXp {O?X _KlPbyLU If hTmpFile = 0 Then
<H(A S' ArrayToBMP2 = False
aG&kl O>m Exit Function
ieK'<%dxF End If
P24 @e D2<e SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
pz z`4VS: WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0&
l'X?S(fiV EC&1
9 SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
sRI=TE]s WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0&
'"NdT7* + 'J<zVD}0 SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN
\}_7^)S; WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0&
,@j& q Ffqn|} gb If BytesWrite < pFrameSize Then
m+JG
e5fR< ArrayToBMP2 = False
=I*ZOE3n End If
'Y/V9;`)s tLGwF3e$A CloseHandle hTmpFile
P<w>1
= n$VPh/ End Function
.M#>@~XR mm~o%1|WR Private Function TESTSignal() As Boolean
Vf* B1Zb Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long
E!]rh,mYK pLFL6\{g extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST)
)fcpE ,g' wz2)seZY If extsign = 1 Then
b+fy&rk@- TESTSignal = True
r4qV}-E Else
S
o0,) If extsign = 0 Then
r_2VExk MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly
B=qRZA!DQ? TESTSignal = False
kO O~%|1CP Exit Function
7.=s1~p End If
w + )GM End If
0DjB qh$ P)
0=@{( '测试视频输入类型
{`SGB;ho
'video type
;
{# M okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40
jYssz4)tp videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE)
?>Ci
`XlLr If videotype = 1 Then
4 rCqN .J '"隔行信号(Interlaced)"
U8 @*I>vA Else
X\:(8C;+ If videotype = 0 Then
XT;IEZQZ '"逐行信号(Non-interlaced)"
A-NC,3 Else
dXSb%ho If videotype = -1 Then
Kh _> V m/ ' "不支持"
BB}iBf I' End If
Vam8NnZ|r End If
:=fHPT End If
yvnrZ&x : >WG91b<Xq '测试垂直扫描线数
A&|(% 'video scanlines
VHkrPJ[ scanlines = -1
GAe_Z( T scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES)
i_9
/!D If scanlines = -1 Then
rAi!'vIE ' "不支持"
F;l<>|vG Else
[75e\=wK 'Trim(Str(ScanLines)) + " 行数/幅"
:1Yd;%>92 End If
%. } 8Y kH '测试帧频
p~ VW3u] 'video field frequency
q+=@kXs >+ fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ)
i}12mjF If fieldfrq = -1 Then
|r!Qhb.! 'lblSignal(8) = "不支持"
5 s2}nIe Else
xH .q 'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒"
.ceU @^ End If
<. ]& FPJ End Function
{.[,ee-)9 jT_Tx\k ]$%4;o4O Sub PicIdentify()
"h|0]y^2 '本程序完成从文件中按顺序读出一幅图像并完成图像识别
n!,TBCNX '根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息
FKTP0e7=9 '判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔
GeR -k9 '方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍
[UrS%]OSR 2G*#Czr" Dim fPTR As Long, cFrame As Long
3). c [F^l Dim i As Long, j As Integer, pTotal As Long, pAV As Integer
oEf^o*5( UmMYe4LQR m,"tdVo . cFrame = 0
)Syf5I "pJ EzC Wam?(!{mOf Do While cFrame < tFrames
[1X5r<(W5 iV$75Atk fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN)
c35vjYQx0 fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&)
Ho*R LVI0U MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize
Yl3PZ*#@ Q >Qu^{o
frmRecord.RText.Text = Str(cFrame)
!c' ;L' frmRecord.RText.Refresh
>LZ)<-Mk J;9QDrl` If CheckMark = True Then
`RLrT3 4 ArrayToBMP TmpBMP
{ }2p1-( frmRecord.Picture1.Picture = LoadPicture(TmpBMP)
I ywx1ac frmRecord.RText.Text = "第" & Str(cFrame) & "帧"
Al;oI3 S
~`AnX3! DrawSlice
]t 0S_ UH$ "!eT 'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo)
{dH<Un(4Z 'If i = vbNo Then
JqIv&W ' Exit Do
]qT r4`. 'End If
<J uJ`t 'cFrame = cFrame + 1
L{ ^@O0S ! q1^X% a End If
xVo)!83+Q DoEvents
x@l~*6!K cFrame = cFrame + 1
QE6-(/ Loop
^qy-el End Sub
+m},c-,=$w ?a_q!,8: E^ti !4{< Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean
0p2O8>w^% !!pi\J?sk '如标志区模式反差存在则为TRUE，否则返回FALSE
\X p"I5 / =<u l-K Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long
> %*X2'^ CheckMark = True
+=xRr?F y.NArN|% '复制标志区
DccsVR`7 For i = 1 To mkH
[wxI
X MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW
Q(Y,p`> Next i
9`VF
[*
9 z-E4-\a
For j = 1 To PilarW * PilarH / 2
pIjVJ9+j mTop = mTop + MKpilar(j)
u $^` hzfI Next j
Z-V%lRQ=b h2*&>Mc For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH
a#j^g u$m mBot = mBot + MKpilar(j)
u 9Tl Xn Next j
=) >q.R9 `) P_X4e]` mTop = mTop / PilarW / PilarH * 2
~#Mx&mZ mBot = mBot / PilarW / PilarH * 2
ml/O S :|*wB mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度
xL"o)]a= DN_C7\CoA '平均值极值化
*XR~fs?/*W For j = 1 To PilarH * PilarW
S}I=i>QB MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0)
RlL,eU$CS Next j
I=-;*3g6 ! ~kz xY mTop = 0: mBot = 0
^aMdbB
For j = 1 To PilarH * PilarW / 2
a-hGpYJJG mTop = mTop + MKpilar(j)
=f| a?j,f~ Next j
-L 3RzX Um| Tf]q For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW
CplRnKra mBot = mBot + MKpilar(j)
XOFaS '. Next j
WHT%m|yn %P6!vx:&^b 2$UR " P mTop = mTop / PilarH / PilarW * 3
tS@/Bq('B mBot = mBot / PilarH / PilarW * 3
_ h-X-s Y &1Iy9&y >C66X?0cd If mBot > iWhite And mTop < iBlk Then
H!=BjU1Pmg CheckMark = True
(ytkq( Else
h0pr"]sO;$ CheckMark = False
.k(_ j.v End If
e 4LNnJU\| End Function
Ku'U^=bVm: `v
er "s; Sub Capture1Frame()
2geC3v% 0o okCaptureTo hBoard, BUFFER, 0, 1 'single
X"GQ^]$O okGetCaptureStatus hBoard, True
EF~PM MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize
vGDo?X~#o End Sub
QyQ8M1m ' qVa/GJ oa7Hx<Y Sub CopyMark(iBlk As Integer, iWhite As Integer)
!X_~|5. '复制标志区并返回标志区暗区与亮区的亮度平均值
Mb!^_cS( 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
uwzT? C A6 % j; cXN '复制标志区
I-hhHm<@ For i = 1 To mkH
zn RhQ+8;! MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW
aC`
c^'5 Next i
5Y r$dNe M*uG`Eo& For j = 1 To mkW * mkH / 2
PTqS L] mTotal = mTotal + MKpilar(j)
?^Ux+ mVE Next j
1i2w<VG1 <ZdNPcT<s iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度
&9{BuBO[ oPBjsQ mTotal = 0
0&~u0B{ For j = mkW * mkH / 2 + 1 To mkW * mkH
*RM'0[1F4 mTotal = mTotal + MKpilar(j)
(La Next j
3! W&J Z;s-t \C iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度
u&bU !ZI b>WT- .b0 '背景亮度
+.cv,1Vx MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
55\mQ|.Jn For i = 1 To 4 * FrameW
{D#`+uw bsTotal = bsTotal + BsLine(i)
mAa]E t. Next i
B:.rp.1 bsAV = bsTotal / FrameW / 4
V|`|CVFo] q"o NB-bz End Sub
p-k qX VV0$L=mo W@=ilW3RD Sub AdjIMGbright(Optional bInit As Boolean = True)
:Yqa[._AF [l:.Q?? )| '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗）
U @|_5[nl '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100
r1] e: ' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30
h='=uj8o5 G.T1 rUh= Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer
3\7$)p+c 4r&~=up] '按标准亮度与对比度采集一帧，确定背景亮度
xcA:Q`c.{ currentContr = 128 '初始对比度
2B;QS\e"
currentBr = 128 '初始亮度
a/fYD2uNo okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度
89bKnsV okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度
1 doqznO DoEvents
8E{>czF"
Capture1Frame
VCO/s9AL '获得图像上缘4行象素
QeoDq
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
!C?z$5g CopyMark iBlack, iBright '图像标志区亮度
<i-RF-*S For i = 1 To 4 * FrameW
N 5DS-gv bsTotal = bsTotal + BsLine(i)
lla96\R Next i
N BX/V^ bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度
{'(8< n57 <ZEA&:p Select Case bsAV
R#M).2:: Case 0 To 60 '夜间通过灯光照明,完全没有背景
TH &B9 currentBr = 150
{VG6m
Hw currentContr = 60
F^-4Pyq@ Case 61 To 80 '有可见背景
tHeLq*)
) currentBr = 140
a6_`V; currentContr = 70
<5%We(3 Case 81 To 100 '有清晰背景
5JXLfYTU I currentBr = 128
uip]K{/A!e currentContr = 80
J ;dFmZOk Case 100 To 150 '有明亮背景
aT #|mk=\ currentBr = 140 '5:30-6:00钟实测数据
# 4>F%_ currentContr = 50
iqeGy&F- Case 151 To 180
><~hOK?v currentBr = 130
W!*vO>^1W currentContr = 60
5" U7I{\ Case 181 To 220 '背景全为白色
w0 iE x1i currentBr = 110
+fN0> @s currentContr = 130
K#@FKv|(" Case 221 To 255 '背景全为白色
u.6%n. g currentBr = 100
rf@ 81Ds currentContr = 100
DP_ \%(A End Select
T*
m_rDDt WW=7QC i Select Case (iBlack + iBright) / 2 '图像反射光强度修正
vCM'n
kXY Case 100 To 150
U^D7T|P$V currentBr = currentBr - 10
h>?OWI Case 151 To 255
3$54 *J currentBr = currentBr - 20
6s;x@g] End Select
zAewE@N#_
q-#fuD^ okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度
<*P1 Sd. okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度
V5+a[ ` ] End Sub
;f
Gi5=- "/5b3^a Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer)
VbjW$? Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long
Hw?
J1#1IE F ceT' For i = 1 To 8
.anL}OA_q MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128&
&0ra a
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128&
Y|F);XXIl Next i
q`hg@uwA{` H'2 =yhtVh For j = 1 To 1024
]Ea-?IhD L1 = L1 + LeftBK(j, 0)
#A!0KN;GC2 L2 = L2 + LeftBK(j, 1)
$ }53f'QjW R1 = R1 + RightBK(j, 0)
G)Y!aX R2 = R2 + RightBK(j, 1)
yyc&'J Next j
c@`P{ 6 diffL = Abs(L1 - L2) / 1024
:nI.Qa'"H diffR = Abs(R1 - R2) / 1024
iKwVYL End Sub
2ip~qZNw>< S5JnJkNn Function CheckSlice() As Boolean
*6L^A`_1] CopySlice avSL, avSLR, avSLL
zPe . If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then
@Klj!2cv$ CheckSlice = True
x/~M=][tN Else
0dW1I|jR CheckSlice = False
5|Qr"c$p End If
~gN'";1i End Function
J']W7!p `F#KXk Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer)
e]QkZg2?Yn Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long
E2MpMR For i = 1 To FrameH
U!4 ^; MoveMemory Slice(1, i), pFRAME(sPos, i), sSize
`m5iZxhw MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize
Dp8(L ]6 MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize
0U'r ia:$ Next i
ZfU_4Pl-> For i = 1 To FrameH
F+G Q l For j = 1 To sSize
R[QE:#hT total = total + Slice(j, i)
!k:j+h/ totalL = totalL + SliceL(j, i)
b~}}{fm&f totalR = totalR + SliceR(j, i)
0W)_5f& Next j
JLhp25{x Next i
Ts\7)6|F avSL = total / FrameH / sSize
N@}U ;x} avSLR = totalR / FrameH / sSize
4/b#$o <I? avSLL = totalL / FrameH / sSize
>qC T#TY End Sub
H\T
h4teE SDkN Sub DrawSlice()
TR |; /yJ frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B
@OpcS>:R frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B
e(Ve rd:c frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B
-nW-I\d% frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR)
Hi Yx(hY End Sub
l< Y x Sub DrawMark(pic As Control)
: .<&Y=^ Dim i As Long, j As Long
4J s>yP pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B
&N EzKf pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B
ag6S"IXh For i = 1 To PilarH
kcle|B For j = 1 To PilarW
3; A1[E6K pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0)
vd~O:=)4 Next j
k Q + Next i
X^ovP'c2 End Sub
=GF+
hM/~ g!$
"CX%8 Function avIMG() As Integer
0pQ>V) Dim i As Long, j As Long, totalIMG As Long
L>B0% TP^ MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize
^P[*yf For i = 1 To pFrameSize
IH5thL@D totalIMG = totalIMG + pBuffer(i)
N `M5`=. Next i
7 ?Fl [FW$ avIMG = totalIMG / pFrameSize
`f s[C
End Function
wgrYZ^]
[7bY( Function avRegion(barCol As Integer, barWidth As Integer) As Integer
MmX42;Pw Dim i As Long, j As Long, totalIMG As Long
Hl#o& *Ui" For i = 1 To FrameH
jV(IS D MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth
MIgIt"M jz Next i
#xmUND`@ For i = 1 To FrameH * barWidth
^JTfRZ :a totalIMG = totalIMG + pBuffer(i)
m ]\L1& Next i
IAfYlS#<yD avRegion = totalIMG / pFrameSize
#\}hN
~@F End Function
fqcyCu7Ep
