这才是我当年写出的一个比较烂的程序 Ix(4<s
[w{ZP4d>
Main2.bas F n[~5/
wSAm[.1i
Attribute VB_Name = "SubMain" s &.Z;X
Option Explicit |HG%o
3E]
qL'3MY.!
'采集文件与临时文件 e<p$Op
Public Const TmpFile As String = "d:\30-0600.dat" ux =a9
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 I?fE=2}9
PN.6BJvu
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long 8vT:icl
Public hBCFile As Long '记录采集参数的文件 &
1Y+ q]
Public Const TmpBMP As String = "d:\1.bmp" A%GJ|h ,i
Public hTmpFile As Long BKD Wd]KEf
#5H@/o8!s=
Z(<ul<?r
'采集窗口参数常量 RtIc:ym
Public Const FrameH As Long = 280& vaQ,l6z
.h
Public Const FrameW As Long = 768& ze 4/XR
Public Const pFrameSize As Long = FrameW * FrameH {>+$u"*
+?.,pq n<=
'标志区范围，用于识别车辆 26Yg?:kP
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X PN'8"8`{
Public Const mkW As Integer = 28 '识别标志立柱宽度 md ZEL Ru
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) } 2\"(_
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) "q(&<+D@
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 B "qG-ci
'车缝检测位置常数 <=zGaU,
Public Const sSize As Long = 32& {'b8;x8h
Public Const sPos As Long = 310& ?DRC!
9o^
Public Const sPosL As Long = 200& 0)P18n"$
Public Const sPosR As Long = 500& t&&OhH K
'车缝检测框位置 > N,G@{FR
Public Slice(1 To sSize, 1 To FrameH) As Byte ':>B %k
Public SliceL(1 To sSize, 1 To FrameH) As Byte %]R#}amW
Public SliceR(1 To sSize, 1 To FrameH) As Byte #ERn 8k
Public avSL As Integer, avSLR As Integer, avSLL As Integer xJ"KR:CD>
P\M+Z A ;
Ja (/ym^
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 cYp}$
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 ALw uw^+
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 .H>Rqikj
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long )`Fr*H3{
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte ~'U;).C
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 q6ikJ8E8b
JNu - z:J
<]9Mg fAe
5sE^M S1
'一次连续采集的帧数 Gg!))I+
Public tFrames As Long !e7vc[N
fg1y@Dj/&
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 sbs"26IE
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 )F~_KD)7jJ
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize c8'8DM
3jI.!xD`
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte jqLyX
Public pBuffer(1 To FrameW * FrameH * 2) As Byte NRl"!FSD;"
Public pWorkSpace(1 To FrameW * FrameH) As Long }UO,R ~q~
Public Const pBufferSize As Long = FrameW * FrameH * 2 +p[~hM6?
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 ^s?
wnEo;j
<N*>9S,}
Public hBoard As Long '采集卡标识 ko:I.6- K
Public mBufferAddr As Long '缓存地址 tS9m8(Hr%Q
Public BufferSize As Long '缓存大小(字节) s{IoL_PJP
Public iCurrentCard As Long n;=A'g|Q
Public CapStatus As Long H,I }R
Public iFrames As Long bo*q{@Ue
Public currentBr As Byte, currentContr As Byte x:bYd\
EJ[
k N^)6
Public hMEM As Long, mStatus As Long 9F-k:hD |
Public Const hMemSize As Long = pFrameSize * 4 :
1{j& $
Public hMemWork As Long h4 9Q2`
Public Const hMemWorkSize As Long = pFrameSize * 5 ;?[~] "
$e_ ps~{7$
Q?tV:jogY
5{5A BV
'串口接收轨道衡数据 g|zK%tR_P
Public WeightFromCom As String %*gO<U4L]
Public bReceiveComplete As Boolean e56#Qb@$\
#<~f~{x
j~{2fd<>
Public Type GrayBMPHeader XgbGC*dQ
Tag As Integer U=t'>;(g
FileLength As Long '文件大小 \% C[l
Reserve1 As Long
RasoO
j$
DataOffset As Long '图像数据偏移量 5^Y/RS i
BMPHeaderSize As Long '文件头长 4tC_W!?$t
'length of the bitmap info header used to describe the bitmap colors, compression,… MCCZh{uo
'the following sizes are possible: NV gLq@F
'28h - windows 3.1x, 95, nt, … x3P@AC$\
'0ch - os/2 1.x };j&)M
'f0h - os/2 2.x g\l;>
L!p|RKz9X
ImageWidth As Long '图像宽（像素数） *Q>:|F[vM
ImageHeight As Long '图像高(像素数) |-mazv A
PlaneNumber As Integer '图像层数 joA+
bpp As Integer 'bits per pixels '1 - monochrome bitmap LBE ".+
'4 - 16 color bitmap #.><A8J
'8 - 256 color bitmap <2 Q@ ^
'16 - 16bit (high color) bitmap Om^ /tp\
'24 - 24bit (true color) bitmap <oO,
CXF
'32 - 32bit (true color) bitmap "h2Ny#
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) S?{5DxilO
'1 - rle 8-bit / pixel (also identified by bi_rle4) 7X|r';"?i
'2 - rle 4-bit / pixel (also identified by bi_rle8) ;FmSL
#]I
'3 - bitfields (also identified by bi_bitfields) H94.E|Q\+
IMAGESIZE As Long '图像数据字节数 n~ql]Ln
hResolution As Long '水平分辩率 像素数/米 5;{Bdvcv
vResolution As Long '垂直分辩率
> o b /@
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 &8pXkD#A
ImportantColors As Long Z~ uKT n
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 J
v#^GNm
End Type @(
t:E`8
/OP*ARoC21
8F *
WT|]
yRYWx` G
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader J4vKfxEg
Public sRECT As RECT 4yA`);r62
j[fQs,efK
c| R/,
/
Public conn As ADODB.Connection V!P3CNK
Public rsTrain As ADODB.Recordset e !yw"Cf*
Public rsOperater As ADODB.Recordset 9PJDT]
Public rsGoods As ADODB.Recordset
=l(JJ
Public rsGood2 As ADODB.Recordset |z'?3
?, ~
Public rsSender As ADODB.Recordset /kz&9FM
Public rsReceover As ADODB.Recordset 6ZR0_v;TD
Public rsTrainTMP As ADODB.Recordset R]Oy4U,f
_E;Y
~I,i
Ig<p(G.;}
'打开采集卡 v2{O67j}
o
'设置参数 !7
oy%{L
'设置为实时单帧采集到缓存方式
@NIypi$T
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 [FL I+;gY
s
V<4 ^n7
8x" d/D
Sub Main() Fjzk;o
Dim i As Integer, status As Long W,~1 KUTc
FT;JYkO
InitBMPinfo gp HwiFc
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 b8>9mKs
BMPHeader.Tag = &H4D42 dO[4}FZ$
BMPHeader.ImageWidth = FrameW Dkb&/k:)
BMPHeader.ImageHeight = FrameH
u\xm8}A
BMPHeader.BMPHeaderSize = &H28 @QG1\W'
BMPHeader.PlaneNumber = 1 w#T , g9
BMPHeader.bpp = 8 S:YL<_oI|
BMPHeader.Compression = 0 j 7 URg>i0
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 nrIL_
BMPHeader.vResolution = &H1274 _);Kb/
BMPHeader.ColorsinBMP = 256 F4Uk+|]Bu
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP 50&F#v%YB
BMPHeader.DataOffset = Len(BMPHeader) J7GsNFL
For i = 0 To 255 G U3
/s&9
BMPHeader.Pallate(i) = RGB(i, i, i) $at|1+bQ
Next i 5B 7*Z
BMPHeader.IMAGESIZE = FrameH * FrameW 'EV *-_k
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE \DqxS=o;
,7P^]V1
CiI:
uU
MoveMemory BMP1, BMPHeader, Len(BMPHeader) lc-|Q#$3$
\2pFFVT
BMP1.ImageWidth = FrameW .@Uz/j?>
BMP1.ImageHeight = FrameH * 2 E<uOk
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight _|ib@Xbin
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE 2-0cB$W+
kDq%Y[6Z
'确定标志位置,为pilarX, pilarY确定初始值 8~E)gV+v
PilarW = mkW Aa>gN
PilarH = mkH '此两项为固定值 c0&'rxi( B
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) Hz8`)cv`
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 $0}bi :7
m;f?}z_\$
n *~
'连续采集记录文件 14!J\`r I
' 建立一个缓冲区为页对齐方式的文件 qJU )d
If Dir(TmpFile) <> "" Then "6yiQ\`J
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ +
nS/jW
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) # &83;uys
' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 ~C /KA6H
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 Q
~JKKq
Else
4P!DrOB
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ g i'agB^
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) Fz&i
lB
End If .4> s2
If hFile = 0 Then <UJJ],)^1A
MsgBox TmpFile & ": File Open Error", vbOKOnly o2 d ~
Exit Sub |"qB2.[
End If JF%=Bc $C
'采集参数记录文件 #@^w>D6W
hBCFile = FreeFile() (Fzh1#
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile ,,@`l\Pgd
)V3(nZY
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 Xp6*Y1Y
If hMEM = 0 Then cl{W]4*
$
fStatus = GetLastError ':D&c
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ oh~
vo !
& "请向技术人员报告该错误代码。", vbOKOnly ==1/N{{R
CloseHandle hFile /dt!J
`:
Exit Sub I&8SP$S>J
End If VtiqAh}4
|o
zoc"'
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) ;J-Ogt @d7
If hMemWork = 0 Then WG
!t!1p
fStatus = GetLastError WgJAr73
l
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ `?^w
& "请向技术人员报告该错误代码。", vbOKOnly @
z)tC@
'释放已成功分配的内存 8 QF?W{NK
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) jHlOP,kc
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Treh { s
"jO3Y/>S
CloseHandle hFile q YZ7Zt;
Exit Sub ,'CWt]OS'
End If sLdUrD%
w"agn}CK
' Test writing |.O!zRm
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0&
M#]|$\v(
~e77w\Q0
'初始化采集卡参数 n/oipiYx
iCurrentCard = -1 !u4Z0 !Ll
hBoard = okOpenBoard(iCurrentCard) ll\^9
4]Q
Debug.Print hBoard |$w={N^ 4
If hBoard = 0 Then z-G7 Y#
ExitGrabber xeM':hD.o
End ?vn 0%e868
End If ]H#Rm#q
okGetBufferSize hBoard, mBufferAddr, BufferSize |4. o$*0Y
If mBufferAddr = 0 Then |vN@2h(|"
MsgBox "缓存不存在！" Q\#{2!I
ExitGrabber t"/"Ge# a
End If ef}E.Bl
Debug.Print Hex(mBufferAddr), Hex(BufferSize) b+].Uc
<ytKf<a%e
eM=) >zl
currentBr = 128: currentContr = 128 >Y-TwD aE
'设置视频输入参数 =+}}Sv2
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 #r.` V!=
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input D4Y!,7WEVt
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 8V|jL?a~
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 k> & s( b
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 _ :X|R#d
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 DJYXC,r
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） 8;g. 3Qv
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) (1AA;)`Kp
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) I4
9l2>
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 $dTf vd
9LO.8Jy
'设置采集参数 ;%7XU~<a
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 o1X/<.0+
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 xSDE6]
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 &1 E~ \8U
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 _8b]o~[Z+
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 zLw h6^?Y
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 NQ!N"C3u
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 ux C
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 j(6$7+2qN
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 ccn`f]5w
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 e*2&s5 #RT
'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 ;5 Vk01R
m>+,^`0
B_"OA3d_
okCloseBoard hBoard M&djw `B
Sleep 50 \W`} L
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 4ZJT[zi
2Cd
--W+=
'设置数据传送方式 9MB\z"b?A
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 > }DjHLTW\
'该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 ?FV7|)f
rw8J:?0x
sRECT.Right = -1 '用于获得当前设置值 N _~KZQ11^
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) R_>TEYZ
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom pO/SV6N
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 0^y@p&;/.
sRECT.Left = 0 cxD}t'T
sRECT.Top = 0 x1:Pj
sRECT.Right = sRECT.Left + FrameW L);||]B
sRECT.Bottom = sRECT.Top + FrameH * 2 `}9 1S
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) r($_>TS&"
o%+A<Ri
sRECT.Right = -1 '检查新设置值 w
<#*O:
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) hGA!1a4 c
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom
sO6g IPU^
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) K\K O5A
}.MoDR3\
If TESTSignal = False Then M
e I 2i
'ExitGrabber @ojg`!,
End If P10p<@?
2&gVZ z
%kZ~xbY
tC?A so
'设为实时采集状态 p_5>?[TW:
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) sh
!~T<yy
I#S~
!
[|vx!p
'单帧采集 O~#uQm
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 762o~vY6$
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) i VKbGgA
okCaptureTo hBoard, BUFFER, 0, 1 'single ~w
1{ zxs
'Do While okGetCaptureStatus(hBoard, False) <> 0 %< wQ
' Sleep 20 *{.&R9#7U'
'Loop ^%oG8z,L
okGetCaptureStatus hBoard, True ^\ vfos
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize W7*_ T]
'写入768*576测试图象 +f\pk \Ith
ArrayToBMP TmpBMP BK(pJNBh
%on9C`/
'打开数据库 DO1 JPeIi
Set conn = New ADODB.Connection /m
Q2;*|
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ HTDyuq s
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ yL ;o{
G
"; Mode=Read|Write" jA-5X?!In
conn.Open 6)#- 5m
iM /*&O}
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) \za5:?[xB
frmRecord.Visible = True q: Bt]2x
frmQuery.Visible = True g]Xzio& w
Load frmReceiveFromComm MJ>Qq[0
E+m]aYu"
'调试参数 P 34LV+e
If InStr(UCase(Command()), "/CAPTURE") > 0 Then I|F~HUzA"
SignalBox.Visible = True ^p"4)6p-W
End If _b!;(~ @p
If InStr(UCase(Command()), "/COMM") > 0 Then q!hy;K`Jd
frmReceiveFromComm.Visible = True uP%axys
End If n b0 Py>4
v ?Yd LR
End Sub y \)G7
(
+ q
#Xy0u
Sub ExitGrabber() eg$5z
Z
'关闭数据库 Bb l)3$`,
'关闭采集卡 "rjv5*z^&
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 6+Wr6'kuH
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) m~Y'$3w
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) ol?z<53X]
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) R0Ax$Cv {
okStopCapture hBoard l&6U|q`
okCloseBoard hBoard Sv7>IVC?@
CloseHandle hFile .#= j
<&
Close #hBCFile {
DEz uU
conn.Close iHE0N6%q
End FVsu8z u
End Sub *R_' $+
BrNG%%n
Function ArrayToBMP(ByVal File As String) *Z]5!$UpC
Dim BytesWrite As Long
z"6ZDC6
FXOT+ 9bg
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ nr<WO~Xw~
CREATE_ALWAYS, 0&, 0&) Gut J_2f^9
W(uP`M%][0
If hTmpFile = 0 Then Y7*(_P3/
ArrayToBMP = False _.d}lK3$2
Exit Function $[M} K
End If O)R 7t3t
(30<oE{
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 4
V u'r?
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& >/TB_ykb
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN ,bZ"8Z"lss
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& L.09\1?.n
=2RhPD
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN |D;_:x9
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& zG-_!FIn
).0V%}>
If BytesWrite < pFrameSize Then $6:XsrV\a
ArrayToBMP = False ="3a%\
End If /S7+B ]
WFU?o[k-O
CloseHandle hTmpFile |5 oKq'(b
gd
oJ4b
End Function z:Xj_ `p
QL) >/%yU
Function ArrayToBMP1(ByVal File As String) #&^ZQs<
Z?~gQ
$
Dim BytesWrite As Long F=oHl@
|8&-66pX
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ~vW)1Xn K
CREATE_ALWAYS, 0&, 0&) M1AZ}b c0]
Lnh':7FQJx
If hTmpFile = 0 Then
>]Mq)V9
ArrayToBMP1 = False -`zG_]=-
Exit Function S2J#b" Y
End If $ZQl IJZ
Tjnt(5
g
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN OW+ e_im}
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& 8- dRdQu
]
./ "mn3U
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN P] pmt1a
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& Bii6Z@kS
D^66 p8t
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN E$]a?uA:
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& /]ku$.mr
\
Sk8%(JD7
If BytesWrite < pBufferSize Then b@=z rhQ
ArrayToBMP1 = False y#]}5gJ
End If u^`eKak"l
V/aQ *V{
CloseHandle hTmpFile Xtci0eS#V
R&6n?g6@/V
End Function y#b;uDY
Ms.PO{wb
'使用该过程建立的文件要求在用后关闭 wzD\8_;6N
Public Function ArrayToBMP2(File As String) As Boolean b%Wd<N2
zc6H o
Dim BytesWrite As Long 9 ' 2 =
5a=nF9/
ArrayToBMP2 = True VDB$"T9#
jA4PDH f+
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ wXc,F D$
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) OOCQsoN
f !5F]qP>-
If hTmpFile = 0 Then )-0[ra]
ArrayToBMP2 = False Q,zC_
Exit Function 7d3 'CQQ4
End If ' 2>l
y._'K+nl
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN > ?S\ ~Y
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& yJnPD/i
rs[?v*R74
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN = y?#^
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& :&Qb>PH[
_F
L<egK
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN &g*klt'B
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& |if '_x1V
.D+RLO z
If BytesWrite < pFrameSize Then V-[2j
C{
ArrayToBMP2 = False WI,40&<
End If Jz
k!K@
;LHDh_.pX
CloseHandle hTmpFile uVN. =
?V#G x> \
End Function VVs{l\$=ZV
4Z*|Dsw
Private Function TESTSignal() As Boolean Hab!qWK`
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long 48wDf_<f5=
)yHJ[
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) 66oK3%
[
j.
_G7z/LJ
If extsign = 1 Then M[A-1]'
TESTSignal = True
{J{1`@
Else |}Q( F+cL
If extsign = 0 Then 3"5.eZSOW
MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly :FnOS<_B
TESTSignal = False W&<g} N+
Exit Function 6H0W`S0a
End If 2bWUa~%B
End If Gu2_dT
ppEJs
'测试视频输入类型 T'hml
'video type V?=TVI*k
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 5!<o-{J[(=
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) 8| w-XR
If videotype = 1 Then K6E}";;
'"隔行信号(Interlaced)" %>i@F =O2<
Else hQJo ~'W=
If videotype = 0 Then rqF"QU= l
'"逐行信号(Non-interlaced)"
/v5qyR7an
Else (G#} *
If videotype = -1 Then d& hD[v
' "不支持" I C k(z~D~
End If f7Yz>To
End If .
=&Jo9
End If -<6v:Z
pP3U, n
'测试垂直扫描线数 !&W|myN
^
'video scanlines ,NDh@VYe
scanlines = -1 3a'q`.L
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) |Z
d]= tue
If scanlines = -1 Then >b'w'"
' "不支持" ~u! gUJ:
Else m)r]F#@/
'Trim(Str(ScanLines)) + " 行数/幅" @\ }sb]
End If Z )NrhJC
QW2?n`Fa9-
'测试帧频 X&s7% ]n
+
'video field frequency P2On k l
fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) ; VBpp<
If fieldfrq = -1 Then 4K E)g
'lblSignal(8) = "不支持" T e+^J 8
Else U M@naU
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" ?gLAW z
End If }f0u5:;Zth
End Function zyDZ$Dhka
[G\o+D?2
q'.;W@m
Sub PicIdentify() G[#.mD{k
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 jA,|JgN|n
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ;J 'OakeVO
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 sv'
Gt1&"Z
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 )L b72;!?
?!H)zz6y
Dim fPTR As Long, cFrame As Long .?f :Nb.O
Dim i As Long, j As Integer, pTotal As Long, pAV As Integer w$b~x4y%
J2'K?|,m
}S,-uggz
cFrame = 0 a
RX
NS Np
~ ^x-ym5
Do While cFrame < tFrames )6G
" *
b7!UZu]IEv
fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) B3Mx,uXT\
fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) y5_XHi@u~o
MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize Z9xR
[g +y_@9s
frmRecord.RText.Text = Str(cFrame) 7gm:ZS
frmRecord.RText.Refresh P])L8zK
x:qr \Rz
If CheckMark = True Then ' X}7 ]y
ArrayToBMP TmpBMP +lKrj\Xj
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) AQe !Sqg'
frmRecord.RText.Text = "第" & Str(cFrame) & "帧" qp\BV #E
XoJgs$3B
DrawSlice %lV@ :"G
/tP7uVL
R
'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) rhIGOk1k
'If i = vbNo Then gGmxx,i
' Exit Do WV2~(/hX&
'End If Wk}D]o0^@
'cFrame = cFrame + 1 C%]."R cMC
_#FIay\ahB
End If p'80d:
DoEvents d5:tSO
cFrame = cFrame + 1 dhW<p 5
Loop !_dR'
End Sub (`pNXQ0n
Ra0=q4vdk
*2=W5LaK.
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean Jh?z=JY
|YRY!V_w
'如标志区模式反差存在则为TRUE，否则返回FALSE izf~w^/
fe';b[q)#
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long 3%2jwR
CheckMark = True SF^x=[ir
.EG* + ,
'复制标志区 /$Z
m~Mp
For i = 1 To mkH H UkerV
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 2 h< U
Next i p qeL%="p;
{y b D
For j = 1 To PilarW * PilarH / 2 U. (Tl>K|0
mTop = mTop + MKpilar(j) <5I1 DF[
Next j Mn@$;\:
UWw}!1
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH tO M(U-7Z&
mBot = mBot + MKpilar(j) <BP RV> 0X
Next j H}
6CKP}
(f~gEKcB2u
mTop = mTop / PilarW / PilarH * 2 Oqmg;\pm
mBot = mBot / PilarW / PilarH * 2
/W`$yM3
/[iG5~G
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 d&u 7]<yDA
E=k w)<X2
'平均值极值化 G'9{a'
For j = 1 To PilarH * PilarW -w ~(3(
MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) (z2Z)_6L*L
Next j (]XbP
W
{i>Jfl]G}
mTop = 0: mBot = 0 +zsZNJ(U
For j = 1 To PilarH * PilarW / 2 87<9V.s 2
mTop = mTop + MKpilar(j) _ 88QgThb
Next j Gqt-_gga
+#s
;yc#=2
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW !}
5*?k
g
mBot = mBot + MKpilar(j) 1ef'7a7e8
Next j 4uUs7T
5B{k \H;
f05=Mc&)
mTop = mTop / PilarH / PilarW * 3 3 Z1OX]R
mBot = mBot / PilarH / PilarW * 3 /EU ;
?O
-`Q}t g>cT
J$QBI&D
If mBot > iWhite And mTop < iBlk Then 7)J6/('
CheckMark = True HIGNRm
Else vbp-`M(
CheckMark = False 9 mPIykAj8
End If 'gDe3@ci!
End Function l E^*t`+
j{;|g%5t
Sub Capture1Frame() <0 uOq
okCaptureTo hBoard, BUFFER, 0, 1 'single U^rm: *f
okGetCaptureStatus hBoard, True 9U^$.Lb
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize vCb]%sd-U
End Sub ax_YKJ5#P
$KX[Zu%
c
0-w6
Sub CopyMark(iBlk As Integer, iWhite As Integer) 8;#AO8+U7)
'复制标志区并返回标志区暗区与亮区的亮度平均值 ?'sXgo.}
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 XsUUJu CG
rN" Xz
'复制标志区 mM5|K@0|
For i = 1 To mkH 9!}q {2j
MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW *d>vR 1
Next i Z>2]Xx%
\
ErDL^M- `
For j = 1 To mkW * mkH / 2 ]*;F. p Z
mTotal = mTotal + MKpilar(j) @Tr&`Hi
Next j @]=f?+y[ 2
[N:BM% FQ
iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度 T4
r5s
ZXt?[L
l
mTotal = 0 iCrxV{
For j = mkW * mkH / 2 + 1 To mkW * mkH ~+HoSX u@E
mTotal = mTotal + MKpilar(j) @o#+5P
Next j ~;unpy m'
Jq
.L:>x
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 kXwi{P3D$
`c(\i$1JY)
'背景亮度 :<GfET Is
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW %8w 9E=
For i = 1 To 4 * FrameW AIh*1>2Xn
bsTotal = bsTotal + BsLine(i) WeC(w+}p
Next i M&y5AB 0
bsAV = bsTotal / FrameW / 4 1,`H:%z%
: #$F)]y'\
End Sub hD
q2-X}
k)":v3 ^
<MdGe1n
Sub AdjIMGbright(Optional bInit As Boolean = True) :c7CiP
`f)(Y1%.
'自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） ((|IS[
'图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 ntGq"
o
' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 3t aa^e.
ZJ(rG((!
Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer F P@qh
tg 85:
'按标准亮度与对比度采集一帧，确定背景亮度 O?ktWHUx
currentContr = 128 '初始对比度 .X
`C^z]+
currentBr = 128 '初始亮度 ~Hmx Ek9
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 m<: IFx#
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 YH\j
@ ^n
DoEvents [U.v:tR
Capture1Frame PZ,z15PG]
'获得图像上缘4行象素 jPk
c3dG
+
MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
9?EV Q
CopyMark iBlack, iBright '图像标志区亮度 P`TIaP9%E
For i = 1 To 4 * FrameW _]| Qec)
bsTotal = bsTotal + BsLine(i) J :S'uxM
Next i =_PvrB 2'
bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度 -(IC~
PAZ$_eSK6
Select Case bsAV =g~j=v ,e
Case 0 To 60 '夜间通过灯光照明,完全没有背景 S&?7K-F>_o
currentBr = 150 XP?*=
Z]
currentContr = 60 |0
!I5|<k
Case 61 To 80 '有可见背景 l6 7KJ
currentBr = 140 v <H b-~
currentContr = 70 |RhM| i
Case 81 To 100 '有清晰背景 S LGW:
currentBr = 128 6E|
S
currentContr = 80 \[#t<dD
Case 100 To 150 '有明亮背景 ."mlSW
"Wm
currentBr = 140 '5:30-6:00钟实测数据 _%Z P{5D>
currentContr = 50 fbC~WV#
Case 151 To 180 vM4<d>
currentBr = 130 q*8lnk
currentContr = 60 .Yx_:h=u
Case 181 To 220 '背景全为白色 f=aIXhiYU
currentBr = 110 kNPDm6m
currentContr = 130 6y
Wc1
Case 221 To 255 '背景全为白色 ;%zC@a~{
currentBr = 100 n &} s-`D
currentContr = 100 {TAw)!R
~
End Select gyu6YD8L
1R*=.i%W
Select Case (iBlack + iBright) / 2 '图像反射光强度修正 r]LCv sVa
Case 100 To 150 'jvp Nn
currentBr = currentBr - 10 Hk;-5A|9
Case 151 To 255 2o5;Uz1{
currentBr = currentBr - 20 #w> ~u2W
End Select n?E}b$6
)q3"t2-
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 CWlW/>yF
B
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 $|a;~m>
End Sub |LmSWy*7
L"vj0@n'0
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) G7-!`-Nk
Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long S "
pI
P`"mM?
u
For i = 1 To 8 "C74
MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& 9 y~ "|t
MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& ]ii+S"U3
Next i v0@) t&O
z%: )
For j = 1 To 1024 WRp yr
L1 = L1 + LeftBK(j, 0) [uR/ M
L2 = L2 + LeftBK(j, 1) '4u v3)P
R1 = R1 + RightBK(j, 0) ?C Y1]d
R2 = R2 + RightBK(j, 1) pn\V +Rg'
Next j 8eyl,W=dn
diffL = Abs(L1 - L2) / 1024 G/{
~_&t
diffR = Abs(R1 - R2) / 1024 u^4h&fL
End Sub kMxjS^fr
V'StvU
Function CheckSlice() As Boolean 'M/ ([|@
CopySlice avSL, avSLR, avSLL ^Mytp> 7
If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then M"wue*&
CheckSlice = True lf$Ve
Else >eS$
CheckSlice = False n
vyB/
End If 9lspo~M
End Function MFwO9"<A
6E^~n
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) i@ zY9,b
Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long y=H@6$2EQ
For i = 1 To FrameH [,g~m9
MoveMemory Slice(1, i), pFRAME(sPos, i), sSize Q"VMNvKYB
MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize &mkpJF/
MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize _H\<[-l
Next i Z8&' f,
For i = 1 To FrameH Cs1>bpY*R6
For j = 1 To sSize ctJ&URCi#
total = total + Slice(j, i) YYUe)j{T
totalL = totalL + SliceL(j, i) ai ^|N.!
totalR = totalR + SliceR(j, i) <z) E (J\
Next j 213\ehhG<
Next i g}Q x`65:
avSL = total / FrameH / sSize G r)-5qh
avSLR = totalR / FrameH / sSize \Tm}mAvK/o
avSLL = totalL / FrameH / sSize {THqz$KN
End Sub m{(+ 6-8|m
&s
VadOBQ
Sub DrawSlice() GAl+ Zg##
frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B K
,isjh2
frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B rK|*hcy
frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B .\)A@ua^
frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) :6P ad
End Sub 7 NF/]y4w
Sub DrawMark(pic As Control) 9UD
@MA
Dim i As Long, j As Long ~&g a1r2v?
pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B L`3n2DEBf
pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B C1fyV]
For i = 1 To PilarH )2.)3w1_4
For j = 1 To PilarW O# _x)13
pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) ^^}Hs-{ T
Next j Kf.T\V4%
Next i EUcKN1
End Sub -[]';f4]M
{9'M0=
Function avIMG() As Integer Jqfm@Y
Dim i As Long, j As Long, totalIMG As Long qnIew ?-*
MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize ]P1YHw9
For i = 1 To pFrameSize &u8z5pls8
totalIMG = totalIMG + pBuffer(i) oNYZIk:
Next i 'uC59X4l
avIMG = totalIMG / pFrameSize o4Q3<T7nI
End Function `s /?b|,
>i~^TY-&
Function avRegion(barCol As Integer, barWidth As Integer) As Integer 9l
!S9d
Dim i As Long, j As Long, totalIMG As Long K=\&+at1
For i = 1 To FrameH (:sZ
b?*
MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth .j?kEN?w
Next i }[n5n
For i = 1 To FrameH * barWidth m#H_*L0
totalIMG = totalIMG + pBuffer(i) QK <\kVZ8
Next i AH d-
avRegion = totalIMG / pFrameSize tZ 8 e`r*
End Function I>n
g`
