引用

引用第20楼newport93于06-14-2010 13:47发表的  : +->\79<#V(  
8dc538:q}  
老五，I 服了U。 _kh>Z  
+yth_9  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 pAENXC\,  

mH'\:oN  
=f
o4x|{O  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! f4R1$(<  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : w.tW=z5  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? Pow|:Lau!  

r9?o$=T  
Bgf=\7 ;5  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  :  ER_ 3'  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 -rO*7HO
 

5:$Xtq  
n6/fan;  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 l/M[am  
!f`5B( @  
可以从宽不？

引用

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

G%$}WA]|  
Td&d,;  
其实标题没有什么，卡总既然改了就不必再改回了。 vbaC+AiX  
oBC]UL;8xJ  
主要是当初写的时候真是顶着锅盖写的。 s*.3ZS5  
a
Dh|48}X  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : CW;m  
哦, 打倒忽悠大家的家伙.      p&O8qAaO  

j%WY ,2P  
Ro~fvL~Ps  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : 0O[l?e4,8{  
每个人的故事对其他人都是故事, >j:|3atb  
自己的故事也是其中之一. F^miq^K=  
跳出来看, DyIV/  
不过是众人中的一个人的故事. -!~vA+jw1  
OW#_ty_ul  
所以,接着听故事. b|6!EGh  
]zcV]Qj$~  
女人们有兴趣的就等老伍开个新帖或者跟贴, C#h76fpH  
听他痛说恋爱革命历史.... lz}llLb1  
Pa
[?L:E  
杂家接着听他自学程序员历史, p+)C$2YK  
高级程序员考了吗? 1@@y]s_.a  

sS|<& 3  
>Fp&8p`am  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ O{nC^`X  
g}YToOs  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 bO
e<\Y$  
>]-<uT_  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 p7$3`t6u  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : =uS8>.Qj  
引用第19楼伍胥之于06-14-2010 12:33发表的  : gsi<S6DQ8  
A>5S]  
;2BPPZ  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 f)WPOTEY  
/CbkqNV  
我连一级也没有考过。 r&=r/k2  
. ;=#qHo9k1%  

${e -ffyy  

引用

ijg,'a~3E  
矬子里拔将军... kr6:{\DU:B  
你们那里的俗语是吧? |NXFla  
L^&do98  
我们这里说"矮子里拔长脚"..应该是同一个意思... 4">84,-N  
N*? WUn9]  
有趣....各地有表达意思一样却方式不同的俗语.... iKY-;YK  
jD<9=B(g  
Of!|,2`(  
你的文章写的有脸皮,没屁眼的, 7;~2e  
让看客大为不满... ~;` fC|)  
f&f[La  
你等着,,估计你以后接到的午夜凶铃就多了... wH#Lb@cfZ0  

|O2|
`"7  
L-SdQTx_  
我到现在也没有接到你的午夜凶铃呢！ ]2g5Ka[>w  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : Uzy;#q  
伍SIR，再次抱拳佩服 'Wd3`4V$  

`Nc`xO?   
9*"[pt+tA  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : *rujdQ
f  
佩服，玩也玩得这么专业！ TPN:cA6[c  

&VtWSq-)  
!07FsPI#{  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : GT1 X  
!Ed<xG/  
介个真的看不懂。 *cb D&R\  
你说你老啦，喜欢怀旧了，才想起来填坑。 (<AM+|  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 hCOy\[2$  


5 Fl  
H8=vQy  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据
3ec==.  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ TnZc.  
DWORD dwCB; F~uA-g  
LARGE_INTEGER  offset; SjNwT[.nr7  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); G+\~rl  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); !]jNVg  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ * zJ iii  
DWORD error = GetLastError(); 3<1HqU  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); R;Ix<y{U  
return FALSE; Hhce:E@K  
} C>(
M+qXL+  
return TRUE; *Tlws  
} /n<Ncf  

'VB 6.0 版 snk{u/0Xm  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 H
I`A;G]  
d-S'y-V?d  
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 sB1tce  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 1J%qbh  
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 6s "bstc{  
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 @BQBNGR1  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long . L6@R
s  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 fm2Mi~}0  
:aFpz6<  
+M%2m3.Jo  
Private Const GENERIC_READ = &H80000000 !v;_@iW3e  
Private Const GENERIC_WRITE = &H40000000 h,jAtL!  
q-)_Qco  
Private Const FILE_SHARE_READ = &H1 (R 2P<
Zr  
Private Const FILE_SHARE_WRITE = &H2 R"kE5:  
Private Const OPEN_EXISTING = 3 R8W44I*R:  
l$_+WC*wp  
Private Const INVALID_HANDLE_VALUE = -1 ?~y(--.t;T  
Cot\i\]jv  
'//file seek (/P&;?j  
Private Const FILE_BEGIN = 0 Q1&dB{L  
Private Const FILE_CURRENT = 1 B+H9c~3$  
Private Const FILE_END = 2 r`"#c7)  
/W
gWe  
Private Const ERROR_SUCCESS = 0& T|iF/p]F  
-v+^x`HR  
'//device io control `j"G=%e3.  
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 59J$SE  
umn~hb5O  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 )PATz #  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 U=#ylQ   
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 Z1lF[d,f;  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 U\GZ  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C WsDe0F  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 >\x 39B  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F X|B;>q
 
< 3+&DV-<N  
'//type h}<
ZZ   
Private Type LARGE_INTEGER pC.T)k  
    lowpart As Long : )*Ge3  
    highpart As Long h9smviU7u  
