这才是我当年写出的一个比较烂的程序 kiZA $:V8
d1 D{wZ3g
Main2.bas B@=+Fg DD
w,;CrW T2t
Attribute VB_Name = "SubMain" AnfJyltS
Option Explicit 6|rqsk
-? &wD["y
'采集文件与临时文件 iAbtv^fn
Public Const TmpFile As String = "d:\30-0600.dat" b,$H!V *
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 +JB. EW/
@T|mHfQ8
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long = %\;7
Public hBCFile As Long '记录采集参数的文件 6*/0 yGij
Public Const TmpBMP As String = "d:\1.bmp" 'h.{fKG]ME
Public hTmpFile As Long \ :1M
M
2 Do^N5y
N3TkRJZ
'采集窗口参数常量 2W~,,$
G
Public Const FrameH As Long = 280& |Ah26<&
Public Const FrameW As Long = 768& P+wV
.pF|
Public Const pFrameSize As Long = FrameW * FrameH 3 =KfNz_
TfDx>
F$
'标志区范围，用于识别车辆 aYkm]w;C
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X <hkg~4EKc
Public Const mkW As Integer = 28 '识别标志立柱宽度 T`Sp!
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) /4<eI 3Z
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) O (<Wn-
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 ,/C<GFae
'车缝检测位置常数 8AOJ '~$
Public Const sSize As Long = 32& 0:@:cz=#*
Public Const sPos As Long = 310& S `5^H~
Public Const sPosL As Long = 200& _h MMm6a|
Public Const sPosR As Long = 500& ~}i &gd|(
'车缝检测框位置 i_)j K
Public Slice(1 To sSize, 1 To FrameH) As Byte e 9U\48
Public SliceL(1 To sSize, 1 To FrameH) As Byte wtndXhVC4>
Public SliceR(1 To sSize, 1 To FrameH) As Byte pe Y( 4#
Public avSL As Integer, avSLR As Integer, avSLL As Integer ^EN_C<V;"d
~ 6 1O
gk"S`1>
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 \vs,$h
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 a 9(1 6k
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 ,i;kAy)
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long 5Q^
L"&0
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte c1'OIK C
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 >w9fFm!Q
"gfy6m
5tX| @Z:
z
l&dHH_m3
'一次连续采集的帧数 d>M&jSCL
Public tFrames As Long Jb#*QJ=
#'mb9GWD3
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 u7UqN
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 XD<7d")I
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize &^8 >Kd8
sT?Qlj 'Zd
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte O{,Uge2n,
Public pBuffer(1 To FrameW * FrameH * 2) As Byte |g}!
F -
Public pWorkSpace(1 To FrameW * FrameH) As Long xiX~*Zs
Public Const pBufferSize As Long = FrameW * FrameH * 2 'sn%+oN
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 &$.Vi&{.
G0^WQ Q4
Public hBoard As Long '采集卡标识 -P]J:7*0?\
Public mBufferAddr As Long '缓存地址 t7H2z}06=h
Public BufferSize As Long '缓存大小(字节) xO`w| k
Public iCurrentCard As Long P >z k
Public CapStatus As Long ja$ e)
Public iFrames As Long \_#0Z+pX
Public currentBr As Byte, currentContr As Byte )Mx[;IwE
vtc} )s\
Public hMEM As Long, mStatus As Long @sO*O4os>
Public Const hMemSize As Long = pFrameSize * 4 +M
/04
Public hMemWork As Long _Z~w pO}/
Public Const hMemWorkSize As Long = pFrameSize * 5 x#|=.T
aEW
Z*y
T?I&n[Y|
L ~cswG'K
'串口接收轨道衡数据 c BQ|m A
Public WeightFromCom As String
.taJCE
Public bReceiveComplete As Boolean c
(O+s/
&n|# jo(gS
/XjIm4EN
Public Type GrayBMPHeader LS{g=3P0
Tag As Integer WIb\ +!
FileLength As Long '文件大小 Ua#*k
TF
Reserve1 As Long
if9I7@
DataOffset As Long '图像数据偏移量 yK+76\} I
BMPHeaderSize As Long '文件头长 Uq 2Uv
'length of the bitmap info header used to describe the bitmap colors, compression,… Ka1
F7b
'the following sizes are possible: 4NMv 7 [r
'28h - windows 3.1x, 95, nt, … i,NN"
'0ch - os/2 1.x 5r.\maW
'f0h - os/2 2.x VZ & >zF
y@ J\h8_
ImageWidth As Long '图像宽（像素数） 2T<QG>;)j
ImageHeight As Long '图像高(像素数) hV;Tm7I2
PlaneNumber As Integer '图像层数
Ash"D~
bpp As Integer 'bits per pixels '1 - monochrome bitmap ps[TiW{q;
'4 - 16 color bitmap c2Ua!p(c
'8 - 256 color bitmap mDC{c ?
'16 - 16bit (high color) bitmap )#l &F$
'24 - 24bit (true color) bitmap L01 R.3Z+
'32 - 32bit (true color) bitmap c>{6NSS -
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) WW2VW-Hk
'1 - rle 8-bit / pixel (also identified by bi_rle4) [CGvM {
'2 - rle 4-bit / pixel (also identified by bi_rle8) [Qa0uM#SU
'3 - bitfields (also identified by bi_bitfields) * ,-)4)7d
IMAGESIZE As Long '图像数据字节数 /7De .O~H
hResolution As Long '水平分辩率 像素数/米 8XD9fB^
vResolution As Long '垂直分辩率 wh
l)^D
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 m=k( 6
ImportantColors As Long > | KfO>
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 ;TD<\1HJT=
End Type .r)WD R
[ -bL>8
XtRfzqg?K
O$J'BnPpw
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader j_-$xz5-
Public sRECT As RECT X&0m$ x
HNxJ`x~Z~
(k"|k
Public conn As ADODB.Connection yHLc lv
Public rsTrain As ADODB.Recordset 0I* ^VGZ
Public rsOperater As ADODB.Recordset l"p
%]\tZ
Public rsGoods As ADODB.Recordset A0# K@
Public rsGood2 As ADODB.Recordset O66\s
q
Public rsSender As ADODB.Recordset :!;BOCTYI
Public rsReceover As ADODB.Recordset )zlksF
Public rsTrainTMP As ADODB.Recordset XA5gosq
9Xmb_@7b}
J x i>1
'打开采集卡 L,of@>
'设置参数 i >Hh_q;'
'设置为实时单帧采集到缓存方式 fw ._
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 Pk T&zSQA
M
c oHV]x
oOy@X =cw
Sub Main() l]Jk
}.
Dim i As Integer, status As Long ) /PvaL
Hq8 <g$
InitBMPinfo "tBd z V
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 V=
I au_
BMPHeader.Tag = &H4D42 %}j.6'`{
BMPHeader.ImageWidth = FrameW 9-eYCg7C|
BMPHeader.ImageHeight = FrameH 5F+5J)h
BMPHeader.BMPHeaderSize = &H28 zNuiB LxDs
BMPHeader.PlaneNumber = 1 ?q1&(g]qO
BMPHeader.bpp = 8 )5_G Jm&R9
BMPHeader.Compression = 0 %gSqc
}v*
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 zL5 r 8mD3
BMPHeader.vResolution = &H1274 .!RBh LH_g
BMPHeader.ColorsinBMP = 256 I! {AWfp0
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP
s$YKdtR
BMPHeader.DataOffset = Len(BMPHeader) /xJ,nwp7
For i = 0 To 255 (P~Jzp9u
BMPHeader.Pallate(i) = RGB(i, i, i) 1eZ">,F6<
Next i z[b, :G
BMPHeader.IMAGESIZE = FrameH * FrameW S;M'qwN
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE 38b%km#
Y iB]}/
.*:SZ3v
MoveMemory BMP1, BMPHeader, Len(BMPHeader) . +]e9mV
{6^c3R[
BMP1.ImageWidth = FrameW ?`_US7.@
BMP1.ImageHeight = FrameH * 2 }OJ*o
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight ~;_]U[eOL
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE
St-:+=V_
1GN>,Lb: o
'确定标志位置,为pilarX, pilarY确定初始值 @xH|(
PilarW = mkW p%+ 0^]v1
PilarH = mkH '此两项为固定值 }] >[FW
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) E^zgYkZO
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 Y
N _#x
,RKBGOz?f
p<Wb^BE
'连续采集记录文件 t
}7hD
' 建立一个缓冲区为页对齐方式的文件 L7_(KC h
If Dir(TmpFile) <> "" Then ^LaI{UDw%h
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ q<o*rcwf ^
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 9xP{#Qa
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 Nt,)5_K <
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 vnMt>]w-}
Else TDBWYppM
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 5)'
_3r
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) [@U8&W
End If TyD*m$`y
If hFile = 0 Then \xkLI:*\
MsgBox TmpFile & ": File Open Error", vbOKOnly h#@l 'Cye
Exit Sub KGxF3xS*7
End If ( t#w@<
'采集参数记录文件 `* "u"7e
hBCFile = FreeFile() 4*&x% ~*
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile vC E$)z'"
25BW/23}e
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 EXH{3E54)`
If hMEM = 0 Then TC?kuQI
fStatus = GetLastError %P0dY:L~
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ yc|C}oQF
& "请向技术人员报告该错误代码。", vbOKOnly I.r &;
CloseHandle hFile 'Y(#Yxc
Exit Sub ^ 'FC.
End If P0~3<h?U8
!;{@O`j?b
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) q@F"fjWBr
If hMemWork = 0 Then y A?>v'K
fStatus = GetLastError }X$
vriW
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ YN ?@ S
& "请向技术人员报告该错误代码。", vbOKOnly H/Cv ?GJF
'释放已成功分配的内存 v:B_%-GfOA
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) #x1AZwC
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) k^Zpb&`Hx
qGuz`&i
CloseHandle hFile nM x0 +N1
Exit Sub .3?'+KZ,
End If {R
`IA|T#k
nQdNXv<(
' Test writing kFgN^v^t
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& Dx$74~2e
'!Ps4ZTn_
'初始化采集卡参数 `Gx"3ZUn
iCurrentCard = -1 #pBAGm 3
hBoard = okOpenBoard(iCurrentCard) Msn)jh
Debug.Print hBoard
Wa
#,>
If hBoard = 0 Then ;_am gRP7$
ExitGrabber oo) P(_"u
End Re5m
End If 8A"[n>931
okGetBufferSize hBoard, mBufferAddr, BufferSize K SIH1E
If mBufferAddr = 0 Then &
d\`=e
MsgBox "缓存不存在！" aO.'(kk8
ExitGrabber I{<6GIU+
End If d8<Lk9H9R
Debug.Print Hex(mBufferAddr), Hex(BufferSize) E$.|h;i]Q
`]\4yTd
6#T?g7\pyR
currentBr = 128: currentContr = 128 ogs9obbZ!
'设置视频输入参数 x5v^@_:
jr
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 [6V'UI6
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input yi
Qke
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 kMKI=>s+
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 E}lU?U5i
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 96]lI3 c
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 ?Pw# !t
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） _DMj )enH"
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值)
hghtF
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) s#`%c({
U|
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 *U.$=4Az
(6A>:_)
'设置采集参数 <
Xm5re.
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 jec03wH_0
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 &FHE(7}/#
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 "8ILV`[
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 n}
GIf&
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 B3O^(M5W
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 %2^C
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 a w/ Y#
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 2n?\tOm(V
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 -))>7skc
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 |}^[f]
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 #j d? ocoY
YP>VC(f
~^lQ[ x
okCloseBoard hBoard _Jk-n Zgn
Sleep 50 +1Si>I
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 DX}EOxO,.
jPP aL]
'设置数据传送方式 |~8\{IcZ
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 [T"oqO4%]
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 G\Hck=P[$3
Xx:0Nt]
sRECT.Right = -1 '用于获得当前设置值 Tr)a6Cf
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) F) {f{-@)
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom Q &(?D
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 b;]'Bo0K
sRECT.Left = 0 ^c< <I-o|
sRECT.Top = 0 7
tF1g= \
sRECT.Right = sRECT.Left + FrameW
\-GV8A2:k
sRECT.Bottom = sRECT.Top + FrameH * 2 $^I uE0.
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) [ A|W0
-4,qAnuM x
sRECT.Right = -1 '检查新设置值 <E$P
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Ptzha?}OZ
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom q\O'r[&V
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) 4 en&EWUr
rr3NY$W
If TESTSignal = False Then $%;NX [>j
'ExitGrabber _8\ Uukm
End If TcZ
Ci^1F
&|%z!x6 f
K).X=2gjY
zF;}b3oIo
'设为实时采集状态 m{mK; D
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) y
97QqQ^
L}nj#z4g
yZxgUF&`
'单帧采集 $Pzvv`f*
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 |?s %8c'w=
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) `>?\MWyu
okCaptureTo hBoard, BUFFER, 0, 1 'single a: iIfdd4'
'Do While okGetCaptureStatus(hBoard, False) <> 0 ?8-e@/E#x
' Sleep 20 L45&O
*%
'Loop $MKx\qx}
okGetCaptureStatus hBoard, True WaWT
5|A
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize }n 6BI}n
'写入768*576测试图象 JQ+4 SomK
ArrayToBMP TmpBMP Xu3^tH-b<
jt"p Js'
'打开数据库 XT{1!I(
Set conn = New ADODB.Connection ETH`. ~
%
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ bsM`C]h&
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ?Y
) Qy,
"; Mode=Read|Write" aP8Im1<A
conn.Open Lr)h
>j6\
^>GL <1
1
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) `C=!8q
frmRecord.Visible = True m4 E 6L
frmQuery.Visible = True aC]~
Load frmReceiveFromComm ?P<&8eY
=)Ew6}
W6
'调试参数 5ez"B]&T
If InStr(UCase(Command()), "/CAPTURE") > 0 Then Vt
n$*ML
SignalBox.Visible = True !aa^kcEjnL
End If mt fDl;/D
If InStr(UCase(Command()), "/COMM") > 0 Then j0 =`Jf
frmReceiveFromComm.Visible = True |1g2\5Re
End If (oq(-Wv
)#ic"UtR
End Sub > m}.}g8
akm) X0!-}
Sub ExitGrabber() )K@ 20Q+0K
'关闭数据库 :b=`sUn<X+
'关闭采集卡 QlJ CdC Sy
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) bT[Q:#GL
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) n+zXt? {u
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) ;TmwIZ
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 5PKv@Mk
okStopCapture hBoard Zx}=c4I(y
okCloseBoard hBoard hx)Ed
CloseHandle hFile }-zx4<4BH
Close #hBCFile '9auQ(2
conn.Close w#Nn(!VR
End Ip8 Ap$
End Sub ~rpYZLH/:0
&_" 3~:N8k
Function ArrayToBMP(ByVal File As String) Q
;m
.m2
Dim BytesWrite As Long k49CS*I
&^9f)xb
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ WH bvb3'
CREATE_ALWAYS, 0&, 0&) FX}<F0([?
4 I:Jb;k>
If hTmpFile = 0 Then F`Q,pBl1p6
ArrayToBMP = False , >{4*PM(
Exit Function @=Ly#HuUM
End If 8C,?Ai<ro
En5Bsz !
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN <6dD{{J]>p
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& L2{to f
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN t~5>P
S
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& v
bb mmv
L4Nk+R;
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN S31 :}
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& ;a{ Dr
'G-VhvM v
If BytesWrite < pFrameSize Then &JfyXM[]
ArrayToBMP = False deHBY4@
End If Bq R ;d
^Xa-)Pu
CloseHandle hTmpFile Esw&ScBOP
hH"3 Y}U@
End Function U%gP2]t%cs
r+m8#uR
Function ArrayToBMP1(ByVal File As String) .4_ ~ku
w/YKWv{_ S
Dim BytesWrite As Long S`0@fieOf
2Q9s?C
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ &[ 3y_,
CREATE_ALWAYS, 0&, 0&) ,e.y4
vnU
bI]1!bi]i
If hTmpFile = 0 Then E'MMhl o
ArrayToBMP1 = False eDaVoc3
Exit Function 71 K6] ~<
End If \hi{r@k>}
$| (roC(
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN s4~c>voQB
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& M_9|YjwS
gP/]05$e
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN ik &lo M_
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& Oo7n_ h1
*ZN"+ wf\
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN @Z3b^G [
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& N1LR
_vS"
CXUNdB
If BytesWrite < pBufferSize Then kdxs {b"t
ArrayToBMP1 = False R#1m_6I
End If ZR..>=
gkBat(Uc
CloseHandle hTmpFile E8%O+x}
y;<jE.7>
End Function O,^,G<`
1-w1k ^e
'使用该过程建立的文件要求在用后关闭 ?)]sfJG
Public Function ArrayToBMP2(File As String) As Boolean
k9}im
=i:?4pIZ
Dim BytesWrite As Long +BzKO >
"DR p4;
ArrayToBMP2 = True !29
R
l`9
!vImmhI!I
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ )x(
*T
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) L?al2aopF
X+&@$v1
If hTmpFile = 0 Then i]Kq
ArrayToBMP2 = False _;'}P2&Q
Exit Function s Gdt)
End If -(:BkA
QZh8l-!#5
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN c
(\-7*En
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& ^gb2=gWZ<
<6(u%t0k5
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN _BR>- :Jr
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& &2QN^)q
|2n2
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN +pf 7
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& uO"@YX/
0Fbq/63
If BytesWrite < pFrameSize Then 3l4k2
ArrayToBMP2 = False kx'6FkZPIr
End If @Ki`g(],P
&p=
~=&g=
CloseHandle hTmpFile Gc@ENE f
bzUc;&WDz
End Function Bljh'Qp>C
^GRd;v =-@
Private Function TESTSignal() As Boolean T*YdGIFO
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long X-n'?=
VaX>tUW
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) X^aujK ^
@
W9eR3q
If extsign = 1 Then c!kbHZ<Z
TESTSignal = True &m Y<e4
Else L
Q;JtLu1
If extsign = 0 Then M.|hnGX N
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly f, ;sEV
TESTSignal = False <Xl G :nmY
Exit Function Ui? t@.
End If s[xdID^3.
End If !_x-aro3<
oxGOn('
'测试视频输入类型 ,{E'k+
'video type apw8wL2
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 ?5/Sa
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) oO= 6Kd+T
If videotype = 1 Then N4H nW0
'"隔行信号(Interlaced)" N18Zsdrp
Else (5Cm+Sy
If videotype = 0 Then U6M4}q(N]
'"逐行信号(Non-interlaced)" w7dG=a&
Else
4[Oy3.-c
If videotype = -1 Then #}k^g:l1
' "不支持" B'~.>, fg
End If *Ru
Uf
End If [$] JvF
End If D} 3E1`)W
t5 5k#`Z
'测试垂直扫描线数 R \`,Q'3
'video scanlines 8(g:i#~
scanlines = -1 0D.YO<PU
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) Dm4\Rl d{
If scanlines = -1 Then :UScbPG
' "不支持" JY
>]u*=
Else !sR`]0
'Trim(Str(ScanLines)) + " 行数/幅" JNMZn/
End If Dj<Vn%d*
@x{;a 9y
'测试帧频 @8/-^Rh*
'video field frequency u9VJ{ F
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) )0UQy
#r
If fieldfrq = -1 Then 66z1_ lA
'lblSignal(8) = "不支持" W }T+8+RU
Else z`
g R*+
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒"
Rl 6E
End If N'[^n,\( :
End Function DoImWNLo
ZYL]|/"J9
CZbp}:|
Sub PicIdentify() YpNTq_S1,
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 '9^x"U9c
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 bLf }U9
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 Dk[[f<H_{
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 2+ 9" >a@
vk[Km[(U'
Dim fPTR As Long, cFrame As Long U)c,ZxE
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer RJd55+h
jfgAI7;b
hg\$>W~ 2
cFrame = 0 y;Dw%m
JsiJ=zo<
q$H'u[KQ06
Do While cFrame < tFrames ?rr%uXQjH
le8n!Dk(
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) *!.'1J:YJ(
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) eb+[=nmP
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize ( c[|k
*4 r;H2%c
frmRecord.RText.Text = Str(cFrame) L*L3;y|
frmRecord.RText.Refresh \/lS!+~'']
t@!oc"z}@
If CheckMark = True Then 6'*?zZrz
ArrayToBMP TmpBMP iL5+Uf)E 3
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 1[B?nk
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" v)X1R/z5xw
.;$/nz6vk
DrawSlice &LYU#$sj
wAy;ZNu
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) uW
MAXGL
'If i = vbNo Then \9D
'7/$I,
' Exit Do b`%/ *
'End If se(_ `a/4Q
'cFrame = cFrame + 1 &WsDYov ?
*+
Q,b ^N
End If JO1c9NyKr
DoEvents Y{2\== ~
cFrame = cFrame + 1 gbKms ; :
Loop N Fc< %#H
End Sub #<!oA1MH4
2Uk$9s
9Y-s],2V
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean ZM4q@O) /
\Dr@n^hk@[
'如标志区模式反差存在则为TRUE，否则返回FALSE vw+
@'+
lm@<i4%$F
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long *[_?4*F
CheckMark = True FtY*I&
oOJN?97!k
'复制标志区 v( (fRX.`
For i = 1 To mkH SD JAk&Z}R
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW zFv>'1$
Next i 3 : );vh!
IURi90Ir
For j = 1 To PilarW * PilarH / 2 {mueP6Gz@J
mTop = mTop + MKpilar(j) h4.ZR={E
Next j [n66ZY#U]
N5oao'7|A
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH BIX%Bu0'f
mBot = mBot + MKpilar(j) 4 d6F4G4U
Next j qW7S<ouh
v\f 41M7D
mTop = mTop / PilarW / PilarH * 2 uZW1
:cx
mBot = mBot / PilarW / PilarH * 2 7G2TT a
WXXLD:gxI
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 +B*ygv:
(MbI8B>
'平均值极值化 a"hlPJlG
For j = 1 To PilarH * PilarW <PJwBA %{
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) tQUp1i{j\
Next j &a-:ZA@
P
VV \@
mTop = 0: mBot = 0 &HW%0lTs%
For j = 1 To PilarH * PilarW / 2 5v>( xl
mTop = mTop + MKpilar(j) [l'~>
Next j ,D~C40f
cV)C:!W2
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW =;c? 6{<1
mBot = mBot + MKpilar(j) VN;Sz,1Z
Next j
SRj|XCd
S{ J$ [!F
{$Fg+~
mTop = mTop / PilarH / PilarW * 3 )S>~ h;
mBot = mBot / PilarH / PilarW * 3 aA0aW=R
%.[GR
rX fQ_
If mBot > iWhite And mTop < iBlk Then O2A Z|[*I
CheckMark = True HtS:'~DYo
Else
+mV4Ty
CheckMark = False 3LX<&."z
End If 2<Ub[R
End Function I[&z#foN=w
uKtrG,/ p
Sub Capture1Frame() Q{mls
okCaptureTo hBoard, BUFFER, 0, 1 'single .F}ZP0THnZ
okGetCaptureStatus hBoard, True rWSw1(sAA
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize ~@L$}Eu
End Sub m"@M~~bh
QJ pUk%Wj
,/JrQWgD
Sub CopyMark(iBlk As Integer, iWhite As Integer) Dth<hS,2J
'复制标志区并返回标志区暗区与亮区的亮度平均值 `EV[uj&1S
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 b6oPnP_3P
o-7>^wV%BD
'复制标志区 N6yqA)z?;
For i = 1 To mkH
:E'38~
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 1>l {c
Next i 8M:;9a8fh
-zMXc"'C^k
For j = 1 To mkW * mkH / 2 !]5F2~"v
mTotal = mTotal + MKpilar(j) j s7J#b7
Next j jskAT A
/
9k2HP]8=[{
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 I)DLnnQQ
d) G7U$z~
mTotal = 0 &~ ^"yo#b
For j = mkW * mkH / 2 + 1 To mkW * mkH Z\O ,
9
mTotal = mTotal + MKpilar(j) )SUT+x(DU
Next j 0.|tKetHq
K3'`!K a*
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 [ #uX{!q'
RR^I*kRH
'背景亮度 (zye
Ch
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW .ay
K+6I
For i = 1 To 4 * FrameW Wu:vO2aw8
bsTotal = bsTotal + BsLine(i) Q_LPLmM
Next i 0>E cm#
bsAV = bsTotal / FrameW / 4 AUxLch+"5K
=^=9z'u"=
End Sub Alh%Z\
nM)
]
w.J2pvyB
Sub AdjIMGbright(Optional bInit As Boolean = True) 4d 9i AN
?$F:S %eH
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） `%F.]| Y0
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 $7M64K{
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 N$?mul a
t'0r4&\
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer <E6]8SQE
)#i]exZ
'按标准亮度与对比度采集一帧，确定背景亮度 ma?569Z8~0
currentContr = 128 '初始对比度 CI$F# j
currentBr = 128 '初始亮度 )N`ia%p_]
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 5GT,:0
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 -Qqb/y
DoEvents GeZwbJ/?B
Capture1Frame ~"br fjd|
'获得图像上缘4行象素 _W tSZmW?
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW LK/gG6n5M0
CopyMark iBlack, iBright '图像标志区亮度 )!p=0&z@{
For i = 1 To 4 * FrameW 4$d|}aj
H
bsTotal = bsTotal + BsLine(i) 5K{(V^8 8F
Next i 'Ys" yY@
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 rWi 9'
6
6"eGd
"
Select Case bsAV E{ Y0TZ+
Case 0 To 60 '夜间通过灯光照明,完全没有背景 =@ V4V} ?
currentBr = 150 $fuFx8`2W
currentContr = 60 B>#zrCD
Case 61 To 80 '有可见背景 t 3v*P6
currentBr = 140 fy9{W @E3p
currentContr = 70 x\ ;`x$3t
Case 81 To 100 '有清晰背景 w0tlF:Eg
currentBr = 128 qV8;;&8r
currentContr = 80 @wZ`;J %
Case 100 To 150 '有明亮背景 e +4p__TmZ
currentBr = 140 '5:30-6:00钟实测数据 xW n.vSos
currentContr = 50 @5Ril9J[b
Case 151 To 180 LQN u]2
currentBr = 130 @+B
.<@V
currentContr = 60 BalOph4M[
Case 181 To 220 '背景全为白色 `H ^Nc\P#
currentBr = 110 @QVAsN W:O
currentContr = 130 4D9l Za}
Case 221 To 255 '背景全为白色 m'oVqA&
currentBr = 100 ANp4yy+
currentContr = 100 3 +BPqhzf
End Select q.~.1
'`!
9j$
OU@N
8
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 8p> %}LX/
Case 100 To 150 Z(*n ZT,
currentBr = currentBr - 10 FhAuTZk
Case 151 To 255 !bT0kP$3}
currentBr = currentBr - 20 HSp*lHU
End Select 6DR@$fpt
]n\WCU ]0
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ,t61IU3"
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 (al 7/EhY
End Sub
`k _5Pz\
*Rr,ii
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) 9%kY8#%SV
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long
6bo ,x
{3`#? q^o'
For i = 1 To 8 ^*%p]r
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& nLQ
3s3@1>
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& m!N_TOl-^
Next i w *#TS8
\
f1hi\p0q
For j = 1 To 1024 9"_qa q
L1 = L1 + LeftBK(j, 0) xgsD<3
L2 = L2 + LeftBK(j, 1) N, ;'oL +
R1 = R1 + RightBK(j, 0) J0mY=vX
R2 = R2 + RightBK(j, 1) 6<sB
Next j fcD$km
diffL = Abs(L1 - L2) / 1024 /Eh\07p
diffR = Abs(R1 - R2) / 1024 >UWL T;N/W
End Sub (3c,;koRR
\*!g0C 8 o
Function CheckSlice() As Boolean =@ gH$Q_1
CopySlice avSL, avSLR, avSLL dSk\J[
D
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then :]=Y1*L\)
CheckSlice = True o9q%= /@,
Else 8X5;)h
CheckSlice = False qJ#?=
ITE
End If I2YQIY+
End Function zu^?9k
#
e+ % ;5\
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) >:X
zv
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long >xJt&jW-
For i = 1 To FrameH \QHe 0?6
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize !+9 H=u
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize cJj0`@0f
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 4x e:+sA.N
Next i i+Ob1B@w
For i = 1 To FrameH !ssE >bDa
For j = 1 To sSize Q*( ]&qr"E
total = total + Slice(j, i) CHN! o9f
totalL = totalL + SliceL(j, i) roj/GZAy"
totalR = totalR + SliceR(j, i) V |#B=W
Next j `k^
i#Nc>
Next i (RWZ [-;)
avSL = total / FrameH / sSize
7$,["cJX
avSLR = totalR / FrameH / sSize =lr*zeHLC
avSLL = totalL / FrameH / sSize DtXXfp@;
End Sub [UR+G8X21m
Uu>YE0/)
Sub DrawSlice() 5#$E4k:YV
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B CH`4FR.-
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B sjWhtd[fgG
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B nU)}!` E
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) V:Q fI
End Sub `lN1 u'(:
Sub DrawMark(pic As Control) qSkt
}F%'
Dim i As Long, j As Long 8[(c'rl|)|
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B i
Dp]l u
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B RvYew!n
For i = 1 To PilarH X[h=UlF
For j = 1 To PilarW "MM7qV
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) :
}UWy?F
Next j <u u1e@P
Next i \
$X3n\
End Sub x # BUIi
A{y3yH`#h
Function avIMG() As Integer s3/->1#i
Dim i As Long, j As Long, totalIMG As Long Ny\iRU)fN
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize
)&se/x+
For i = 1 To pFrameSize UyD=x(li
totalIMG = totalIMG + pBuffer(i) 57v[b- SK
Next i uC 5m xZ
avIMG = totalIMG / pFrameSize b;9v.MZ4>g
End Function ogip#$A}3
C.%iQ x`
Function avRegion(barCol As Integer, barWidth As Integer) As Integer .<rL2`C[c
Dim i As Long, j As Long, totalIMG As Long @UkcvhH
For i = 1 To FrameH tojJQ6;J
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth scJ`oc: <J
Next i PPPRO.y
For i = 1 To FrameH * barWidth >F Z 6\
totalIMG = totalIMG + pBuffer(i) L 4
x
Next i AG/nX?u7)t
avRegion = totalIMG / pFrameSize 5 (2g*I
End Function ]rZ"5y
