引用

引用第20楼newport93于06-14-2010 13:47发表的  : V')0 Mr  
sH\5/'?  
老五，I 服了U。 ToYAW,U[d  
`-LGU7~+  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 s.8{5jVG  

)=Jk@yj8x  
r&FDEBh  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! v0L\0&+  

引用

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

kwsp9 0)  
S{3 nM<  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : <m'ow  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 Ps<d('=  

c_>f0i  
yDGVrc'  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 k?7 X3/O  
fDP$ sW  
可以从宽不？

引用

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

.(WQYOMl0  
QNl'ZB\  
其实标题没有什么，卡总既然改了就不必再改回了。 x L" |)A =  
QeK*j/  
主要是当初写的时候真是顶着锅盖写的。 !Xph_SQ!B=  
}m-FGk  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : 'u1?tQ=gmk  
哦, 打倒忽悠大家的家伙.      Ez-[ )44/  

qhz]Wm P   
.uk>QMs1  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : a)'5Nw9*  
每个人的故事对其他人都是故事, o$Z6zmxO  
自己的故事也是其中之一. JQ@E>o7_  
跳出来看, UTH_^HAN#G  
不过是众人中的一个人的故事. _&b4aW9<  
McQe1  
所以,接着听故事. " _ka<R..  
Z7?~S
2{c  
女人们有兴趣的就等老伍开个新帖或者跟贴, 2FW\O0U  
听他痛说恋爱革命历史.... CtSl  
wL:flH@  
杂家接着听他自学程序员历史, `6xkf&Kt  
高级程序员考了吗? LmnymcH  

@>U-t{W  
& J2M1z%  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ xsMBC  
F;<xnC {[  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 9*1,!%]  
XUlS\CH@{  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 <>aw 1WM+  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : d*%`!G  
引用第19楼伍胥之于06-14-2010 12:33发表的  : pxh"B\"4*  
F ;2w1S^  
7G>d TO  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 ~15N7=wCM  
]n~ilS.rkl  
我连一级也没有考过。 3skC$mpJHw  
. Tap.5jHL  

Ot6aRk  

引用

%s(k_|G+4  
矬子里拔将军... MfWyc_  
你们那里的俗语是吧? +y3%3EKs1~  
b7p@Dn?E  
我们这里说"矮子里拔长脚"..应该是同一个意思... d5gR"ja  
LBa[:j2  
有趣....各地有表达意思一样却方式不同的俗语.... S_IUV)  
xe` </  
1BpiV-]=  
你的文章写的有脸皮,没屁眼的, 4QIX19{"  
让看客大为不满... xM&Wgei]10  
PU^l.  
你等着,,估计你以后接到的午夜凶铃就多了... CyXRi}W.  

K8UP,f2  
lUvpszH=  
我到现在也没有接到你的午夜凶铃呢！ ub\MlSr  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : Yd=
>K HVD  
伍SIR，再次抱拳佩服 qfMo7e@6*  

s)6U_  

B=^)Ub5'  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : 5BlR1
*  
佩服，玩也玩得这么专业！ ,>0*@2
 

j)/nKh4O  
IpcNuZo9&  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : ;h*K}U  
C1m]*}U  
介个真的看不懂。 =WyZX 7@R  
你说你老啦，喜欢怀旧了，才想起来填坑。 FtfKe"qw  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 SEGri#s  

->y J5smtY  
w&o&jAb-M  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 ,!Z
*5  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ DRp~jW(\y  
DWORD dwCB; Rv$[)`&T  
LARGE_INTEGER  offset; X[PZg{   
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); Z{ X|6
.  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); QgU8s'e  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ {B?Wu3-  
DWORD error = GetLastError(); tG9BfGF  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); bzuEfFaL  
return FALSE; Ay 5i+)MD  
} 4W#vP
  
return TRUE; V )x$|!(  
} ER5gmmVP@p  

'VB 6.0 版 G~2jUyv  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 j.w@
(<=x  
m'6&9Ja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 bm?sbE  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long  -QM: q  
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 ]B%v+uaW  
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 toy a fHf  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long zF8dKFE~  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 kb{]>3 Y"  
5I y;oZ  
7VqM$I  
Private Const GENERIC_READ = &H80000000 f]`#J%P  
Private Const GENERIC_WRITE = &H40000000 C":32_q  
JEahG zO  
Private Const FILE_SHARE_READ = &H1 wVicyiY]  
Private Const FILE_SHARE_WRITE = &H2 ;#xmQi'`  
Private Const OPEN_EXISTING = 3 *W0y: 3dB3  
^;Y|3)vvB  
Private Const INVALID_HANDLE_VALUE = -1 6K-_pg]  
jkiFLtB@V  
'//file seek T
Z(cu>  
Private Const FILE_BEGIN = 0 % NA9{<I  
Private Const FILE_CURRENT = 1 w)kNkD  
Private Const FILE_END = 2 P"y`A}Bx  
#sPHdz'3M  
Private Const ERROR_SUCCESS = 0& aqRhh=iS  
E9Np0M<  
'//device io control +*ZO&yJQ^<  
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 hbzC#@q  
Y;@>b{s  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 hyCh9YOu)  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 @SJL\{_  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 7\$qFF-y  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 XC0bI,Fu,  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C 4)h]MOZ  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 #{?PbBE}  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F B$ajK`x&I  
8\^}~s$$A
 
'//type DcoX+8 7  
Private Type LARGE_INTEGER 9[b<5Llt  
    lowpart As Long -xSA  
    highpart As Long tyXuG<  
End Type _=Z,E.EN  
)uj Ex7&c  
Private Enum MEDIA_TYPE Zhh2v>QOy  
    Unknown Hfwq/Is  
    F5_1Pt2_512 &]e'KdXF  
    F3_1Pt44_512 2N~Fg^xB  
    F3_2Pt88_512 ~P8tUhff