End Type &B,& *Lp  
.E8p-R5)V>  
Private Enum MEDIA_TYPE EuA<{%i  
    Unknown 7?WBzo!!L  
    F5_1Pt2_512 w=>mG-  
    F3_1Pt44_512 6 &Aa b56  
    F3_2Pt88_512 o[W3/  
    F3_20Pt8_512 g-gBg\y{v  
    F3_720_512 cZT.vA#  
    F5_360_512 l5nDt$Ex  
    F5_320_512 ]@}BdMlHp  
    F5_320_1024 =v=!x  
    F5_180_512 yQ&%* ?J  
    F5_160_512 1b%7FrPkd  
    RemovableMedia &_hCs![  
    FixedMedia =9@yJ9c-  
End Enum VIdoT2  
&bgi0)>  
Private Type DISK_GEOMETRY 'n#S6.Y:  
    Cylinders           As LARGE_INTEGER 5VoiDM=\c  
    MediaType           As MEDIA_TYPE % x;!s=U  
    TracksPerCylinder   As Long Ui;s.f  
    SectorsPerTrack     As Long 5&K
n #  
    BytesPerSector      As Long ho$%7mc  
End Type trt\PP:H%  
V/%;:ul.  
'//private vars Y rnqi-P  
Private hDisk           As Long             'disk handle |^{" 2l"j  
Private lpGeometry      As DISK_GEOMETRY    'disk info u(`A?H:  
Private lBufferSize     As Long             'the buffer size of read/write GlD'?Mk1  
7f,WzvV  
Public Function OpenDisk(ByVal FileName As String) As Boolean vBnHG-5;P  
'// 打开磁盘 6u;(R0n  
    hDisk = CreateFile(FileName, _ 0Ch._~Q+20  
                        GENERIC_READ Or GENERIC_WRITE, _
n9-[z2n  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ B`EgL/Wg[  
                        ByVal 0&, _ 0lN8#k>H  
                        OPEN_EXISTING, _ :[03upyS  
                        0, _ |:[vpJFK  
                        0) P?7b,
a95O  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) >AFp O*q"  
End Function mj|9x1U)  
[ Ulo; #P  
Public Function CloseDisk() As Boolean X+@,vCC  
'//关闭磁盘
K a|\gl;V  
    CloseDisk = CloseHandle(hDisk) 3vD,hL`&  
End Function >f8,YisH  
!2Iwuru  
Public Function GetDiskGeometry() As Boolean ?\r3 _  
'//获取磁盘参数 }`FPe   
    Dim dwOutBytes      As Long 7?] p\`  
    Dim bResult         As Boolean ob #XKL  
     tpK4 gjf  
    bResult = DeviceIoControl(hDisk, _ #ySx
$WT;  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ Z+7S,M  
                                ByVal 0&, 0, _ [.,6~=}vP  
                                lpGeometry, Len(lpGeometry), _ -y<uAI g  
                                dwOutBytes, _ Jl ?Q}SB  
                                ByVal 0&) KL`>mJo$  
     v}D!  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack *?&O8SSBH  
    GetDiskGeometry = bResult iK:]Q8b  
End Function RVnYe='  
0n=E.qZ9c  
Public Sub GetDiskInfo(MediaType As Long, _ Gzt5efygKt  
                        Cylinders As Long, _ oFp&j@`k8j  
                        TracksPerCylinder As Long, _ sA lgp2-  
                        SectorsPerTrack As Long, _ ztpb/9J9  
                        BytesPerSector As Long) k]g\` gc  
'//返回磁盘的参数 {jG`l$$  
    MediaType = lpGeometry.MediaType i[#Tn52D  
    Cylinders = lpGeometry.Cylinders.lowpart UkV] F
]  
    TracksPerCylinder = lpGeometry.TracksPerCylinder 8ipLq`)  
    SectorsPerTrack = lpGeometry.SectorsPerTrack v%[mt`I  
    BytesPerSector = lpGeometry.BytesPerSector Q2=~  
9Z 4R!Q  
End Sub i-b7  
)`-]nMc  
Public Property Get BufferSize() As Long $)V4Eu;  
'//返回每次读/写的缓冲大小 Km-B=6*QY  
    BufferSize = lBufferSize Wz]S+IpY  
End Property &@-glF5  
iN*@ f8gf  
m Y0C7i  
Public Function LockVolume() As Boolean X
Q8Imkc  
'// 将卷锁定 1 Y&d%AA  
    Dim dwOutBytes  As Long eGil`:JY"  
    Dim bResult     As Boolean vxx3^;4p  
     (6{ VMQ  
    bResult = DeviceIoControl(hDisk, _ P+UK@~D+G  
                                FSCTL_LOCK_VOLUME, _ cj *4XYu  
                                ByVal 0&, 0, _ ,YTIYG](  
                                ByVal 0&, 0, _ 9n'p7(s%  
                                dwOutBytes, _ {9MYEN}FO  
                                ByVal 0&) 1-#tx*>AY  
    LockVolume = bResult Le!I-i(aD  
End Function < r~Tj  
TfPx  
:w+Rs+R  
Public Function UnlockVolume() As Boolean _c 2#  
'// 将卷解锁 ;l' I.j  
    Dim dwOutBytes As Long o[6hUX0tN  
    Dim bResult As Boolean l ;uEw  
     V_* ^2c)  
    bResult = DeviceIoControl(hDisk, _ =j0V/=  
                                FSCTL_UNLOCK_VOLUME, _ [>;O'>  
                                ByVal 0&, 0, _ A?/?9Gr  
                                ByVal 0&, 0, _ \<} nn?~n  
                                dwOutBytes, _ L;"<8\vWB  
                                ByVal 0&) jo^*R'}  
    UnlockVolume = bResult ?6dtvz;K+?  
End Function k$UBZ,=iC  
CvN~  
XHr{\/4V  
Public Function DismountVolume() As Boolean dQ[lXV[}v  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 *u}):8=&R  
    Dim dwOutBytes As Long ^4"
_I   
    Dim bResult As Boolean uOQ5.S+  
     ]^y}}y  
    bResult = DeviceIoControl(hDisk, _ yl}Hr*  
                                FSCTL_DISMOUNT_VOLUME, _ 7@FB^[H:y  
                                ByVal 0&, 0, _ Ogb_WO;)  
                                ByVal 0&, 0, _ 4jpF^&y7u^  
                                dwOutBytes, _ :.cX3dP@  
                                ByVal 0&) / @&Sqv4?  
    DismountVolume = bResult 3jNcL{  
End Function yrjm0BM#  
;%1^k/b6t  
|Xag:hof  
Public Function ReadDisk(ByVal Cylinders As Long, _ UTPl7po5D  
                    ByVal Tracks As Long, _ i]nE86.;  
                    db() As Byte) As Boolean D1f=f88/}  
