引用

引用第20楼newport93于06-14-2010 13:47发表的  :  :E'38~  
Lsuc*Ps  
老五，I 服了U。 }^P(p?~  
hwkol W  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 Z/56JYt!~  

m.S@ e8kS  
/koNcpJ  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! js7J#b7  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : d*8 c, x  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? B
>#zrCD  

)v8;\1`s:  
fy9{W@E3p  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : `k_5Pz\  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 DV*8Mkzg  

*Rr,ii  
9%kY8#%SV  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 6bo,x  
{3`#? q^o'  
可以从宽不？

引用

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

pc:K5 -Os  
: }UWy?F  
其实标题没有什么，卡总既然改了就不必再改回了。 6"-LGK:  
\ $X3n\  
主要是当初写的时候真是顶着锅盖写的。 "&Q-'L!M'/  
[3t N-aj [  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : &q``CCOF&  
哦, 打倒忽悠大家的家伙.      D GOc!  

P[#V{%f* 5  
jVi''#F?f  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : .CQ IN]iD  
每个人的故事对其他人都是故事, y?CEV-3+  
自己的故事也是其中之一. HWVWl~FA  
跳出来看, 1 /7H` O?  
不过是众人中的一个人的故事. ,t*
#o&+  
*oZBv4Vh   
所以,接着听故事. @e$zEj5  
VAsaJ`vcb  
女人们有兴趣的就等老伍开个新帖或者跟贴, ,F6i5128{  
听他痛说恋爱革命历史.... 224I%x.,  
l_>^LFO
A  
杂家接着听他自学程序员历史, ran Q_\  
高级程序员考了吗? vT\`0di~  

RUYwDtC  
]*ZL>fuD|  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ K}&|lCsb  
J@p[v3W  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 sJw3o7@pg  
%I&Hx<Hj  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 nd'zO#"m?  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : F1w~f <  
引用第19楼伍胥之于06-14-2010 12:33发表的  : [@uL)*o_#  
F4YCU$V  
8e[kE>tS._  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 C8-4 m68"  
 #RbPNVs  
我连一级也没有考过。 t?QR27cs$  
. \m*?5]m;  

[-{L@  

引用

H.'MQ  
矬子里拔将军... z )a8 ^]`  
你们那里的俗语是吧? {S'xZ._=  
%_KNAuM  
我们这里说"矮子里拔长脚"..应该是同一个意思... R1 hb-  
@&83/U?  
有趣....各地有表达意思一样却方式不同的俗语.... ZV,n-
M =  
R1{"  
" F~uTo  
你的文章写的有脸皮,没屁眼的, t /EB y"N#  
让看客大为不满... -KCm#!  
ZiSy&r:(  
你等着,,估计你以后接到的午夜凶铃就多了... &owBmpz  

j42U|CuK  
dAm(uJ  
我到现在也没有接到你的午夜凶铃呢！ Hh$x8ADf  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : U~s&}M\n  
伍SIR，再次抱拳佩服 V`l.F"<L  

z<m,X
j4w  
p*-o33Ve  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

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

${8 1~  
(=j]fnH?  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : uCB7(<  
|bk.gh  
介个真的看不懂。 ^%@(>:)0  
你说你老啦，喜欢怀旧了，才想起来填坑。 ytf.$P  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 1mz;4xb  

v/ dSz/<]  
9fp1*d  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 g""1f%U_p  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ t4R=$ km  
DWORD dwCB; t
7pe)i,)  
LARGE_INTEGER  offset; ypM0}pdvTp  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); Ms;:+JI  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); <Td4 o&JR  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ `f,SY  
DWORD error = GetLastError(); <5?.s< y$"  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); $vnshU8/v  
return FALSE; ftw\oGrS  
} h|$.`$  
return TRUE; Cu3^de@h  
} D4g $x'  

'VB 6.0 版 ~4S@kYe{3K  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 <t>"b| fW  
LE%3.. !  
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 y, @I6  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long p}$VBl$'  
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 PJA%aRP,:  
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 DF|(CQs9  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long yANk(  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 8@^=k.5IK  
k\8]fh)J\7  
;N6Euiz  
Private Const GENERIC_READ = &H80000000 u=I\0H  
Private Const GENERIC_WRITE = &H40000000 {x{e?c!  
Nb~.6bsL  
Private Const FILE_SHARE_READ = &H1 w#_/CUL  
Private Const FILE_SHARE_WRITE = &H2 KP`{ UD)  
Private Const OPEN_EXISTING = 3 I?}YS-2  
o(Yj[:+m  
Private Const INVALID_HANDLE_VALUE = -1 <)ozbv Xk  
8XZS BR(Z  
'//file seek -$WU-7`  
Private Const FILE_BEGIN = 0 5TqB&GP0  
Private Const FILE_CURRENT = 1 *^e06xc:  
Private Const FILE_END = 2 -\O%f)R  
H,bYzWsrPo  
Private Const ERROR_SUCCESS = 0& d%FD=wm  
 pbM~T(Y8  
'//device io control G9J+D?'hH  
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 tu8n1 W  
Ea#wtow|-  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 x PoI+,  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 xs y5"  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 ys`"-o[*  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 :_E=&4&g  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C 6K501!70g6  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 zRSIJ!A~  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F s4uZ;  
wiKUs0|  
'//type 't'~p#$,F  
Private Type LARGE_INTEGER @2ZE8O#I  
    lowpart As Long V+myGsr`  
    highpart As Long |giV<Sj  
End Type Q^}6
GS$  
f-6
-!  
Private Enum MEDIA_TYPE LxaR1E(Cc'  
    Unknown [+<lm 5t  
    F5_1Pt2_512 &~Qi+b0!  
    F3_1Pt44_512 Qxr&zT7f  
    F3_2Pt88_512 FMMQO,BU  
    F3_20Pt8_512 (!`TO{!6P  
    F3_720_512 wN'Q\l+  
    F5_360_512 ANh7`AUuO  
    F5_320_512 7< ;87t]]  
    F5_320_1024 mxUM&`[  
    F5_180_512 I/:M~ b  
    F5_160_512 /qp)n">  
    RemovableMedia .21[3.bp/q  
    FixedMedia >S/m(98  
End Enum d/oxRzk'L  
:=9?XzCC  
Private Type DISK_GEOMETRY vZ3/t8$*  
    Cylinders           As LARGE_INTEGER +72[*_ <  
    MediaType           As MEDIA_TYPE (ns>z7  
    TracksPerCylinder   As Long &cy@Be}|T  
    SectorsPerTrack     As Long gbF^m`A>%+  
    BytesPerSector      As Long 5H8]N#Y&  
End Type t:|knZq  
y!JZWq%=  
'//private vars 67<Ym0+ =  
Private hDisk           As Long             'disk handle 9,8}4Y=GVI  
Private lpGeometry      As DISK_GEOMETRY    'disk info DMO8~5  
Private lBufferSize     As Long             'the buffer size of read/write rBR,lS$4  
C8 [W  
Public Function OpenDisk(ByVal FileName As String) As Boolean /sHWJ?`&/,  
'// 打开磁盘 GddP)l{uCF  
    hDisk = CreateFile(FileName, _ )w\E^  
                        GENERIC_READ Or GENERIC_WRITE, _ X633.]+  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _  {oQ.y  
                        ByVal 0&, _ t*X k'(v  
                        OPEN_EXISTING, _ *UM
=EQaYk  
                        0, _ "\0&1C(G  
                        0) V}de|=  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) 5y3V duE  
End Function 6yZ!K  
cZ>h[XX[  
Public Function CloseDisk() As Boolean X@`kuWIUw  
'//关闭磁盘 DLMM1 A  
    CloseDisk = CloseHandle(hDisk) hes$LH  
End Function 5`];[M9  
(`%$Aa9 J  
Public Function GetDiskGeometry() As Boolean ^=kUNyY  
'//获取磁盘参数 !58j xh  
    Dim dwOutBytes      As Long (<y~]igy  
    Dim bResult         As Boolean l!UF`C0g  
     cbsU!8
 
    bResult = DeviceIoControl(hDisk, _ %C}TdG(C  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ ;#c=0*.  
                                ByVal 0&, 0, _
8&T6  
                                lpGeometry, Len(lpGeometry), _ ,|RS]I>X  
                                dwOutBytes, _ !\D[lh}rL  
                                ByVal 0&) ]!l]^/.  
     3@xn<eu  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack *2wFLh  
    GetDiskGeometry = bResult 6, =oTmFP  
End Function kC~\D?8E=  
s'/b&Idf8  
Public Sub GetDiskInfo(MediaType As Long, _ R Ptc \ 4  
                        Cylinders As Long, _ )q#1C]7m*  
                        TracksPerCylinder As Long, _ i4"BN,NZ{  
                        SectorsPerTrack As Long, _ iBlZw%zKP  
                        BytesPerSector As Long) ,D#ssxV  
'//返回磁盘的参数 aH@GhI
^@  
    MediaType = lpGeometry.MediaType -n.ltgW@   
    Cylinders = lpGeometry.Cylinders.lowpart Buazm3q8H  
    TracksPerCylinder = lpGeometry.TracksPerCylinder G .PzpBA  
    SectorsPerTrack = lpGeometry.SectorsPerTrack +"8AmN4  
    BytesPerSector = lpGeometry.BytesPerSector ibe#Y  
y"5>O|`  
End Sub jpg$5jZ  
liu%K9-r  
Public Property Get BufferSize() As Long w,uyN  
'//返回每次读/写的缓冲大小 jvGGIb"&1  
    BufferSize = lBufferSize YXeL7W  
End Property rDr3)*H?0  
%p?+r  
M3>c?,O)J  
Public Function LockVolume() As Boolean =2-!ay:  
'// 将卷锁定 K7o!,['W  
    Dim dwOutBytes  As Long JQSp2b@'H  
    Dim bResult     As Boolean ^Yu<fFn  
     2|Of$oMc  
    bResult = DeviceIoControl(hDisk, _ A}K2"lQ#>,  
                                FSCTL_LOCK_VOLUME, _ >SS YYy  
                                ByVal 0&, 0, _ ZV:cgv  
                                ByVal 0&, 0, _ mRJX,  
                                dwOutBytes, _ kTJz
.  
                                ByVal 0&) b=Rw=K.  
    LockVolume = bResult A^\A^$|O6  
End Function BT[jD}?  
PDwi])6mf  
Zp:(U3%  
Public Function UnlockVolume() As Boolean 5!GL"  
'// 将卷解锁 %OS}BAh^i  
    Dim dwOutBytes As Long V)HX+D>  
    Dim bResult As Boolean h?UUd\RU)  
     .aJ\^
Fx  
    bResult = DeviceIoControl(hDisk, _ frsqnvm;+  
                                FSCTL_UNLOCK_VOLUME, _ 3RSiu}  
                                ByVal 0&, 0, _ Pr|:nJs  
                                ByVal 0&, 0, _ bt b$C  
                                dwOutBytes, _ Z+# =]Kw)  
                                ByVal 0&)  Z1
@E  
    UnlockVolume = bResult i6)7)^nG  
End Function `R\aNgCS}  
70sb{)  
Id_?  
Public Function DismountVolume() As Boolean Rwu y!F  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 R1CoS6  
    Dim dwOutBytes As Long uU+R,P0  
    Dim bResult As Boolean 1^F !X=  
     f9R~RRz  
    bResult = DeviceIoControl(hDisk, _ 8v eG^o  
                                FSCTL_DISMOUNT_VOLUME, _ lt:xN?--A?  
                                ByVal 0&, 0, _ Atdr|2  
                                ByVal 0&, 0, _ iA=QK u!  
                                dwOutBytes, _ /E(319u_  
                                ByVal 0&) >b6!*Lrhs  
    DismountVolume = bResult dCbRlW  
End Function
>a6{y  
:[hZn/  
^T^l3B[  
Public Function ReadDisk(ByVal Cylinders As Long, _ qM~;Q6{v  
                    ByVal Tracks As Long, _ +`y{r^xD  
                    db() As Byte) As Boolean U/9i'D[|{  
'//按柱面和磁道来读取磁盘数据 !|\$|m<n  
    Dim iPos    As Long +0{$J\s  
    Dim lRead   As Long 5"5tY  
     ~ 9F rlj  
    iPos = Cylinders * Tracks * lBufferSize %Y0,ww2  
     kPuY[~i%  
    If SeekAbsolute(0, iPos) Then k/U1 :9  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) 6bv~E.  
    End If 7FQ&LF46  
End Function Ib8*rL0p<L  
.?<M$38fv  
Public Function WriteDisk(ByVal Cylinders As Long, _ x%J4A+kU  
                     ByVal Tracks As Long, _ >v sy P  
                     db() As Byte) As Boolean ?p&CR[  
'//按柱面和磁道来写磁盘数据 H8$l }pOz  
    Dim iPos    As Long HUP~  
    Dim lRead   As Long nTy8:k']  
     p }p@])}8  
    iPos = Cylinders * Tracks * lBufferSize Nft~UggK  
     [;/4'  
    If SeekAbsolute(0, iPos) Then r4X0. mPY*  
        WriteDisk = WriteBytes(lBufferSize, db()) >M2
~BDZ  
    End If O %x <  
End Function S-^:p5{r  
U,;a+z4\  
4Lg!54P8  
'///////////////////////////////////////////////////////////////////////////////////// :TPT]q d@  
'//file system 1=*QMEv1G  
]$4Dh
B  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean FR bm
eq3c  
'//seek file Z$a5vu*pg  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte Ct EpS<*c  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) NU]+ {7  
    If LowPos = -1 Then ;7;=)/-  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) !+<OED=qe  
    Else ]npsclvJ  
        SeekAbsolute = True eUY/H1
  
    End If G)(vd 0X1  
     %S'gDCwq  
End Function ~2HlAU))<&  
<%_7%  
8ztVv   
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean 5mtsN#  
'//read data to array v--Qbu  
    Dim RetVal    As Long :NHP,"  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) xOKLc!J  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF 1" k_l.\,0  
    ReadBytes = Not (RetVal = 0) Wqy\yS [  
     x6h';W_ 8  
End Function nBN+.RB:(  
=hw&2c  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean u!]g^r  
'//write data from array !Dc|g~km\  
    Dim RetVal As Long X-lB1uq^  
    Dim BytesToWrite As Long w<qn@f  
    Dim BytesWritten As Long bi@z<Xm%  
     rAv)k&l  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) t\\oGH
 
     ?j'Nx_RoX  
    WriteBytes = Not (RetVal = 0) QsO%m  
End Function K@RE-K6{  

这才是我当年写出的一个比较烂的程序 ?o>JX.Nl&7  
3QD+&9{D  
Main2.bas \#yKCA';  
6bE~m<B\`  
Attribute VB_Name = "SubMain" [. rULQ
l  
Option Explicit X2PyFe  
tCVaRP8eC+  
'采集文件与临时文件 K/;*.u`:  
Public Const TmpFile As String = "d:\30-0600.dat" pXE'5IIN  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 >V,i7v*?  
a,/wqX  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long FD1Z}v!5IJ  
Public hBCFile As Long  '记录采集参数的文件 jYxmU8  
Public Const TmpBMP As String = "d:\1.bmp" rGqT[~{t  
Public hTmpFile As Long H\PY\O&cP  
VoGyjGt&  
4WAs_~  
'采集窗口参数常量 -(;<Q_'s{"  
Public Const FrameH As Long = 280& =/Lwprj  
Public Const FrameW As Long = 768& ES>iM)M  
Public Const pFrameSize As Long = FrameW * FrameH n N_Ylw  
_u]S/X-  
'标志区范围，用于识别车辆 N!Q~?/!d  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X ]lgI Q;r  
Public Const mkW As Integer = 28  '识别标志立柱宽度 4nz$Ja)  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) lQ{o[axT
 
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) N E/_  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 5ns.||%k  
'车缝检测位置常数 4b
@Awtk  
Public Const sSize As Long = 32& {0~xv@ U  
Public Const sPos As Long = 310& YCBcyE}p  
Public Const sPosL As Long = 200& K^yZfpa8  
Public Const sPosR As Long = 500& o3ZqPk]al  
'车缝检测框位置 9aacW  
Public Slice(1 To sSize, 1 To FrameH) As Byte &F 3'tf?  
Public SliceL(1 To sSize, 1 To FrameH) As Byte B/^1uPTZ71  
Public SliceR(1 To sSize, 1 To FrameH) As Byte PF+SHT'4}#  
Public avSL As Integer, avSLR As Integer, avSLL As Integer &Sr7?u`k  
c]x'}Kc  
TIIwq H+h.  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 Kqn {q4L  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 CKu
f'h#  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 8Buus  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long .Bs~FIe^  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte LP{@r ic  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 vNn$dc  
hgU#2`fS  
0]u=GD%  
aG x[?}=  
'一次连续采集的帧数 U#mrbW  
Public tFrames As Long z]V%&f  
.B?J@,  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 ]nQC  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 0kiV-yc   
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize a*N<gId  
-]-?>gkN5  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte wRCv?D`vV  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte xE"QX N  
Public pWorkSpace(1 To FrameW * FrameH) As Long *ak"}s  
Public Const pBufferSize As Long = FrameW * FrameH * 2 +8zCol?j  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 P.>5`^  
T!ik"YZ@i  
Public hBoard As Long   '采集卡标识 P-LdzVt(^  
Public mBufferAddr As Long  '缓存地址 <cUaIb;(4  
Public BufferSize As Long  '缓存大小(字节) bpaS(nBy  
Public iCurrentCard As Long |9;MP&68  
Public CapStatus As Long qy^sdqHl@  
Public iFrames As Long x3C^S~  
Public currentBr As Byte, currentContr As Byte LvcGh  
fnJ!~b*qo  
Public hMEM As Long, mStatus As Long +wpQ$)\  
Public Const hMemSize As Long = pFrameSize * 4 \)/dFo\l  
Public hMemWork As Long "3H?_!A9  
Public Const hMemWorkSize As Long = pFrameSize * 5 mW 4{*   
9C"d7--  
][[\!og  
#^zUaPV 7r  
'串口接收轨道衡数据 {s R|W:fS$  
Public WeightFromCom As String L>X39R~  
Public bReceiveComplete As Boolean hAvX{]  
b'mp$lt!  
k0>]7t$L  
Public Type GrayBMPHeader q)F@f /  
  Tag As Integer sI% =G3o=  
  FileLength As Long    '文件大小 wF.S ,|  
  Reserve1 As Long %AV[vr
,  
  DataOffset As Long    '图像数据偏移量 MVYf-'\^
  
  BMPHeaderSize As Long  '文件头长 &`}8Jz=S  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… ;p] f5R^  
                        'the following sizes are possible: WW.amv/[a  
                        '28h - windows 3.1x, 95, nt, … Eq82?+9  
                        '0ch - os/2 1.x yu98d1  
                        'f0h - os/2 2.x UPr8Q^wm  
g-O}e4  
  ImageWidth As Long           '图像宽（像素数） '"4S3Fysm  
  ImageHeight As Long          '图像高(像素数) QP={b
+8  
  PlaneNumber As Integer  '图像层数 -6yFE- X/  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap [+_0y[~,tB  
                                        '4 - 16 color bitmap vq_v;$9}  
                                        '8 - 256 color bitmap Dxx`<=&g  
                                        '16 - 16bit (high color) bitmap +=JJ=F)  
                                        '24 - 24bit (true color) bitmap &"/IV$H  
                                        '32 - 32bit (true color) bitmap 7zWr5U.  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) sR*.i?lN  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) v0uA]6:  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) R;3Tyn+  
                                    '3 - bitfields (also identified by bi_bitfields) q*pWx]Y  
  IMAGESIZE As Long  '图像数据字节数 /)LI1\o  
  hResolution  As Long  '水平分辩率  像素数/米 =L F 9im  
  vResolution  As Long  '垂直分辩率 d~za%2{  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 ](tv`1A,Wd  
  ImportantColors As Long ,2/y(JX}*!  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 Xt%>
XP  
End Type 1^R:[L4R`  
9i`sSi8   
;qwNM~  
lE 09Y  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader O<}Kr mUC~  
Public sRECT As RECT AriW&E  
7TaHE   
[KT1.5M[  
Public conn As ADODB.Connection OO  /Pc  
Public rsTrain As ADODB.Recordset I7@g,~s  
Public rsOperater As ADODB.Recordset w}:&+B:  
Public rsGoods As ADODB.Recordset \66j4?H#  
Public rsGood2 As ADODB.Recordset meM61ue_2  
Public rsSender As ADODB.Recordset nLjc.Z\Bl  
Public rsReceover As ADODB.Recordset m!H7;S-(  
Public rsTrainTMP As ADODB.Recordset mvV5Xal  
4.o[
:5'  
!tckE\ h#N  
'打开采集卡 IHaNg K2  
'设置参数 }3xZ`v
X[T  
'设置为实时单帧采集到缓存方式 yw{;Qm2\7  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 iTpU4 Qsj  
8Ug`2xS<_  
f6O5k8n  
Sub Main() Ljq!\D  
  Dim i As Integer, status As Long _= d X01  
     ,^d!K(xb  
   InitBMPinfo ,f2tG+P  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 )?D w)s5  
    BMPHeader.Tag = &H4D42 W%.ou\GN^t  
    BMPHeader.ImageWidth = FrameW { kF"<W  
    BMPHeader.ImageHeight = FrameH Btu=MUS  
    BMPHeader.BMPHeaderSize = &H28 ;~ , <8  
    BMPHeader.PlaneNumber = 1 *LZ^0c:r  
    BMPHeader.bpp = 8 o*}--d?S  
    BMPHeader.Compression = 0 \8HLQly|@  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 %I>-_el  
    BMPHeader.vResolution = &H1274 /N?vV p  
    BMPHeader.ColorsinBMP = 256 7Ew.6!s#n1  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP S` v+rQjW  
    BMPHeader.DataOffset = Len(BMPHeader) d(>  
    For i = 0 To 255 D/7hVwMw:
 
      BMPHeader.Pallate(i) = RGB(i, i, i) gXThdNU4G  
    Next i tMQz'3,X  
    BMPHeader.IMAGESIZE = FrameH * FrameW Ei & Z  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE 2ij
/!  
$Afw]F$  
KfkE'_F  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) hJIF!eoI  
     %J%ZoptY:  
    BMP1.ImageWidth = FrameW r|!r!V8j  
    BMP1.ImageHeight = FrameH * 2 wO&2S-;_K  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight &:MfLDJ  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE f:6%DT~a&C  
Zv8I`/4?  
  '确定标志位置,为pilarX, pilarY确定初始值 wEp*j+Mmce  
   PilarW = mkW b( qO fek  
   PilarH = mkH  '此两项为固定值 '<v_YxEn  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) Pcox~U/j  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整
1;$8=j2  
   ujMics(  
   fNllF,8}  
  '连续采集记录文件 F')fi0=  
  ' 建立一个缓冲区为页对齐方式的文件 cy+EJq I  
  If Dir(TmpFile) <> "" Then JRT,%;*,  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ (RtjD`e}  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ^,;AM(E  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 7\e96+j|f  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 eo~>|
0A*V  
  Else sKU?"|G81G  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 0*-nVC1  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) LsGu-Y5^  
  End If 7Rix=*  
  If hFile = 0 Then ))z1T 8  
    MsgBox TmpFile & ": File Open Error", vbOKOnly tUR9ti  
    Exit Sub K,o@~fj  
  End If e_{!8u.+  
  '采集参数记录文件 TA~YCj$  
hBCFile = FreeFile() 28rC>*+z  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Tl2e?El;4  
   H*&ZXAKv  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 w6w'Jx  
If hMEM = 0 Then w:~Y@b~D  
    fStatus = GetLastError lAcXi$pF  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ |'bRVqJ  
     & "请向技术人员报告该错误代码。", vbOKOnly 4X^{aIlshk  
    CloseHandle hFile fL7u419=  
    Exit Sub MaX:oG
F,  
End If v7kR]HU[y  
(K>=!&tlp=  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) -jJw wOm  
If hMemWork = 0 Then S7 _^E  
    fStatus = GetLastError 7vf?#^RlV  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ u^{6U(%  
     & "请向技术人员报告该错误代码。", vbOKOnly fvUD' sx  
     '释放已成功分配的内存 ~BJ~]~0P`  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) |loo^!I  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) HvSYE[Zt|  
     pHpHvSI  
    CloseHandle hFile AT6:&5_`  
    Exit Sub }[%d=NY  
End If c'8a)j$$+  
n$S`NNO{]  
' Test writing YEB@p.  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& Q|+g= |%^  
     pPX~pPIj2  
   '初始化采集卡参数 eJm7}\/6`  
   iCurrentCard = -1 q%Fc?d9  
   hBoard = okOpenBoard(iCurrentCard) X
A%a7Xtni  
   Debug.Print hBoard ^twJNm{99  
   If hBoard = 0 Then y?1<7>L5~  
      ExitGrabber `Rc7*2I)l  
      End <\If:  
   End If qK9\oB%s7  
   okGetBufferSize hBoard, mBufferAddr, BufferSize uv,_?x\'  
   If mBufferAddr = 0 Then lv*fK  
     MsgBox "缓存不存在！" @/m|T]'8  
     ExitGrabber
uDZ$'a  
   End If v-J9N(y"
 
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) +.RC{o,  
   4[eQ5$CB<u  
   1`X- O>  
   currentBr = 128: currentContr = 128 %%w/;o!c  
   '设置视频输入参数 eyiGe1^C  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 j+>#.22+  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input u VZouw#  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 (DW[#
2\.  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 W"@FRWcd  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 
W?B(Jsv  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 22<T.c  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） E9yBa=#*c  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) ZPISclSA+  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) $j\UD8Hj'-  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 TBz Oz:k  
   p`i_s(u  
   '设置采集参数 h6Vm;{~  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 $YM6}D@  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 g+-=/Ge  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 y+PiH  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 d5x>kO'[l  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 c&o|I4|Y,  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 D3>;X=1  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 :gNTQZR  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 %!>~2=Q2*  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 4&+;n[D  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 1;4] HNI  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 p FkqDU  
   (xJZeY)-b^  
   rU{E}  
   okCloseBoard hBoard 0H6^
2T<  
   Sleep 50 jb~/>I^1  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 ~ }<!ON;  
   mu1Lgs$;  
   '设置数据传送方式 TyCMZsvM,  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 nsCat($)  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 &!kr&g#]  
   c<8RRY
s  
   sRECT.Right = -1   '用于获得当前设置值 )/hb9+S  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ( _{\tgSm  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom "1U:qr2-H  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 <Y
(lRM{  
   sRECT.Left = 0 "^~>aVuXf  
   sRECT.Top = 0 V0Z\e _I  
   sRECT.Right = sRECT.Left + FrameW t1I` n(]n  
   sRECT.Bottom = sRECT.Top + FrameH * 2 j3
W)5ZX  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) / xfg4  
   dUTF0
U  
   sRECT.Right = -1   '检查新设置值 'kD~tpZ  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) `Xbk2KD p  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom cN{-&\ 6L  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) (v\Cv)OS  
   y'9 bs  
   If TESTSignal = False Then '~1uJ0H  
      'ExitGrabber a09 ]5>*  
   End If :V%XEN)  
   vIoV(rc+  
   F_Q?0 Do0'  
   JERWz~n}  
   '设为实时采集状态 [,F5GW{x  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) :PrQ]ss@C5  
   _Vs\:tygs  
   gGiLw5o,  
   '单帧采集 E,#J\)'z  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 +U%U3tAvs  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) LZCz
iW  
   okCaptureTo hBoard, BUFFER, 0, 1 'single U
*Hw t\  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 u,d@oF(=  
   '   Sleep 20 }wJDHgt]-p  
   'Loop -}Jf4k#G  
   okGetCaptureStatus hBoard, True f8Xe%"<  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize r`Qzn" H  
   '写入768*576测试图象 tsFwFB*  
   ArrayToBMP TmpBMP -'tgr6=|w"  
   ml|[xM8  
   '打开数据库 QDRgVP  
   Set conn = New ADODB.Connection ZjE!? '(ef  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 2#n4t2p  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ l"\W]'T:r  
      "; Mode=Read|Write" 9Fl}"p[>L.  
   conn.Open ?5%|YsJP_  
   WrR97]7t  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) ?\Q
EK  
   frmRecord.Visible = True 6[h3pb/m  
   frmQuery.Visible = True [>'P  
   Load frmReceiveFromComm 8%UI<I,  
   0.^9)v*i  
   '调试参数 dJhT}"x  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then 7DU"QeLeb  
     SignalBox.Visible = True cNW[i"  
   End If b ;Vy=f  
   If InStr(UCase(Command()), "/COMM") > 0 Then Om%
9 x  
     frmReceiveFromComm.Visible = True [email protected]{s@  
   End If sW":~=H  
axl!zu*  
End Sub *S).@j\{W  
H-Uy~Ry*T  
Sub ExitGrabber() By t{3$  
  '关闭数据库 %C]K`=vI-  
  '关闭采集卡 M~/%V NX  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 2/9P&c-rp  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) y:0j$%^  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) V01-n{~G  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) B}.G(-u?7  
  okStopCapture hBoard Q1G?
e,Q  
  okCloseBoard hBoard 
HS|X//]  
  CloseHandle hFile f3 lKdXnP  
  Close #hBCFile uLw$`ihw  
  conn.Close 4JTFdbx  
  End yK +&1U2`  
End Sub o,!r t1&0  
C} #:<Jx  
Function ArrayToBMP(ByVal File As String) V}l>p?  
Dim BytesWrite As Long SnF3I  
p",HF%  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ $lj1924?^  
  CREATE_ALWAYS, 0&, 0&) C^@~  
mW_<c,3D.  
If hTmpFile = 0 Then o9!DK  
   ArrayToBMP = False "RG
.2
7  
   Exit Function x,\PV>  
End If acWm+  

5-L?JD4&  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Z=sCYLm  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& <y(uu(c  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN rNL*(PN}lO  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& YQ`G OP#/  
X*2MNx^K~  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN U$J l5[`F^  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& rei 8LW  
Wt>J `  
If BytesWrite < pFrameSize Then J"diFz+20  
  ArrayToBMP = False [email protected]  
End If Ba/RO36&c  
K@q&HV"'.  
CloseHandle hTmpFile HwB {8S?sm  
SXQ@;=]xV  
End Function t
(}/g  
?Fce!J  
Function ArrayToBMP1(ByVal File As String) rVUUH!  
GHv{    
Dim BytesWrite As Long inYM+o!U b  
~ct2`M$TL(  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 7e1 dEgn  
  CREATE_ALWAYS, 0&, 0&) RG&I\DTyt  
Rb)|66&3&  
If hTmpFile = 0 Then I`22Zw
q:  
   ArrayToBMP1 = False EbCIIMbe"  
   Exit Function g.9L)
L  
End If wAw42{M  
'9'l=Sh  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 8s<^]sFP  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& },ra
v]  
@zo7.'7P  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN 9*4 .  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& |)9thIQF  
YnSbw3U.I  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN q^5yk=2fq  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ar Q)%W  
0Y7$d`  
If BytesWrite < pBufferSize Then <O.Kqk* nq  
  ArrayToBMP1 = False QS^~77q  
End If +fM&su=wl  
Ski G2n]  
CloseHandle hTmpFile J5;5-:N  
Vr 8:nP:  
End Function {{32jU7<  
W
$r^  
'使用该过程建立的文件要求在用后关闭 K]X`sH:  
Public Function ArrayToBMP2(File As String) As Boolean O#vn)+Y,*  
fb23J|"  
Dim BytesWrite As Long ^pj>9%  
@|BD|{k  
ArrayToBMP2 = True u+m4!`  
tmp6hB  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 4:D:|r  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) eI^gV'UK  
8q0I:SJy  
If hTmpFile = 0 Then &M[MEO`t8  
   ArrayToBMP2 = False ?{eY\I  
   Exit Function (z/jMMms  
End If _m Xs4  
R<|ejw  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Y=E9zUF  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& W@^J6sH  
0E-pA3M6  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN qYK4 )JP  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& _lXt8}:+  
\^
9pW 2v  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN !x7o|l|cP  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& (%bE~Q2P*<  
:/6()_>bO  
If BytesWrite < pFrameSize Then TtPr)F|  
  ArrayToBMP2 = False COSTV>s;  
End If I FsE!oDs4  
6a*83G,k  
CloseHandle hTmpFile Y.>kO  
H8&p<=  
End Function J@QdieW6  
\QGa4_#  
Private Function TESTSignal() As Boolean L?
8^aG  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long -j&
Vtr  
Cc!
J1)  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) qbb6,DL7J  
}S */b1  
If extsign = 1 Then HMV) U
{  
   TESTSignal = True X]!D;7^  