K  
    F3_20Pt8_512 q>$ev)W  
    F3_720_512 "HElB9  
    F5_360_512 L+Xc-uv["p  
    F5_320_512 iYORu3  
    F5_320_1024 (l-tvk4Ln  
    F5_180_512 @kpv{`Y  
    F5_160_512 NdtB1b  
    RemovableMedia =XucOli6  
    FixedMedia !sDh4jQ`  
End Enum Q&wB$*u  
{QHVo#  
Private Type DISK_GEOMETRY PP;}e  
    Cylinders           As LARGE_INTEGER ^W' fA{sr  
    MediaType           As MEDIA_TYPE S1p;nK  
    TracksPerCylinder   As Long y#Fv+`YDl  
    SectorsPerTrack     As Long T (O
W  
    BytesPerSector      As Long # {w9s0:  
End Type f&eK|7J_Yf  
/<@SFF .  
'//private vars [ oL.+  
Private hDisk           As Long             'disk handle W-x?:X<}  
Private lpGeometry      As DISK_GEOMETRY    'disk info !46RGU:I  
Private lBufferSize     As Long             'the buffer size of read/write Gn|F`F  
{QcLu"?c  
Public Function OpenDisk(ByVal FileName As String) As Boolean uD1e!oU  
'// 打开磁盘 s}UjGFP  
    hDisk = CreateFile(FileName, _ 4L ;% h  
                        GENERIC_READ Or GENERIC_WRITE, _ 4]G?G]lS>  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ +Z7th7W/,  
                        ByVal 0&, _ n[T[DCQ,  
                        OPEN_EXISTING, _ '(f&P=[b  
                        0, _ q qpgy7  
                        0) #MX'^RZ>2  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) x_|UPF  
End Function u<3HQ.:;  
ORyE`h
 
Public Function CloseDisk() As Boolean uw[<5  
'//关闭磁盘 Z*y`R XE  
    CloseDisk = CloseHandle(hDisk) 9N9L}k b  
End Function //T>G_1  
!>{G,\^=pT  
Public Function GetDiskGeometry() As Boolean {["\.ZS|  
'//获取磁盘参数 rR9|6l 3  
    Dim dwOutBytes      As Long t]y D-3'l&  
    Dim bResult         As Boolean ??PC k1X  
     [5zx17'  
    bResult = DeviceIoControl(hDisk, _ %\D)u8}  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ o.w\l\  
                                ByVal 0&, 0, _ ,sA[)wP{  
                                lpGeometry, Len(lpGeometry), _ ?nofUD.  
                                dwOutBytes, _ <j&DK2u=i  
                                ByVal 0&) #33fGmd[  
     ]+|~cRQ9I  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack @
hJ
%@(  
    GetDiskGeometry = bResult Q<h-FW8z  
End Function mL{B!Q  
b8V~S'6VqO  
Public Sub GetDiskInfo(MediaType As Long, _ 9K5pwC\$%  
                        Cylinders As Long, _ $FlW1E j  
                        TracksPerCylinder As Long, _ o7J  
                        SectorsPerTrack As Long, _ Gb8D[1=u=  
                        BytesPerSector As Long) 'MEz|Z  
'//返回磁盘的参数 /2UH=Q!x4E  
    MediaType = lpGeometry.MediaType c_
-drS  
    Cylinders = lpGeometry.Cylinders.lowpart [s"O mA y4  
    TracksPerCylinder = lpGeometry.TracksPerCylinder |B'9\OkP[=  
    SectorsPerTrack = lpGeometry.SectorsPerTrack DF1I[b=]  
    BytesPerSector = lpGeometry.BytesPerSector X%Z{K-  
bSfpbo4(  
End Sub $}J5xG,}$  
`tHvD=`m.  
Public Property Get BufferSize() As Long 5b!vgm#])  
'//返回每次读/写的缓冲大小 BGOuDKz9C  
    BufferSize = lBufferSize b7NM#Hb
 
End Property UUzYbuS>&l  

jT8#C=a7  
g .onTFwN  
Public Function LockVolume() As Boolean i=i(%yQ%  
'// 将卷锁定 mz@T  
    Dim dwOutBytes  As Long J?RabYd ~  
    Dim bResult     As Boolean "}q@Y=  
     N}pw74=1  
    bResult = DeviceIoControl(hDisk, _ jX3,c%aQ5e  
                                FSCTL_LOCK_VOLUME, _ }`W){]{kO  
                                ByVal 0&, 0, _ \R|4( +]x  
                                ByVal 0&, 0, _ dRj|g  
                                dwOutBytes, _ 8Eakif0CO  
                                ByVal 0&) .q%WuQw  
    LockVolume = bResult .q `Hjmg<  
End Function giZP.C"0  
gCioq.  
-R57@D>j\  
Public Function UnlockVolume() As Boolean 2q3+0Et8  
'// 将卷解锁 :YXX8|>  
    Dim dwOutBytes As Long iz8Bf;  
    Dim bResult As Boolean Gnfd;. (.  
     Cnbz=z  
    bResult = DeviceIoControl(hDisk, _ :uWw8`  
                                FSCTL_UNLOCK_VOLUME, _ #0ETY\}ZD  
                                ByVal 0&, 0, _ [z9`)VIe  
                                ByVal 0&, 0, _ ]8Q4B W  
                                dwOutBytes, _ Pl=ZRKn  
                                ByVal 0&) \hBG<nH{0  
    UnlockVolume = bResult R_sr?V|"  
End Function b~'"^ Bts*  
62O.?Ij  
E"+Q
J~!  
Public Function DismountVolume() As Boolean `S6x<J&T\/  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 i\KQ!f>A  
    Dim dwOutBytes As Long RRRCS]y7$t  
    Dim bResult As Boolean JHz [7  
     ~-EOjX(X'E  
    bResult = DeviceIoControl(hDisk, _ Min ^>  
                                FSCTL_DISMOUNT_VOLUME, _ S`#w+C#EW  
                                ByVal 0&, 0, _ <F}_ /q1  
                                ByVal 0&, 0, _ =x< ge_Y  
                                dwOutBytes, _ AWP"b? ^G|  
                                ByVal 0&) RoU55mL  
    DismountVolume = bResult oASY7k_3  
End Function .Xce9C0SW  
k\WR ]  
o Z%9_$Z  
Public Function ReadDisk(ByVal Cylinders As Long, _ |/09<F:L[  
                    ByVal Tracks As Long, _ Zb1<:[  
                    db() As Byte) As Boolean Qp/QaVQ+  
'//按柱面和磁道来读取磁盘数据 i'9vL:3  
    Dim iPos    As Long t.laO. 3  
    Dim lRead   As Long H*[M\gN$  
     ?L yxw]  
    iPos = Cylinders * Tracks * lBufferSize k Mu8"A z  
     &?q/ 1vLa  
    If SeekAbsolute(0, iPos) Then JBJhG<J  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) P"W2(d  
    End If x7~r,x(xM  
End Function p1&b!*o-&  
LL2=&VK  
Public Function WriteDisk(ByVal Cylinders As Long, _ BReJ!|{m}  
                     ByVal Tracks As Long, _ Z?%zgqTXb  
                     db() As Byte) As Boolean xZ6~Ma2z  
'//按柱面和磁道来写磁盘数据 h{
AII  
    Dim iPos    As Long kuol rfGB  
    Dim lRead   As Long e6d<dXx  
     #=6E\&NC  
    iPos = Cylinders * Tracks * lBufferSize 5[A@gw0u  
     ^c&L,!_)H  
    If SeekAbsolute(0, iPos) Then kL $!E9  
        WriteDisk = WriteBytes(lBufferSize, db()) N'g>M
BdI  
    End If |QU <e  
End Function nq6@6GRG  
c17_2 @N  
R $&o*K`?  
'///////////////////////////////////////////////////////////////////////////////////// \~fONB Y  
'//file system xn5l0'2
 
W0l,cOOZJ  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean ^ q<v{_  
'//seek file KO]T<R h<  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte poToeagZ~Q  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) l y(>8F  
    If LowPos = -1 Then }HY-uQ%@g  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) So0f)`A  
    Else OU8Lldt  
        SeekAbsolute = True H`0|tepz  
    End If !{^PO<9  
     ,QcF|~n  
End Function $4/yZaVb  
d5oI
H  
kg 'o&^/=  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean j#+!\ft5  
'//read data to array z"0I>gl  
    Dim RetVal    As Long KTP8?Q"n0  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) ?)u@Rf9>  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF Jh ]i]7r  
    ReadBytes = Not (RetVal = 0) Ed_N[I   
     G5CI<KRK#  
End Function
)rekY;  
13@|w1/Z  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean @>p<3_Y1  
'//write data from array BZR:OtR^  
    Dim RetVal As Long {buo^kgj`]  
    Dim BytesToWrite As Long NdzSz]q}  
    Dim BytesWritten As Long hRs&t,{&  
     O*0l+mop  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) kP-3"ACG  
     m^bNuo  
    WriteBytes = Not (RetVal = 0) 8=gjY\Dp  
End Function ^R# E:3e  

这才是我当年写出的一个比较烂的程序 T~Gvp0r}h  
K%^V?NP*{Z  
Main2.bas }Q=!Y>Tc  
jpO7'ivG  
Attribute VB_Name = "SubMain" R)mu2^  
Option Explicit hRK/T7v  
-(f)6a+H  
'采集文件与临时文件
A1.7O  
Public Const TmpFile As String = "d:\30-0600.dat" Of4^?` ^  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 vSi.t
xV2  
hFH*B~*:#  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long " N9 <wU  
Public hBCFile As Long  '记录采集参数的文件 Uc@
Ao :  
Public Const TmpBMP As String = "d:\1.bmp"
)i!o8YB  
Public hTmpFile As Long g7OqX \  
'H \9:7  
H;YP8MoQ  
'采集窗口参数常量 R}q>O5O  
Public Const FrameH As Long = 280& HbXPok  
Public Const FrameW As Long = 768& Yy)tmq  
Public Const pFrameSize As Long = FrameW * FrameH
uf&myV7  
. r[Hu40p  
'标志区范围，用于识别车辆 +\F'iAs@  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X :9^;Qv*  
Public Const mkW As Integer = 28  '识别标志立柱宽度 cd$m25CxC  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) 0V'nK V"|  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) { S3ZeN,kZ  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 {TX]\uf G  
'车缝检测位置常数 Fsif6k=4  
Public Const sSize As Long = 32& vTlwRG=5  
Public Const sPos As Long = 310& %Ti}CwI`  
Public Const sPosL As Long = 200& !V i@1E  
Public Const sPosR As Long = 500& 1 D<_
N  
'车缝检测框位置 Si6al78  
Public Slice(1 To sSize, 1 To FrameH) As Byte X@K-^8  
Public SliceL(1 To sSize, 1 To FrameH) As Byte .HkL2m  
Public SliceR(1 To sSize, 1 To FrameH) As Byte ha(Z<  
Public avSL As Integer, avSLR As Integer, avSLL As Integer cm&I* 0\  
t.`@{R$hoA  
YKO){f5  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 bO'Sgc[]  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 fjs [f'L  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 `Ye\p6v!+  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long w*oQ["SL  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte E|6VX4`+  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 SVO3821  
QlO0qbG[y  
@U3Vc|  
}j*KcB_  
'一次连续采集的帧数 vK_?<>  
Public tFrames As Long QA5QweL  
(^u1~1E 5  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 A-T]9f9  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 Xq
W@rU  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize p;t
Vn{u  
V3c l~  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte CS==A57I  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte DGAX3N;r6{  
Public pWorkSpace(1 To FrameW * FrameH) As Long E#ul IgD  
Public Const pBufferSize As Long = FrameW * FrameH * 2 ]>~)<   
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 w8S p<6*  
%jJ>x3$F  
Public hBoard As Long   '采集卡标识 @8;W\L$~1  
Public mBufferAddr As Long  '缓存地址 3b+d"`Y^S  
Public BufferSize As Long  '缓存大小(字节) E}40oID  
Public iCurrentCard As Long +eFFSt  
Public CapStatus As Long $!8-? ?ML  
Public iFrames As Long ev#;t@^
 
Public currentBr As Byte, currentContr As Byte <
iH`rP#  
=gJb^ Gx(w  
Public hMEM As Long, mStatus As Long ?q;Fp  
Public Const hMemSize As Long = pFrameSize * 4 K)Q]a30  
Public hMemWork As Long $`z)~6'  
Public Const hMemWorkSize As Long = pFrameSize * 5 d*~ICir7  
ML( Eo  
]cGA~d  
YRh BRE  
'串口接收轨道衡数据 z#]Jv!~EPE  
Public WeightFromCom As String t4-pM1]1_  
Public bReceiveComplete As Boolean (fCXxyZrr  
(&+kl q  
k; w- E  
Public Type GrayBMPHeader B,TB3 {  
  Tag As Integer uW M{JEOl  
  FileLength As Long    '文件大小 j}~86JO+Cw  
  Reserve1 As Long p' +  
  DataOffset As Long    '图像数据偏移量 { T-'t/0e(  
  BMPHeaderSize As Long  '文件头长 BPdfYu,il  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… lJE93rXU  
                        'the following sizes are possible: BbgnqzU  
                        '28h - windows 3.1x, 95, nt, … LAd\ Tvms  
                        '0ch - os/2 1.x )0Me?BRp  
                        'f0h - os/2 2.x ++V=s\d7  
<-,gAk)u  
  ImageWidth As Long           '图像宽（像素数） U2ZD]q  
  ImageHeight As Long          '图像高(像素数) XI22+@d6  
  PlaneNumber As Integer  '图像层数 3>R#zJf  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap ; =X P&  
                                        '4 - 16 color bitmap { Fawt:  
                                        '8 - 256 color bitmap K)\M5id]  
                                        '16 - 16bit (high color) bitmap }MHCd)78b  
                                        '24 - 24bit (true color) bitmap TW[_Ko86  
                                        '32 - 32bit (true color) bitmap >|twyb  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) /XhIx\40l  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) 5lm<%  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) )tl.
s)"N  
                                    '3 - bitfields (also identified by bi_bitfields) 2UFv9  
  IMAGESIZE As Long  '图像数据字节数 6bBB/yd  
  hResolution  As Long  '水平分辩率  像素数/米 hA33 K #bC  
  vResolution  As Long  '垂直分辩率 (Nx;0"5IX  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 |=$-Wu  
  ImportantColors As Long /Rg*~Ers *  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 J,AR5@)1  
End Type 4)U.5FBk )  
> 3&: 5  
1. rj'  
.R9IL-3fO  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader K00 87}H  
Public sRECT As RECT l PK +$f$  
Qt/8r*Oe  
V}SBuQp"  
Public conn As ADODB.Connection }w1~K'ck}>  
Public rsTrain As ADODB.Recordset 3AsT
  
