引用

引用第20楼newport93于06-14-2010 13:47发表的  : [ sBD|P;M  
<G={Vfr  
老五，I 服了U。 R0WJdW#  
vEkz
5$  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 Z)<>d.  

I5mS!m/X  
[email protected] c OZ  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! p|%)uA3'/  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : lH[N*9G(  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? WE3l*7<@  

KQk;:1
hW  
$ _zdjzT  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : aw([email protected]]  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 sGV%O=9?2  

P
S>k67sI  
"B.lj)  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 46*[email protected](  
.; :[sv)  
可以从宽不？

引用

引用第10楼卡拉于06-13-2010 21:49发表的  : * ,,D% L  
老伍，对不住，我把你原来的英文标题改了，太不吸引人眼球了，有些人还当是英文的都不会去点击。我通篇读了一下，改成了现在的标题。如果你不喜欢，可以改回来。 HZR~r:_ i  

9hcZbM]  
*&LVn)@[`  
其实标题没有什么，卡总既然改了就不必再改回了。 w+PbT6;  
1'M<{h<sP  
主要是当初写的时候真是顶着锅盖写的。 }nuhLt1  
X|X6^}  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : |.0/~Xy-  
哦, 打倒忽悠大家的家伙.      'RC(ss1G  

t:9}~
%~  
g~S>_~WL  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : &cV$8*2b^  
每个人的故事对其他人都是故事, Oz#
$ x  
自己的故事也是其中之一. KwndY,QD  
跳出来看, gYn1-/Z>I  
不过是众人中的一个人的故事. M`*B/Fh2  
(\{9W  
所以,接着听故事. D}XyT/8G3  
9<[email protected]}w  
女人们有兴趣的就等老伍开个新帖或者跟贴, >9'G>~P~I=  
听他痛说恋爱革命历史.... \rY|l  
I\&..e0l  
杂家接着听他自学程序员历史, \bw71( Q  
高级程序员考了吗? UO47XAO  

,%w_E[2  
@Ck6s  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ 8xJdK'  
M
CD]
n  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 IAf,TKfe  
%6j|/|#]  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 ~  ' 81  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : D-\\L[  
引用第19楼伍胥之于06-14-2010 12:33发表的  : E]WammX c  
M,"4r^%k  
(C*G)Aj7  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 %Js3Y9AL C  
'uBXSP#  
我连一级也没有考过。 ny%-u&1k  
. W-<E p<7{  

LbOjKM^-  

引用

<&\HXAOd  
矬子里拔将军... 1,=U^W.G  
你们那里的俗语是吧? uNZJNrV%  
wvvMesX<L  
我们这里说"矮子里拔长脚"..应该是同一个意思... +6@".<  
I1^0RB{~  
有趣....各地有表达意思一样却方式不同的俗语.... S1(. AI~  
 /s.sW l  
 ?1?D[7$  
你的文章写的有脸皮,没屁眼的, #x$.  
让看客大为不满... o)
F^0t  
&1YAPxX  
你等着,,估计你以后接到的午夜凶铃就多了... V9z/yNo  

ke_Dd?  
8.HqQ:?&2t  
我到现在也没有接到你的午夜凶铃呢！ L3lf28W  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : PCDsj_e  
伍SIR，再次抱拳佩服 =UYZ){rt9E  

zC#[  
ysm)B?+k  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : `7$0
H]*6  
佩服，玩也玩得这么专业！ a<-NB9o~v  

N9@@n:JT  
k)j,~JH  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : vzDoF0Ts*p  
PNVYW?l  
介个真的看不懂。 esE5#Yq4.k  
你说你老啦，喜欢怀旧了，才想起来填坑。 e(nT2E  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 peW4J<,  

\$;Q3t3  
0'&N?rS  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 g Mhn\  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ G.Z4h/1<  
DWORD dwCB; 7-Bttv{  
LARGE_INTEGER  offset; j;%RV)e  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); ;&="aD  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); OJX* :Q  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ X{2))t%  
DWORD error = GetLastError(); r(qAe{  
MessageBox(NULL,"写入文件失败!",NULL,IDOK);
x-W6W  
return FALSE; 08*O|Ym,  
} \~j6}4XS1.  
return TRUE; >v1E;-ZA  
} B_Qi  

'VB 6.0 版 8M9LY9C  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 .[email protected])3  
P?QVT;]  
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 X MkyX&y  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long fK-tvP0}*  
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 PWErlA:58  
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 \gtI4zl*J  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long ;4E(n  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 F|Y}X|x8Q  
Bg PwIK x  
'j6)5WL$  
Private Const GENERIC_READ = &H80000000 "0BuQ{CQ  
Private Const GENERIC_WRITE = &H40000000 'VH%cz*  
ykq9]Xqhv  
Private Const FILE_SHARE_READ = &H1 >$^[email protected]jf  
Private Const FILE_SHARE_WRITE = &H2 |[%CFm}+?  
Private Const OPEN_EXISTING = 3 Glz yFj  
E05RqnqBn0  
Private Const INVALID_HANDLE_VALUE = -1 iEe<+Eyns  
/Q|guJx  
'//file seek 4q<LNv
JA  
Private Const FILE_BEGIN = 0 CqF=5z:A  
Private Const FILE_CURRENT = 1 4VPJv>^  
Private Const FILE_END = 2 drv"I[}{A  
MXQS6F#  
Private Const ERROR_SUCCESS = 0& _6Ex}`fyJ  
u
+U '|6)E  
'//device io control I\8f`l  
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 L\O}q  
+i %,+3#6  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 jGp|:!' w  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 .JkcCEe{G  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 [email protected]:?=hc  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 2!UNFv#=$  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C C}})dL;(  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 NTj:+z0  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F 6Vq]AQx  
BK+(Uf;g  
'//type Er 4P  
Private Type LARGE_INTEGER @|7Ma/8v  
    lowpart As Long sg=mkkD!g  
    highpart As Long \QpH~&QIS  
End Type iJIDx9 )Z  
*
jAw  
Private Enum MEDIA_TYPE i2h,=NHJh?  
    Unknown >n`!S`)9{  
    F5_1Pt2_512 GQU9UXe  
    F3_1Pt44_512 /.?m9O^ F  
    F3_2Pt88_512 QvPG 6A]T  
    F3_20Pt8_512 OJ2O?Te8  
    F3_720_512 |?a 4Nl?  
    F5_360_512 n\U3f M>N  
    F5_320_512 #<^ngoOj  
    F5_320_1024 Ax'jNo
l  
    F5_180_512 hM":?Rx  
    F5_160_512 W0++q=F  
    RemovableMedia 8Gw0;Uu8D  
    FixedMedia jj[email protected]<  
End Enum
uude<d"U  
.H.#W1`  
Private Type DISK_GEOMETRY l7g< $3
 
    Cylinders           As LARGE_INTEGER 81(.{Y839_  
    MediaType           As MEDIA_TYPE c5jd q[0  
    TracksPerCylinder   As Long xe4F4FC'  
    SectorsPerTrack     As Long !W^b:qjJ  
    BytesPerSector      As Long btQDG  
End Type 3`W=rIMli  
]w)*8 w.)  
'//private vars @R!
f(\  
Private hDisk           As Long             'disk handle Hg~O0p}[  
Private lpGeometry      As DISK_GEOMETRY    'disk info 8SG*7[T7  
Private lBufferSize     As Long             'the buffer size of read/write xj1FCT2  
] i}3
`e?  
Public Function OpenDisk(ByVal FileName As String) As Boolean 0Q2P"1>KT/  
'// 打开磁盘 09_L^
'`  
    hDisk = CreateFile(FileName, _ Wq4>!|  
                        GENERIC_READ Or GENERIC_WRITE, _ ka3(sctZ5  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ ,gvv297  
                        ByVal 0&, _ 
P[l?  
                        OPEN_EXISTING, _ ;M<jQntqS{  
                        0, _ [email protected]/i [email protected]  
                        0) @kq~q; F  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) T'n~QfU  
End Function k8]uy2R6}  
NlBn V
 
Public Function CloseDisk() As Boolean L(a){<c  
'//关闭磁盘 q.
%[!O  
    CloseDisk = CloseHandle(hDisk) eyx;8v cM  
End Function [sM
~B  
qre.^6
x  
Public Function GetDiskGeometry() As Boolean H;&^A5  
'//获取磁盘参数 c<'Pt4LY  
    Dim dwOutBytes      As Long Z+zx*(X  
    Dim bResult         As Boolean T8ga) BA  
     D~KEjz!bQ  
    bResult = DeviceIoControl(hDisk, _ hXvg<Rf  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ 8veYs`  
                                ByVal 0&, 0, _ Rf&~7h'+  
                                lpGeometry, Len(lpGeometry), _ !9$xfg}  
                                dwOutBytes, _ /uTU *Oe  
                                ByVal 0&) 3#d5.Ut  
     INm2
1MS$  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack ]cz*k/*0  
    GetDiskGeometry = bResult o6FSSKM  
End Function }d, iA FG  
=Ws-s f]  
Public Sub GetDiskInfo(MediaType As Long, _ mP1EWh|  
                        Cylinders As Long, _  X,z qI  
                        TracksPerCylinder As Long, _ YKjm_)8]w  
                        SectorsPerTrack As Long, _ R'#[
}s  
                        BytesPerSector As Long) \= M*x  
'//返回磁盘的参数 \2F$FRWo  
    MediaType = lpGeometry.MediaType 6[-N})  
    Cylinders = lpGeometry.Cylinders.lowpart 1>JUI5 {  
    TracksPerCylinder = lpGeometry.TracksPerCylinder +1K9 R\  
    SectorsPerTrack = lpGeometry.SectorsPerTrack $"+ahS<?tC  
    BytesPerSector = lpGeometry.BytesPerSector g$qNK`y  
\]uo^@$bm  
End Sub yv.UNcP?  
O 23dtH  
Public Property Get BufferSize() As Long [
V\0P,l  
'//返回每次读/写的缓冲大小 X[ERlw1q4Q  
    BufferSize = lBufferSize Rh
J{#G~:%  
End Property f0 ;Fokt(  
yQ33JQr  
a88(,:t  
Public Function LockVolume() As Boolean G0Q8"]  
'// 将卷锁定 vgfLI}|5  
    Dim dwOutBytes  As Long [Sl uYmW  
    Dim bResult     As Boolean +Om(&\c(6  
     z|VQp,ra  
    bResult = DeviceIoControl(hDisk, _ Gw"H#9J} T  
                                FSCTL_LOCK_VOLUME, _ {8NnRnzU  
                                ByVal 0&, 0, _ .t/XW++  
                                ByVal 0&, 0, _ x Z3b)j2D  
                                dwOutBytes, _ {Z>OAR#   
                                ByVal 0&) jQAK ?7':=  
    LockVolume = bResult __}j {Buk  
End Function TFX*kk&R  
;QT.|.t6  
#6])\  
Public Function UnlockVolume() As Boolean &E@8 z&  
'// 将卷解锁 ]fN\LY6p  
    Dim dwOutBytes As Long N:#"4e  
    Dim bResult As Boolean u$7od$&S  
     UjNe0jt%s  
    bResult = DeviceIoControl(hDisk, _ wSTy2Oyo;  
                                FSCTL_UNLOCK_VOLUME, _ <NV [8B#k]  
                                ByVal 0&, 0, _ P4{8pO]B  
                                ByVal 0&, 0, _ pw^$WK  
                                dwOutBytes, _ p[E}:kak_-  
                                ByVal 0&) K{]!hm,[3  
    UnlockVolume = bResult "3kIQsD|j  
End Function U5uO|\+)  
/8Sg<  
fc
'NU(70c  
Public Function DismountVolume() As Boolean S>W_p~@  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 Z.a`S~U  
    Dim dwOutBytes As Long 3"ALohlL  
    Dim bResult As Boolean %3L4&W_T  
     %P!
6cyQS  
    bResult = DeviceIoControl(hDisk, _ w1Z9@*C!  
                                FSCTL_DISMOUNT_VOLUME, _ $wL zaZL|  
                                ByVal 0&, 0, _ ,KXS6:1%5Y  
                                ByVal 0&, 0, _ VdrqbZ   
                                dwOutBytes, _ 0dv# [  
                                ByVal 0&) |sf&t  
    DismountVolume = bResult o6JCy\Bx  
End Function IM
aa#8,  
by 'P}  
9oOr-9t3  
Public Function ReadDisk(ByVal Cylinders As Long, _ ;T!w$({V0z  
                    ByVal Tracks As Long, _ M2UF3xD  
                    db() As Byte) As Boolean Pr |u_^  
'//按柱面和磁道来读取磁盘数据 W\JbX<mQ  
    Dim iPos    As Long s-V5\Lip,  
    Dim lRead   As Long 1#KE4 (  
     (vX+ Yw  
    iPos = Cylinders * Tracks * lBufferSize xgw[)!g^\  
     {+CW_ce  
    If SeekAbsolute(0, iPos) Then `)sC".b7  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) Ig owz7  
    End If Z`L-UQJ.  
End Function "MH_hzbBF  
HAq  
Public Function WriteDisk(ByVal Cylinders As Long, _ D6cqON0a.  
                     ByVal Tracks As Long, _ Ns?8N":  
                     db() As Byte) As Boolean 1P(5+9"s  
'//按柱面和磁道来写磁盘数据 11%<bmJ]Q3  
    Dim iPos    As Long !q:[[email protected]  
    Dim lRead   As Long zGtWyXP  
     G}!dm0s$  
    iPos = Cylinders * Tracks * lBufferSize #G'Y2l  
     qmNgEz%  
    If SeekAbsolute(0, iPos) Then ,(h:0L2v7d  
        WriteDisk = WriteBytes(lBufferSize, db()) [)K?e!c8  
    End If =og5Mh,  
End Function x|>N  
gIGyY7{(s8  
ZE+VLV v  
'///////////////////////////////////////////////////////////////////////////////////// u4 # #*m  
'//file system TqzL]'NS+  
}$6;g-|HX  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean 05]y
*I  
'//seek file j<H5i}  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte mB.yb
rig  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) O=2"t%Gc  
    If LowPos = -1 Then DG2CpR)S  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) vuL;P"F4&  
    Else N~c Y~a  
        SeekAbsolute = True d
Mo456L  
    End If A .]o&S}  
     ;+d2qbGd  
End Function 0K+a/[email protected] n\  
o>(I_3J[p  
* z,] mi%  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean 1y \-Iz
^  
'//read data to array [email protected][email protected]  
    Dim RetVal    As Long /Y NV  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) m tPmVze  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF teRK#: .P  
    ReadBytes = Not (RetVal = 0) Ancka  
     "])yV    
End Function --t"X<.z  
BU3VXnqT[  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean $K_G|Wyi  
'//write data from array 0A]+9@W;  
    Dim RetVal As Long =6PTT$,
 
    Dim BytesToWrite As Long eouxNw}F1  
    Dim BytesWritten As Long WA~PE` U  
     a]JQ Zo1$  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) nSMw5  
     33O O
%rWi  
    WriteBytes = Not (RetVal = 0) E=G"_ ^hCE  
End Function Zo
=w8Hr  

这才是我当年写出的一个比较烂的程序 !YM;5vte+  
@<n8?"{5S  
Main2.bas khXp}p!Zm  
=N,a
hq  
Attribute VB_Name = "SubMain" Mk:k0,z  
Option Explicit ^@"H(1Hxu/  
5eP0W#  
'采集文件与临时文件 [/P}1 c[)U  
Public Const TmpFile As String = "d:\30-0600.dat" XGs d"UW  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 ?E6*Ef  
4R;6u[a]u  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long A_:[email protected]  
Public hBCFile As Long  '记录采集参数的文件 }@+{;"  
Public Const TmpBMP As String = "d:\1.bmp" {j0c)SETN  
Public hTmpFile As Long CH`_4UAX%  
f^EDiG>b`  
/d1 B-I  
'采集窗口参数常量 !yfQ^a_
O  
Public Const FrameH As Long = 280& c)7i%RF'  
Public Const FrameW As Long = 768& 7aV(tMzd  
Public Const pFrameSize As Long = FrameW * FrameH o<J_?7c~}  
|=xK-;qs  
'标志区范围，用于识别车辆 NHL -ll-R  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X 96 oztUK  
Public Const mkW As Integer = 28  '识别标志立柱宽度 )|d]0/<  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) c~bTK" u  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) n)~9  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 \Y
?ByY  
'车缝检测位置常数 h_SDW %($  
Public Const sSize As Long = 32& D:r+3w:l]  
Public Const sPos As Long = 310& _@U11|  
Public Const sPosL As Long = 200& Em(&cra  
Public Const sPosR As Long = 500& L#\!0YW/@  
'车缝检测框位置 0-N"_1k|?  
Public Slice(1 To sSize, 1 To FrameH) As Byte DbL=2  
Public SliceL(1 To sSize, 1 To FrameH) As Byte XSw!_d  
Public SliceR(1 To sSize, 1 To FrameH) As Byte 
XAnN<  
Public avSL As Integer, avSLR As Integer, avSLL As Integer [email protected]py  
e 2P ds`  
H7I
&Ky  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 <8'-azpJ6<  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 m\XgvpvrP  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 u>YC4&  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long Cq< a|t  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte t9!8Bh<  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 *h H\H   
`Dn"<-9:  
O% Mi`\[email protected]  
(|
*CVI;
 
'一次连续采集的帧数 figCeJ!W4  
Public tFrames As Long M?3Nh;  
>~D-\,d|f  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 R _c! ,y  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 NDmTxW#g  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize *yDsK+[_  
H J8rb  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte "< c,I=A  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte  UE-+P  
Public pWorkSpace(1 To FrameW * FrameH) As Long IwR/4L YI  
Public Const pBufferSize As Long = FrameW * FrameH * 2 #y?iUv  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 'JjW5  
!^,<nP  
Public hBoard As Long   '采集卡标识 BnB]]<gO"  
Public mBufferAddr As Long  '缓存地址 )PU_'n=>  
Public BufferSize As Long  '缓存大小(字节) X =W.{?  
Public iCurrentCard As Long U)3*7D  
Public CapStatus As Long ly8IrgtKy  
Public iFrames As Long }kCaTI?
@#  
Public currentBr As Byte, currentContr As Byte JIA'3"C  
2,3pmb  
Public hMEM As Long, mStatus As Long (;Ad:!9{  
Public Const hMemSize As Long = pFrameSize * 4 )6k([u%;B  
Public hMemWork As Long <6djdr1:b  
Public Const hMemWorkSize As Long = pFrameSize * 5 5V{> 82  
$z"1&y)  

^O9_dP:  
-VO&#Mt5u  
'串口接收轨道衡数据 {Y(#<UDM  
Public WeightFromCom As String j&c YRKpz  
Public bReceiveComplete As Boolean B F,8[|%#  

BSMM3jXb  
T=kR!Gx  
Public Type GrayBMPHeader ?KK u1~a_  
  Tag As Integer dpTeF`N  
  FileLength As Long    '文件大小 ):c)$$dn  
  Reserve1 As Long !=Hu?F p  
  DataOffset As Long    '图像数据偏移量 e[:i`J 2  
  BMPHeaderSize As Long  '文件头长 V=?qU&r<+  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… $BPTk0Y  
                        'the following sizes are possible: @rV|7%u  
                        '28h - windows 3.1x, 95, nt, … 3 cb$g  
                        '0ch - os/2 1.x o-f;$]yp>  
                        'f0h - os/2 2.x Q,`:RF3  
Y]33:c_;Mo  
  ImageWidth As Long           '图像宽（像素数） ^qro0]"LD  
  ImageHeight As Long          '图像高(像素数) k,kr7'Q  
  PlaneNumber As Integer  '图像层数 EJz?GM  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap w`Ss MI  
                                        '4 - 16 color bitmap [ 1$p}
x  
                                        '8 - 256 color bitmap (9phRo)>  
                                        '16 - 16bit (high color) bitmap [\rnJ lE  
                                        '24 - 24bit (true color) bitmap FD+y?U F  
                                        '32 - 32bit (true color) bitmap CHojF+e  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) I_k!'zR[N  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) \D<w:\P  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) !
UV1OU  
                                    '3 - bitfields (also identified by bi_bitfields) @uJ^k >B  
  IMAGESIZE As Long  '图像数据字节数 M(8Mj[>>Rj  
  hResolution  As Long  '水平分辩率  像素数/米 a#k
=! W  
  vResolution  As Long  '垂直分辩率 )v+R+3<  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 &>T7]])  
  ImportantColors As Long /p PSo  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 \mIm}+!H  
End Type L6ifT`;T  
z^etH/]Sy  
h,(f3Ik0O  
^s;xLGl]  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader *2
(W`m  
Public sRECT As RECT !go$J]T  
+ bU*"5"  
'WC> _L  
Public conn As ADODB.Connection VxKD>:3c  
Public rsTrain As ADODB.Recordset z K+C&X  
Public rsOperater As ADODB.Recordset %^?yI
 
Public rsGoods As ADODB.Recordset _^(}6o  
Public rsGood2 As ADODB.Recordset ,+Bp>=pvs  
Public rsSender As ADODB.Recordset w9W0j  
Public rsReceover As ADODB.Recordset JR_s-&GaM  
Public rsTrainTMP As ADODB.Recordset \{RMj"w:  
R=ipK63  
4L`<xX;:{  
'打开采集卡 6bacU#0o  
'设置参数 g:yUZ;U
 
'设置为实时单帧采集到缓存方式 ,e{|[k  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 A$a>=U|Z8  
}R\9ybv  
l?rT_uO4  
Sub Main() dZ"B6L!^(  
  Dim i As Integer, status As Long itpljh  
     A{QXzoWkg0  
   InitBMPinfo DJ Gq=*  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 v Wt{kg;  
    BMPHeader.Tag = &H4D42
@}r2xY1  
    BMPHeader.ImageWidth = FrameW ?L'4*S]  
    BMPHeader.ImageHeight = FrameH V|njgcn d  
    BMPHeader.BMPHeaderSize = &H28 D#pZN,'  
    BMPHeader.PlaneNumber = 1 (0cL! N;;  
    BMPHeader.bpp = 8 1vG]-T3VC  
    BMPHeader.Compression = 0 =/6rX"\P  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 @S>$y5if  
    BMPHeader.vResolution = &H1274 )dM
Xn2O  
    BMPHeader.ColorsinBMP = 256 VY#:IE:T  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP `PH*tdYrh  
    BMPHeader.DataOffset = Len(BMPHeader) DClV&\i=o  
    For i = 0 To 255 @ a$HJ:  
      BMPHeader.Pallate(i) = RGB(i, i, i) M.(shIu!+  
    Next i 5IsRIz[`TK  
    BMPHeader.IMAGESIZE = FrameH * FrameW N)&(&2  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE
Vjc*D]  
^-|yF2>`  
3!OO_  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) -j<g}IG  
     }p <p(  
    BMP1.ImageWidth = FrameW 
`H7V['
 
    BMP1.ImageHeight = FrameH * 2 4NN81~v 4  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight \[email protected]  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE :/1/i&a  
mK);NvJ!  
  '确定标志位置,为pilarX, pilarY确定初始值 JBCJVWUt  
   PilarW = mkW Bp.z6x4  
   PilarH = mkH  '此两项为固定值 QSNLo_z  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) -T
5$l  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 rP=!!fC1;  
   w2mLL?P  
   7H=^~J  
  '连续采集记录文件 7ql&UIeQ  
  ' 建立一个缓冲区为页对齐方式的文件 >d{O1by=d9  
  If Dir(TmpFile) <> "" Then }_A#O|dxO  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ u>cU*E4/  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ^9ZW}AAO  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 OGC|elSM  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 (ru9Ke%Dx  
  Else ?Ww\D8yV&  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ CK{.Ic^  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) [email protected]5D h  
  End If j$f`:A  
  If hFile = 0 Then GkutS.2G#  
    MsgBox TmpFile & ": File Open Error", vbOKOnly 2Y+8!4^L a  
    Exit Sub +TR#  
  End If yQ3*~d~U|L  
  '采集参数记录文件 n5yPUJK2L6  
hBCFile = FreeFile() !N::[email protected]  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile ~5f|L(ODX  
  
YnCWmlC  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 5nhc|E)C  
If hMEM = 0 Then G#~6a%VW  
    fStatus = GetLastError "E><:_,\  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ t\p_QWnF  
     & "请向技术人员报告该错误代码。", vbOKOnly 9m:qQ1[\  
    CloseHandle hFile 3}}#'5D  
    Exit Sub ];|;")#=  
End If BU| bo")  
`T;M=S^y*E  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) j+p=ik  
If hMemWork = 0 Then =}G `i**  
    fStatus = GetLastError 
j (8I+||  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 6}vPwI  
     & "请向技术人员报告该错误代码。", vbOKOnly vT7ei"~&u  
     '释放已成功分配的内存 @+S5"W  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) |0wUOs*5  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) KLc<c1BZ  
     P]pVYX#m  
    CloseHandle hFile r|bvpZV  
    Exit Sub dB^')-wA  
End If -ty_<m]  

mB:I8g7  
' Test writing m>@$T x  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& CDz-IQi  
     pFu3FUO*;  
   '初始化采集卡参数 mxpncM=q  
   iCurrentCard = -1 ^H,oI*  
   hBoard = okOpenBoard(iCurrentCard) 9J$z/j;X  
   Debug.Print hBoard -6+&?f  
   If hBoard = 0 Then nsq7, %5  
      ExitGrabber y?|JBf  
      End ^c9~~m16+  
   End If *d,u)l :S  
   okGetBufferSize hBoard, mBufferAddr, BufferSize 9tnW:Nw~  
   If mBufferAddr = 0 Then n{~Ws^d  
     MsgBox "缓存不存在！" Y^?J3[@  
     ExitGrabber F?LTWm
  
   End If 0 w"&9+kV  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) 4YVxRZ1[3  
   Rks3L  
   h4xRRyK  
   currentBr = 128: currentContr = 128 IEB|Y  
   '设置视频输入参数   0%  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 7[l  "=  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input +^c;4-X 0  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 >Fzu]G4]  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 !/w<F{cl  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 Q6cF<L`bW  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 V9 pKbX  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） 2<aBUGA  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) D/CSR=b  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) T[iwP~l  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 |zV-a2K%J  
   3 *o l  
   '设置采集参数 Ny;(1N|&3  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 &b 2Vt  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ,R j{^-k  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 *Mt's[8  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 %#rH~E  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 r lalr+Rf  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 HNA/LJl[VU  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 su}> >07  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 #^- U|~,  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 [T;0vv8  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 O)'Bx=S4Ke  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 :bL L
N  
   FuNc#n>  
   CL*i,9:NR  
   okCloseBoard hBoard +oY[uF  
   Sleep 50 oEE*H2l\  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 !\a'GO[  
   9HlRf6S  
   '设置数据传送方式 ,y[wS5li  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 +8FlDiP  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 '3f"#fF6  
   h Znq\p~  
   sRECT.Right = -1   '用于获得当前设置值 hsVf/%  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) g/b_\__A  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom -d+q+l>0  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 Qwn/ ,  
   sRECT.Left = 0 qV$\.T>x  
   sRECT.Top = 0 fA u^%jiU  
   sRECT.Right = sRECT.Left + FrameW -.|V S|y  
   sRECT.Bottom = sRECT.Top + FrameH * 2 "CdL?(  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) _5vAnt*  
   We#u-#k_O  
   sRECT.Right = -1   '检查新设置值 n>tYeN)F<  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT)
sXm/+I^  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 5-Vdq  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) ?Sj3-*/?  
    _2VL%  
   If TESTSignal = False Then 3_W1)vd{
 
      'ExitGrabber [email protected]@O\\  
   End If \gRX:i#n  
   ( w(GJ/g  
   6,sZo!G  
   /wB<1b"  
   '设为实时采集状态 )+c4n]  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) )W!8,e+%  
   8[SiIuIV  
   [kx_Izi/T  
   '单帧采集 GZ#6}/;b  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 gaaW:**y  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) 0^4uZeW?  
   okCaptureTo hBoard, BUFFER, 0, 1 'single 9x/HQ(1  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 ?Gc9^bB I  
   '   Sleep 20 LlP_`fA  
   'Loop s+>VqyHgf  
   okGetCaptureStatus hBoard, True ,[}5@cS  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize Kd8V,teH  
   '写入768*576测试图象 %EYh5W  
   ArrayToBMP TmpBMP P SDzs\ s  
   CUgXpU*  
   '打开数据库 |:SBkM,  
   Set conn = New ADODB.Connection 1;<J] S$$  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ SF2A?L?}+  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ q1sK:)Hu+  
      "; Mode=Read|Write" ~9JU_R^%m  
   conn.Open 6D,xs}j1  
   wt4uzg8  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) |;o#-YosP  
   frmRecord.Visible = True 9^Q:l0|  
   frmQuery.Visible = True *a*\E R  
   Load frmReceiveFromComm E%\jR  
   EOu\7;kE9  
   '调试参数 6CBk,2DswI  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then iha{(-  
     SignalBox.Visible = True [pOQp fo\  
   End If 77
- Jx`C  
   If InStr(UCase(Command()), "/COMM") > 0 Then 8;YeEW5  
     frmReceiveFromComm.Visible = True 6'UtB!gr  
   End If l/,O9ur-  
oR>o/$z$)g  
End Sub ;/#E!Ja/u  
nj99!"_  
Sub ExitGrabber() J&w%lYiu5  
  '关闭数据库 K^bzZa+a  
  '关闭采集卡 E]`)  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) uBI?nv,  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) A-e#&pJ  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) :SilQm*Pl  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) Ml)~%ZbF  
  okStopCapture hBoard XQ&iV7   
  okCloseBoard hBoard %pmowo~{  
  CloseHandle hFile 5inmFT?9Z  
  Close #hBCFile S~fQ8t70  
  conn.Close $e#p -z  
  End l \7NR  
End Sub '+1<7jl&I  
s0"S;{_#  
Function ArrayToBMP(ByVal File As String) >|%m#JG  
Dim BytesWrite As Long D4[[email protected]}4D  
ItGi2'}  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ 2'_xg~  
  CREATE_ALWAYS, 0&, 0&) }:C4T*|  
ri&B%AAc  
If hTmpFile = 0 Then /%Lj$]S7[4  
   ArrayToBMP = False 6%Ap/zvCZ>  
   Exit Function ALS\}_8  
End If w(pLU$6X  
[email protected] vSe  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN -M}#-qwf  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& 6r/NdI  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN aObWd5~  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& rmmN2+H  
zRPX mu{t  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN RWtD81(oC'  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& <
@xp. Y  
;}{xpJ/  
If BytesWrite < pFrameSize Then vR<Y1<j  
  ArrayToBMP = False vt}+d StUm  
End If 8qL*Nf  
Qr[email protected]_+w!  
CloseHandle hTmpFile J<Di2b+  
preKg$U  
End Function Q':xi;?Kt  
N%!8I  
Function ArrayToBMP1(ByVal File As String) mh;<lW\K/Z  
b[,J-/;JNL  
Dim BytesWrite As Long y&Sl#IQ L  
Ijq1ns_tx8  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ UR6.zE4=_  
  CREATE_ALWAYS, 0&, 0&) @'`!2[2'?  
S'qEBz  
If hTmpFile = 0 Then )p' ZSXb  
   ArrayToBMP1 = False T{v(B["!$  
   Exit Function cmF&1o3_  
End If o %s
BU  
=!m5'$Uz>  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN I*[email protected]oI*  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& %[ 0V>  
|SC^H56+  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN VE5w!of  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& w1B!z  
[YG\a5QK  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN @ SaU2  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ScU?T<u:i  
W|J8QNL?jm  
If BytesWrite < pBufferSize Then ?{l}35Q [email protected]  
  ArrayToBMP1 = False ,2T&3
3m  
End If tZmo= 3+:  
<a7y]Py  
CloseHandle hTmpFile \xG>>A%  
|Fz/9+I  
End Function fH?e9E4l  
5BnO-[3  
'使用该过程建立的文件要求在用后关闭 ]b
!o(5m  
Public Function ArrayToBMP2(File As String) As Boolean B}_*0D  
uu L
"o  
Dim BytesWrite As Long c'nEbelE  
/tI8JXcUK  
ArrayToBMP2 = True |?{3&'`J8w  
IiTV*azVh  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ [email protected]}x's  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) 
"Mzb  
c}GmS@  
If hTmpFile = 0 Then )8]O|Z-CU  
   ArrayToBMP2 = False eS(\E0%QI  
   Exit Function h^R EBPe  
End If zu}oeAQc$  
_<pSCR0  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN `s93P^%  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& ]V*s-och'  
|kJ'FZZd  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN =W'a6)WE  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& %PozxF:  
N>##}i  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN Ik2yIf5d  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& ;0DTf  
9TRS#iVL+*  
If BytesWrite < pFrameSize Then %suSZw`  
  ArrayToBMP2 = False 6L[Yn?;  
End If u;p.:{'  
ZHT_o\  
CloseHandle hTmpFile o?(({HH
 
x01n  
End Function ApHs`0=(  
[4L[[email protected]  
Private Function TESTSignal() As Boolean #[email protected]&Gv  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long ^\=
<geEj  
) =-$>75Z  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) t}L kl(  
[email protected]  
If extsign = 1 Then @9_H4V  
   TESTSignal = True .4E5{F{~  
Else ^R- -&{I  
    If extsign = 0 Then 6'CZfs\  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly [email protected](&xfTC  
        TESTSignal = False J%ng8v5ex  
        Exit Function JDPn   
    End If V45A>#?U  
End If 87WIDr  
Kn-
cwz5  
'测试视频输入类型 "ee:Z_Sz  
'video type ybLl[K(D=  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 2F*spu  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) B].
V|8h  
If videotype = 1 Then nmIos]B  
        '"隔行信号(Interlaced)" PyQt8Qlz  
Else U hKC:<%  
   If videotype = 0 Then kI7c22OJ  
       '"逐行信号(Non-interlaced)" kT6h}d^/^  
   Else jb;!"HC  
     If videotype = -1 Then ]@E_Hx{
S  
       ' "不支持" QOXG:?v\  
     End If q?} /q  
   End If >g7}JI &  
End If cmG*"  
v2=Iqo  
'测试垂直扫描线数 !p$HS0c  
'video scanlines P^9y0Q  
scanlines = -1 BG ,ln(Vz  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) UrtA]pc3L  
    If scanlines = -1 Then \fC)]QZ  
        ' "不支持" k1Z"Qmz  
    Else f_A'.oq+  
        'Trim(Str(ScanLines)) + " 行数/幅" C\"nlNKw  
    End If )F_vWbg  
WUOoK$I~K  
'测试帧频 A^lJlr:_`  
'video field frequency .*FBr7rE\  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) &b :u~puM  
    If fieldfrq = -1 Then JX4uH>6  
        'lblSignal(8) = "不支持" Gy}WZ9{  
    Else }!_x \eq^  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" |2RoDW  
    End If [+,%T;d;  
End Function pJ8;7u  
B=dF\.&Z  

TA;r  
Sub PicIdentify() ."`mh&+`  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 QuFzj`(  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 VF#2I%R*  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 i vTx6-]  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 wJ.?u][email protected]  
R1'tW=  
  Dim fPTR As Long, cFrame As Long kyV!ATL1F  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer q8DSKi  
     ,uz+/K%OA5  
2rxZN\gyL  
cFrame = 0 E2[email protected]Y|:  
w3,DsEXu  
:+?eF^5  
Do While cFrame < tFrames KWu c*!  
   *[XVkt`H  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) =Sjr*)<@j  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) GFA D  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize aTi2=HL=S  
   p7SX,kpt>  
  frmRecord.RText.Text = Str(cFrame) !+bLhW`  
  frmRecord.RText.Refresh tjONN(K`  
       3K)12x$.K  
  If CheckMark = True Then H]]UsY`  
   ArrayToBMP TmpBMP ~HW8mly'  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) Evjvaa^  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" R0yPmh,{  
   o 8fB  
   DrawSlice [email protected] (P"  
   B!PT|  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) ^)i5.o\  
   'If i = vbNo Then 7E0L-E=.  
   '  Exit Do 8]G  
   'End If zY11.!2  
   'cFrame = cFrame + 1 9^yf'9S1  
   u/s,#  
  End If tr[(,kX  
  DoEvents =`&7pYd,
 
  cFrame = cFrame + 1 :A,g:B  
Loop f&=WgITa  
End Sub F+!w[}0  
NY(z
3G  
R=7,F6.  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 30BFwNE  
XIe p3l*  
'如标志区模式反差存在则为TRUE，否则返回FALSE jRn5)u  
OEZ`5"j  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long +ConK>;  
CheckMark = True [email protected]  
   ! .q,m>?+  
'复制标志区 w
(,K  
For i = 1 To mkH 9`a1xnL  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW DfPC@` k  
Next i ?cyBF*o  
/Jcf
AY  
For j = 1 To PilarW * PilarH / 2 $Gy &  
   mTop = mTop + MKpilar(j) s%cfJe_k  
Next j BB$(0mM^  

4+tKg*|  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH m2{DLw".  
   mBot = mBot + MKpilar(j) {4C/ZA{|l  
Next j crwui8  
"r+v^  
mTop = mTop / PilarW / PilarH * 2 G5[email protected] o  
mBot = mBot / PilarW / PilarH * 2 uGoySt&;(  
xr*%:TwCta  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 V(6*wQ` &  
},]G +L;R  
'平均值极值化 *ku}.n  
  For j = 1 To PilarH * PilarW g+R
gDt9  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) Z&Qz"V>$  
  Next j c>$PL
O^  
   n%Rl$  
mTop = 0: mBot = 0 }EMds3<  
For j = 1 To PilarH * PilarW / 2 `)aIFAW  
  mTop = mTop + MKpilar(j) HL`=zB%  
Next j .="/n8B  
[email protected]<1<y  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW @H83Ad  
  mBot = mBot + MKpilar(j) q,Nhfo(  
Next j 5LX'fL7zU  
sC}p_'L  
78MQoG<  
  mTop = mTop / PilarH / PilarW * 3 f{HjM? Mb3  
  mBot = mBot / PilarH / PilarW * 3 }Sx+:N*  
   sw\O\%^  
_\ &N<  
If mBot > iWhite And mTop < iBlk Then f, iHM  
  CheckMark = True E2nsBP=5C  
Else <i$ud&D  
  CheckMark = False *.,G;EC^  
End If ]?<=DHn  
End Function f(*ygI  
VpO+52&  
Sub Capture1Frame() ! N!A%  
   okCaptureTo hBoard, BUFFER, 0, 1 'single C$x r)_  
   okGetCaptureStatus hBoard, True @ L=dcO{r  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize uE=pq<  
End Sub r7zS4;b  

\UEO$~Km  
u}0U !
 
Sub CopyMark(iBlk As Integer, iWhite As Integer) H[DBL  
'复制标志区并返回标志区暗区与亮区的亮度平均值 2mt S\bAF  
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 >D5WAQ>b  
   + e3{J_  
'复制标志区 +t JEG:  
For i = 1 To mkH lh]Q\  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW bm\Zp  
Next i DX b=Ku  
- %'ys  
For j = 1 To mkW * mkH / 2 P
$H9  
   mTotal = mTotal + MKpilar(j) S2\|bs7;J,  
Next j (Do](C  
cYx.<b JH  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 5fa Y{;8  
'2:HBJ  
mTotal = 0 6V&HlJH  
For j = mkW * mkH / 2 + 1 To mkW * mkH uG^RU\(  
   mTotal = mTotal + MKpilar(j) *>,#'C2  
Next j $v\o14 v  
T\OpPSYbl  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 KM9)  
$gPR3*0  
'背景亮度 gNaB^IY  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW -V
afN   
  For i = 1 To 4 * FrameW
]b&O#D9  
    bsTotal = bsTotal + BsLine(i) #HyE-|_ C  
  Next i mhi^zHpa  
  bsAV = bsTotal / FrameW / 4 x&d:V  
><DXT nt'x  
End Sub >0AVs6&;v  
!g2~|G  
wqE+hKs,  
Sub AdjIMGbright(Optional bInit As Boolean = True) SLjSNuOP  
py%_XL=w,  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） ;NPbEPL[5  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 \sc's7  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 =;m
;r!,K  
     di|5|bn7  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer @E !`:/k
 
   8h$f6JE  
  '按标准亮度与对比度采集一帧，确定背景亮度 5~H}%W,P  
  currentContr = 128   '初始对比度 %<rV~9:  
  currentBr = 128   '初始亮度 TO]7%aB  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 +A
kMU|6  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 u?V Tns
u  
  DoEvents \eoJ6IRE\T  
  Capture1Frame }pOJM&I  
  '获得图像上缘4行象素 q u+Zl1~$]  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW RA ER\9i  
  CopyMark iBlack, iBright   '图像标志区亮度 yr[HuwU  
  For i = 1 To 4 * FrameW TYu(;~  
    bsTotal = bsTotal + BsLine(i) Uy;e5<<  
  Next i +2Wijrn  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 cqZuG}VR  
   <E1ngG  
  Select Case bsAV )ad
6>Y  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 >pj)va[Q  
       currentBr = 150 P0O=veCf  
       currentContr = 60 4&}dA^F  
     Case 61 To 80   '有可见背景 i"OY=iw-N  
       currentBr = 140 LG:Mksd8=4  
       currentContr = 70 sV$Zf `X)  
     Case 81 To 100  '有清晰背景 X{-901J1  
       currentBr = 128 R7NE=X4  
       currentContr = 80  .H7xG'$  
     Case 100 To 150  '有明亮背景 }:xj%?ki  
       currentBr = 140                '5:30-6:00钟实测数据 o?((FW5.;  
       currentContr = 50 $e/[!3CASP  
     Case 151 To 180 GI[XcK^*w  
       currentBr = 130 aC,?FWm  
       currentContr = 60 ~(Xzm  
     Case 181 To 220  '背景全为白色 5o2vj8::  
       currentBr = 110 hw)#TEt   
       currentContr = 130 ;pVnBi  
     Case 221 To 255  '背景全为白色 Y:KIaYkk  
       currentBr = 100 tXW7G@  
       currentContr = 100 !v?WyGbUg  
  End Select ;Vlt4,s)  
   [`_-;/Gx2  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 uK5 C-  
        Case 100 To 150 2y#[uSqB  
          currentBr = currentBr - 10 [email protected]0v=u>  
        Case 151 To 255 }e8u p*#me  
          currentBr = currentBr - 20 Mx_
O'D  
  End Select vQsI^
p  
   Gid 6,J  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ZO\x|E!b  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 c7f11N!v>b  
End Sub U#' 
WP  
[email protected]>11?  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) RDsBO4RG  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long 6sz:rv}  
     9Pjw<xt  
    For i = 1 To 8 !6pE0(V^+4  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& QNxY`  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128&  Mcm%G#  
    Next i W*.
6'u)9  
     &eY&6I  
    For j = 1 To 1024 65>}Q.p  
      L1 = L1 + LeftBK(j, 0) E` gUNAKQ  
      L2 = L2 + LeftBK(j, 1) y*7<tj.`b0  
      R1 = R1 + RightBK(j, 0) (\*+HZ`(Uu  
      R2 = R2 + RightBK(j, 1) hVf;{p &  
    Next j #@8JYzMq%  
    diffL = Abs(L1 - L2) / 1024 0;[email protected]  
    diffR = Abs(R1 - R2) / 1024 {"n=t`E)3  
End Sub `[email protected]`3*%v  
aZB$%#'vR  
Function CheckSlice() As Boolean :~4M9  
  CopySlice avSL, avSLR, avSLL l2 mO{'|C  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then dH_g:ocA  
    CheckSlice = True L1u(\zw  
  Else "c*&~GSE4  
    CheckSlice = False r"_SL!,^  
  End If _h0hl]rf  
End Function 5rUDRFO6  
`Yw:<w\4C  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) KreF\M%Ke  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long 0.lOSAq  
  For i = 1 To FrameH K3-Cuku  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize 8XhGo2zf  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize SU>cJ*  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize [email protected]v> `  
  Next i i27KuPjC  
  For i = 1 To FrameH hjx=?  
    For j = 1 To sSize ~%d*#Yxq  
       total = total + Slice(j, i) +p):  
       totalL = totalL + SliceL(j, i) !bQqzny$R  
       totalR = totalR + SliceR(j, i) 2{I+H'w8:  
    Next j ix!4s613w  
  Next i Z[G:  
  avSL = total / FrameH / sSize d8%s GH  
  avSLR = totalR / FrameH / sSize _>4Qh#6K  
  avSLL = totalL / FrameH / sSize @[email protected]  
End Sub $i;_yTht  
~?<VT k  
Sub DrawSlice() ^
gdv:[m  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B [email protected] *l  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B M.0N`NmS  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B f\h|Z*Bv  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) %IHra6  
End Sub [&K"OQ^\2h  
Sub DrawMark(pic As Control) RC+`sZE9  
   Dim i As Long, j As Long (U^f0wJg  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B qY$]^ gS  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B `VD7VX,rp*  
   For i = 1 To PilarH l$DQkbOj  
     For j = 1 To PilarW U~s-'-C/  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) /Q\|u:oO,  
     Next j uG{/yJeU  
   Next i ^zVW 3Y q  
End Sub |nT+W|0U  
BZ}_  
Function avIMG() As Integer SeIL   
  Dim i As Long, j As Long, totalIMG As Long ;k5B@z/<S  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 0S$6j-"  
  For i = 1 To pFrameSize {<L|Z=&k`  
    totalIMG = totalIMG + pBuffer(i) $0P7^4)w:  
  Next i ,<O|Iis  
  avIMG = totalIMG / pFrameSize K~Z$NS^W&  
End Function 7]lUPLsl  
Lu9`(+  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer zIy&gOX  
  Dim i As Long, j As Long, totalIMG As Long Xn*>qm  
  For i = 1 To FrameH DE!P[$J  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth |eEXCn3{  
  Next i f/3rcYR;y  
  For i = 1 To FrameH * barWidth bm#/ KT_8  
    totalIMG = totalIMG + pBuffer(i) Yrmd hSY  
  Next i S/
)yi  
  avRegion = totalIMG / pFrameSize |rwx;+  
End Function <z R CT  

一共这么多文件。 $_Q]3"U  
Y20T$5{#  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 h1Logm+m  
第6车皮 &{ZTtK&JF  

KZ$^Q<d^  
grTwo  
第9车皮 V~

]&1  
^EcwY- Qr  
  

从这里里分离出来的。

n..R'vNj  
MR/gLm (8(  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 &;[
e  
zR5KC!xc  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？
.~fov8  
(W5JVk_o