引用

引用第20楼newport93于06-14-2010 13:47发表的  : ?{J!#`tfV  
OHp5z? z  
老五，I 服了U。 wODvc9p}]  
sy<iKCM\  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 EZr6oO@Nc  

=fG:A(v%}  
Z>A{i?#m  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! XQ;I,\m  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : Rl@$xP  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? snMQ"ju  

Lx+`<<_dJ  
6$e]i|e  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : do'ORcZ  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 !C`20,U  

P4%>k6X  
rWr/p^~  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 {8m1dEC^@Q  
YBylyVZ  
可以从宽不？

引用

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

ewQe/Fq  
t?.\|2  
其实标题没有什么，卡总既然改了就不必再改回了。 hho%~^bn(  
sRi%1r7  
主要是当初写的时候真是顶着锅盖写的。 ,i! [QXZ  
(6-y+LG  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : l_ZO^E~D_  
哦, 打倒忽悠大家的家伙.      pqOA/^ar  

YV4 :8At1  
Jxf}b}^T  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : gj[zka0_  
每个人的故事对其他人都是故事, 0c`sb+?  
自己的故事也是其中之一. "-28[a3q  
跳出来看, :&qC<UD  
不过是众人中的一个人的故事. *&h6*zP?  
n}Vbdx lN  
所以,接着听故事. u
/;
_?zI  
+<GrRYbC  
女人们有兴趣的就等老伍开个新帖或者跟贴, Y'2-yB  
听他痛说恋爱革命历史.... >,kL p|gA  
2.!1kije  
杂家接着听他自学程序员历史, ZMP?'0h=  
高级程序员考了吗?  +jv}\Jt  

Ko4)0&  
u"*J[M~  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ ?ISI[hoc  
3,%nkW  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 g%+ql[(4  
%Fs*
#S  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 "IOC[#&G  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : 0T7M_G'5Q  
引用第19楼伍胥之于06-14-2010 12:33发表的  : Xs{/}wc.q;  
aIQrb  
bta0?O #  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 <m~T>Ql1  
k,a,h^{}j  
我连一级也没有考过。 jQY>9+t  
. [[#xES21F  

Q~x*bMb.  

引用

5JO[+>  
矬子里拔将军... Up_>y>x  
你们那里的俗语是吧? %j~9O~-  
}*xC:A%aS  
我们这里说"矮子里拔长脚"..应该是同一个意思...  I/u
'bDq  
*U( 1iv0n  
有趣....各地有表达意思一样却方式不同的俗语.... s'R~r  
2qt=jz\s  
;%v%K+}r  
你的文章写的有脸皮,没屁眼的, 8W(<q|t  
让看客大为不满... Tbe_xs^  
m]bL)]Z  
你等着,,估计你以后接到的午夜凶铃就多了... V;M3z9xd  

cjCE3V9X  
z:dXc  
我到现在也没有接到你的午夜凶铃呢！ 7~nIaT  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : wJ;9),fL  
伍SIR，再次抱拳佩服 J`U$b+q6  

!X \Sp}  
daaga}]d  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : avYh\xZ  
佩服，玩也玩得这么专业！  e B9m4  

17MN8SfQ  
}w|=c>'_}  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : VC_3ll]vr  
XY$cx~  
介个真的看不懂。 K4K3<Pg  
你说你老啦，喜欢怀旧了，才想起来填坑。 <uWJ>sg^6  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 |r<.R>  

)VSGqY r#  
;I0yQlx|U  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 v]d?6g  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ <+mO$0h"r  
DWORD dwCB; $AL|d[[T[  
LARGE_INTEGER  offset; 1*eWvYo1  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); U3VsMV*Y  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); s525`Q;  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ X~<>K/}u5  
DWORD error = GetLastError(); //4p1^%  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); D%5 {A=  
return FALSE; DI"dY ug#  
} mtHi9).,y|  
return TRUE; BhhK|U/  
} `siy!R  

'VB 6.0 版 M\$<g  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 }!J/ 9WKgU  
g'l7Jr3  
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 \C'I l w  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long E!(`275 s  
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 (t"YoWA#m  
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 [))2u:tbS\  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long @%5F^Vbd  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 \[hrG?A  
7u&H*e7  
)9;kzp/  
Private Const GENERIC_READ = &H80000000 3`C3+  
Private Const GENERIC_WRITE = &H40000000 =fu_ Jau}  

z<C~DH  
Private Const FILE_SHARE_READ = &H1 y|2g"J  
Private Const FILE_SHARE_WRITE = &H2 iaq:5||,  
Private Const OPEN_EXISTING = 3 rnt$BB[g  
R.n`R|NOd  
Private Const INVALID_HANDLE_VALUE = -1 p_kTLNZd9  
zfT'!k
b,(  
'//file seek $(<*pU  
Private Const FILE_BEGIN = 0 mhHm#  
Private Const FILE_CURRENT = 1 5D q{"@E  
Private Const FILE_END = 2 EzY scX.[  
n$\6}\k  
Private Const ERROR_SUCCESS = 0& >=RHE@  
s*A|9uf5  
'//device io control Lh5+fk~i~8  
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 K`AW?p^$Y  
"MVN/Gl  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 BfO}4   
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 RWEgUDX^/  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 T=)L5Vuq<  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 5E!|on  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C rO2PbF3  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 5tbiNm^X  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F 4QN6BZJ5  
^dp[Z,[1z  
'//type LnACce ?b  
Private Type LARGE_INTEGER Bg 8t'dw?K  
    lowpart As Long nqw*oLFQ  
    highpart As Long C^ k3*N  
End Type ,hcBiL/  
5Qe
}v  
Private Enum MEDIA_TYPE u>-uRz<)t  
    Unknown DW;.R< 8  
    F5_1Pt2_512 ?\ i,JJO  
    F3_1Pt44_512 D/!G
]hx  
    F3_2Pt88_512 PeR<FSF ,i  
    F3_20Pt8_512 ;kcFQed\w  
    F3_720_512 \?Oa}&k$F8  
    F5_360_512 r|sy_Sk/{  
    F5_320_512 iOA3x 8J  
    F5_320_1024 U S~JLJI
 
    F5_180_512 ,jdKcWy'  
    F5_160_512 A_dYN?^?|  
    RemovableMedia 9cHNwgD>v  
    FixedMedia s!zr>N"  
End Enum O
Tr
!?xi  
s?gXp{O?X  
Private Type DISK_GEOMETRY _KlPbyLU  
    Cylinders           As LARGE_INTEGER m~\m"zJ4  
    MediaType           As MEDIA_TYPE (4/`@;[  
    TracksPerCylinder   As Long r'}k`A5>  
    SectorsPerTrack     As Long -Z#]_C{Y-)  
    BytesPerSector      As Long I5AjEp  
End Type RI].LB _  
_a02#  
'//private vars CX@HG)l  
Private hDisk           As Long             'disk handle 4?6'~G$k  
Private lpGeometry      As DISK_GEOMETRY    'disk info gcY~_'&u  
Private lBufferSize     As Long             'the buffer size of read/write s</ktPtu  
Hwi7oXP  
Public Function OpenDisk(ByVal FileName As String) As Boolean m+JG e5fR<  
'// 打开磁盘 =I*ZOE3n  
    hDisk = CreateFile(FileName, _ 1 bx^Pt)  
                        GENERIC_READ Or GENERIC_WRITE, _ N_~Wu  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ 3j
Q$72_  
                        ByVal 0&, _ $[9V'K  
                        OPEN_EXISTING, _ gj(l&F *@  
                        0, _ ?%TM7Z4  
                        0) 7B>cmi  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) d(cYtM,P  
End Function :j!_XMyT:  
@;-Un/'C;7  
Public Function CloseDisk() As Boolean [;\< 2=H  
'//关闭磁盘 {s^n|b}  
    CloseDisk = CloseHandle(hDisk) >Sl:Z ,g;  
End Function ^*T{-U'  
W!Os ci  
Public Function GetDiskGeometry() As Boolean XcW3IO  
'//获取磁盘参数 A
Fnlt  
    Dim dwOutBytes      As Long O#ajoE  
    Dim bResult         As Boolean o3`gx  
     @ F"ShT0  
    bResult = DeviceIoControl(hDisk, _ *xX0]{49q  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ fxCPGj  
                                ByVal 0&, 0, _ "gVH;<&]  
                                lpGeometry, Len(lpGeometry), _ 'Rf#1ls#  
                                dwOutBytes, _ AI`1N%Owi  
                                ByVal 0&) U8@*I>vA  
     b8xfV{3L  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack !!Gi.VL
 
    GetDiskGeometry = bResult 5nlyb,"^g  
End Function "MKsSty  
AHg4kG  
Public Sub GetDiskInfo(MediaType As Long, _ CX(yrP6;  
                        Cylinders As Long, _ +/ d8d  
                        TracksPerCylinder As Long, _ )eVDp,.^  
                        SectorsPerTrack As Long, _ t@mw f3,  
                        BytesPerSector As Long) k-p7Y@`+a  
'//返回磁盘的参数 6j.(l4}  
    MediaType = lpGeometry.MediaType o]k]pNO  
    Cylinders = lpGeometry.Cylinders.lowpart $+yQ48Wq  
    TracksPerCylinder = lpGeometry.TracksPerCylinder vVR CM  
    SectorsPerTrack = lpGeometry.SectorsPerTrack ;bu;t#  
    BytesPerSector = lpGeometry.BytesPerSector UEb'E;  
k{$"-3 ed  
End Sub eh# (}v  
j;c^pLUP  
Public Property Get BufferSize() As Long q+=@kXs>+  
'//返回每次读/写的缓冲大小 Q? |MBTo  
    BufferSize = lBufferSize I.0Usa"z  
End Property 5s2}nIe  
=cX"gI [  
Y  .X-8  
Public Function LockVolume() As Boolean yH0ZSv  
'// 将卷锁定 vG=$
UUh@~  
    Dim dwOutBytes  As Long jT_Tx\k  
    Dim bResult     As Boolean ]$%4;o4O  
     "h|0]y^2  
    bResult = DeviceIoControl(hDisk, _ n!,TBCNX  
                                FSCTL_LOCK_VOLUME, _ -|UX}t*  
                                ByVal 0&, 0, _ Ge
R-k9  
                                ByVal 0&, 0, _ |Szr=[  
                                dwOutBytes, _ o".O#^3H%  
                                ByVal 0&) -"b3q  
    LockVolume = bResult
15yV4wHr  
End Function s~'C'B?  
T_ #oMXZ/  
<qZ+U4@I)  
Public Function UnlockVolume() As Boolean iK23`@&%_  
'// 将卷解锁 N>#P 1!eP  
    Dim dwOutBytes As Long <cd%n-  
    Dim bResult As Boolean ]uXsl0'`V  
     Cl){sP=8W  
    bResult = DeviceIoControl(hDisk, _ o%s}jBo}  
                                FSCTL_UNLOCK_VOLUME, _ Aba%Gh  
                                ByVal 0&, 0, _ 246!\zf  
                                ByVal 0&, 0, _ `SpS?mWA  
                                dwOutBytes, _ N`:bvr  
                                ByVal 0&) 3^Q U4   
    UnlockVolume = bResult ty8!"-V1  
End Function <OFqUp*l  
" ~hjB  
m|
?J^_  
Public Function DismountVolume() As Boolean PW\FcT  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 Or~6t}f  
    Dim dwOutBytes As Long T[II;[EiE  
    Dim bResult As Boolean i(#c Yb  
     U-N/
Z\QD  
    bResult = DeviceIoControl(hDisk, _ <Ju
J`t  
                                FSCTL_DISMOUNT_VOLUME, _ , X+(wp  
                                ByVal 0&, 0, _ !q1^X% a  
                                ByVal 0&, 0, _ YuuG:Kk  
                                dwOutBytes, _ n]g,)m  
                                ByVal 0&) .EELR]`y7I  
    DismountVolume = bResult W-B[_  
End Function 8?R_O}U  
X
64I~*  
yM~D.D3H  
Public Function ReadDisk(ByVal Cylinders As Long, _ n
Fn`>kQ  
                    ByVal Tracks As Long, _ [~0q )  
                    db() As Byte) As Boolean gDBQ\vM8  
'//按柱面和磁道来读取磁盘数据 {N`<e>A]{  
    Dim iPos    As Long tUnVdh6L.B  
    Dim lRead   As Long + {dIs
 
     69w"$Vk  
    iPos = Cylinders * Tracks * lBufferSize %HS!^j3C%  
     q.Mck9R7  
    If SeekAbsolute(0, iPos) Then ;'+cT.cmH  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) M?CMN.Dw  
    End If @_Oe`j^  
End Function ^vz@d+\Kd  
meWq9:z  
Public Function WriteDisk(ByVal Cylinders As Long, _ _ o3}Ly}  
                     ByVal Tracks As Long, _ =1?yS3  
                     db() As Byte) As Boolean gx.]4v  
'//按柱面和磁道来写磁盘数据 fXQRsL8 ]  
    Dim iPos    As Long y6yseR!  
    Dim lRead   As Long Tj~#Xc  
     ml/O
  
    iPos = Cylinders * Tracks * lBufferSize S :|*wB  
      M)RQIl5  
    If SeekAbsolute(0, iPos) Then s$G8`$+i1  
        WriteDisk = WriteBytes(lBufferSize, db()) *XR~fs?/*W  
    End If S}I=i>QB  
End Function jv^L~<u  
I=-;*3g6  
!~kzxY  
'///////////////////////////////////////////////////////////////////////////////////// ^aMdbB  
'//file system sM_e_e  
(KU@hp-\  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean n#,l &Bx  
'//seek file ^@> Qiy  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte y=`(`|YW}`  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) |ZzBCL8q  
    If LowPos = -1 Then _YUF /B'  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) =l9#/G#R  
    Else |}Lgo"cTC  
        SeekAbsolute = True
Bbp9Q,4  
    End If HK.J/Zr  
     B)NB6dCp  
End Function {NDe9
V5  
bME3" e{O  
I(S6DkU  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean 00TdX|V`  
'//read data to array }e@-
[RJ!  
    Dim RetVal    As Long U /Fomu  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) |`/uS;O  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF %05a>Rf&  
    ReadBytes = Not (RetVal = 0) q,Q|Uvpk  
     YtQWAr
X,  
End Function v%Xe)D   
{<n)zLy  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean oa7Hx<Y  
'//write data from array !X_~|5.  
    Dim RetVal As Long 1
r4/McB  
    Dim BytesToWrite As Long uwzT? C A6  
    Dim BytesWritten As Long %j; cXN  
     bS6Yi)p  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) SW,Po>Y  
     aC` c^'5  
    WriteBytes = Not (RetVal = 0) TD9`SSpP  
End Function }A^,y  

这才是我当年写出的一个比较烂的程序 b5R*]  
kMXl {  
Main2.bas q"oNB-bz  
j+/*NM_y3  
Attribute VB_Name = "SubMain" j&5Xjl
>4  
Option Explicit +Eg# 8/q  
@9a=D<'>  
'采集文件与临时文件 U @|_5[nl  
Public Const TmpFile As String = "d:\30-0600.dat" r1]e:  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 g7-K62bb  
uUs>/+  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Tkf !Y?  
Public hBCFile As Long  '记录采集参数的文件 cGKk2'v?  
Public Const TmpBMP As String = "d:\1.bmp" hrF4 a$  
Public hTmpFile As Long ] fB{   
i/z7a%$   
}fZBP]<I(  
'采集窗口参数常量 i2E7$[  
Public Const FrameH As Long = 280& ks$G6WC  
Public Const FrameW As Long = 768& 8EA?'~"  
Public Const pFrameSize As Long = FrameW * FrameH m6D4J=59  
Q!v[ b{]8  
'标志区范围，用于识别车辆 k"$V O+}m  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X " cg>g/  
Public Const mkW As Integer = 28  '识别标志立柱宽度 ^Du_e(TiyK  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) 70eN]OY  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) TH &B9  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 7O#>N}|  
'车缝检测位置常数 0b'R5I.M  
Public Const sSize As Long = 32& @dNbL}qQ  
Public Const sPos As Long = 310& ,~#hHhR_  
Public Const sPosL As Long = 200& 5JXLfYTUI  
Public Const sPosR As Long = 500& {{\HU0g>&  
'车缝检测框位置 ).xWj VC  
Public Slice(1 To sSize, 1 To FrameH) As Byte ;q2T*4NN  
Public SliceL(1 To sSize, 1 To FrameH) As Byte +l(}5(wc  
Public SliceR(1 To sSize, 1 To FrameH) As Byte ,d#4Ib  
Public avSL As Integer, avSLR As Integer, avSLL As Integer yM@cml6Ox  
;U&VPIX$  
I4'j_X t  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 \mloR '  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 @T"385>  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 u.6%n.g  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long ?a@l.ZM*  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte v]~[~\|a  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 jYv !}  
9`AQsZ2  
\ :.p8`  
QR4o j  
'一次连续采集的帧数 3$54*J  
Public tFrames As Long ,fn=%tiUk  
zAewE@N#_  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 HFOp4  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 }: e9\r)  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize |1o]d$3m  
g,nE
iL  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte VbjW$?  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte ojri~erJE?  
Public pWorkSpace(1 To FrameW * FrameH) As Long :|Cf$2k7  
Public Const pBufferSize As Long = FrameW * FrameH * 2 6%-2G@ 6d  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 vNIQc "\-  
it$~uP |  
Public hBoard As Long   '采集卡标识 rH,N.H#]  
Public mBufferAddr As Long  '缓存地址 C'ZU .Y  
Public BufferSize As Long  '缓存大小(字节) "5Mo%cUp  
Public iCurrentCard As Long Yi`.zm  
Public CapStatus As Long ||f4f3R'  
Public iFrames As Long Qw:j2g2H7  
Public currentBr As Byte, currentContr As Byte $.Ni' U  
U' Cp3>  
Public hMEM As Long, mStatus As Long iKwVYL
 
Public Const hMemSize As Long = pFrameSize * 4 syF/jWM5  
Public hMemWork As Long F<[8!^l(z  
Public Const hMemWorkSize As Long = pFrameSize * 5 {$^|^n5j  
jk @]d5  
%~~QXH\  
trLs4o,  
'串口接收轨道衡数据 ^_uzr}LE`  
Public WeightFromCom As String EZ4qhda  
Public bReceiveComplete As Boolean dq2v[?*R  
aF:
LL>H  
k>"I!&#g  
Public Type GrayBMPHeader novZ<?7 5;  
  Tag As Integer V]
2Q92  
  FileLength As Long    '文件大小 DVd /OU  
  Reserve1 As Long ?9:\1)]  
  DataOffset As Long    '图像数据偏移量 aO1cd_d6x_  
  BMPHeaderSize As Long  '文件头长  ~$B,K]  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… <,{v>vlw  
                        'the following sizes are possible: a$ }^z  
                        '28h - windows 3.1x, 95, nt, … |dK-r  
                        '0ch - os/2 1.x j*"s~8u4  
                        'f0h - os/2 2.x jolCR-FDu  
9YKEME+:  
  ImageWidth As Long           '图像宽（像素数） Ts\7)6|F  
  ImageHeight As Long          '图像高(像素数) ]+AI:  
  PlaneNumber As Integer  '图像层数 SzgVvmM}  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap >qCT#TY  
                                        '4 - 16 color bitmap 2r,fF<WQ  
                                        '8 - 256 color bitmap [>E0(S]  
                                        '16 - 16bit (high color) bitmap j^gF~Wz^  
                                        '24 - 24bit (true color) bitmap 1K>4i. X  
                                        '32 - 32bit (true color) bitmap 0^=S:~G  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) vj pe'zx  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) i!NGX  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) 8Bhng;jX  
                                    '3 - bitfields (also identified by bi_bitfields) PA E)3  
  IMAGESIZE As Long  '图像数据字节数 (
_* a4xGF  
  hResolution  As Long  '水平分辩率  像素数/米 mN{$z<r  
  vResolution  As Long  '垂直分辩率 MEu-lM7v  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 !s$fqn 6  
  ImportantColors As Long ee0J;pP2#  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 vd~O:=)4  
End Type ]#nAld1cmy  
X^ovP'c2  
4
[?Q*f!  
Xp'KQ1w)  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader Vr'Z5F *@  
Public sRECT As RECT L>B0%TP^  
rTH@PDk>)  
p: o*=  
Public conn As ADODB.Connection <:?&}'aA  
Public rsTrain As ADODB.Recordset bWqGypq4  
Public rsOperater As ADODB.Recordset tc[PJH&P  
Public rsGoods As ADODB.Recordset &("?6%GC  
Public rsGood2 As ADODB.Recordset  [7bY(  
Public rsSender As ADODB.Recordset &>-Cz%IV  
Public rsReceover As ADODB.Recordset T*oH tpFj#  
Public rsTrainTMP As ADODB.Recordset jV(IS
D  
$jHL8r\e7  
#r1x0s40D  
'打开采集卡 |l9AgwDg  
'设置参数 rP'oUV_  
'设置为实时单帧采集到缓存方式 9} vWTt0  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 f*Kipg p  
z"<PveVo  
k@w&$M{tPF  
Sub Main() }V 1sY^C  
  Dim i As Integer, status As Long 8]O|$8'"  
     #\}hN ~@F  
   InitBMPinfo  z#y<QH  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 PSRGlxdO  
    BMPHeader.Tag = &H4D42 YXvKDw'95  
    BMPHeader.ImageWidth = FrameW -$7Jc=:>  
    BMPHeader.ImageHeight = FrameH zVIzrz0  
    BMPHeader.BMPHeaderSize = &H28 HV}NT~
 
    BMPHeader.PlaneNumber = 1 \sk,3b
-&'  
    BMPHeader.bpp = 8 B 7#;tCf  
    BMPHeader.Compression = 0 ]C!u~A\jq  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 Uc4 r  
    BMPHeader.vResolution = &H1274 L2 I/h`n"  
    BMPHeader.ColorsinBMP = 256 E_
++yK^=  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP '&"7(8E} *  
    BMPHeader.DataOffset = Len(BMPHeader) ]SQ_*$`  
    For i = 0 To 255 ^C(AMT  
      BMPHeader.Pallate(i) = RGB(i, i, i) T/H*Bo*=5  
    Next i k
z#DBh!&  
    BMPHeader.IMAGESIZE = FrameH * FrameW t[<=QK  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE \1tce`+  
5+U~ZW0|+  
txi m|)  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) IflpM]  
     :7R\"@V4  
    BMP1.ImageWidth = FrameW HjK|9  
    BMP1.ImageHeight = FrameH * 2 $1axZ~8sS  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight U}UIbJD*=  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE O&}07(  
H:|y u  
  '确定标志位置,为pilarX, pilarY确定初始值 )T>a|.  
   PilarW = mkW 2uB.0  
   PilarH = mkH  '此两项为固定值 |Oo WGVc  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) <Sz9: hg-  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 4o%hH  
   TqWvHZX  
   A3Su&0uaB  
  '连续采集记录文件 pRC#DHcHh  
  ' 建立一个缓冲区为页对齐方式的文件 B$\5=[U  
  If Dir(TmpFile) <> "" Then ;>PV]0bOm>  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ U<*dDE~z  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) t<e?f{Q5  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 (F @IUbnl  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 ]|-y[iu  
  Else 2W}RXqV<  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ ^0r@",  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) Y$(G)F
s  
  End If }%VHBkuc  
  If hFile = 0 Then &P\T{d2"  
    MsgBox TmpFile & ": File Open Error", vbOKOnly |_O1 V{Q=  
    Exit Sub "MyYu}AD  
  End If S`NH6?/uH  
  '采集参数记录文件 C ZJW`c/  
hBCFile = FreeFile() 5vS'Qhc  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile dZZ
Hk  
   I!bG7;=_  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 j*CnnM#n  
If hMEM = 0 Then UPbG_ #"wZ  
    fStatus = GetLastError o}[wu:>yk  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ UOa{J|k>h  
     & "请向技术人员报告该错误代码。", vbOKOnly ~WVrtYJu  
    CloseHandle hFile a1?Y7(alPU  
    Exit Sub v'|Dj^3[  
End If ;$W|FpR2  
*QrTZ$\C  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) sUg 7  
If hMemWork = 0 Then (j2]:BVu  
    fStatus = GetLastError c0tv!PSw  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ hRME;/r]X  
     & "请向技术人员报告该错误代码。", vbOKOnly WhkE&7Gk
 
     '释放已成功分配的内存 -q-%)f  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) towQoqv  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) u!t'J +:  
     _Wgg=A"G  
    CloseHandle hFile 9;:
Lf  
    Exit Sub %cBJ haR{(  
End If -`rz[";n  
wt-)5f'{  
' Test writing aa$+(  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& r1,RloyZS  
     ^.k}YSWut  
   '初始化采集卡参数 r=s7be  
   iCurrentCard = -1 9D&ocV3QV
 
   hBoard = okOpenBoard(iCurrentCard) zg)]:  
   Debug.Print hBoard r| YuHm  
   If hBoard = 0 Then xNT[((  
      ExitGrabber Wt_@ [email protected]  
      End PyIIdTm  
   End If OYe @P  
   okGetBufferSize hBoard, mBufferAddr, BufferSize eQMY3/#  
   If mBufferAddr = 0 Then XrYz[h*)!  
     MsgBox "缓存不存在！" ,UY],;ib  
     ExitGrabber c: _l+CgeH  
   End If gPDc6{/C<  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) m,-:(82  
   T@X!vCjf6  
   `2GHB@S"k  
   currentBr = 128: currentContr = 128 H=B8'N  
   '设置视频输入参数 htIV`_<Ro  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 ).xQ~A\.  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input 
y%43w4  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 <x,$ODso  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 (d@lG*K  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 *ozeoX'5D  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 si)920?E&  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） ^ng?+X>mP  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) 94H 6`  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) [03Aej  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 qRTy}FU1  
   `^RpT]S  
   '设置采集参数 ,b2Cl[  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 iQ:]1H s  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 Uh*V>HA#  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 ~Q5L)}8N  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 nd-y`@z  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 #p0vrQ;5f  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 3. Kh  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 Fz-Bd*uS  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 zxXm9zrLo  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回  R\)pW9)  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 gR%fv  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 X5=Dc+  
   )~rN{W<s`H  
   -fYgTst2  
   okCloseBoard hBoard k|1/gd5  
   Sleep 50 ~fEgrF d  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 =! /S |  
   7n {uxE#U)  
   '设置数据传送方式 4h?[NOA"  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 7)z^*;x  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 $:SHZe  
   uTngDk  
   sRECT.Right = -1   '用于获得当前设置值 |6$6Za]:  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ?PLf+S  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom =ejkE; %L  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 `5Q0U%`W  
   sRECT.Left = 0 )V} t(>V  
   sRECT.Top = 0 &Zd!|u  
   sRECT.Right = sRECT.Left + FrameW 
#\Lt 0  
   sRECT.Bottom = sRECT.Top + FrameH * 2 0zetOlFbO  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ,LX]  
   e5C560  
   sRECT.Right = -1   '检查新设置值 !f j DO!,!  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) 8h}o5B  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom .XTBy/(0  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) B xq(+^T  
   "4|D"|w I)  
   If TESTSignal = False Then mZ'`XAS~;  
      'ExitGrabber L3,p8-d9Z  
   End If y?;&(Tcbt8  
   Q% )fuI  
   !M
ceg  
   YrFB~z.V  
   '设为实时采集状态 b<NI6z8\  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) 3 rV)
JA  
   Js ~_8  
   K'Wg_ihA  
   '单帧采集 =rGjOb3+  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 o{lR_  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) *ax$R6a#X  
   okCaptureTo hBoard, BUFFER, 0, 1 'single g&) XaF[!  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 DhYQ>Gv8U  
   '   Sleep 20 c&J,O1){\  
   'Loop UOi8>;k`  
   okGetCaptureStatus hBoard, True i_Ab0vye  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize Z-.`JkKd8  
   '写入768*576测试图象 >
d&B:  
   ArrayToBMP TmpBMP GeD^-.^  
   0
DV  .1  
   '打开数据库 ymiOtA Z  
   Set conn = New ADODB.Connection I4,C-D  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ ^,qi`Tk  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ]:8:|*w  
      "; Mode=Read|Write" :[?hU}9  
   conn.Open w/#k.YE  
   :iP2e+j  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) {rBS52,Z#  
   frmRecord.Visible = True f9?\Q'v8  
   frmQuery.Visible = True Q!iM7C!8  
   Load frmReceiveFromComm { owK~  
   Z~CL|=   
   '调试参数 GMyzQ] @}  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then Z`Rrv$M!  
     SignalBox.Visible = True 9s7sn*aB#5  
   End If p<: b
Pw  
   If InStr(UCase(Command()), "/COMM") > 0 Then \x5b=~/
 
     frmReceiveFromComm.Visible = True R#DnV[!\  
   End If mbK$_HvU  
fczId"   
End Sub ' cR||VX  
~*@UQ9*p#  
Sub ExitGrabber() t
I~.3+F  
  '关闭数据库 ^ 9UKsy/q  
  '关闭采集卡 N^jQ\|A<  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 
v=R=K  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) mfc\w'  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) >hQeu1 ~W  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 8XIG<Nc  
  okStopCapture hBoard 3dTz$s/[  
  okCloseBoard hBoard yyW;VKN  
  CloseHandle hFile HN]roS t~  
  Close #hBCFile gi#bU  
  conn.Close wsYvbI!  
  End 4"U/T1&  
End Sub \] 1qAF
B5  
Lk9X>`b#B  
Function ArrayToBMP(ByVal File As String) = W$ f+  
Dim BytesWrite As Long #`?B
:  
;shhgz$  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ _8P0iC8Zg#  
  CREATE_ALWAYS, 0&, 0&) DD{-xCCR  
qwM71 B!r  
If hTmpFile = 0 Then * G!C 'w\$  
   ArrayToBMP = False bz<f u  
   Exit Function a<*q+a(*W  
End If y@Z@ eK3  
@(<C{  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN T
{<riJ`O  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& c@>Tzk%?"  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN :c)N"EJlI2  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& F !g>fIg  
XEl-5-M"  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN V(3^ev/  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 7&;M"?m&  
T)?:
q  
If BytesWrite < pFrameSize Then +twl`Z3n  
  ArrayToBMP = False DybuLB$f  
End If la+RK  
wVX]"o  
CloseHandle hTmpFile sxkWg>  
lA>^k;+ >  
End Function yyB;'4Af  
4+I@  
Function ArrayToBMP1(ByVal File As String) R~ n[g  
"H\1Z,P<m  
Dim BytesWrite As Long ;5Spdi4w  
B|XrjI?  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ H3CG'?{ _  
  CREATE_ALWAYS, 0&, 0&) iq*]CF  
;+jz=9Q-  
If hTmpFile = 0 Then WR,MqM20  
   ArrayToBMP1 = False d5jZ?
  
   Exit Function |C"( K-do  
End If /enlkZx=8  
.^ djt  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN i[_B~/_  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& m[n=t5~  
A{X:p3$eN  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN /6",#B}%b  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& wX<w)@  
4@19_+3  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN xU<WUfS1  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& )B'&XLK  
Sy()r 6n  
If BytesWrite < pBufferSize Then 
HueGARS  
  ArrayToBMP1 = False a4aM.o  
End If F#Y9 @E  
|I \&r[J  
CloseHandle hTmpFile cip5 -Z@8  
4:wVT ;?a  
End Function 4~<78r5m  
*Cf5D6=Q  
'使用该过程建立的文件要求在用后关闭 ^m pWQ`R  
Public Function ArrayToBMP2(File As String) As Boolean 5XtIVHA@{  
c[VVCN8dA  
Dim BytesWrite As Long %x{jmZ$}  
t@r>GHO  
ArrayToBMP2 = True ,Y9bXC8+dU  
F/ p/&9  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ ~i_YrTp  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) w]1hoYuV  
-4wr)zjfW  
If hTmpFile = 0 Then BPO)<bx_  
   ArrayToBMP2 = False [QUaC3l)  
   Exit Function FJ-X~^  
End If X6 E^5m  
<OgwA$abl%  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN AwnQ5-IR\  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& Ql>bsr}  
PzF>yG
[  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN %[S-"k
 
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& gi {rqM  
CZZwBt$P  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN u-</G-y  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& HE!"3S2S&+  
vo(riHH  
If BytesWrite < pFrameSize Then Z?JR6;@W  
  ArrayToBMP2 = False Z;/QB6|%  
End If 6sjd:~J:  
!U::kr=t  
CloseHandle hTmpFile zD^*->`p  
'_ZiZ4O  
End Function gug9cmA/Q7  
R?62gH  
Private Function TESTSignal() As Boolean Ob!NC&  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long Mbm'cM&}  
OTe h8h  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) d
a'1H  
xu%_Zt2/?j  
If extsign = 1 Then q
kXnpv  
   TESTSignal = True ~t+T5`K  
Else 1FA :"0lO  
    If extsign = 0 Then <=nOyT9  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly kB[l6`  
        TESTSignal = False ) KvGJo)("  
        Exit Function d)>b/0CZ  
    End If C*X=nezq  
End If &ci;0P#Q  
L0\~K~q  
'测试视频输入类型 !#y_
vz9  
'video type LUaOp "  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 ,F%2'W  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) ,{6Vf|?  
If videotype = 1 Then L`3;9rO  
        '"隔行信号(Interlaced)" Fv_B(a  
Else 4yK{(!&i+  
   If videotype = 0 Then R1C}S  
       '"逐行信号(Non-interlaced)" )B*D\9\Z  
   Else f/PqkHF  
     If videotype = -1 Then >;Ag7Ex  
       ' "不支持" je;C}4  
     End If Kj53"eW  
   End If <#nt?X n  
End If )WNw0cV}J>  
RE0ud_q2  
'测试垂直扫描线数 $U=j<^R}a  
'video scanlines 56JxHQu  
scanlines = -1 :%[mc-6.  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) eQqnPqi-  
    If scanlines = -1 Then LA]UIM@  
        ' "不支持" Llf#g#T  
    Else '2z1$zst,#  
        'Trim(Str(ScanLines)) + " 行数/幅" [_HY6gr  
    End If ]A&pXAM  
'[Zgwz;z  
'测试帧频 w%1-_;.aU6  
'video field frequency ;IOM3'5T@  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) :X*$U ~aQ  
    If fieldfrq = -1 Then J5!-<oJ/  
        'lblSignal(8) = "不支持" 9 1.gE*D  
    Else tp<v  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" gWD46+A){  
    End If 6%^A6 U  
End Function [
CG3&J  
.QU]  
EvYe1Y-  
Sub PicIdentify() ^]5^p9Jt"e  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 ni$;"RGC  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息
m)l'i!Y  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 oNhCa>)/  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 3ncN)E/@  
-{XDQ{z<%  
  Dim fPTR As Long, cFrame As Long =f?vpKq40  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer 70<{tjyc  
     Y{d-k1?s5  
%63s(ekU  
cFrame = 0 W"Tj.oCUG  

v#|y
r<  
icK$W2<8mg  
Do While cFrame < tFrames QQ,V35Vp[  
   !tzk7D  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) D_q"|D$SB  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) lFtH;h,==v  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize e_YTh^wU  
   G\ z5Ue*  
  frmRecord.RText.Text = Str(cFrame) =odKi"-6  
  frmRecord.RText.Refresh FLo`EE":O(  
       -K (>uV!?  
  If CheckMark = True Then "c.@4#/_  
   ArrayToBMP TmpBMP mCe"=[  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) Skg}/Ek  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" }Uu#N H  
   %At. nlss  
   DrawSlice ,!H`@K
l  
   <2af&-EGs  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) cJE4uL<  
   'If i = vbNo Then W m&*  
   '  Exit Do MW v(/_b  
   'End If '=0l{hv@  
   'cFrame = cFrame + 1 \`0s %F:V}  
   dv Vz#  
  End If F'-,Ksn  
  DoEvents 11vAx9  
  cFrame = cFrame + 1 oFb~|>d  
Loop Mt4*`CxtH;  
End Sub !]3kFWs  
EK&";(x2(  
.?`8B9w  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean _WR/]1R  
J#gG*(  
'如标志区模式反差存在则为TRUE，否则返回FALSE Kzx` E>,z'  
Tb:6IC7="  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long cd|/4L6  
CheckMark = True I~GHx5Dk  
   R`J .vMT  
'复制标志区 LAFxeo  
For i = 1 To mkH 9m.MGJbQ_f  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW ^ z`d2it  
Next i <naxpflom0  
8VtRRtl  
For j = 1 To PilarW * PilarH / 2 fg7  
   mTop = mTop + MKpilar(j) 99tUw'w  
Next j Jot7 L%,TB  
a/</P |UG  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH 4T]A! y{  
   mBot = mBot + MKpilar(j) M._;3_)%/  
Next j hSz_e  
K$l@0r ~k  
mTop = mTop / PilarW / PilarH * 2 '|<r[K  
mBot = mBot / PilarW / PilarH * 2 _T_6Yl&cf)  
lc3N i<3v  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 nDS\2  
6zi 5#23  
'平均值极值化 Y2IMHNtH  
  For j = 1 To PilarH * PilarW #KNl<V+c}1  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) T`bUBrK6g`  
  Next j p, T 4BO  
   ^( s(4|  
mTop = 0: mBot = 0 l"1*0jgBw  
For j = 1 To PilarH * PilarW / 2  7p- RPC  
  mTop = mTop + MKpilar(j) i&%m^p
 
Next j Vr@tSc&  
xI_0`@do  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW S17;;w0  
  mBot = mBot + MKpilar(j) zGdYk-H3TH  
Next j 8aJJ??o{  
i;atYltEJ2  
4jc?9(y
%  
  mTop = mTop / PilarH / PilarW * 3 ,^7]F"5
 
  mBot = mBot / PilarH / PilarW * 3 X~cdM1z?  
   "@^Q"RF  
==UYjbuU  
If mBot > iWhite And mTop < iBlk Then .D*~U
I  
  CheckMark = True f@gvDo]Y  
Else ][KlEE>W2  
  CheckMark = False "Zy:q'`o  
End If AB{zkEuK  
End Function hQ}_(F_H  
{V pko  
Sub Capture1Frame() dBwoAq`'  
   okCaptureTo hBoard, BUFFER, 0, 1 'single (I`lv=R"j  
   okGetCaptureStatus hBoard, True /M JI^\CA  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize \H9:%Tlp~4  
End Sub PCHKH  
Ms
Zx 0]  
-&Q+x,.%  
Sub CopyMark(iBlk As Integer, iWhite As Integer) CG95ScrX  
'复制标志区并返回标志区暗区与亮区的亮度平均值 S.{   
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 G3 |x%/Fbp  
   XS #u/!  
'复制标志区 ^ir)z@P?V  
For i = 1 To mkH l,~`o$_  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW ~<-mxOe  
Next i Z- t&AH  
R
58NTPm  
For j = 1 To mkW * mkH / 2 B &7NF}CF2  
   mTotal = mTotal + MKpilar(j) _%e r,Ed  
Next j -k@1# c+z  
QJ(5o7Tfn  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度
EDuH+/:n  
)dFPfu&HL  
mTotal = 0
OwEu S#-  
For j = mkW * mkH / 2 + 1 To mkW * mkH 5dhy80|g]  
   mTotal = mTotal + MKpilar(j) CiGXyhh  
Next j #.!#"8{0_  
t\h4-dJn  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 I

Mncl=1  
!^8X71W|  
'背景亮度 |Y8}*C\M.h  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW >28l9U  
  For i = 1 To 4 * FrameW 5F!Qn\{u{  
    bsTotal = bsTotal + BsLine(i) 4l{$dtKbI  
  Next i ?"^{:~\N  
  bsAV = bsTotal / FrameW / 4 Bd7B\zM  
=@pD>h/~  
End Sub p_ f<@WE  
Tt
F+~K  
r B{w4  
Sub AdjIMGbright(Optional bInit As Boolean = True) ~ g-(  
Y mL{uV$  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） '9=b@SaAj  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 MV
??S{^4  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 &2U%/JqY  
     PU[<sr#,  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer )t@9!V  
   ^_i)XdPU  
  '按标准亮度与对比度采集一帧，确定背景亮度 YQ.ci4.f  
  currentContr = 128   '初始对比度 4U_+NC>b  
  currentBr = 128   '初始亮度 q7<d|s
 
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 `N&*+!O%  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 xticC>  
  DoEvents gR}>q4b  
  Capture1Frame A&X(\c M  
  '获得图像上缘4行象素 Osncl5PD)  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW a~E@scD  
  CopyMark iBlack, iBright   '图像标志区亮度 u:AKp<'  
  For i = 1 To 4 * FrameW 4$.$j=Ct."  
    bsTotal = bsTotal + BsLine(i) H6%QM}t  
  Next i (? j $n?p  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 1$T;u~vg  
   6x|"1 G{  
  Select Case bsAV ZDuP|" ^  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 nf=*KS\v  
       currentBr = 150 f#mBMd j  
       currentContr = 60 6t/nM  
     Case 61 To 80   '有可见背景 oU`8\n](  
       currentBr = 140 .'N:]G@ !  
       currentContr = 70 $Wt0e 4YSu  
     Case 81 To 100  '有清晰背景 qpzzk9ba[  
       currentBr = 128 BH6)`0&2*N  
       currentContr = 80 &HBqweI  
     Case 100 To 150  '有明亮背景 |&OW_*l  
       currentBr = 140                '5:30-6:00钟实测数据 S`g:zb_  
       currentContr = 50 Tlc3l}B*Z  
     Case 151 To 180 =<Q_&_.60  
       currentBr = 130 n "?It  
       currentContr = 60 @v{lH&K:;  
     Case 181 To 220  '背景全为白色 P"d7Af  
       currentBr = 110 zmd,uhNc:  
       currentContr = 130 XCr\Y`,Z@  
     Case 221 To 255  '背景全为白色 Syv[[Ek  
       currentBr = 100 5p!X}u]  
       currentContr = 100 U$jw8I'.  
  End Select ?}|l )  
   /orpQ UHA  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 1{D_30sG.  
        Case 100 To 150 Cq\1t  
          currentBr = currentBr - 10 kHLpa/A  
        Case 151 To 255 8w1TX [b  
          currentBr = currentBr - 20 ,p2BB"^_i  
  End Select (1pI#H"f9  
   !l
xs1!:  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 "c5C0 pK0  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 8axz`2`  
End Sub C+ibLS4i  
-(*<2Hy4  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) I3sH8/*  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long RO.GD$ 3n  
     >SRUC  
    For i = 1 To 8 !_EL{/ko  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& k\->uSU9  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& 5@l[!Jl0k  
    Next i {6H%4n  
     n.9k<  
    For j = 1 To 1024 GVS-_KP\  
      L1 = L1 + LeftBK(j, 0) vxuxfi8x  
      L2 = L2 + LeftBK(j, 1) T,N"8N{K"  
      R1 = R1 + RightBK(j, 0) XfY~q~f8  
      R2 = R2 + RightBK(j, 1) K5l#dl_T  
    Next j [MLJs-*   
    diffL = Abs(L1 - L2) / 1024 pkTg.70wU  
    diffR = Abs(R1 - R2) / 1024 s}"5uDfn1F  
End Sub b^
wWg  
Pf,S`Uw;  
Function CheckSlice() As Boolean 6G2s^P1Dl@  
  CopySlice avSL, avSLR, avSLL L(Ww6
oj  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then qkQ_#  
    CheckSlice = True |]=. ^  
  Else @;>i3?  
    CheckSlice = False 2y6@:VxSh  
  End If ]j.=zQP?'  
End Function !;Hi9,<#7g  
"
>pW:apl%  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) %f??O|O3  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long xW|^2k  
  For i = 1 To FrameH S}fU2Wi  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize WZ}je!82  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize fDe4 [QQ8  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 6x18g(KbP  
  Next i ~yacJU=  
  For i = 1 To FrameH dLA'cQId  
    For j = 1 To sSize 0LI:R'P+P[  
       total = total + Slice(j, i) )gM3,gSS  
       totalL = totalL + SliceL(j, i) MV8Lk/zd?A  
       totalR = totalR + SliceR(j, i) r=57,P(:Ca  
    Next j zx)^!dEMM  
  Next i (EZ34,k'S  
  avSL = total / FrameH / sSize ?}f+PP,  
  avSLR = totalR / FrameH / sSize w\(LG_n|  
  avSLL = totalL / FrameH / sSize p#-ov-znp  
End Sub tF:'Y ~3 p  
6 0C;J!D  
Sub DrawSlice() $BIQ#T>qK  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B -anLp8G*  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B YA(_*h  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B _`RzPIS^  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) $xx5+A%,  
End Sub 6AS'MD%&  
Sub DrawMark(pic As Control) z3F ^OU   
   Dim i As Long, j As Long $7Sbz&)y3  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B DGfhS`
X  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B aJh=4j~.  
   For i = 1 To PilarH f1eY2UtWQ  
     For j = 1 To PilarW 9{OH%bF  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) 2 uuI_9 "^  
     Next j D@]gc&JN[  
   Next i 7\.Ax  
End Sub 31BN ?q  
`D2wlyqO6  
Function avIMG() As Integer TTNgnP  
  Dim i As Long, j As Long, totalIMG As Long a2:Tu  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize mX@Un9k  
  For i = 1 To pFrameSize P<+y%g(({  
    totalIMG = totalIMG + pBuffer(i) NpmPm1Ix .  
  Next i q\ihye  
  avIMG = totalIMG / pFrameSize dU!`aPL?  
End Function &uLxAw  
44s K2  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer k:?+75?$  
  Dim i As Long, j As Long, totalIMG As Long R<r"jOd]  
  For i = 1 To FrameH g4n&k  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth !83x,*O  
  Next i sOyWsXd+R'  
  For i = 1 To FrameH * barWidth fX.V+.rj  
    totalIMG = totalIMG + pBuffer(i) >z=_V|^$  
  Next i s3G\L<~mB  
  avRegion = totalIMG / pFrameSize ~&E|;\G  
End Function Y~RZf /`  

一共这么多文件。 k&nhF
9Y4  
o3H+.u
$  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 *8p\.za1  
第6车皮 M3Kpp_d_!  

IidZ
-Il  
|Sg *j-.  
第9车皮 #e%.z+7I  
^v3+w"2  
  

从这里里分离出来的。

'+vA\(K  
0iK;Egwm  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 OhmQ,  
7&"n`@(.!  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ +1!qs,  
V$i cWu  

继续填个坑： V8wKAj Ux  
Ppt2A6W  
用VBA控制WORD自己修订学生毕业文的格式。 Cb@3M"1: