引用

引用第20楼newport93于06-14-2010 13:47发表的  : zjluX\  
Z!C`f/h9  
老五，I 服了U。 ib5
;f0Qa  
AzLbD2Pl  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 ^CowJ(y(  

U%mkh Wn  

GM)\)\kNF  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! (z8]FT  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : uE,i-g0$Id  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? nx!qCgo  

D..{|29,:  
=:xV(GK}  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : kcq9p2zKv  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 ?G~/{m.  

p6&LZ=tL3  
\N# HPrv}  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 o1 hdO  
SeRK7Q&_  
可以从宽不？

引用

引用第10楼卡拉于06-13-2010 21:49发表的  : ~cO?S2!W  
老伍，对不住，我把你原来的英文标题改了，太不吸引人眼球了，有些人还当是英文的都不会去点击。我通篇读了一下，改成了现在的标题。如果你不喜欢，可以改回来。 4*N@=v  

'mBLf&fB  
yBYuDfeZ  
其实标题没有什么，卡总既然改了就不必再改回了。 r
)9i1rI+  
sx)$=~o  
主要是当初写的时候真是顶着锅盖写的。 N27K  
)H[h53bIq  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : fr,CH{Uq  
哦, 打倒忽悠大家的家伙.      VxPTh\O*[  

72s$  
v:J.d5  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : #r:Kg&W2FO  
每个人的故事对其他人都是故事, MeK \eZ\  
自己的故事也是其中之一. JI[rIL\Ey  
跳出来看, kGBl)0pr`x  
不过是众人中的一个人的故事. 66"ZH,335  
|$|nV^y  
所以,接着听故事. G"UH4n[1ur  
]uj.uWD  
女人们有兴趣的就等老伍开个新帖或者跟贴, EbwZZSds1  
听他痛说恋爱革命历史.... xt<, (4u  
v-r[~  
杂家接着听他自学程序员历史, ,rl <ye*&  
高级程序员考了吗? /bNVgK`L5  

u UVV>An  
Bu>yRL=*  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ {L2Gb(YLW  
"]\":T  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 <8z[,X}bM  
8w@W8(3B  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 bcx{_&1p  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : `bi_)i6Low  
引用第19楼伍胥之于06-14-2010 12:33发表的  : fPk9(X;G!p  
CK`3   
WCfe!P?g  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 : PjUl  
Q]?J%P.  
我连一级也没有考过。 $d??(  
. OrH1fhh   

e[k;SSs  

引用

$b 71  
矬子里拔将军... sp |y/r#  
你们那里的俗语是吧? XY t8vJ  
ks`  
我们这里说"矮子里拔长脚"..应该是同一个意思... !#|fuOWe  
JpHsQ8<  
有趣....各地有表达意思一样却方式不同的俗语.... )'I<xx' 1  
!\k#{ 1[!  
 /qQ2@k  
你的文章写的有脸皮,没屁眼的, sxQ,x/O  
让看客大为不满... I\4`90uBN  
MPEBinE?  
你等着,,估计你以后接到的午夜凶铃就多了... _ L:w;Oy9T  

hjp ?/i%TQ  
ThQEQ6y  
我到现在也没有接到你的午夜凶铃呢！ Z FrXw+  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : ib=^tK  
伍SIR，再次抱拳佩服 _.8]7f`*Gc  

fD}]Mi:V  
PH4bM  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : pO +wJ|f  
佩服，玩也玩得这么专业！ 5Fm?,^  

<EN[s  
{rJF)\2  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : g#nsA(_L  
O. f3 (e!  
介个真的看不懂。 ?Lb7~XK t\  
你说你老啦，喜欢怀旧了，才想起来填坑。 5*'N Q010  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 c@{^3V##T  

Z"nuO\zH~  
;8Q?`=a  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 %ycT}Lu  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ 2>$L>2$  
DWORD dwCB; hUvH t+d  
LARGE_INTEGER  offset; 'QS~< ^-j"  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); wm[ d5A4  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); h0QQP  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ }j@@  
DWORD error = GetLastError(); zq>"a&Y,  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); u+FftgA  
return FALSE; |L-juT X9  
} ?bi^h/f  
return TRUE; j'b4Sbs-f  
} l zknB  

'VB 6.0 版 jl29~^@}1i  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 *3oQS"8  
I9&<:`  
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long wWswuhq<  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 'B:De"_(N  
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long '//declare has changed DuZ]g#  
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long '//declare has changed tELnq#<6  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long *#9kFz-  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 {]N?DmF  
I4ct``Di  
+a@SdWf  
Private Const GENERIC_READ = &H80000000 mw.aavB  
Private Const GENERIC_WRITE = &H40000000 P?ol]MwaB  

}eK*
)  
Private Const FILE_SHARE_READ = &H1 *M5C*}dl  
Private Const FILE_SHARE_WRITE = &H2 vxZUtyJfe  
Private Const OPEN_EXISTING = 3 .b) (_*  
@TG~fJSA12  
Private Const INVALID_HANDLE_VALUE = -1 5WG@ ;K%  
`G{t<7[[;  
'//file seek o
: DnZN  
Private Const FILE_BEGIN = 0 ^?`,f>`M  
Private Const FILE_CURRENT = 1 AU\!5+RDB  
Private Const FILE_END = 2 'v)+S;oB  
}/FM#Xh  
Private Const ERROR_SUCCESS = 0& v)pWx0l=  
0kEq|k9  
'//device io control EU~'n-  
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long t$%}*@x7  
RtEkd_2  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 Ki\jiflc7  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 ho<#i(  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 88U  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 S(xA}0]  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C !9Xex?et  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 }Ec"&  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F ]c+'SJQ  
Qp Vm  
'//type Ghe=hhZ  
Private Type LARGE_INTEGER DzOJ{dF  
    lowpart As Long 2l%iXK[  
    highpart As Long 7nIMIkT:  
End Type SX8%F:<.  
q@> m~R  
Private Enum MEDIA_TYPE ZXkAw sr  
    Unknown n-WvIy  
    F5_1Pt2_512 Stx-(Kfn4  
    F3_1Pt44_512 Ds/zl Z  
    F3_2Pt88_512 l/M+JT~R  
    F3_20Pt8_512 l,8|E  
    F3_720_512 =~*u(0sJa  
    F5_360_512 wpmtv325  
    F5_320_512 ovVU%2o1b  
    F5_320_1024 K|!)<6ZsG7  
    F5_180_512 `buTP?]4.  
    F5_160_512 Jrl xa3 [  
    RemovableMedia V!!'S h  
    FixedMedia k{8N@&D  
End Enum SjU6+|l  
v:b%G?o  
Private Type DISK_GEOMETRY l)bUHh5[  
    Cylinders           As LARGE_INTEGER 3N \X{za  
    MediaType           As MEDIA_TYPE "fw uvT 1  
    TracksPerCylinder   As Long _"TG:RP  
    SectorsPerTrack     As Long pc>R|~J{2  
    BytesPerSector      As Long 1yf&ck1R  
End Type =^}2 /vA  
r73Xh"SL  
'//private vars 3<lDsb(}0A  
Private hDisk           As Long             'disk handle \hX^Cn=6  
Private lpGeometry      As DISK_GEOMETRY    'disk info RmCR"~  
Private lBufferSize     As Long             'the buffer size of read/write /iy/2x28>  
CjCnh7tm  
Public Function OpenDisk(ByVal FileName As String) As Boolean Fv B2y8&W  
'// 打开磁盘 ]sE^=;Pv?  
    hDisk = CreateFile(FileName, _ 4QDzG~N4)|  
                        GENERIC_READ Or GENERIC_WRITE, _ '?4[w]0J<  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ 9bvd1bKEW  
                        ByVal 0&, _ .!! yj,bQz  
                        OPEN_EXISTING, _ :oQaN[3>_  
                        0, _ ?whp_  
                        0) bZJ
iubBRI  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) rkp0ej2-  
End Function 5$w1[}UUd  
N~YeAe~+  
Public Function CloseDisk() As Boolean JJa?"82FXZ  
'//关闭磁盘 C
Q ?|=cN  
    CloseDisk = CloseHandle(hDisk) $ S/8T  
End Function jws(`mIf\  
BC+qeocg  
Public Function GetDiskGeometry() As Boolean *n\qV*|6bI  
'//获取磁盘参数 IS~oyFS  
    Dim dwOutBytes      As Long tL|Q{+i yE  
    Dim bResult         As Boolean U)6
JJv  
      7dIDKx  
    bResult = DeviceIoControl(hDisk, _ X?a67qL  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ ~*Wb MA  
                                ByVal 0&, 0, _ d{jl&:  
                                lpGeometry, Len(lpGeometry), _ S([
De"y  
                                dwOutBytes, _ .d,Zx  
                                ByVal 0&) z@}~2K  
     mZ%\`H+  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack 2Ev,dWV  
    GetDiskGeometry = bResult kE}Ib4]J  
End Function P'';F}NwfX  
xDS9g Gr  
Public Sub GetDiskInfo(MediaType As Long, _ 6ZJQ '9f  
                        Cylinders As Long, _ H(|v  
                        TracksPerCylinder As Long, _ %0'f`P6  
                        SectorsPerTrack As Long, _ #/6X
44 *u  
                        BytesPerSector As Long) (C|%@61S  
'//返回磁盘的参数 +ZO*~.zZ  
    MediaType = lpGeometry.MediaType %-.GyG$i  
    Cylinders = lpGeometry.Cylinders.lowpart sa])^mkq(  
    TracksPerCylinder = lpGeometry.TracksPerCylinder ;!b(b%  
    SectorsPerTrack = lpGeometry.SectorsPerTrack ,'}ZcN2)  
    BytesPerSector = lpGeometry.BytesPerSector _9dV 3I  
9EW 7,m{A  
End Sub \/%mabLK  
TY}?>t+  
Public Property Get BufferSize() As Long IuL]V TY  
'//返回每次读/写的缓冲大小 ~Fh(4'  
    BufferSize = lBufferSize }W J`q`g  
End Property hR2.w/2j  
7#`:m|$  
_L ].n)b  
Public Function LockVolume() As Boolean XafyI*pOX  
'// 将卷锁定 *{bqHMd4L  
    Dim dwOutBytes  As Long 7;V 5hul  
    Dim bResult     As Boolean $6[]c)(  
     12E"6E)
 
    bResult = DeviceIoControl(hDisk, _ G<I5%Yo6G  
                                FSCTL_LOCK_VOLUME, _ /:)4tIV  
                                ByVal 0&, 0, _ u-$AFSt  
                                ByVal 0&, 0, _ 'Z[R*Ikzq  
                                dwOutBytes, _ oc3/ IWII  
                                ByVal 0&) /e,lD)  
    LockVolume = bResult Q*5d~Yr]R  
End Function s 
Y,3  
;DOz92X
94  
1zffPC8jl  
Public Function UnlockVolume() As Boolean rkrt.B  
'// 将卷解锁 O_q_O  
    Dim dwOutBytes As Long ){Y2TWW&0  
    Dim bResult As Boolean g$qh(Z_s  
     +J}M$eQ  
    bResult = DeviceIoControl(hDisk, _ 62q-7nV  
                                FSCTL_UNLOCK_VOLUME, _ rXMv&]Ag  
                                ByVal 0&, 0, _ '
=kX   
                                ByVal 0&, 0, _ }HzZj;O^2>  
                                dwOutBytes, _ rv[\2@}  
                                ByVal 0&) ))vwofkw4  
    UnlockVolume = bResult R_&>iu'[  
