这才是我当年写出的一个比较烂的程序
w=b (X
q+: XAOak$(j Main2.bas
) |#%Czd4 |01? w | Attribute VB_Name = "SubMain"
I?!rOU= 0
Option Explicit
JN3cg
,5k-.Md>2* '采集文件与临时文件
D@YP7 Public Const TmpFile As String = "d:\30-0600.dat"
N]/!mo? '已有数据：30-0600.dat /30日早6点进车与6：30出车头
y>VcgLIB 3NK ^AaTK Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long
@]CF&: P A Public hBCFile As Long '记录采集参数的文件
i^z`"3#LE Public Const TmpBMP As String = "d:\1.bmp"
< a rZbM Public hTmpFile As Long
Eh8Pwt7C@ eH>#6R1- mPZG A\ '采集窗口参数常量
f?fKhu2 Public Const FrameH As Long = 280&
[G|mY6F ^ Public Const FrameW As Long = 768&
JHV)ZOO Public Const pFrameSize As Long = FrameW * FrameH
,lN5,zI=S P<dy3 ; '标志区范围，用于识别车辆
CX/ (o] Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X
]L_w$ev' Public Const mkW As Integer = 28 '识别标志立柱宽度
;I6s-moq_ Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白)
0`#(Toe{B Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白)
MEZ{j%-a Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标
Y0uvT7+[hi '车缝检测位置常数
'w/qcD- Public Const sSize As Long = 32&
XH 4d<?qu Public Const sPos As Long = 310&
[ .
yJV` Public Const sPosL As Long = 200&
PK6iY7Qp) Public Const sPosR As Long = 500&
%B2XznZ: '车缝检测框位置
?^ !,vh
Public Slice(1 To sSize, 1 To FrameH) As Byte
=J 'P. Public SliceL(1 To sSize, 1 To FrameH) As Byte
X~T/qFS Public SliceR(1 To sSize, 1 To FrameH) As Byte
JyBp-ii Public avSL As Integer, avSLR As Integer, avSLL As Integer
pJpNO$$w TvhJVVQ+? [`fI:ao| Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化
Q% ad q-B '该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别
h,t|V}Wb Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围
Xh3; Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long
,i}|5ozj4 Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte
(-yl|NFBw '前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向
70 W"G
X& 6o&ZIY J9k ,32xcj}j)r H -t|i '一次连续采集的帧数
0NE{8O0;Fr Public tFrames As Long
{[G`Z9]z&- pgc3j
P! '在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据
dz9Y}\2tf '而该卡的硬件设置是按场采集，只需要读第一场的数据即可。
O_,O,1 '所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize
%n?vJ#aX% E$\~lcq Public pFRAME(1 To FrameW, 1 To FrameH) As Byte
~4 #B'Gy[ Public pBuffer(1 To FrameW * FrameH * 2) As Byte
f_mhD dq Public pWorkSpace(1 To FrameW * FrameH) As Long
'"YYj$>
' Public Const pBufferSize As Long = FrameW * FrameH * 2
&k>aP 0k" Public pGray(0 To 255) As Long '整幅图像的灰度直方图
n~0z_;5 ?H|T& 6 6 Public hBoard As Long '采集卡标识
F#r#}.B='U Public mBufferAddr As Long '缓存地址
2OBfHO ~D Public BufferSize As Long '缓存大小(字节)
Rs;15@t@ Public iCurrentCard As Long
XJ\hd, R Public CapStatus As Long
eb:A 1f4L Public iFrames As Long
W.}]
.7}h Public currentBr As Byte, currentContr As Byte
!AHAS {eZ{] Public hMEM As Long, mStatus As Long
LgqGVh3\s Public Const hMemSize As Long = pFrameSize * 4
:J_oj:0r"f Public hMemWork As Long
B&KL2&Z~Pq Public Const hMemWorkSize As Long = pFrameSize * 5
7ET jn)%bs
)$M, Ul GlYly5F l[h'6+o '串口接收轨道衡数据
j+ ::y) $ Public WeightFromCom As String
nS.G~c| Public bReceiveComplete As Boolean
r#876.JK n2-0.
Er Z| 6{T Public Type GrayBMPHeader
`^F: - Tag As Integer
D@54QJ< FileLength As Long '文件大小
!XE aF]8 Reserve1 As Long
dbGg
D=}o DataOffset As Long '图像数据偏移量
%CH 6lY=lI BMPHeaderSize As Long '文件头长
sa-9$},z4 'length of the bitmap info header used to describe the bitmap colors, compression,…
$g8}^1 'the following sizes are possible:
Q\_{d0
0 '28h - windows 3.1x, 95, nt, …
A *]$v '0ch - os/2 1.x
5 9 2;W-y 'f0h - os/2 2.x
|Ur"za;%@ fv'4f$U ImageWidth As Long '图像宽（像素数）
b[^{)$( ImageHeight As Long '图像高(像素数)
NlPS# PlaneNumber As Integer '图像层数
0& w0a P`Y bpp As Integer 'bits per pixels '1 - monochrome bitmap
**;p (CI '4 - 16 color bitmap
b Y8GA '8 - 256 color bitmap
kyUl{Zj '16 - 16bit (high color) bitmap
.(Y6$[#@ '24 - 24bit (true color) bitmap
xF8S*,#,* '32 - 32bit (true color) bitmap
19u =W( Compression As Long '压缩方法 '0 - none (also identified by bi_rgb)
$~u.Wq '1 - rle 8-bit / pixel (also identified by bi_rle4)
[ = M % '2 - rle 4-bit / pixel (also identified by bi_rle8)
j'rS&BI G '3 - bitfields (also identified by bi_bitfields)
je%M AgW` IMAGESIZE As Long '图像数据字节数
+&v\
/ hResolution As Long '水平分辩率 像素数/米
=
1|"- vResolution As Long '垂直分辩率
H[&@}v,L ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100
QJ X/7RA
ImportantColors As Long
[s6C
Zc L Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数
pWaP C /,g End Type
7nE"F!d+0 E,"&-
`/2v F 1W+o?B D_D ,t8_Y Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader
^$?qT60%d| Public sRECT As RECT
aq>?vti1D C3 ;[e0.1b mV\$q@sII Public conn As ADODB.Connection
{[#(w75R{ Public rsTrain As ADODB.Recordset
D!3{g V# Public rsOperater As ADODB.Recordset
#6> 6S;Ib Public rsGoods As ADODB.Recordset
7Ua7A Public rsGood2 As ADODB.Recordset
5G*II_j Public rsSender As ADODB.Recordset
f =:.BR{ Public rsReceover As ADODB.Recordset
/'&; Q7!) Public rsTrainTMP As ADODB.Recordset
<e"J4gZf& C
7"HQQ MWwJzVL8 '打开采集卡
w9&#~k]5 '设置参数
:{ }_|]>K '设置为实时单帧采集到缓存方式
) iE"Tl '由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存
N +Sq}hI |ng%PQq) EQ
>t[ &
Sub Main()
R, 0Oq5 Dim i As Integer, status As Long
[?
KIN_e# "Ai6< :ml InitBMPinfo
Bq }x9C&< '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件
vgG}d8MW37 BMPHeader.Tag = &H4D42
I 48VNX BMPHeader.ImageWidth = FrameW
F'W>
8
BMPHeader.ImageHeight = FrameH
p 8> %Mflf BMPHeader.BMPHeaderSize = &H28
oK+Lzb\d{M BMPHeader.PlaneNumber = 1
4 br 6
$ BMPHeader.bpp = 8
g`Md80*Zfk BMPHeader.Compression = 0
wK5_t[[ BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0
lgD]{\O$ip BMPHeader.vResolution = &H1274
>M4"|W U_ BMPHeader.ColorsinBMP = 256
NPU^) B BMPHeader.ImportantColors = BMPHeader.ColorsinBMP
+<(a} 6dt BMPHeader.DataOffset = Len(BMPHeader)
L]bVN)JU For i = 0 To 255
\HSicV#i BMPHeader.Pallate(i) = RGB(i, i, i)
NB)t7/Us Next i
i5 7(
$1. BMPHeader.IMAGESIZE = FrameH * FrameW
s
zq+@2: BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE
kq/u,16@ *8A6 Q9YT YMB~[]$V< MoveMemory BMP1, BMPHeader, Len(BMPHeader)
5w3Fqu>39? BQ rL7y BMP1.ImageWidth = FrameW
sBW3{uK BMP1.ImageHeight = FrameH * 2
h8v>zNf' BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight
-Zy)5NB-tZ BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE
y:so
L:(F zB)%lb '确定标志位置,为pilarX, pilarY确定初始值
x-Z ^Q C PilarW = mkW
8 njuDl PilarH = mkH '此两项为固定值
>;lKLGJrd> PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX)
4M`Xrfwm'[ PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整
B@cz
?%] rxE&fjW :t$A8+A+0 '连续采集记录文件
L,M+sN ' 建立一个缓冲区为页对齐方式的文件
tbur$ 00 If Dir(TmpFile) <> "" Then
zy )i1d hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _
h_ ZX/k 0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&)
{BOLP E- ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项
W<'<'z5 ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。
PdE>@0X?M Else
qo;)X0 N hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _
rK=6]j(K 0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&)
`BT^a
=5 End If
I,P!@ If hFile = 0 Then
fP Q|e"? MsgBox TmpFile & ": File Open Error", vbOKOnly
aqL<v94wX Exit Sub
#x)}29%e# End If
)/Y~6
A9> '采集参数记录文件
KTmagl gp hBCFile = FreeFile()
L3c*LL Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile
&HF]\`RNr z,Xk \@ hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容
u
Qp_':\k If hMEM = 0 Then
/tC9G@Hl fStatus = GetLastError
7'.s 7&
'7 MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _
*\q8BZ & "请向技术人员报告该错误代码。", vbOKOnly
ixI:@# 5wY CloseHandle hFile
g [L Exit Sub
[thboP.? End If
.E<Dz r%-n*_?.s hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE)
$ KQ,}I If hMemWork = 0 Then
#5{sglC"|F fStatus = GetLastError
uBeNXOre MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _
3M*Y= ?pI & "请向技术人员报告该错误代码。", vbOKOnly
j#igu#MB* '释放已成功分配的内存
j
jY{Uq mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT)
qi\n] I mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE)
^KH%mSX> ]P3 [.$z CloseHandle hFile
'lQYJ0 Exit Sub
fValSQc!U End If
x rI}3T
vInFo.e[4 ' Test writing
eP |)SU 'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0&
bXvbddu)} $9H[3OZPVv '初始化采集卡参数
S aNN;X0 iCurrentCard = -1
.TN2s\:]jw hBoard = okOpenBoard(iCurrentCard)
0x P:9rm Debug.Print hBoard
*.8:'F If hBoard = 0 Then
jgRCs.6 ExitGrabber
y4<+- End
otnV-7 )@ End If
=J3`@ 9;
okGetBufferSize hBoard, mBufferAddr, BufferSize
(#u{ U= If mBufferAddr = 0 Then
P 9yw&A MsgBox "缓存不存在！"
yQ-hnlzn~ ExitGrabber
p7 [(z
End If
mQ,{=C=D Debug.Print Hex(mBufferAddr), Hex(BufferSize)
~e^)q>Lb7( We m?{kx0 ptR currentBr = 128: currentContr = 128
lU$X4JBzS '设置视频输入参数
<!!nI%NC okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2
!%62Phai ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input
}su6izx
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度
BE4\U_]a3 okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光
4*8&[b okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式
t-EV h~D1p okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式
6Ct0hk
4 okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字）
U.Hdbmix okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值)
-tP.S1D okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值)
) E~mJln okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号
:uvc\|:s l C{L6 &T '设置采集参数
`.8-cz
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧
J|?[.h7tO okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式
K+> V|zKuk okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度
;Jo*|pju okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换
P#
bm uCOS okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式
Fwv\ pJ}$ okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集
fLM.k CD?u okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值
MPG+B/P& okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数
BhkAQEsWTQ okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回
Oga1u
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000
gMay 'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节
*1,=qRjL #M:B3C!ouY Rp eBm#E2 okCloseBoard hBoard
&#,v_B)a_E Sleep 50
>w2f8tW`PP hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效
BvJ\x) S w
"|iBZ@ '设置数据传送方式
enPYj.*/0 'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行
.+ uVgSN '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。
L8D m9} % &1$~m0 sRECT.Right = -1 '用于获得当前设置值
Hn^sW
LT
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
kA,4$ 2_o Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom
F*!gzKZ" Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000
JD-Be cz sRECT.Left = 0
Q'C 4pn@ sRECT.Top = 0
`.`FgaJ
| sRECT.Right = sRECT.Left + FrameW
2;}xN! 8 sRECT.Bottom = sRECT.Top + FrameH * 2
Vy
r]
x iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
_KxX&TH aj !xH,y sRECT.Right = -1 '检查新设置值
2D_6 iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
!|(Ao"] Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom
: SdIU36 Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1))
C\/b~HU ,i;9[4 QMX If TESTSignal = False Then
.W-=x,`hY4 'ExitGrabber
8_Jj + End If
4V>vg2
d BArJ"t*/z T z2x9b\82 D/*vj| '设为实时采集状态
K)N)IZ1q 'iFrames = okCaptureActive(hBoard, BUFFER, 0&)
^@Y9!G= 8nf
4Jk8r /O_0=MLp '单帧采集
Y` q!V= 'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1
%cd
]xQpCp 'iFrames = okCaptureSingle(hBoard, BUFFER, 0&)
w4aiI2KFq okCaptureTo hBoard, BUFFER, 0, 1 'single
d(\ 1 } l 'Do While okGetCaptureStatus(hBoard, False) <> 0
Pgx+\;w" ' Sleep 20
IY~
{)X 'Loop
DbQBVy okGetCaptureStatus hBoard, True
`43vxcMg MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize
H! #5!m& '写入768*576测试图象
63SVIc~wT ArrayToBMP TmpBMP
% dYI5U89 Z{
%Uw;d '打开数据库
uiuTv)pwF Set conn = New ADODB.Connection
Bd QQ9$@5 conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> `0| X "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _
Ho >p ^p "; Mode=Read|Write"
pBvo M={2! conn.Open
Vrud R#q g\qX7nIH? frmRecord.Picture1.Picture = LoadPicture(TmpBMP)
Ipg\9*c` frmRecord.Visible = True
O/nqNQ?< frmQuery.Visible = True
y]MWd#U Load frmReceiveFromComm
a0)vvo=bz C~:b* X '调试参数
j}"]s/= 6 If InStr(UCase(Command()), "/CAPTURE") > 0 Then
cS5w +`,L SignalBox.Visible = True
t3 K>\ : End If
Px$'(eMj^3 If InStr(UCase(Command()), "/COMM") > 0 Then
(+@faP
frmReceiveFromComm.Visible = True
L#[HnsLp_ End If
ItMl4P`| Od*v5qT;$ End Sub
Dn: Yi8= uH= Gt^_ Sub ExitGrabber()
VBhE{4J '关闭数据库
M Ey1~h/ '关闭采集卡
Fr<Pe&d n mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT)
e5FCqNip' mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE)
s~/57S mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT)
ZIDFF mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE)
0NVG"-Q okStopCapture hBoard
}@3$)L%n_u okCloseBoard hBoard
1RURZoL CloseHandle hFile
E=A/4p6\$ Close #hBCFile
%odw+PhO conn.Close
l(.7t' End
l#mtND3 End Sub
E8+8{
#f; ADTU{6UPS Function ArrayToBMP(ByVal File As String)
fO0- N>W'P Dim BytesWrite As Long
gp %tMT I1 FU^Y{sbDg hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _
C CC 4(v CREATE_ALWAYS, 0&, 0&)
rnJS[o0 VN?<[#ij If hTmpFile = 0 Then
BzN/6VEw ArrayToBMP = False
J&( Exit Function
h!Z Z2[ End If
z/pDOP Ku `Nkx7Z~w: SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
0H; "5 WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0&
w"yK\O E SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
`Uu^I
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0&
9]"\"ka3> So0
`c,D SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN
pn+D@x#IA WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0&
twAw01". }`#j;H$i If BytesWrite < pFrameSize Then
4
3}qaf [ ArrayToBMP = False
"MW55OWYU End If
u|(aS^H=q K@I+]5E%? CloseHandle hTmpFile
"tpvENz2s cPx66Dh& End Function
4GEj W4E \%P
ma8&d Function ArrayToBMP1(ByVal File As String)
oC5gME"2 o@Dk%LxP Dim BytesWrite As Long
$h C~ af6 OX '/?B(( hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _
KwY`<t1lA; CREATE_ALWAYS, 0&, 0&)
9Y; }JVS [ e$]pN% If hTmpFile = 0 Then
Uy: @,DW ArrayToBMP1 = False
~_ ( !}V Exit Function
mI2|0RWI)l End If
:Xb*m85y \?aOExG
I SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
|L*6x
S[ WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0&
R/yPZO-U hLu
&lY SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
w;@`Yi .WQ WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0&
R65;oJh Z?5,cI[6# SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN
bDxPgb7
N= WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0&
.n?5}s+ q M|5^
':Y If BytesWrite < pBufferSize Then
x*3@,GmZl ArrayToBMP1 = False
~ Ay End If
mm3zQ!2j. F I80vV7
CloseHandle hTmpFile
:h3#1fko T]5U_AI@ End Function
I #Arr#% ,q{lYX83S '使用该过程建立的文件要求在用后关闭
FA5k45w L Public Function ArrayToBMP2(File As String) As Boolean
tW'qO:y+ L2:oZ&:u`J Dim BytesWrite As Long
8Ng)
)7g! ,"4X&>_f ArrayToBMP2 = True
%w;1*~bH | j\eBCnH3 hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _
PG C07U :B CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&)
r9U[-CX:" 3 ATN?V@ If hTmpFile = 0 Then
C6Um6 X9/i ArrayToBMP2 = False
A{xSbbDk
Exit Function
@Z"QA!OK~c End If
g`y/ _ 4yJ01s SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN
G:H(IA7 Z WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0&
89 _&X[X GA( {r
i SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN
Ly@U\%. WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0&
Lqy|DJ% \Qe'?LRu{ SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN
Ut0qr kqF WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0&
qdg= Imx ZYpD8u6U If BytesWrite < pFrameSize Then
&QiAM`MbC= ArrayToBMP2 = False
j( wY/Hl End If
Ke'YM{ :/I={)5 CloseHandle hTmpFile
Z3&XTsq H{p[G hp End Function
_p3WE9T 2d ,wrC<'$ Private Function TESTSignal() As Boolean
D_L'x
" Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long
,i1 fv
" (cbB % extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST)
c~Q`{2%+ Py( w T%w If extsign = 1 Then
M}_M_ TESTSignal = True
2nOe^X!* Else
b@UF
PE5jy If extsign = 0 Then
C{lB/F /|! MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly
KyVe0>{_u TESTSignal = False
0~LnnD N Exit Function
w+:+r/!g End If
^/4 {\3 End If
l%v hV& f?oI'5R41 '测试视频输入类型
n=<q3}1Jej 'video type
ulJ+:zwq$ okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40
9}7oKlyk videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE)
@pyA;>U If videotype = 1 Then
ZVCv(J '"隔行信号(Interlaced)"
Pj^k
pjV Else
^;v.ytO* If videotype = 0 Then
#RsIxpc '"逐行信号(Non-interlaced)"
-M(58/y Else
5cv,
>{~5 If videotype = -1 Then
pJ<)intcbE ' "不支持"
t/4/G']W End If
>QbI)if`1 End If
9
u6
g End If
qX}dbuDE"P -0[>} !l=G '测试垂直扫描线数
TU^tW 'video scanlines
LS?` {E
scanlines = -1
^+.e5roBKj scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES)
#==[RNM%ap If scanlines = -1 Then
EV;;N ' "不支持"
IrVM|8vT3 Else
[m@e^6F0U 'Trim(Str(ScanLines)) + " 行数/幅"
`0-m`> 1> End If
`pn-fk vCrW A-q# '测试帧频
{ILQ
CvP* 'video field frequency
`K ~>!d_ fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ)
Q'vIeG "o If fieldfrq = -1 Then
B%?|br 'lblSignal(8) = "不支持"
c"jhbH!u4 Else
6r ?cpJV{
'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒"
pD)/- Dgdm End If
D0"yZ p} End Function
60SenHKles M\x7=*\ )xXrs^
Sub PicIdentify()
Nc^b8&
2J '本程序完成从文件中按顺序读出一幅图像并完成图像识别
P-
*R N
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息
*8(t y%5F0 '判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔
0Mzc1dG: '方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍
\p_8YC FL*w( Br. Dim fPTR As Long, cFrame As Long
~=aI2( b Dim i As Long, j As Integer, pTotal As Long, pAV As Integer
p5D3J[?N &Cn9
k3E\R bl QzVp- cFrame = 0
A/W7 ;D
EKI+Dq, mqfEs0~I Do While cFrame < tFrames
^Xz`hR "!4>gg3r fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN)
=FC;d[U fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&)
ztt%l # MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize
2&G1 Q'! }<x!95 frmRecord.RText.Text = Str(cFrame)
0zk
T8'v frmRecord.RText.Refresh
T[2f6[#[_ LKwUpu! If CheckMark = True Then
4F P~+ ArrayToBMP TmpBMP
rSFXchD/ frmRecord.Picture1.Picture = LoadPicture(TmpBMP)
8aIq#v frmRecord.RText.Text = "第" & Str(cFrame) & "帧"
^?l-YnQqm? Ny&Fjzl DrawSlice
L@x8hUG" .$T:n[@ 'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo)
EIl$"^- 'If i = vbNo Then
&B>uPZ] ' Exit Do
/ A`zy 'End If
w1/T>o 'cFrame = cFrame + 1
DqC }f# #+5mpDh
End If
Yi! >8 DoEvents
E* DVQ3~ cFrame = cFrame + 1
D -\'P31 Loop
s Gm(Aax*0 End Sub
mk3e^,[A Hi 0df3t HZ`G)1&) Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean
77[
; J dzC&7
9$ '如标志区模式反差存在则为TRUE，否则返回FALSE
gpTF^.( @=|
b$E Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long
xWI 0s;k CheckMark = True
}sN9QgE M%dl?9pbq '复制标志区
F7PZ V+\ For i = 1 To mkH
j7|
\)x, MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW
,,
-[P*@ Next i
'%r@D&*vp M5bj |tQ4 For j = 1 To PilarW * PilarH / 2
%l$&_xV- mTop = mTop + MKpilar(j)
! B38!
L Next j
1*
Fvx-U' ]> "/<" For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH
r :\ 5/0( mBot = mBot + MKpilar(j)
?;=Y1O7 N( Next j
;ZW}47:BS6 x;b+gIz* mTop = mTop / PilarW / PilarH * 2
q@!H^hd} mBot = mBot / PilarW / PilarH * 2
$5 p'+bE 7)5 $ 1 mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度
GeW$lA I @nW(K F '平均值极值化
U=<.P;+f9 For j = 1 To PilarH * PilarW
z4%F2Czai& MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0)
uL{~(?U $ Next j
x~ Esu}x7 Bv|9{:1%X} mTop = 0: mBot = 0
1RO gUJ; For j = 1 To PilarH * PilarW / 2
_WkcJe` mTop = mTop + MKpilar(j)
UK9MWC5g9 Next j
^T
J > rX R;4% For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW
Q)i`.mHfFI mBot = mBot + MKpilar(j)
*'S%gR=Aa+ Next j
5 WNRo[`7 b.u8w2( x @R A1&c mTop = mTop / PilarH / PilarW * 3
&JQ @(w mBot = mBot / PilarH / PilarW * 3
o_^d>Klb8 oL/^[TXjH ezy5Jqk5% If mBot > iWhite And mTop < iBlk Then
aGkVC*T CheckMark = True
X;a{JjN Else
2dlV'U_g CheckMark = False
)jZ=/ xG End If
|~vQ0D
End Function
4oEq,o_ hx;kEJ Sub Capture1Frame()
^T 1-dw( okCaptureTo hBoard, BUFFER, 0, 1 'single
h[)aRo okGetCaptureStatus hBoard, True
|@9I5Eg)iE MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize
8 @*|T?r End Sub
.6A:t? . ?01""Om VX@G}3Ck Sub CopyMark(iBlk As Integer, iWhite As Integer)
Y8xnvK* '复制标志区并返回标志区暗区与亮区的亮度平均值
~rfjQPbh9x 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
B*?PB] QZq9$;>dW '复制标志区
g.sV$.T2K For i = 1 To mkH
OU5|m%CmO MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW
= 8e8!8 Next i
.BB:7+ .F$AmVTN For j = 1 To mkW * mkH / 2
"ddH7:(k< mTotal = mTotal + MKpilar(j)
V# %spW Next j
KO;6 1y: 10 C91/ iBlk = mTotal / (mkW * mkH / 2) '标志区上部白区平均亮度
CO+jB .*ovIU8 mTotal = 0
$%"}N _M For j = mkW * mkH / 2 + 1 To mkW * mkH
1X}Tp\e mTotal = mTotal + MKpilar(j)
Y>m=
cqR Next j
6&Ir0K / JBJ7k
19; iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度
lTd2~_ 2%yJo7f$[ '背景亮度
g#2X'%&+ MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
7%FZXsD For i = 1 To 4 * FrameW
w+(wvNmNEK bsTotal = bsTotal + BsLine(i)
\ @t5S Next i
HPH {{ p bsAV = bsTotal / FrameW / 4
<;Z3
5 { -ZON']|<}k End Sub
2cL )sP} @ BW8`Ky1 DyTk<L Sub AdjIMGbright(Optional bInit As Boolean = True)
1KR|i" ~F6gF7] z '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗）
/'_ RI '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100
.qPfi]
ty ' 夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30
RL)3k8pk ti2_kYq Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer
ASU\O3%% pNWp3+a' '按标准亮度与对比度采集一帧，确定背景亮度
>o= p5#{ currentContr = 128 '初始对比度
{mitF currentBr = 128 '初始亮度
YGmdiY:;1 okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度
=eLb"7C#0 okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度
TAoR6aE DoEvents
YYh_lAS> Capture1Frame
9o'6es..@Z '获得图像上缘4行象素
$NRb' MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW
JB_`lefW,' CopyMark iBlack, iBright '图像标志区亮度
.*7UT~o=CS For i = 1 To 4 * FrameW
4N0nU bsTotal = bsTotal + BsLine(i)
~8{3
Fc 0 Next i
kw}1 CXD bsAV = bsTotal / FrameW / 4 '图像上缘基线亮度
!QspmCo+ /j@r~mt/pA Select Case bsAV
jch8 d(`?d Case 0 To 60 '夜间通过灯光照明,完全没有背景
-{%''(G currentBr = 150
lM%fgy X currentContr = 60
GK%ovK Case 61 To 80 '有可见背景
ghj ~r currentBr = 140
>D #}B1(! currentContr = 70
.u?$h0u5 Case 81 To 100 '有清晰背景
*?"{T;4u~O currentBr = 128
PCfs6.*5Mf currentContr = 80
iRtDZoiD' Case 100 To 150 '有明亮背景
"uC*B4` currentBr = 140 '5:30-6:00钟实测数据
qE:DJy < currentContr = 50
:J-5Q]# Case 151 To 180
dw!E ao47 currentBr = 130
y ]%,Y=%X currentContr = 60
HwuPjc# Case 181 To 220 '背景全为白色
r, KK% B
currentBr = 110
=Q />g 6 currentContr = 130
9r#{s Y Case 221 To 255 '背景全为白色
9v2 ; currentBr = 100
5/ju
it currentContr = 100
mnj A8@1 End Select
!c($ C _q4m7C< Select Case (iBlack + iBright) / 2 '图像反射光强度修正
] w_)Spo. Case 100 To 150
x@}Fn:c!5 currentBr = currentBr - 10
R!qrb26k Case 151 To 255
Rw 8o ] currentBr = currentBr - 20
N+75wtLy& End Select
I !O S&8:u +eXfT*=u5 okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度
BAHx7x#( okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度
!17Z\Ltqyj End Sub
%/on\*Vh3 R
|% Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer)
} O Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long
{jf~?/<
RZ%X1$ For i = 1 To 8
74 (J7 MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128&
p2
(_YN;s MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128&
r/2:O92E Next i
59]9-1" + @/FX7O{n: For j = 1 To 1024
uJ\ Nga<? L1 = L1 + LeftBK(j, 0)
V,5}hQJ
F L2 = L2 + LeftBK(j, 1)
*)I1gR~ R1 = R1 + RightBK(j, 0)
N|S xAg R2 = R2 + RightBK(j, 1)
LL
[>Uu?Y Next j
Q>yt O'v
1 diffL = Abs(L1 - L2) / 1024
wm7 1,R1 diffR = Abs(R1 - R2) / 1024
aB'@8[]z End Sub
kc [["w& 4pT|r6!< Function CheckSlice() As Boolean
b{Ss+F CopySlice avSL, avSLR, avSLL
-P&e4sV{ If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then
s+- aHn CheckSlice = True
vD vGT <d Else
RkwY3 s" CheckSlice = False
<DS6-y End If
j
}l8k@f End Function
dR :iUw:V ]S geZ07 Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer)
D0i30p` Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long
eMzCAO For i = 1 To FrameH
%Eg e^4PE MoveMemory Slice(1, i), pFRAME(sPos, i), sSize
=rF8[Q0K MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize
qT @IY)e MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize
$(=1A>40 Next i
V}-o): dI| For i = 1 To FrameH
>t(@?* ZFT For j = 1 To sSize
N
kI: total = total + Slice(j, i)
#+k[[; 0 totalL = totalL + SliceL(j, i)
):
C4}&l totalR = totalR + SliceR(j, i)
T%/w^27E Next j
pnJT
]?}, Next i
-+_&#twU avSL = total / FrameH / sSize
o+TZUMm avSLR = totalR / FrameH / sSize
"|SE#k avSLL = totalL / FrameH / sSize
*,
K
\A End Sub
n.R hA-O [email protected]5[q0: Sub DrawSlice()
UUqj?'Nv frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B
MNC!3d(D\R frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B
S I5QdX frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B
zK?[ dO frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR)
m)}MkC- End Sub
edx'p`%d5 Sub DrawMark(pic As Control)
*rT(dp!Y Dim i As Long, j As Long
Kf~+jYobO pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B
Bn q\Gg pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B
V0i$"|F+ E For i = 1 To PilarH
It-*CD9
For j = 1 To PilarW
qV,j) b3M pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0)
p ]=;t" Next j
!*6z=:J Next i
C|LQYz-
{ End Sub
\
6 a
'bPo 5V| Function avIMG() As Integer
IOl"Xgn5 Dim i As Long, j As Long, totalIMG As Long
8$Yf#;m[ MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize
=)8fE*[s For i = 1 To pFrameSize
ze N!*VG totalIMG = totalIMG + pBuffer(i)
0 +LloB Next i
KW^aARJ) avIMG = totalIMG / pFrameSize
ArK9E!`^ End Function
gQ#T7 G. TX1 Function avRegion(barCol As Integer, barWidth As Integer) As Integer
wP?q5r5 Dim i As Long, j As Long, totalIMG As Long
\'*`te:{ For i = 1 To FrameH
pr(\ ?\a MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth
12dW:#[ Next i
[rU8
#4.
For i = 1 To FrameH * barWidth
DU8LU*q' totalIMG = totalIMG + pBuffer(i)
yfQE8 v+ Next i
)n@ 3@NV avRegion = totalIMG / pFrameSize
i{qU R P}. End Function
8 GN{*Hg
