引用

引用第20楼newport93于06-14-2010 13:47发表的  : G$JFuz)|  
' fW#7W  
老五，I 服了U。
r|R7-HI  
\7 a4uc  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 Vb4;-?s_  

lF4u{B9DM  
h/ep`-YaH  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! ;+_8&wbqW  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : rU\[SrIhz  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? <@#PF$!  

T1 M
Y X  
i@$*Csj\9*  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : T@48qg  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 q)I|2~Q c^  

<
y=ovkM3  
(JZ".En#X  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 tYe:z:7l?<  
\"^%90F  
可以从宽不？

引用

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

:5# V^\3*  
KD*O%@X5C  
其实标题没有什么，卡总既然改了就不必再改回了。 +zO]N &  
77aX-e*=E  
主要是当初写的时候真是顶着锅盖写的。 uHvaZMu  
*\ECf.7jz  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : +/_!P;I  
哦, 打倒忽悠大家的家伙.      ?>TbTfmR  

)$F6  
W_D%|Ub2X  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : b@F_7P%  
每个人的故事对其他人都是故事,  l58l  
自己的故事也是其中之一. t5A[o7BS  
跳出来看, EKJH_!%  
不过是众人中的一个人的故事. `|Ne
vpXY1  
BDnBBbBrz  
所以,接着听故事. DW4MA<UQ  
z22N7W=7  
女人们有兴趣的就等老伍开个新帖或者跟贴, m9cj7  
听他痛说恋爱革命历史.... 5I_hh?N4Z  
|: / @t  
杂家接着听他自学程序员历史, fl!1AKSn@N  
高级程序员考了吗? %rX\ P  

roL]v\tr  
YFAn
lqC  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ 6yi/&#YM  
XSls]o s  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。
{AtfK>D  
-ca]Q|m8  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 "SDsISWd  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : 6Lav.x\W  
引用第19楼伍胥之于06-14-2010 12:33发表的  : ~rQ4n9G  
\qRjXadj  
~4}*D
hsh  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 v] W1F,u  
U3(L.8(sA  
我连一级也没有考过。 GR_p1 C\  
. d eHY8x5uI  

lS>=y#i3Xv  

引用

Z={UM/6w  
矬子里拔将军... F9ZOSL 8Q  
你们那里的俗语是吧? H@K l  
#a/n5c&6/  
我们这里说"矮子里拔长脚"..应该是同一个意思... z[_
R"+   
zS,%msT^A  
有趣....各地有表达意思一样却方式不同的俗语.... k?z [hZg0  
'JJ1#kKa  
]i9H_K  
你的文章写的有脸皮,没屁眼的, /QM0.{Ypl  
让看客大为不满... W8\PCXnsfl  
HFpjNR  
你等着,,估计你以后接到的午夜凶铃就多了... !tm|A`<g#<  

U+I3P  
_D!M nTK  
我到现在也没有接到你的午夜凶铃呢！ ^Osd/g  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : XACEt~y  
伍SIR，再次抱拳佩服 ;mM\, {Z  

[hvig$L  
)%nt61P\W  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : z|4@nqqX  
佩服，玩也玩得这么专业！ O(WMTa'%  

[^"(%{H  
/:c,v-  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : ?PU(<A+  
l Ib >t  
介个真的看不懂。 (? #U &  
你说你老啦，喜欢怀旧了，才想起来填坑。 WFc[F`b  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 =S7C
(;=4  

uEi.nSp)S  
J&0wl]w|O%  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 l`w|o  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ y0y;1N'KK  
DWORD dwCB; J$=b&$I(  
LARGE_INTEGER  offset; t2
%bHIG}  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); +^ 3L~?  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); *ytd.^@r  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ JbD)}(G;  
DWORD error = GetLastError(); Gpp}Jpj   
MessageBox(NULL,"写入文件失败!",NULL,IDOK); !gH.st  
return FALSE; e+[J[<8  
} \iTPJcb5  
return TRUE; 6"c!tJc7j  
} rgY?X$1q_  

'VB 6.0 版 yA) +-  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 aNf3 R;*  
sf&K<C](  
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 \YF!< 2|[  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long MicVNs  
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 {_gj>n(1  
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 f(ec/0W  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long */h9"B  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 /P:WQ*  
)RKhEm%Vr2  
K{|dt W&  
Private Const GENERIC_READ = &H80000000 @T=HcUP)  
Private Const GENERIC_WRITE = &H40000000 thboHPml{  
t;PnjCD<`  
Private Const FILE_SHARE_READ = &H1 k |aOUW  
Private Const FILE_SHARE_WRITE = &H2 z\ $>k_  
Private Const OPEN_EXISTING = 3 H" g&  
zpQ/E  
Private Const INVALID_HANDLE_VALUE = -1 xM"XNT6b  
x/q$RcDOm  
'//file seek kFs kn55  
Private Const FILE_BEGIN = 0 [#h!3d|?B  
Private Const FILE_CURRENT = 1 s 17gi,"X  
Private Const FILE_END = 2 iKTU28x  
+? g,&NE  
Private Const ERROR_SUCCESS = 0& Dve5m=  
4Tw1ga
s.  
'//device io control xB] v  
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 5oyMR_yl  
R$,iDv.jI  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 :s985sEv  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 lcJumV=%>  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 ^)]*10  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 0'2{[xF  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C (ZR"O8  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 &!aLOx*3`  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F ><[.  
#AnSjl  
'//type HbVV]y  
Private Type LARGE_INTEGER ?4||L8j2^  
    lowpart As Long %l P   
    highpart As Long |>V>6%>vK6  
End Type ?mUu(D:7D  
4sgwQ$m)  
Private Enum MEDIA_TYPE dWWkO03|  
    Unknown o5A_j?t  
    F5_1Pt2_512 kEDZqUD  
    F3_1Pt44_512 lNPbU ~k  
    F3_2Pt88_512 &l*dYzqq  
    F3_20Pt8_512 9&FV=}MO  
    F3_720_512 vF\zZ<R/  
    F5_360_512 5}aC'j\  
    F5_320_512 :iC\#i] 6  
    F5_320_1024 M|]1}8d?  
    F5_180_512 Nm.>C4  
    F5_160_512 1:Gd{z  
    RemovableMedia H/I`c>Zn  
    FixedMedia P9chRy  
End Enum +>%+r  
@*{BX~f  
Private Type DISK_GEOMETRY oD2;Tdk  
    Cylinders           As LARGE_INTEGER L2A#OZZu  
    MediaType           As MEDIA_TYPE bo/!u s#  
    TracksPerCylinder   As Long l[0P*(I ,  
    SectorsPerTrack     As Long PP`n>v=n  
    BytesPerSector      As Long [gY__  
End Type u(a&x|WY
 

F}4 0  
'//private vars HcUz2Rm5XP  
Private hDisk           As Long             'disk handle dNt|"9~&  
Private lpGeometry      As DISK_GEOMETRY    'disk info ~7H.<kJt  
Private lBufferSize     As Long             'the buffer size of read/write -k{R<L  
RN3D:b+  
Public Function OpenDisk(ByVal FileName As String) As Boolean DfFPGFv  
'// 打开磁盘 6)YNjh.{*  
    hDisk = CreateFile(FileName, _ Q 8E~hgO  
                        GENERIC_READ Or GENERIC_WRITE, _ />7/S^  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ ==r|]~x  
                        ByVal 0&, _ p&27|1pZm  
                        OPEN_EXISTING, _ "x^bl+_"  
                        0, _ #a l^Uqd  
                        0) -$ft `Ih  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) oU5mrS.7M!  
End Function zQ_[wM-  
Ox'.sq4  
Public Function CloseDisk() As Boolean \+A<s,x  
'//关闭磁盘 ^*W<$A_  
    CloseDisk = CloseHandle(hDisk) . +?lID  
End Function T#f@8 -XUE  
v%Q7\X(  
Public Function GetDiskGeometry() As Boolean PTZ1oD  
'//获取磁盘参数 ?8m/]P/~  
    Dim dwOutBytes      As Long M.Ik%nN#K0  
    Dim bResult         As Boolean wpI4P:  
     :.Sc[UI0  
    bResult = DeviceIoControl(hDisk, _ RV(z>XM  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ FI5C&d5d  
                                ByVal 0&, 0, _ O+J;Hp;\_  
                                lpGeometry, Len(lpGeometry), _ 0G 1o3[F  
                                dwOutBytes, _ sn#h=,*4`  
                                ByVal 0&) #|i{#~gxM  
     ?@(H. D6'v  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack ;~;St>?\R\  
    GetDiskGeometry = bResult ]~ M -KT  
