这才是我当年写出的一个比较烂的程序 gfs?H #
nmVL%66K
Main2.bas Sf)VQ5U!Y
&/4W1=>(
Attribute VB_Name = "SubMain" <w.W[a k
Option Explicit 4*_9Gl
u cyz>TL0
'采集文件与临时文件 @U(D&_H,K
Public Const TmpFile As String = "d:\30-0600.dat" =LS?:Mhm
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 {|6(_SM|
R $=UJ}>
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Qd 1Q~PBla
Public hBCFile As Long '记录采集参数的文件 &gZ5dTj>
Public Const TmpBMP As String = "d:\1.bmp" EOj
o >w>
Public hTmpFile As Long A\_cGM 2
#!KbqRt
|j
niI(
'采集窗口参数常量 XU .FLN e
Public Const FrameH As Long = 280& %9xz[Ng
Public Const FrameW As Long = 768& 8|`4D 'Ln
Public Const pFrameSize As Long = FrameW * FrameH RJ1 Q.o
K <KyX8$P0
'标志区范围，用于识别车辆 )G0a72
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X Mjrl KI}f/
Public Const mkW As Integer = 28 '识别标志立柱宽度 n97A'"'wz
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) %J?;@ G)r
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) C w`v\
9
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 I
m1e/F]
'车缝检测位置常数 :~pPB#)nk
Public Const sSize As Long = 32& E[>4 b7{g:
Public Const sPos As Long = 310& eW]K ~SPd7
Public Const sPosL As Long = 200& 1+PLj[;jJ:
Public Const sPosR As Long = 500& T"XP`gk
'车缝检测框位置 {SW}S_
Public Slice(1 To sSize, 1 To FrameH) As Byte 37Z:WJ?
Public SliceL(1 To sSize, 1 To FrameH) As Byte i!< ,8 e=
Public SliceR(1 To sSize, 1 To FrameH) As Byte 3ADT Yt".
Public avSL As Integer, avSLR As Integer, avSLL As Integer S\
~W pf
ao<@a{G
_YY:}'+
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 U&|=d H]-
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 UfSWd R)
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 b:Dr _|
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long PWOV~ `^;
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte =usx' #rb
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 GmB7@-[QA%
AS[cz!
>
yK<%AV@v
a 1Qg&s<
'一次连续采集的帧数 pIk&NI
Public tFrames As Long JB a:))lw
{mMrD 5
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 }|
_uqvin
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 impzqQlZ,
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize !j6]k^ra
I Db|J%e^P
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte 74rz~ZM
5
Public pBuffer(1 To FrameW * FrameH * 2) As Byte q3B#rje>h
Public pWorkSpace(1 To FrameW * FrameH) As Long oW (p (>
Public Const pBufferSize As Long = FrameW * FrameH * 2 B i?DmrH
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 &)O X* y
%8tl JQvu
Public hBoard As Long '采集卡标识 Hm4:m$=p
4
Public mBufferAddr As Long '缓存地址 0x'>}5 `5
Public BufferSize As Long '缓存大小(字节) # vYdP#nWb
Public iCurrentCard As Long J.mEOo!>
Public CapStatus As Long pm,& kE
Public iFrames As Long Iw8;",e2
Public currentBr As Byte, currentContr As Byte -4o6 OkK<
b;O]@kBB
Public hMEM As Long, mStatus As Long a5:Q%F<!
Public Const hMemSize As Long = pFrameSize * 4 n M1U=Du
Public hMemWork As Long *? 7Ie;)
Public Const hMemWorkSize As Long = pFrameSize * 5 ? r=cLC
q 4PRc<\^
l. ?R7f
W\o(f W
'串口接收轨道衡数据 Y(ly0U}
Public WeightFromCom As String el39HB$
Public bReceiveComplete As Boolean xXM`f0s@+]
@!&\Z[",
C ".&m
Public Type GrayBMPHeader l=[<gPE
Tag As Integer <P7 f\$o~
FileLength As Long '文件大小 #[C |%uq
Reserve1 As Long 0Np }O=>
DataOffset As Long '图像数据偏移量 |_8- 3
BMPHeaderSize As Long '文件头长 0ejx; Mum
'length of the bitmap info header used to describe the bitmap colors, compression,… Uwr inkoeE
'the following sizes are possible: a1B_w#?8
'28h - windows 3.1x, 95, nt, … *;8tj5du
'0ch - os/2 1.x 2GA6@-u\
'f0h - os/2 2.x bN@V=C 3
-kxNJ Gc?
ImageWidth As Long '图像宽（像素数） ~S15tZ
$
ImageHeight As Long '图像高(像素数) @k n0f`
PlaneNumber As Integer '图像层数 1D g\\aUk
bpp As Integer 'bits per pixels '1 - monochrome bitmap f*7/O |Gp
'4 - 16 color bitmap 'H <?K
'8 - 256 color bitmap 8*I43Jtlf,
'16 - 16bit (high color) bitmap ` ZXX[&C
'24 - 24bit (true color) bitmap 9~bje^M
'32 - 32bit (true color) bitmap gX5I`mm
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) &F*s.gL
'1 - rle 8-bit / pixel (also identified by bi_rle4) a; D{P`%n
'2 - rle 4-bit / pixel (also identified by bi_rle8) V6?ku6k
'3 - bitfields (also identified by bi_bitfields) abUvU26t
IMAGESIZE As Long '图像数据字节数 /cUcfe#X
hResolution As Long '水平分辩率 像素数/米 1 e1$x@\\
vResolution As Long '垂直分辩率 (Sr& Y1D
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 0: R }
ImportantColors As Long v{^_3
]
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 8E"Ik ~
End Type ~xpU<Pd*
f@T/^|`mh
Gvw4ot/
=O1N*'e
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader 2j
` x^
Public sRECT As RECT 7OG=LF*V-
I4ZL +a
\T'uFy9&a
Public conn As ADODB.Connection jzSh|a9_
Public rsTrain As ADODB.Recordset &/}]9 #
Public rsOperater As ADODB.Recordset W~k"`g7uu
Public rsGoods As ADODB.Recordset _ro^<V$%
Public rsGood2 As ADODB.Recordset sptDzVM
Public rsSender As ADODB.Recordset }x`W+r
Public rsReceover As ADODB.Recordset
(m
4`l_
Public rsTrainTMP As ADODB.Recordset G2U= *|
\@vR *E
W) ihk\E
'打开采集卡 lwa xj7
'设置参数 V03U"eI="
'设置为实时单帧采集到缓存方式 r. 0IC*Y
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 -mOSB(#bo
*g]q~\b/;
}BS.OK?
Sub Main() +^YXqOXU
Dim i As Integer, status As Long pI|Lt
T~7i:<E^
InitBMPinfo -bu.Ar-#;h
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 3:7 J@>
BMPHeader.Tag = &H4D42 PuqT&|wP l
BMPHeader.ImageWidth = FrameW
@T
BMPHeader.ImageHeight = FrameH o {Sc
BMPHeader.BMPHeaderSize = &H28 -$J\BkI
BMPHeader.PlaneNumber = 1 1w/1 k6`0
BMPHeader.bpp = 8 {$)z C*l
BMPHeader.Compression = 0 /Y:&307q
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 \ dTX%<5D
BMPHeader.vResolution = &H1274 oE[wOq +
BMPHeader.ColorsinBMP = 256 N_lQz(nG/2
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP rlmzbIu I9
BMPHeader.DataOffset = Len(BMPHeader) #o k 1qT9_
For i = 0 To 255 ;BUJ5
BMPHeader.Pallate(i) = RGB(i, i, i) M5s>;q)
Next i jt?4ra NW
BMPHeader.IMAGESIZE = FrameH * FrameW CTQF+Oe8O
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE N}b/; Y
Lz's!b
fi ^ I1*S
MoveMemory BMP1, BMPHeader, Len(BMPHeader) \:-#,( .V
W'u6F- $2
BMP1.ImageWidth = FrameW `@q[&^
BMP1.ImageHeight = FrameH * 2 P7 O$*
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight :jB~rhZ~
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE l^w=b~|7=
4eK!1|1
'确定标志位置,为pilarX, pilarY确定初始值 P? VGY
PilarW = mkW xQ9P'ru
PilarH = mkH '此两项为固定值 #\[h.4i
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) aa2&yc29hp
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 T_|%n F-+
lfp[(Ph)9
wv>*g:El'
'连续采集记录文件 "i_I<?aGB
' 建立一个缓冲区为页对齐方式的文件 eRc+.m[
If Dir(TmpFile) <> "" Then Fxdu)F,~u
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ qk;*$Q
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) A94ZG:
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 'd 4I/
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 b}< T<
Else bhDV U(%I6
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 5A
oKlJrY
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) |1wfLJ4--l
End If O*xC}$OOn
If hFile = 0 Then L|
.q19b*
MsgBox TmpFile & ": File Open Error", vbOKOnly B :#5U85m
Exit Sub P&"8R
End If =/Pmi_
'采集参数记录文件 b <>GF-`w
hBCFile = FreeFile() !|;^
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile m Igc)"
kIhP 73M
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 'g.9
g oQ
If hMEM = 0 Then {I0b %>r=
fStatus = GetLastError U>?q |(u
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ pQAG%i^mF
& "请向技术人员报告该错误代码。", vbOKOnly g*?)o!_ *
CloseHandle hFile 9W88_rE'e}
Exit Sub u :AKp<'
End If EITA[Ba B`
NC'+-P'y
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) ;[TC`DuNj0
If hMemWork = 0 Then b9Jah
fStatus = GetLastError nXPl\|pXt
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 6x|"1
G{
& "请向技术人员报告该错误代码。", vbOKOnly ZDuP|" ^
'释放已成功分配的内存 al/Mgo
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) V/5.37FSb
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) jA_w OR7$
%Z9& z mO
CloseHandle hFile ?,uTH
4
Exit Sub <" F\&M`G
End If {\z&`yD@
a,g3 /
' Test writing wZB:7E%
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& 07 [%RG
|& OW_*l
'初始化采集卡参数 )Be?axI
iCurrentCard = -1 !lQGoXQ'4
hBoard = okOpenBoard(iCurrentCard) !lxs1!:
Debug.Print hBoard W <.h@Rz+
If hBoard = 0 Then \1|]?ZQ\ K
ExitGrabber -} avH
End ,{DZvif
End If OiBDI3,|+
okGetBufferSize hBoard, mBufferAddr, BufferSize aDEz |>q
If mBufferAddr = 0 Then *FhD%><
MsgBox "缓存不存在！" ZslH2#
ExitGrabber Tk~RT<\Ab+
End If W,<L/ZKJ
Debug.Print Hex(mBufferAddr), Hex(BufferSize) b {Srd3
,Vb;2
?4>uGaU\
currentBr = 128: currentContr = 128 +6paM
'设置视频输入参数 S c!]M 5
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 T,N"8N{K"
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input XfY ~q~f8
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 K5l#dl_T
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 [MLJs- *
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 u\LG_/UJV1
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 #m>Rt~(,S
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） YDh6X D<Z
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) ;VM',40
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) OSP#FjH
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 Zx$q,Zo<
8/q6vk><
'设置采集参数 wkNf[>jX?
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 oVi_X98R
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 i
T* !3
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 OS|uZ<"Rq3
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 T.ZPpxY
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 j{}-zQ]n
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 5A| 4
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 x~1.;d BF
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 4cZig\mE;
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 UrAg*v! Qy
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 kg@D?VqJP
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 },1**_#<Br
6x18g(KbP
~yacJU=
okCloseBoard hBoard p }p1>-j
Sleep 50 yLv jf
P1
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 BC!n;IAe
[f`^+, U
'设置数据传送方式 "s[Y $!#
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ifA=qn0=
}
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 K&1o!< |
Q depzo>E
sRECT.Right = -1 '用于获得当前设置值 KKMzhvf]#
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) j5hM |\]
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom dzA5l:5
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 85;h s
sRECT.Left = 0 +Smt8O<N
sRECT.Top = 0 $BIQ# T>qK
sRECT.Right = sRECT.Left + FrameW -anLp8G*
sRECT.Bottom = sRECT.Top + FrameH * 2 \1 ` L-lz
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) OPm ?kr
Y)D~@|D
,
sRECT.Right = -1 '检查新设置值 "F_o%!l
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) F\pw0^K;N
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 4a 'O#;h o
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) dFdll3bC
si`{>e~`6P
If TESTSignal = False Then ?Q$LIoR
'ExitGrabber X`xI~&t _
End If WY=RJe2
%cIF()
bpe8
`b(#
{8L)F w
'设为实时采集状态 2kv%k3 Q{
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) PT2b^PP
00DWXGt20o
[y^)&L$=
'单帧采集 t<`h(RczHI
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 m3| KIUP
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) aFkxR\x
6%
okCaptureTo hBoard, BUFFER, 0, 1 'single FN$ hEc!
'Do While okGetCaptureStatus(hBoard, False) <> 0 -I, _{3. S
' Sleep 20 <9za!.(zu
'Loop NF?FEUoxz
okGetCaptureStatus hBoard, True ]J= S\
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize }h+_kRQ
'写入768*576测试图象 sU7>q }!
ArrayToBMP TmpBMP eF
O+@
g 4n& k
'打开数据库 qg7]
YT&
Set conn = New ADODB.Connection M~& |-Hm
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ i&cH
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ iz|mJUx
"; Mode=Read|Write" {HgW9N(
conn.Open _ F0qq j
`i{k^Q
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) s3G\L<~mB
frmRecord.Visible = True d<*4)MR N
frmQuery.Visible = True IKJ~sw~AQ
Load frmReceiveFromComm ,H{
/@|RW
3F%Q q7v
'调试参数 c[=%v]j:u
If InStr(UCase(Command()), "/CAPTURE") > 0 Then |=OO$z;q|
SignalBox.Visible = True Bjg 21b
w^
End If hl4@ Y#n
If InStr(UCase(Command()), "/COMM") > 0 Then mtfyhFk
frmReceiveFromComm.Visible = True , N : 'Z
End If 6~ g:"}
%9_wDfw~
End Sub |
?6
wlf
>.R6\ >N%
Sub ExitGrabber() !
;Mh5*-
'关闭数据库 4SG22$7 W
'关闭采集卡 4fDo
}~
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) !U02>X
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) ;bt@wgY
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) )B d`N^k+
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) cQ4TYr;?
okStopCapture hBoard ,v"/3Ff{,
okCloseBoard hBoard Dl862$_Q
CloseHandle hFile ^V^In-[!y:
Close #hBCFile + mBJvrI
conn.Close W Y@x2bBi
End pv;c<NQ'1
End Sub X,- '
v[z
*
*?mZtF
Function ArrayToBMP(ByVal File As String) dEXHd@"H
Dim BytesWrite As Long J
CIm*6~
cz_4cMgxu
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ T;- Zl[H
CREATE_ALWAYS, 0&, 0&) -Q@jL{Ue
kndP?#>
p1
If hTmpFile = 0 Then r#{r]q_E*
ArrayToBMP = False Y^)VHE]
Exit Function T[$Sbz`
End If >K`.!!av,Y
(xU+Y1*g"%
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
{HqwpB \@
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& D\Y)E#%,
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN _ Ko0
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& &`7~vA&c
h t^U VV2
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN _/[n/"gn
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& I3Sl>e(Z
~A8%[.({5
If BytesWrite < pFrameSize Then C9-9cdW
H
ArrayToBMP = False fgxsC7P$
End If Rl 4r 9
0XlX7Sk+
CloseHandle hTmpFile `
R@24 )
[7Nn%eZC
End Function Ow \9vf6H
39!o!_g
Function ArrayToBMP1(ByVal File As String) F" a^ `E&
%EPqJ(T
Dim BytesWrite As Long @LY 5]og
*$(=I6b
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ oH+UuP2a-J
CREATE_ALWAYS, 0&, 0&) O$
i6r]j_
<$liWAGX\
If hTmpFile = 0 Then [5%/{W,~m
ArrayToBMP1 = False ` w S
g/
Exit Function < %Qw
dEO
End If {d$S~
]\nG1+ta
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN da@y*TO#i
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& ,8( % J3J
BfOG e!Si
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN !2x"'o
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& KmV>tn BQ
#SY 8Zv
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN GS{:7%=j
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ^_<>o[qE
;>=hQC{f>
If BytesWrite < pBufferSize Then v)JQb-<
ArrayToBMP1 = False l,/q# )5[
End If K*J8(/WkD
:C42yQAP
CloseHandle hTmpFile rL URP2~
OU=9fw
End Function PiB)p UYj
T[)) ful
'使用该过程建立的文件要求在用后关闭 RCt)qh+
Public Function ArrayToBMP2(File As String) As Boolean T
JY$<:
QnxkD)f *0
Dim BytesWrite As Long T
4
SByX9
|D^Q}uT
ArrayToBMP2 = True Fg
a9
^&uWAQohL
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ U]sU
b3
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) o,) p *glO
i:#R
U^ R
If hTmpFile = 0 Then -b@E@uAX /
ArrayToBMP2 = False Cu({%Gy+
Exit Function :Puv8[1i
End If ;hs:wLVa"
hBsjO3n
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Fc} wu W
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& 2h&pm
ZP)=2'RY
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN EpGe'S
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& BN4dr9T
,Ucb)8a
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN :0T]p"y4
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& pb%#`2"
}jd[>
zk
If BytesWrite < pFrameSize Then `n-e.{O((
ArrayToBMP2 = False s)=L6t^a6
End If i/x PO
v%3)wD
CloseHandle hTmpFile
#py7emu
:kZ2N67
End Function gx[# @ (
@6*<Xs
=
Private Function TESTSignal() As Boolean wri[#D {
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long 6o;lTOe s
:&)RK~1m_
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) z!Kadqns
7\ff=L-b
If extsign = 1 Then K=sQ_j. &Z
TESTSignal = True 5d}P rYa
Else u\qyh9 s
If extsign = 0 Then E08AZOY&g
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly S=aXmz<
TESTSignal = False dab>@z4
Exit Function `@.YyPxX\
End If qe(X5 ?#;
End If `M>{43dj
e;3$7$n Pv
'测试视频输入类型 P[P!WLr""
'video type ,h/0:?R
KW
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 \)BKuIP
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE)
glHag"(
If videotype = 1 Then q){]fp.,@
'"隔行信号(Interlaced)" 54 F([w
Else !^axO
If videotype = 0 Then W&06~dI1!
'"逐行信号(Non-interlaced)" B_5q}Bp<
Else mKpUEJ<a
If videotype = -1 Then Q,\lS
' "不支持" >mF`XbS
End If >\D XA)nc
End If 4)j<(5
End If |[34<tIN
XQ(`8Jl&^
'测试垂直扫描线数 ZuS+ p0H"
'video scanlines R l5} W\&
scanlines = -1 %n}. E30 4
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) hQGZrZK#
If scanlines = -1 Then +G/~v`Bv
' "不支持" '%RMpyK~
Else ;JL@V}L,
'Trim(Str(ScanLines)) + " 行数/幅" s* 9tWSd
End If n^Z?u9V R
mA^>Y_:
'测试帧频 \yG_wZs
'video field frequency !W$Br\<
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) =r0!-[XCa
If fieldfrq = -1 Then /Hzh gMV3
'lblSignal(8) = "不支持" |P ?
8<8p
Else Y SrFHVq
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" 0^ (.(:
End If q/OraPAB
End Function }Pb !u9_
q=?"0i&V
h]EXD
Sub PicIdentify() D'nV
& m
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 Zl, K#
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 tW=0AtZl]
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 )%j)*Ymz;
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 r)j#S kh].
i0A C.]4e"
Dim fPTR As Long, cFrame As Long X_!mZ\H7
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer ^\+6*YE 4
Jy|Mfl%d
%\b5)p
cFrame = 0 ;
wHuL\
%oor 7 -l
WZ&#O#(eO`
Do While cFrame < tFrames L a9@h"
wFqz.HoB
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) }Xc |Z.6
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) * fd` .}
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize b1*6
)
M.OWw#?p:_
frmRecord.RText.Text = Str(cFrame) ?tA- `\E
frmRecord.RText.Refresh jilO% "
LnJ7i"Q
If CheckMark = True Then r kD4}jV
ArrayToBMP TmpBMP 3F.O0Vz
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) t*}<v@,
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" +V'r >C:
d'3'{C|kk
DrawSlice }p- %~ Y
U'lmQrF!
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) SbI,9 <
'If i = vbNo Then :m$%D]WY
' Exit Do Ej34^*m9k
'End If k6Tpaf^
'cFrame = cFrame + 1 {Zseu$c
+mxYz#reX
End If kT$4 X0}
DoEvents ;% k%AXw
cFrame = cFrame + 1 =kc{ Q@Dk
Loop 4x C0Aw
End Sub 8
dZH&G@;
JnsXEkM)
e@,L~ \
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 15eHdd d
#& 8 Opo(
'如标志区模式反差存在则为TRUE，否则返回FALSE Mvcl9
WG }QLcP
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long HdnSs0 /
CheckMark = True 9MYt4
d?{2A84S
'复制标志区 *(k=!`4(
For i = 1 To mkH &0C!P= -p
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW nVM `&azD
Next i / 9;Pbxn
(Iq\+@xE=
For j = 1 To PilarW * PilarH / 2 50R+D0^mh
mTop = mTop + MKpilar(j) AT 9SD vJ
Next j ^ #t<ILUa
[&`>&u@MK
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH E
Fv+[
mBot = mBot + MKpilar(j) sIy$}_
Next j 11-uJVO~*
/gd o~
mTop = mTop / PilarW / PilarH * 2 v Cmh3TQ
mBot = mBot / PilarW / PilarH * 2 pF !vW
eD(a
+El}
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 x)
U;
Y
zvtxX*
'平均值极值化 g1{wxB
FE
For j = 1 To PilarH * PilarW R;.WOies4
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) Bpp9I;)c
Next j (@#Lk "B
L"-&B$B:
mTop = 0: mBot = 0 w6yeX<!ll
For j = 1 To PilarH * PilarW / 2 %4
-pw|':
mTop = mTop + MKpilar(j) 7r;A
wa
Next j 'Qfy+_0
plIx""a^h
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW v4 .V%tg!
mBot = mBot + MKpilar(j) AdYQhF##
Next j QA 9vH'
:|A db\b
H
Z}'W<N
mTop = mTop / PilarH / PilarW * 3 U D(#u 3z
mBot = mBot / PilarH / PilarW * 3 2bC %P})m
Q$zlxn 7\
_k@l-Bj
If mBot > iWhite And mTop < iBlk Then pxC5a i
CheckMark = True h/VYH(Tj
Else U{}7:&As
CheckMark = False r 1a{Y8?
End If 2M1mdkP3
End Function yTv K)4&
F>Oh)VL,Ev
Sub Capture1Frame() .R"L$V$RU.
okCaptureTo hBoard, BUFFER, 0, 1 'single 1
M{#"t{6
okGetCaptureStatus hBoard, True $.cGRz
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize `&6]P :_qp
End Sub 3g h^a ;uC
_
o(h]G1].
^KF'/9S
Sub CopyMark(iBlk As Integer, iWhite As Integer) ]a%Kn]HI&2
'复制标志区并返回标志区暗区与亮区的亮度平均值 Y'~&%|9+T
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 ;lEiOF+d
;$/G T
'复制标志区 18HHEW{
For i = 1 To mkH S mu x&e
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW & tOD
Next i +~v(*s C
bDNd
m-
For j = 1 To mkW * mkH / 2 a RwBxf
mTotal = mTotal + MKpilar(j) 0cbF.Um8
Next j c8s/`esA
}<S2W\,G
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 !{XO#e
NEH$&%OV?
mTotal = 0 x M[#Ah)
For j = mkW * mkH / 2 + 1 To mkW * mkH xd. C&Dx5
mTotal = mTotal + MKpilar(j) .0Z vCv:>
Next j .KS
Gma6]
$ g^;*>yr
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 [P,nW/H
ou-
;k
}
'背景亮度 cA
\W|A)
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW ]>,|v,i
=
For i = 1 To 4 * FrameW Dw[Q,SE
bsTotal = bsTotal + BsLine(i) ;Vy'
y
Next i 1mV0AE538
bsAV = bsTotal / FrameW / 4 {XC rjO|
`ouzeu9}
End Sub ]]ZBG<#
5`DH\VD.j
F{+`F<r
Sub AdjIMGbright(Optional bInit As Boolean = True) !R@4tSu
"8]17 0
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） $F%?l \7j
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 J)->
7h =
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 B;Z^.3
"F}Ip&]hAG
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer y_&XF>k91
FHC7\#p/9Z
'按标准亮度与对比度采集一帧，确定背景亮度 gD\}CxtG
currentContr = 128 '初始对比度 q Q'@yTVN
currentBr = 128 '初始亮度 (Vv] : Y]
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 7q=0]Hrg(D
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 5S? yj
DoEvents *S4P'JSY
Capture1Frame 3Cl9,Z"&6$
'获得图像上缘4行象素 }{y$$X<:
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW iT"Itz-^#
CopyMark iBlack, iBright '图像标志区亮度 8(;i~f:bCW
For i = 1 To 4 * FrameW u\wd<<I']
bsTotal = bsTotal + BsLine(i) IA4(^ -9
Next i 3"n8B 6
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 p'4P2
w1b
<>A?87
Select Case bsAV jFv<]D%A[
Case 0 To 60 '夜间通过灯光照明,完全没有背景 &O,$l3 P
currentBr = 150 SAJ=)h~
currentContr = 60
}+J@;:
Case 61 To 80 '有可见背景 T1&H!
currentBr = 140 R 2s>;V.:
currentContr = 70 V LN3x.BY
Case 81 To 100 '有清晰背景 t} M3F-NZ
currentBr = 128 CQ[-Cp7
currentContr = 80 : \OvVS/
Case 100 To 150 '有明亮背景 do,X{ \
currentBr = 140 '5:30-6:00钟实测数据 $C/Gn~k 5
currentContr = 50 nSiNSLv
Case 151 To 180 S@)bl
currentBr = 130 %R >S "
currentContr = 60 }"Cn kg
Case 181 To 220 '背景全为白色 <hbbFL}|%
currentBr = 110 zJ`(L
nV
currentContr = 130
6zWvd
Case 221 To 255 '背景全为白色 buXG32;
currentBr = 100 A'8K^,<
currentContr = 100 6f!mk:\T.
End Select SI9hS4<j
k]iS3+nD
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 L /> GYx
Case 100 To 150 Gp+XM
currentBr = currentBr - 10 #VE $C3<
Case 151 To 255 MvmP["%J4_
currentBr = currentBr - 20 Se`N5hQ
End Select O2dgdtm
z-G (!]:
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 gEsR-A!m
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 R.T-Pt ene
End Sub r|@?v ,
i#=X#_
+El
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) vB x^zDe
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long Se8y-AL6x>
7p$*/5fk
For i = 1 To 8 6%#' X
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& y~jIA p
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& B_2>Y t"
Next i a)Ek~{9
)M 0O=Cl1
For j = 1 To 1024 Rp*t"HSaAW
L1 = L1 + LeftBK(j, 0) yFo5 pKF.J
L2 = L2 + LeftBK(j, 1) ={ '($t%|T
R1 = R1 + RightBK(j, 0) PEIr-qs%D
R2 = R2 + RightBK(j, 1) `qz5rPyZ
Next j !?/bK[
P,
diffL = Abs(L1 - L2) / 1024 eb\`)MI/
diffR = Abs(R1 - R2) / 1024 *Rh .s!@4
End Sub bicL %I2h
9A(K_ d-!H
Function CheckSlice() As Boolean [#Vr)\n
CopySlice avSL, avSLR, avSLL Q8oo5vqQ#C
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then \k_3IP?o=
CheckSlice = True w "i Z n
Else *Mc \7D
CheckSlice = False 4?& a?*M
End If T}
[vfIJD
End Function R
<\Yg3m8
5I,X#}K[
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) E 5{)d~q
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long s=
fKAxH
For i = 1 To FrameH e~;) -Z
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize jt--w"|-r
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize MlE~ gCD
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize %Qz`SO 8x?
Next i x^2/jUc#B
For i = 1 To FrameH e&4u^ '+K
For j = 1 To sSize v6\2m c.
total = total + Slice(j, i) Zr;=p"cXr
totalL = totalL + SliceL(j, i) dRa<,@1"
totalR = totalR + SliceR(j, i) i%8&g2
Next j q:
EQ,
Next i 66^t[[
avSL = total / FrameH / sSize J9.p8A^^2
avSLR = totalR / FrameH / sSize s.)w
A
`&&
avSLL = totalL / FrameH / sSize 63Yu05'
End Sub z{L;)U B^
FF~4y>R7u
Sub DrawSlice() )\Q|}JV
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B m0 \}Cc
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B O Zm[i H
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B {~g
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) 3y B6]U
End Sub _PXo'*j
Sub DrawMark(pic As Control) 3uG5b8?
Dim i As Long, j As Long EsB'nf r
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B R7c)C8/~
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B d<? :Q
For i = 1 To PilarH $yFuaqG`Wo
For j = 1 To PilarW -yGm^EwP
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) E]?HCRa5R
Next j {WOfT6y+
Next i g GT,PP(k
End Sub SkRQFm0a~
%esZ}U
Function avIMG() As Integer gGml
c:/J%
Dim i As Long, j As Long, totalIMG As Long G%R`)Z]8&
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 5)NBM7h
For i = 1 To pFrameSize F)ld@Ydk=
totalIMG = totalIMG + pBuffer(i) NO p= /
Next i t~K!["g
avIMG = totalIMG / pFrameSize Q]UYG(
End Function X]"OW
WCT W#<izm
Function avRegion(barCol As Integer, barWidth As Integer) As Integer kGV`Q
Dim i As Long, j As Long, totalIMG As Long wg_CI,Kq
For i = 1 To FrameH R mV/ wY
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth < DZ76
Next i d|+jCTKS
For i = 1 To FrameH * barWidth nvVsO>2{ o
totalIMG = totalIMG + pBuffer(i) vcU\xk")
Next i @~G`~8
avRegion = totalIMG / pFrameSize %P,^}h 7
End Function p Y>-N