Public rsOperater As ADODB.Recordset sK7+Q  
Public rsGoods As ADODB.Recordset 1;mW,l'`  
Public rsGood2 As ADODB.Recordset rxy&spX  
Public rsSender As ADODB.Recordset \U[{z&]~  
Public rsReceover As ADODB.Recordset /ig:9R  
Public rsTrainTMP As ADODB.Recordset Q)LM-ZJKQ  
T)Y=zIQ1]7  
dO4
{|(z  
'打开采集卡 2EfF
=Fm>  
'设置参数 lhw()u  
'设置为实时单帧采集到缓存方式 !kE-_dY6)  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 `~ * @q!  
lhw ,J]0*  
|Tm!VFd  
Sub Main() hrhb!0  
  Dim i As Integer, status As Long ;~\MZYs3m  
     H<}^'#"p  
   InitBMPinfo qt;y2gf=  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 ~d6DD;`K  
    BMPHeader.Tag = &H4D42 LWHd~ "eU  
    BMPHeader.ImageWidth = FrameW #_(jS+lP?k  
    BMPHeader.ImageHeight = FrameH l"2OP6d  
    BMPHeader.BMPHeaderSize = &H28 ^",ACWF4Sk  
    BMPHeader.PlaneNumber = 1 =Q[b'*o7  
    BMPHeader.bpp = 8 L30$%G|  
    BMPHeader.Compression = 0 opJMS6%r  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 1f8GW  
    BMPHeader.vResolution = &H1274 y^}6!>Ou:  
    BMPHeader.ColorsinBMP = 256 QCX8IIHG  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP ^1L >l9F  
    BMPHeader.DataOffset = Len(BMPHeader) H8`(O"V  
    For i = 0 To 255 ##EYH1P]  
      BMPHeader.Pallate(i) = RGB(i, i, i) Hv\-_>}K  
    Next i $pFo Rv  
    BMPHeader.IMAGESIZE = FrameH * FrameW d\ ~QBr?  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE ;Hj~