End Function -$rfu  
t &0p@xLQ  
+oa]v1/W  
Public Function DismountVolume() As Boolean 0J"3RTt  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 ~a}pYLxl  
    Dim dwOutBytes As Long Ra5cfkH;  
    Dim bResult As Boolean DX|kO  
     zq#o8))4X  
    bResult = DeviceIoControl(hDisk, _ hG U &C]  
                                FSCTL_DISMOUNT_VOLUME, _ h=aHZ6v  
                                ByVal 0&, 0, _ U7N<!6  
                                ByVal 0&, 0, _ T/ov0l_  
                                dwOutBytes, _ 4C$,X!kzF  
                                ByVal 0&) utXcfKdt  
    DismountVolume = bResult ,o`qB81  
End Function >X]<s^  
! WmpnPr1  
{>qCZ#E5WO  
Public Function ReadDisk(ByVal Cylinders As Long, _ aNz%vbh\  
                    ByVal Tracks As Long, _ @9L9c  
                    db() As Byte) As Boolean YZ}gZQ.A0  
'//按柱面和磁道来读取磁盘数据 ??Lxb% 7R  
    Dim iPos    As Long 5y)kQ
<x"  
    Dim lRead   As Long Jq->DzSmj/  
     Us<lWEX;k  
    iPos = Cylinders * Tracks * lBufferSize ,^(T^ -  
     uE2Yn`Ha  
    If SeekAbsolute(0, iPos) Then D'X'h}+2  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) K|&y
?w  
    End If QZY(S*Up  
End Function {XAKf_Cg  
a]*^uEs  
Public Function WriteDisk(ByVal Cylinders As Long, _ UkC\[$-"\  
                     ByVal Tracks As Long, _ *w;f\zW  
                     db() As Byte) As Boolean -p1arA  
'//按柱面和磁道来写磁盘数据 ;%)i/MGEB  
    Dim iPos    As Long #'[ f^xgJ  
    Dim lRead   As Long oj/tim  
     =[$*PTe  
    iPos = Cylinders * Tracks * lBufferSize #KwF
rlZ  
     BBDOjhik  
    If SeekAbsolute(0, iPos) Then kF5}S8B  
        WriteDisk = WriteBytes(lBufferSize, db()) z"-Urd^O  
    End If ifkA3]  
End Function 9f "*Oj  
Mm5l>D'c  
_i&\G}mrC  
'///////////////////////////////////////////////////////////////////////////////////// T"z!S0I  
'//file system ]PFc8qv{  
(?Yz#Yf  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean Ldu!uihx  
'//seek file +1Uw<~  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte al2v1.Y}  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) _VJb i,V  
    If LowPos = -1 Then $t]DxMd  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) aCanDMcBnq  
    Else rtI4W  
        SeekAbsolute = True >2rFURcD  
    End If ]Vubz54  
     a36<S0R  
