引用

引用第20楼newport93于06-14-2010 13:47发表的  : %z"${ zw  
)FSa]1t;x  
老五，I 服了U。 7j~}M(s
"  
lSK<LytB  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 |Q*OA  

n1r'Y;G  
4KnrQ-D  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! nz_1Fu>g|  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : zya2 O?s  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? v)s; wD  

\Jm^XXgS  
V8}jFib  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : kJk6lPSqi7  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 $9rQ w1#e  

Ee097A?1vj  
&b9bb{y_$K  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 vTq [Xe"  
&\L\n
}i-  
可以从宽不？

引用

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

;X%8I$Ba,  
qx";G  
其实标题没有什么，卡总既然改了就不必再改回了。 4b 1a?  
.Zm de*b  
主要是当初写的时候真是顶着锅盖写的。 wOn*QO[  
>gf,8flgj  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : 8@r>`c  
哦, 打倒忽悠大家的家伙.      @./@"mR<  

y(X^wC  
"rHPcp"m  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : .J?RaH{i  
每个人的故事对其他人都是故事, ik5"9b-\<  
自己的故事也是其中之一. Tsocc5gWZ*  
跳出来看, ^ #3,*(S  
不过是众人中的一个人的故事. WS"v"J%   
]F #0
to  
所以,接着听故事. tG[v@-O  
?ZYj5[op,H  
女人们有兴趣的就等老伍开个新帖或者跟贴, ?f*>=;7=  
听他痛说恋爱革命历史.... 0%qM`KZC  
\O )u' Bu  
杂家接着听他自学程序员历史, Sg1,9[pb  
高级程序员考了吗? $]MOAj"LH  

5
")BCA  
|WSmpuf  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ p1s|JI  
3v3`d+;&  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 w:2yFC  
uFL! *#A  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 QB*n [(?  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : Ox6^=D"  
引用第19楼伍胥之于06-14-2010 12:33发表的  : TSj)XU {W  
ZW x4/G  
|UN#utw{^Y  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 (qDJgf4fgn  
c[EG cY={  
我连一级也没有考过。 9mEhZ"  
. *2Q x69`  

Rk}=SB-  

引用

#!4`t]E<  
矬子里拔将军... }R`}Ey|{  
你们那里的俗语是吧? 10
*^  
`3
.bux~  
我们这里说"矮子里拔长脚"..应该是同一个意思... e*o:ltP./  
^?T,>ZI  
有趣....各地有表达意思一样却方式不同的俗语.... 9HAK  
\>+BvF  
PcvA/W  
你的文章写的有脸皮,没屁眼的, 2>im'x 5  
让看客大为不满... r]&&*:  
E#n:d9WA:  
你等着,,估计你以后接到的午夜凶铃就多了... A&_v:z4y/  

\8`^QgV`@  
<9`/Y"\p  
我到现在也没有接到你的午夜凶铃呢！ aq8mD^j-&  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : T4}q%%7l  
伍SIR，再次抱拳佩服 %`:+A?zL  

dZ\T@9+j+  
7s1LK/R|u  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : eh$T 3_#q  
佩服，玩也玩得这么专业！ P 4~C0z  

b=Y3O  
i- r y5x  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : A+F@JpV  
8W yv!tL  
介个真的看不懂。 )F4P-u  
你说你老啦，喜欢怀旧了，才想起来填坑。 O
PVcT  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 +W9#^  