n+  
XLH+C ]pfr  
ODC8D>Z
Yl  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) H)>;/#!r-  
     tc!wLnhG  
    BMP1.ImageWidth = FrameW yZ7,QsEsN  
    BMP1.ImageHeight = FrameH * 2 Ldl5zc  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight YJl("MZ  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE Ie4hhW  
E Kz'&Gu  
  '确定标志位置,为pilarX, pilarY确定初始值 [fKUyI Y_  
   PilarW = mkW ]f_6 '|5A  
   PilarH = mkH  '此两项为固定值 +{L<? "  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) `zE}1M%y  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 W"k8KODOY  
   K!]1oy'V  
   a\:VREKj,  
  '连续采集记录文件 y;AL'vm9  
  ' 建立一个缓冲区为页对齐方式的文件 Vw&HVo  
  If Dir(TmpFile) <> "" Then 8krpowVs~  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ D*YM[sN`  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) Jte#ZnP  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 rn=m\Gv e  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 =n' 4?W@  
  Else '8T=~R6  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ `A,g] 1C:  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) bLd#xXl  
  End If }-o{ASC#  
  If hFile = 0 Then LJ(1RK GCz  
    MsgBox TmpFile & ": File Open Error", vbOKOnly SJ};TEA  
    Exit Sub hweaGL t0  
  End If mK [0L  
  '采集参数记录文件 '^FGc  
hBCFile = FreeFile() ?1[\!  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile &2=dNREJ}1  
   t6A:ZmG_  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 ZU9c 5/J  
If hMEM = 0 Then I~9hx*!%%  
    fStatus = GetLastError SY^dWLf  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ GKFq+]W  
     & "请向技术人员报告该错误代码。", vbOKOnly Wf&W^ Q  
    CloseHandle hFile IW%|G  
    Exit Sub !\,kZ|#>  
End If =pk)
3<GwF  
?w+Ix~k  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) +5&wOgx  
If hMemWork = 0 Then N]<!j$pOz  
    fStatus = GetLastError @bnG:np  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ P7x =  
     & "请向技术人员报告该错误代码。", vbOKOnly ~2zMkVH  
     '释放已成功分配的内存 `/MvQ/  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) ,+ #6Y _  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) zWb4([P;  
     }QsZ:J.  
    CloseHandle hFile \C`~S7jC  
    Exit Sub ~~6^Sh60g  
End If {|yob4N  
a /:@"&Y  
' Test writing ryc & n5  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ~35U]s@v  
     |-CnT:|o  
   '初始化采集卡参数 V2<?ol  
   iCurrentCard = -1 ?l$Nf@-  
   hBoard = okOpenBoard(iCurrentCard) z8J."27ND  
   Debug.Print hBoard YTj kPj:  
   If hBoard = 0 Then viAMr"z  
      ExitGrabber CCX8>09  
      End `St.+6^J  
   End If j$TwL;  
   okGetBufferSize hBoard, mBufferAddr, BufferSize Ii^5\v|C  
   If mBufferAddr = 0 Then v,\R,{0  
     MsgBox "缓存不存在！" D^-7JbE]  
     ExitGrabber ,E$@=1)  
   End If =07]z@s  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) jh.@-  
   XbZ*&  
   bug Ot7  
   currentBr = 128: currentContr = 128 f7'q-  
   '设置视频输入参数 hAjM1UQ,Y  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 bQZ*r{g  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input AT\qiznvP  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ;9}pOzF1q  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 fV M`-8ZTq  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 %Jf<l&K.`  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 I6s3+x;O  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） i]#+1Hf  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) a!mf;m  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) 7oR:1DXw|  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 R3!@?mcr  
   iK IOh('G  
   '设置采集参数 )#}mH@  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 e[Jem5C  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 Zxb_K  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 G5,~Z&}YS  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 C(id=F  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 |P.6<  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 wfP5@!I  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 -dO
'~all  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 3tmdi3s  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 u^j {U}  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 80$fG8  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 ejO}t:}P  
   `W-&0|%Ta  
   n?:=  
   okCloseBoard hBoard )Y8",Ig  
   Sleep 50 [*Z`Kc  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 dna6QV>A  
   hHPs&EA.p  
   '设置数据传送方式 IB`>'~s&A  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 <soz#}e  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 xwH?0/  
   LsM7hL y   
   sRECT.Right = -1   '用于获得当前设置值 ~WpG
f,  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) i"j(b|?
e  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom thqS*I'#g  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 SgEBh  
   sRECT.Left = 0 gXH[$guf  
   sRECT.Top = 0 &l?+3$q  
   sRECT.Right = sRECT.Left + FrameW :~ A%#  
   sRECT.Bottom = sRECT.Top + FrameH * 2 vw)7 !/#  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) 62>zt2=  
   \@;\t7~  
   sRECT.Right = -1   '检查新设置值 c0Dmq)HK?  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) )C.yF)Ql  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom n6(.{M;  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) \M"UmSB o  
   > QFHm5Jw  
   If TESTSignal = False Then A~dQ\M  
      'ExitGrabber 6ITLGA  
   End If  x5Z-{"  
   gBf4's  
   5 eA8niq#  
   4TwQO$C  
   '设为实时采集状态  A, P
lvI  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) $j5,%\4<  
   '>v^6iS  
   nSCWg=E^  
   '单帧采集 1,V`8 [  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 (LtkA|:  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) oQ7]=|  
   okCaptureTo hBoard, BUFFER, 0, 1 'single K"V:<a  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 &|<xqt  
   '   Sleep 20 O3.C:?;x  
   'Loop T`9-VX;`  
   okGetCaptureStatus hBoard, True f2,1<^{  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize (.Lrmf@hI7  
   '写入768*576测试图象 CVi`bO4\  
   ArrayToBMP TmpBMP =q"eU=9  
   sgr=w+",Q  
   '打开数据库 c:l]=O   
   Set conn = New ADODB.Connection ?QA\G6i4  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 3[XQR8o  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ yxBUj*3  
      "; Mode=Read|Write" G^(}a
]>9  
   conn.Open Oc&),ru2l  
   Ft@Wyo`^  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 4{qB X?  
   frmRecord.Visible = True ?v-1zCls  
   frmQuery.Visible = True T|"7sPgGR  
   Load frmReceiveFromComm 0q9>6?=i  
   L}j0a>=x4  
   '调试参数 ?Mp1~{8  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then n tP|\E  
     SignalBox.Visible = True pX=,iOF[I  
   End If 9Z6C8Jv  
   If InStr(UCase(Command()), "/COMM") > 0 Then UHGcnz<  
     frmReceiveFromComm.Visible = True Y&2aO1  
   End If /i)Hb`(S  
~^vC,]hU  
End Sub k?VQi5M  
p$k\m| t  
Sub ExitGrabber() p[2GkP  
  '关闭数据库 LjdYsa
i-  
  '关闭采集卡 >x[`;O4  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) h~7,` fo  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Q!M)xNl/  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) @S 6u9v  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) YGsS4ia*4i  
  okStopCapture hBoard )nu~9km3  
  okCloseBoard hBoard 0 3~Ikll  
  CloseHandle hFile f'6|OsVQ  
  Close #hBCFile ^\:2}4Uj_  
  conn.Close o/
,NGU  
  End #~Q8M*~@  
End Sub zEw>SP1,  
;:m&#YJV  
Function ArrayToBMP(ByVal File As String) A{<xc[w;p  
Dim BytesWrite As Long 4UA
vw  
nVD  Xj  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ 9B)(>~q  
  CREATE_ALWAYS, 0&, 0&) d/7lefF  
^UA(HthY  
If hTmpFile = 0 Then .~}z4r  
   ArrayToBMP = False  0v^:  
   Exit Function %TrF0{NR90  
End If QT#6'>&7-b  
!CjqL~  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN %So]3;'  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& ,kgF2K!  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN ZB5?!.ND  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& yW.COWL=)  
(P==VZQg  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 5A&y]5-Q`  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0&  l>v{  
*wi}>_\  
If BytesWrite < pFrameSize Then 50a
\e  
  ArrayToBMP = False Ih1|LR/c  
End If Ewo*yY>  
:Y)to/h
 
CloseHandle hTmpFile NfE.N&vI_c  
+ySY>`1k~  
End Function D*vm cSf  
Napf"Av  
Function ArrayToBMP1(ByVal File As String) O Df4+& u  
CQODXB^  
Dim BytesWrite As Long W>spz~w%j  
cbKL$|  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ `dJDucD  
  CREATE_ALWAYS, 0&, 0&) &14W
vAU  
gUB{Bh($Y  
If hTmpFile = 0 Then I"xWw/Ec  
   ArrayToBMP1 = False }iIbc
A  
   Exit Function Y(GN4@`S  
End If Q1>zg,r  
J<JBdk  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN i9UI,b%X  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& oj}"H>tTp  
/f1'm@8;  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN CsSp=(  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& HBLWOQab  
i=v]:TOu  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN gY`Nr!O  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& M+s j}  
G5Q!L;3HZ  
If BytesWrite < pBufferSize Then S*%iiD)  
  ArrayToBMP1 = False ,2WH/"  
End If Xz;b,C&*t  
SvK1.NUa  
CloseHandle hTmpFile #1$}S=8*f  
a%hGZCI  
End Function W'_/6_c$!  

6kvV  
'使用该过程建立的文件要求在用后关闭 ^Y^"
'"  
Public Function ArrayToBMP2(File As String) As Boolean EaS~`  
wVi%
oSfM  
Dim BytesWrite As Long s0{ NsK>  
2w?G.pO#  
ArrayToBMP2 = True DM3B]Yl  
Xy#VQ{!  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ u9![6$R  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) dDKqq(9(`  
1a9w(
X  
If hTmpFile = 0 Then Rq7p29w  
   ArrayToBMP2 = False n_$yV:MuT!  
   Exit Function M@?"t_e1  
End If .R5/8VuHF  
0^]t"z5f0  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN =8{*@>CX  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& lVeH+"M?  
@~jxG%y86  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN s?O&ZB2GM[  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& !=[uT+v  
>zL|8f  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN ]5|z3<K^  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& CKTrZxR"  
I{dl%z73  
If BytesWrite < pFrameSize Then p27p~b&  
  ArrayToBMP2 = False BV9*s  
End If ma}
}Sn)Q  
7d D.G/'  
CloseHandle hTmpFile 7o{*Z  
MWq$AK ]  
End Function 7;HUE!5,^l  
Kj*m r%IaU  
Private Function TESTSignal() As Boolean w)S;J,Hv  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long FU@uH U5fd  
Rlw9$/D!Z  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) (Cj,\r  
R'EW7}&  
If extsign = 1 Then v`{:~q*  
   TESTSignal = True Mr6E/7g%  
Else E_[ONm=,  
    If extsign = 0 Then $P?{O3:V  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly bNvAyKc -  
        TESTSignal = False g'G8 3F  
        Exit Function xQz
#i-v  
    End If 'TEyP56  
End If Kp_jy.e7&  
A9BxwQU#  
'测试视频输入类型 'yNPhI  
'video type I=YCQ VvA  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 QAvWJydb  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) Tkrx7Cs(  
If videotype = 1 Then 7b.U!Ju  
        '"隔行信号(Interlaced)" !cCg/  
Else -,>:DUN2  
   If videotype = 0 Then i X/tt  
       '"逐行信号(Non-interlaced)" >=!AL, :  
   Else `I>], J/  
     If videotype = -1 Then Pi%tsKk%  
       ' "不支持" 6=>7M b$  
     End If 0]a15  
   End If w67xl  