End Function r8.v0b"1  
dfcG'+RU}  
Public Sub GetDiskInfo(MediaType As Long, _ Bb`^,?m  
                        Cylinders As Long, _ i% lB U1  
                        TracksPerCylinder As Long, _ va;w
Q~&  
                        SectorsPerTrack As Long, _ Z`KmH.l!  
                        BytesPerSector As Long)  d2C:3-4  
'//返回磁盘的参数 N| LVLsK  
    MediaType = lpGeometry.MediaType 4Pdk?vHK;  
    Cylinders = lpGeometry.Cylinders.lowpart UQ~rVUo.c  
    TracksPerCylinder = lpGeometry.TracksPerCylinder 1ouTZ'c?  
    SectorsPerTrack = lpGeometry.SectorsPerTrack [40 YoVlfM  
    BytesPerSector = lpGeometry.BytesPerSector t}
gqk'  
/GaR&  
End Sub b1o(CG(}*  
es]m 6A  
Public Property Get BufferSize() As Long x"80c(i  
'//返回每次读/写的缓冲大小 dY.uOafr  
    BufferSize = lBufferSize c.WT5|:qw  
End Property \&90$>h  
{`Z)'G\`  
M8}M*\2  
Public Function LockVolume() As Boolean [9^e u>)A  
'// 将卷锁定 ^IYN"yX_  
    Dim dwOutBytes  As Long RJ44o>L4O  
    Dim bResult     As Boolean ,
&SJ?XAs  
     $)~]4n
=  
    bResult = DeviceIoControl(hDisk, _ ?Sxnq#r#  
                                FSCTL_LOCK_VOLUME, _ {jI/ 9  
                                ByVal 0&, 0, _ `yXy T^  
                                ByVal 0&, 0, _ d:''qgz`  
                                dwOutBytes, _ | L&V-f&K  
                                ByVal 0&) T5;D0tM/  
    LockVolume = bResult q4N$.hpb  
End Function <H/H@xQ8G  
KA#-X2U/  
Yv
-uC}e  
Public Function UnlockVolume() As Boolean <|iU+.j\  
'// 将卷解锁 <i|+p1t  
    Dim dwOutBytes As Long !Ua#smZ  
    Dim bResult As Boolean E>D@#I>  
     ,Pm/ci(s  
    bResult = DeviceIoControl(hDisk, _ 0]~n8mB>  
                                FSCTL_UNLOCK_VOLUME, _ rl=_ "sd=  
                                ByVal 0&, 0, _ ^S|^1  
                                ByVal 0&, 0, _ m+"%J d{q  
                                dwOutBytes, _ 5ntP{p%>  
                                ByVal 0&) STI3|}G*P  
    UnlockVolume = bResult b1cd5  
End Function ]FBfh.#X@  
)^+$5OR\c  
5 S&>9l  
Public Function DismountVolume() As Boolean U\{Z{F%8  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 TW0^wSm  
    Dim dwOutBytes As Long 91XHz14  
    Dim bResult As Boolean =qvU9p2o  
     9Ba<'wk/>"  
    bResult = DeviceIoControl(hDisk, _ 5KSsRq/8"  
                                FSCTL_DISMOUNT_VOLUME, _ (" %yV_R  
                                ByVal 0&, 0, _ !c7Od )]  
                                ByVal 0&, 0, _ \m!."~%  
                                dwOutBytes, _ =I1@O9}+i  
                                ByVal 0&) kuaov3Ui  
    DismountVolume = bResult HvTQycG  
End Function %9
.KH  
0*/~9n-Vl  
|T%/d#b~  
Public Function ReadDisk(ByVal Cylinders As Long, _ 4J1Q])G9  
                    ByVal Tracks As Long, _ G#Ow>NJ  
                    db() As Byte) As Boolean o_n.,=/cZ  
'//按柱面和磁道来读取磁盘数据 x{}m)2[Y  
    Dim iPos    As Long K3^2R-3:8  
    Dim lRead   As Long  ?`>yl4  
     .R,8<4  
    iPos = Cylinders * Tracks * lBufferSize s>X;m .<  
     _p.{|7  
    If SeekAbsolute(0, iPos) Then `L>'9rbZO  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) RFdN13sJv  
    End If $;1~JOZh  
End Function zU%aobZ  
.y!Hw{cq  
Public Function WriteDisk(ByVal Cylinders As Long, _ \=<.0K A~  
                     ByVal Tracks As Long, _ b4wJnmC8  
                     db() As Byte) As Boolean ;
xc  
'//按柱面和磁道来写磁盘数据 oSoG&4  
    Dim iPos    As Long J :(l&  
    Dim lRead   As Long 4$"Lf'sH6  
     4o8!p\a  
    iPos = Cylinders * Tracks * lBufferSize 49m/UeNZ  
     2h!3[{M\  
    If SeekAbsolute(0, iPos) Then ^5+-7+-S  
        WriteDisk = WriteBytes(lBufferSize, db()) Ft}tIP7  
    End If V1G]LM  
End Function j; C(:6#J  
C&T3vM  
)94R\ f  
'///////////////////////////////////////////////////////////////////////////////////// THJ+OnP  
'//file system =DgD&_  
2i)y'+s  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean 5a/)
|  
'//seek file x@~V975Y  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte pqK3u)  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) l O^h)hrR  
    If LowPos = -1 Then *)1,W+A5L  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) 83a Rq&(R  
    Else @b zrJ7$  
        SeekAbsolute = True r/e&}!  
    End If gyK"#-/_d  
     or<JjTJ\o_  
End Function '9)@U+yfQ  
WA/\x  
BhjXNf9[  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean `6A"eDa  
'//read data to array `@&qf}`  
    Dim RetVal    As Long N%a[Y  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) lVdExR>H  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF 4$^=1ax  
    ReadBytes = Not (RetVal = 0) \WT
g 0b[  
     i469<^A  
End Function 2gGJ:,RC$  
kLhtkuS4  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean 9`muk  
'//write data from array Tla*V#:Ve  
    Dim RetVal As Long 9(_/jU4mc  
    Dim BytesToWrite As Long  P/Zo  
    Dim BytesWritten As Long ?>_.~b~  
     sw1XN?O  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) zM!*r~*k$  
     
k[p  
    WriteBytes = Not (RetVal = 0) $ ]HIYYs  
End Function =aCv Xa&,  

这才是我当年写出的一个比较烂的程序 $`  
>C i=H(8vN  
Main2.bas -[F^~Gv|;  
MS b{ve_  
Attribute VB_Name = "SubMain" S8y4 p0mV  
Option Explicit *8N~Zmz  
R[V%59#{Z  
'采集文件与临时文件 Ov9.qNT  
Public Const TmpFile As String = "d:\30-0600.dat" CUG6|qu  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 l^_X?
L@  
j% nd  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long 1@y?OWC  
Public hBCFile As Long  '记录采集参数的文件 pUmB h  
Public Const TmpBMP As String = "d:\1.bmp" ^K"`k43 {  
Public hTmpFile As Long ~EN @$N^h  
Np<Aak  
i8{jMe!Sa  
'采集窗口参数常量 HCu1vjU(]  
Public Const FrameH As Long = 280& 1pn167IQL  
Public Const FrameW As Long = 768& 3EFk] X  
Public Const pFrameSize As Long = FrameW * FrameH MMf6QxYf  
Cn"N5(i  
'标志区范围，用于识别车辆 'G^=>=w|Nv  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X <.<Nw6  
Public Const mkW As Integer = 28  '识别标志立柱宽度 B8PF}Mf  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) V>nY?  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) !y),| #7P  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 YZk&'w  
'车缝检测位置常数 :K&hGZ+5  
Public Const sSize As Long = 32& YMWy5 \  
Public Const sPos As Long = 310& h<j04fj  
Public Const sPosL As Long = 200& t5_`q(:  
Public Const sPosR As Long = 500& 52"/Zr}j  
'车缝检测框位置 <Z&gAqj 2  
Public Slice(1 To sSize, 1 To FrameH) As Byte L}9@kjW  
Public SliceL(1 To sSize, 1 To FrameH) As Byte rYLNV!_  
Public SliceR(1 To sSize, 1 To FrameH) As Byte %*uqtw8  
Public avSL As Integer, avSLR As Integer, avSLL As Integer OYKV*  
d/^^8XUK  
HGKm?'['  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 D(&OyZ~Q+  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 V_~wWuZ-  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 i2*nYd`K  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long 1#@'U90xf  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte ;)kB J @  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向
`A'*x]l  
^R\blJQ<^  
@|^Ch+%@  
WULj@ds\~
 
'一次连续采集的帧数 OT[t EqQ  
Public tFrames As Long (=X16}n:>  
&a0%7ea`.S  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 saZ ;ixV  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 ''6"Xi|5  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize Re2kD/S3  
0I k@d'7  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte r1\.Jz  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte j]P|iL  
Public pWorkSpace(1 To FrameW * FrameH) As Long KyDBCCOv  
Public Const pBufferSize As Long = FrameW * FrameH * 2 o ).pF">jh  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 \-B>']:R4  
R0|X;3  
Public hBoard As Long   '采集卡标识 QZ`<+"a0  
Public mBufferAddr As Long  '缓存地址 X bg7mj9c  
Public BufferSize As Long  '缓存大小(字节) rS jC/O&b  
Public iCurrentCard As Long 5 9X|l&/  
Public CapStatus As Long ]_
Qc}pMF&  
Public iFrames As Long g&[g?L  
Public currentBr As Byte, currentContr As Byte ^TjFR*S'E  
Bm?Ku7}.  
Public hMEM As Long, mStatus As Long V *]!N  
Public Const hMemSize As Long = pFrameSize * 4 ks{s Q@~  
Public hMemWork As Long hImCy9i}  
Public Const hMemWorkSize As Long = pFrameSize * 5 ZTun{Dw{  
gK>Vm9rO  
QXrK-&fju  
:Cuae?O,  
'串口接收轨道衡数据 pif8/e  
Public WeightFromCom As String qN)cB?+  
Public bReceiveComplete As Boolean g(` 6cY[}  
iN><m|  
QSLDA`  
Public Type GrayBMPHeader *qqFIp^  
  Tag As Integer qq/Cn4fN8  
  FileLength As Long    '文件大小 q&M;rIo?  
  Reserve1 As Long +VeLd+Q}  
  DataOffset As Long    '图像数据偏移量 MVCCh+,GI  
  BMPHeaderSize As Long  '文件头长 (t z! "K  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… qm '$R3g  
                        'the following sizes are possible: ~\^8 ^  
                        '28h - windows 3.1x, 95, nt, … 2H /a&uo@n  
                        '0ch - os/2 1.x Qw^tzP8  
                        'f0h - os/2 2.x itvwmI,m\  
md_Ld /  
  ImageWidth As Long           '图像宽（像素数） =FKB)#N  
  ImageHeight As Long          '图像高(像素数) *Dn{MD7,M  
  PlaneNumber As Integer  '图像层数 9xz`
V1mIL  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap ANNL7Z3C  
                                        '4 - 16 color bitmap lojn8uL  
                                        '8 - 256 color bitmap 25TEbp[dy  
                                        '16 - 16bit (high color) bitmap HaSH0eTw  
                                        '24 - 24bit (true color) bitmap LY >JE6zTt  
                                        '32 - 32bit (true color) bitmap H^s SHj  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) !F8 !]" *  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) T;%SB&  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) p-}:7CXP  
                                    '3 - bitfields (also identified by bi_bitfields) fG{oi(T  
  IMAGESIZE As Long  '图像数据字节数 iaC$K@a{  
  hResolution  As Long  '水平分辩率  像素数/米 ;~K($_#H  
  vResolution  As Long  '垂直分辩率 kb6v2 ^8H  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 =f["M=)ZJ  
  ImportantColors As Long tY#^3ac  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 _ &M>f?l  
End Type 5 |b/G  
:K~7BJ(HO  
A gPg0(G  
\<8!b{F  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader iO@wqbg$6  
Public sRECT As RECT w;_Ds  
(y36NH+  
(UM+?]Qwy  
Public conn As ADODB.Connection &zT~3>2  
Public rsTrain As ADODB.Recordset %Xi%LUk{  
Public rsOperater As ADODB.Recordset v:>P;\]r9M  
Public rsGoods As ADODB.Recordset Z`%
;bP:  
Public rsGood2 As ADODB.Recordset ooAZ,l=8  
Public rsSender As ADODB.Recordset f6#H@ X  
Public rsReceover As ADODB.Recordset Xu$*ZJ5w  
Public rsTrainTMP As ADODB.Recordset Pv'x|
p*  
UOu&sg*o2B  
^>"?!lv  
'打开采集卡 V]AL'}( 0  
'设置参数 }lY-
_y  
'设置为实时单帧采集到缓存方式 bcZonS  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 C+k>Ajr  
0QpWt  
pxF!<nN1,  
Sub Main()
\5Jv;gc\\  
  Dim i As Integer, status As Long `zL9dlZ  
     ]'G7(Y\)f  
   InitBMPinfo %F~ dmA#:  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 '3Ri/V,  
    BMPHeader.Tag = &H4D42 wnX6XyUH  
    BMPHeader.ImageWidth = FrameW kr?|>6?  
    BMPHeader.ImageHeight = FrameH ,Tx8^|b#F  
    BMPHeader.BMPHeaderSize = &H28 2S;zze7)  
    BMPHeader.PlaneNumber = 1 Ixw,$%-]y6  
    BMPHeader.bpp = 8 e =_hfOUC  
    BMPHeader.Compression = 0 U]acm\^Z  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 B]vj1m`9  
    BMPHeader.vResolution = &H1274 l0_V-|x  
    BMPHeader.ColorsinBMP = 256 |?>h$'  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP )N/KQ[W  
    BMPHeader.DataOffset = Len(BMPHeader) H,}?YW  
    For i = 0 To 255 l.BNe)1!22  
      BMPHeader.Pallate(i) = RGB(i, i, i) F)@<ZE  
    Next i PjHm#a3zg%  
    BMPHeader.IMAGESIZE = FrameH * FrameW u;!Rv E8N  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE }FX Rp=s  
{ \ePJG#  
~
I<y^]2{  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) D6t]E)FH  
     *.RVH< W=8  
    BMP1.ImageWidth = FrameW ; 
p9D2&  
    BMP1.ImageHeight = FrameH * 2 !=we7vK}  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight %c0;Bb-  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE -O5m@rwt<  
[wR8q,2  
  '确定标志位置,为pilarX, pilarY确定初始值 &<V~s/n=6?  
   PilarW = mkW eBB D9SI
 
   PilarH = mkH  '此两项为固定值 J0 P  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) ($s{em4L  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 7d)aDc*TjW  
   _X[c19q  
   R32d(2%5K  
  '连续采集记录文件 Go|65Z\`7M  
  ' 建立一个缓冲区为页对齐方式的文件 H]e 2d|  
  If Dir(TmpFile) <> "" Then dUZ&Ty^{  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ epF>z   
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) {aSq3C<r  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 xpM~*Gpm  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 {>Px.%[<  
  Else tTgW^&B  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ cF2/}m]  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) )B_h"5X4\y  
  End If H/$q]i*#K  
  If hFile = 0 Then =X*E
(.6Ip  
    MsgBox TmpFile & ": File Open Error", vbOKOnly f/yK|[g~  
    Exit Sub <Va>5R_
d<  
  End If b~gF,^w  
  '采集参数记录文件 }#J}8.  
hBCFile = FreeFile() T!PX?  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile S\A[Z&k0  
   9:>K!@  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 J^:~#`8  
If hMEM = 0 Then rx/ 6x(3  
    fStatus = GetLastError c'2ra/?k  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 5glGlD6R  
     & "请向技术人员报告该错误代码。", vbOKOnly v,0DGR~  
    CloseHandle hFile (R-Q9F+
;  
    Exit Sub (a?Ip)`I  
End If =Ug_1w  
Ei-OuDM;)  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 0=B5 =qyw  
If hMemWork = 0 Then q 4{tH  
    fStatus = GetLastError u W T[6R  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ Vz*'^=(o&  
     & "请向技术人员报告该错误代码。", vbOKOnly ;j=1 oW  
     '释放已成功分配的内存 0h#M)Ft  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) @XmkIm  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) fm0(  
     H JiP:{  
    CloseHandle hFile %u}sVRJ  
    Exit Sub ks D1NB;9  
End If C)w*aU,(  
BE~[%6T7  
' Test writing 0^ [6  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& mxGN[%ve  
     JyO lVs<T  
   '初始化采集卡参数 1*h7L<#|mQ  
   iCurrentCard = -1 bG)MG0<TT  
   hBoard = okOpenBoard(iCurrentCard) sXxO{aeev  
   Debug.Print hBoard B
*IDx`^Y  
   If hBoard = 0 Then |xm|Q(PG  
      ExitGrabber ]Ho`*$dD  
      End iE(g
rI3  
   End If 8H?AL RG  
   okGetBufferSize hBoard, mBufferAddr, BufferSize ([~`{,sv  
   If mBufferAddr = 0 Then P
vwIO_W  
     MsgBox "缓存不存在！" }^7V^W  
     ExitGrabber S<~nk-xr*h  
   End If DF2&j!  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) @{u c  
   R`q!~8u  
    ZsZ1  
   currentBr = 128: currentContr = 128 {9 O`/|  
   '设置视频输入参数 <Tf;p8#  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 Z&,}Fgl!F  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input =Qrz|$_rv  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 L ]c9
 
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 [2V/v  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 ?sYjF iE  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 0 ,-b %X  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） U@nwSfp:G  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) @g ~sgE}#  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) ?miM15XI  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 k#xpY!' 7  
   `'WLGQG  
   '设置采集参数 sA}R!  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 8BDL{?Mu  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 'Aj>+H<B  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 9 NQq=@  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 9DX3]Z\7X  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 <J-Z;r(gQN  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 +ctv]'P_  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 ]?{lQ0vw'w  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 K8Zk{on  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 LnS>3$t*  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 sdQv:nd'R  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 Q%^bA,$&D  
   (_ah~VnO  
   4a! 7|}W  
   okCloseBoard hBoard h>0<@UP  
   Sleep 50 xQap44KPZ  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 ,np`:fBMy  
   >N-%  
   '设置数据传送方式 b_yXM  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 +;;%Atgn  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 Q
aR.8/xV  
   E e>j7k.G.  
   sRECT.Right = -1   '用于获得当前设置值 0(x@ NGb>{  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) 6a?p?I K^  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom "~C#DZwt{  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 Ir #V2]$  
   sRECT.Left = 0 79H+~1Az  
   sRECT.Top = 0 y>|XpImZ  
   sRECT.Right = sRECT.Left + FrameW `gN68:B  
   sRECT.Bottom = sRECT.Top + FrameH * 2 :g[x;Q[@  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) <t% A)L%  
   "|`9{/]  
   sRECT.Right = -1   '检查新设置值 ~-wJ#E3g  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) g/p9"eBpq  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom rJp6d:M  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) lVtn$frp  
   mcr#Ze  
   If TESTSignal = False Then Y{RB\} f(  
      'ExitGrabber C)s1' =TZ  
   End If |wQZ~Ux:  
   Tj5@OcA$  
   pIiED9  
   P1stL,  
   '设为实时采集状态 WG}CPkj  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) :
"te
-  
   s $x] fO  
   [[h) 4H{T  
   '单帧采集 \/'n[3x  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 -i5g 8t'  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) QYXx7h r=$  
   okCaptureTo hBoard, BUFFER, 0, 1 'single K"j= _%{  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 % T\N@  
   '   Sleep 20 &>.1%x
@R  
   'Loop U^BXCu1km  
   okGetCaptureStatus hBoard, True @n*D>g  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize :b*`hWnQ  
   '写入768*576测试图象 3Lki7QW`  
   ArrayToBMP TmpBMP Cf[F`pFM  
   K/v-P <g  
   '打开数据库 <Cu?$  
   Set conn = New ADODB.Connection ?3,tG z)  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 9Pk3}f)a  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ `sy &dyM  
      "; Mode=Read|Write" %C0O?q  
   conn.Open ZM`P~N1?)g  
   b.q"
s6u  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) x*8f3^ wE  
   frmRecord.Visible = True x9A ZS#e)[  
   frmQuery.Visible = True h^kNM8  
   Load frmReceiveFromComm SoU'r]k1x  
   (!5}" fj  
   '调试参数 }, &,Dt  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then =v$s+`cP  
     SignalBox.Visible = True OKP_3Ns  
   End If Ej09RO"pB  
   If InStr(UCase(Command()), "/COMM") > 0 Then wn|@D<  
     frmReceiveFromComm.Visible = True cqL7dlhIl  
   End If :;q_f+U  
w })Pedg  
End Sub y6jmn1K  
p]z54 ~  
Sub ExitGrabber() _ZM9 "<M-X  
  '关闭数据库 I S8nvx\  
  '关闭采集卡 DPQGh`J  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) F%Umau*1  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) PJ'lZu8?x  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) 8t:&#h  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) tW"ptU^9)
 
  okStopCapture hBoard 3(})uV  
  okCloseBoard hBoard (L:Fb  
  CloseHandle hFile CU1\C*  
  Close #hBCFile K6*UFO4}i  
  conn.Close ivz9R'  
  End LiD |4(3  
End Sub i2a"J&,6O  
pkfOM"5'  
Function ArrayToBMP(ByVal File As String) J:Y|O-S!  
Dim BytesWrite As Long 1 lCikS^c  
.4re0:V  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ vs)I pV(  
  CREATE_ALWAYS, 0&, 0&) |\n) <r_  
0$ 9;pzr  
If hTmpFile = 0 Then R|J>8AL}BY  
   ArrayToBMP = False qL5#.bR  
   Exit Function e$+f~~K  
End If fwv T2G4  
3k*:B~1  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN *R\/#Y|  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& w[7.@%^[  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN *8X9lv.Z  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& 3p 1EScH  
@ *O{*2  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN QC5f:BwM  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& p$1Rgm\  
ElR&scXi__  
If BytesWrite < pFrameSize Then ^x"c 0R^  
  ArrayToBMP = False #C;zS9(]B  
End If NU& ^7[!yl  
p/WH#4Xdr  
CloseHandle hTmpFile dFP-(dX#  
LF)a"Sh  
End Function *tfDXQ^mN  
@W\4UX3dK  
Function ArrayToBMP1(ByVal File As String) hf+/kc!>i  
& #PBww  
Dim BytesWrite As Long {&}/p-S  
N!Wq}#&l  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ P[I*%  
  CREATE_ALWAYS, 0&, 0&) j)tCr Py  
v7<S F  
If hTmpFile = 0 Then =#Cf5s6qt  
   ArrayToBMP1 = False 5 (21gW9  
   Exit Function t#pqXY/;D  
End If Q@W|GO H3  
r>:L$_]L  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN i=X*  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& CziaxJ  
RJ}yf|d-C  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN R-A'v&=  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& g[wP!y%V  
[zTYiNa  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN FE8+E\ U?  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ?jNF6z*M6  
Pn'`Q S?  
If BytesWrite < pBufferSize Then vx\nr8'k  
  ArrayToBMP1 = False :u>W&D  
End If IwTr'}XIw  
7y>Tn`V8G  
CloseHandle hTmpFile m\*&2Na  
j<l#qho{h  
End Function 1-6gB@cvQ  
 /,1SE(  
'使用该过程建立的文件要求在用后关闭 :b<-[8d&  
Public Function ArrayToBMP2(File As String) As Boolean !y>lOw})Q  
3AdP^B<  
Dim BytesWrite As Long |u^)RB  
B#HnPUUK  
ArrayToBMP2 = True E1c>nrnh*  
A+0T"2  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ q3c*<n g#  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) BG
B,Gb  
/e.FY9  
If hTmpFile = 0 Then 6?%]odI#  
   ArrayToBMP2 = False tk`: CT *  
   Exit Function H o4B  
End If UfK4eZx*`  
}iPo8Ra  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN O%YjWb  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& z3^RUoGU  
vQ:x%=]  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN _L*f8e8  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& -@%t"8  
uIYcmF\?  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN W:VW_3  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 5wzQ?07T_  
l9_m>X~  
If BytesWrite < pFrameSize Then -!XrwQyk  
  ArrayToBMP2 = False YHETI~'j.  
End If yD"]{  
?gd'M_-J,  
CloseHandle hTmpFile qxf+#  
f*{M3"$E  
End Function ,3VG.u;U   
8s QQK.N(  
Private Function TESTSignal() As Boolean X!U]`Qh  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long D-Bv(/Pz]$  
"[awmZ:wo  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) -/M9 vS  
vn|TiZ  
If extsign = 1 Then *4|9&PNLE  
   TESTSignal = True "NxOOL L  
Else 4]"a;(  
    If extsign = 0 Then |f"-|6  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly /lf\ E=  
        TESTSignal = False |9+bSH9  
        Exit Function g/OI|1a  
    End If m5e\rMN~>\  