End Function cIX59y#7  
&HE8O}<>  
5]{YERa'  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean 3ySnAAG  
'//read data to array ;rFa I^  
    Dim RetVal    As Long v-kH7H"z  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) zAH+{4lC+  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF E-/]UH3u H  
    ReadBytes = Not (RetVal = 0) 2a
G<^3  
     % u
g`dZ/  
End Function q &+GpR  
c}Qc2D3*  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean  wNPZ[V:  
'//write data from array *?uF&( 0  
    Dim RetVal As Long Og["X
0j  
    Dim BytesToWrite As Long F'K{=  
    Dim BytesWritten As Long V3-LVgM%  
     9'tM65
K  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) j6\{j#q  
     zUh(b= ,  
    WriteBytes = Not (RetVal = 0) =\3*;59\  
End Function 67e1Y@Xu  

这才是我当年写出的一个比较烂的程序 \+,jM6l
}-  
zIL.R#|D=  
Main2.bas T57S!CJ^$5  
l6O2B/2
j  
Attribute VB_Name = "SubMain" Sc
I9.{  
Option Explicit P -Pt{
:  
wxoBq{r;  
'采集文件与临时文件 
~6OdPD  
Public Const TmpFile As String = "d:\30-0600.dat"
7SQu  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 j8PK\j[  
{\%x{  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Z/0M9 Q%  
Public hBCFile As Long  '记录采集参数的文件 jj^CW"IB  
Public Const TmpBMP As String = "d:\1.bmp" 8z+ CYeV  
Public hTmpFile As Long 'HC4Q{b`  
FnCHbPlb  
wC[J=:]tA5  
'采集窗口参数常量 *33Zt+  
Public Const FrameH As Long = 280& &
1I0i[R  
Public Const FrameW As Long = 768& 6 2LZ}yn_"  
Public Const pFrameSize As Long = FrameW * FrameH i^n&K:6  
;c'jBi5W  
'标志区范围，用于识别车辆 ]t,ppFC#  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X =IUTU4!]  
Public Const mkW As Integer = 28  '识别标志立柱宽度 | o?@Eh  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) ur'A;B  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) ;%U`P8b!  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 /q>"">  
'车缝检测位置常数 qvT9d7x  
Public Const sSize As Long = 32& ,e;(\t:  
Public Const sPos As Long = 310& , w_Ew  
Public Const sPosL As Long = 200& # OJD<=")  
Public Const sPosR As Long = 500& al5?w{us  
'车缝检测框位置 eVy,7goh  
Public Slice(1 To sSize, 1 To FrameH) As Byte rsP1?Hxq  
Public SliceL(1 To sSize, 1 To FrameH) As Byte / og'W j  
Public SliceR(1 To sSize, 1 To FrameH) As Byte uto4bs:  
Public avSL As Integer, avSLR As Integer, avSLL As Integer ICGBU>Db  
#R)$nv:h?^  
+pE-Yn`YS  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 d kXK0k  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 8\[6z0+;  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 j3FDGDrg  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long s^6S
{XJ  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte <@?bYp  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ON$u581 y  
K <0ItNv  
rod{77  
Q%85,L^U  
'一次连续采集的帧数 S]<Hx_[}  
Public tFrames As Long -O ej6sILO  
I|p(8R!  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 :+u?A  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 /JvNJ f  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize mtHw! *  
$
idYG< ],  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte Pp}j=$&j\  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte * @oAM,@  
Public pWorkSpace(1 To FrameW * FrameH) As Long Kj'uTEM  
Public Const pBufferSize As Long = FrameW * FrameH * 2 LOp<c<+aW  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 3c6#?<%0`  
HK} C<gg  
Public hBoard As Long   '采集卡标识 P'g$F<~V  
Public mBufferAddr As Long  '缓存地址 |=SaI%%Be  
Public BufferSize As Long  '缓存大小(字节) ,fL*yn  
Public iCurrentCard As Long J3 K!@m_\  
Public CapStatus As Long 1X=}  
Public iFrames As Long @P%&Dha  
Public currentBr As Byte, currentContr As Byte 2cww
7z/B  
s]}P jh8  
Public hMEM As Long, mStatus As Long TEY%OIzU+  
Public Const hMemSize As Long = pFrameSize * 4 ~*H!zKIx  
Public hMemWork As Long [Y5B$7|s<  
Public Const hMemWorkSize As Long = pFrameSize * 5 [1N*mY;  
#/YKA{  
0"ZRJl<)[I  
s:Memvf  
'串口接收轨道衡数据 #wt#-U;  
Public WeightFromCom As String 2?HLEiI1  
Public bReceiveComplete As Boolean ,l~i|_   
&u.t5m7(  
x;kW }U  
Public Type GrayBMPHeader '(ql7  
  Tag As Integer Wz9 }glr  
  FileLength As Long    '文件大小 /Wt<[g#  
  Reserve1 As Long EKgTRRW  
  DataOffset As Long    '图像数据偏移量 mio\}SA  
  BMPHeaderSize As Long  '文件头长 S25&UwUw  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… 1}'|HAu  
                        'the following sizes are possible: =n9|r.\&uJ  
                        '28h - windows 3.1x, 95, nt, … G6L 'RP  
                        '0ch - os/2 1.x MbF.KmV  
                        'f0h - os/2 2.x BaqRAO7  
TJ+yBMd*%  
  ImageWidth As Long           '图像宽（像素数） nq r[HFWs  
  ImageHeight As Long          '图像高(像素数) ^'#vUj:"  
  PlaneNumber As Integer  '图像层数 +Ge-!&.;A  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap AuWEy-q?  
                                        '4 - 16 color bitmap O{Wy;7i  
                                        '8 - 256 color bitmap |E|d"_Ma  
                                        '16 - 16bit (high color) bitmap _%Jqyc"-  
                                        '24 - 24bit (true color) bitmap YX-G>.Pc  
                                        '32 - 32bit (true color) bitmap c\7~_ w2  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) q*
52|?  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) - wCfw
C  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) 3PPN_Z  
                                    '3 - bitfields (also identified by bi_bitfields) @*!8  
  IMAGESIZE As Long  '图像数据字节数 bz,C%HFA  
  hResolution  As Long  '水平分辩率  像素数/米 ]M#_o]  
  vResolution  As Long  '垂直分辩率  z7>  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 FL-sXg  
  ImportantColors As Long . ]P@{T||Y  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 U#-89.x  
End Type o AvX(  
>=$( ,8"  
=lA*?'
kd  
U }xRvNz  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader @=:( b"Sg  
Public sRECT As RECT GXf"a3  
wU+-;C5e  
y1z4qSeM  
Public conn As ADODB.Connection KxqJlben  
Public rsTrain As ADODB.Recordset ]Z6==+mCP  
Public rsOperater As ADODB.Recordset '9*(4/,UJJ  
Public rsGoods As ADODB.Recordset <w<&,xM  
Public rsGood2 As ADODB.Recordset aNw8][  
Public rsSender As ADODB.Recordset <$/'iRtRzW  
Public rsReceover As ADODB.Recordset NZCPmst  
Public rsTrainTMP As ADODB.Recordset ?bW|~<X~  
j#zUO&Q@  
O\8_;Gc;  
'打开采集卡 QF Vy2 q  
'设置参数 {e,S}:$g4  
'设置为实时单帧采集到缓存方式  { |a=  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 X)x$h{ OE  
Wu?4oF  
6Xbo:#  
Sub Main() 6o!+E@V b  
  Dim i As Integer, status As Long (@[c;+x  
     8Y_wS&eB  
   InitBMPinfo p%ek)tT  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 =UT*1-yhR  
    BMPHeader.Tag = &H4D42 !3E33
 
    BMPHeader.ImageWidth = FrameW n}}$-xl  
    BMPHeader.ImageHeight = FrameH xXQDHc-Ba  
    BMPHeader.BMPHeaderSize = &H28 "'~55bG  
    BMPHeader.PlaneNumber = 1 ?u/RQ 1  
    BMPHeader.bpp = 8 hv2@}<r?  
    BMPHeader.Compression = 0 >Ta|#]{  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 :OQx;>'  
    BMPHeader.vResolution = &H1274 <S<@V?h  
    BMPHeader.ColorsinBMP = 256 ~{/"fTif  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP C/U^8,6\n  
    BMPHeader.DataOffset = Len(BMPHeader) Z2!O)
8  
    For i = 0 To 255 Dz3=k
sXZ  
      BMPHeader.Pallate(i) = RGB(i, i, i) cba~  
    Next i 9Eu.Y
 
    BMPHeader.IMAGESIZE = FrameH * FrameW IXc"gO  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE Kj.4Z+^  
F=bX\T7  
*`7cvt5]IM  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) \%g# __\  
     V]&0"HX2r!  
    BMP1.ImageWidth = FrameW fIWOo >)D  
    BMP1.ImageHeight = FrameH * 2 -YPUrU[)  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight K`Vi5hR~c  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE EPkmBru ^  
Pm*FA8a7  
  '确定标志位置,为pilarX, pilarY确定初始值 ef*V
s  
   PilarW = mkW .0}]/%al  
   PilarH = mkH  '此两项为固定值 o)GLh^g_I'  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) Z]jm.'@ z@  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 PS7ta?V QC  
   2guWWFS  
   W^v3pH-y#  
  '连续采集记录文件 _vr>- :G  
  ' 建立一个缓冲区为页对齐方式的文件 L/t'|<m  
  If Dir(TmpFile) <> "" Then C5"=%v[gQv  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ E>NRC\^@  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) $t}t'uJ  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 ^`?2g[AA  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 %a$ l%8j&  
  Else 86y)+h`  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ )!+~q!A  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) sT ]JDC6  
  End If ?H3L
s~R  
  If hFile = 0 Then nJC/yS|  
    MsgBox TmpFile & ": File Open Error", vbOKOnly ^M
_0M  
    Exit Sub +`'=K ;{U  
  End If jbZ%Y0 km%  
  '采集参数记录文件 {$5?[KD  