End If ?"@ET9  
*4#on>  
'测试垂直扫描线数 E:Y:X~vy  
'video scanlines (G5T%[/U  
scanlines = -1 ;4d.)-<No_  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) Y}/jR6hK  
    If scanlines = -1 Then ~yN(-I1P  
        ' "不支持" -fM1$/ ]  
    Else 1P
U*:58[  
        'Trim(Str(ScanLines)) + " 行数/幅" e<'U8|}hc{  
    End If h}6b&m  
}Z6nN)[|0Y  
'测试帧频
}'j
V/  
'video field frequency ;a{rWz1Wm  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) ct\<;I(H  
    If fieldfrq = -1 Then n.;3X  
        'lblSignal(8) = "不支持" x_ySf!ih  
    Else -IvL+}K  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" A*Q[k 9B  
    End If ry,}F@P&  
End Function eH=c|m]!P  
4GTrI@}3  
4 ? {*(  
Sub PicIdentify() luF#OPC  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 ,iOZ|  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 a97Csxf ;7  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 <t6d)mJ%  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 "4[<]pq  
3ExVZu$  
  Dim fPTR As Long, cFrame As Long n49s3|#)G  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer Wy)('EM  
     -eYL*P
a  
wrK#lh2  
cFrame = 0 NhtEW0xCr  
dKe @JQ+-z  
ZPYH#gC&T  
Do While cFrame < tFrames %EB;1
  
   Ij$)RSPtH  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) Ge9}8  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) [Ye5Y?  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize {Vl"m2  
   LO>8 j:  
  frmRecord.RText.Text = Str(cFrame) 8XkI k7  
  frmRecord.RText.Refresh ] 1Qi=2'  
       o@@w^##  
  If CheckMark = True Then *08+\ed"#  
   ArrayToBMP TmpBMP Z W2s[p r  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) tnRJ#[Io  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" _U=S]2QW  
   hE5G!@1F  
   DrawSlice ^HoJ.oC/  
  
3APYO  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) MVuP |&:n  
   'If i = vbNo Then 0sabh `iQ^  
   '  Exit Do 3It8&x:  
   'End If Eb7}$Ji\  
   'cFrame = cFrame + 1 u p~@?t2  
   1?]J;9p  
  End If &`sR){R  
  DoEvents h~.V[o7=  
  cFrame = cFrame + 1 sBB:$X  
Loop L3>4t: 8  
End Sub WV~SL/k|  
)Jz!Ut  
i\Q":4  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean M[vCpa  
o(nHB g  
'如标志区模式反差存在则为TRUE，否则返回FALSE >!G5]?taa
 
@_uFX!;  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long /]l f>\x1  
CheckMark = True .)nCOwR6p  
   W#C q6N  
'复制标志区 Wlxk  
For i = 1 To mkH (T2<!&0 @  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW *hl<Y,W(  
Next i 6fQ*X~| p  
SJF2k[da  
For j = 1 To PilarW * PilarH / 2 R_~F6O^EO  
   mTop = mTop + MKpilar(j) hf[IEK  
Next j
~s0P FS7  
TQ2i{e
 
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH P ]_Vz  
   mBot = mBot + MKpilar(j) *U2Ck<"]  
Next j YL!oF^XO  
X{|k<^:  
mTop = mTop / PilarW / PilarH * 2 {!tOI  
mBot = mBot / PilarW / PilarH * 2 Y/!0Q6<[2Y  
'U*udkn 2]  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 T)O]:v  
95% :AQLV  
'平均值极值化 aH9L|BN*  
  For j = 1 To PilarH * PilarW X~#@rg!"  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) aEZJNWv  
  Next j ^zkd{ov  
   td`wNy\  