Else #F!Kxks  
    If extsign = 0 Then P[FV2R~  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly b0 &  
        TESTSignal = False {(}yG_Q]!  
        Exit Function Yrxk Kw#  
    End If TiyUr [  
End If 09d9S`cS\  
fJ
y)STQ4  
'测试视频输入类型 T6uMFD4 |  
'video type wX0l?xdI  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 'd/*BjNp)  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) `a >?UUT4  
If videotype = 1 Then @.gPJMA  
        '"隔行信号(Interlaced)"
0oSQY[ht/  
Else y@3Q;~l,  
   If videotype = 0 Then X'x3esw w  
       '"逐行信号(Non-interlaced)" Q4?EZ_O  
   Else :m Kxa  
     If videotype = -1 Then n?:2.S.8  
       ' "不支持" Q.A \U>AgV  
     End If !MoOKW  
   End If 0Gsu  
End If hU"F;4p  
L+.H z&*@  
'测试垂直扫描线数 T#@ {G,N  
'video scanlines BxdX WO  
scanlines = -1 cvfUyp;P  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) F.?01,J=1  
    If scanlines = -1 Then oxfF`L"  
        ' "不支持" Qs l80~n_7  
    Else J=iRul^S  
        'Trim(Str(ScanLines)) + " 行数/幅" p x#suy  
    End If j0x5@1`6G  
Efx= T$%^&  
'测试帧频 RBE7485  
'video field frequency u]E.iX p  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) Lc]1$  
    If fieldfrq = -1 Then KQ{
Lt?S  
        'lblSignal(8) = "不支持" #byJqy&e  
    Else u]M\3V.  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" z]=8eV\  
    End If {q,?<zBzu  
End Function BSgTde|3y  
s?c JV`  
>3PMnI  
Sub PicIdentify() \GL*0NJ  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 <7'&1=%r  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ]
g,lRG  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 N*_"8LIfi_  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 % :/
_f  
Jf_%<\ O  
  Dim fPTR As Long, cFrame As Long uw33:G  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer Y5Z!og  
      ?Vc0)  
!n<o)DsZR  
cFrame = 0 ^=+e?F`:
{  
CxDcY  
]-:6T0JuS  
Do While cFrame < tFrames mI"D(bx\  
   k!3 cq)  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) sn"fK=,#g  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) OCNPi4  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize NiA4JgM]v  
   : @6mFTV  
  frmRecord.RText.Text = Str(cFrame) *5D3vB*S  
  frmRecord.RText.Refresh aGK@)&h$  
       c-B / ~&  
  If CheckMark = True Then Fp%Ln(/m  
   ArrayToBMP TmpBMP '#D8*OP^  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) g)R1ObpZ  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" ar$*a>'?  
   dZ]Rqr _!  
   DrawSlice TSjIz5  
   ,Dp0fauJ  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) !E0!-UpY  
   'If i = vbNo Then rF] +,4  
   '  Exit Do Kkv<"^H  
   'End If 3-|3`(  
   'cFrame = cFrame + 1 -V5w]F'  
   >zngJ$  
  End If OJ1tV% E  
  DoEvents "^Rv#  
  cFrame = cFrame + 1 4h8*mMghs  