hBCFile = FreeFile() bVO{,P2o  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile [+j}:u  
   }V:ZGP#!'  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 B~xT :r  
If hMEM = 0 Then 9=YX9nP  
    fStatus = GetLastError dTcrJ|/Y  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ Ti:PKpc  
     & "请向技术人员报告该错误代码。", vbOKOnly =K
qb V{!  
    CloseHandle hFile 2)cq!Zv  
    Exit Sub =n7QLQU  
End If *jE>
(J`  
}M*yE]LL;Z  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) EVYICR5g  
If hMemWork = 0 Then r~N:|ip=  
    fStatus = GetLastError ^/b3_aM5d  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 1g<jr.  
     & "请向技术人员报告该错误代码。", vbOKOnly |soDt<y+L  
     '释放已成功分配的内存 ^qvN:v$1  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Jga;
nrU  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) KsVN<eR{  
     8 =\}#F  
    CloseHandle hFile f2ea|l  
    Exit Sub j%%& G$Tfu  
End If QmxI;l  
dPvRbwH<  
' Test writing Pk)>@F<  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& s aY;[bz}  
     jjLx60|{  
   '初始化采集卡参数 v{tw;Z#  
   iCurrentCard = -1 *5T^wZpj)  
   hBoard = okOpenBoard(iCurrentCard) g4z*6L,u  
   Debug.Print hBoard 2nz^%pLT  
   If hBoard = 0 Then 7\.{O$Q  
      ExitGrabber 0;6
eSmF  
      End ^6g^ Q*"  
   End If GP<PU  
   okGetBufferSize hBoard, mBufferAddr, BufferSize J;8M._  
   If mBufferAddr = 0 Then Q &~|P}   
     MsgBox "缓存不存在！" :Q]P=-Y8  
     ExitGrabber C^QpVt-T  
   End If pg0Sq9qCN  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) l|{q8i#4V  
   dA03,s  
   Wl? 0|{W  
   currentBr = 128: currentContr = 128 IPHZ~'M  
   '设置视频输入参数 8U86-'Pq  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 xNAX)v3Z  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input P]cC2L@Vbi  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Q^trKw~XNy  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 ~[ a6  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式
'/O >#1  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 ?E +[  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） 1xBgb/+  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) Z/G`8|A  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) mQd L"caA  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 7H=V|Btnc  
   7F$G.LhMw  
   '设置采集参数 K)DpC*j  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 p#;I4d G  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ^?<gz!(-  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 {$AwG#kt  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 ; ,9:1.L  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式
mZ_643|  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 k7ye,_&>  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 \k 9EimT}  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 g$S|CqRG  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 d BRK6hFC  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 v0q(k;Ya  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 ?2q4dx0  
   "($"T v2  
   dQ#$(<v[  
   okCloseBoard hBoard E!"N}v  
   Sleep 50 Ar{7H)V:  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 {f1iys'Om  
   e)BU6m%  
   '设置数据传送方式 W*.j=?)\[  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 4J5 RtK  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 y).dw(  
   0)Nu  
   sRECT.Right = -1   '用于获得当前设置值 1buVV]*~  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) M1HGXdN*B  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom !94qF,#1  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 ^K3Bn  
   sRECT.Left = 0 a* 2JLK  
   sRECT.Top = 0 i0q<,VSl$_  
   sRECT.Right = sRECT.Left + FrameW -_[ZRf?^  
   sRECT.Bottom = sRECT.Top + FrameH * 2 <Dk6o`7^N  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ^jYE4gHM  
   IEmjWw4  
   sRECT.Right = -1   '检查新设置值 i(O+XQ}Fyx  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) cZR9rnZT  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom |&u4Q /0  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) )JA9bR <  
   @h=r;N#/`P  
   If TESTSignal = False Then BS*Y3$  
      'ExitGrabber ,azBk`$iQr  
   End If %^KN
Y ;E  
   vCX
54  
   Ah:d2*SR4  
   5.M82rR;~  
   '设为实时采集状态 4"^v]&I  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) BWF>;*Xro  
   7ILb&JQ!%{  
   P!xN]or]u  
   '单帧采集 ;M<R  e  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 $Cnv]1%  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) SPu+t3  
   okCaptureTo hBoard, BUFFER, 0, 1 'single y?P4EVknM3  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 ]L6[vJHx  
   '   Sleep 20 )i/x%^ca$  
   'Loop hEhvA6f,  
   okGetCaptureStatus hBoard, True }kZ)|/]kn  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize W!Fu7a  
   '写入768*576测试图象 GtLnh~)  
   ArrayToBMP TmpBMP
ssY5g !%  
   !-AK@`i.  
   '打开数据库 j"5 $m@lgn  
   Set conn = New ADODB.Connection F<0GX!p4u  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ G
r&YzbSX  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ }Gf9.ACQ  
      "; Mode=Read|Write" N!lQ; o'  
   conn.Open %LjhK,'h  
   )dh _eqnX  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) s:zz8oN  
   frmRecord.Visible = True XlJA}^e  
   frmQuery.Visible = True sD=iHO Am  
   Load frmReceiveFromComm $*$X5  
   5c ($~EFr  
   '调试参数 R1?LB"aN  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then $97EeE:{M  
     SignalBox.Visible = True K#;EjR4H  
   End If 9 M;k(B!  
   If InStr(UCase(Command()), "/COMM") > 0 Then |SX31T9rG  
     frmReceiveFromComm.Visible = True :meq4!g{1  
   End If b|Sjh;  
S; Fj9\2)I  
End Sub y^:N^Gt  
S;tv4JY  
Sub ExitGrabber() jJqq:.XqB8  
  '关闭数据库 rO[ Zx' a  
  '关闭采集卡 M$Or|HT
G  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) wl5+VC*l0  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) ~5:-;ZbZ  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) l1 UN.l'p  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) BTnrgs#[  
  okStopCapture hBoard _z6" C8W  
  okCloseBoard hBoard b wqd`C  
  CloseHandle hFile 5H!6m_,w  
  Close #hBCFile wOV} <.W  
  conn.Close d$5\{YLy
 
  End }.t8Cy9G  