GFtE0IQ  
D$y-Kh  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 *Ldno`1O  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ yTL<S'  
DWORD dwCB; 3
L(vZ2&  
LARGE_INTEGER  offset; _D?`'zN  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); ?]u=5gqUU  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); ' fP`ET5  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ m;KD@E!  
DWORD error = GetLastError(); -dsE9)&8DX  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); j /=4f�  
return FALSE; <',bqsg[  
} w@ =Uf7  
return TRUE; "+:IA|1wD  
} tXnD>H YV  

'VB 6.0 版 ..hD_k  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 JgY#W1>  
T.p:`}M a  
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 1Qz1 Ehz>  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 2k$~Mv@L  
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 Zm!5X9^!  
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 )~l`%+
 
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long G;3N"az  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 W{v-(pW  
Cn>RUGoUsI  
D#G(&<Q  
Private Const GENERIC_READ = &H80000000 c$HZvv  
Private Const GENERIC_WRITE = &H40000000 @d86l.=  
Xi!`+N4  
Private Const FILE_SHARE_READ = &H1 Fz4g:8qdA  
Private Const FILE_SHARE_WRITE = &H2 '+c
Px\4  
Private Const OPEN_EXISTING = 3 R s)Nz< d  
K-b'jP\  
Private Const INVALID_HANDLE_VALUE = -1 q!P{a^Fnc  
9!sR}  
'//file seek N^{+1u7  
Private Const FILE_BEGIN = 0  rVo?I  
Private Const FILE_CURRENT = 1 V,CVMbn/%N  
Private Const FILE_END = 2 _YgvLz %  
kX^Y{73  
Private Const ERROR_SUCCESS = 0& _Q1[t9P"  
2E":6:Wsw  
'//device io control #ig* !  
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 9xm'0 '  
I2PFJXp_]n  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 >AT T<U=  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 Zr.6J*&!  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 hO@VYO  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 sjj*7 i*  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C <..|:0Q&~  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 ayQB@2%  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F `vPc&.
-K  
\E<t'\>@ X  
'//type 1 Xi.OGl  
Private Type LARGE_INTEGER 0'9zXJ"  
    lowpart As Long UI>?"b6 L  
    highpart As Long +(|6Wv  
End Type oj1,DU  
APA:K9jD  
Private Enum MEDIA_TYPE cc^[u+  
    Unknown ]TmxCTVL  
    F5_1Pt2_512 )W& $FU4JK  
    F3_1Pt44_512 NJ{M-K%>  
    F3_2Pt88_512 q|+`ihut  
    F3_20Pt8_512 \.%GgTF  
    F3_720_512 4D-4BxN*  
    F5_360_512 B:Xmc,|,  
    F5_320_512 *U=%W4?W  
    F5_320_1024 (NBq!;_2,x  
    F5_180_512 {b6$F[e  
    F5_160_512 $ h( B2  
    RemovableMedia 5#v|t\ {  
    FixedMedia eBW=bK~[VP  
End Enum 1k8zAtuj  
xi
=\]  
Private Type DISK_GEOMETRY ?A4t &4  
    Cylinders           As LARGE_INTEGER dNL<O  
    MediaType           As MEDIA_TYPE LiF(#OuZ  
    TracksPerCylinder   As Long 3M[b)At V.  
    SectorsPerTrack     As Long Q{0!N8']"  
    BytesPerSector      As Long V=v7<I= ]  
End Type <x| P}  
JBKCa 3  
'//private vars c$>$2[*=  
Private hDisk           As Long             'disk handle ZCbnDj  
Private lpGeometry      As DISK_GEOMETRY    'disk info V@"Y"}4n4  
Private lBufferSize     As Long             'the buffer size of read/write XeT{y]lkd  
cKKl\g@}  
Public Function OpenDisk(ByVal FileName As String) As Boolean =7U_ jDME  
'// 打开磁盘 ?$#,h30  
    hDisk = CreateFile(FileName, _ D!oELZ3  
                        GENERIC_READ Or GENERIC_WRITE, _ FX#fh 2  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ #K3`$^0 s  
                        ByVal 0&, _ 71#

ipZ
 
                        OPEN_EXISTING, _ ![,W?  
                        0, _ GrB+Y!{{  
                        0) Zh]FL8[ nc  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) *uq}jlD`!  
End Function _V`Gmy[]p  
b&V}&9'[M;  
Public Function CloseDisk() As Boolean I;<aJo6Yl  
'//关闭磁盘 viJK%^U=-  
    CloseDisk = CloseHandle(hDisk) LT3ViCZ-n  
End Function sX~ `Vn&  
1[;~>t@C  
Public Function GetDiskGeometry() As Boolean [*k25N  
'//获取磁盘参数 7:D@6<J?  
    Dim dwOutBytes      As Long ]8qFxJ+2^  
    Dim bResult         As Boolean dk^Uf84.Gr  
     > v~?Vd(  
    bResult = DeviceIoControl(hDisk, _ j}CZ*  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ ~X`_g/5X  
                                ByVal 0&, 0, _ rIE 
m  
                                lpGeometry, Len(lpGeometry), _ rIt
#ps  
                                dwOutBytes, _ {|kEGq~aE  
                                ByVal 0&) $C;)Tlh  
     ?<iinx   
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack d}.*hgk  
    GetDiskGeometry = bResult E?z~)0z2`  
End Function $#/-+>  
~j`;$o  
Public Sub GetDiskInfo(MediaType As Long, _ h8Bs=T  
                        Cylinders As Long, _ w<ol$2&B  
                        TracksPerCylinder As Long, _ ;L gxL Qy;  
                        SectorsPerTrack As Long, _ nKzS2u=:Y  
                        BytesPerSector As Long) !Deg!f\g  
'//返回磁盘的参数 f;nO$h[Qb  
    MediaType = lpGeometry.MediaType azxGUS_i<  
    Cylinders = lpGeometry.Cylinders.lowpart }? W[D  
    TracksPerCylinder = lpGeometry.TracksPerCylinder X. =%  
    SectorsPerTrack = lpGeometry.SectorsPerTrack ; SS/bS|  
    BytesPerSector = lpGeometry.BytesPerSector ,/=Fm  
QD}'2{M!  
End Sub (0=e ,1 n  
J^J$I!  
Public Property Get BufferSize() As Long  jx3J$5  
'//返回每次读/写的缓冲大小 g(i_di  
    BufferSize = lBufferSize :|\{mo1NB  
End Property &pCNOHi|  
XRMYR97  
I+?9}t  
Public Function LockVolume() As Boolean XPhC*r  
'// 将卷锁定 csPziH$wl  
    Dim dwOutBytes  As Long m;S!E-W  
    Dim bResult     As Boolean s 9Y'MQo*  
     z|o7k;raH  
    bResult = DeviceIoControl(hDisk, _ B
P6|^Q  
                                FSCTL_LOCK_VOLUME, _ !`rR;5&sT  
                                ByVal 0&, 0, _ #]iSh(|8  
                                ByVal 0&, 0, _ a&Stdh  
                                dwOutBytes, _ 'V=i;2mB*  
                                ByVal 0&) QD6in>+B@  
    LockVolume = bResult 2k}" 52  
End Function Y'YvVI  
ky`xBO=  
S<f]Y4A&  
Public Function UnlockVolume() As Boolean <R TAO2  
'// 将卷解锁 W]]@pbG"H\  
    Dim dwOutBytes As Long d%y)/5  
    Dim bResult As Boolean PE IUKlX  
     BJ0P1vh6M  
    bResult = DeviceIoControl(hDisk, _ r{V=)h  
                                FSCTL_UNLOCK_VOLUME, _ z)RJUmY3B  
                                ByVal 0&, 0, _ q;
^Q1[Ari  
                                ByVal 0&, 0, _ V5MLzW\8  
                                dwOutBytes, _ [email protected]<u  
                                ByVal 0&) ]>33sb S6  
    UnlockVolume = bResult g8JO/s5xV  