Loop :(,mL2[  
End Sub x[X`a  
iZxt/}1X0  
89HsPB1"t  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 8(lR!!=q  
LZ<[ll#C  
'如标志区模式反差存在则为TRUE，否则返回FALSE Td hTQ  
{@.Vh
]  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long xu\eXx6H  
CheckMark = True y=Q!-~5|fF  
   pRi<cO  
'复制标志区 %tmp  
For i = 1 To mkH 4 1t
)(+r  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW XAuI7e  
Next i A@$kLex  
cyQ
BqG  
For j = 1 To PilarW * PilarH / 2 % frfSGf.#  
   mTop = mTop + MKpilar(j) 6B6vP%H#  
Next j |V|+lx'sc  
g"K>5Cb  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH h@1!T  
   mBot = mBot + MKpilar(j) =&vFVIhWcf  
Next j ] fwZAU  
5 1dSFr<#  
mTop = mTop / PilarW / PilarH * 2 V.=lGhi  
mBot = mBot / PilarW / PilarH * 2 hXB|g[zT  
I ~$1Lu`~  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 fS=hpL6]@  
;ME)O g  
'平均值极值化 lH2wG2  
  For j = 1 To PilarH * PilarW JOD/Raq.1k  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) >jT p6tu,  
  Next j tR)H~l7q  
   dRaOGm)  