End Sub 6Eu"T9(  
GUcGu5tw:  
Function ArrayToBMP(ByVal File As String) UFPSQ  
Dim BytesWrite As Long 9s2N!bx  
x5(B(V@b  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ vYNu=vnM  
  CREATE_ALWAYS, 0&, 0&) tlyDXB~+  
g9G 8;  
If hTmpFile = 0 Then @)x8<  
   ArrayToBMP = False v5A8"&Jr  
   Exit Function D` abVf  
End If }@TtX\7(D  
I*4g ;1x  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN +`&-xq76  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& ? t_$C,A+  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN B&Iy_;  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& pxV@fH+`  
w,VUWja  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN =z4kK_?F,  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 5pz( 6gA  
~]78R!HJ  
If BytesWrite < pFrameSize Then 3?r?)$Jk  
  ArrayToBMP = False 9jf2b  
End If oi\e[qE  

~8tb^  
CloseHandle hTmpFile q[
5&  
9B
9:lR  
End Function Dssecc'  
chszP{-@X  
Function ArrayToBMP1(ByVal File As String) Yq0jw&v  
mw flx8  
Dim BytesWrite As Long ' }T6dS  
4fL/,j/^  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ~# PC(g  
  CREATE_ALWAYS, 0&, 0&) + 0 |d2_]E  
7-j=h e/  
If hTmpFile = 0 Then ay>u``$R  
   ArrayToBMP1 = False ?TMrnR/d  
   Exit Function {w52]5l  
End If {GhM,-%e  
L4!T  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN q3e^vMK "  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& NsF8`rg  
ICm/9Onh&  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN $E6b u4I  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& EZ)$lw/!J  
JXAH/N&i  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN ;oivG)hJl  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& I%tJLdL  
HwxME%w  
If BytesWrite < pBufferSize Then ZnZ`/zNO  
  ArrayToBMP1 = False (aX6jdvo  
End If " "{#~X}  
8dCa@r&tz  
CloseHandle hTmpFile xC YL3hl  
dPb@[k  
End Function cIOM}/gqv  
o
l8|  
'使用该过程建立的文件要求在用后关闭 HOb0\X  
Public Function ArrayToBMP2(File As String) As Boolean L
@x#:s=  
dW9Ci"~v  
Dim BytesWrite As Long ByivV2qd{  
'[ `pU>9  
ArrayToBMP2 = True Zd<8c^@  
'eg;)e:`b+  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ !~QmY,R  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) dFzlcKFFD  
2>'/!/+R  
If hTmpFile = 0 Then 't#E -+o  
   ArrayToBMP2 = False A[Pz&\@  
   Exit Function VjGtEIew  
End If Y N*"q'Yz_  
IiB"F<&[j{  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN eG08Xt|lc  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& 'w`3( ':=  
Av,E|C  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN KiYz]IM$4  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& $zD}hO9  
+&qj`hA-b  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN ~O~R,h>  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& xO<Uz"R  
ES9|e
o6  
If BytesWrite < pFrameSize Then o}6d[G>  
  ArrayToBMP2 = False :M9 E  
End If /2fQM_ ,P  
 o
\-:  
CloseHandle hTmpFile ZE4xF8  
%Kc2n9W  
End Function zOT(>1'  
c5AEn -Q  
Private Function TESTSignal() As Boolean ~]C m   
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long 3-U@==:T  
}1? 2  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) H-'~c\)  
`%Jq^uW  
If extsign = 1 Then .!yw@kg  
   TESTSignal = True _ su$]s  
Else yGX"1Fb?;x  
    If extsign = 0 Then <j&LC /]o  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly FWl'='5L  
        TESTSignal = False rF)[ Sed:T  
        Exit Function RJ~I?{yR0[  
    End If a6epew!2  
End If [.LbX`K:  
6+ C
7vG`  
'测试视频输入类型 qIg^R@  
'video type (C60HbL   
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 [fl^1!3{  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) H
iPd|D  
If videotype = 1 Then 9xM7X?  
        '"隔行信号(Interlaced)" lbnH|;`$]m  
Else D&nVkZP>  
   If videotype = 0 Then pHv~^L%=  
       '"逐行信号(Non-interlaced)" +X4/l" |  
   Else G;yh$n<"  
     If videotype = -1 Then '/~j !H4q9  
       ' "不支持" obt Xtqew  
     End If bqSp4TI  
   End If vj4n=F,Z  
End If ?)mM]2%%  
&C6Z{.3V  
'测试垂直扫描线数 ,-.
a! a  
'video scanlines :}3;z'2]l  
scanlines = -1 d!#qBn$*[  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) (f>~+-IL  
    If scanlines = -1 Then \8iWcqJktN  
        ' "不支持" Hl b%/&  
    Else rBrJTF:
.  
        'Trim(Str(ScanLines)) + " 行数/幅" 6U[bAp  
    End If +9[s(E?SY  
9,>u,  
'测试帧频 m j@{hGP  
'video field frequency \K%A}gn He  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) > ?<C+ZHh  
    If fieldfrq = -1 Then !R"iV^?V  
        'lblSignal(8) = "不支持" vY'E+M"+@  
    Else k+`e0Jago  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" pqnZ:'V  
    End If %eQw\o,a  
End Function Y/Q/4+  
e sDd>W  
-Gn0TA2/C  
Sub PicIdentify() #b5V/)K  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 0pl |  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 6ujePi <U  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 ,{VC(/d  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 i2Cw#x0s  
!/wR[`s9w  
  Dim fPTR As Long, cFrame As Long `&!J6)OJ  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer (|_N2R!  
     jw$[b=sa  
PHv0^l]B  
cFrame = 0 %\QK/`krp  
gbL!8Z1
h  
TF-k|##G  
Do While cFrame < tFrames J={R@}u  
   @-G^Jm9~\m  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) 18];fC  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) ,/6 aA7(  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize PA<<{\dp  
   <P #]U"?A  
  frmRecord.RText.Text = Str(cFrame) cr"AK"TQ  
  frmRecord.RText.Refresh MO-)j_o-Z  
       9~6)u=4sS"  
  If CheckMark = True Then '/v@q]!  
   ArrayToBMP TmpBMP n2(@uT&>  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) a^QyYX}\qR  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" 1GI/gc\  
   t8\XOj  
   DrawSlice j_Qkw ?  
   Qz9*o  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) U3 y-cgE  
   'If i = vbNo Then \\9$1yg  
   '  Exit Do z-;2)RkV2  
   'End If 5V"g,]'Nd  
   'cFrame = cFrame + 1 3gNVnmZG  
   0OAHD'  
  End If v5` Q7ZZ  
  DoEvents i{5 ,mS&  
  cFrame = cFrame + 1 RT$.r5l_@  
Loop rA6lyzJ  
End Sub Y1Sfhs)  
/ +9o?Kxya  
 }J-+^  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean LJ+Qe%|  
SxWK@)tP  
'如标志区模式反差存在则为TRUE，否则返回FALSE wU1h(D2&h  
F
3pBk)>a\  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long L2 ^-t7  
CheckMark = True +*vg)F:  
   b%"Lwqdr7  
'复制标志区 E[E7GsmqV  
For i = 1 To mkH NvU~?WN  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW M->$'Zgh`  
Next i ,sln0  
WPu{ ]<pl  
For j = 1 To PilarW * PilarH / 2 5\\a49k.p  
   mTop = mTop + MKpilar(j) ZQ'bB5I  