End Function CBqeO@M  
I,*zZNvRi  
3q!hY  
Public Function DismountVolume() As Boolean 1gA9h-'w  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 UkE fuH  
    Dim dwOutBytes As Long vnNX)$f  
    Dim bResult As Boolean w$X"E*~>8  
     (^:0g.~c  
    bResult = DeviceIoControl(hDisk, _ Y~P1r]pi B  
                                FSCTL_DISMOUNT_VOLUME, _ }-ly'4=l  
                                ByVal 0&, 0, _ <]~FX25  
                                ByVal 0&, 0, _ {xFgPtCM  
                                dwOutBytes, _ f(^? PGO  
                                ByVal 0&) XA&Vtgu  
    DismountVolume = bResult dOm@cs  
End Function 29xm66  
Rd?8LLz  
Pp*:rA"N  
Public Function ReadDisk(ByVal Cylinders As Long, _ m+t<<5I[-  
                    ByVal Tracks As Long, _ vqC!Ajm  
                    db() As Byte) As Boolean ]Kutuf$t  
'//按柱面和磁道来读取磁盘数据 -A?6)ggf.  
    Dim iPos    As Long 5 (Lw-_y#  
    Dim lRead   As Long 4@b~)av)  
     56;^ NE4  
    iPos = Cylinders * Tracks * lBufferSize *kmD/J  
     (Q_J{[F  
    If SeekAbsolute(0, iPos) Then Z?Cl5o&lb  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) H+ P&} 3  
    End If b"lzR[X,e  
End Function 8QYP\7}o  
VO (KQx  
Public Function WriteDisk(ByVal Cylinders As Long, _ m4 4"qp  
                     ByVal Tracks As Long, _ )(?,1>k`Z  
                     db() As Byte) As Boolean 59Lv/Mfy  
'//按柱面和磁道来写磁盘数据 ^dR="N  
    Dim iPos    As Long M@k8;_5  
    Dim lRead   As Long qHZ!~Kq,"'  
     EpX.{B@B_[  
    iPos = Cylinders * Tracks * lBufferSize CNo'qlvF5N  
     w)#Lu/  
    If SeekAbsolute(0, iPos) Then (;9-8Y&_d  
        WriteDisk = WriteBytes(lBufferSize, db()) B<99-7x3  
    End If ;i)NP X  
End Function y@#JzfY?Hr  
x6i7x"  
b9F:X  
'///////////////////////////////////////////////////////////////////////////////////// ^V1.Y  
'//file system 7Rba@ cs9  
r%craf  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean K@JGGgrE`!  
'//seek file U?bQBHIC  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte ma +iIt;  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) ~HFqAOr  
    If LowPos = -1 Then EO&PabZWR  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) Ihd{@6m  
    Else mW/6FC  
        SeekAbsolute = True 7s2 l3  
    End If JE a~avyJ  
     <}\!FuC  
End Function m| / ?((s  
0tL#-47  

iI!MF1  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean sew0n`d1  
'//read data to array FO"sE`  
    Dim RetVal    As Long w$XqxI/&  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) N;YAG#'9~_  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF -`I&hzl6E  
    ReadBytes = Not (RetVal = 0) HX;JO[0  
     o9<)rUy  
End Function #~_ZG% u  
` XvuyH  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean `X["Bgk$!T  
'//write data from array cYC@@?  
    Dim RetVal As Long W>+/N4  
    Dim BytesToWrite As Long XF6ed  
    Dim BytesWritten As Long
$?HOke  
     wM-I*<L>  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) sjZ@}Vk3b  
     F}f/cG<X  
    WriteBytes = Not (RetVal = 0) DOsQVdH  
End Function 4Y2!q$}I+  