mTop = 0: mBot = 0 zT#`qCbT'J  
For j = 1 To PilarH * PilarW / 2 lV6dm=k  
  mTop = mTop + MKpilar(j) =\3Tv  
Next j Kat&U19YH  
ke%pZ7{u  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW i9A~<
 
  mBot = mBot + MKpilar(j) ;Ii1B{W  
Next j Y; ).+si  
S6D^3n  
314=1JbL  
  mTop = mTop / PilarH / PilarW * 3 73F5d/n  
  mBot = mBot / PilarH / PilarW * 3 Hd &{d+B  
   Eu,`7iQ?(  
.`p&ATgv  
If mBot > iWhite And mTop < iBlk Then ,6,]#R :J  
  CheckMark = True 3BQ!qO17^d  
Else :50b8  
  CheckMark = False _}gtcyx  
End If %,U PJn  
End Function 2+Rv{%  
X.FGBR7=q  
Sub Capture1Frame() {whvTN1#dh  
   okCaptureTo hBoard, BUFFER, 0, 1 'single A''pS  
   okGetCaptureStatus hBoard, True igC_)C^i>  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize X+82[Y,mB.  
End Sub /*rht
rS)  
$`J_:H%  
rwf^,r"r  
Sub CopyMark(iBlk As Integer, iWhite As Integer) ig!7BxM)<h  
'复制标志区并返回标志区暗区与亮区的亮度平均值 ST dNM\+  
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 V diJ>d[  
   >:1P/U  
'复制标志区 GTl xq%?b  
For i = 1 To mkH "r'ozf2\  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW M(Zc^P}N  
Next i ae+* =,  
\Qy$I-Du  
For j = 1 To mkW * mkH / 2 _$s> c!t,#  
   mTotal = mTotal + MKpilar(j) w_wslN,)  
Next j  QLKK.]  
D(]E/k@;~  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 9`B$V##-L  
ej(ikj ~j  
mTotal = 0 r 
?m6$  
For j = mkW * mkH / 2 + 1 To mkW * mkH hdma=KqZ(  
   mTotal = mTotal + MKpilar(j)
>m6&bfy\q  
Next j %)(Cp-b!  
`{Tk@A_yd  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 & E}mX]t  
z  rfUQO  
'背景亮度 bPbb\|u0d  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW Jkt4@h2Q}  
  For i = 1 To 4 * FrameW kcuzB+  
    bsTotal = bsTotal + BsLine(i) }}
 ZY  
  Next i "Cz<d w]D  
  bsAV = bsTotal / FrameW / 4 BS1A
p  
~O6\6$3b5E  
End Sub 5&!c7$K0  
('[TLHP  
O XP\R  
Sub AdjIMGbright(Optional bInit As Boolean = True) ~d >W?A  
H17-/|-;0!  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） gVR@&bi7  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 cr;`Tl~}s  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 `3_lI~=eH  
     gm"#:< )  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer [1yq{n=  
   f 2YLk  
  '按标准亮度与对比度采集一帧，确定背景亮度 8|^CK|m6*  
  currentContr = 128   '初始对比度 v6=-g$FG  
  currentBr = 128   '初始亮度 s Be7"^  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Af(WV>'  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 j+IrqPKC^  
  DoEvents Dt|)=a  
  Capture1Frame 7^6uG6  
  '获得图像上缘4行象素 60>.ul2  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW `'S0*kMT  
  CopyMark iBlack, iBright   '图像标志区亮度 }^kL|qmjR  
  For i = 1 To 4 * FrameW sW@krBxMv  
    bsTotal = bsTotal + BsLine(i) "sUyHt-&  
  Next i rNDrp@A>  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 ~Nc Q1.  
   5 Wx~ZQZ  
  Select Case bsAV p{$p $/A  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 mN_Z7n;^eh  
       currentBr = 150 7:E!b=o#  
       currentContr = 60 3L5r*fa  
     Case 61 To 80   '有可见背景 /
e@H^Cgo  
       currentBr = 140 e^1uVN  
       currentContr = 70 ]/X(V|t  
     Case 81 To 100  '有清晰背景 cmwPu
K$  
       currentBr = 128 A!i q->+  
       currentContr = 80 d^E [|w;  
     Case 100 To 150  '有明亮背景 /8'S1!zc  
       currentBr = 140                '5:30-6:00钟实测数据 5\ fCd|  
       currentContr = 50 {Qu"%h.Al  
     Case 151 To 180 G4
_,  
       currentBr = 130 cC{"<fYF  
       currentContr = 60 |I;$M;'r&  
     Case 181 To 220  '背景全为白色 V^s0fWa  
       currentBr = 110 V@-)\RZm  
       currentContr = 130 qQ]]~ F  
     Case 221 To 255  '背景全为白色 w?Ju5 5  
       currentBr = 100 $A_]:qI2  
       currentContr = 100 l@Z6do  
  End Select 5VW|fI  
   }2
8=  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 SGL|Ck  
        Case 100 To 150 ),}AI/j;zY  
          currentBr = currentBr - 10 w8Sv*K  
        Case 151 To 255 ]e?x# <S  
          currentBr = currentBr - 20 (qMj-l  
  End Select Y"g.IK`V  
   c3%@Wj:fo  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 #dxgB:l)%l  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 Dh4 6o|P  
End Sub G\d$x4CVGc  
l! bv^  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) 2BXy<BM @  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long Wi.5Y{  
     4'1m4Ugg  
    For i = 1 To 8 bC!`@/  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& 6A R2htN^  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& >/$Fh:R-  
    Next i B=f,QU  
     O`1!  
    For j = 1 To 1024 R"v 3!P  
      L1 = L1 + LeftBK(j, 0) ),:c+~@@kT  
      L2 = L2 + LeftBK(j, 1) FDzqL; I  
      R1 = R1 + RightBK(j, 0) w*9br SK  
      R2 = R2 + RightBK(j, 1) T#@lDpO  
    Next j !A3-0zN!  
    diffL = Abs(L1 - L2) / 1024 W#fZ1E6  
    diffR = Abs(R1 - R2) / 1024 $g9**b@  
End Sub y] oaO+  
0pb'\lA  
Function CheckSlice() As Boolean KL,/2(  
  CopySlice avSL, avSLR, avSLL #18FA|   
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then 68fiG   
    CheckSlice = True pmvT$;7I  
  Else 9p* gU[  
    CheckSlice = False Lo.rvt  
  End If El
j_,z  
End Function ` mfq 2bVc  
2-*V=El  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) >4` dy  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long SymwA
S+  
  For i = 1 To FrameH T=f|,sK +7  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize ./vZe_o)j$  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize ~5 N)f UI\  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize BAj-akc f  
  Next i inb^$v  
  For i = 1 To FrameH O4 3YY2  
    For j = 1 To sSize  +ECDD'^!  
       total = total + Slice(j, i) }GMbBZ:nKK  
       totalL = totalL + SliceL(j, i) ) /vhclkb  
       totalR = totalR + SliceR(j, i) g:l.MJT  
    Next j lf<S_2i  
  Next i DhLqhME53  
  avSL = total / FrameH / sSize Jq.lT(E8D  
  avSLR = totalR / FrameH / sSize P;[OWSR[d  
  avSLL = totalL / FrameH / sSize \`<cH#  
End Sub u6V/JI}g  
<:>SGSE9  
Sub DrawSlice() `?g`bN`Vn  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B j1
q[2'  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B EI>6Nh  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B Gl %3XdU  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) ]Y>h3T~  
End Sub 'nQVj  
Sub DrawMark(pic As Control) KOq
;jH{$  
   Dim i As Long, j As Long -ezY=0Q&  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B sZWaV4  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B F7L&=K$2y  
   For i = 1 To PilarH rPNb\Ri  
     For j = 1 To PilarW [S]S^ej*8  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) gJiK+&8I  
     Next j YpAg  
   Next i 8(g:HR*;  
End Sub s&kQlQ=  
n6d9\  
Function avIMG() As Integer r[(x
jn  
  Dim i As Long, j As Long, totalIMG As Long ,C.:;Ime({  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize 7\zZpPDV  
  For i = 1 To pFrameSize G0 J4O!3  
    totalIMG = totalIMG + pBuffer(i) jxaD&4Fs8  
  Next i hf/2vt m  
  avIMG = totalIMG / pFrameSize 3ya1'qUC  
End Function []R? ViG  
#ge)2  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer hRI"y":zD  
  Dim i As Long, j As Long, totalIMG As Long 6Tw#^;q-  
  For i = 1 To FrameH 9Y
a<My  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth =o}"jVE  
  Next i yH 9!GS#  
  For i = 1 To FrameH * barWidth PP~rn fE  
    totalIMG = totalIMG + pBuffer(i) Ma*y=d;,1  
  Next i '3]p29v{  
  avRegion = totalIMG / pFrameSize 1be %G [*  
End Function .o1^O
h  

一共这么多文件。 GKY:"q&h  
P+3G*M=}  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 v[a#>!;s  
第6车皮 2J4 |7UwJ  

DJQ]NY|  
FYcMvY  
第9车皮 U-FA^c;  
 29sgi"  
  

从这里里分离出来的。

zsMw5
C  
spU!t-n67  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 1Oca@E\Z.  
-0KbdHIKb'  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ @!&Jgg53G  
#lyM+.
T  

继续填个坑： hP4)8>  
|?2 hml  
用VBA控制WORD自己修订学生毕业文的格式。 Ukh$`q}