Next j N]iu o.  
mH\eJ  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH !i77v, (#|  
   mBot = mBot + MKpilar(j) 5^7q 2".  
Next j @EV*QC2l;Y  
4g}'/  
mTop = mTop / PilarW / PilarH * 2 #I] ^Wo  
mBot = mBot / PilarW / PilarH * 2 E0-<-w3'  
?O.1HEr  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 Ut
 hH  
 Re^~8q[  
'平均值极值化 bUBQ  
  For j = 1 To PilarH * PilarW \.,qAc\[  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) I|oS`iLl$  
  Next j "Acc]CqH*  
   5}"@$.{i  
mTop = 0: mBot = 0 l\%LT{$e  
For j = 1 To PilarH * PilarW / 2 /swNhDQ"o  
  mTop = mTop + MKpilar(j) %?WR9}KU0  
Next j ]F81N(@:F  
?OFl9%\ V  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW 8,m3]Lg  
  mBot = mBot + MKpilar(j) [/iT D= O,  
Next j `R+I(Cb  
JLFZy\  
@.Su Hd  
  mTop = mTop / PilarH / PilarW * 3 /yn%0Wish  
  mBot = mBot / PilarH / PilarW * 3 Kfl#78$d  
   D`C#O 7.N  
_)6N&u8  
If mBot > iWhite And mTop < iBlk Then 67{>x[  
  CheckMark = True D<:J6W7]
 
Else B
y7?<A  
  CheckMark = False `7mRUDz  
End If : ZWKrnG  
End Function klwNeGF]N  
g&oAa;~o  
Sub Capture1Frame() 02F[4c~  
   okCaptureTo hBoard, BUFFER, 0, 1 'single Sp>v`{F  
   okGetCaptureStatus hBoard, True T_=iJ: Q  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize QFYO_$1Y)  
End Sub M)v4>Rw+  
*%,{<C, Y  
1YxG<K]  
Sub CopyMark(iBlk As Integer, iWhite As Integer) eK=<a<tx  
'复制标志区并返回标志区暗区与亮区的亮度平均值 a
][QY1E@?  
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 fu]mxGPc  
   \8e27#PJR  
'复制标志区 jJOs`'~Q\  
For i = 1 To mkH H:jx_  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW BJ,9C.|  
Next i +'f+0T\)  
a/v!W@Zz}  
For j = 1 To mkW * mkH / 2 q PI1\!z6  
   mTotal = mTotal + MKpilar(j) SV}C]<  
Next j }aC@ov]2  
[;n/|/m,  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 ,2C {X+t  
7\xGMC ctM  
mTotal = 0 m}oqs0xx  
For j = mkW * mkH / 2 + 1 To mkW * mkH zIE{U  
   mTotal = mTotal + MKpilar(j) g!*5@k|C  
Next j J jp)%c#_  
U1!#TD)@  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 p,'Z{7HG  
?cRGdLP'D  
'背景亮度 HX&G  k  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW yoc;`hO-  
  For i = 1 To 4 * FrameW Sl7x>=  
    bsTotal = bsTotal + BsLine(i) y +2  
  Next i Sq Y$\&%  
  bsAV = bsTotal / FrameW / 4 q}'ww  
FC BsC#
 
End Sub 2S^:fm}  
2MQ XtK  
G!L(K  
Sub AdjIMGbright(Optional bInit As Boolean = True) 8\H*Z2yF+  
Spqbr@j  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） IqW4Q1>f  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 Gi=s|vt  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 ~Y.I;EPKt  
     Ub_!~tb}?  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer $/p/9 -  
   j[e<CGZ  
  '按标准亮度与对比度采集一帧，确定背景亮度 9z0G0QW[  
  currentContr = 128   '初始对比度 ! O~:  
  currentBr = 128   '初始亮度 uz%<K( :Ov  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 &ap&dM0@%a  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 i3[%]_eP.  
  DoEvents l1?$quM^V  
  Capture1Frame RL|d-A+;  
  '获得图像上缘4行象素 T1YCld  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW ^KRe(  
  CopyMark iBlack, iBright   '图像标志区亮度 v+b#8  
  For i = 1 To 4 * FrameW
6 J B"qd  
    bsTotal = bsTotal + BsLine(i) 2b i:Q9  
  Next i R5KOa
i!  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 #FNSE*Y  
   yJRqX]MLA  
  Select Case bsAV N9}27T+4  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 <jwQ&fm)/R  
       currentBr = 150 E@(nKe&6T_  
       currentContr = 60 g,61'5\  
     Case 61 To 80   '有可见背景 {k"t`uo_  
       currentBr = 140
jr`;H  
       currentContr = 70 .%x%b6EI  
     Case 81 To 100  '有清晰背景 CNkI9>L=W`  
       currentBr = 128 ,^K}_z\9f  
       currentContr = 80 rTmVHt  
     Case 100 To 150  '有明亮背景 (Q4