mTop = 0: mBot = 0 @+Pf[J41  
For j = 1 To PilarH * PilarW / 2 I@c0N*(  
  mTop = mTop + MKpilar(j) ~EPjZ3 ?  
Next j 9cbB[c_.  
o+R. u}|  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW 34]%d<
;A  
  mBot = mBot + MKpilar(j) 3dY6;/s  
Next j .>a$g7Rj  
1(D1}fcul  
fVv$K&  
  mTop = mTop / PilarH / PilarW * 3 }cyq'mi  
  mBot = mBot / PilarH / PilarW * 3  MbM:3  
   r6<ArX$Yl  
Q,O]x#  
If mBot > iWhite And mTop < iBlk Then 2@4MC`&  
  CheckMark = True W|)(|W  
Else M`q#,Y?3^I  
  CheckMark = False 1w6.  
End If "%Lmgy:~  
End Function 2%*|fF}I  
OHQ3+WJ  
Sub Capture1Frame() Z*;*I<-  
   okCaptureTo hBoard, BUFFER, 0, 1 'single -1#e^9Ve\  
   okGetCaptureStatus hBoard, True bwT"$Ee  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize t>=GVu^  
End Sub % {c2lyw  
kv[OW"8t  
o^N%;d1%E  
Sub CopyMark(iBlk As Integer, iWhite As Integer)
~ 6TfW~V  
'复制标志区并返回标志区暗区与亮区的亮度平均值 rjt O`Mt`  
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 o(BYT9|.kw  
   R2'C s  
'复制标志区 s')!<E+z\t  
For i = 1 To mkH oF`-cyj"  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW %9cqJ]S  
Next i pq@$&G  
Q&tFv;1w6  
For j = 1 To mkW * mkH / 2 HL|0d }  
   mTotal = mTotal + MKpilar(j) _6| /P7"  
Next j "P9wT)J_  
9eksCxFg  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度  z, :+Oc  
:s
? y,  
mTotal = 0 chMt5L+5  
For j = mkW * mkH / 2 + 1 To mkW * mkH ]q@rGD85K  
   mTotal = mTotal + MKpilar(j)  ; \Y-  
Next j `z5v}T  
H74NU_  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 ^D0/H N   
[UUM^!1  
'背景亮度 dVK@Fgo  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW Uia)5zz8  
  For i = 1 To 4 * FrameW 6eVe}V4W  
    bsTotal = bsTotal + BsLine(i) Ebmqq#SHjX  
  Next i &fh.w]\  
  bsAV = bsTotal / FrameW / 4 ,2Sv1v$  