End If >lA7*nn  
Z -pyFK\  
'测试视频输入类型 nHI(V-E2:H  
'video type +DicP"~*  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 kjx >  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) f|X[gL,B  
If videotype = 1 Then @kwLBAK}@  
        '"隔行信号(Interlaced)" .>k=A|3G  
Else lP}od  
   If videotype = 0 Then N1YgYL  
       '"逐行信号(Non-interlaced)" Q8 -3RgAw  
   Else OfD@\;L  
     If videotype = -1 Then y!S^xS  
       ' "不支持" Vn)%C_-]A  
     End If @b]VCv0*f%  
   End If V)2"l"Kt  
End If MPjr_yc]  
x HY+q;  
'测试垂直扫描线数 &\&'L|0F  
'video scanlines ])N|[|$  
scanlines = -1 &@=u+)^-{  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) jz %;4e
~t  
    If scanlines = -1 Then K{|w 43>D  
        ' "不支持" XXXljh6  
    Else W=~id"XtJ  
        'Trim(Str(ScanLines)) + " 行数/幅" :L]-'\y  
    End If Bp&6x;MJf  
M_tj7Q3 W  
'测试帧频 _mw13jcN]  
'video field frequency 40 A&#u9o  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) vz6SCGg,  
    If fieldfrq = -1 Then CIIY|DI`l  
        'lblSignal(8) = "不支持" HvAE,0N  
    Else ktN%!Mh\  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" =ZG<BG_  
    End If M,&tA1CH  
End Function ah 4kA LO  
.JNcY]V#  
3b<: :t  
Sub PicIdentify() 'n>K^rA  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 ]9fS@SHdx  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 1lbwJVY[  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 D._{E*vg  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 k&OC&  
{*sGhGwr  
  Dim fPTR As Long, cFrame As Long -_s%8l^  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer D`V6&_.p  
     (2: N;  
IS-}:~Pi  
cFrame = 0 a4 %`"  
,r@xPZPz:e  
:}^Rs9 '  
Do While cFrame < tFrames Dp^"J85}   
   *f{ 7  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) '-`O. 4u  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) w"q-#,37j  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 1JIG+ZNmd  
   >g=^,G}y  
  frmRecord.RText.Text = Str(cFrame) Pl_^nFm0  
  frmRecord.RText.Refresh