hm]<  
       currentBr = 140                '5:30-6:00钟实测数据 )oU%++cdo  
       currentContr = 50 #PJHwvr  
     Case 151 To 180 I)YUGA5  
       currentBr = 130  'K7m!y  
       currentContr = 60 |3{"ANmm'  
     Case 181 To 220  '背景全为白色 K}j["p<!  
       currentBr = 110 &Fg|52  
       currentContr = 130 |@*3 nb8  
     Case 221 To 255  '背景全为白色 wdo(K.m  
       currentBr = 100 rQb=/@-  
       currentContr = 100 fb*h.6^y9  
  End Select gL(_!mcwu  
   5HqvSfq>?  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 :H(w W   
        Case 100 To 150 |T) $E  
          currentBr = currentBr - 10 hzcSKRm  
        Case 151 To 255 z?I"[M  
          currentBr = currentBr - 20 =lOdg3#\a  
  End Select \)'5V!B|s  
   3Ud{W$Ym  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ALY3en9,  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 oH]_2[ !  
End Sub e\7AtlW"  
q4y sTm  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) ^1mnw@04  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long 2P(6R.8;6  
    
T?+%3z}8  
    For i = 1 To 8 o0}kRL  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128&
D<wz%*  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& GnFm*L  
    Next i V<&^zIJUR  
     V7}]39m(s  
    For j = 1 To 1024 s,;7m  
      L1 = L1 + LeftBK(j, 0) \MU-D,@  
      L2 = L2 + LeftBK(j, 1) fuQk}OW{  
      R1 = R1 + RightBK(j, 0) E3"j7y[S  
      R2 = R2 + RightBK(j, 1) dMlJ2\]u  
    Next j UrRYK-g  
    diffL = Abs(L1 - L2) / 1024 + \jn$>E  
    diffR = Abs(R1 - R2) / 1024 &ra2(S45  
End Sub \~BYY|UB;W  
WZ6'"Cz`  
Function CheckSlice() As Boolean 7RZ HU+  
  CopySlice avSL, avSLR, avSLL XEe$Wh  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then JUpb*B_z  
    CheckSlice = True !+V."*]l  
  Else S\dG>F>S  
    CheckSlice = False vKFEA7  
  End If !(8)'<t9  
End Function B"Hz)-MW  
lK%)a +2  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) #Y%(CI  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long R}E$SmFg  
  For i = 1 To FrameH F6Ne?[b  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize _fM=J+  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize h2P&<ggqX  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize >z|bQW#2  
  Next i P
|tNmv[;  
  For i = 1 To FrameH Is[n 7Q  
    For j = 1 To sSize dIq*"Ry+~  
       total = total + Slice(j, i) nIEIb.-  
       totalL = totalL + SliceL(j, i) Memb `3  
       totalR = totalR + SliceR(j, i) K3.z>.F'h  
    Next j HrS-o=  
  Next i "~:P-]`G  
  avSL = total / FrameH / sSize C-sFTf7  
  avSLR = totalR / FrameH / sSize l 0K_29^  
  avSLL = totalL / FrameH / sSize >v'@p  
End Sub U)6Ew4uRxV  
&\iMIJ-  
Sub DrawSlice() %$6?em_  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B $g&_7SJ@  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B ,~G:>q$ad  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B +k{l]-)1  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) K +l-A>Ic  
End Sub <0btw
sv}  
Sub DrawMark(pic As Control) 8JojKH  
   Dim i As Long, j As Long vtw97G  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B 044Q>Qz,  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B k!0vpps
 
   For i = 1 To PilarH Ie7S'.Lmq  
     For j = 1 To PilarW @>q4hYF  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) ;;}}uW=  
     Next j n3_|#1Qu  
   Next i Y;1s=B9  
End Sub c1M *w9o  
A)80qx:  
Function avIMG() As Integer ">v-CSHY  
  Dim i As Long, j As Long, totalIMG As Long AvZOR  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize cMoBYk  
  For i = 1 To pFrameSize Egi(z9|Pp  
    totalIMG = totalIMG + pBuffer(i) xFA+ZjBC  
  Next i XE S$V15  
  avIMG = totalIMG / pFrameSize r*kz`cJ  
End Function /:ju/~R}  
J 7HOSFwXn  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer 9|l6.$Me/  
  Dim i As Long, j As Long, totalIMG As Long 4K0Fc^-  
  For i = 1 To FrameH RH^;M-'  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth UWW'[gEP1  
  Next i <~hx ~"c  
  For i = 1 To FrameH * barWidth -?L3"rxAP  
    totalIMG = totalIMG + pBuffer(i) Z\S'HNU  
  Next i x }.&?m  
  avRegion = totalIMG / pFrameSize B,4 3b O  
End Function RV>n Op}R  

一共这么多文件。 49Hgq/uO  
3^`.bm4 ^  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 1i 7p'  
第6车皮 { PkPKp  

s@K #M  
F>ps&h  
第9车皮 =`t%p1   
[(iJj3s!  
  

从这里里分离出来的。

qViolmDz  
'+iqbcUd,  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 i]IZ0.?Y  
3t$)saQR  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ QE~#eo  
Jc,{n*  

继续填个坑： S<DS|qOo  
gfU!sYZ  
用VBA控制WORD自己修订学生毕业文的格式。 r^!P=BS{