这才是我当年写出的一个比较烂的程序 ?oD
]J  
5x2m]
u  
Main2.bas .|VWYN   
e5GJ:2sH  
Attribute VB_Name = "SubMain" pzQWr*5a  
Option Explicit u ? }T)B  
Vx~N`|yY  
'采集文件与临时文件 (}4]U=/nV  
Public Const TmpFile As String = "d:\30-0600.dat" /c&;WlE/n  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 pX/42W  
+o4W8f=Ga  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Ft[)m#Dj`  
Public hBCFile As Long  '记录采集参数的文件 7m<;"e)  
Public Const TmpBMP As String = "d:\1.bmp" \#hp,XV>  
Public hTmpFile As Long Ag82tDL[u  
?V{AP&#M$x  
C$<['D?8  
'采集窗口参数常量 G-DvM6T  
Public Const FrameH As Long = 280& Dcep^8'  
Public Const FrameW As Long = 768& 1v?|n8  
Public Const pFrameSize As Long = FrameW * FrameH dsUt[z1w5  
6^+T_{gl  
'标志区范围，用于识别车辆 S^,q{x*T  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X 
,ix>e  
Public Const mkW As Integer = 28  '识别标志立柱宽度 ?BEO(;'  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) O>M4%p  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) -~|E(ys  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 G
@N -+  
'车缝检测位置常数 'QP~uK  
Public Const sSize As Long = 32& mu>L9Z~(L_  
Public Const sPos As Long = 310& ru5T0w";V  
Public Const sPosL As Long = 200& Y)ig:m]#  
Public Const sPosR As Long = 500& A*a:#'"*N  
'车缝检测框位置 8HaBil  
Public Slice(1 To sSize, 1 To FrameH) As Byte tLD(%s_  
Public SliceL(1 To sSize, 1 To FrameH) As Byte ;bMmJ>[l-  
Public SliceR(1 To sSize, 1 To FrameH) As Byte UNC%<=  
Public avSL As Integer, avSLR As Integer, avSLL As Integer s?,\aSsU@  
C)RJjaOr  
x\R%hGt  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 /SvB w>gQ  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 9i?Q=Vuc~<  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 [b?[LK}.  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long 'KU)]v  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte H wu(}  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 :~ ; 48m  
z~f;5xtI  
!8Mi+ZV  
6+iZJgwAy  
'一次连续采集的帧数
~stG2^"[  
Public tFrames As Long w(EUe4 w{  
%8]~+#]p  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 UWPzRk#s"  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 B7u4e8(E*  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize ?j:g.a+U  
3c|u2Pl  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte q=J8SvSRl  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte \G~<O071  
Public pWorkSpace(1 To FrameW * FrameH) As Long M
,R**z  
Public Const pBufferSize As Long = FrameW * FrameH * 2 u]uUm1Er  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 ^h5h kIx0  
YM`I&!n  
Public hBoard As Long   '采集卡标识 A4mnm6Tf  
Public mBufferAddr As Long  '缓存地址 *;0Ods+IcY  
Public BufferSize As Long  '缓存大小(字节) ]iHSU P  
Public iCurrentCard As Long PX$_." WA  
Public CapStatus As Long xV+cX*4h  
Public iFrames As Long Yo^9Y@WDW  
Public currentBr As Byte, currentContr As Byte +*')0I
 
<`P7^ 'z!  
Public hMEM As Long, mStatus As Long VmbfwHRWb  
Public Const hMemSize As Long = pFrameSize * 4 'k1vV  
Public hMemWork As Long # VAL\Z  
Public Const hMemWorkSize As Long = pFrameSize * 5 m+LP5S  
*$Tz g!/  
C"[d bh!  
"/~KB~bB  
'串口接收轨道衡数据 U'Mxf'q  
Public WeightFromCom As String g4U`Qf3  
Public bReceiveComplete As Boolean Z<4Du  
so]p1@K  
C U 8s*  
Public Type GrayBMPHeader : 6|nXL  
  Tag As Integer !=B=1th4  
  FileLength As Long    '文件大小 +)06*"I  
  Reserve1 As Long ./r#\X)dc  
  DataOffset As Long    '图像数据偏移量 rJ^*8C!  
  BMPHeaderSize As Long  '文件头长 j}F;Bfq!  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… ?Dn 
6  
                        'the following sizes are possible: *vS)aRK  
                        '28h - windows 3.1x, 95, nt, … )N}
.n2Y8W  
                        '0ch - os/2 1.x v*3tqT(%  
                        'f0h - os/2 2.x )"sJaH
x<  
E8Y (C_:s  
  ImageWidth As Long           '图像宽（像素数） Y2&hf6BE  
  ImageHeight As Long          '图像高(像素数) 6jpfo'uB$  
  PlaneNumber As Integer  '图像层数 p8bAz  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap &f_ua)cyY  
                                        '4 - 16 color bitmap $Ao iH{f  
                                        '8 - 256 color bitmap .{ t]Mc  
                                        '16 - 16bit (high color) bitmap 8oxYgj&~X  
                                        '24 - 24bit (true color) bitmap ])v WvNx  
                                        '32 - 32bit (true color) bitmap OY'6~w9  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) T{B\1|2w  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) U3rpmml  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) .EXxNB]%Y&  
                                    '3 - bitfields (also identified by bi_bitfields) ^a#  
  IMAGESIZE As Long  '图像数据字节数 L8.u7(-#  
  hResolution  As Long  '水平分辩率  像素数/米 BqG7Et  
  vResolution  As Long  '垂直分辩率 \*i[m&3;q  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 ^3 6oqe{  
  ImportantColors As Long D@iE2-n&V  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 FrL ;1zt  
End Type %&\DCAFk  
*{1]b_<  
NB)$l2<d  
j@778fvM\t  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader ^>/] Qi  
Public sRECT As RECT *T:gx:Sg/  
p/4}SU  

Hr}pO"%  
Public conn As ADODB.Connection =t!$72g\  
Public rsTrain As ADODB.Recordset v_L?n7c  
Public rsOperater As ADODB.Recordset rpn&.#KS  
Public rsGoods As ADODB.Recordset ^Sj*  
Public rsGood2 As ADODB.Recordset 7a5G,C#QQ  
Public rsSender As ADODB.Recordset rd hM#?  
Public rsReceover As ADODB.Recordset b[;Zl<  
Public rsTrainTMP As ADODB.Recordset 9zac[tno  
QKt+Orz  
'M=c-{f~  
'打开采集卡 f J$ >VN  
'设置参数 C
[2LP$6*/  
'设置为实时单帧采集到缓存方式 mJFFst,  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 3Jj 3!aDB  
34s>hm=0.  
XMi)PXs$  
Sub Main() Z0!yTM/C  
  Dim i As Integer, status As Long |*te69RX  
     m14OPZ<3?-  
   InitBMPinfo _a&M k  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 wU(N<9  
    BMPHeader.Tag = &H4D42 A"pV 7 y  
    BMPHeader.ImageWidth = FrameW OtD!@GQ6  
    BMPHeader.ImageHeight = FrameH =CGB}qU l0  
    BMPHeader.BMPHeaderSize = &H28 T.B}k`$  
    BMPHeader.PlaneNumber = 1 E As1 =  
    BMPHeader.bpp = 8 n\'@]qG)Z4  
    BMPHeader.Compression = 0 M7. fz"M  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 0?/vcsO  
    BMPHeader.vResolution = &H1274 K
sFkC=  
    BMPHeader.ColorsinBMP = 256 m>8tA+K)+)  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP LvbS")  
    BMPHeader.DataOffset = Len(BMPHeader) S<=
|i  
    For i = 0 To 255 6SVh6o@]  
      BMPHeader.Pallate(i) = RGB(i, i, i) wpS $-  
    Next i iD`>Bt7gD  
    BMPHeader.IMAGESIZE = FrameH * FrameW 0{Bhr12V  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE &8'QD~  
jB-wJNP/  
FTT=h0t  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) k`
;&?
?  
     P d)<Iw^<
 
    BMP1.ImageWidth = FrameW jQRl-[n  
    BMP1.ImageHeight = FrameH * 2 l~j{i/>  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight W;y ,Xs  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE ;{S7bH'6m  
`bMwt?[*  
  '确定标志位置,为pilarX, pilarY确定初始值 z3|)WS^  
   PilarW = mkW y _A7CG"^  
   PilarH = mkH  '此两项为固定值 3lo.YLP^  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) {q
^?Rw  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 a, ~}G'U  
   )uxXG`,h  
   _^Yav.A=  
  '连续采集记录文件 kO'_g1f<[  
  ' 建立一个缓冲区为页对齐方式的文件 @$] CC1Y  
  If Dir(TmpFile) <> "" Then _;8+L\  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ ly)L%hG  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) "Qfw)
!#  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 b]XDfe  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 8iKupaaOX  
  Else Qu6Q)dZ<  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ +x:- W0C:  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) S1G=hgF_L  
  End If !PuW6  
  If hFile = 0 Then ~ s# !\Ye  
    MsgBox TmpFile & ": File Open Error", vbOKOnly n s;nle|m  
    Exit Sub C$#X6Q!,  
  End If bc ;
(2D  
  '采集参数记录文件 0\a;} S'g#  
hBCFile = FreeFile() M%@=BT  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile 3E`poE  
   ;&?l1Vu  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 [bZASeh  
If hMEM = 0 Then Tj_~BT  
    fStatus = GetLastError w/Ej>OS  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ #`Gh8n #  
     & "请向技术人员报告该错误代码。", vbOKOnly /'WVRa  
    CloseHandle hFile O({vHqN>  
    Exit Sub QJK
VNOo  
End If x39 n7+j4  
t]PO4GA  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) Yh9fIRR
 
If hMemWork = 0 Then ^Z
~'>J  
    fStatus = GetLastError u[yUUYe  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ T*irCe  
     & "请向技术人员报告该错误代码。", vbOKOnly _?J:Z*z?  
     '释放已成功分配的内存 ]id5jVY  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 8j%hxAV$  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) x"xtILrI  
     3GUJlFj  
    CloseHandle hFile 8"2X 8C8  
    Exit Sub J2P5<  
End If 2}HS`) /  
L7 f'  
' Test writing =sa bJsgL  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& nd?R|._R  
     50
J"cGs~  
   '初始化采集卡参数 mbCY\vEl  
   iCurrentCard = -1 Lf}@v  
   hBoard = okOpenBoard(iCurrentCard) XF=GmkO  
   Debug.Print hBoard m(c5g[6nO  
   If hBoard = 0 Then ?Rg8 u  
      ExitGrabber o;<oXv  
      End RBM(>lU:  
   End If Bvy(vc=UDW  
   okGetBufferSize hBoard, mBufferAddr, BufferSize wD'LX  
   If mBufferAddr = 0 Then ^"hsbk&Yu  
     MsgBox "缓存不存在！" ({l!'>?  
     ExitGrabber 6yRxb(  
   End If T.R (  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) 1> wt  
   f7Fr%*cO
 
   wU=@,K  
   currentBr = 128: currentContr = 128 (y;8izp9!  
   '设置视频输入参数 Ne 9R u'B6  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 H;nq4;^yK  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input XkJzt  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 .-W_m7&}  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 >xa k  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 DGllJ_/Z  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 i][af  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） #w<:H1,4
 
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) |e#ea~/b  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) Vg^@6zU  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 |=CV.Su  
   l|onH;g\  
   '设置采集参数 //\UthOT  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 <u9U%Vsi  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 %}%vey  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 SOPQg?'n=V  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 cr_Q,
*  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 ?a]uyw,  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 -A A='s  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 'G-zJcU  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 F6xQ`T|  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 ,0=@cJ  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 /92m5p  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 ND|!U#wMNV  
   beM}({:`  
   WF{rrU:  
   okCloseBoard hBoard <O#/-r>2  
   Sleep 50 !b+/zXp3I
 
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 BHW8zY=F  
   |(=`l  
   '设置数据传送方式 ?MhY;z`=  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 s]p3dB#  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 ixFuqPij  
   L>qLl_.  
   sRECT.Right = -1   '用于获得当前设置值 RO1xcCp  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) xo46L\  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom u4kg#+H  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 D{!NTr  
   sRECT.Left = 0 HBc^[fJ^-  
   sRECT.Top = 0 B[R1XpB7  
   sRECT.Right = sRECT.Left + FrameW !SFF 79$c  
   sRECT.Bottom = sRECT.Top + FrameH * 2 jLEwFPz  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Wi?37EHr  
   N>$Nw<wV  
   sRECT.Right = -1   '检查新设置值 utz!ElzA  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) 2Hp#~cE+.  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 8yDu(.Q  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) 1Lf :TQB  
   tE: m& ;I  
   If TESTSignal = False Then (|PxR#{l<  
      'ExitGrabber e2v[ma-  
   End If @pKQ}?  
   3B<$6  
   !a[1rQH  
   }FTyRHD|  
   '设为实时采集状态 _=.f+1W  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) ^|(w)Sy  
   ^dzg'6M  
   ^BruRgc+  
   '单帧采集 [foZO&+!  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 p7A&r:qq#  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) `<C/-Au  
   okCaptureTo hBoard, BUFFER, 0, 1 'single !PzlrH)M=p  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 \H zI*|*A  
   '   Sleep 20 B0KZdBR x}  
   'Loop uW8LG\Z>D5  
   okGetCaptureStatus hBoard, True <R.5Ma  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize 0O,l rF0'  
   '写入768*576测试图象 coxMsDs  
   ArrayToBMP TmpBMP 6BJPQdqSl  
   54Baz  
   '打开数据库 fdD?"z  
   Set conn = New ADODB.Connection }cL9`a9j  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ i7fQj, q  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ C>qKKLZ  
      "; Mode=Read|Write" ~ZSP K;D[  
   conn.Open Jz!8Xg%a  
   $Qv+*%c  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) <E(#;F^y  
   frmRecord.Visible = True hK+Iow-  
   frmQuery.Visible = True [kyF|3k~  
   Load frmReceiveFromComm )bqfj>%#c  
   hoc$aqP6pp  
   '调试参数 /8GgEW9Q~G  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then }D7q)_g=  
     SignalBox.Visible = True H-9%/e  
   End If > !
OD[9  
   If InStr(UCase(Command()), "/COMM") > 0 Then !6pOY*> j  
     frmReceiveFromComm.Visible = True 1>"K<6b+  
   End If \I@=EF- &  
xsx @aF  
End Sub Ua^'KRSO  
Asn7;x0;  
Sub ExitGrabber() pv=g)  
  '关闭数据库 <
.0-K_  
  '关闭采集卡 :/BU-SFK^  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) OgiE lA.  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) XM$HHk}L;  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) $f-f0t'  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) !`k{Ga  
  okStopCapture hBoard @eRR#
S  
  okCloseBoard hBoard }'mBqn  
  CloseHandle hFile T #&9|  
  Close #hBCFile &sp7YkaW  
  conn.Close t&SC>8M<  
  End XF{ g~M  
End Sub pr8eRV!x  
zUM;Qwl  
Function ArrayToBMP(ByVal File As String) HXTB
xh  
Dim BytesWrite As Long `5:Wv b>|  
);wSay>%(  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ '*5I5'[ X,  
  CREATE_ALWAYS, 0&, 0&) 8Vkw vc  
1@)8E`u  
If hTmpFile = 0 Then 3%]%c6  
   ArrayToBMP = False O;9'0-F ?  
   Exit Function JRkC~fv  
End If xq2{0q  
SsDe\"?Q  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ?q(7avS9  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& -,Q !:  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN t%e}'?#^  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& {q%wr*  
y#:_K(A" k  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN  $&96qsr  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& %pNK ?M+  
)QGj\2I  
If BytesWrite < pFrameSize Then ;^}gC}tq  
  ArrayToBMP = False Lt+ Cm$3  
End If 6uCa iPV  
uoYG@L2  
CloseHandle hTmpFile  ,%#FK|  
yVvO!  
End Function 9pKN^FX,76  
3[E3]]OVa  
Function ArrayToBMP1(ByVal File As String) Bf$YwoZov  
C:/O]slH  
Dim BytesWrite As Long #YM5P  
,F7W_f# @3  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ Sni Ck*T,  
  CREATE_ALWAYS, 0&, 0&) A@BYd'}]  
