引用

引用第20楼newport93于06-14-2010 13:47发表的  : .ZJh-cd  
#tfJ ?w`  
老五，I 服了U。 2'}2r ~6  
bQeYFY#^  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 oz0-'_  

7SM/bJ-M#  
< 1r.p<s  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! ~ g,QwaA[  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : ejQCMG7  
Is that what you wanted to express yourself to us with the whole blank message but the very big title?  wb?hfe  

Z:OO|x  
y7Ub~qU  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : O^:h_L  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 %q
HT!aP  

u rOGOa$  
n" ~*9'  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 @W,
Y_8:  
gdT_kb5HL8  
可以从宽不？

引用

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

EHHxCq?  
rZv+K/6*M  
其实标题没有什么，卡总既然改了就不必再改回了。 z,)sS<t(  
C] w< &o  
主要是当初写的时候真是顶着锅盖写的。 $yAfs3/%)s  
h~@+M5r,  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : lMez!qx,=  
哦, 打倒忽悠大家的家伙.      YO$b#  

Y&f[2+?2NK  
-_DiD^UcXn  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : TL{pc=eBo  
每个人的故事对其他人都是故事, <VR&=YJ  
自己的故事也是其中之一. OXX(OCG>  
跳出来看, C%?D E@k  
不过是众人中的一个人的故事. j_uY8c>3\q  
a~>0JmM+N  
所以,接着听故事. {C0^D*U:  
#'Y6UGJ\n  
女人们有兴趣的就等老伍开个新帖或者跟贴, A|_%'8  
听他痛说恋爱革命历史.... Po!JgcJ#\  
; 9&.QR(  
杂家接着听他自学程序员历史, MQH8Q$5D  
高级程序员考了吗? {R!TUQ5  

|ezO@  
0*
IY%=i  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ +Y9D!=_lj  
V'f5-E0  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 bA^:p3  
B m@oB2x)  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 1fhK{9#  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : \ NSw<.  
引用第19楼伍胥之于06-14-2010 12:33发表的  : m>-^K  
9Glfi@.  
{S
"  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 IfmIX+t?  
VDu .L8  
我连一级也没有考过。 q'AnI$!  
. ?]:EmP  

Z=Y_;dS9  

引用

2:HP5  
矬子里拔将军... 9k+&fyy  
你们那里的俗语是吧? A"<)(M+kG  
J(&M<<%  
我们这里说"矮子里拔长脚"..应该是同一个意思... vl{_M*w ;  
ny_ kr`$42  
有趣....各地有表达意思一样却方式不同的俗语.... z'}=A  
OG?j6qhpl  
yH"$t/cU"R  
你的文章写的有脸皮,没屁眼的, -f;j1bQ  
让看客大为不满... IJBJebqL  
vb.Y8[  
你等着,,估计你以后接到的午夜凶铃就多了... >-|90CSdSJ  

)>X|o$2  
$h]Y<&('G  
我到现在也没有接到你的午夜凶铃呢！ 0m YZ7S5g  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : 23\j1?  
伍SIR，再次抱拳佩服 l;{N/cS  

Xm^ h5jAr  
p`<e~[]a  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : bUAR<R'E  
佩服，玩也玩得这么专业！ K7[AiU_I  

T?]kF-   
DtJTnvG~B  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : K5)yM @cq  
_8NEwwhc  
介个真的看不懂。 (Xr_ np @  
你说你老啦，喜欢怀旧了，才想起来填坑。 |B1;l<|`  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 Oj4u!SY\j  

Kixr6\  
.n)!ZN  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 dY4k9
p8  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){
F; MF:;mM  
DWORD dwCB; ~3'OiIw1@  
LARGE_INTEGER  offset; Xew1LPI  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); >TlW]st  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); e$ XY\{  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ O7'<I|aD  
DWORD error = GetLastError(); q2S!m6!  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); ; Oi[:Ck  
return FALSE; ,{ uW8L  
} [yYH>~SuwZ  
return TRUE; "J8;4p  
} Ha=_u+@  

'VB 6.0 版 l}Q"Nb)  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 ]< s\V-y  
$TD~k;   
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 S/n j5Lh  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long AK@`'$  
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 O2`oe4."vd  
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long '//declare has changed l\T!)Ql  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long DD/>{kff  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 f.aB?\"f6  
Xx3g3P  
>op:0on]}  
Private Const GENERIC_READ = &H80000000 |b$>68:  
Private Const GENERIC_WRITE = &H40000000 z_:eM7]jv  
WNn[L=f  
Private Const FILE_SHARE_READ = &H1 }XGMa?WR  
Private Const FILE_SHARE_WRITE = &H2 *]}CSZ[>  
Private Const OPEN_EXISTING = 3 LC,*H0  
3wN?|N   
Private Const INVALID_HANDLE_VALUE = -1 4GU/V\e|  
Q)LXL.0h  
'//file seek }pl]9  
Private Const FILE_BEGIN = 0 ,?xLT2>J_  
Private Const FILE_CURRENT = 1 M('s|>\l  
Private Const FILE_END = 2 Ci7P%]9  
,]PyDq6  
Private Const ERROR_SUCCESS = 0& O6m.t%*  
"EcX
_>  
'//device io control -y&v9OC2-  
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 *PSvHXNi  
~Ho{p Oq  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 hzT{3YtY2  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 bH\'uaJ  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 ,67"C2Y  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 AfbB~LlBq  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C biK)&6|`sa  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 7Sg
weZ}"  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F Pl rkgS0J  
D00G1:Ft(T  
'//type DU5:+" u3  
Private Type LARGE_INTEGER ]^J+
-c  
    lowpart As Long r/ NSD$-n  
    highpart As Long [%j?.N  
End Type ,:#,}w_HyO  
^CZCZ,v  
Private Enum MEDIA_TYPE >63)z I  
    Unknown c;:">NR  
    F5_1Pt2_512 ADv^eJJ|  
    F3_1Pt44_512 ^[{`q9A#d  
    F3_2Pt88_512 u*t,
i`  
    F3_20Pt8_512 a|DsHZ^6^  
    F3_720_512 S=0"f}Jo.  
    F5_360_512 8 uDerJ!  
    F5_320_512 mR{CVU  
    F5_320_1024 EJf#f
 
    F5_180_512 @4IW=V  
    F5_160_512 Vq3gceo'0A  
    RemovableMedia _BZ1Vnv  
    FixedMedia GVmC }>z  
End Enum &8[ZN$Xe"  
kzZDtI)  
Private Type DISK_GEOMETRY fD1?z"lo  
    Cylinders           As LARGE_INTEGER KQG-2oW  
    MediaType           As MEDIA_TYPE qP~WEcH`[  
    TracksPerCylinder   As Long o"rq/\ovv  
    SectorsPerTrack     As Long
% v;e  
    BytesPerSector      As Long _j:UGMTi(U  
End Type ~Cjz29|gp  
_iG2J&1'L  
'//private vars q,[k7&HS  
Private hDisk           As Long             'disk handle f4 ]N0  
Private lpGeometry      As DISK_GEOMETRY    'disk info IDy_L;'`*  
Private lBufferSize     As Long             'the buffer size of read/write ,HFs.9#&B  
~bdv_|k  
Public Function OpenDisk(ByVal FileName As String) As Boolean D(y+1^>  
'// 打开磁盘 z$JX'(<Z7  
    hDisk = CreateFile(FileName, _ [8>z#*B  
                        GENERIC_READ Or GENERIC_WRITE, _ wP[xmO-%  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ bA}AD`5  
                        ByVal 0&, _ 2v0!` &?M{  
                        OPEN_EXISTING, _ A/q2g7My  
                        0, _ v8ba~  
                        0) 9T(L"9r-e  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) $4Z+F#mx  
End Function Vy-28icZ`  
BjJ,"sT  
Public Function CloseDisk() As Boolean x(L(l=^"  
'//关闭磁盘 2O eshkE  
    CloseDisk = CloseHandle(hDisk) 4p.^'2m  
End Function WtEI] WO  
' |&> /dyq  
Public Function GetDiskGeometry() As Boolean ?b||Cr  
'//获取磁盘参数 F%xK"l`&  
    Dim dwOutBytes      As Long rRB~=J"  
    Dim bResult         As Boolean 0cHfxy3  
     >[ eW">:>K  
    bResult = DeviceIoControl(hDisk, _ sX+`w c  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ KAd_zkUA  
                                ByVal 0&, 0, _ >T<6fpXuk2  
                                lpGeometry, Len(lpGeometry), _ ]UDd :2yt  
                                dwOutBytes, _ AY#wVy  
                                ByVal 0&) 6cM<>&e  
     >(X#<`  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack <fN; xIB  
    GetDiskGeometry = bResult =96
G8hlT  
End Function 0,HqE='w  
"\e:h| .G  
Public Sub GetDiskInfo(MediaType As Long, _ 7ftR4  
                        Cylinders As Long, _ 4-mVB wq  
                        TracksPerCylinder As Long, _ sLb8*fak  
                        SectorsPerTrack As Long, _ 4&Byl85q  
                        BytesPerSector As Long) S_J,[#&  
'//返回磁盘的参数 N_ UQ  
    MediaType = lpGeometry.MediaType t/}L36@+  
    Cylinders = lpGeometry.Cylinders.lowpart b"I~_CL|  
    TracksPerCylinder = lpGeometry.TracksPerCylinder \tY"BC4.  
    SectorsPerTrack = lpGeometry.SectorsPerTrack B[r<m J  
    BytesPerSector = lpGeometry.BytesPerSector {Fbg]'FQ
 
,V,f2W 4  
End Sub geksjVwP
H  
]kx
-,M(  
Public Property Get BufferSize() As Long 93j{.0]X  
'//返回每次读/写的缓冲大小 Yc^%zxub  
    BufferSize = lBufferSize 5sCFzo<=vh  
End Property a6%@d_A  
!O|ql6^;  
S}[l*7  
Public Function LockVolume() As Boolean v
?L  
'// 将卷锁定 X0`j-*,FX  
    Dim dwOutBytes  As Long KU-'+k2s;p  
    Dim bResult     As Boolean (8.{+8o  
     lsk_P&M  
    bResult = DeviceIoControl(hDisk, _ Q]@c&*_|  
                                FSCTL_LOCK_VOLUME, _ iOXZ]Xj5  
                                ByVal 0&, 0, _ LheFQ A  
                                ByVal 0&, 0, _ nX|Q~ x]  
                                dwOutBytes, _ zDD4m`2  
                                ByVal 0&) 6^)rv-L~5y  
    LockVolume = bResult ~.J,A\F  
End Function ._?V%/  
%SAw;ZtQ:  
Gav"C{G  
Public Function UnlockVolume() As Boolean @5xu>gKn  
'// 将卷解锁 w5 `#q&?  
    Dim dwOutBytes As Long YTK^ijmU6x  
    Dim bResult As Boolean B MM--y@  
     (89Ji'dc
  
    bResult = DeviceIoControl(hDisk, _ .20V 3  
                                FSCTL_UNLOCK_VOLUME, _ ow$q7uf  
                                ByVal 0&, 0, _ 'BY-OA#xJ  
                                ByVal 0&, 0, _ zJ+3g!  
                                dwOutBytes, _ 69-:]7.g  
                                ByVal 0&) }Dn^d}?s||  
    UnlockVolume = bResult OsQkA2=  
End Function CK0l9#g  
H3, ut  
Us,)]W.S  
Public Function DismountVolume() As Boolean 8'A72*dhX  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 K/txD20 O|  
    Dim dwOutBytes As Long afHaB/t{R  
    Dim bResult As Boolean [$pmPr2  
     8$0\J_  
    bResult = DeviceIoControl(hDisk, _ q*,Q5  
                                FSCTL_DISMOUNT_VOLUME, _ 9Hd;353Q  
                                ByVal 0&, 0, _ %%%S"$t  
                                ByVal 0&, 0, _ yEq#Dr  
                                dwOutBytes, _ ?7 \\e;j}  
                                ByVal 0&) B:< ]Hl$  
    DismountVolume = bResult Q$~n/  
End Function 'cV?i&;  
U&UKUACn"  
aBhV3Fd[B  
Public Function ReadDisk(ByVal Cylinders As Long, _  B/G-Yh$E  
                    ByVal Tracks As Long, _ /` [!_4i  
                    db() As Byte) As Boolean b O=yi)  
'//按柱面和磁道来读取磁盘数据 _%~$'Hy  
    Dim iPos    As Long P ZxFZvE  
    Dim lRead   As Long zvY+R\,in  
     +`B'r '  
    iPos = Cylinders * Tracks * lBufferSize  W^Y#pn  
     b7HffO O  
    If SeekAbsolute(0, iPos) Then w7FoL  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) lT'9u,6  
    End If .Pe9_ZH$W  
End Function ^rL_C}YBj-  
5{K}?*3hJ  
Public Function WriteDisk(ByVal Cylinders As Long, _ Gh}yb-$N`&  
                     ByVal Tracks As Long, _ <_Eg?ePW#  
                     db() As Byte) As Boolean i0:>Nk  
'//按柱面和磁道来写磁盘数据 }s_hD`'  
    Dim iPos    As Long Pao%pA.<  
    Dim lRead   As Long D'b#,a;V  
     I9Eu' ,  
    iPos = Cylinders * Tracks * lBufferSize ]5' d&f  
     er2cQS7R  
    If SeekAbsolute(0, iPos) Then z x@$RS+]  
        WriteDisk = WriteBytes(lBufferSize, db()) tu0aD%C  
    End If TW7:q83{l  
End Function 2# vv$YD  
d,0 }VaY=D  
TJ(K3/)Z  
'///////////////////////////////////////////////////////////////////////////////////// Zp&@h-%YoD  
'//file system H6K`\8/SeN  
 (gwj)?:  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean S|em[D[Y^  
'//seek file WA6!+G y  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte rkB'Hf  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) #]E(N~  
    If LowPos = -1 Then KL
 [ek  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) gd7^3q[$h  
    Else Y ya`&V  
        SeekAbsolute = True @%hCAm  
    End If }^-<k0A4?  
     S QY"OBo<e  
End Function c)}2K0  
4nqoZk^R  
EHn"n"Y  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean 0:=ZkEEeU  
'//read data to array M6rc!K  
    Dim RetVal    As Long HpVj
ee  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) #Yuvbb[  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF ,+`HQdq  
    ReadBytes = Not (RetVal = 0) L?5f+@0.  
      fvEAIs  
End Function Ep
Yy3^5d  
4-R^
/A0  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean +oc >S  
'//write data from array OtTBErQNF  
    Dim RetVal As Long -.IEgggf  
    Dim BytesToWrite As Long ]]0,|My7  
    Dim BytesWritten As Long >9H@|[C  
     R"AUSO|{  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) ;`dh fcU  
     :7g=b%;  
    WriteBytes = Not (RetVal = 0) C[uOReo  
End Function x%N\5 V1  

这才是我当年写出的一个比较烂的程序 $t~@xCi]S  
K_/zuTy  
Main2.bas :hRs`=d"r  
<7_KeOLJ  
Attribute VB_Name = "SubMain" e>}}:Ud  
Option Explicit 8RW&r  
!#2=\LUC  
'采集文件与临时文件 "TcW4U9  
Public Const TmpFile As String = "d:\30-0600.dat" p(F" /  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 ORN6vX(1  
)$Mmn  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long $((6=39s  
Public hBCFile As Long  '记录采集参数的文件 "O[j!fG8,  
Public Const TmpBMP As String = "d:\1.bmp" Oakb '  
Public hTmpFile As Long ])DX%$f  
o>Er_r  
bFS>)
 
'采集窗口参数常量 44ed79ly0)  
Public Const FrameH As Long = 280& N K]B?  
Public Const FrameW As Long = 768& Hr<o!e{Y  
Public Const pFrameSize As Long = FrameW * FrameH ccFn.($p?,  
m#vL*]c}  
'标志区范围，用于识别车辆 7nU6k%_%  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X 69K{+|  
Public Const mkW As Integer = 28  '识别标志立柱宽度 SqA J-_~  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) n5-)/R[z  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) .7NNT18  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 +rXF{@ l  
'车缝检测位置常数 '8Ztj  
Public Const sSize As Long = 32& !7bw5H  
Public Const sPos As Long = 310& FQz?3w&ia  
Public Const sPosL As Long = 200& zSEs?  
Public Const sPosR As Long = 500& h}`!(K^;3  
'车缝检测框位置 bx4'en#  
Public Slice(1 To sSize, 1 To FrameH) As Byte e({9]  
Public SliceL(1 To sSize, 1 To FrameH) As Byte }x0- V8  
Public SliceR(1 To sSize, 1 To FrameH) As Byte ^Xb7[+I6  
Public avSL As Integer, avSLR As Integer, avSLL As Integer ;Q;[*B=kE  
wC_l@7t  
&MZ$j46  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 Ny- [9S-<  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 %+>s#Q2d  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 >'uU)Y{  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long $~0Q@ ):  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte }@1q @xU  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 cF)/^5Z  
B
/JO~;{  
A- YBQPE  
{66sB{P  
'一次连续采集的帧数 7dG79H  
Public tFrames As Long tR0pH8?e"  
A>`945|  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 -|k)tvAm  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 !" #9<~Q,p  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize `:m!~  

J5p"7bc  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte PNOGN|D  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte $''?HjB
}T  
Public pWorkSpace(1 To FrameW * FrameH) As Long "@A![iP  
Public Const pBufferSize As Long = FrameW * FrameH * 2 Uxfl_@lJ  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 LVJI_O{fH  
]uj=:@  
Public hBoard As Long   '采集卡标识 cJo\#cr  
Public mBufferAddr As Long  '缓存地址 =]`lN-rYw  
Public BufferSize As Long  '缓存大小(字节) [H<bh%  
Public iCurrentCard As Long >_dx_<75&  
Public CapStatus As Long {5r0v#;  
Public iFrames As Long @`opDu!  
Public currentBr As Byte, currentContr As Byte M->*{D@a  
E/&Rb*3  
Public hMEM As Long, mStatus As Long 0Sq][W
=  
Public Const hMemSize As Long = pFrameSize * 4 9E2j!  
Public hMemWork As Long H=
*5ASc  
Public Const hMemWorkSize As Long = pFrameSize * 5 X,aYK;q%z  
aprm0:Q ^  
4/kv3rv  
PNF?;*`-{7  
'串口接收轨道衡数据 kE8>dmH23  
Public WeightFromCom As String oI:o"T77sA  
Public bReceiveComplete As Boolean s>k Uh  
zya5Jb:Sg  

*[ #;j$m  
Public Type GrayBMPHeader `\`>0hlu  
  Tag As Integer 3f" %G\  
  FileLength As Long    '文件大小 -oeL{9;  
  Reserve1 As Long PWRy7d  
  DataOffset As Long    '图像数据偏移量 *-W #G}O0  
  BMPHeaderSize As Long  '文件头长 VErv;Gy V  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… @vL20O.  
                        'the following sizes are possible: eI.2`)>  
                        '28h - windows 3.1x, 95, nt, … 7]xm2CHx5  
                        '0ch - os/2 1.x &8&d3EQ  
                        'f0h - os/2 2.x <~TP#uAz  
wbDM5%  
  ImageWidth As Long           '图像宽（像素数） /+*#pDx/zW  
  ImageHeight As Long          '图像高(像素数) NjPDX>R\K  
  PlaneNumber As Integer  '图像层数 )#|<w9uec  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap a,F&`Wg  
                                        '4 - 16 color bitmap <!-sZ_qq  
                                        '8 - 256 color bitmap %*aJLn+]_R  
                                        '16 - 16bit (high color) bitmap ]5~s"fnG  
                                        '24 - 24bit (true color) bitmap `RU[8@ 2%  
                                        '32 - 32bit (true color) bitmap _=ua6}Xp  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) ah @uUHB  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) \^(0B8|w  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) dkgSvi :!  
                                    '3 - bitfields (also identified by bi_bitfields) M.-"U+#aD  
  IMAGESIZE As Long  '图像数据字节数 g4`Kp;}&'  
  hResolution  As Long  '水平分辩率  像素数/米 5u
q3\a  
  vResolution  As Long  '垂直分辩率 iovfo2!hD  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 6u`F d#  
  ImportantColors As Long 0]
QRsVz+  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 F' U 50usV  
End Type >Vy>O&r  
y@
2epY?{  
b2 _Yu^  
dzK{ Z  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader nJ4@I7Sk;  
Public sRECT As RECT p4IZ   
? J}r  
$aHAv/&(5  
Public conn As ADODB.Connection CQel3Jtt.  
Public rsTrain As ADODB.Recordset 8
}H1_y-g[  
Public rsOperater As ADODB.Recordset 8[r9HC  
Public rsGoods As ADODB.Recordset W$U0[^1  
Public rsGood2 As ADODB.Recordset J PyOG_h  
Public rsSender As ADODB.Recordset (,^*So/  
Public rsReceover As ADODB.Recordset |qZ ko[W}=  
Public rsTrainTMP As ADODB.Recordset kGpa\c g1  
}$MN|s  
Wg{k$T_>  
'打开采集卡 #&v/icz$  
'设置参数 q~CA0AR  
'设置为实时单帧采集到缓存方式 ReiB $y6  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 qq)0yyL r  
y;mj^/SxK  
m)V/L]4  
Sub Main() DeR='7n  
  Dim i As Integer, status As Long AL$&|=C-$  
    
!O\;Nua  
   InitBMPinfo Vpy 2\wZWb  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 [
E#UGJ@  
    BMPHeader.Tag = &H4D42 '$4O!YI9@  
    BMPHeader.ImageWidth = FrameW #;n+YM">:  
    BMPHeader.ImageHeight = FrameH %r&-gWTQ,  
    BMPHeader.BMPHeaderSize = &H28 DD" $1o"  
    BMPHeader.PlaneNumber = 1 q$1PG+-  
    BMPHeader.bpp = 8 gaA<}Tp,  
    BMPHeader.Compression = 0 {G <kA(Lm  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 9/+Nj/  
    BMPHeader.vResolution = &H1274 i)#:qAtP*  
    BMPHeader.ColorsinBMP = 256 y/e2l  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP %WqNiF0-  
    BMPHeader.DataOffset = Len(BMPHeader) ^F?&|clM/  
    For i = 0 To 255 vR0];{  
      BMPHeader.Pallate(i) = RGB(i, i, i) E?(xb B  
    Next i A:(*y 2  
    BMPHeader.IMAGESIZE = FrameH * FrameW dKl^jsd  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE eC5$#,HiC  
Zm
OfEg|h\  
6wco&7   
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) l3N I$Zu  
     Oj<S.fi  
    BMP1.ImageWidth = FrameW 1ygpp0IGJ  
    BMP1.ImageHeight = FrameH * 2 dU\%Cq-G)  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight +,~z Wv1v  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE iU6Gp-<M,  
"V{yi!D{<  
  '确定标志位置,为pilarX, pilarY确定初始值 8|E'>+ D_-  
   PilarW = mkW )54%HM_$k  
   PilarH = mkH  '此两项为固定值 e><5Pr
)  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) XLMb=T~S  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 BBcV 9CGU  
   E\gim<]  
   q+B&orp  
  '连续采集记录文件 Z3[S]jC  
  ' 建立一个缓冲区为页对齐方式的文件 S+TOSjfis  
  If Dir(TmpFile) <> "" Then ~Lc066bLeq  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ GGhM;%H_99  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) {3N'D2N  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 Vh}SCUof'  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 Hw#d_P:  
  Else OL_{_K(w  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ 9
qS"uj  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) olLfko4$*V  
  End If 0%!rx{f#\  
  If hFile = 0 Then XZw6Xtn  
    MsgBox TmpFile & ": File Open Error", vbOKOnly b64 @s2]  
    Exit Sub + [Hh,I7  
  End If P0`Mdk371  
  '采集参数记录文件 n$xQ[4eH)  
hBCFile = FreeFile() JG{j)O|L  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile 6<K6Y5<6  
   L 8{\r$  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 7d92Pe  
If hMEM = 0 Then g$. \
  
    fStatus = GetLastError ''\;z<v  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ s=?g\oR  
     & "请向技术人员报告该错误代码。", vbOKOnly Ltjbxw"Qd  
    CloseHandle hFile ]*7Y~dO  
    Exit Sub &rkEK4  
End If ?\8?%Qk  
(C]o,7cYS  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) zhY+x<-  
If hMemWork = 0 Then hHqh{:q{v  
    fStatus = GetLastError oD}uOC}FS{  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ k6=nO?$  
     & "请向技术人员报告该错误代码。", vbOKOnly v]B L[/4  
     '释放已成功分配的内存 vkLC-Mzm<  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 0Z{j>=$  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) gm9mg*aM  
     lO2[JP  
    CloseHandle hFile r>GZ58i  
    Exit Sub i-yy/y-N  
End If sB69R:U;  
v&Kqq!DE  
' Test writing O Fj
e+S  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& RpLE 02U  
     =@F&o4)r  
   '初始化采集卡参数 r! Ay:r  
   iCurrentCard = -1 V.wqZ {G  
   hBoard = okOpenBoard(iCurrentCard) gW Y"w!f  
   Debug.Print hBoard dMR3)CO  
   If hBoard = 0 Then $%VuSrZ&  
      ExitGrabber h*ZC*eV>  
      End a<]B B$~  
   End If U-n; xX0=  
   okGetBufferSize hBoard, mBufferAddr, BufferSize :!zl^J;  
   If mBufferAddr = 0 Then *,BzcZ  
     MsgBox "缓存不存在！" k
o5V9Drc  
     ExitGrabber (knp#  
   End If 2w)-\/j}  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) l }XU5 9  
   };'\~g,1  
   ja=F7Usb  
   currentBr = 128: currentContr = 128 vM_:&j_?``  
   '设置视频输入参数 Zw wqSyuGf  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 d#2$!z#  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input !%dN
<%Ah  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 wcDRH)AW.  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 .f+TZDUO  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 r,_?F7  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 ]({~,8s  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） ePIiF_X  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) Q]p(u\ *  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) _HhbIU  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 l7
De6A"  
   Nan
[<  
   '设置采集参数 NH_<q"gT  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 M:5b4$Qh<  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 @3kKJ  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 ?`J[[",  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 }MUn/ [x  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 O{ /q-~_  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 r H~" 4  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 J*9 $;  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 H4]Ul eU  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 HYmn:?H  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 Ytg
j|@jsp  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 :kfp_o+J  
   UwC=1g U  
   l3 DYg  
   okCloseBoard hBoard BL&LeSa  
   Sleep 50 Xy%p"b<  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 u+{a8=  
   ,]b~t0|B  
   '设置数据传送方式 7 I >G{  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 }jill+]  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 tDAhyy73  
   sUPz/Z.h  
   sRECT.Right = -1   '用于获得当前设置值 trE{FT  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) C!7>1I~5  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom KN- avu_Ix  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 ]r_;dYa  
   sRECT.Left = 0 ;NlWb =  
   sRECT.Top = 0 }`+B=h-dW  
   sRECT.Right = sRECT.Left + FrameW 9(":,M(/o  
   sRECT.Bottom = sRECT.Top + FrameH * 2 /r_~:3F  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) }<'5 z qS  
   <id}<H  
   sRECT.Right = -1   '检查新设置值 [V:\\$  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) TwgrRtj'  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom tnLAJ+-M  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) fA89|NTSUh  
   ^wS5>lf7p  
   If TESTSignal = False Then U!Ek'  
      'ExitGrabber {/pm <k=  
   End If N!`e}Z6S  
   ul*Q
t}  
   d|4}obCt  
   yv) ux:P&+  
   '设为实时采集状态 2h%z ("3/  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) 4V~?.  
   CW<N: F.9  
   N]RZbzK_5G  
   '单帧采集 J:skJ.Wx  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 LiKxq=K  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) @gG<le6  
   okCaptureTo hBoard, BUFFER, 0, 1 'single '}Ri`  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 \rPbK+G.  
   '   Sleep 20 w|Nz_3tI  
   'Loop n[(Qr9  
   okGetCaptureStatus hBoard, True &5:tn=E  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize #h/Mbj~S  
   '写入768*576测试图象 m>SErxU(z  
   ArrayToBMP TmpBMP Uk\Id~xLV  
   |.wEm;Bz  
   '打开数据库 &?h,7 D;A  
   Set conn = New ADODB.Connection S6[v;{xJ  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ U#U]Pt

  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ Uo2GK3nT  
      "; Mode=Read|Write" EAeqLtFqs  
   conn.Open tY <Z'xA?  
  
@_z4tUP  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) t:fFU
1x  
   frmRecord.Visible = True *_?dVhxf  
   frmQuery.Visible = True zz& ?{vJ  
   Load frmReceiveFromComm @$T 9Ll  
   Gm\/Y:U  
   '调试参数 ~jsLqY*(+  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then `Qqk<o  
     SignalBox.Visible = True Ge<nxl<Bd  
   End If $HJwb-I  
   If InStr(UCase(Command()), "/COMM") > 0 Then vv=VRhwF  
     frmReceiveFromComm.Visible = True <vwkjCA`  
   End If GaSPJt   
gJM`[x`T  
End Sub ~,*b }O  
QD%L0;j  
Sub ExitGrabber() H@l}WihW  
  '关闭数据库 ]7e =fM9V;  
  '关闭采集卡 LQjsOo  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) ZI=v.wa  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) 6"}?.E$  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) 'e6WDC1Am(  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) -I=l8m6L  
  okStopCapture hBoard +a*tO@HG  
  okCloseBoard hBoard JY6 Qp  
  CloseHandle hFile E4hLtc^ +
 
  Close #hBCFile &~W:xg(jN  
  conn.Close {GJ@psG*  
  End q&d~ \{J  
End Sub 2,*M|+W~  
?Ae ven  
Function ArrayToBMP(ByVal File As String) R
Z+`T+zL  
Dim BytesWrite As Long `hb%+-lj+  
/d%=E  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ __.+s32SS$  
  CREATE_ALWAYS, 0&, 0&) G\(|N9^:  
!o$!Frc  
If hTmpFile = 0 Then QVtQx>K`  
   ArrayToBMP = False +!|9hF'  
   Exit Function M|Rb&6O  
End If %HJK;   
k-}b{  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN oJfr +3I  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& 7.`fJf?   
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN sM9+dh  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& -a-(r'Qc(  
1/"WD?a  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN l]5w$dded~  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& #t+d iR  
s-v  
If BytesWrite < pFrameSize Then /i77  
  ArrayToBMP = False nvPwngEQm  
End If +>PX&F  
=kuMWaD  
CloseHandle hTmpFile l'eyq}&  
=W'Ae,&  
End Function !/wtYI-`  
8-O)Xx}cU  
Function ArrayToBMP1(ByVal File As String) IC7M$  
S9
#)A->  
Dim BytesWrite As Long V5rST +  
,{ mCf^  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ %VnbmoO  
  CREATE_ALWAYS, 0&, 0&) 

o>VVsH  
f`Fi#EKT  
If hTmpFile = 0 Then R2 V4#  
   ArrayToBMP1 = False w`5xrqt@  
   Exit Function D gaMO,  
End If :ijAqfX  
hodgDrmO/  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN q|),`.eh\  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& vuYSVI2=H  
)+6MK(<"  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN eow'K 821A  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& F|!){=   
y`=]T>X&x  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN 5D'\b}*lJ}  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& <%"b9T`'  
ctGL-kp  
If BytesWrite < pBufferSize Then d m`E!R_  
  ArrayToBMP1 = False \o^2y.q:>  
End If lg&t8FHa;  
r >nG@A  
CloseHandle hTmpFile ^- d% r  
=
y-
@AU8  
End Function o !U 6?  
q7E~+p(>(  
'使用该过程建立的文件要求在用后关闭 5^x1cUB]  
Public Function ArrayToBMP2(File As String) As Boolean hyFyP\u]  
zOiu5  
Dim BytesWrite As Long 1aTB%F  
mrjswF27$o  
ArrayToBMP2 = True \*<d{gZ~  
q*>&^V$M  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ .qZI$ l.  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) O`<KwUx !  
=z /dcC$r  
If hTmpFile = 0 Then ZEx}$<)_  
   ArrayToBMP2 = False % S os  
   Exit Function J7g8D{4  
End If c3CWRi`LE  
sL$:
"=  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN .yEBOMNZ  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& _/tHD]um  
KGFv"u{  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN $\U4hHOo  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& .P"D  
q0zr E5  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN >o=-$gz`  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& T]c%!&^_  
n~V  ]Z  
If BytesWrite < pFrameSize Then BGX.U\uc  
  ArrayToBMP2 = False &:`U&06q  
End If @8I4[TE  
]@u6HH~^  
CloseHandle hTmpFile $ F5 b  
53n^3M,qK  
End Function #%h-[/  
{Sj9%2'M)  
Private Function TESTSignal() As Boolean LBZ+GB  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long h[@tZ(jrY  
W}mn}gTQ  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) q1KZ5G)6GJ  
FFEfI4&SfS  
If extsign = 1 Then N <Xq]! K-  
   TESTSignal = True D-._z:_  
Else |0f>aZ  
    If extsign = 0 Then 71t*%  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly 7](
KV"%V  
        TESTSignal = False jIyB  
        Exit Function Ev}C<zk*  
    End If OL^l 3F  
End If  #^A*  
fNW"+ <W  
'测试视频输入类型 @W"KVPd  
'video type }|8_9Rx0*  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 jr:7?8cH0L  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE)
Jh!I:;/  
If videotype = 1 Then AiO$<CS  
        '"隔行信号(Interlaced)" bl&nhI)w  
Else #$8%
w  
   If videotype = 0 Then &n8_0|gK  
       '"逐行信号(Non-interlaced)" *(T:,PY  
   Else $cU!m(SILQ  
     If videotype = -1 Then m3/O.DY%0  
       ' "不支持" R1$:~p2m  
     End If YF>m$?;  
   End If 9j6QX~,  
End If 2HsLc*9{4  
t,+nQ9  
'测试垂直扫描线数 |}di&y@-JI  
'video scanlines |$ lM#Ua  
scanlines = -1 85Otss/mM  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) z)r=+ -  
    If scanlines = -1 Then /k
,-P  
        ' "不支持" z?*w8kU&>  
    Else /~$WUAh  
        'Trim(Str(ScanLines)) + " 行数/幅" Tq[kl'_  
    End If LAS'u"c|  
lrIjJ V  
'测试帧频 -^hWM}F  
'video field frequency 8b;1FQ'  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) =E#%'/ A;c  
    If fieldfrq = -1 Then BdH-9n~,  
        'lblSignal(8) = "不支持" %2{%Obp'  
    Else Oagsoik  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" hFy;ffs.  
    End If i\r Du^VQ  
End Function &keR~~/  
x#xFh0CA  
7 *`h/  
Sub PicIdentify() `ux{;4q  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 Xx0hc 8qd  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 A
y0U=#XP  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 (Hb:?(  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 +{f:cea (1  
>8#X;0\Kj  
  Dim fPTR As Long, cFrame As Long _8F`cuyW  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer Ni-xx9)=  
     =k^Y?.  
dQA'($  
cFrame = 0 g'n7T|h ~  
jk[1{I/  
zv\kPfGDK  
Do While cFrame < tFrames 1e{IC=  
   sg3OL/"  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) n%.7h3  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) {CGUL|y  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 8h*Icf  
   8y.wSu  
  frmRecord.RText.Text = Str(cFrame) @] DVD  
  frmRecord.RText.Refresh R? "q]af~  
       B][U4WJ)  
  If CheckMark = True Then S79;^X  
   ArrayToBMP TmpBMP \kMefU  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) D"2& P^-  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" &-Gqdnc  
   i/`m`qdg  
   DrawSlice L>aLqQ3  
   qGB{7-ru  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) fY51:0{  
   'If i = vbNo Then ?kH8Lw~{5W  
   '  Exit Do CFMo)"  
   'End If gv-
xm  
   'cFrame = cFrame + 1 xRzFlay8  
   '}Z~JYa0  
  End If pm 9"4z  
  DoEvents Tz8PSk1[  
  cFrame = cFrame + 1 y[)>yq y  
Loop 5A3xVN=  
End Sub #mCL) [  
qzK dQ&vO  
W_\5nF  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean xqG[~)~  
aJbO((%$|u  
'如标志区模式反差存在则为TRUE，否则返回FALSE !h23cj+V  
:* Z4yx  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long x7!L{(E3  
CheckMark = True rrBsb -
 
   Ez fN&8E  
'复制标志区 ,*&:2o_r  
For i = 1 To mkH %InA+5s`  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW AQ,' 6F9  
Next i $0>60<J  
g" p%C:NN  
For j = 1 To PilarW * PilarH / 2 Mh:L$f0A%O  
   mTop = mTop + MKpilar(j)
zuJ@E=7  
Next j =JK@z  
#*K}IBz  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH e4 78U$  
   mBot = mBot + MKpilar(j) /_An P  
Next j p6#g;$V$  
Eg#K.5hJ  
mTop = mTop / PilarW / PilarH * 2 NV72  
mBot = mBot / PilarW / PilarH * 2 * KDI}B>  
8pIP  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 jHE}qE~>5  
{GK;63`1  
'平均值极值化 i@)i$i4
  
  For j = 1 To PilarH * PilarW =S+wCN  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) v1+3}5b'uF  
  Next j 93("oBd[s(  
   m.# VYN`+A  
mTop = 0: mBot = 0 5HkKurab  
For j = 1 To PilarH * PilarW / 2 ~962i#&4  
  mTop = mTop + MKpilar(j) (_mnB W  
Next j Dwr)0nk  
"55skmD.P  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW c dl&9-}  
  mBot = mBot + MKpilar(j) )U7t  
Next j k;AD`7(=  
F4}]b(L  
? (Dq?-.  
  mTop = mTop / PilarH / PilarW * 3 =jOv] /  
  mBot = mBot / PilarH / PilarW * 3 "U>JM@0DNm  
   -D  
Tc>  
If mBot > iWhite And mTop < iBlk Then QwJVS(Gs4  
  CheckMark = True cl=EA6P\X  
Else r~jm`y  
  CheckMark = False G'Q-An%z  
End If "GMBjT8  
End Function PV'x+bN5  
*'.|9W  
Sub Capture1Frame() f332J  
   okCaptureTo hBoard, BUFFER, 0, 1 'single 5cL83FQh  
   okGetCaptureStatus hBoard, True K6v6yn p/  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize Z_};|B}  
End Sub p*4':TFuD;  
7~^GA.92  
WM7oM~&{6  
Sub CopyMark(iBlk As Integer, iWhite As Integer) %Gz0^[+  
'复制标志区并返回标志区暗区与亮区的亮度平均值 jnKWZ/R  
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 R_W+Ylob  
   Vd,jlt.t  
'复制标志区 Fq~yL!#!  
For i = 1 To mkH
GK)?YM  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 0QXVW}`hz  
Next i ZRh~`yy  
-3t7*  
For j = 1 To mkW * mkH / 2 qT{U(  
   mTotal = mTotal + MKpilar(j) 8=B|C'>  
Next j s C%&cRQD  
n$xc];j  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 ww\CQ6/h  
;f0I 8i,JN  
mTotal = 0 ov`h  
For j = mkW * mkH / 2 + 1 To mkW * mkH [842&5Pd?  
   mTotal = mTotal + MKpilar(j) +7D|4  
Next j &=Ar  
WejYy|  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 bv]`!g: C  
bH7X'%r  
'背景亮度 :|V$\!o'U  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW p4.wh|n  
  For i = 1 To 4 * FrameW ieDk;  
    bsTotal = bsTotal + BsLine(i) q0i(
i.h  
  Next i 2,$8icM  
  bsAV = bsTotal / FrameW / 4 V wg
|K|  
!;&p"E|b#  
End Sub l2zFKCGF(  
Zd^rNHhA  
]i&6c
  
Sub AdjIMGbright(Optional bInit As Boolean = True) cs,N <|  
3}TaF~  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） ck ]Do !h  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 BZ94NOOdw  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 zT=Ho   
     _E&A{HkJ  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer b
#uL?f  
   Y;dz,}re  
  '按标准亮度与对比度采集一帧，确定背景亮度 :1cV;gJ  
  currentContr = 128   '初始对比度 @Lpq~ 1eZB  
  currentBr = 128   '初始亮度 >BIMi^  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 8'r2D+Vwm  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ?*[N_'2W+  
  DoEvents q@QksAq  
  Capture1Frame AF;)#T <  
  '获得图像上缘4行象素 W98i[Q9A7  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW tvkb~  
  CopyMark iBlack, iBright   '图像标志区亮度 ] bM)t<  
  For i = 1 To 4 * FrameW Y>|B;Kj0(  
    bsTotal = bsTotal + BsLine(i) YIn',]p:  
  Next i 1L%CJ+Q#0i  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 5gH1.7i b  
   .*@;@06?
 
  Select Case bsAV *g:4e3Iy  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 wKtl+}}  
       currentBr = 150 x5,++7Tz  
       currentContr = 60 C]O(T2l{l  
     Case 61 To 80   '有可见背景 W]"zctE  
       currentBr = 140 q MfT>rH  
       currentContr = 70 x[wq]q#*  
     Case 81 To 100  '有清晰背景 -[*,^Ti`  
       currentBr = 128 q-[@$9AS  
       currentContr = 80 ypbe!Y<i]  
     Case 100 To 150  '有明亮背景 UldXYtGe  
       currentBr = 140                '5:30-6:00钟实测数据 9TgIB  
       currentContr = 50 5L+>ewl  
     Case 151 To 180 zvYq@Mhr  
       currentBr = 130 CY 4gSe?  
       currentContr = 60 ;,C)
!c&  
     Case 181 To 220  '背景全为白色 s>B5l2Q4  
       currentBr = 110 9oyE$S h]  
       currentContr = 130 0t^M3+nc  
     Case 221 To 255  '背景全为白色 YZLkL26[  
       currentBr = 100 <{dVKf,e  
       currentContr = 100 %q/62f 7?  
  End Select _Z
p}?b5Q  
   4,bv)Im+ `  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 oibsh(J3  
        Case 100 To 150 54gBJEhg  
          currentBr = currentBr - 10 p#ol*m5wE  
        Case 151 To 255 **w!CaqvY  
          currentBr = currentBr - 20 ?Nup1! D  
  End Select ^nT/i .#_  
   ' KWyx  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 %824Cqdc  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 09X01 X[  
End Sub u!!Y=!y*<  
B8nf,dj?X  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) ^!<U_;+  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long Ff$L|  
     bx#>BK!  
    For i = 1 To 8 PXK7b2fE.  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& ~+Rc}K  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& kW2sY^Rg  
    Next i ^Ew]uN>,  
     y~B h  
    For j = 1 To 1024 nGpXI\K  
      L1 = L1 + LeftBK(j, 0) @)UZ@ ~R  
      L2 = L2 + LeftBK(j, 1) W3]_m8,Z  
      R1 = R1 + RightBK(j, 0) X\]L=>]C  
      R2 = R2 + RightBK(j, 1) G! ]k#.^A,  
    Next j .GsV>H  
    diffL = Abs(L1 - L2) / 1024 Nh8Q b/::  
    diffR = Abs(R1 - R2) / 1024 sd,J 3  
End Sub c& r70L,  
TC@s  
Function CheckSlice() As Boolean "9m2/D`=  
  CopySlice avSL, avSLR, avSLL ujDd1Bxf?  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then HFKfkAl  
    CheckSlice = True @KWb+?_H{<  
  Else @E;=*9ek{u  
    CheckSlice = False p31NI f`  
  End If  J}htu  
End Function LIS)(
X<]?  

whmdcVh.  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) x*![fK  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long -d~4A  
  For i = 1 To FrameH b=g8eMm  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize Lrta/SU*  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize dU6ou'pf  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize t
a35 K"  
  Next i 2"0es40;0  
  For i = 1 To FrameH >z/#_z@LV  
    For j = 1 To sSize 33o9Yg|J~  
       total = total + Slice(j, i) Of-Rx/
 
       totalL = totalL + SliceL(j, i) di?K"Z>  
       totalR = totalR + SliceR(j, i) bt"W(m&f  
    Next j ge,H-8'Z  
  Next i x^HGVWw_  
  avSL = total / FrameH / sSize Z,RzN5eN  
  avSLR = totalR / FrameH / sSize 'z0:C
cbj  
  avSLL = totalL / FrameH / sSize hU
(umL<  
End Sub 8J=?5  
19&<|qTz  
Sub DrawSlice() MC?,UDNd%  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B vX{J' H]u  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B :9O#ObFR  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B w:%o?pKet1  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) T?:Rdo!:u  
End Sub A'j;\ `1  
Sub DrawMark(pic As Control) H(R1o~  
   Dim i As Long, j As Long GS0;bI4ay  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B _
4rFEYz$d  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B VYu~26Zr  
   For i = 1 To PilarH a K&b{d  
     For j = 1 To PilarW {\
S+#W\  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) >7wOoK|1'  
     Next j Ozw;(fDaU  
   Next i #Vl 0.l3  
End Sub QP@%(]fG  
NhfJ30~  
Function avIMG() As Integer jq-p;-i  
  Dim i As Long, j As Long, totalIMG As Long 5\N(PL  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize r#+d&.|  
  For i = 1 To pFrameSize Qt iDTr  
    totalIMG = totalIMG + pBuffer(i) NV)!7~r}:  
  Next i fdxLAC  
  avIMG = totalIMG / pFrameSize ~"!]
3C,L  
End Function &)8:h+&Z  
8B7cBkl:  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer Y,GU%[+  
  Dim i As Long, j As Long, totalIMG As Long `NnUyQ;T
 
  For i = 1 To FrameH e&simX;W  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth CKtB-a  
  Next i o4`hY/<t  
  For i = 1 To FrameH * barWidth c]$i\i#  
    totalIMG = totalIMG + pBuffer(i) ,oN8HpGs  
  Next i k>F'ypm  
  avRegion = totalIMG / pFrameSize m`IC6
*  
End Function +awW3^1Ed  

一共这么多文件。 e8y;.D[2  
vbkI^+=,YY  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 D Gr> 2  
第6车皮 ,O.3&Nz,c  

qgE 73.!`6  
ML:Q5 ^`  
第9车皮 ^w(p8G_-w  
cYFiJJLG]  
  

从这里里分离出来的。

vlY83mU.  
%77v'Pz1  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 q'fZA;  
DD{-xCCR  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ Fuq ;4UcbL  
pyJY]"UHVE  

继续填个坑： H]As2$[  
R~ n[g  
用VBA控制WORD自己修订学生毕业文的格式。 "H\1Z,P<m