'//按柱面和磁道来读取磁盘数据 [3.rG!Na  
    Dim iPos    As Long HIF]c  
    Dim lRead   As Long fp7Qb $-A  
    
[>-k
(D5D  
    iPos = Cylinders * Tracks * lBufferSize HZT;7 <  
     $spf=t"nh  
    If SeekAbsolute(0, iPos) Then =T$E lXwJ  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) g@Zc'g/XB  
    End If vzw\f  
End Function K +~  
ld $`5!Z  
Public Function WriteDisk(ByVal Cylinders As Long, _ W.a/k7 p  
                     ByVal Tracks As Long, _ L6a8%%`  
                     db() As Byte) As Boolean Q%7EC>V  
'//按柱面和磁道来写磁盘数据 ciTQH
(G  
    Dim iPos    As Long sqw _c{9  
    Dim lRead   As Long l
wU&jo*@  
     (\}IOCNS  
    iPos = Cylinders * Tracks * lBufferSize )d(cXN-T  
     (]1%s?ud*  
    If SeekAbsolute(0, iPos) Then ^tah4QmUA  
        WriteDisk = WriteBytes(lBufferSize, db()) =9c24j  
    End If (:\hor%  
End Function 6-3l6q  
Pc3u`QL?  
2C-u2;X2  
'///////////////////////////////////////////////////////////////////////////////////// [D t`@Dm  
'//file system ct ZW7  
7-5q\[ZK  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean qb_V ,b9  
'//seek file d >%_<pw  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte vl#/8]0!  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) )L{\k$r!EM  
    If LowPos = -1 Then rdb%/@.-  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) |3i~?] A  
    Else R9W(MLe58  
        SeekAbsolute = True 7@sWT<P  
    End If <ESAoY"RPN  
     4Mprc~ 7vr  
End Function .JiQq]  
#_ E8>;)k  
! >:O3*/  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean K)qmJ-Gub  
'//read data to array t~AesHZpk  
    Dim RetVal    As Long /nrD
U*  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) alG}Aw#gS  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF y|p:^41Ro  
    ReadBytes = Not (RetVal = 0) \R<yja  
     s#Le`pGo
W  
End Function Ev()2 80  
0`x<sjG\q  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean ecHy. 7H  
'//write data from array ?eu=0|d  
    Dim RetVal As Long L$b9|j7  
    Dim BytesToWrite As Long !O5UE  
    Dim BytesWritten As Long &EQov9P7  
     B4.hJZ5  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) d1,azM  
     WMg#
pLc#  
    WriteBytes = Not (RetVal = 0) R+m{nO~r  
End Function {>z.y1  

这才是我当年写出的一个比较烂的程序 sST6_b  
Dk4Wj"LS  
Main2.bas ZK13[_@9  
S"Efp/-  
Attribute VB_Name = "SubMain" hP7nt  
Option Explicit # mzJ^V-  
`Q{k iy  
'采集文件与临时文件 7mu%|!  
Public Const TmpFile As String = "d:\30-0600.dat" p*^O8o  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 N+r~\[N\9  
9oaq%Sf   
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long P$!Ht  
Public hBCFile As Long  '记录采集参数的文件 Tv(s?T6f  
Public Const TmpBMP As String = "d:\1.bmp" @p!["v&  
Public hTmpFile As Long }x%"Oq|2]x  
r2
Q"NVw  
jReI+ pS  
'采集窗口参数常量 eQ*gnV}rE%  
Public Const FrameH As Long = 280& o]]Q7 S=  
Public Const FrameW As Long = 768& 4TLh'?Xu9  
Public Const pFrameSize As Long = FrameW * FrameH 0]"j ,  
,@P3!|  
'标志区范围，用于识别车辆 ]03!KE  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X >_5D`^   
Public Const mkW As Integer = 28  '识别标志立柱宽度 _ p?q/-[4  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) {}>"f]3  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) r p _G.C  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 X=DJOepH'  
'车缝检测位置常数 L\b$1U!i  
Public Const sSize As Long = 32& UP,
(zKTA  
Public Const sPos As Long = 310& '8}\! i&  
Public Const sPosL As Long = 200& c d:O@)i  
Public Const sPosR As Long = 500& AD8~  
'车缝检测框位置 >`6^1j(3  
Public Slice(1 To sSize, 1 To FrameH) As Byte g'mkhF(  
Public SliceL(1 To sSize, 1 To FrameH) As Byte 5Wn6a $^  
Public SliceR(1 To sSize, 1 To FrameH) As Byte iG<|3I  
Public avSL As Integer, avSLR As Integer, avSLL As Integer js>6Du  
N%^mR>.`  
 fBQZ=zh  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 r"0nUf*og:  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 wPV`j:?'  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 R+^/(Ws'<  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long
w("jyvV[C  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte C5eol &  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 #Q;#A |EZ  
YN\ QwV  
!{SEm"J^  
: \.v\.wm  
'一次连续采集的帧数 >Vn!kN6\  
Public tFrames As Long H#1/H@I#  
A?_2@6Y^  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 ~>C!l 
k  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 cW MZw|t  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize )>=`[$D1t  
hwexv 9""  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte #!<x|N?_<  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte u'=#~'6  
Public pWorkSpace(1 To FrameW * FrameH) As Long 0m?ul%=  
Public Const pBufferSize As Long = FrameW * FrameH * 2 #ReW#?P%b/  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 'W$qi@f_s  
(L~3nN;rr  
Public hBoard As Long   '采集卡标识 |px4a"  
Public mBufferAddr As Long  '缓存地址 ;1"K79  
Public BufferSize As Long  '缓存大小(字节) >0512_J+  
Public iCurrentCard As Long Jq.26I=  
Public CapStatus As Long #{N#yReh  
Public iFrames As Long \Z)''
:},C  
Public currentBr As Byte, currentContr As Byte ^up*KQ3u\  
N["(ZSS   
Public hMEM As Long, mStatus As Long :s8,i$Ex  
Public Const hMemSize As Long = pFrameSize * 4 C8(sH@  
Public hMemWork As Long V @8X.R>  
Public Const hMemWorkSize As Long = pFrameSize * 5 lMP|$ C  
<KJ18/  
iPHMyxT+S  

SLBKXj|  
'串口接收轨道衡数据 !lHsJ)t  
Public WeightFromCom As String OxqP:kM  
Public bReceiveComplete As Boolean W}(dhgf  
`UeF3~)>E  
dLj
T^ 9  
Public Type GrayBMPHeader _I@ dt6oF  
  Tag As Integer +LrW#K;  
  FileLength As Long    '文件大小 h#;yA"j1&  
  Reserve1 As Long K5k,47"  
  DataOffset As Long    '图像数据偏移量 ukri7 n
*  
  BMPHeaderSize As Long  '文件头长 @89mj{  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… /ZD/!YD&R  
                        'the following sizes are possible: M?]ObIM:5  
                        '28h - windows 3.1x, 95, nt, … 5nEvnnx0  
                        '0ch - os/2 1.x C?b Mj[$  
                        'f0h - os/2 2.x ~-.q<8  
!hJ%{.  
  ImageWidth As Long           '图像宽（像素数） p|W:;(  
  ImageHeight As Long          '图像高(像素数) V1(eebi|  
  PlaneNumber As Integer  '图像层数 NbgP,-  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap i3f/ {D/  
                                        '4 - 16 color bitmap 6g$+))g  
                                        '8 - 256 color bitmap ,m0=z
H4+:  
                                        '16 - 16bit (high color) bitmap {!x-kF
_  
                                        '24 - 24bit (true color) bitmap +y-:(aP  
                                        '32 - 32bit (true color) bitmap :<nL9y jt  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) :@Q_oyWE8  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) d[ {=/~0  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) xXLKL6F(\  
                                    '3 - bitfields (also identified by bi_bitfields) $BNn1C8[  
  IMAGESIZE As Long  '图像数据字节数 bZa?h.IF  
  hResolution  As Long  '水平分辩率  像素数/米 }_u)3X.O  
  vResolution  As Long  '垂直分辩率 R|tjvp-[}  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 ;m;wSp  
  ImportantColors As Long 'd/A+W  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 ;r8,Wx@f1C  
End Type .o fYFK  
Z^#7&Pv0  
<$ '#@jW  
b
}[{'  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader F7=a|g  
Public sRECT As RECT 3`-[95w  
t$s)S>  
oq;}q  
Public conn As ADODB.Connection tXfB.[U  
Public rsTrain As ADODB.Recordset Qza[~6  
Public rsOperater As ADODB.Recordset 8B\,*JGY2  
Public rsGoods As ADODB.Recordset _*&<hAZ j  
Public rsGood2 As ADODB.Recordset qB"y'UW8  
Public rsSender As ADODB.Recordset +>/Q+nh  
Public rsReceover As ADODB.Recordset ]_#[oS  
Public rsTrainTMP As ADODB.Recordset GVFD_;j'  
EEF}Wf$f  
W*VQ"CW{^]  
'打开采集卡 UlQ}   
'设置参数 !74*APPHR  
'设置为实时单帧采集到缓存方式 w6Ue5Ix,!  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 g[!sGa&  
'?Hy"5gUA  
K@W~  
Sub Main() IgSe%B  
  Dim i As Integer, status As Long oPR?Ar  
     48n7<M;I  
   InitBMPinfo Ll0"<G2t  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 l&uBEYx   
    BMPHeader.Tag = &H4D42 N_f>5uv  
    BMPHeader.ImageWidth = FrameW 9NausE40  
    BMPHeader.ImageHeight = FrameH =J^FV_1rJ  
    BMPHeader.BMPHeaderSize = &H28 z#\YA]1  
    BMPHeader.PlaneNumber = 1 ]xN)>A2  
    BMPHeader.bpp = 8 |/O_AnG I  
    BMPHeader.Compression = 0 0 LIRi%N5*  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 S/xC X!  
    BMPHeader.vResolution = &H1274 a,KqTQB  
    BMPHeader.ColorsinBMP = 256 b1-'q^M  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP )H-y  
    BMPHeader.DataOffset = Len(BMPHeader) wZKEUJpQ  
    For i = 0 To 255 8U7X/L  
      BMPHeader.Pallate(i) = RGB(i, i, i) aX|LEZ;D>  
    Next i @Jr@ fF}  
    BMPHeader.IMAGESIZE = FrameH * FrameW ?a'P;&@7  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE \Qei}5P,  
5DnX8t+d  
poVtg}n  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) 3nX={72<b  
     -)p| i~j^A  
    BMP1.ImageWidth = FrameW vs(x; zpJ  
    BMP1.ImageHeight = FrameH * 2 Hjc *WTu  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight cUc:^wvLS  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE GbJVw\5Z*  
\* SEj&9  
  '确定标志位置,为pilarX, pilarY确定初始值 i|QL6e*0  
   PilarW = mkW FlepM*  
   PilarH = mkH  '此两项为固定值 S~Yu;  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) n_Bi HMIU'  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 MUvgmJsN  
   zOA2chy4  
   d^^EfWU  
  '连续采集记录文件 Z'o'd_g>I+  
  ' 建立一个缓冲区为页对齐方式的文件 &KVXU0F^z  
  If Dir(TmpFile) <> "" Then L~e{Vv8UR  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _
4?.L+wL  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) W4n( 6esO  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 L3y`*&e>  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 y~;w`5;|  
  Else 8&UwnEk<  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ %2<u>=6byG  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) SX @zDuM  
  End If )A:|8m  
  If hFile = 0 Then ~=Q Tv8  
    MsgBox TmpFile & ": File Open Error", vbOKOnly _q3|Ddm2LN  
    Exit Sub SB=%(]S  
  End If *#Hw6N0#  
  '采集参数记录文件 zoHFTD4 g  
hBCFile = FreeFile() Pm!/#PtX  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile %)! b254  
   1eMz"@Q9  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 s[#ww =T\  
If hMEM = 0 Then C!6d`|  
    fStatus = GetLastError  @t<KS&  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ G~KYFNHr  
     & "请向技术人员报告该错误代码。", vbOKOnly tW}At  
    CloseHandle hFile nv_9Llh=z  
    Exit Sub OzS/J;[PO[  
End If \I #}R4z  
m!_*Q  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) A7=k9|  
If hMemWork = 0 Then
?`U=Ps  
    fStatus = GetLastError 1cY,)Z%l #  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ `u#N  
     & "请向技术人员报告该错误代码。", vbOKOnly +'!Y[7|9iv  
     '释放已成功分配的内存 =w2_1F"  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 4$_:a?9  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) ;eT+Ly|{  
     Or,W2  
    CloseHandle hFile :XeRc"m<  
    Exit Sub Tb<}G cwJ  
End If w^8i!jCy  
fe!{vrS  
' Test writing jC_m0Iwc  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& c@/K}  
     ^{l$>e]  
   '初始化采集卡参数 ;)rXQm  
   iCurrentCard = -1 *g!7P
zJ'  
   hBoard = okOpenBoard(iCurrentCard) 5;q{9wvqO  
   Debug.Print hBoard  22FHD4  
   If hBoard = 0 Then /L*JHNu"_  
      ExitGrabber mk]8}+^.  
      End BSHtoD@e7  
   End If [L DY;k~5+  
   okGetBufferSize hBoard, mBufferAddr, BufferSize !FHm.E_>  
   If mBufferAddr = 0 Then c!dc` R  
     MsgBox "缓存不存在！" [ %6(1$Ih  
     ExitGrabber D2MWrX  
   End If
nV3I6  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) a+PVi  
   K| '`w.  
   
?yy,3:  
   currentBr = 128: currentContr = 128 j6DI$tV~  
   '设置视频输入参数 p^*A&7d:P  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 2C"[0*.[N  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input 1AAOg+Y@U"  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 v]X*(e  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 K410.o/=-  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 xvTz|Y  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 h"t\x}8qq  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） vk.P| Y-;  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) VQ
l(5 \6O  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) ,'&H` h54  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 JUdQ Q  
   #VynADPs`o  
   '设置采集参数 /nB|Fo_&Q  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 _BHEK  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ^vha4<'-qG  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 e]-%P(}Z  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 +~f=L
- >  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 2./;i>H[u  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 YuFR*W;$  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 W$Sc@!M3{  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 MZ"|Jn  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 U sq.'y/o  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 Q?/qQ}nNw  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 jj6yf.r6c  
   e"&QQ-q  
   njckPpyb@  
   okCloseBoard hBoard M$U
Zn  
   Sleep 50 X}B]0z>  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 ;bRyk#  
   {B[ }}wX$  
   '设置数据传送方式 Nx=rw h  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 x4-_K%  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 =Hx]K8N)  
   f[wxt n'r  
   sRECT.Right = -1   '用于获得当前设置值 52t6_!y+V  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) *cAI gO7  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom RZP7h>y6@  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 Kjt\A]R%  
   sRECT.Left = 0 I'0{ Q`}  
   sRECT.Top = 0 l;i/$Yu7  
   sRECT.Right = sRECT.Left + FrameW -mw`f)?Ev  
   sRECT.Bottom = sRECT.Top + FrameH * 2 p((a(Q/
  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) M.\V/OX  
   4/AE;yX  
   sRECT.Right = -1   '检查新设置值 I`;SA~5  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ^MO})C  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom }56WAP}Z 4  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) >)+N$EN  
   58P[EMhL  
   If TESTSignal = False Then il% u)NN  
      'ExitGrabber XeX`h
_  
   End If d r$E:kr  
   nYE%@Up  
   OXI>`$we  
   n50WHlMtt  
   '设为实时采集状态 :B:6ezDF6  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) DB3qf>@?  
   nM|F MK^  
   ~3Y4_ b5E  
   '单帧采集 c3.;
o  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 ym_p49  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) tmi)LRF H  
   okCaptureTo hBoard, BUFFER, 0, 1 'single w|c200Is}e  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 i!EAs`$o`  
   '   Sleep 20 Oi<yT"7  
   'Loop 5i+cjT2  
   okGetCaptureStatus hBoard, True oL@K{dk  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize (dT
Q,0  
   '写入768*576测试图象 !cW!zP-B*p  
   ArrayToBMP TmpBMP @MO/LvD  
   V.Tn1i-v  
   '打开数据库 lBGYZ--  
   Set conn = New ADODB.Connection wKKQAM6P1  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ P1ak>T*#2  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ B>g(i=E  
      "; Mode=Read|Write" u9fJ :a  
   conn.Open MUSsanCA  
   Ll.P>LH  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP)  0+e  
   frmRecord.Visible = True 6ZfL-E{  
   frmQuery.Visible = True 'qJ0338d#U  
   Load frmReceiveFromComm ) Z)Gb~G  
   LVT:oIQ  
   '调试参数 0o!mlaU#  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then )]kxLf#  
     SignalBox.Visible = True %77
uc9}  
   End If d,toUI  
   If InStr(UCase(Command()), "/COMM") > 0 Then 9BAvE\o0  
     frmReceiveFromComm.Visible = True o59b#9  
   End If 54=*vokX_  
N(V_P[]"*,  
End Sub aa"3 Io  
zd/kr  
Sub ExitGrabber() %OOkPda  
  '关闭数据库 OY8P  
  '关闭采集卡 8OiCldw:HN  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Jv}&8D  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE)  ?tA%A  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) EjMVlZC>  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 4w)>}  
  okStopCapture hBoard G.`
},c;A-  
  okCloseBoard hBoard yD#(Iw  
  CloseHandle hFile Cz &3= ),G  
  Close #hBCFile ~d\^ynQ  
  conn.Close No`*->R  
  End [:uHe#L  
End Sub kc(m.k!|f\  
i%[+C  
Function ArrayToBMP(ByVal File As String) %%NT m  
Dim BytesWrite As Long `]^W#6l
 
"By$!R-&  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ tQas_K5  
  CREATE_ALWAYS, 0&, 0&) `QtkC>[  
7ug"SV6Hb  
If hTmpFile = 0 Then )/)[}wN;j  
   ArrayToBMP = False ^`k;~4'd  
   Exit Function
3?&v:H  
End If Ho =vdB  
fvk(eWB  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 7Mk>`4D'c  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& k7 j.VpN9  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN %-a;HGbZn  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& ?U+hse3e~  
2vh }:A_  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN <ZheWl  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& hz*T"HJ]t  
;dPaWS1D  
If BytesWrite < pFrameSize Then Q-rG~O9-  
  ArrayToBMP = False Qj|rNeM_  
End If zw+RDo  
No)0|C8:  
CloseHandle hTmpFile at4JLbk  
,H%[R+)  
End Function ZZ  Hjv  
+3J<vM}dy  
Function ArrayToBMP1(ByVal File As String) 7F2 RH 8)  
UI"UBZZ$  
Dim BytesWrite As Long 9!FU,4 X
 
T*%rhnTv0  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ O-[  
  CREATE_ALWAYS, 0&, 0&) 0N~kq-6.\  
TgaxZW  
If hTmpFile = 0 Then .$7RF!p  
   ArrayToBMP1 = False +Gg|BTTL/  
   Exit Function K_~kL0=4  
End If j1A%LS;c_  
dNhbv zl(  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN NU3T XO  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& `hdff0  
~M8|r!_  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN :;eQ*{ `\  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& :P/VBX
h  
PpKjjA<  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN 0|.jIix;  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& I;-Y2*  
<b.p/uA  
If BytesWrite < pBufferSize Then vbn=ywz  
  ArrayToBMP1 = False 2x9.>nwhb  
End If ')0@J`  
T~k@Z  
CloseHandle hTmpFile .{\eco  
w^Yo)"6  
End Function Vjs'|%P7  
n~]"sTC}&  
'使用该过程建立的文件要求在用后关闭 "T{WOGU+  
Public Function ArrayToBMP2(File As String) As Boolean KE ?NQMU  
"w%:5~u9  
Dim BytesWrite As Long pS|K[:5  
"[!b5f3!I  
ArrayToBMP2 = True v/9DD%An  
!Ve0:$  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ w7.,ch  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) T.3{}230<  
$y&W:  
If hTmpFile = 0 Then D
=mmBo  
   ArrayToBMP2 = False b>VV/j4!/  
   Exit Function ^3BPOK[*gB  
End If Jx~H4y=z  
5!fOc]]Ow  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN rJkJ/9s  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& 0&j90J$`  
7P<f(@0h$E  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN W# ~7X  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& a#"orc j  
-fk;Qq3O  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN '?| 1\j  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& Zp3-Yo w2  
Q"C*j'n   
If BytesWrite < pFrameSize Then KILX?Pt[7  
  ArrayToBMP2 = False !p).3Kx0  
End If |Z94@uB  
%~ PcJhz  
CloseHandle hTmpFile Er%&y  
Y (bB7tR  
End Function ~abyjM  
Yj1|]i5b  
Private Function TESTSignal() As Boolean '(FC  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long ,|s*g'u  
bsDA&~)s  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) 38D5vT)n  
i
n/~' u  
If extsign = 1 Then +/Y2\s  
   TESTSignal = True oe]*Q  
Else 4NW!{Vw ,  
    If extsign = 0 Then iuGwc086  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly NI#]#yM+  
        TESTSignal = False Lv]%P.=[G  
        Exit Function lYCvYe  
    End If -f&vH_eK  
End If O*GF/ R8B  
j :B/ FL  
'测试视频输入类型 ^n0;Q$\  
'video type \.}T_,I  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 Rlk3AWl2u  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) n 5R9<A^  
If videotype = 1 Then oG1z PspL  
        '"隔行信号(Interlaced)" +1YEOOfVY  
Else OyVP_Yx,V  
   If videotype = 0 Then Lo1ySLo$G  
       '"逐行信号(Non-interlaced)" MGsQF#6]  
   Else Qgj# k  
     If videotype = -1 Then OU/}cu  
       ' "不支持" U,#x\[3!Jt  
     End If eZAMV/]jH  
   End If A~PR  
End If dh7`eAMY   
+4_,, I  
'测试垂直扫描线数 t&?{+?p: 9  
'video scanlines '*mZ/O-  
scanlines = -1 j=irx5:  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) i,r:R g~  
    If scanlines = -1 Then 17Cb{Q  
        ' "不支持" uAeo&|&  
    Else e O\72? K  
        'Trim(Str(ScanLines)) + " 行数/幅" fV|uKs(W  
    End If <[)-Q~Gg5  
h;jO7+W  
'测试帧频 3 R
+e  
'video field frequency ah:["< z<  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) b(GV4%  
    If fieldfrq = -1 Then dT*Yv` h  
        'lblSignal(8) = "不支持" H5x7)1 Ir|  
    Else H?];8wq$G  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" d,Aa8I  
    End If r[i^tIv6As  
End Function qIQ=OY=6  
B223W_0"o  
(l^7EpNs  
Sub PicIdentify() KhfADqji|  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 JE-* o"&  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 Bk~C$'x4  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 ?h&XIM(  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 5<dg@,\  
H%@f ^  
  Dim fPTR As Long, cFrame As Long XqmB%g(  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer
!vAmjjB  
     /S"jO[n9b  
?I6rW JcQ6  
cFrame = 0 E+O{^C=  
}w$2,r gA  
:TU|:2+  
Do While cFrame < tFrames =WT$\KYGv  
   L T$U z  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) uL/wV~g  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) ~Mn3ADIb=  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize bwXeEA@{  
   # -luE  
  frmRecord.RText.Text = Str(cFrame) ]qT&6:;-]  
  frmRecord.RText.Refresh 4n1g4c-   
       _M`ZF*o=c  
  If CheckMark = True Then :,0(aB  
   ArrayToBMP TmpBMP ~r.R|f]IQ  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) (L*GU7m;  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" jXE:aWQht  
   B>L7UQ6_[  
   DrawSlice gU
ru=p  
   "5V;~}=S  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) 60!%^ O =  
   'If i = vbNo Then _eiqs  
   '  Exit Do i7.8H*z'  
   'End If tRdf:F\X  
   'cFrame = cFrame + 1 T"z<D+pN  
   Jr
!BDg  
  End If tdH[e0x B  
  DoEvents gPKf8{#%e  
  cFrame = cFrame + 1 r& a[
?  
Loop G(a5@9F  
End Sub wu.l-VmGp)  
[j0[c9.p[  
+=8wZ]  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean mF;mJq<d  
h+1|.d  
'如标志区模式反差存在则为TRUE，否则返回FALSE skcyLIb  
`MSig)V  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long cuQ!"iH  
CheckMark = True 4]U=Y>\Sr  
   754MQK|g  
'复制标志区 /9R0}4i7  
For i = 1 To mkH M(I%y 0  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW XvaIOt>A  
Next i }i~k:k mV  
1<BKTMBq?{  
For j = 1 To PilarW * PilarH / 2 Dds-;9  
   mTop = mTop + MKpilar(j) xx`YBn~"  
Next j *lSu=dk+  
LIcc0w3  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH [LnPV2@e  
   mBot = mBot + MKpilar(j) fmz"Zg9=  
Next j 3@V?L:J  
<==uK>pET  
mTop = mTop / PilarW / PilarH * 2 :'DyZy2Fd  
mBot = mBot / PilarW / PilarH * 2 {}YA7M:L  
dxs5woP  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 %VO+\L8Fs  
'Bue*  
'平均值极值化 h:8P9WhWF  
  For j = 1 To PilarH * PilarW N55F5  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) :VT%d{Vp_  
  Next j 9!_,A d;3  
   !XtG6ON=  
mTop = 0: mBot = 0  #%;Uh  
For j = 1 To PilarH * PilarW / 2 .]vb\N
BK7  
  mTop = mTop + MKpilar(j) 3}H{4]*%_  
Next j ;_bRq:!j;  
oVp ZR$  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW wb.yGfJ  
  mBot = mBot + MKpilar(j) ;W?#l$R  
Next j RK!9(^Ja  
M r)t>4  
h=A  
  mTop = mTop / PilarH / PilarW * 3 "bhK%N;  
  mBot = mBot / PilarH / PilarW * 3 Nnh\FaI  
   NuQ!huh  
ev$:7}h=  
If mBot > iWhite And mTop < iBlk Then -MTk9<qnT  
  CheckMark = True VP#KoX85  
Else C.S BJ  
  CheckMark = False MI`qzC*%  
End If w6V/Xp][U  
End Function nc;eNB  
C1D:Xi-  
Sub Capture1Frame() |jiIx5qr  
   okCaptureTo hBoard, BUFFER, 0, 1 'single rexf#W)  
   okGetCaptureStatus hBoard, True _Xd"'cXw  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize \}jA1oy  
End Sub A]|w1nq  
O-V|=t  
DPT6]pl"y  
Sub CopyMark(iBlk As Integer, iWhite As Integer) sjy
r9AF  
'复制标志区并返回标志区暗区与亮区的亮度平均值 K KB+o)*W  
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 c*ueI5i  
   r%=-maPL[  
'复制标志区 B"_O!  
For i = 1 To mkH 2GptK"MrD  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW V;%ug'j  
Next i _;k<=ns(=  
,H{9`a#+:  
For j = 1 To mkW * mkH / 2 c7XBZ%D  
   mTotal = mTotal + MKpilar(j) &+#5gii1i  
Next j ?62Im^1/  
qLCNANWnd  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 9A"s7iJ)  
'SXHq>#gA  
mTotal = 0 5pJe`}O4  
For j = mkW * mkH / 2 + 1 To mkW * mkH v#Rh:#7O%U  
   mTotal = mTotal + MKpilar(j) B%8@yS  
Next j =%m{|HQ`  
J#$U<`j*G  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 ^bv^&V&IB  
q-`&C  
'背景亮度 SZKYq8ZA)V  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW &4:R(]|  
  For i = 1 To 4 * FrameW M(a%Qk?]/  
    bsTotal = bsTotal + BsLine(i) Vc9rc}  
  Next i %V>%AP  
  bsAV = bsTotal / FrameW / 4 e-rlk5k%f  
MZV$YD^S  
End Sub g!XC5*}  
INA3^p'w  
F^.A~{&L  
Sub AdjIMGbright(Optional bInit As Boolean = True) fbh,V%t7  
NT+.E[J6  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） =^KgNQ   
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 |6Q5bV  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 CGi;M=xr  
      ;2C  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer 5GM-*Ak@  
   wyy 1M+  
  '按标准亮度与对比度采集一帧，确定背景亮度 !h.hJt  
  currentContr = 128   '初始对比度 HV~Fe!J_  
  currentBr = 128   '初始亮度 9O 'j+?(`@  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 >:-e  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 [#Qf#T%5h  
  DoEvents "Wj{+|f  
  Capture1Frame G[>
NP#P  
  '获得图像上缘4行象素 u+j\PWOtm  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW "9_$7.q<y  
  CopyMark iBlack, iBright   '图像标志区亮度 3:iEt (iCI  
  For i = 1 To 4 * FrameW S"&Gutu3o  
    bsTotal = bsTotal + BsLine(i) >`AK'K8{M  
  Next i ~2Wus8X-  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 #Nh'1@@  
   EnWv9I<  
  Select Case bsAV )95k3xo  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 <[[yV  
       currentBr = 150 yUnV%@.  
       currentContr = 60 7W)W9=&BT  
     Case 61 To 80   '有可见背景 dx@dnWRT,  
       currentBr = 140 &G"s!:  
       currentContr = 70 /0/ouA>+  
     Case 81 To 100  '有清晰背景 PZ|I3z  
       currentBr = 128 _^& q
,S  
       currentContr = 80 N-K/jY  
     Case 100 To 150  '有明亮背景 r!&174DSR1  
       currentBr = 140                '5:30-6:00钟实测数据 B@(d5i{h  
       currentContr = 50 #4Z e2T|  
     Case 151 To 180 1b~21n  
       currentBr = 130 
#+ch  
       currentContr = 60 #NFB=oJI  
     Case 181 To 220  '背景全为白色
94w)Yln  
       currentBr = 110 Q$U5[
TZm  
       currentContr = 130 (X "J)xaQ  
     Case 221 To 255  '背景全为白色 hP)Zm%@0f  
       currentBr = 100 'V?FeWp  
       currentContr = 100 9qftMDLZJ\  
  End Select F%6wdM W  
   o-@01_j  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 F-s{#V1=  
        Case 100 To 150 y$%oR6K7-  
          currentBr = currentBr - 10 7Y8~")f  
        Case 151 To 255 <YW)8J  
          currentBr = currentBr - 20 Z{B  e  
  End Select W4
o8]&A  
   fn,n'E]  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 \x-2qlZ  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 RHFRN&RU$  
End Sub zp woK&T+  
%'1iT!g8  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) KVOV<uDCj  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long A^,E~Z!x  
     jc"sPrv5  
    For i = 1 To 8 Kzrd<h]`)  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& W/,bz",v3  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& 1O`V_d)  
    Next i Po)U!5Tm  
     ;0Z-  
    For j = 1 To 1024 j1;[6XG  
      L1 = L1 + LeftBK(j, 0) ` Tap0V  
      L2 = L2 + LeftBK(j, 1) tBGL
EeL/.  
      R1 = R1 + RightBK(j, 0) `TPIc  
      R2 = R2 + RightBK(j, 1) <J<"`xKL  
    Next j $rX CNew(  
    diffL = Abs(L1 - L2) / 1024 ,,uhEoH  
    diffR = Abs(R1 - R2) / 1024 b,^ " -r  
End Sub H1c8]}  
b1?^9c#0d  
Function CheckSlice() As Boolean &?R/6"J  
  CopySlice avSL, avSLR, avSLL V| V9.  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then rC!O}(4t%$  
    CheckSlice = True VFf;|PHS  
  Else Q2 !GWz$  
    CheckSlice = False f5*qlQJFz\  
  End If ZR\N~.  
End Function C7dq=(p&  
Q#3}AO  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) sMMOZ'
bT  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long Aars\   
  For i = 1 To FrameH NVx>^5QV  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize {N}az"T4f  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize 7n#-3#_mG  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize b#?sx"z  
  Next i `o{ Z;-OF  
  For i = 1 To FrameH -|FHv+  
    For j = 1 To sSize >UCg3uFj  
       total = total + Slice(j, i) TnN ythwZ  
       totalL = totalL + SliceL(j, i) ]R""L<K%HF  
       totalR = totalR + SliceR(j, i) P*!`AWn  
    Next j JH\:9B+:L  
  Next i 4*}
&nmW  
  avSL = total / FrameH / sSize 2A\b-;4EP  
  avSLR = totalR / FrameH / sSize r<ww%2HTS
 
  avSLL = totalL / FrameH / sSize LL e*|:  
End Sub p/(Z2N"  
#$Zx].[lc  
Sub DrawSlice() p?L%'  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B (e'8>Pv  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B RTh=x.  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B O8 .iP+  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) v's1& %sM  
End Sub D;P=\i>9-  
Sub DrawMark(pic As Control) /''=V.-N  
   Dim i As Long, j As Long f!kZyD7  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B
)l`Ks  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B 2L&c91=wE  
   For i = 1 To PilarH Bug.>ln1  
     For j = 1 To PilarW G{[w+ObX  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) k( Sda>-  
     Next j e#/&A5#Ya  
   Next i QwX81*nx  
End Sub znE1t%V  
dXxf{|gk>  
Function avIMG() As Integer 5@5*}[M  
  Dim i As Long, j As Long, totalIMG As Long _5rKuL  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize ,^G+<T6  
  For i = 1 To pFrameSize ZRf9'UwS  
    totalIMG = totalIMG + pBuffer(i) |Lg2;P7\  
  Next i &lLk[/b  
  avIMG = totalIMG / pFrameSize ,;t:x|{%  
End Function _]*YSeh=  
 j;.P  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer {?:]'c  
  Dim i As Long, j As Long, totalIMG As Long i6HRG\9nU  
  For i = 1 To FrameH ~qqxHymc  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth e$s&B!qJ  
  Next i XnP?hw%  
  For i = 1 To FrameH * barWidth Z5v_- +K  
    totalIMG = totalIMG + pBuffer(i) r\"R?P$y|  
  Next i %JBLp xnq  
  avRegion = totalIMG / pFrameSize YA pC|R,^  
End Function eOb--@~8  

一共这么多文件。 )w4U]inJ$"  
33<{1Y[Q6E  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 ! (lF#MG}  
第6车皮 c

h%zu%;f  

cZ)JvU9]  
]v}W9{sY  
第9车皮 vfn[&WN]  
o:v_I{  
  

从这里里分离出来的。

27[e0 j  
"i&n;8?Y  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 G,Yctv  
M7Z&t'=  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ >d .
|I&  
xzMpTZQ  

继续填个坑： vcy+p]6KE-  
RM2fe Wm  
用VBA控制WORD自己修订学生毕业文的格式。 3!*`hQ;s