m]8rljo  
If hTmpFile = 0 Then l+'@y (}Q  
   ArrayToBMP1 = False (c ?OcwTH  
   Exit Function MO+g*N  
End If <FIc!  
_ cK"y2  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN |*W`}i  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& \0iF <0oy  
66*/"dBwm  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN a$p?r3y  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& >(s)S[\  
PpD ?TAlA  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN N/QTf1$  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& kh/n|2  
vT V'D&x2  
If BytesWrite < pBufferSize Then n*6Oa/JG7  
  ArrayToBMP1 = False 5:%xuJD  
End If tr6<89e(o  
C9[Jr)QX  
CloseHandle hTmpFile {OP[Rrm  
{ as#lHn  
End Function 7q<2k_3<  
7*8R:X+^r  
'使用该过程建立的文件要求在用后关闭 [R[]&\W  
Public Function ArrayToBMP2(File As String) As Boolean k{<]J5{7  
DIH|6R  
Dim BytesWrite As Long R _WP r[P  
UI}v{0
5]  
ArrayToBMP2 = True { ZiJnJX  
5o 4\Jwt  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ dd#=_xe  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) n=#AH;42  
x2*l5t  
If hTmpFile = 0 Then ufE;rcYE  
   ArrayToBMP2 = False Vp*#,(_G:  
   Exit Function .5*h']iFr1  
End If eAh~`  
M=$ qus  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN iB;EV8E  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& T u>5H`  
g5X;]%:  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN f]MKNX  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& 5qzFH,  
QFMR~6 ?  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN /EF0~iy  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& U|QLc  
{3F;:%$`c  
If BytesWrite < pFrameSize Then 68 %= V>V  
  ArrayToBMP2 = False pj:s+7"t  
End If u}ULb F  
vt@5Hb)  
CloseHandle hTmpFile \ s^a4l2  
"c8 -xG  
End Function qjQR0MC  
=e2|:Ba!  
Private Function TESTSignal() As Boolean FES_:?.0  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long q}[
g/%  
T8( \:v
 
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) h+)XLs  
*Y"Kbn6  
If extsign = 1 Then R57>z`;  
   TESTSignal = True o$]wd*+  
Else XKD0n^L[  
    If extsign = 0 Then kR2kV"-l  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly C7#ji"t  
        TESTSignal = False `)Z"||8K  
        Exit Function r(;sX  
    End If ocCq$%Ka  
End If f%fD>a  
ME"B1Se\  
'测试视频输入类型 fYrC;&n  
'video type U.]5UP:a  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 ?.tnaE  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) Y;$wD9W  
If videotype = 1 Then  xE.K  
        '"隔行信号(Interlaced)" p4QQ5O$;  
Else tHAr9
 
   If videotype = 0 Then -j1?lY  
       '"逐行信号(Non-interlaced)" Bw _^"e8X  
   Else t*Hr (|.  
     If videotype = -1 Then l"70|~  
       ' "不支持" Z<L|WRe  
     End If &)[?D<  
   End If %M8m 8 )  
End If 7kX;|NA1  
W^{zlg  
'测试垂直扫描线数 Bx9R!u5D  
'video scanlines q`1"]gy.  
scanlines = -1 )Il) H  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) jdz]+Q`j
q  
    If scanlines = -1 Then w<=?%+n  
        ' "不支持" VfWU-lJ  
    Else }+/j/es{]  
        'Trim(Str(ScanLines)) + " 行数/幅" G?`{OW3:_  
    End If LpCJfQ  
\)KLm  
'测试帧频 {nvF>  
'video field frequency N 4Kj)E@  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) 1vKAJ<4W  
    If fieldfrq = -1 Then oYOR%'0*m+  
        'lblSignal(8) = "不支持" nn[OC=cDN  
    Else Vwxb6,}Z  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" m)"gj**|y  
    End If E,u/^V9x  
End Function bMe/jQuL.$  
cAFYEx/(  
/-%0y2"7  
Sub PicIdentify() gR7in!8  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 7A6Qrfw  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 F/gA[Y|,gI  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 PkM]jbLe8  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 = BcKWC  
.nDB{@#  
  Dim fPTR As Long, cFrame As Long SI_u0j4%*  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer <'WS -P%U  
     og0 su  
vmEbk/Vy  
cFrame = 0 S7i,oP7  
 ?'>pfU  
u^2)oL  
Do While cFrame < tFrames w[ )97d  
   :wWPEhK  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) %?<Y&t  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) dsJMhB_41U  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize '" MT$MrT  
   1ym^G0"s  
  frmRecord.RText.Text = Str(cFrame) v_U+wga  
  frmRecord.RText.Refresh `Vph=`0  
       qPal'c0  
  If CheckMark = True Then Xy(8}  
   ArrayToBMP TmpBMP ckDWY<@v  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 3|++2Z{},  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" m9~cQ!m  
   >|j8j:S[  
   DrawSlice }Pi}? 41!  
   PB[Y^q
 
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) :pz`bFJk  
   'If i = vbNo Then Sq<ds}o'8l  
   '  Exit Do ENoGV;WG  
   'End If M3m)uiz  
   'cFrame = cFrame + 1 dgbq Mu"  
   [f
._w~  
  End If ?7;_3+T#  
  DoEvents %=w@c  
  cFrame = cFrame + 1 #bIUO2yVo  
Loop 9):h %o  
End Sub {"rYlN7,  
<!qN<#$y  
:8( "n1^  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean E^ub8  
YCBp]xuE  
'如标志区模式反差存在则为TRUE，否则返回FALSE hCpX#rg?  
]lQLA IQ  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long !H)Cua)  
CheckMark = True {
$ a $m  
   AFMIp^F  
'复制标志区 d2\#Zlu<  
For i = 1 To mkH oItEGJ|  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW _P].Z
8  
Next i C!,|Wi2&  
4hl`~&yDf  
For j = 1 To PilarW * PilarH / 2 qoZUX3{  
   mTop = mTop + MKpilar(j) M\m6|P  
Next j FaA'%P@  
5vP=Wf cW  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH b=87k
  
   mBot = mBot + MKpilar(j) Z'Uc }M'U  
Next j G~.bi<(v  
PiL[&_8g  
mTop = mTop / PilarW / PilarH * 2 :t)<$dtf[  
mBot = mBot / PilarW / PilarH * 2 PxAUsY  
 -F->l5  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 3'*}ZDC  
ta;q{3fe  
'平均值极值化 v35!? 5{  
  For j = 1 To PilarH * PilarW $u"*n\k>  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) :o37 V!  
  Next j  b79z<D  
   ;\mTm;]G  
mTop = 0: mBot = 0 1uwzo9Yg  
For j = 1 To PilarH * PilarW / 2 wC&+nS1  
  mTop = mTop + MKpilar(j) `4Db( ~
  
Next j 1r:i'cWh  
vV$6fvS  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW KkK !E  
  mBot = mBot + MKpilar(j) =|j~*6Hd  
Next j Uo ]x6j<  
PR+L6DT_  
b^s>yN  
  mTop = mTop / PilarH / PilarW * 3 "|,;~k1  
  mBot = mBot / PilarH / PilarW * 3 l|jb}9(J  
   A_pc v7=@  
A?zxF5rfp  
If mBot > iWhite And mTop < iBlk Then cXDG(.!n7B  
  CheckMark = True <>l!  
Else XYrZI/R  
  CheckMark = False f.e4 C,  
End If -a+oQP]O  
End Function $ca>bX]  
+$CO  
Sub Capture1Frame() jhx
@6[  
   okCaptureTo hBoard, BUFFER, 0, 1 'single
6+.8nx:9X  
   okGetCaptureStatus hBoard, True E9N.b.Q)  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize 5Sh.4A\  
End Sub j&y>?Y&Sb  
-|cB7P  
m[w 8|[  
Sub CopyMark(iBlk As Integer, iWhite As Integer) ^J-"8%  
'复制标志区并返回标志区暗区与亮区的亮度平均值 c}u`L6 !I3  
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 M[:},?ah0  
   =@\Li)Y  
'复制标志区 )O:T\{7+  
For i = 1 To mkH hLo'q^mGr  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW e0e3b]  
Next i ,6Ua+\|  
Z*Lv!6WS  
For j = 1 To mkW * mkH / 2 O!3`^_.  
   mTotal = mTotal + MKpilar(j) M/x*d4b_  
Next j uP.[,V0@^  
SbYsa  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 mo*ClU7  
2EAY`}Rl6.  
mTotal = 0 H_&z-g`  
For j = mkW * mkH / 2 + 1 To mkW * mkH .}*_NU   
   mTotal = mTotal + MKpilar(j) UmNh0n S  
Next j A<*G;  
1)N~0)dO  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 ~IQ2;

A  
&Jf67\N  
'背景亮度 #Zq[.9!q{  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW -<Oy5N  
  For i = 1 To 4 * FrameW n&fV^ x  
    bsTotal = bsTotal + BsLine(i) n38l!m(.  
  Next i %CaF-m=Pq  
  bsAV = bsTotal / FrameW / 4 y%Wbm&h  
0s2@z5bfX  
End Sub ^v+7IFn  
#U?=D/  
Y'9<fSn5&  
Sub AdjIMGbright(Optional bInit As Boolean = True) wK*b2r}0/  
d>bS)  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） L=v"5)m2R  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 egHvI&w"o  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 ,!I'0x1OR  
     VGL!)1
b  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer R![)B97^  
   ;)rs#T;$  
  '按标准亮度与对比度采集一帧，确定背景亮度 m2r%m y  
  currentContr = 128   '初始对比度 >sZ207*  
  currentBr = 128   '初始亮度 :G/.h[\R|  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 XJ *W7HD  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 B,NHy C1i  
  DoEvents 2E/yZ ~2s  
  Capture1Frame PvkHlb^x%  
  '获得图像上缘4行象素 _usi~m  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW o4d[LV4DS  
  CopyMark iBlack, iBright   '图像标志区亮度 G ]JWd  
  For i = 1 To 4 * FrameW r$/.x6g//  
    bsTotal = bsTotal + BsLine(i) Z.{r%W{2  
  Next i A1kqWh
g\  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 48W-Tf6v|  
   \?K>~{)  
  Select Case bsAV $?Yw{%W  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 _  ATIV  
       currentBr = 150 g| M@/Dl  
       currentContr = 60 KOP*\\1 J  
     Case 61 To 80   '有可见背景 ?YA5g' l  
       currentBr = 140 bA*T1Db,t>  
       currentContr = 70 0o*  
     Case 81 To 100  '有清晰背景 1}DUe.a  
       currentBr = 128 8pE0ANbq  
       currentContr = 80 I/Q5Y-atg  
     Case 100 To 150  '有明亮背景 se^(1R k  
       currentBr = 140                '5:30-6:00钟实测数据 *p>1s!i  
       currentContr = 50 c ;@k\6  
     Case 151 To 180 38HnW  
       currentBr = 130 maINp"#  
       currentContr = 60 wJb"X=i*  
     Case 181 To 220  '背景全为白色 mj^]e/s%  
       currentBr = 110 .=% ,DT"  
       currentContr = 130 M hJ;)(  
     Case 221 To 255  '背景全为白色 h_?#.z0ih;  
       currentBr = 100 $/XR
/  
       currentContr = 100 }29Cm$p  
  End Select ?D]qw4J  
   ^[u*m%UB  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 7nOn^f D  
        Case 100 To 150 H>Ws)aCq  
          currentBr = currentBr - 10 {S=gXIh(y  
        Case 151 To 255 dq U.2~9  
          currentBr = currentBr - 20 }rbsarG@  
  End Select L|
pJ\~  
   <Q%:c4N  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Mz:t[rfs  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度
eK_Yt~dj  
End Sub j[q$;uSD  
m<wEw-1.  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) VQ]MJjvb  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long NX5NE2@^qH  
     /&Vgo~.J  
    For i = 1 To 8 DUOSL  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& %m0x]  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& u*C"d1v=  
    Next i ?&>H^}gDZ  
     7J$ 5dFV2  
    For j = 1 To 1024 HZ.Jc"+M  
      L1 = L1 + LeftBK(j, 0) /{7we$+,p  
      L2 = L2 + LeftBK(j, 1) /c9%|<O%  
      R1 = R1 + RightBK(j, 0) H,5##@X  
      R2 = R2 + RightBK(j, 1) "RG #e+  
    Next j J"W+9sI0  
    diffL = Abs(L1 - L2) / 1024 Pln*?o  
    diffR = Abs(R1 - R2) / 1024 j6.'7f5M<H  
End Sub q oJ4w7  
nbM7 >tnsk  
Function CheckSlice() As Boolean $v*0 \O  
  CopySlice avSL, avSLR, avSLL e)x;3r"j  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then RI2Or9.   
    CheckSlice = True b/Q\ .!  
  Else t 9Dr%#  
    CheckSlice = False 2`]_c=  
  End If /naGn@m5u  
