这才是我当年写出的一个比较烂的程序 ^gOww6$ <
r<c #nD~K
Main2.bas XE1$K_m
qZ*f%L(
Attribute VB_Name = "SubMain" fN)x#?
Option Explicit q$gz_nVq,b
v^SsoX>WMH
'采集文件与临时文件 s\gp5MT
Public Const TmpFile As String = "d:\30-0600.dat" *%\mZ,s"
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 oQT2S>cm^
:g2
}C
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long *KJB>W%@uM
Public hBCFile As Long '记录采集参数的文件 NQX>Qh
2
Public Const TmpBMP As String = "d:\1.bmp" X*F_<0RC1
Public hTmpFile As Long bb;(gK;F
W;zpt|kAH
M-J<n>hl
'采集窗口参数常量 S`m,S4-eD
Public Const FrameH As Long = 280& XJ gh>^R^
Public Const FrameW As Long = 768& NvJV</l6 A
Public Const pFrameSize As Long = FrameW * FrameH R>2I RvY(
rkDi+D 6`q
'标志区范围，用于识别车辆 E T:T7
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X |0sPka/u16
Public Const mkW As Integer = 28 '识别标志立柱宽度 -\#lF?fzb
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) "3fBY\>a
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) L0Y0&;y|R
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 M0L&~p_F
'车缝检测位置常数 ~$<UE }qp
Public Const sSize As Long = 32& ;+U<bqL6
Public Const sPos As Long = 310& |sIr?RL{C
Public Const sPosL As Long = 200& pJBg? D
Public Const sPosR As Long = 500& +q {[\#t5
'车缝检测框位置 nPFwPk8=M
Public Slice(1 To sSize, 1 To FrameH) As Byte e z\eOH6
Public SliceL(1 To sSize, 1 To FrameH) As Byte khx.yRx
Public SliceR(1 To sSize, 1 To FrameH) As Byte a460 |w6
Public avSL As Integer, avSLR As Integer, avSLL As Integer JoZ(_Jh%m
~_>cM c
Qz,|mo+
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 aD9q^EoEs
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 d'"r("w#
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 B=n[)"5fBO
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long *
geN [ [
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte T\9~<"P^
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向
q0&$7GH4
5\
hd4
&|9.}Z 8U
j 1*f]va
'一次连续采集的帧数 /_t|Dry015
Public tFrames As Long 9b"MQ[B4#a
W:`#% :C
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 qMP1k7uG)
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 y('k`>C
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize |3shc,7
h3!$r~T!a:
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte eC! #CK
Public pBuffer(1 To FrameW * FrameH * 2) As Byte =\};it{u
Public pWorkSpace(1 To FrameW * FrameH) As Long 'yY>as
Public Const pBufferSize As Long = FrameW * FrameH * 2 wL}l`fRB
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 };,/0Fu
jlqv2V7=/
Public hBoard As Long '采集卡标识 }Fa%%}
Public mBufferAddr As Long '缓存地址 *?t%0){
Public BufferSize As Long '缓存大小(字节) i"r!w|j
Public iCurrentCard As Long MS3=~*+
Public CapStatus As Long ,.tfWN%t\
Public iFrames As Long G2:%g(
Public currentBr As Byte, currentContr As Byte mi,&0xDe a
9GU]l7C=z
Public hMEM As Long, mStatus As Long =*Z5!W'd
Public Const hMemSize As Long = pFrameSize * 4
4!.(|h@
Public hMemWork As Long H8{ol6wc)6
Public Const hMemWorkSize As Long = pFrameSize * 5 s?rBE.g@}
iW%8/$
$}GTG'*.
!H@0MQ 7
'串口接收轨道衡数据 t2>fm QIQ
Public WeightFromCom As String lg$zG
a?
Public bReceiveComplete As Boolean Hfym 30
h-#1U3d
k; ZxY"^
Public Type GrayBMPHeader P7.' kX9
Tag As Integer ?K_
'@
FileLength As Long '文件大小 |[ $~\MU
Reserve1 As Long S( ^.?z
DataOffset As Long '图像数据偏移量 X4|4QgY
BMPHeaderSize As Long '文件头长 YA:nOvd@O
'length of the bitmap info header used to describe the bitmap colors, compression,… ;# uZhd
'the following sizes are possible: ?r=jF)C<'
'28h - windows 3.1x, 95, nt, … 1} %B%*N
'0ch - os/2 1.x U_B(( Z(g
'f0h - os/2 2.x T,%j\0
%NHkDa!
ImageWidth As Long '图像宽（像素数） pkgjTXR2b
ImageHeight As Long '图像高(像素数) *L4`$@l8
PlaneNumber As Integer '图像层数 Cbm\h/PXl
bpp As Integer 'bits per pixels '1 - monochrome bitmap O +vS|
'4 - 16 color bitmap J h&~ToF
!
'8 - 256 color bitmap 5PT5#[
'16 - 16bit (high color) bitmap uXjP`/R|
'24 - 24bit (true color) bitmap ntVS:F
'32 - 32bit (true color) bitmap a<~77~"4wn
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) r^Zg-|gr
'1 - rle 8-bit / pixel (also identified by bi_rle4) yQNV@T<o
'2 - rle 4-bit / pixel (also identified by bi_rle8) `= lc<T^
'3 - bitfields (also identified by bi_bitfields) vy9 w$ls
IMAGESIZE As Long '图像数据字节数 ~;]W T
hResolution As Long '水平分辩率 像素数/米 8s{?v &p
vResolution As Long '垂直分辩率 (kv
?33
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 *Hz^K0:8(
ImportantColors As Long @p 6<Lw_E
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 )wvHGecp*
End Type N$>^g"6 o
J aTp} #
?a(L. 3 E
Gh.[dF?
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader 42J {aJVH
Public sRECT As RECT p Z: F:
/U&Opo
{aO
BZ!v%4^9
Public conn As ADODB.Connection RTh`ENCKR
Public rsTrain As ADODB.Recordset }7E^ZZ]f
Public rsOperater As ADODB.Recordset \%]I{
Public rsGoods As ADODB.Recordset h:Gu`+D>W
Public rsGood2 As ADODB.Recordset " ZM4F?x
Public rsSender As ADODB.Recordset kE9esC 3
Public rsReceover As ADODB.Recordset G+UMB n
Public rsTrainTMP As ADODB.Recordset ngohtB^]
-h|B 1*mt
eqw0]U\pv
'打开采集卡 R_XR4)(<
'设置参数 )G^
KDj"
'设置为实时单帧采集到缓存方式 l
vMlL5t
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 o%9*B%HO/
?']5dD
#|&Sc_#4)
Sub Main() aE;le{|!({
Dim i As Integer, status As Long 1 i[ \T
}G4 z tiuG
InitBMPinfo Qx;\US v
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 }X*Riu7gk
BMPHeader.Tag = &H4D42 C C BfK p
BMPHeader.ImageWidth = FrameW SN7"7jo P<
BMPHeader.ImageHeight = FrameH FC i U
BMPHeader.BMPHeaderSize = &H28 d)4
m6
BMPHeader.PlaneNumber = 1 J_ x13EaV0
BMPHeader.bpp = 8 z|E
EVNFd&
BMPHeader.Compression = 0 }J"> }j]/
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 bef_rH@`
BMPHeader.vResolution = &H1274 p$ O
x'A4
BMPHeader.ColorsinBMP = 256 WmY``
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP 26&'X+n&
BMPHeader.DataOffset = Len(BMPHeader) AP77a*@8
For i = 0 To 255 S"w R%\NIp
BMPHeader.Pallate(i) = RGB(i, i, i) }by;F9&B
Next i n 8*;lK8
BMPHeader.IMAGESIZE = FrameH * FrameW QnZcBXI8
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE [W %$qZlP
q\m2EURco
+
gtrt^:]l
MoveMemory BMP1, BMPHeader, Len(BMPHeader) V=:'SL*3|
-gSUjP
BMP1.ImageWidth = FrameW 1N7Kv4,
BMP1.ImageHeight = FrameH * 2 91 =OF*w
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight wiz$fj
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE \b%kf9 9
X.hm s?]
'确定标志位置,为pilarX, pilarY确定初始值 F a'k0/_j
PilarW = mkW Oo"^%F~%
PilarH = mkH '此两项为固定值 ):i&`}SY
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) ~0beuK&p
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 Llr>9(|
.pvi!NnL-
B2-V@ 06
'连续采集记录文件 bFe+m1Q_
' 建立一个缓冲区为页对齐方式的文件 Zt.'K(]2h
If Dir(TmpFile) <> "" Then ?c [*:N(
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ oD<k
MK
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) Jn{O Ww2
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 \,u_7y2 c
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ]]C b$$Td
Else ~//fN}~R
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ =c/wplv*
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ne 4Q#P
End If $5Xh,DOg
If hFile = 0 Then dZi "$ g
MsgBox TmpFile & ": File Open Error", vbOKOnly gw, UQbnu
Exit Sub Vx~,Uex0+
End If s2Mb[#:a"
'采集参数记录文件 1P~X8=9h
hBCFile = FreeFile() UrqRx?#
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile cWoPB
_
5$V _Hj
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 S H!
If hMEM = 0 Then :yUEkm8
fStatus = GetLastError 0NS<?p~_S
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ .Fdgb4>BXX
& "请向技术人员报告该错误代码。", vbOKOnly bbrXgQ`s+w
CloseHandle hFile xuq v 6b.
Exit Sub $ GlW f
End If 9 FB19
.zi_[
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) {zMU#=EC
If hMemWork = 0 Then ^J$2?!~
fStatus = GetLastError !o:f$6EA~C
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ |&RU/ a
& "请向技术人员报告该错误代码。", vbOKOnly ;kY(<{ 2
'释放已成功分配的内存 KXx32 b,~
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) XUz3*rfs
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Q_[ 3`j l
q@[Qj Gj@
CloseHandle hFile 5H*\t 7
Exit Sub ^s|6vd;PD=
End If O8h%3&
D9
g#F f6
' Test writing xai*CY@cQ
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& 0 u;4%}pD
ogyTO|V=
'初始化采集卡参数 _d5QbTe
iCurrentCard = -1 d3D] k,
hBoard = okOpenBoard(iCurrentCard) 19w*!FGX
Debug.Print hBoard +j< p
\Kn>
If hBoard = 0 Then Zl^\Q=*s
ExitGrabber F oN|i"*l
End B} l vr-c#
End If 7 @D@ucL
okGetBufferSize hBoard, mBufferAddr, BufferSize 0*f)=Q'
If mBufferAddr = 0 Then -[cTx[Z,
MsgBox "缓存不存在！" U4d
:] z
ExitGrabber \Wxuk YH
End If P-?0zF/T$
Debug.Print Hex(mBufferAddr), Hex(BufferSize) 7pe\M/kl
03q 5e
gt@m?w(
currentBr = 128: currentContr = 128 MF5 [lK9e
'设置视频输入参数 Tf'hc]`vS
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 |y (Q
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input 9[<)WQe6M
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 k?+?v?I
=
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 KrQ1GepJ
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 KV(Q;~8"X
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 A~)D[CV
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） s.$3j$vT 8
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) <J) ]mh dm
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) ?l9XAW t\
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 #d6)#:uss
4 o Fel.o
'设置采集参数 nAv#?1cjz
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 g:hjy@ w
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式
\W~ N
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 k$ blEa4
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 ,J+}rPe"sf
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 F(>Np2oi6
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 Zy`m!]G]80
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 N sXHO
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 'Gj3:-xqL
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 Q+[n91ey**
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 MN\HDKN
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 ]n6# VTz*
.(K)?r-g5
8Vr%n2M
okCloseBoard hBoard t'n pG}`tE
Sleep 50 6 (]Dh;gC
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 JRB9rSN^
\NPmym_ 6J
'设置数据传送方式 EV] 1ml k$
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ]'&LGA`
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 "
&Y`+ 0S8
;ub;l h 3
sRECT.Right = -1 '用于获得当前设置值 ;r<^a6B
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) qLD
?juas
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom R!}H;[c
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 ZOh`(})h y
sRECT.Left = 0 d
YJ(!V&
sRECT.Top = 0 r>>%2Z-P
sRECT.Right = sRECT.Left + FrameW c2l@6<Ww
sRECT.Bottom = sRECT.Top + FrameH * 2 ,o86}6Ag
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) F3On?x)
vS;RJg=
sRECT.Right = -1 '检查新设置值 MTuV^0%jD
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) k\5c|Wq|g
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom Tp/6 ,EE
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) bCRV\myd`
8\+uec]k
If TESTSignal = False Then ]Sf ]J4eQ
'ExitGrabber G<65H+)M\
End If Cd#(X@n
(A9Fhun
O%X f!4 Z
*4\:8
'设为实时采集状态 +^6 0T$
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) ~vm%6CABM
LSL/ZvSP
]cHgleHQ
'单帧采集 m*&]!mM"0G
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 o#3 ly-ht
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) d,k!qjf=r
okCaptureTo hBoard, BUFFER, 0, 1 'single Q /U2^
'Do While okGetCaptureStatus(hBoard, False) <> 0 cr7 }^ s
' Sleep 20 gb[5&> (#
'Loop NcBIg:
V\c
okGetCaptureStatus hBoard, True M\uiq38
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize +
%<(E
'写入768*576测试图象 DX#Nf""Pw
ArrayToBMP TmpBMP mE+*)gb:Rd
C0T;![/4 A
'打开数据库 p|U?86 t
Set conn = New ADODB.Connection XO.jl" xu
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ <? q?Mn
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ xQ7 l~O
b
"; Mode=Read|Write" Cio
1E-4
conn.Open n(1l}TJy
-_=nDH
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 0q()|y ?}
frmRecord.Visible = True f,U.7E
frmQuery.Visible = True .s?L^Z^
Load frmReceiveFromComm <sb~
^B
&* M!lxDN
'调试参数 P) Jgs
If InStr(UCase(Command()), "/CAPTURE") > 0 Then {'7B6
SignalBox.Visible = True
dm\F
End If kMIcK4.MH
If InStr(UCase(Command()), "/COMM") > 0 Then ha]VWt%}
frmReceiveFromComm.Visible = True G/)O@Ugp
End If V(H1q`ao9
n@<YI
End Sub BtkOnbz8X
XWBA^|-N
Sub ExitGrabber() Ua:}V n&!
'关闭数据库 )1?y 8_B
'关闭采集卡 t% d Z-Ym
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) &GpRI(OB/+
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) LBw1g<&
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) | mZxfI
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) (nQ
^
okStopCapture hBoard p_RsU`[
okCloseBoard hBoard KI"#f$2&
CloseHandle hFile ;AG8C
#_
Close #hBCFile `KZm0d{H
conn.Close ~[t[y~Hup
End d[iQ` YW5
End Sub 3#LlDC_WC
h79}qU
Function ArrayToBMP(ByVal File As String) qU \w=
Dim BytesWrite As Long /CrSu
q }3`|'3
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ 5AFJC?
CREATE_ALWAYS, 0&, 0&) lU8l}Ndz"
{&&z-^
If hTmpFile = 0 Then pC#E_*49
ArrayToBMP = False 4>wP7`/+y
Exit Function ; 5*&x z
End If ^
gd aa>L
)* u8/U
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 'NWfBJm
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& =>m<GvQz
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN A @i
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0&
/T"+KU*
_P!m%34|
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN t*p71U4+I
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& KYB `D.O
y'3rNa] G1
If BytesWrite < pFrameSize Then l [dK[4
ArrayToBMP = False = }~hWL
End If *I B4[6
K%t*8
4j
CloseHandle hTmpFile KqHy G
xB@ T|EP
End Function j ` EXlc~
p/ ,=OaVU
Function ArrayToBMP1(ByVal File As String) Sh/08+@+L:
C"y(5U)d
Dim BytesWrite As Long x'8x
l|u>T b|V
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 8'[~ 2/
CREATE_ALWAYS, 0&, 0&) })'B<vq
FUiRTRIYe
If hTmpFile = 0 Then i}cRi &2[
ArrayToBMP1 = False 0 j^Kgx
Exit Function % aP!hy
End If wi!?BCse q
l5~os >
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 9=s<Ld
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& A[B<~
><4<
yj1
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN QFA 8 N
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& hqD *z6aH
&j;wCvE4+
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN ___~D
dq
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0&
\ __i
kpuz]a7pK
If BytesWrite < pBufferSize Then ~?l |
[
ArrayToBMP1 = False ~$ c\JKH-
End If \UA[
% 7hrk
CloseHandle hTmpFile VM ZMG$C
]>!K
3kB
End Function Z* F3G#A
[:dY0r +
'使用该过程建立的文件要求在用后关闭 )L? P}$+
Public Function ArrayToBMP2(File As String) As Boolean %mW{n8W3{
gM&{=WDG6
Dim BytesWrite As Long ldf\;Qk
8C40%q..
ArrayToBMP2 = True 7 W5@TWM
P1!qbFDv8
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ W" scV@HKu
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) {
$oj.V 4
1Yq! ~ 8
If hTmpFile = 0 Then vz&|J
ArrayToBMP2 = False h0EEpL|\
Exit Function _T60;ZI+^
End If z 'Hw
a,,ex i
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ?d* z8 w
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& u* eV@KK!
_O?`@g?i
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN "MeVE#O
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& GblA9F7
0S"mVZ*P
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN nkPh,X\N0
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& KR} ?H#%
[+Iz@0 q
If BytesWrite < pFrameSize Then I{|O "8
ArrayToBMP2 = False Q3'llOx
End If Cp\6W[2+B
6bg
;q(*7
CloseHandle hTmpFile Z{*\S0^ST
~g91Pr
End Function 10Q ]67
XPc^Tq
Private Function TESTSignal() As Boolean p%ki>p )E|
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long i$Ul(?
PI { bmZ
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) ,~U>'&M
;
Xg6Jh ``
If extsign = 1 Then -OV&Md:~
TESTSignal = True 4Z3su^XR
Else G/E+L-N#`
If extsign = 0 Then 2Ah#<k-gC;
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly }J}-//[A
TESTSignal = False &C_j\7Dq
Exit Function l$KA)xbI
End If RH W]Z
Pr<
End If `bq<$e
X0HZH?V+
'测试视频输入类型 <sbu;dQ`
'video type \
#F
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 70?\ugxA
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) hgG9m[?K
If videotype = 1 Then hPkp;a #
'"隔行信号(Interlaced)" ic:zsuEm
Else 8S
TvCH"Z_
If videotype = 0 Then '@v\{ l
'"逐行信号(Non-interlaced)" 'ms-*c &
Else &A
Nf!*<\E
If videotype = -1 Then &u
."A3(
' "不支持" .^` {1%
End If zpn9,,~u
End If (MM]N=Tw4
End If 9c bd~mM{
WCZjXDiwJ
'测试垂直扫描线数 qz_7%c]K[
'video scanlines ]h`&&B qt
scanlines = -1 B`)BZ,#p
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) k t#fM d$
If scanlines = -1 Then bIDj[-
CDG
' "不支持" [>I<#_^~
Else NWESP U):w
'Trim(Str(ScanLines)) + " 行数/幅" (XTG8W sN
End If J3V=
46Yc
K8|r&`X0
'测试帧频 tAd%#: K
'video field frequency ,Zx 0%#6
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) LVM%"sd?
If fieldfrq = -1 Then P8:dU(nlW
'lblSignal(8) = "不支持" BKC iIf kZ
Else ,&A7iO
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" s[>,X#7 y
End If 8Al{+gx@?
End Function Qp5VP@t
n&4N[Qlv,
-m zIT4
Sub PicIdentify() :LQYo '@yB
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 N{!i =A
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 tU5zF.%
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 P= BZ+6DS
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 gx/,)> E.
KfEx"94
Dim fPTR As Long, cFrame As Long QE+g
j 8
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer 2QcO R4_V
&&8x%Pml
5DU6rks%
cFrame = 0 P bn*_/H
y-b%T|p9
/{ J4:N'B>
Do While cFrame < tFrames 9.M4o[
z| J_b"u4
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) n F]W,@u"h
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) *8
A
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize ?=msH=N<l
tKuwpT 1Qc
frmRecord.RText.Text = Str(cFrame) AR%4D3Dma
frmRecord.RText.Refresh df +l%9@
KZY}%il!`
If CheckMark = True Then *KF#'wi
ArrayToBMP TmpBMP `{h */Q
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) D /gw .XYL
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" qBQ?HLK-
r|8d
4
DrawSlice hh%-(HaLX3
&m7]v,&
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) @i_FTN
'If i = vbNo Then ?zMHP#i
' Exit Do ~vhE |f
'End If
7aRi 5
'cFrame = cFrame + 1 H2 {+)
_.Nbt(mz
End If 2 a)xTA#
DoEvents 05#1w#i
cFrame = cFrame + 1 Lg+Ac5 y}`
Loop |^I0dR/w:
End Sub 1-uxC^u?|#
H|<[YYk
%wg -=;d4
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean :S83vE81WK
2zA4vZkbcw
'如标志区模式反差存在则为TRUE，否则返回FALSE J4C.+![!Ah
?! :ha;n
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long 4Z=_,#h4.
CheckMark = True NA`SyKtg_
{z5--T ogJ
'复制标志区
DPxM'7
For i = 1 To mkH [ S%_In
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW Xl{P8L
Next i H2
\;%K 2
|s(FLF -
For j = 1 To PilarW * PilarH / 2 |A~jsz6 pI
mTop = mTop + MKpilar(j) :r,pqnH _
Next j P1 8hxXE3
ua$GNm
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH eK =xrk
mBot = mBot + MKpilar(j) ,-c6dS
Next j { lDd.Fn
<al(
7
mTop = mTop / PilarW / PilarH * 2 =o(5_S.u;
mBot = mBot / PilarW / PilarH * 2 `AtBtjs RV
SM#]H-3
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 ^mDe08.
%b
U$.@]F4&
'平均值极值化 Zn+.;o)E<
For j = 1 To PilarH * PilarW On:il$MU
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) 4[r0G +
Next j uBKgcpvTs
~H_/zK 6e
mTop = 0: mBot = 0 /S R*W5#s
For j = 1 To PilarH * PilarW / 2 #Y `~(K47
mTop = mTop + MKpilar(j) )9G[dDeC
Next j $9#H04.x
(`>+zT5aH
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW k Z
.gO
mBot = mBot + MKpilar(j) sf
qL|8
Next j ^zmG0EH,
kx{{_w
Qj.#) R
mTop = mTop / PilarH / PilarW * 3 /4V#C-
mBot = mBot / PilarH / PilarW * 3 )[6 U^j4
H5B:; g@
IqHV)A
If mBot > iWhite And mTop < iBlk Then
.G XBc
CheckMark = True YUD`!C
Else zkrM/ @p#
CheckMark = False Yui3+}Ms
End If 6 7.+
.2
End Function 85$m[+md
8 +/rlHp
Sub Capture1Frame() {X+3;& @
okCaptureTo hBoard, BUFFER, 0, 1 'single mHTXni<!
okGetCaptureStatus hBoard, True %D34/=(X
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize KeB"D!={;
End Sub TDKki(o=~
9 '; JXf$
Tbih+# ?
Sub CopyMark(iBlk As Integer, iWhite As Integer) l"T44CL;
'复制标志区并返回标志区暗区与亮区的亮度平均值 }O5i/#.lR
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 ".V$~n(
L(<*)No
'复制标志区 -H@ :*
For i = 1 To mkH =l; ewlU
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 81F/G5
Next i (!aNq(
29" 'K.r
For j = 1 To mkW * mkH / 2 yCR?UH;
mTotal = mTotal + MKpilar(j) Oh`69
k
Next j O2E/jj
@Zu5Vp J
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 ]L $\
#
J y:Qlx`
mTotal = 0 ||= )d&
For j = mkW * mkH / 2 + 1 To mkW * mkH A]0
S t@
mTotal = mTotal + MKpilar(j) J. b9F:&}
Next j ~s*)f.l
AaOu L,l
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 ?0?#U0(;u
5"@*?X K^
'背景亮度 M61 xPq8y5
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW e0zq1XcZ
For i = 1 To 4 * FrameW [< ?s?Ci
bsTotal = bsTotal + BsLine(i) jDfC=a])
Next i m|n%$$S&
bsAV = bsTotal / FrameW / 4 gIa+5\qYY
]EBxl=C}D
End Sub HxV=F66"
ZR B)uA)5=
nI-w}NQ
Sub AdjIMGbright(Optional bInit As Boolean = True) Y|f[bw
Qf+\;@
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） ["93~[[^
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 - t'jNR'
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 ?k&Vy
Gbr=+AT
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer cWsN r'MS*
@Z
%ivR:
'按标准亮度与对比度采集一帧，确定背景亮度 ^z IW+:
currentContr = 128 '初始对比度 m bxZL<ua
currentBr = 128 '初始亮度 O)*+="Rg
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 2!m /
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 HGs $*
DoEvents +H-6e P
Capture1Frame T{. pM4Hd
'获得图像上缘4行象素 jyUjlYAAv`
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW f!uw zHA`?
CopyMark iBlack, iBright '图像标志区亮度 :D6
ON"6
For i = 1 To 4 * FrameW Q800y??&J
bsTotal = bsTotal + BsLine(i) _Xc8Yg }`
Next i b9J_1Gl]
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 L-WT]&n_
jh%Eq+#S
Select Case bsAV m@2QnA[ 4
Case 0 To 60 '夜间通过灯光照明,完全没有背景 z6=Z\P +
currentBr = 150 <I\/n<*
currentContr = 60 gnOt+W8
Case 61 To 80 '有可见背景 kR-SE5`Jk
currentBr = 140 8, 4"uuI
currentContr = 70 ] d0BN`*U.
Case 81 To 100 '有清晰背景 mb TEp* H
currentBr = 128 VU(v3^1"
currentContr = 80 rdP[<Y9
Case 100 To 150 '有明亮背景 %K hI
>O<
currentBr = 140 '5:30-6:00钟实测数据 -` kW&I0
currentContr = 50 v5#j Z $<F
Case 151 To 180 ^e _hLX\SW
currentBr = 130 D9=KXo^
currentContr = 60 feDlH[ $
Case 181 To 220 '背景全为白色 wr/"yQA]
currentBr = 110 EoR}Af
currentContr = 130 % K lrSo
Case 221 To 255 '背景全为白色 EzM
?Nft
currentBr = 100 3 *"WG O5
currentContr = 100 C=L>zOZ
End Select !Vn\u
Z,
Y
b&b
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 e "4 ''/
Case 100 To 150 4K#>f4(U`g
currentBr = currentBr - 10 { OkV %Q<
Case 151 To 255 zm5 ]J
currentBr = currentBr - 20 | `2RShu
End Select $aD
VG})
|O\s|H
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 a`E#F]
Z
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 qpP=K $
End Sub -hGk?_Nqa/
@sW24J1q+
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) (z {#Eq4
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long D rUO-
)9{0] u;9
For i = 1 To 8 RUnSC OdX
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& mZS
>O_E
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& ;~ )5s'
Next i :841qCW
mI-]/:
For j = 1 To 1024 J s@hLP `
L1 = L1 + LeftBK(j, 0) #4Rx]zW^%
L2 = L2 + LeftBK(j, 1) ]_ __M
R1 = R1 + RightBK(j, 0) A@!qv#'
R2 = R2 + RightBK(j, 1) / |;RV"
Next j 8sWJcmVo
diffL = Abs(L1 - L2) / 1024 {Qf=G|Ah
diffR = Abs(R1 - R2) / 1024 r"g
JX
End Sub ]3],r ?-tJ
~zJbK. _
Function CheckSlice() As Boolean z;,u}u}aI
CopySlice avSL, avSLR, avSLL \R9(x]nZ%
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then lHY+}v0
CheckSlice = True ~rqCN,= d
Else qdJ=lhHM}
CheckSlice = False sQHv%]s 0
End If
M>xK+q?O
End Function J9--tJ?[>o
F3[T.sf
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) Mlg0WrJ|2
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long rK6l8)o
For i = 1 To FrameH @ s
u^0 9n
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize hc(#{]].
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize -n~1C {<
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize I#Y22&G1
Next i ` x Ex^P^7
For i = 1 To FrameH <SA zxo:I
For j = 1 To sSize mUAi4N
total = total + Slice(j, i) 6EoMt@7g
totalL = totalL + SliceL(j, i) [\98$BN
totalR = totalR + SliceR(j, i) ~]IOK$1F%
Next j #_ ;lf1x!
Next i 5FPM`hLT
avSL = total / FrameH / sSize t: x \kp
avSLR = totalR / FrameH / sSize `t>l:<@
%
avSLL = totalL / FrameH / sSize )5Q~I,dP
End Sub iJI }TVep#
PFlNo` iO
Sub DrawSlice() >UTBO|95y
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B <y('h I'
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B #1A.?p
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B !7O+og
L
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) lwxaMjaL4K
End Sub 9rA0lqr]5
Sub DrawMark(pic As Control) }z'8Bu
Dim i As Long, j As Long } ^ ~F|
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B ~k-y &<UR
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B T[w]o}>cW
For i = 1 To PilarH aB 2F C$z
For j = 1 To PilarW hn 7#
L
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) 6m/r+?'
Next j !3c
\NbU
Next i + /4
A
End Sub xf\ C|@i
13$%,q )
Function avIMG() As Integer }1L4 "}L.
Dim i As Long, j As Long, totalIMG As Long hE'-is@7
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize h lvK5Z
For i = 1 To pFrameSize gS!:+G%
totalIMG = totalIMG + pBuffer(i) +5g_KS
Next i Fj 8 z
avIMG = totalIMG / pFrameSize z3{ G9Np
End Function /Vx7mF:
kr ^P6}'
Function avRegion(barCol As Integer, barWidth As Integer) As Integer c)6m$5]
Dim i As Long, j As Long, totalIMG As Long htO +z7
For i = 1 To FrameH Gt8M&S-;
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth r..iko]T
Next i kUL' 1!j7
For i = 1 To FrameH * barWidth g{]0sn#
totalIMG = totalIMG + pBuffer(i) ;>U2|>5V
Next i _P#|IAq*
avRegion = totalIMG / pFrameSize > y m,{EHK
End Function ]!W=^!