^$3w&$K*  
End Sub t"4Rn<-  
%Td+J`|U+  
<$Xn:B<H  
Sub AdjIMGbright(Optional bInit As Boolean = True) ^2(";.m  
e=|F(iW  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） zkw 0jX~  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 H7 o$O  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 >0[qi1  
    
'Sm/t/g"|  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer ^2P;CAjj-  
   T749@!v`z  
  '按标准亮度与对比度采集一帧，确定背景亮度 %@)U/G6s}  
  currentContr = 128   '初始对比度 `V$ cz88b  
  currentBr = 128   '初始亮度 $H %+k?  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 c1=;W$T(s  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 Y>c5:F;  
  DoEvents m mw)C"  
  Capture1Frame PLlx~A  
  '获得图像上缘4行象素 JB:mbH  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW \v B9fA:*  
  CopyMark iBlack, iBright   '图像标志区亮度 <L[ *hp  
  For i = 1 To 4 * FrameW K.c6Rg  
    bsTotal = bsTotal + BsLine(i) fte!Ll'  
  Next i 9~*_(yjF  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 o
%QhV6(F  
   ZfF`kD\  
  Select Case bsAV rGP? E3  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 &ij^FAM  
       currentBr = 150 .l" _K  
       currentContr = 60 =t <:zLe  
     Case 61 To 80   '有可见背景 uT@8 _9  
       currentBr = 140 aa' 0EU:  
       currentContr = 70 y$"~^8"z  
     Case 81 To 100  '有清晰背景 b3jU~L$  
       currentBr = 128 9.]Cy8  
       currentContr = 80 jp\JwE  
     Case 100 To 150  '有明亮背景 5[0l08'D  
       currentBr = 140                '5:30-6:00钟实测数据 _~(MA-l  
       currentContr = 50 [7CH(o1a&  
     Case 151 To 180 ,(5dQ`hA0  
       currentBr = 130 KG7X8AaK#  
       currentContr = 60 Ji)a%j1V9  
     Case 181 To 220  '背景全为白色  yS(=eB_  
       currentBr = 110 %t(, *;  
       currentContr = 130 H>Iet}/c  
     Case 221 To 255  '背景全为白色 bDcWb2lqs  
       currentBr = 100 $/-wgyP3m+  
       currentContr = 100 S@l a.0HDA  
  End Select d60Fi#3d  
  
%K/G+  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 ;nHo%`Zt  
        Case 100 To 150 '8((;N|I^  
          currentBr = currentBr - 10 I NFz X  
        Case 151 To 255 0n=9TmE  
          currentBr = currentBr - 20 U(=f5|-  
  End Select gs<qi'B  
   l)2HHu<  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 \5v=pDd4g  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 jn#N7%{Mk  
End Sub ^y;OHo  
}r\SP3  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) &'oacV=  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long XJV3oj  
     Vf\?^h(tP  
    For i = 1 To 8  K{7S  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& ~]D\&D9=?  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& Jh/M}%@|  
    Next i "m\UqQGX  
     aL$c).hq0  
    For j = 1 To 1024 bsmoLT  
      L1 = L1 + LeftBK(j, 0) d(dw]6I6  
      L2 = L2 + LeftBK(j, 1) {{#a%O  
      R1 = R1 + RightBK(j, 0) RF\1.HJG  
      R2 = R2 + RightBK(j, 1) b{ ubp  
    Next j ML9T(th6v  
    diffL = Abs(L1 - L2) / 1024 8Y;zs7Y  
    diffR = Abs(R1 - R2) / 1024 4YB7og%P  
End Sub { ?1mY"  
Y+Q
,4s  
Function CheckSlice() As Boolean Cvu8X&y  
  CopySlice avSL, avSLR, avSLL 5i wikC=y  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then `)xU;-  
    CheckSlice = True 8[{0X4y3  
  Else :)3$&QdHT  
    CheckSlice = False n?KS]ar>  
  End If IU;pkgBj0Y  