End Function i[M]d`<36  
W;9Jah.  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) y9'F D5\s  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long J&jNO Nu?  
  For i = 1 To FrameH kn1+lF@  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize c-, 6k  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize h1uD>heGl  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize sJ(q.FRM'  
  Next i ko<iG]Dv'  
  For i = 1 To FrameH q7'[II;  
    For j = 1 To sSize A1u|L^  
       total = total + Slice(j, i) ( O>oN~  
       totalL = totalL + SliceL(j, i) `9yR,Xk=l  
       totalR = totalR + SliceR(j, i) $xsmF?Dsx5  
    Next j Y =BXV7\  
  Next i X/!37  
  avSL = total / FrameH / sSize fX 41o#
 
  avSLR = totalR / FrameH / sSize oL69w1  
  avSLL = totalL / FrameH / sSize FeM,$&G:  
End Sub eS{ xma  
GP/Gv  
Sub DrawSlice() ;n-IpR#|  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B U~Ai'1?xz  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B av*M#  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B _-.~>C  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) [va7+=[1=  
End Sub wcI4Y0+J  
Sub DrawMark(pic As Control) 7L=V{,,v  
   Dim i As Long, j As Long [Y^1}E*  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B Fo1|O&>  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B /Dn  
   For i = 1 To PilarH I$7TnMug  
     For j = 1 To PilarW 1n86Mp1.e  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) b2vc  
     Next j u
VBMI.&w  
   Next i Gr a(DGX  
End Sub RZ:i60  
EjY COb-  
Function avIMG() As Integer yt-F2Z &  
  Dim i As Long, j As Long, totalIMG As Long rH<iUiA?O  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize +^6v%z  
  For i = 1 To pFrameSize LbeMP  
    totalIMG = totalIMG + pBuffer(i) Nu%JI6&R  
  Next i jt/ |u=  
  avIMG = totalIMG / pFrameSize cLD
-,v;c  
End Function }ST0?_0F*  
/rqaUC)A  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer :8<\]}J  
  Dim i As Long, j As Long, totalIMG As Long &_!g|-  
  For i = 1 To FrameH tt7l%olw  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth ;%R+]&J  
  Next i 5E#koy7 $s  
  For i = 1 To FrameH * barWidth [Bz'c1  
    totalIMG = totalIMG + pBuffer(i) pdrF/U+  
  Next i = +uUWJ&1G  
  avRegion = totalIMG / pFrameSize VK)K#!O8  
End Function ,6%{9oW9Z:  

一共这么多文件。 I]`>m3SJ  
~[i,f0O,  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 #[*e$C  
第6车皮 FeS6>/  

^yKP 99(  
Osb"$8im  
第9车皮 G:.Nq,513  
PZ-|W  
  

从这里里分离出来的。

gsc*![N  
/w!b2KwV  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 iTbmD  
gSu+]N  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ D2>EG~xWq  
+U+c]Xgt  

继续填个坑： zv#i\8h^p  
Dw[w%
uz  
用VBA控制WORD自己修订学生毕业文的格式。 QsDab4