n.@#rBKZ  
       y*w"J3|29  
  If CheckMark = True Then z|uOJ0uK  
   ArrayToBMP TmpBMP (viWY  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) T
]^?l  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" 7kdeYr~<1  
   Cm^Ylp  
   DrawSlice 5n:nZ_D  
   a-fv[oB  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) uG4$2  
   'If i = vbNo Then 6j_ 678  
   '  Exit Do S3ErH,XB.  
   'End If x,w8r+~5  
   'cFrame = cFrame + 1 {&E?<D2_&  
   yGRR8F5>(  
  End If I[@ts!YD  
  DoEvents E\ tL
 
  cFrame = cFrame + 1 %y eu"  
Loop wqcDAO(  
End Sub Hyf"iYv+  
[Uswf3  
' [%jj UU  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean nZ~kZ |VS  
D2{L=  
'如标志区模式反差存在则为TRUE，否则返回FALSE qbH%
Hx  
g-XKP  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long V)=
Z6ti  
CheckMark = True I<sfN'FpT  
   Qy/uB$q{A  
'复制标志区 87pnSj/X"  
For i = 1 To mkH )GK+  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW )5U!>,fT  
Next i
;;M"hI3@  
g#w`J\iz  
For j = 1 To PilarW * PilarH / 2 2bkJ /u`i  
   mTop = mTop + MKpilar(j) ;3mL^  
Next j nkTYWw  
tp@*=*^I  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH B`#*o<eb  
   mBot = mBot + MKpilar(j) lHcA j{6  
Next j ]}.0el{  
>$Fp}?xX
 
mTop = mTop / PilarW / PilarH * 2 JT}.F!q6E  
mBot = mBot / PilarW / PilarH * 2 ~)_K"h.DY  
{ E^U6@  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 V- /YNRV  
7aV$YuL)X~  
'平均值极值化 XJc ,uj7  
  For j = 1 To PilarH * PilarW ,}KwP*:Z  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) UAdz-)$  
  Next j
