这才是我当年写出的一个比较烂的程序 $j}sxxTT
e$(i!G)
Main2.bas p|%Y\!
>-y&k^a=
Attribute VB_Name = "SubMain" Mz{ Rh+gS
Option Explicit &<i>)Ss
c l 7+DAE
'采集文件与临时文件 u=
+
Public Const TmpFile As String = "d:\30-0600.dat" /C8(cVNZ
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 .'AHIR&>
0\}j[-`pF
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Zk;;~ESOU
Public hBCFile As Long '记录采集参数的文件 e]X9"sd0=
Public Const TmpBMP As String = "d:\1.bmp" ~KfjT
p#
Public hTmpFile As Long 1 }q[8q
/0YNB)
l1_X5D I
'采集窗口参数常量 k0D &F; a%
Public Const FrameH As Long = 280& IO_H%/v"jC
Public Const FrameW As Long = 768& Xhkw<XbV
Public Const pFrameSize As Long = FrameW * FrameH _5YL !v&
<ct {D|mm
'标志区范围，用于识别车辆 9'8oOBqm3%
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X NtOR/*
Public Const mkW As Integer = 28 '识别标志立柱宽度 Z*e7W O.
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) 3y
D5u
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) "AVj]jR
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 7iJk0L$]x
'车缝检测位置常数 yb**|[By
Public Const sSize As Long = 32& \&qVr1|
Public Const sPos As Long = 310& iii$)4 V
Public Const sPosL As Long = 200& TuCOoz@d
Public Const sPosR As Long = 500& 0_y%Qj^e
'车缝检测框位置 't_=%^ q
Public Slice(1 To sSize, 1 To FrameH) As Byte w)8@Tu:Q
Public SliceL(1 To sSize, 1 To FrameH) As Byte o_* |`E
Public SliceR(1 To sSize, 1 To FrameH) As Byte LP)mp cQ
Public avSL As Integer, avSLR As Integer, avSLL As Integer ~O
6~',KD
N$,)vb<
{}^ELw
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 @x J^JcE
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 ^9b
`;}) .
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 x}>tX
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long &Y=NUDt_
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte n _ez6{
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ]R>k0X.V
17Gdu[E
j1iC1=`ZM
IKr7"`
'一次连续采集的帧数 K ;xW /7?
Public tFrames As Long /tv;W
+m7 x>ie)
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 hA\8&pI;
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 ;^8^L'7cr
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize
$-AvH( @
# nYGKZ
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte 22r01qH
Public pBuffer(1 To FrameW * FrameH * 2) As Byte OB^ 2NL~Q~
Public pWorkSpace(1 To FrameW * FrameH) As Long K+$c,1
wb
Public Const pBufferSize As Long = FrameW * FrameH * 2 @ Q1j
H~t
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 g4$%)0x%
a&ByV!%%+_
Public hBoard As Long '采集卡标识 +@qk=]3 a
Public mBufferAddr As Long '缓存地址 &s;%(c04A
Public BufferSize As Long '缓存大小(字节) fY"28#
Public iCurrentCard As Long XP;&iZ
J
Public CapStatus As Long A>g $[
Public iFrames As Long RK3/!C`
Public currentBr As Byte, currentContr As Byte 7ER 2 h*
gX _BJ6
Public hMEM As Long, mStatus As Long `U1%d7[vY
Public Const hMemSize As Long = pFrameSize * 4 }Voh5*$E`
Public hMemWork As Long q@-qA]
Public Const hMemWorkSize As Long = pFrameSize * 5 I~qiF%?d
(Mm{"J3uv
imhq*f#A[
ry]7$MQyV
'串口接收轨道衡数据 # f~a\}$I
Public WeightFromCom As String p +7BsW .l
Public bReceiveComplete As Boolean )?bb]hZg?O
E H "g`r
;VFr5.*x
Public Type GrayBMPHeader xA5$!Oq7
Tag As Integer t5Mo'*j
=
FileLength As Long '文件大小 EXFxiw
Reserve1 As Long yK7>^ p}V
DataOffset As Long '图像数据偏移量 -pGt ;
BMPHeaderSize As Long '文件头长 *f#4S_ws`
'length of the bitmap info header used to describe the bitmap colors, compression,…
k"7eHSy,
'the following sizes are possible: *_wef/==
'28h - windows 3.1x, 95, nt, … @
:4Kk
4g1
'0ch - os/2 1.x
Y) *l w
'f0h - os/2 2.x rlIEch^wZ
.- Lqo=o\
ImageWidth As Long '图像宽（像素数） U?lu@5 ^Z
ImageHeight As Long '图像高(像素数) YPy))>Q>cK
PlaneNumber As Integer '图像层数 Wkk Nyg,
bpp As Integer 'bits per pixels '1 - monochrome bitmap -9*WQU9R
'4 - 16 color bitmap fDqXM;a"
'8 - 256 color bitmap 2!otVz! Mh
'16 - 16bit (high color) bitmap 2* L/c-
'24 - 24bit (true color) bitmap $B?7u@>,
'32 - 32bit (true color) bitmap rWs5s!l,
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) ge oN4
'1 - rle 8-bit / pixel (also identified by bi_rle4) VfcQibm
'2 - rle 4-bit / pixel (also identified by bi_rle8) FVmg &[
.
'3 - bitfields (also identified by bi_bitfields) 66 Xt=US
IMAGESIZE As Long '图像数据字节数 D)sEAfvX
hResolution As Long '水平分辩率 像素数/米 85{vz|(':
vResolution As Long '垂直分辩率 %UJ4wm
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 u .=; A#
ImportantColors As Long _z 5C
plO
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 *vO'Z &
End Type e d*AU,^@v
?BZ ][~n-Q
e,*[5xQ
g[jZ A[[
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader !m|%4/
M@
Public sRECT As RECT /_a *C.a6
=|%T E
e`Yns$x
Public conn As ADODB.Connection ] zY
Public rsTrain As ADODB.Recordset ~=mM/@
HD
Public rsOperater As ADODB.Recordset ui{_w @ o
Public rsGoods As ADODB.Recordset m8 PB2h
Public rsGood2 As ADODB.Recordset Zn0fgQd
Public rsSender As ADODB.Recordset m'B6qy!}6
Public rsReceover As ADODB.Recordset " '#Hh&Us
Public rsTrainTMP As ADODB.Recordset iP%=Wo.
j1kc&(
Pvw %,=41O
'打开采集卡 S%fBt?-Cm
'设置参数 JrAc]=
'设置为实时单帧采集到缓存方式 E G.C2]Fi
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 !v L :P2
y)E2=JQA/
.Cus t
Sub Main() UVJ(iNK"
Dim i As Integer, status As Long $
bosGG
,AM-cwwT:u
InitBMPinfo 7$=@q|$
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 0cUt "(]
BMPHeader.Tag = &H4D42 P.B'Gh#^
BMPHeader.ImageWidth = FrameW ;LE
@Ezx
BMPHeader.ImageHeight = FrameH K-u/q6ufK
BMPHeader.BMPHeaderSize = &H28 OJ 5 !+#>
BMPHeader.PlaneNumber = 1 3T/j5m}+!
BMPHeader.bpp = 8 ? $ c
BMPHeader.Compression = 0 ix+x-G
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 ?63JQ.;
BMPHeader.vResolution = &H1274 kwR@oVR^
BMPHeader.ColorsinBMP = 256 *~uuCLv_
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP rfi `Bp
BMPHeader.DataOffset = Len(BMPHeader) TMCA?r%Y\
For i = 0 To 255 !?*!"S-Sl
BMPHeader.Pallate(i) = RGB(i, i, i) u
Cfp+
Next i RWo B7{ G
BMPHeader.IMAGESIZE = FrameH * FrameW ~Wm}M
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE ,-Nk-g
UYOn
p7R<
$SVGpEw
MoveMemory BMP1, BMPHeader, Len(BMPHeader) 6w;|-/:`
8!6*|!,:?n
BMP1.ImageWidth = FrameW 9`{2 h$U
BMP1.ImageHeight = FrameH * 2 OF/)-}!
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight *^Y0}?]qT
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE 9Ol_z\5
>pvg0Fh
'确定标志位置,为pilarX, pilarY确定初始值 ^b %8_?2m
PilarW = mkW `=DCX%Vw
PilarH = mkH '此两项为固定值 NF!1)
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) hY 2PV7"[;
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 "%t`I )
K >6k@okO
& }}WP:U
'连续采集记录文件 Q$L(f H kw
' 建立一个缓冲区为页对齐方式的文件 tlgvBRH >
If Dir(TmpFile) <> "" Then I7^X;Q
F
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 3]es$ Jy
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) Sg>0P*K@
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 +yH~G9u(
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 x 4< /\o
Else j]"xck
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ u/c3omY"#
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 34kd|!e,
End If CH it
If hFile = 0 Then ] /Q
y1,
MsgBox TmpFile & ": File Open Error", vbOKOnly u g"<\"
Exit Sub xN8JrZE&
End If veg!mY2&
'采集参数记录文件 )N 6[rw<
hBCFile = FreeFile() ok2~B._+;
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Z<<gz[$+p
H`lD@
q'S
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 m@u`$rOh
If hMEM = 0 Then ja- ~`
fStatus = GetLastError E}9ldM=]s
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ AuipK*&g
& "请向技术人员报告该错误代码。", vbOKOnly -z$2pXT ^
CloseHandle hFile z x
Uj1
Exit Sub S)@vl^3ec
End If a
BH1J]_
/ +`<X%^U
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) A i){,nh`0
If hMemWork = 0 Then g+)\ /n|
fStatus = GetLastError 8 G] m7Z
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ ]G PJ(+5
& "请向技术人员报告该错误代码。", vbOKOnly ,D2_Z]
'释放已成功分配的内存 eI rmD
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) B~z g"
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) L_ K\i?
:qTcxzV
CloseHandle hFile q U*&49 X
Exit Sub bK8F |
End If X\2
hKUkT
`lezJ (Xm
' Test writing 'A!/pUML
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ]=VS~azZ5
2\B9o `Y
'初始化采集卡参数 / &as)
iCurrentCard = -1 XuoEAu8]
hBoard = okOpenBoard(iCurrentCard) n o+tVm|
Debug.Print hBoard E0^%|Mh]b
If hBoard = 0 Then 0 DVZRB
ExitGrabber YQdX>k
End 3,L3C9V'
End If cievC,3*
okGetBufferSize hBoard, mBufferAddr, BufferSize X/K)kIi
If mBufferAddr = 0 Then cN lY=L
MsgBox "缓存不存在！" PFy;qk
ExitGrabber \Fg6 b6
End If S5u#g`I]
Debug.Print Hex(mBufferAddr), Hex(BufferSize) D8AIV K]
etMh=/NFV
<Iyot]E
currentBr = 128: currentContr = 128 g^ $ 11
'设置视频输入参数 Z WRRh^
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 0&IXzEOr
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input v#]v,C-*
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Pph8"`mv.m
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 D *I;|.=u
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 Jhy
t)@7/,
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 aC~n :0 v
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） ;GFB@I@
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) n,a5LR
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) 5vX 8mPR_
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 kefv=n*]l
)Q CM2
'设置采集参数 <!}l~Ln15
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 Vy^yV|`v
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 "=\_++
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 L\wpS1L(
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 /dJ)TW(Ir
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 =l
2Dm
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 F0'A/T'ht
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 ]Zz G!7
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 0O,T=z[+>
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 K}E7|gdG
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 @U3foL2\
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 DwY<qNWT
Vm ;Q w
R =9~*9
okCloseBoard hBoard 27E9
N O =
Sleep 50 + i @yZfT
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 t_>bTcsU
?t0zs q
'设置数据传送方式 tK|9q s<%
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 B5,QJ W*
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。
-N7L #a
yC 7Vb
P
sRECT.Right = -1 '用于获得当前设置值 ,mjfZ*N
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) + iH30v
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom h>Uid
&:?
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 Z\
=04[
sRECT.Left = 0 q
X%v Rf0
sRECT.Top = 0
.d~] e2x
sRECT.Right = sRECT.Left + FrameW jXY ;V3l
sRECT.Bottom = sRECT.Top + FrameH * 2 !\#Wk0Ku
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) xPDA475Cw3
K+@eH#Cv,(
sRECT.Right = -1 '检查新设置值 "4oz
lWx
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
Ep\
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom >[H&k8\7n
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) EhIV (q 9x
|[owNV>
If TESTSignal = False Then A?IZ(
Zx(`
'ExitGrabber Yl&tkSw46
End If e4=FU&RpNH
me:|!lI7YU
SQt|(r)
{
#1j"
'设为实时采集状态 B
naU)E h
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) 7}'A)C>J;
?7kV+{.
}x?H ~QQT
'单帧采集 (!VMnLlXRK
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 `!omzE*bk5
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) -<51CD w,
okCaptureTo hBoard, BUFFER, 0, 1 'single ,]uX:h-EM
'Do While okGetCaptureStatus(hBoard, False) <> 0 S}w.#ty En
' Sleep 20 9U=fJrj'u
'Loop }xf= 'lE
okGetCaptureStatus hBoard, True RJRq` T|m
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize YF! &*6m
'写入768*576测试图象 o\]: !#r{T
ArrayToBMP TmpBMP UGmuX:@y76
d]7|v
r]
'打开数据库 juCG?}di;
Set conn = New ADODB.Connection k)5_1 y
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 88#qu.
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ i,'Ka[6
"; Mode=Read|Write"
H\=LE
conn.Open !
nCjA\$
8{G?92
{rN
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 6i]Nr@1C
frmRecord.Visible = True v dH+>l
frmQuery.Visible = True pdi=6<?bd
Load frmReceiveFromComm [EmOA.6
S0N2rU
'调试参数 Rct"\{V')n
If InStr(UCase(Command()), "/CAPTURE") > 0 Then 'z-;* !A}j
SignalBox.Visible = True p<HTJ0
End If &8]#RQy{f
If InStr(UCase(Command()), "/COMM") > 0 Then aI= {,\
frmReceiveFromComm.Visible = True 9'n))%CZ.
End If 7 bonOt
Y
)pjjW"C+
End Sub ^$=tcoQG
,yk PQz O
Sub ExitGrabber() # 5y9L
'关闭数据库 'n^2|"$sH
'关闭采集卡 uS,p|}Q&
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Z(Eke
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Jm %ynW
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) nxyjL)!)0
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) A-a17}fta
okStopCapture hBoard !_U37Uj<m
okCloseBoard hBoard ~IlF*Zz#}6
CloseHandle hFile :T7
?
Close #hBCFile
Hz]4A S
conn.Close -v;n"Zy1
End `! nJS|
End Sub a1g 6}
ym\
s-C!uq
Function ArrayToBMP(ByVal File As String) }{&l n
Dim BytesWrite As Long vXy uEEe
ha|@ X p
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _
's>#8;X
CREATE_ALWAYS, 0&, 0&) D Hm[8 Qp
0~+NB-L}
If hTmpFile = 0 Then X(GmiH /E
ArrayToBMP = False b8N[. "~:
Exit Function 1m>^{u
End If (!ZQ
CJ9cCtA
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ?{
B[
^
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& <H5n>3#pH
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
w.J%qWJq
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& -XBKOybHBO
!Tn0M;
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN K,e q D<
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& DO&+=o`"
mW~i
c
If BytesWrite < pFrameSize Then HQ^9 [HN.
ArrayToBMP = False NqJ<!q)
End If QFW0K D`5
Pqy-gWOv
CloseHandle hTmpFile _{6,.TN
Yz j%{fkh
End Function :cc[Jco@w
;RWW+x8 IB
Function ArrayToBMP1(ByVal File As String) =5y`(0 I`U
xdd:yrC
Dim BytesWrite As Long lo+xo;Nd
9W1;Kb|Z<
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ~@T+mHny
CREATE_ALWAYS, 0&, 0&) 2Vp>"
5N oe/6
If hTmpFile = 0 Then /[a |DUoHO
ArrayToBMP1 = False [ 8F
\;
Exit Function
bKk CW
End If C9<4~IM
w
T&1-eq >l
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN brg"
:V1a
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& SkiJ pMN
@J-plJ4e
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN 81 g9ZV(4
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& 1@A7 h$
1P
8To7c
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN mi7sBA9L8
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& |Du,UY/
Mn]}s:v
If BytesWrite < pBufferSize Then 2 9"mE;j
ArrayToBMP1 = False |x &Z~y
End If 3<c*v/L{C\
Q0V^P DF
CloseHandle hTmpFile =
:Po%Z%{
6xQ"
bFm
End Function T>#TDMU#Fm
O6y @G
.+
'使用该过程建立的文件要求在用后关闭 <9ma(PFa
Public Function ArrayToBMP2(File As String) As Boolean +w "XNl
o" |O
]
Dim BytesWrite As Long DpA\r_D
pO"m~ mpA
ArrayToBMP2 = True <fNGhmL
h zaLx8L
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ DVObrL)znL
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) luW
<V>
)fNGB]%
If hTmpFile = 0 Then ( "_Q
ArrayToBMP2 = False (E!%v`_0
Exit Function L)q`D2|'
End If 'sj9[o@]
xME(B@j
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ]{YN{
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& &&; ex9
{bN Y
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN jEUx
q%BH
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& [ZuVUOm
-NAmu97V}
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 8NnhT E
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& B ,V( LTE
}%
eDEM
If BytesWrite < pFrameSize Then xM&EL>m>L
ArrayToBMP2 = False 8)N0S% B
End If A?
e,U,
o
g_Ri$x8
CloseHandle hTmpFile X(IyvfC
lZ}P{d'f.
End Function y k?SD1hj
43KaL(
Private Function TESTSignal() As Boolean ,#
]+HS^B
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long BS N6|W
e\`wlaP,
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) T`
uDlo
GF&_~48GD
If extsign = 1 Then {3_Gjb5\\4
TESTSignal = True SijtTY#r
Else S# ,+Z7
If extsign = 0 Then mv{< '
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly /x$}D=(CZ
TESTSignal = False xXO R IlD
Exit Function $( S*GF$S
End If neF8V"-u&
End If <BS
Sa`N`
c8T/4hU
MN
'测试视频输入类型 -:MmSeG7gO
'video type FIH @ 2zA
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 Zw +=ng.q?
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) O47PkP8
If videotype = 1 Then M3ZOk<O<R
'"隔行信号(Interlaced)" G c wt7~
Else >wA+[81[
If videotype = 0 Then v' C@jsx M
'"逐行信号(Non-interlaced)" ri: , q/-
Else -(!uC +BZX
If videotype = -1 Then 8`}l\ Y
' "不支持" )&>L !,z
End If
R6 ;jY/*#
End If WhH!U0
End If =tq1ogE
"c6<zP
'测试垂直扫描线数 Q.yb
4
'video scanlines
4iwf\#
scanlines = -1 i&JpM] N
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) mKM,kY
If scanlines = -1 Then |7y
6
pz
' "不支持" YUCC*t
Else Wu ,S\!
'Trim(Str(ScanLines)) + " 行数/幅" + @e
}mL\8
End If Q |%-9^
E-^2"j >o
'测试帧频 :i.t)ES
'video field frequency Y.7}
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) EOhC6>ATh
If fieldfrq = -1 Then 6Z Xu,ks}
'lblSignal(8) = "不支持" Y,'%7u
Else xWDR72 6
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" hq L+_| DW
End If 6.[)`iF+#
End Function -OWZ6#v(
/N>} 4Ay
=LOk13l\"
Sub PicIdentify() 4 h;4!I|
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 }B`Ku5 M
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 guU=NQZ
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 !:3^ hb
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 t ^
m ~
#G[t X6gU
Dim fPTR As Long, cFrame As Long Y17hOKc`
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer " CM ucK
40u7fojg2
tj[ c#@[B
cFrame = 0 ZNi
+Aw$u
syR N4
%yfE7UPS]
Do While cFrame < tFrames
>zQOK-
J smB^
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) 9:Si]
Pp+S
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) L"^OdpOs
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize ]w!0u2K<Q\
Pubv$u
2
frmRecord.RText.Text = Str(cFrame) :5jexz."M
frmRecord.RText.Refresh zZ: xEc
z|I0-1tAK
If CheckMark = True Then #ra*f~G
ArrayToBMP TmpBMP 9p4y>3
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) r_^)
1w
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" "Kq>#I'%W
cAb>2]M5V
DrawSlice ) &:L'N
g
rspt}
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) yPoSJzC=[
'If i = vbNo Then 1 DqX:WM6
' Exit Do * jE;9^
'End If eeW`JG-E
'cFrame = cFrame + 1 `]jqQr97
~g7m 3
End If ;g+]klR!
DoEvents q6R Eh ;$
cFrame = cFrame + 1 xz8G
}Ku
Loop 9Sz7\ W0
End Sub V#L'7">VP
zW5C1:.3K
w
G8
nw;
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean f 0DK>L
0elxA8Z~e
'如标志区模式反差存在则为TRUE，否则返回FALSE <UT> PCN G
BZ+;n
|<r
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long &<Zdyf?[Ou
CheckMark = True 5]d{6Nc3
P
'C^;OjAg
'复制标志区 GJ,a RI
For i = 1 To mkH x#r<,uNn,
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW VO_dA4C}z
Next i {~'H
R&*@@F-dx
For j = 1 To PilarW * PilarH / 2 '#q4Bc1
mTop = mTop + MKpilar(j) O%&cE*e X
Next j R!6 =7
H O*YBL
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH ^s-25 6iI
mBot = mBot + MKpilar(j) w"~<h;
Next j F?BS717qS%
h&`y$Jj
mTop = mTop / PilarW / PilarH * 2 u%B&WwHG
mBot = mBot / PilarW / PilarH * 2 6e.[, -eU
<^c3}
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 Z7z]2v3}c
bq NP#C
'平均值极值化 m(_9<bc>
For j = 1 To PilarH * PilarW JYJU&u
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) #K4*6LI
Next j `eR 7H>I
ugLlI2 nJ
mTop = 0: mBot = 0 o_$&XNC_
For j = 1 To PilarH * PilarW / 2 ! ),t"Ae?>
mTop = mTop + MKpilar(j) r[pF ^y0
Next j {[W(a<%bXm
N 9LgU)-Jt
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW 9->q| E4
mBot = mBot + MKpilar(j) 8EI:(NE*J
Next j 4x=(Zw_X
m*Cu-6&qd
X{\jK]O
mTop = mTop / PilarH / PilarW * 3 X#`dWNrN
mBot = mBot / PilarH / PilarW * 3 QIK
9
v+6e;xl 8
)+EN$ *H
If mBot > iWhite And mTop < iBlk Then ,[ l`zp
CheckMark = True orqJ[! u)`
Else Oaa"T8t
CheckMark = False Jzex]_:1~
End If Z9[+'ZWt
End Function .Y\EE;8%
)/ >A6A:
Sub Capture1Frame() ~=cmM
okCaptureTo hBoard, BUFFER, 0, 1 'single
^2C>L}
okGetCaptureStatus hBoard, True +qy
6d7 ^
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize u-:Ic.ZV
End Sub Ilq=wPD}j
`
>U?v
2 hq\n<
Sub CopyMark(iBlk As Integer, iWhite As Integer) RB$
z]/=
'复制标志区并返回标志区暗区与亮区的亮度平均值 q.W> 4 k
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 vFhz!P~
q7_+}"i
'复制标志区 ?lKhzH.T
For i = 1 To mkH 7u|B ](FS
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW ? \y%]1
Next i %\6Q .V#s
Y3rt5\!
For j = 1 To mkW * mkH / 2 X{Zm9T
mTotal = mTotal + MKpilar(j) E ]f)Os$
Next j jatr/
#
yN*',I&
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 Bm /YgQi
WU)Ss`s \
mTotal = 0 ]
.m qxf
For j = mkW * mkH / 2 + 1 To mkW * mkH xaW{I7FfG
mTotal = mTotal + MKpilar(j) HI
D([Wk
Next j 6Hf,6>
{dzoEM[
1s
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 8@eOT zm
pj8azFZ
'背景亮度 Vte EDL /w
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW fYX<d%?7
For i = 1 To 4 * FrameW >cgpaj x*
bsTotal = bsTotal + BsLine(i) BC7 7<R!E)
Next i b1-&v|L
bsAV = bsTotal / FrameW / 4 ^ R~~L
Md&WJ
};L
End Sub D*2\{W/
(ML haux-
>5ChcefH
Sub AdjIMGbright(Optional bInit As Boolean = True) /XbW<dfl
uM S*(L_
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） -6C +L bV
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 v("wKHWTI@
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 /X#z*GX
y{=>$C[
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer q>s`uFRg(
)(T AT<
'按标准亮度与对比度采集一帧，确定背景亮度 MKg,!TELe
currentContr = 128 '初始对比度 D$q'FZH
currentBr = 128 '初始亮度 #*^+F?o,(
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 orfp>B) 0
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 75NRCXh.
DoEvents (
kw5>c7
Capture1Frame PJ\0JR7 a
'获得图像上缘4行象素 :L i/=>R^
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW lr3
mE
CopyMark iBlack, iBright '图像标志区亮度 %!|O.xxRR
For i = 1 To 4 * FrameW Mvcfk$pA
bsTotal = bsTotal + BsLine(i) Z^ar.boc
Next i qL K?%?.N<
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 Vw~\H Gs/~
h "W8N+e\
Select Case bsAV RE"^
)-
Case 0 To 60 '夜间通过灯光照明,完全没有背景 L:R<e#kgS
currentBr = 150 $kPHxD!"
currentContr = 60 >*1}1~uU`'
Case 61 To 80 '有可见背景 DL8x": ;
currentBr = 140 rx!=q8=0R
currentContr = 70 y7lWeBnC
Case 81 To 100 '有清晰背景 1[PMDS_X
currentBr = 128 a`c:`v2o
currentContr = 80 z&}-8JykH
Case 100 To 150 '有明亮背景 r{K;|'d%h
currentBr = 140 '5:30-6:00钟实测数据 vhgLcrn
currentContr = 50 |yY`s6Uq
Case 151 To 180 r>t1 _b+nu
currentBr = 130 f.xA_ Y>
currentContr = 60 h{'t5&yY
Case 181 To 220 '背景全为白色 i.y)mcB4
currentBr = 110 m_7
nz!h
currentContr = 130 vHKlLl>*2
Case 221 To 255 '背景全为白色 ]?LB?:6
currentBr = 100 | i7a@'0 )
currentContr = 100 bGmx7qt#
End Select K$[$4 dX]
,r^"#C 0J}
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 zT9JBMNE:
Case 100 To 150 h~} .G{"
currentBr = currentBr - 10 wkb$^mU
Case 151 To 255 "484 n/D
currentBr = currentBr - 20 ^@6q
End Select uGVy6,
Ng =ONh
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 \RG!@$i
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 l67 Jl"v
End Sub * ?%
k#S
.~D>5 JnEk
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) '7 )"
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long %, q. ),F
!0}\&<8 /m
For i = 1 To 8 <L0#O(L
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& /X*oS & -M
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& #x@ eDnb_
Next i >U!*y4
k$i'v:c|:i
For j = 1 To 1024 01@t~v3!Z
L1 = L1 + LeftBK(j, 0) 7 hw .B'7
L2 = L2 + LeftBK(j, 1) MuI2?:~:*4
R1 = R1 + RightBK(j, 0) U1R4x!ym4
R2 = R2 + RightBK(j, 1) n"D ?I
Next j n1v5Q2xw
diffL = Abs(L1 - L2) / 1024
%D=]ZV](
diffR = Abs(R1 - R2) / 1024 Ip
*g'
End Sub U5r}6D !)
3iX?~
Function CheckSlice() As Boolean ;;U :Jtn2
CopySlice avSL, avSLR, avSLL 9S7A!AKE
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then ; H0 {CkH
CheckSlice = True < V&5P3)d9
Else !CY&{LEYn0
CheckSlice = False p( LZ)7/
End If F
"jt&9j
g
End Function p Pr o }@@
7jG(< !,
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) >SmV74[s2
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long vqd X^m^PY
For i = 1 To FrameH 2N [=
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize sM2MLh 'D
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize UQ?%|y*Kc
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize Z;DCI-Wg
Next i ~$
,qgf
For i = 1 To FrameH
A[N
{
For j = 1 To sSize ,!Q V>=
total = total + Slice(j, i) _lxco=qd=%
totalL = totalL + SliceL(j, i) HIvZQQW|
totalR = totalR + SliceR(j, i) @%ECj)u`O
Next j S?0$? w?
Next i ~Ci{3j :]
avSL = total / FrameH / sSize ,_
2x{0w:>
avSLR = totalR / FrameH / sSize g=8un`]7
avSLL = totalL / FrameH / sSize MgM
D\
End Sub Bi%x`4Lf
42C<1@>zO
Sub DrawSlice() <i. a pBH
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B `ldz`yu6++
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B P:xT0g
tt
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B V"KS[>>f
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) k !L@G
Q
End Sub PAF8W lg
Sub DrawMark(pic As Control) *%FA:Y
Dim i As Long, j As Long ^A_;#vK
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B o>]`ac0b}Y
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B "&+3#D
>
For i = 1 To PilarH 0y#Ih {L
For j = 1 To PilarW !nf-}z e{
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) t T%/r,
Next j \IM4Z|NN"
Next i 8?FueAM'
End Sub t67Cv/r~
Xl-e !
Function avIMG() As Integer E,[xUz"
Dim i As Long, j As Long, totalIMG As Long PL=^}{r
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 8{
c !).
For i = 1 To pFrameSize 6<'K~ 1do:
totalIMG = totalIMG + pBuffer(i) I:j 3sy
Next i ] ZoPQUS?
avIMG = totalIMG / pFrameSize Tl(" IhkC
End Function -G |a*^
/F /;G*n
Function avRegion(barCol As Integer, barWidth As Integer) As Integer I/J7rkf
Dim i As Long, j As Long, totalIMG As Long w Iv o"|%
For i = 1 To FrameH r7m D{0s*
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth QO;4}r q
Next i 3251Vq %
For i = 1 To FrameH * barWidth z? ]G3$i(
totalIMG = totalIMG + pBuffer(i) f>$`` .O
Next i V|D] M{O
avRegion = totalIMG / pFrameSize #s5N
[uK^m
End Function |UUdz_i!:
