引用

引用第20楼newport93于06-14-2010 13:47发表的  : )-5eIy  
)cizd^{  
老五，I 服了U。 \\:%++}J  
tKUW  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 ps2j]g  

h?/E/>  
9FSa=<0wE  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! G?Gf,{#K  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : ~;$QSO\2h  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? 7P3/Ky@6  

AP>n- Z|  
$S<B\\ %  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : A/a=)su  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 CB>W# P%  

2 ^"j]g>mj  
/PSXuVtu5  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 Jf=V<  
f@!9~s  
可以从宽不？

引用

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

a,4G E'  
-J6`  
其实标题没有什么，卡总既然改了就不必再改回了。 a.UYBRP/l  
Ii}{{1N6  
主要是当初写的时候真是顶着锅盖写的。 v9@_DlV\  
99:.j=  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : d5 ]-{+V+  
哦, 打倒忽悠大家的家伙.      #NMQN*J>D  

{EoZ}I  
V$
$9Rh  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : )`|`PB  
每个人的故事对其他人都是故事, 8c%N+E]  
自己的故事也是其中之一. h{~GzrL*  
跳出来看, D&N3LH  
不过是众人中的一个人的故事. #QOb[9(Tu(  
2=7[r-*E  
所以,接着听故事. `5x0p a  
]$UTMuOQl  
女人们有兴趣的就等老伍开个新帖或者跟贴, h6`VU`pPI  
听他痛说恋爱革命历史.... j:48l[;ed  
I&1.}{G>F  
杂家接着听他自学程序员历史, |a\,([aU  
高级程序员考了吗? )g-0b@z!n  

R5},E  
@YS,)U)4S  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ K`|V1L.m  
X,8Zn06
M  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 1csbuR?  
_S &6XNV  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 "Rf|o6!d  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : PUd/|Rc/}  
引用第19楼伍胥之于06-14-2010 12:33发表的  : #7J3
,EV  
C}o^p"M*B3  
S =sL:FC  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 p .~5k  
!D 'A  
我连一级也没有考过。 yzGBGC  
. .+ic6  

+sd':v
E  

引用

LXc;`]  
矬子里拔将军... #D+.z)iZn  
你们那里的俗语是吧? (b.Mtd  
BJZGQrsz  
我们这里说"矮子里拔长脚"..应该是同一个意思... 0+rBGk  
bU4\Yu   
有趣....各地有表达意思一样却方式不同的俗语.... 1eS@ihkP  
fAT M?  
|'L$ogt6  
你的文章写的有脸皮,没屁眼的, 'EU|w,GL}  
让看客大为不满... HhTD/  
 n4AQ  
你等着,,估计你以后接到的午夜凶铃就多了... 1
!ijRr  

m?1AgsBR  
@Y6~;(p  
我到现在也没有接到你的午夜凶铃呢！  A1jA$  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : EMS$?"K  
伍SIR，再次抱拳佩服 &?SU3@3|  

"Ze<dB#,Y  
&PEw8: TX  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : Lc13PTz>>g  
佩服，玩也玩得这么专业！ 8Ir = @  

[cf!%3>53  
I>z0)pB  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : d w]jF=u  
Dk`(Wgk2  
介个真的看不懂。 r:Rk!z*  
你说你老啦，喜欢怀旧了，才想起来填坑。 }:a:E~5y  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 vX
/(" [  

tKKQli4Mn4  
,c9K]>8m`  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 _[t:Vme}v  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ 5isqBu  
DWORD dwCB; ZF~@a+o  
LARGE_INTEGER  offset; }*9mNE  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); 9B<aY p)  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); K)[DA*W  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ Ne9S90HsB6  
DWORD error = GetLastError(); G=l-S\0@  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); p]erk  
return FALSE; ;2jH;$HZ  
} ;
dVYR=l  
return TRUE; {f:%+h  
} Y~[k_!  

'VB 6.0 版 :ExCGS[  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 zq t{oN_  
AMf{E  
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 {7Q)2NC  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long iw\yVd^]:k  
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 e-Ma8+X\  
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long '//declare has changed 2U.'5uA"L  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long ^
R7|x+  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 f'?FYBL  
e .1! K  
%v)O!HC}  
Private Const GENERIC_READ = &H80000000 <b#1L  
Private Const GENERIC_WRITE = &H40000000 PEDV9u[A  
OH/!Ky\@  
Private Const FILE_SHARE_READ = &H1 o 4F(X0  
Private Const FILE_SHARE_WRITE = &H2 S";c7s  
Private Const OPEN_EXISTING = 3 5e}adHjM  
7w51UmO  
Private Const INVALID_HANDLE_VALUE = -1 9mRP%c#(  
Bx9v2x.  
'//file seek R;3nL[{U  
Private Const FILE_BEGIN = 0 ]wm<$+@  
Private Const FILE_CURRENT = 1 GLWEoV9<  
Private Const FILE_END = 2 !@3"vd{^  
&\ $~  
Private Const ERROR_SUCCESS = 0& v1}9i3Or#  
Ev>P|kV&A  
'//device io control -"uOh,G}  
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 c.4WwzK  
yB2}[1  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 WiiAIv&  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 (j?ckah%V  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 hnBX enT6  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 V 0z`p"  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C mr2fNA>kR  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 DA_}pS"  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F T7R,6qt  
</]a`h
]  
'//type '|J~2rbyr  
Private Type LARGE_INTEGER %i5tf;x6i  
    lowpart As Long /?Hq  
    highpart As Long /l>!7  
End Type >yf}9Zs  
F_-}GN%  
Private Enum MEDIA_TYPE CWY-}M  
    Unknown g$h`.Fk,  
    F5_1Pt2_512 yIYQ.-DkS+  
    F3_1Pt44_512 ]e6$ ={  
    F3_2Pt88_512 ,xI FF-[0  
    F3_20Pt8_512 R@~=z5X(Q  
    F3_720_512 @id!F<+%oD  
    F5_360_512 g1 v=a  
    F5_320_512 ex6QHUQ  
    F5_320_1024 IN7Cpg~9%  
    F5_180_512 u5N&Wn{  
    F5_160_512 8h,=yAn5  
    RemovableMedia G3dA`3  
    FixedMedia -BcnJK0  
End Enum D=@bPB
>  
_qa9wK/  
Private Type DISK_GEOMETRY sZPyEIXie  
    Cylinders           As LARGE_INTEGER 10IX84  
    MediaType           As MEDIA_TYPE S\L^ZH?[2  
    TracksPerCylinder   As Long V `7(75  
    SectorsPerTrack     As Long .H 9r_  
    BytesPerSector      As Long bJoP@s  
End Type Te2C<c  
weC.kx   
'//private vars &lnM 1W  
Private hDisk           As Long             'disk handle (lg~}Jw q  
Private lpGeometry      As DISK_GEOMETRY    'disk info f
Uq:`#Q  
Private lBufferSize     As Long             'the buffer size of read/write Pl\NzB,`  
^C'{# p"  
Public Function OpenDisk(ByVal FileName As String) As Boolean /tj_WO_  
'// 打开磁盘 i5cK5MaD  
    hDisk = CreateFile(FileName, _ "</A)y&  
                        GENERIC_READ Or GENERIC_WRITE, _ _E2
W%N  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ ;a 6Z=LB  
                        ByVal 0&, _ ]w_JbFmT  
                        OPEN_EXISTING, _ Qz4Do6#y  
                        0, _ =z zmz7op  
                        0) Q6;bORN  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) s"5wnp6pW  
End Function [JYy  
V 5D8z  
Public Function CloseDisk() As Boolean (f;.
`W  
'//关闭磁盘 IoZ_zz0  
    CloseDisk = CloseHandle(hDisk) sB8v:
 
End Function Zu/w[*;M  
B$ jX%e{:S  
Public Function GetDiskGeometry() As Boolean S$n?  
'//获取磁盘参数 w@WPp0mny  
    Dim dwOutBytes      As Long w8cbhc  
    Dim bResult         As Boolean \+j:d 9?  
     K57u87=*X?  
    bResult = DeviceIoControl(hDisk, _ 'U-8w@\Z
 
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ xX.kKEo"d  
                                ByVal 0&, 0, _ J,:Wv`N:9~  
                                lpGeometry, Len(lpGeometry), _ !v. <H]s)  
                                dwOutBytes, _ .z[#j]k  
                                ByVal 0&) 6TDa#k5v  
     RQ;w$I\  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack < :4b4Nl  
    GetDiskGeometry = bResult 'x6rU"e$J  
End Function C#n.hgo>I  
ipyc(u6Z5  
Public Sub GetDiskInfo(MediaType As Long, _ '| p"HbJ  
                        Cylinders As Long, _ M|fC2[]v B  
                        TracksPerCylinder As Long, _ YI>9C 76L  
                        SectorsPerTrack As Long, _ RTr"#[  
                        BytesPerSector As Long) |3mcL'  
'//返回磁盘的参数 upnX7as  
    MediaType = lpGeometry.MediaType f7/M_sx  
    Cylinders = lpGeometry.Cylinders.lowpart gg/2R?O]  
    TracksPerCylinder = lpGeometry.TracksPerCylinder +GncQs y  
    SectorsPerTrack = lpGeometry.SectorsPerTrack A1n4R  
    BytesPerSector = lpGeometry.BytesPerSector tyFsnck  
zX]l$Q+  
End Sub i 0F6eqe=J  
c#-*]6x  
Public Property Get BufferSize() As Long 7%Ou6P$^fr  
'//返回每次读/写的缓冲大小 j'`-3<k  
    BufferSize = lBufferSize _Kbj?j  
End Property Va[t'%~&zR  
gx8i|]  
7(d#zu6n  
Public Function LockVolume() As Boolean N}nE?|N=5  
'// 将卷锁定 5Od&-~O  
    Dim dwOutBytes  As Long KM? w{ ~9  
    Dim bResult     As Boolean 0#CmB4!<O  
     YC(X= D  
    bResult = DeviceIoControl(hDisk, _ 3_8W5J3I  
                                FSCTL_LOCK_VOLUME, _ qM<CBcON  
                                ByVal 0&, 0, _ kB.CeG]
tk  
                                ByVal 0&, 0, _ 3wg1wl|  
                                dwOutBytes, _ Mm;[f'{M)  
                                ByVal 0&) Ibg~.>.u{  
    LockVolume = bResult "B>8on8O  
End Function "}vxHN#  
"U/yq
 
3L36 2  
Public Function UnlockVolume() As Boolean | {Q}:_/q  
'// 将卷解锁 iJ`zWpj+{Q  
    Dim dwOutBytes As Long Gk xtGe  
    Dim bResult As Boolean "RTv[n!  
     gC(@]%  
    bResult = DeviceIoControl(hDisk, _ 45k.U$<|  
                                FSCTL_UNLOCK_VOLUME, _ zkquXzlgB  
                                ByVal 0&, 0, _ yK y )%i  
                                ByVal 0&, 0, _ 3$S~!fh  
                                dwOutBytes, _  %C_c%3d  
                                ByVal 0&) .03Rp5+v  
    UnlockVolume = bResult dQ_h
lx!J  
End Function %aV~RB#  
p3>Md?e  
-A@/cS%p  
Public Function DismountVolume() As Boolean l6zYiM  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘
PS8^=  
    Dim dwOutBytes As Long AH-BZ8  
    Dim bResult As Boolean U>sEFzBup  
     9h/Hy aN  
    bResult = DeviceIoControl(hDisk, _ gJ~CD1`O  
                                FSCTL_DISMOUNT_VOLUME, _ @,9YF}  
                                ByVal 0&, 0, _ Shv$"x:W  
                                ByVal 0&, 0, _ [8Fn0A  
                                dwOutBytes, _ R3>c\mA  
                                ByVal 0&) Ckc5;:b&m  
    DismountVolume = bResult t37<<5A  
End Function |*^}e54  
vR&b2G7o  
&8I}q]'k  
Public Function ReadDisk(ByVal Cylinders As Long, _ :| !5d{8S8  
                    ByVal Tracks As Long, _ ~~=]_lwyK%  
                    db() As Byte) As Boolean \ AIFIy  
'//按柱面和磁道来读取磁盘数据 %=$Knc_!T^  
    Dim iPos    As Long %Cr TO(  
    Dim lRead   As Long vqZBDQ0  
     &*745,e  
    iPos = Cylinders * Tracks * lBufferSize dL_9/f4   
     $+PyW( r  
    If SeekAbsolute(0, iPos) Then 6AoKuT;
 
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) wbvOf X  
    End If X`J86G)  
End Function [] el 4.J,  
4)8e0L*[B?  
Public Function WriteDisk(ByVal Cylinders As Long, _ Z1Qv>@u  
                     ByVal Tracks As Long, _ ?C- ju8]|  
                     db() As Byte) As Boolean ~nb(e$?N  
'//按柱面和磁道来写磁盘数据 %w?C)$Kn \  
    Dim iPos    As Long V(8,94vm  
    Dim lRead   As Long {T-^xwc  
     FmFjRYA W  
    iPos = Cylinders * Tracks * lBufferSize Fy
0sn|  
     Z;,G:@
,  
    If SeekAbsolute(0, iPos) Then W23Q>x&S  
        WriteDisk = WriteBytes(lBufferSize, db()) }1%%`  
    End If \C
>+ubF  
End Function e^, IZ{  
3.1%L"r[)  
`sDLxgwI  
'///////////////////////////////////////////////////////////////////////////////////// ;+.cD
 
'//file system RB6Q>3g  
U#&+n-n pO  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean bDm7$ (  
'//seek file _90<*{bt.  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte ahQY-%>  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) *tv\5KW G  
    If LowPos = -1 Then O8cZl1C3  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) rNurzag  
    Else hiEYIx  
        SeekAbsolute = True )U7fPKQ  
    End If %~} ,N  
      _8 !x  
End Function dS\!tdHP-Q  
M6bM`wHH>  
?rA3<j  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean evpy%/D  
'//read data to array &H P g>  
    Dim RetVal    As Long |sY  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) ens]?,`0  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF *
[ m:4\  
    ReadBytes = Not (RetVal = 0) _]-4UA-  
     I9Uj3cL\  
End Function Pd-LDs+Ga  
dPbn[* :  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean ~9xkiu5~  
'//write data from array ^d@2Y0h
H  
    Dim RetVal As Long tRO=k34  
    Dim BytesToWrite As Long >rJ**y
 
    Dim BytesWritten As Long KCAV  
     'MBXk2?b  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) KVh#"]<WV  
     {bR2S&=OmK  
    WriteBytes = Not (RetVal = 0) W#E(?M[r  
End Function %-$BtR2@o  

这才是我当年写出的一个比较烂的程序 p*)I QM<B  
V.*y_=i8t  
Main2.bas >3pT).wH|M  
lC`w}0p  
Attribute VB_Name = "SubMain" M@P%k`6C  
Option Explicit RwYFBc  
K~2sX>l  
'采集文件与临时文件 $(+xhn(O  
Public Const TmpFile As String = "d:\30-0600.dat" *^Ges;5$"  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 [ZC\8tP`V  
,Q3OQ[Nmh  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long 4c95G^dZ  
Public hBCFile As Long  '记录采集参数的文件 G;iH.rCH  
Public Const TmpBMP As String = "d:\1.bmp" ;']u}Nh  
Public hTmpFile As Long }mzd23^W>P  
lM}-'8tt?  
KO~KaN  
'采集窗口参数常量 s^SU6P/]  
Public Const FrameH As Long = 280& /H"fycZ  
Public Const FrameW As Long = 768& F\^8k/0  
Public Const pFrameSize As Long = FrameW * FrameH TnKv)%VF  
UP$>,05z6  
'标志区范围，用于识别车辆 +/l@o u'  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X _hJdC|/   
Public Const mkW As Integer = 28  '识别标志立柱宽度 9P)!v.,T/  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) #AC T&J  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) de)4)EzUP  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 *S"RU~1_  
'车缝检测位置常数 ?|/K(}  
Public Const sSize As Long = 32& x,]x>Up  
Public Const sPos As Long = 310& ]z5hTY  
Public Const sPosL As Long = 200& 9<&M~(dwT4  
Public Const sPosR As Long = 500& (QL:7  
'车缝检测框位置 9
(OeH7  
Public Slice(1 To sSize, 1 To FrameH) As Byte CLk,]kA'r  
Public SliceL(1 To sSize, 1 To FrameH) As Byte ~]QQaP  
Public SliceR(1 To sSize, 1 To FrameH) As Byte B@NBN&Fr  
Public avSL As Integer, avSLR As Integer, avSLL As Integer ~[dL:=?c  
"]kzt ux  
HfgTc h  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 KvEv0L<ky  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 8)=(
eI$  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 ~CbiKez  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long |59)6/i  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte }Hq3]L
VE  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ep?D;g  
*4NY"EwjN  
Y]KHC
Y  
0ju-l=w  
'一次连续采集的帧数 n|6G\99l+M  
Public tFrames As Long [@5cYeW3.  
/} z9(  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 8h }a:/  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 rab$[?]  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize rks"y&&Nc  
O39   
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte 4w=v /WDo  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte
4x(m.u@  
Public pWorkSpace(1 To FrameW * FrameH) As Long 7<*0fy5nn  
Public Const pBufferSize As Long = FrameW * FrameH * 2 s
ve} ent  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 t&EizH$  
VFx[{Hy  
Public hBoard As Long   '采集卡标识 {:*G/*1[.  
Public mBufferAddr As Long  '缓存地址 f<i K%  
Public BufferSize As Long  '缓存大小(字节) CHZ/@g c  
Public iCurrentCard As Long [5!}+8]W  
Public CapStatus As Long ~ tyqvHC  
Public iFrames As Long ygj%VG  
Public currentBr As Byte, currentContr As Byte 0%%U7GFB5  
+_$s9`@]6  
Public hMEM As Long, mStatus As Long :9ia|lN  
Public Const hMemSize As Long = pFrameSize * 4 nDO 7  
Public hMemWork As Long pe0ax-Zv  
Public Const hMemWorkSize As Long = pFrameSize * 5 ]
u!s-=3s  
0kj5r*qA  
:$k1I-^R  
sS;)d  
'串口接收轨道衡数据 )W>$_QxbN  
Public WeightFromCom As String cu foP&  
Public bReceiveComplete As Boolean 1.k=ji$D0  
x{
Utf$|  
wK7w[Xt  
Public Type GrayBMPHeader k ,ldi  
  Tag As Integer ,Y
x<"2 W  
  FileLength As Long    '文件大小 cW_wIy\]&  
  Reserve1 As Long v%AepK&  
  DataOffset As Long    '图像数据偏移量 =X^ a  
  BMPHeaderSize As Long  '文件头长 M>Tg$^lm  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… }2LWDQ;po  
                        'the following sizes are possible: n44 T4q  
                        '28h - windows 3.1x, 95, nt, … !j`<iPI7B  
                        '0ch - os/2 1.x 6H: f
g  
                        'f0h - os/2 2.x >6jal?4u-  
V0Oqq0\  
  ImageWidth As Long           '图像宽（像素数） S|)atJJ0G"  
  ImageHeight As Long          '图像高(像素数) " "m-5PGYo  
  PlaneNumber As Integer  '图像层数 l0`bseN<  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap e)B1)c8s  
                                        '4 - 16 color bitmap 6E K<9M
 
                                        '8 - 256 color bitmap _AX,}9
 
                                        '16 - 16bit (high color) bitmap &V$cwB  
                                        '24 - 24bit (true color) bitmap dm[cl~[ Q  
                                        '32 - 32bit (true color) bitmap IqFcr
U$4  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) ~!~i_L\V  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) MD;Z UAX<  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) ]xMZo){[|  
                                    '3 - bitfields (also identified by bi_bitfields) "{qn m+G  
  IMAGESIZE As Long  '图像数据字节数 )
mf|3/o  
  hResolution  As Long  '水平分辩率  像素数/米 ;`LG WT-<F  
  vResolution  As Long  '垂直分辩率 \wsVO"/  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 
j0~am,yZ  
  ImportantColors As Long GiX3c^V"1  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 %L-qAI&V  
End Type F nXm;k,9*  
{*F =&D  
L&)e}"  
k(^TXUK\o  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader YW6a?f^!  
Public sRECT As RECT mj e9i  
& [@)Er=  
aaCRZKr  
Public conn As ADODB.Connection e+-#/i*  
Public rsTrain As ADODB.Recordset #}B1W&\sw  
Public rsOperater As ADODB.Recordset 8..|-<w  
Public rsGoods As ADODB.Recordset IB|6\uKn  
Public rsGood2 As ADODB.Recordset <uB)u>3   
Public rsSender As ADODB.Recordset X,aRL6>r  
Public rsReceover As ADODB.Recordset .O'~s/h  
Public rsTrainTMP As ADODB.Recordset gBhX=2%  
``k[
CgV  
No6-i{HZ  
'打开采集卡 f~\H|E8(  
'设置参数 4)D~S4{E5  
'设置为实时单帧采集到缓存方式 poW%Fzj  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 :%J;[bS+  
g[1>|Ax`'  
;YY<KuT  
Sub Main() mY/"rm  
  Dim i As Integer, status As Long -K?lhu  
     o*/;Zp==  
   InitBMPinfo 9ghzK?Yc  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 Jh=.}FXnjL  
    BMPHeader.Tag = &H4D42 ,'HjL:r  
    BMPHeader.ImageWidth = FrameW y3b"'-%  
    BMPHeader.ImageHeight = FrameH N,rd=
m+  
    BMPHeader.BMPHeaderSize = &H28 *(1<J2j  
    BMPHeader.PlaneNumber = 1 tmq?h%O>  
    BMPHeader.bpp = 8 J/K~8sc  
    BMPHeader.Compression = 0 Q"u2<  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 BXU0f%"8U  
    BMPHeader.vResolution = &H1274 0+op|bdj  
    BMPHeader.ColorsinBMP = 256 n@ba>m4{  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP Ul/m
]b6-  
    BMPHeader.DataOffset = Len(BMPHeader) "*D9.LyM  
    For i = 0 To 255 ,LxZbo!  
      BMPHeader.Pallate(i) = RGB(i, i, i) u8KQV7E  
    Next i 8g!79q\c4  
    BMPHeader.IMAGESIZE = FrameH * FrameW CF','gPnc  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE -.? @f tY  
e,p*R?Y{[  
d3q.i5']G  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) !`H{jwH  
     /"st sF  
    BMP1.ImageWidth = FrameW PkyX,mr#1  
    BMP1.ImageHeight = FrameH * 2 +em!TO  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight \9OKf|#j  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE \RR` F .7  
)'f=!'X  
  '确定标志位置,为pilarX, pilarY确定初始值 t !6sU]{  
   PilarW = mkW R|8L'H+1x  
   PilarH = mkH  '此两项为固定值 EGqu-WBS  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) As>Og
 
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 8CRbo24"s  
   [zN*P$ U]  
   Y% \3N  
  '连续采集记录文件 (_ :82@c  
  ' 建立一个缓冲区为页对齐方式的文件 !Whx^B:  
  If Dir(TmpFile) <> "" Then H!7?#tRU  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ \ [OB.  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) %La7);SeY  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 )@I] Rk?  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。  ^`lrKk  
  Else }JST(d &  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ N atC}k  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) v5\ALWy+p  
  End If 4(P<'FK $  
  If hFile = 0 Then 1aS:bFi`  
    MsgBox TmpFile & ": File Open Error", vbOKOnly ibZ[U p?  
    Exit Sub n:wAxU  
  End If WO9vOS>  
  '采集参数记录文件 OAs>F"  
hBCFile = FreeFile() 3bezYk  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile )8g&lyT  
   2;>uP#1]  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 h%u!UHA  
If hMEM = 0 Then zLe(#8G  
    fStatus = GetLastError B,_K mHItd  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 8g)$%Fy+N  
     & "请向技术人员报告该错误代码。", vbOKOnly w=(dJ(7gu  
    CloseHandle hFile ;`pIq-=  
    Exit Sub h_P  
End If "}1cQ|0a  
OqMdm~4B!j  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) Uaux0W  
If hMemWork = 0 Then qzvht4  
    fStatus = GetLastError "#gKI/[qxq  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ iR9duP+  
     & "请向技术人员报告该错误代码。", vbOKOnly xg, 9~f[  
     '释放已成功分配的内存 ;% KS?;%[  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) @.a59kP8X  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) mD% qDKI  
     ZDzG8E0Sq  
    CloseHandle hFile r vq{Dfo=  
    Exit Sub >gL&a#<S  
End If n_]B5U  
./3/3&6  
' Test writing PPV T2;9  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& *2-b&PQR{  
     0iM'),v[]  
   '初始化采集卡参数 +u g2p;<B  
   iCurrentCard = -1 6(7{|iY  
   hBoard = okOpenBoard(iCurrentCard) HU/4K7e`  
   Debug.Print hBoard =s*c(>  
   If hBoard = 0 Then z.RM85?T  
      ExitGrabber {aV,h@>  
      End wAW{{ p  
   End If 73S N\  
   okGetBufferSize hBoard, mBufferAddr, BufferSize : %AEwRZ  
   If mBufferAddr = 0 Then `?[,1  
     MsgBox "缓存不存在！" >#&25,Q  
     ExitGrabber Hp ;$fQ  
   End If J9tV|
0  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) ~ehN%-  
   vJi<PQ6  
   ( 1  
   currentBr = 128: currentContr = 128 4noy!h  
   '设置视频输入参数 'J0I$-QYk  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 XPdqE`w=$p  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input kzK9.  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 x%ccNP0  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 9* 3;v;F  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 0uM&F[.x@g  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 +!ljq~%  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） cVMRS
p  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) nvwf!iU6  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) Ylu\]pr9|C  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 6!itr"  
   nIL67&  
   '设置采集参数 B:UM2Jl   
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 &M3KJ I0L  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 3HcduJntl  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 noz1W ]  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 Yd~J(  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 Q1yXdw  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 | X#!5u  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 8b-mW>xsA  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 3'i(wI~
<[  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 @x!
+_z  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 X
}x\n\Z  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 =6 zK1Z  
   !"RRw&0M  
   t\YM Hq<Y  
   okCloseBoard hBoard ;-"q;&1e  
   Sleep 50 Nr*X1lJ6  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效  tKh  
   fdwP@6eh  
   '设置数据传送方式 A1Uy|Dl  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 o+XQMg  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 2)0J@r'  
   Gl|n}wo$  
   sRECT.Right = -1   '用于获得当前设置值 :Hr Fbq  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) nq>F_h  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 2T?Y  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 /joY? T  
   sRECT.Left = 0 ^\`a-l^  
   sRECT.Top = 0 [Pjitw/?  
   sRECT.Right = sRECT.Left + FrameW a%kvC#B  
   sRECT.Bottom = sRECT.Top + FrameH * 2 [.Fq l+  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) !J@!2S9  
   R)SY#*Y  
   sRECT.Right = -1   '检查新设置值 tq'ri-c&b  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) q
7soV(P  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom -L6CEe  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) biw . ~  
   BAvz @H  
   If TESTSignal = False Then eGpKoq7a  
      'ExitGrabber 88S:E7 $  
   End If \Z42EnJ  
   1$C?+H  
   gE^pOn  
   HIE8@Rv/3  
   '设为实时采集状态 ]s )Y ">6  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) ^
LB]  
   ?GhMGpdMq  
   f2M*]{N  
   '单帧采集 %*Mr ^=  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 Dyo^O=0c  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) ~G=E Q]a
  
   okCaptureTo hBoard, BUFFER, 0, 1 'single xz.M'az\  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 %-K5sIz  
   '   Sleep 20 @K*W3& TO  
   'Loop t18j2P>`  
   okGetCaptureStatus hBoard, True -z-yk~F  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize n= $ne2/  
   '写入768*576测试图象 K*,,j\Q.  
   ArrayToBMP TmpBMP C'gv#!Q  
   Q}<QE:-&E  
   '打开数据库 P?|\Ig1Gk
 
   Set conn = New ADODB.Connection $-t@=N@vO?  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ @Y.r 
,q  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ W| zPV`  
      "; Mode=Read|Write" ae@!M  
   conn.Open o^"OKHU,S0  
   r1vS~ 4Z  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 3}mg7KV&  
   frmRecord.Visible = True {m{nCl)y  
   frmQuery.Visible = True p"jze3mF  
   Load frmReceiveFromComm MXEI/mDYK  
   6`7bk35B  
   '调试参数 jpZq]E9`P  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then 5cU:wc  
     SignalBox.Visible = True IDos4nM27]  
   End If kn$_X
4^?  
   If InStr(UCase(Command()), "/COMM") > 0 Then T!41[vm(  
     frmReceiveFromComm.Visible = True oq$#wiV"Q  
   End If -gt?5H h  
Q_iN/
F  
End Sub [Y, L=p  
L%\Wt1\[  
Sub ExitGrabber() XSK<hr0m  
  '关闭数据库 _&s pMf  
  '关闭采集卡 0#uB[N  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) ~&MDf pl  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) &?1^/]'"r  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) #l: 1R&F  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 4J
(-~  
  okStopCapture hBoard ]e"!ZR?XJ  
  okCloseBoard hBoard , !%E\`  
  CloseHandle hFile cqs.[0 z#B  
  Close #hBCFile 7 wEv`5  
  conn.Close 6H  U*,  
  End VMJaL}J]  
End Sub \~Z%}$ =  
ZS]Z0iZv9  
Function ArrayToBMP(ByVal File As String) -oUNK}>  
Dim BytesWrite As Long
OQ wO7Z  
, u%V%  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _
,1Z([R*  
  CREATE_ALWAYS, 0&, 0&) qAbmQ{|w  
-gba&B+D"  
If hTmpFile = 0 Then aL90:,V  
   ArrayToBMP = False C%]qK(9vvd  
   Exit Function j} ^3v #  
End If f#GMJ mCQs  
cVxO\M  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN <`; {gX1  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& HB}rpiB  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN Lq;iR  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& vbtZ5Gm   
.{`C>/"}  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN VX8CEO  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& U{pg y#/  
xJ. kd Tr  
If BytesWrite < pFrameSize Then z;<~j=lP  
  ArrayToBMP = False &Q}%
b7  
End If `0M6<e]C  
9Sd?,z  
CloseHandle hTmpFile e?+-~]0  
!P^Mo> "  
End Function uG6.(A1LM  
~re}6-?  
Function ArrayToBMP1(ByVal File As String) }Kp<w,  
.S/zxf~h  
Dim BytesWrite As Long 0}`-vOLd-  
6
hYz^}2g  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ w4TQ4 Y  
  CREATE_ALWAYS, 0&, 0&) '2<r{  
W  
If hTmpFile = 0 Then w <"mS*Q  
   ArrayToBMP1 = False MOCcp s*  
   Exit Function iZeq l1O  
End If u|AMqS  
u "k< N|.3  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ' F9gp!s8~  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& Dr%wab"yy  
dc1Zh W4  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN +YW;63"
o  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& "Z,T%]  
6XU p$Pd(  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN ` Z5dRLrd  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& {!qnHv\S  
Gs3V]qbEP  
If BytesWrite < pBufferSize Then Y\B6c
^E)  
  ArrayToBMP1 = False X_@|+d  
End If e:'56?|  
il!B={  
CloseHandle hTmpFile Ny/eYF#  
,&M#[>\(3  
End Function 5<v1v
&  
.43cI(  
'使用该过程建立的文件要求在用后关闭 9Scg:}Nj  
Public Function ArrayToBMP2(File As String) As Boolean q jc4IW t~  
.o/uA  
Dim BytesWrite As Long lA/-fUA  
~AX~z)  
ArrayToBMP2 = True D^.  c:  
e_KfnPY   
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ NjEi.]L*fX  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) 7[qL~BT+  
Khc^q*|C)  
If hTmpFile = 0 Then ?0*[ L  
   ArrayToBMP2 = False G
xG~J4  
   Exit Function `t)9u^[<(  
End If K#X/j'$^  
G&1bhi52  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Q/0gd? U?  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& ?(d1;/0v>  
~v pIy-  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN C<(oaeQY  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& '
=Lpch2J  
 @,k5T51m  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 0\ (:y^X  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& t? 6 et1~  
we^'R}d  
If BytesWrite < pFrameSize Then <y^_&9  
  ArrayToBMP2 = False _&S#;ni\c  
End If t;h`nH[  
zN]%p>,)HB  
CloseHandle hTmpFile Rky]F+J  
-40X3  
End Function a4 N f\7  
d*gv.mE  
Private Function TESTSignal() As Boolean Is}kCf  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long QOg >|"KL  
-wg}X-'z0  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) Rb:<?&7ZzN  
3Zd,"/RH  
If extsign = 1 Then /(5"c>  
   TESTSignal = True y||RK`H  
Else ,z/aT6M?H  
    If extsign = 0 Then z rSPa\M  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly *.|%uf.  
        TESTSignal = False v7./u4S|V  
        Exit Function !\BZ_guz  
    End If -2J37   
End If 0g|5s  
vZTXvdF  
'测试视频输入类型 ^-k"gLg  
'video type &Q?@VNi  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 k
"&o)*d  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) ([<HFc`  
If videotype = 1 Then |R@T`dW  
        '"隔行信号(Interlaced)" ' :B;!3a0d  
Else Ta?}n^V?;  
   If videotype = 0 Then h^tCF=S  
       '"逐行信号(Non-interlaced)" +@3+WD  
   Else '0q$qN  
     If videotype = -1 Then xLoQ0rt 6  
       ' "不支持" HFy9b|pjy  
     End If .06D_L"M  
   End If [I4MK%YQ  
End If iUR ij@  
Yr-SlO>  
'测试垂直扫描线数 SU~.baP?  
'video scanlines }5oI` 9VT  
scanlines = -1 XxmWj-=qO  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) QWfSm^ t  
    If scanlines = -1 Then Jk\-e`eE  
        ' "不支持" fuUtM_11  
    Else d8jH?P-"  
        'Trim(Str(ScanLines)) + " 行数/幅" C){Q;`M-<  
    End If 3_XLx{["'  
\uPz
j_kU6  
'测试帧频 f2IH2^)P  
'video field frequency S5TVfV5LI  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) ~>=.^  
    If fieldfrq = -1 Then '_ .qhsS  
        'lblSignal(8) = "不支持" 3[fm|aU  
    Else <F0^+Pf/  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" ,k4pW&A  
    End If oxc;DfJ_  
End Function =+j3E<w  
={P`Tve  
/ie&uWy  
Sub PicIdentify() C&w0HoF  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 (=7"zECq#  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ye$_=KARP  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 0x-g0]  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 \vT~2Y(K  
xWzybuLp  
  Dim fPTR As Long, cFrame As Long a&b/C*R_  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer wX]$xZ!s  
     $Xlr@)%  
23^>#b7st  
cFrame = 0 !9/`PcNIpy  
96V8R
<   
xo'!$a}I2  
Do While cFrame < tFrames ]}rNxT4<  
   #4$YQ  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) )f:i4.M  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) 4joE"H6  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize a&8K5Z%0  
   4DCh+|r  
  frmRecord.RText.Text = Str(cFrame) <<MpeMi  
  frmRecord.RText.Refresh R~oJ-}iYX  
       OU,FU@6,7w  
  If CheckMark = True Then BVb ^xL  
   ArrayToBMP TmpBMP OmWEa  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) (y>N\xS9  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" }UW*[dCf>C  
   Ex p?x  
   DrawSlice 4};@QFT*  
   08nh y[  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) hTn"/|_SW  
   'If i = vbNo Then d|NW&PG  
   '  Exit Do xc}[q`vK  
   'End If L4/ns@e  
   'cFrame = cFrame + 1 'D5J5+.z  
   (X"5x]7]  
  End If St%x\[D  
  DoEvents 1}=D  
  cFrame = cFrame + 1 (?1$  
Loop ,#ZPg_x?1  
End Sub :Pdh##k  
?tjEXg>ny  
/OztkThx=  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean +S(# 7  
J2VPO n  
'如标志区模式反差存在则为TRUE，否则返回FALSE ]z^jz#>um&  
?Xypn#OPt  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long wz:e\ !  
CheckMark = True u5}:[4N%I  
   u$%C`v
>  
'复制标志区 # `E  
For i = 1 To mkH u$aK19K/  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW BNdq=|,+"  
Next i m6e(Xk,)  
-6- sI  
For j = 1 To PilarW * PilarH / 2 X.4WVI  
   mTop = mTop + MKpilar(j) u9S*2'  
Next j W$hCI)m(  
; D
<k  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH UDi(7c0.  
   mBot = mBot + MKpilar(j) 2v ~8fr4
  
Next j ?l6yLn5si^  
1sj7]G]`
k  
mTop = mTop / PilarW / PilarH * 2 (v/
L   
mBot = mBot / PilarW / PilarH * 2 }5vKQf  
l.pxDMY  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 %;QK5L 
 
_D4qnb@  
'平均值极值化 a[~[lk=7  
  For j = 1 To PilarH * PilarW j "<?9/r  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) tB>!1}v  
  Next j PM[W7gT  
   sX~E ~$_g  
mTop = 0: mBot = 0 1iz =i^}  
For j = 1 To PilarH * PilarW / 2 _9lMa7i  
  mTop = mTop + MKpilar(j) fKY-@B[|  
Next j 7Fo^:"  
5\
quh2Q _  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW !I ?C8)  
  mBot = mBot + MKpilar(j) vf3)T;X>  
Next j ,V9qiu=m   
ivo><"Y(r  
G)<B7-72;  
  mTop = mTop / PilarH / PilarW * 3 j_90iP^5:  
  mBot = mBot / PilarH / PilarW * 3 ZzE(S  
   A2ye ^<-C.  
fs#9~b3  
If mBot > iWhite And mTop < iBlk Then j67a?0<C2U  
  CheckMark = True /P,1KVQPh  
Else 8`+=~S  
  CheckMark = False y{mt *VA4  
End If TzaeE  
End Function F!#)l*OX;  
 <Y"RsW9  
Sub Capture1Frame() /Kli C\  
   okCaptureTo hBoard, BUFFER, 0, 1 'single A_@..hX(  
   okGetCaptureStatus hBoard, True wGLMLbj5  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize cN&Ebn  
End Sub  ?pEPwc  
3'.3RKV  

*$0*5d7  
Sub CopyMark(iBlk As Integer, iWhite As Integer) g]&fyB#  
'复制标志区并返回标志区暗区与亮区的亮度平均值 8wkhbD|;  
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 3 twA5)v  
   &{8:XJe*,%  
'复制标志区 3\m!  
For i = 1 To mkH 9]=J+ (M  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW }V]b4t  
Next i p4z4[=-:  
85&7WAco"B  
For j = 1 To mkW * mkH / 2 >WLX5i&  
   mTotal = mTotal + MKpilar(j) _\+]/rY9o  
Next j _?"y1L.  
}cMkh  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 KU $,{Sn6@  
Iz+%wAZ|B6  
mTotal = 0 8+w*,R
y`  
For j = mkW * mkH / 2 + 1 To mkW * mkH "7
%jv[  
   mTotal = mTotal + MKpilar(j) 9~~NxWY%x  
Next j /a32QuS  
N:U}b1$L6  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 dM^ EYW  
%^lD  
'背景亮度 FA,n>  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW *Ze0V9$'  
  For i = 1 To 4 * FrameW :(US um  
    bsTotal = bsTotal + BsLine(i) |E6_TZ#=  
  Next i ||X3g"2W9  
  bsAV = bsTotal / FrameW / 4 }TMO>eB'  
~|=D.}#$  
End Sub s*gqKQ;  
aWTurnee^  
B`eK_'7t  
Sub AdjIMGbright(Optional bInit As Boolean = True) 'm*
W<  
D1y`J&A>Q  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） G)s.~ T  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 n! 5(Z5=  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 $BehU  
     n[DRX5OxR'  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer H3$py|}lL  
   %|H]T]s  
  '按标准亮度与对比度采集一帧，确定背景亮度 ddN(L`nd  
  currentContr = 128   '初始对比度 
>C_G~R  
  currentBr = 128   '初始亮度 [(*Eg!?W
=  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 yrEh5v:  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 7#j.yf4  
  DoEvents Wx-0Ip'9  
  Capture1Frame zl8M<z1`1  
  '获得图像上缘4行象素 f
eyc  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW Nxt:U{`T'  
  CopyMark iBlack, iBright   '图像标志区亮度 5?H8?~&dz  
  For i = 1 To 4 * FrameW ++b[>};  
    bsTotal = bsTotal + BsLine(i) }d}sC\>U  
  Next i %( 7##f_  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 =!SV;^-q  
   o7E|wS  
  Select Case bsAV :u9'ZHkZ  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 Ld.9.d]  
       currentBr = 150 &mtt,]6C_  
       currentContr = 60 \l(J6T
u  
     Case 61 To 80   '有可见背景 ShC$ue?Q  
       currentBr = 140 xRc+3Z= N  
       currentContr = 70 P0>2}/;o  
     Case 81 To 100  '有清晰背景 W6>t!1oO+  
       currentBr = 128 (^i
F)z  
       currentContr = 80 \ejHM}w3,  
     Case 100 To 150  '有明亮背景 I;JV-jDM  
       currentBr = 140                '5:30-6:00钟实测数据 QErdjjgE  
       currentContr = 50 rGNa[1{kRs  
     Case 151 To 180 |qe;+)0>K  
       currentBr = 130 '8)kFR^9  
       currentContr = 60 !aUYidd  
     Case 181 To 220  '背景全为白色 ~-vCY  
       currentBr = 110 MkMDI)Y|  
       currentContr = 130 vzs4tkG  
     Case 221 To 255  '背景全为白色 %]7 6u7b/  
       currentBr = 100 cy@Ri#  
       currentContr = 100 DQK?y=vf  
  End Select FW8Zpr!u  
   rtAPkXJFM  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 u_NLgM7*  
        Case 100 To 150 =_BHpgL  
          currentBr = currentBr - 10 5B)&;[  
        Case 151 To 255 q n-f&R  
          currentBr = currentBr - 20 2LN6pu  
  End Select f$^wu~  
   vW eg1  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 QBGm)h?=  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 b%MZfaU  
End Sub
'MW%\W;  
dz+!yE\f$  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) g(i6Uj~)  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long 4r4 #u'Om  
     ,*W~M&n"m  
    For i = 1 To 8 zB0*KgAn{  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& =$4I}2  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& B /uaRi%  
    Next i %`
k [xz  
     }I uqB*g[t  
    For j = 1 To 1024 N4,oO H~  
      L1 = L1 + LeftBK(j, 0) C[%Qg=<  
      L2 = L2 + LeftBK(j, 1) Az y`
4  
      R1 = R1 + RightBK(j, 0) .g}N@  
      R2 = R2 + RightBK(j, 1) BNJ0D   
    Next j 8>WA5:]v  
    diffL = Abs(L1 - L2) / 1024 >x*[izr/K  
    diffR = Abs(R1 - R2) / 1024 mWZP.w^-  
End Sub 3);P!W4>  
*7H *ep
Ua  
Function CheckSlice() As Boolean gk| % 4.  
  CopySlice avSL, avSLR, avSLL =5*Wu+S 4r  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then 2F*>&n&Db7  
    CheckSlice = True rP]|`*B  
  Else '|=
Pw  
    CheckSlice = False KE"6I  
  End If Ojz'p5d`>  
End Function S||W  
@.E9ml  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) (" :Dz_  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long OF`J{`{r  
  For i = 1 To FrameH _fZec+oM  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize rK'Lvt@w  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize TO89;O  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize A^FkU  
  Next i kCD]  &  
  For i = 1 To FrameH 6oLOA}q   
    For j = 1 To sSize fx+_;y  
       total = total + Slice(j, i) pW.WJ`Rk  
       totalL = totalL + SliceL(j, i) :@jctH~  
       totalR = totalR + SliceR(j, i) I1m[M?  
    Next j qvu1u GCc  
  Next i P\K#q%8  
  avSL = total / FrameH / sSize Pl/Xh0
3E  
  avSLR = totalR / FrameH / sSize =&08s(A  
  avSLL = totalL / FrameH / sSize ByP<-Deh  
End Sub F-zIzzb&O  
TaSS) n  
Sub DrawSlice() Gn4b*Y&M]3  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B ?7wcv$K5  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B <eMqg u  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B ~vt*%GN3  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) }*rSg .  
End Sub GdUsv  
Sub DrawMark(pic As Control) eik_w(xPT  
   Dim i As Long, j As Long '8zd]U  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B RuYIG?J=/  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B .gfi9J  
   For i = 1 To PilarH hfI=9x/  
     For j = 1 To PilarW X<IW5*  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) 3'x>$5W  
     Next j }0\SNp
VN  
   Next i >)C7IQ/  
End Sub 6M&ajl`o  
p
Le4dz WA  
Function avIMG() As Integer @2. :fK  
  Dim i As Long, j As Long, totalIMG As Long eE'>kP}  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 3. #L  
  For i = 1 To pFrameSize #*pB"L  
    totalIMG = totalIMG + pBuffer(i) *w0|`[P+h  
  Next i vdn)+fZ;   
  avIMG = totalIMG / pFrameSize \( V1-,  
End Function V0{#q/q  
\Y"S4<"R  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer Q e+;BE-H  
  Dim i As Long, j As Long, totalIMG As Long @,1_CqV  
  For i = 1 To FrameH @` Pn<_L  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth `lE&:)  
  Next i I~F&@  
  For i = 1 To FrameH * barWidth ,nL~?h-Zh  
    totalIMG = totalIMG + pBuffer(i) J \|~k2~  
  Next i
Epp>L.?r  
  avRegion = totalIMG / pFrameSize zqt<[=O  
End Function |MKR&%Na  

一共这么多文件。 [r>hKZU2  
"2%R?  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 0j;|IU\  
第6车皮 056yhB  

yT3K 2A  
wAR:GO 'n  
第9车皮 ArX*3
 
aAoAjVNkK  
  

从这里里分离出来的。

/e*<-a  
z9#jXC#OdN  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。  H<b4B$/  
t.O4-+$ig  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ v#IZSBvuQK  
oU 8o;zk0  

继续填个坑： `Sj8<O}  
:(x 90;DW  
用VBA控制WORD自己修订学生毕业文的格式。 !lB,2_