5lGQ#r  
   B& "RS  
mTop = 0: mBot = 0 p:Oz<P  
For j = 1 To PilarH * PilarW / 2 lVP |W:~K  
  mTop = mTop + MKpilar(j) a%v>eXc  
Next j M%3Wy"YQ,n  
D'<$ g  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW >G&^?5  
  mBot = mBot + MKpilar(j) +N7"EROc  
Next j w;~>k%}j  
3EI]bmi~  
@' d6iYk_  
  mTop = mTop / PilarH / PilarW * 3 =)(0.E  
  mBot = mBot / PilarH / PilarW * 3 7H4L-J3  
   )Z("O[  
pp<E))&R  
If mBot > iWhite And mTop < iBlk Then .8K6C]gw  
  CheckMark = True g@Ld "5$^2  
Else cu)U7  
  CheckMark = False #,TELzUVE  
End If 02(h={  
End Function F.68
iN}  
/p,{?~0mj  
Sub Capture1Frame() !W~QT}  
   okCaptureTo hBoard, BUFFER, 0, 1 'single ^,`M0g\ $  
   okGetCaptureStatus hBoard, True &f"T,4Oh  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize *U_S1>0n  
End Sub CG.,/]_  
se#@)LtZ  
pcnl0o~  
Sub CopyMark(iBlk As Integer, iWhite As Integer) f9a$$nb3`  
'复制标志区并返回标志区暗区与亮区的亮度平均值 [z2eCH  
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 Zb"jB$58  
   vTHq)
C.7G  
'复制标志区 07FT)Q
TE  
For i = 1 To mkH $2QYxY9s  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW v$;@0t:;#  
Next i HAd%k$Xu{  
9)Ly}Kzx  
For j = 1 To mkW * mkH / 2 !j0_ cA  
   mTotal = mTotal + MKpilar(j) XC2FF&B&  
Next j ?,>5[Ha^?  
+mLD/gK`  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 V:OiW"/  
"oe!M'aj`1  
mTotal = 0 Y([d;_#P  
For j = mkW * mkH / 2 + 1 To mkW * mkH i-]U+m*  
   mTotal = mTotal + MKpilar(j) "b`7[;a  
Next j F_v-}bbcFQ  
<<sE`>)  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 *,&S',S-  
m<3w^mww  
'背景亮度 (xu=%  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW s%O Y<B@V2  
  For i = 1 To 4 * FrameW x}|+sS,g  
    bsTotal = bsTotal + BsLine(i) sBU_Ft  
  Next i YQYX,b  
  bsAV = bsTotal / FrameW / 4 +j.qZ8  
' Rc#^U*n  
End Sub F\-Si!~oOz  
t3a#%'Dv  
^&MK42,\  
Sub AdjIMGbright(Optional bInit As Boolean = True) p31oL{D  
NV6 G.x  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） )b9_C O}  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 7E\g &R.  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 I|T7+{
5z  
     lH6fvz  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer <aXoB*Y  
   kM;o0wi  
  '按标准亮度与对比度采集一帧，确定背景亮度 W~yLl%  
  currentContr = 128   '初始对比度 l sr?b  
  currentBr = 128   '初始亮度 Im+7<3Z  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 !3V{2-y$-  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 j`9Qzi1  
  DoEvents WL1\y|  
  Capture1Frame p?kvW42/  
  '获得图像上缘4行象素 :v)6gz(p  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW `7\H41%\pp  
  CopyMark iBlack, iBright   '图像标志区亮度 xCq'[9oU  
  For i = 1 To 4 * FrameW F,&)X>:l  
    bsTotal = bsTotal + BsLine(i) d8o ewkiR  
  Next i <h@]Ri  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 G|*G9nQ  
   \7 Gz\=\LR  
  Select Case bsAV %J!NL0x_  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 uXpv*i{R  
       currentBr = 150 [,b)YjO~Xd  
       currentContr = 60 7]Rk+q2:  
     Case 61 To 80   '有可见背景 @vt$MiOi  
       currentBr = 140 N2Ssf$  
       currentContr = 70 3ev-Iqz  
     Case 81 To 100  '有清晰背景 , D"]y~~I5  
       currentBr = 128 u{Ak:0G7  
       currentContr = 80 0sh~I  
     Case 100 To 150  '有明亮背景 Ha)np  
       currentBr = 140                '5:30-6:00钟实测数据 X3yS5whd(  
       currentContr = 50 lE'wfUb  
     Case 151 To 180 `XgFga)  
       currentBr = 130 Oyan9~  
       currentContr = 60 wDKELQ(yH  
     Case 181 To 220  '背景全为白色 ?-,6<K1  
       currentBr = 110 kC`Rd:5  
       currentContr = 130 AG>\aV"b  
     Case 221 To 255  '背景全为白色 =) }nLS3t  
       currentBr = 100 |'$ l7  
       currentContr = 100 O:YJ%;w  
  End Select P,ydt  
   +GeWg` \=  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 GW/WUzK  
        Case 100 To 150 H%z/v|e6  
          currentBr = currentBr - 10 'Wp@b678  
        Case 151 To 255 *)D1!R<\,R  
          currentBr = currentBr - 20
]]PE#DDg  
  End Select >f@ G>H)+  
   V{ |[oIp  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 CN\=9Rvs  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 CmnHh~ %  
End Sub q:]Q% IC^  
+?AW>&68y  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) `tVy_/3(9  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long MUwxgAG`G  
     9.s,:?5e  
    For i = 1 To 8 l!@ 1u^v2  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& (N aK3_  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& ]
\dHU.i  
    Next i ,Xtj;@~-  
     <u0,Fp  
    For j = 1 To 1024 SiTe
B)/  
      L1 = L1 + LeftBK(j, 0) kceyuD$3G  
      L2 = L2 + LeftBK(j, 1) M*`hDdS  
      R1 = R1 + RightBK(j, 0) niz'b]] +  
      R2 = R2 + RightBK(j, 1) c\K<sM{  
    Next j 7n&yv
9"  
    diffL = Abs(L1 - L2) / 1024 X~L!e}Rz  
    diffR = Abs(R1 - R2) / 1024 :)4*^a/lC  
End Sub ) EXJ   
H+x#gK2l  
Function CheckSlice() As Boolean H=<LutnZ  
  CopySlice avSL, avSLR, avSLL vaB!R 0  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then ) rpq+~b   
    CheckSlice = True D/:3RZF  
  Else ^Xs]C|=W  
    CheckSlice = False x<F $aXOS  
  End If YtYy zX5u7  
End Function H1&R I4XC  
= F<:}Tx)C  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) !y[3]8Xxv  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long x7$ax79ly  
  For i = 1 To FrameH 0OW
L  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize &S-er{]]  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize GTA f   
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 1-o V-K  
  Next i t!qwxX*$T  
  For i = 1 To FrameH o;J;k_[MX  
    For j = 1 To sSize ArXl=s';s4  
       total = total + Slice(j, i) &,MFB  
       totalL = totalL + SliceL(j, i) ^l(^z fsZ  
       totalR = totalR + SliceR(j, i) J\A8qh8  
    Next j V
3uXan_  
  Next i A ~&+F> Z  
  avSL = total / FrameH / sSize !\
x?R6K  
  avSLR = totalR / FrameH / sSize ?cK]C2Ak
  
  avSLL = totalL / FrameH / sSize H~Uq?
!=b  
End Sub ~ffwLgu!  

,g|2NjUAc  
Sub DrawSlice() %{'4. ,  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B  {7X~!e|w  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B vpLMhf`  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B  }_%P6  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) >rf5)Y~f  
End Sub _#pnjo  
Sub DrawMark(pic As Control) niWx^gKb$  
   Dim i As Long, j As Long yU_9a[$V  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B y6%<zhs  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B xS+rHC  
   For i = 1 To PilarH  zy>}L #  
     For j = 1 To PilarW 7I >J$"  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) (B}+h   
     Next j >nM%p4E  
   Next i j^EbO3  
End Sub 9rcI+q=E  
]w[ThHRJ  
Function avIMG() As Integer V^rW?Do  
  Dim i As Long, j As Long, totalIMG As Long U^?= 0+  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize mH\@QdF  
  For i = 1 To pFrameSize *eGM7o*\X  
    totalIMG = totalIMG + pBuffer(i)  uJ8{HB  
  Next i KB[QZ`"%!  
  avIMG = totalIMG / pFrameSize
kUbnVF5'  
End Function 0>@[o8  
GOVAb'  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer c-*2dV[@  
  Dim i As Long, j As Long, totalIMG As Long n9] ~  
  For i = 1 To FrameH z<<Tk.65  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth 9o_-=>(  
  Next i vr4S9`,  
  For i = 1 To FrameH * barWidth sfI N)jh  
    totalIMG = totalIMG + pBuffer(i) hW' H
T  
  Next i
[hnK/4!  
  avRegion = totalIMG / pFrameSize #{,h@g}W  
End Function it,w^VU_]  

一共这么多文件。 Qlh?
iA  
$G3@< BIN  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 @_Sp3nWdu  
第6车皮 ^ZVOql&  

4(|yD;  
^A#x<J+  
第9车皮 iT$d;5_pU  
8A4TAT4,  
  

从这里里分离出来的。

nVt,= ?_ U  
HM(S}>  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 hPB^|#}  
t5Oeb<REz  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ Dxlpo! ?#  
gx',~  

继续填个坑： 9$[PAjwk  
L
" GQQ  
用VBA控制WORD自己修订学生毕业文的格式。 v?=y9lEH@%