End Function :pV("tHE  
_|Kv~\G!  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) 'AlSq:g Z  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long { <ao4w6B  
  For i = 1 To FrameH M,v@ G$pW  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize :[ZC-hc\  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize ;zxlwdfcr'  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize [F9KC^%S  
  Next i >?uH#%C5  
  For i = 1 To FrameH eG2qOq$[  
    For j = 1 To sSize _<' kzOj  
       total = total + Slice(j, i) FZ'>LZ  
       totalL = totalL + SliceL(j, i) 8-
l)TTP&.  
       totalR = totalR + SliceR(j, i) `'tw5}  
    Next j \c@qtIc  
  Next i cB9KHqB  
  avSL = total / FrameH / sSize R'a5,zEo/  
  avSLR = totalR / FrameH / sSize |SXMu_w  
  avSLL = totalL / FrameH / sSize 1x<rh\oo  
End Sub >t6'8g"T  
IbNTdg]/F`  
Sub DrawSlice() ~QQ23k&  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B t&?v9n"X  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B vN6]6nUOiT  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B ;@ !d!&  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) =-B3vd:LF  
End Sub w[$Wpae  
Sub DrawMark(pic As Control) )Q pP1
[  
   Dim i As Long, j As Long ]mGsNQ ].H  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B ]FnrbQ|  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B r~BQy'  
   For i = 1 To PilarH XC8z|A-@  
     For j = 1 To PilarW 8aIf{(/k  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) v!v0,?b*  
     Next j |@n{tog+-  
   Next i H)}1
xQ{3F  
End Sub {Z{NH: ^  
:Pp;{=J  
Function avIMG() As Integer H?r;S 5)c  
  Dim i As Long, j As Long, totalIMG As Long H ]N/Y{  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize J\8l%4q3  
  For i = 1 To pFrameSize "1j\ZCXK_Z  
    totalIMG = totalIMG + pBuffer(i) >p+gx,N  
  Next i Y.hH fSp  
  avIMG = totalIMG / pFrameSize 2|_Jup  
End Function {G
*:N[pJp  
RAkFgC ~  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer PXQ9P<m  
  Dim i As Long, j As Long, totalIMG As Long eG)/&zQ8  
  For i = 1 To FrameH TB3T:A>2  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth U8I~co:h  
  Next i %A[p!U  
  For i = 1 To FrameH * barWidth )9W#5V$  
    totalIMG = totalIMG + pBuffer(i) 2g07wJ6x  
  Next i #5"<.z  
  avRegion = totalIMG / pFrameSize b-=[(]_$h  
End Function '9F{.]  

一共这么多文件。 m_U6"\n 5  
v i.AzO  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 $aI MQ[(  
第6车皮 O]LuL&=s y  

X@4d~6k?  
iOXP\:mPo  
第9车皮 fQA)r  
uU !i`8  
  

从这里里分离出来的。

WbzL!zLd!  
s1apHwJ -  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

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

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ LtIZgOd<  
!K)|e4$  

继续填个坑： En_8H[<%  
Kg67cmj)f  
用VBA控制WORD自己修订学生毕业文的格式。 O]! DNN