这才是我当年写出的一个比较烂的程序 b#a@rh
)Gb,^NGr
Main2.bas 3D_"yZ
f4"4Z
V
cr
Attribute VB_Name = "SubMain" ="'- &
Option Explicit |')-VhLLK
>f$NzJ}
'采集文件与临时文件 O%g\B8;
Public Const TmpFile As String = "d:\30-0600.dat" utH%y\NMF|
'已有数据:30-0600.dat /30日早6点进车与6:30出车头 ]Ik%#l.G_
%w5[*V
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long [l*;E
f,
Public hBCFile As Long '记录采集参数的文件 wa ky<w,
Public Const TmpBMP As String = "d:\1.bmp" opD-vDa h
Public hTmpFile As Long >DP:GcTG
5)M2r!\
L/i(KF{
'采集窗口参数常量 !r
e1EL
Public Const FrameH As Long = 280& ~5 >[`)
Public Const FrameW As Long = 768& *_"u)<J
Public Const pFrameSize As Long = FrameW * FrameH [/$N!2'5
j?-R]^-5
'标志区范围,用于识别车辆 p/*"4-S
Public Const PilarC As Integer = 260 '识别标志立柱中线坐标X Qn|+eLY
Public Const mkW As Integer = 28 '识别标志立柱宽度 B+"g2Y
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) ,2,5Odrz
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) P1V1as
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 9/kXc4
'车缝检测位置常数 "U8S81'
Public Const sSize As Long = 32& S
GM!#K
Public Const sPos As Long = 310& $iPP|Rw
Public Const sPosL As Long = 200& }C,O
Public Const sPosR As Long = 500& JJnYOau
'车缝检测框位置 CVQB"L
Public Slice(1 To sSize, 1 To FrameH) As Byte B4Lx{uno
Public SliceL(1 To sSize, 1 To FrameH) As Byte ,S!w'0k|n
Public SliceR(1 To sSize, 1 To FrameH) As Byte 0^
&!6R
Public avSL As Integer, avSLR As Integer, avSLL As Integer Gx'TkU=
f Iy]/
l r~gG3
Public MKpilar(1 To mkW * mkH) As Byte '一维数组用于亮度对比度分析,比使用二维数组更便于VB编译优化 3ZojE ux`
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 H~o <AmE0!
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer '图像的前4行。用于确定标志区的亮度与对比度范围 _u5dC
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long :E'P7A
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte 6ep>hS4A&
'前后帧左右上角128列*8行像素块,根据平均值差绝对值判断进车方向 3n48 %5
Vz"u>BP3~
!9 f4R/ ?
u|fXP)>.
'一次连续采集的帧数 |[1D$Qv
Public tFrames As Long z<&m*0WYA
K5k?H
'在采集卡申请的缓存中,是按帧为单位的,每一帧包含奇偶场两场的数据 A5nO=
'而该卡的硬件设置是按场采集,只需要读第一场的数据即可。 FS@A8Bb
'所以要设置的缓存帧的大小是frameW*frameH*2,而一场的数据量为pFrameSize f*fE};
A'-_TFwW
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte X3B{8qx_>
Public pBuffer(1 To FrameW * FrameH * 2) As Byte WG5W0T_
Public pWorkSpace(1 To FrameW * FrameH) As Long
,.v7FM^gO
Public Const pBufferSize As Long = FrameW * FrameH * 2 d8OL!Rk
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 BsLG^f
Y7SacRO
Public hBoard As Long '采集卡标识 DDeE(E
Public mBufferAddr As Long '缓存地址 1@_T m
Public BufferSize As Long '缓存大小(字节) gQouOjfP
Public iCurrentCard As Long z-,VnhLx
Public CapStatus As Long ; Lql_1
Public iFrames As Long e;ty !)]
Public currentBr As Byte, currentContr As Byte =k{`oO~:9+
T3 pdx~66
Public hMEM As Long, mStatus As Long `.v(fC
Public Const hMemSize As Long = pFrameSize * 4 s'u(B]E
Public hMemWork As Long Vmi{X b]<
Public Const hMemWorkSize As Long = pFrameSize * 5 p]ivf
X?o(
b/F-
ln<]-)&C
!'0S0a8
'串口接收轨道衡数据 z$[C#5+2
Public WeightFromCom As String s>%Pd7:
Public bReceiveComplete As Boolean _Qd,VE
8u
TH?9< C-C
P8I*dvu _
Public Type GrayBMPHeader ,t,wy37*D
Tag As Integer |d}MxS`^
FileLength As Long '文件大小 L
CSeOR
Reserve1 As Long x0Z5zV9
DataOffset As Long '图像数据偏移量 _MfD
BMPHeaderSize As Long '文件头长 }roG(
'length of the bitmap info header used to describe the bitmap colors, compression,… YZE.@Rz
'the following sizes are possible: b,<9
'28h - windows 3.1x, 95, nt, … rU2iy"L
'0ch - os/2 1.x MGt]' }
'f0h - os/2 2.x <Kt3PyF
Vrp[r *V@E
ImageWidth As Long '图像宽(像素数) Q6'nSBi:A_
ImageHeight As Long '图像高(像素数) g^~Kze
PlaneNumber As Integer '图像层数 ^p=L\SJ
bpp As Integer 'bits per pixels '1 - monochrome bitmap uaw <
'4 - 16 color bitmap _[K#O,D,
'8 - 256 color bitmap ,pt%)
c
'16 - 16bit (high color) bitmap G>z,#Xt
'24 - 24bit (true color) bitmap ,Em$ !n
'32 - 32bit (true color) bitmap z"
QJhCh7
Compression As Long '压缩方法 '0 - none (also identified by bi_rgb) ,1UZv>}S
'1 - rle 8-bit / pixel (also identified by bi_rle4) k6**u
'2 - rle 4-bit / pixel (also identified by bi_rle8) uk7'K 0j
'3 - bitfields (also identified by bi_bitfields) ziEz.Wn"
IMAGESIZE As Long '图像数据字节数 jbte
*Ae
hResolution As Long '水平分辩率 像素数/米 ^^Jnv{)
vResolution As Long '垂直分辩率 Q0cRH"!:
ColorsinBMP As Long '图中所用的颜色。对256色图像总为0x100 %y<]Yzv.
ImportantColors As Long A6"Hk0Hf
Pallate(0 To 255) As Long '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 ycr"Y|
End Type glUo7^ay7
;*cLG#&'M
0 f/.>1M=
f3tv3>p
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader !;
v~^#M]~
Public sRECT As RECT uT_!'l$fr
c&'JmKV>&
u8vuwbra!
Public conn As ADODB.Connection ;#k-)m%
Public rsTrain As ADODB.Recordset z#Nl@NO&
Public rsOperater As ADODB.Recordset r\M9_s8
Public rsGoods As ADODB.Recordset G/?~\
}:s
Public rsGood2 As ADODB.Recordset .EP6oKA
Public rsSender As ADODB.Recordset Hs(D/&6%
Public rsReceover As ADODB.Recordset " I+p
Public rsTrainTMP As ADODB.Recordset 'Kbl3fUF
hOk00az
{nMAm/kyj
'打开采集卡 Es'Um,ku
'设置参数 P?ep]
'设置为实时单帧采集到缓存方式 !<n"6KA.
'由另一线程查询采集状态,如果完成采集,传送至用户数组分析或保存 =A!S/;z>
q4k@l
z/]q)`G
Sub Main() K%j&/T j1
Dim i As Integer, status As Long ,FQK;BU!lh
buMqF-j
InitBMPinfo & >JDPB?5
'生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 _GoVx=t
BMPHeader.Tag = &H4D42 C"w
{\
&R
BMPHeader.ImageWidth = FrameW .tXtcf/
BMPHeader.ImageHeight = FrameH Pz"`MB<'Ik
BMPHeader.BMPHeaderSize = &H28 kQv*eZ~
BMPHeader.PlaneNumber = 1 t?)pl2!A
BMPHeader.bpp = 8 \\4Eh2
Y
BMPHeader.Compression = 0 }1H=wg>\
BMPHeader.hResolution = &H1274 'Windows pBrush.exe的默认值,PhotoED.exe默值为0 C>QIrZu
BMPHeader.vResolution = &H1274 ,|T7hTn=
BMPHeader.ColorsinBMP = 256 &KC!*}<tx
BMPHeader.ImportantColors = BMPHeader.ColorsinBMP pwX C
BMPHeader.DataOffset = Len(BMPHeader) Sp SnoVI
For i = 0 To 255 { T]?o~W
BMPHeader.Pallate(i) = RGB(i, i, i) t+TYb#Tc
Next i 0$vj!-Mb^j
BMPHeader.IMAGESIZE = FrameH * FrameW X% {'<baR
BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE s8gU7pT49
slW3qRT\k
'mM jjG9
MoveMemory BMP1, BMPHeader, Len(BMPHeader) V'gw\mcb
(ywo
a
BMP1.ImageWidth = FrameW \wav?;z
BMP1.ImageHeight = FrameH * 2 s
(2GFc
BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight Qx`~g,wk8
BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE 5g
;ac~g
,^'R_efY
'确定标志位置,为pilarX, pilarY确定初始值 (lH,JX`$a
PilarW = mkW \5><3*\
PilarH = mkH '此两项为固定值 NAFsFngqH
PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) ;%!m<S|%k
PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY) '此两项需要在程序初始化时检查并进行调整 ~H6;I$e[
k|E]YvnfG
YJF#)TkF
'连续采集记录文件 |M~ON=
' 建立一个缓冲区为页对齐方式的文件 !~iGu\y
If Dir(TmpFile) <> "" Then 2#5,MP~r
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ yy2I2Bv
0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) xytr2V ]aV
' 在95/98中,如果打开文件时没有声明overlapped方式,在读定文件时就不能使用overlapped参数项 "$^0%-
' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 Q(@IK&v
Else SZ!=`a]
hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ <,1fkq>,
0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ?Dsm~bkX[
End If :+&AY2`
If hFile = 0 Then KFWJ}pNq
MsgBox TmpFile & ": File Open Error", vbOKOnly mY&ud>,U:
Exit Sub 4Yjx{5QSAG
End If {Gi h&N
'采集参数记录文件 jUMf6^^
hBCFile = FreeFile() "^CXY3v
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile =U-r*sGLN
mZvG|P$}
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE) ’分配系统内容 +: Ge_-
If hMEM = 0 Then oQ2KW..q
fStatus = GetLastError #=,(JmQPt
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ ,^s
& "请向技术人员报告该错误代码。", vbOKOnly hfM;/
CloseHandle hFile KLQ!b,=q
Exit Sub 40P) 4w
End If ]s1 YaNq
QLq@u[A
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 6`H.%zM
If hMemWork = 0 Then A.%CAGU5w
fStatus = GetLastError 8<#U9]
MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 3:CO{=`\7B
& "请向技术人员报告该错误代码。", vbOKOnly LXfCmc9|Z
'释放已成功分配的内存 ":W%,`@$
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) C2F0tr|
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) #gbH^a'
=tdSq"jh
CloseHandle hFile )@g;j>
Exit Sub E
l&h;N
End If y=sGe!^
sq0 PBEqq
' Test writing u\e\'\
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ]]iPEm"@
b= PVIZ
'初始化采集卡参数 !]?$f=
iCurrentCard = -1 }iN2KeLAF
hBoard = okOpenBoard(iCurrentCard) ":;@Hnb/
Debug.Print hBoard g@v
s*xE
If hBoard = 0 Then HK=[U9 o?
ExitGrabber '
/%zi,0
End dE=Ue#1U@5
End If ' [0AHM
okGetBufferSize hBoard, mBufferAddr, BufferSize )mcEQ -!b
If mBufferAddr = 0 Then %@J1]E;
MsgBox "缓存不存在!" /Wj,1WX~
ExitGrabber MXh
"Y*}
End If #Z!b G?="
Debug.Print Hex(mBufferAddr), Hex(BufferSize) K\.5h4k
X]*QUV]i
WMuD}s
currentBr = 128: currentContr = 128 =[tSd)D,y
'设置视频输入参数 Sfjje4R
okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 j|_E$L A\
' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input H=MCjh&$q
okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 _7)F
?
okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 NYB[Zyp
okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 %1U`@0
okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 2z0n<`
okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行(低字)同步开槽(高字) udqS'g&
okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移,低字X偏移 (144/44经验值) P&A|PY,P
okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小:低字X高字Y (768/576采集卡最大值) qoU3"8
okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 L\aBc}
30cd|
S?
'设置采集参数 RuRt0Sd3
okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0 '逐帧 l:(Rb-Wy
okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ?w&SW{ I
okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8 '8位灰度 {bNXedZ\
okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 6tjcAsV
okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 Cpl;vQ
okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 8\ha@&p
okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944 '水平像素数 PAL制式固定值 wzWbB2Mb5
okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 ]
Uc`J8p,
okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 j6}R7$JR
'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 u:gtOjk2
'Buffer Block Size不用设置,而用okSetTargetRect函数进行动态调节 N=1JhjVk"
fZWGn6$
h5zVGr
okCloseBoard hBoard FH5ql~
Sleep 50 TCVl8)j
hBoard = okOpenBoard(iCurrentCard) '关闭后重新打开使新的设置值生效 y }2F9=
[w\?j,
'设置数据传送方式 C*70;:b
'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 3tS~:6-/
'该设置对本程序无意义,因为程序直接用CopyMemory方法读缓存,而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 T=Z.U$
C*6S@4k
sRECT.Right = -1 '用于获得当前设置值 bha?eN
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) _GtBP'iN
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom b`mj_b
Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1) 'FrameW + FrameH * &H10000 p='-\M74K
sRECT.Left = 0 hsLzj\)6
sRECT.Top = 0 .V'V:;BE%
sRECT.Right = sRECT.Left + FrameW 8cg`7(a
sRECT.Bottom = sRECT.Top + FrameH * 2 wo^Sy41bF
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) QDmYSY$
W 0[N0c
sRECT.Right = -1 '检查新设置值 ;e8V
+h
iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) JqU ADm
Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom F
phDF
Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) in%;Eqk
!^fa.I'mM
If TESTSignal = False Then 'Pltn{iq[
'ExitGrabber Wa"(m*hW
End If f<jb=\}x
HL{$ ^l#v
g^>#^rLU
2(YPz|~W
'设为实时采集状态 g=)J~1&p
'iFrames = okCaptureActive(hBoard, BUFFER, 0&) \>/M .2
Z'v-F^
-`c:}m
'单帧采集 mryN}
'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 'W. Vr4
'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) q!,zq
okCaptureTo hBoard, BUFFER, 0, 1 'single 6gO9 MQY
'Do While okGetCaptureStatus(hBoard, False) <> 0 Jc*XX
u)
' Sleep 20 K`:=]Z8
'Loop CZ{k@z`r
okGetCaptureStatus hBoard, True tJI
,r_
MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize D$
eB ,~
'写入768*576测试图象 XR+3j/zEQ
ArrayToBMP TmpBMP BNGe
exs@
3ha|0[r9
'打开数据库 u62 )QJE
Set conn = New ADODB.Connection S5=Udd"
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 3yS
"Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ,t$,idcT+
"; Mode=Read|Write" rJfqA@
conn.Open 4g
_"ku
ZFh+x@
frmRecord.Picture1.Picture = LoadPicture(TmpBMP) b
B
frmRecord.Visible = True (X[2TT3j!
frmQuery.Visible = True Yn51U6_S
Load frmReceiveFromComm D vkxI<Xa
ffDc6*.Q
'调试参数 vlWw3>4
If InStr(UCase(Command()), "/CAPTURE") > 0 Then d4^`}6@
SignalBox.Visible = True N1EezC'^
End If B)SLG]72f
If InStr(UCase(Command()), "/COMM") > 0 Then pa
.K-e)Mu
frmReceiveFromComm.Visible = True b%(6EiUA
End If vxlOh.a|/L
?h\mk0[
End Sub tB(4Eq
\
USML~]G
z
Sub ExitGrabber() ;^k7zNf-
'关闭数据库
S9
sR#
'关闭采集卡 LX+5|u
mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Mio>{%/
mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Bn wzcl
mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) W=}Okq)x9I
mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 25{ uz
okStopCapture hBoard obClBO)@Y
okCloseBoard hBoard *=F(KZ
CloseHandle hFile ")#<y@Rv
Close #hBCFile 2-If]Fc
conn.Close AD5)
.}[F
End qztV,R T
End Sub p
QE)p
wNCCH55Pt
Function ArrayToBMP(ByVal File As String) "&YYO#YO
Dim BytesWrite As Long y&T&1o
FpV`#6i7
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ gz#4{iT~
CREATE_ALWAYS, 0&, 0&) tl8O6`<Z
US&B!Q:v
If hTmpFile = 0 Then *6ZCDm&N
ArrayToBMP = False =ZYThfAEw
Exit Function 43:t
\
End If ,lN5,zI=S
P<dy3;
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN VkmRh,T
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& j}HFs0<L
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN Do-^S:.
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& pNaiXu3
t@zdmy
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN
KJhN
J
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& `vk0c
"`tXA
If BytesWrite < pFrameSize Then &&8'0.M{
ArrayToBMP = False 3SG?W_
End If !-]C;9Zd
^y.UbI
CloseHandle hTmpFile $+=
<(*
8}p8r|d!ls
End Function B;zt#H4
FVWfDQ$&v
Function ArrayToBMP1(ByVal File As String) Gy29MUF
N0TeqOi4Y
Dim BytesWrite As Long &vUq}r%P
n[+'OU[
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 8Cf|*C+_'
CREATE_ALWAYS, 0&, 0&) 4n( E;!s
oW}!vf3z
If hTmpFile = 0 Then x!TZ0fq0
ArrayToBMP1 = False 6o&ZIY