引用

引用第20楼newport93于06-14-2010 13:47发表的  : ,'fxIO  
'LE"#2Hu  
老五，I 服了U。 ';B#Gx  
,&^3Z  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 YT#3n  

]lOh&Cz[  
/+]s.V.  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! s +s" MI  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : feM6K!fL`  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? n/d`qS  

?%tMohL  
2B0W~x2=  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : $ i)bq6  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 OVzt\V*+%W  

e~%  ;K4  
!)"%),>}o  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 RcG0 8p.)  
-H^oXeN  
可以从宽不？

引用

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

/>¬$>  
q{s(.Uq$&  
其实标题没有什么，卡总既然改了就不必再改回了。 I}e3zf>  
i|w8.}0  
主要是当初写的时候真是顶着锅盖写的。 Wcb7 ;~K  
j?y LDLj  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : 5OoN!TEM  
哦, 打倒忽悠大家的家伙.      U^qt6$bK  

Z}|(FRVk  
w[6J `
 
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : Jk0r&t7  
每个人的故事对其他人都是故事, O LI$1d_  
自己的故事也是其中之一. eHDef  
跳出来看, h
K<5KZ/
4  
不过是众人中的一个人的故事. ZylJp
8U  
pHoEa7:  
所以,接着听故事. >AJSqgHQ,  
9}z0J  
女人们有兴趣的就等老伍开个新帖或者跟贴, L.]$6Q0  
听他痛说恋爱革命历史.... #$3yz'"QF  
Z@Ae$ '9H  
杂家接着听他自学程序员历史, w
u"&|dt  
高级程序员考了吗?
b=3H  

c*UvYzDZL  
qH['09/F6  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ `Y?87f:SP  
=!m}xdTP  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 -gQCn>"  
$cu00
K  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 Zs<KZGn-B  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : 2Hum!p:1  
引用第19楼伍胥之于06-14-2010 12:33发表的  : f3|@|'  ;  
fqu}Le  
9_sA&2P{uV  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 rxme(9M  
MQ)L:R`L  
我连一级也没有考过。 `>o?CIdp  
. {,OS-g  

}h 3K@R   

引用

.vG,fuf8  
矬子里拔将军... 7Ol}EPf#  
你们那里的俗语是吧? 7OWbAu;  
=+w*gDr  
我们这里说"矮子里拔长脚"..应该是同一个意思... q$G,KRy/  
jgS%1/&  
有趣....各地有表达意思一样却方式不同的俗语.... ]59i>  
T;L>P[hNn  
wM_c48|d  
你的文章写的有脸皮,没屁眼的, hXGwP4  
让看客大为不满... <)*2LBF@]  
SR*wvQnOx  
你等着,,估计你以后接到的午夜凶铃就多了... H'F6$ypoS  

>%E([:$A  
m0{!hF[^  
我到现在也没有接到你的午夜凶铃呢！ ! Q<>3xZ  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : CXtU"X  
伍SIR，再次抱拳佩服 ":3 VJ(eY  

N)% ;jh:T  
yk2!8  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

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

Vv$HR  
0%s|Zbo!>  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : &;H{cv`  
zvv:dC/p<  
介个真的看不懂。 MrE<vw@he  
你说你老啦，喜欢怀旧了，才想起来填坑。 Ni[4OR$-O  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 SP 2 8  

-7'#2P<)  
 9CUimZ  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 X7aXxPCq1  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ h"QbA"  
DWORD dwCB; h\,5/ )Y  
LARGE_INTEGER  offset; VlW9UF-W  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); 2]jPv0u  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); >L2*CV3p  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ O{KB0"s>i  
DWORD error = GetLastError(); <Mgf]v.QS  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); ~] =?b)B  
return FALSE; ((3t:  
} [h}K$q  
return TRUE; vW.%[]  
} Oo%!>!Lt,  

'VB 6.0 版 =mrY/: V  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 9EgP9up{6!  
{Qtq7q.  
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 :k!j"@r  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long i^%-aBZ  
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 < tQc_  
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=Wd,$\  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long ?M&4pO&Y  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 OCx5/ 88X  
~"mj;5Id  
yuNfhK/#r  
Private Const GENERIC_READ = &H80000000 0M!0JJy#*  
Private Const GENERIC_WRITE = &H40000000 <%!J?  
.:0M+Jr"  
Private Const FILE_SHARE_READ = &H1 F/<qE!(  
Private Const FILE_SHARE_WRITE = &H2 &G{2s J5{  
Private Const OPEN_EXISTING = 3 HCc`  
EODB`$+  
Private Const INVALID_HANDLE_VALUE = -1 ZH-5Qy_  
*caLN,G  
'//file seek 5-p.MGso  
Private Const FILE_BEGIN = 0 CX+9R3pa  
Private Const FILE_CURRENT = 1 }K8Lm-.=  
Private Const FILE_END = 2 7z<Cu<  
QFzFL-H~N  
Private Const ERROR_SUCCESS = 0& 6+%-GgPf  
RWE~&w G}  
'//device io control X(GV6mJ4  
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 q:yO92Ow  
Xu]h
$%W  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 4;\Y?M}g?  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 `C<F+/q  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 $9i9s4u^  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 P3$,ca'  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C G]lvHD  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 IIP.yyh>  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F 2Guvze_bU  
*]!l%Uf
%  
'//type (UzPklkZ  
Private Type LARGE_INTEGER S8*>kM '  
    lowpart As Long [2H[5<tH  
    highpart As Long STlPT5e.}  
End Type )VY10R)$  
}N|\   
Private Enum MEDIA_TYPE 5Bd(>'ig_  
    Unknown 6^ik|k|  
    F5_1Pt2_512 t&f" jPu>  
    F3_1Pt44_512 [aNhP;<  
    F3_2Pt88_512 R9=K(pOT  
    F3_20Pt8_512 e`ex]py<C  
    F3_720_512 E._hg+ (Hi  
    F5_360_512 .Cfp'u%\;  
    F5_320_512 hZ o5p&b  
    F5_320_1024 \1{_lynD  
    F5_180_512 I7bi@t  
    F5_160_512 7sguGwg)_  
    RemovableMedia v$JLDt_  
    FixedMedia E!dp~RwZu  
End Enum /hfUPO5  
[0(mFMC`  
Private Type DISK_GEOMETRY cKpQr7]ur  
    Cylinders           As LARGE_INTEGER 28+HKbgK  
    MediaType           As MEDIA_TYPE @H4wHlb  
    TracksPerCylinder   As Long kd`YSkZ  
    SectorsPerTrack     As Long 82.HH5Z{  
    BytesPerSector      As Long gUb "3g0  
End Type C M^r|4K  
#W^_]Q=5R'  
'//private vars '8={ sMy  
Private hDisk           As Long             'disk handle Fv a] *5  
Private lpGeometry      As DISK_GEOMETRY    'disk info &[)D]UL  
Private lBufferSize     As Long             'the buffer size of read/write PHl4 vh#E!  
R25-/6_V>  
Public Function OpenDisk(ByVal FileName As String) As Boolean GDmv0V$6  
'// 打开磁盘 ]gHLcr3  
    hDisk = CreateFile(FileName, _ w<mqe0  
                        GENERIC_READ Or GENERIC_WRITE, _ VwC4QK,d;  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ fr]Hc+7  
                        ByVal 0&, _ /'"R Mq  
                        OPEN_EXISTING, _ n531rkK-   
                        0, _ qu!<lW~c  
                        0) *cQz[S@F  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) 'rh\CA/}D  
End Function m>O2t-  
ZZwBOGVU  
Public Function CloseDisk() As Boolean >E~~7Yal  
'//关闭磁盘 g6`.qyVfz'  
    CloseDisk = CloseHandle(hDisk) bx]14}6  
End Function |} 9GHjG  
VHj*aBHB  
Public Function GetDiskGeometry() As Boolean -rRz@Cr  
'//获取磁盘参数 +
ruj  
    Dim dwOutBytes      As Long Ss+F9J  
    Dim bResult         As Boolean LiF.w:
}  
     ^Wk0*.wg  
    bResult = DeviceIoControl(hDisk, _ >!<V\ Fj1  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ 0pCDEs  
                                ByVal 0&, 0, _ ',%5mF3j  
                                lpGeometry, Len(lpGeometry), _ pdy+h{] 3  
                                dwOutBytes, _ eoJFh  
                                ByVal 0&) G*=H;Upi  
     <@%ma2  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack 8m \;P  
    GetDiskGeometry = bResult #-A5 Z;TD.  
End Function gi '^qi2  
Yr:>icz|  
Public Sub GetDiskInfo(MediaType As Long, _ s7AI:Zv  
                        Cylinders As Long, _ %K`4 k.gN  
                        TracksPerCylinder As Long, _ 'oT|cmlc  
                        SectorsPerTrack As Long, _ 8@Q"YA3d+  
                        BytesPerSector As Long) 7V |"~%  
'//返回磁盘的参数 o`25  
    MediaType = lpGeometry.MediaType r"6 lLc  
    Cylinders = lpGeometry.Cylinders.lowpart (s.o  
    TracksPerCylinder = lpGeometry.TracksPerCylinder br10ptEx  
    SectorsPerTrack = lpGeometry.SectorsPerTrack mxZ4 HD{
 
    BytesPerSector = lpGeometry.BytesPerSector J (=4  
ayN*fiV]  
End Sub `c>A
>c|  
Aw5K3@Ltz  
Public Property Get BufferSize() As Long QZz&1n  
'//返回每次读/写的缓冲大小 hg!x_Eq|  
    BufferSize = lBufferSize cFe V?a  
End Property W0+u)gDDz  
E=3#TBd  
\?[O,A   
Public Function LockVolume() As Boolean Jr|K>  
'// 将卷锁定 8 `y
B  
    Dim dwOutBytes  As Long +)% ,G@-`  
    Dim bResult     As Boolean  $.=5e3  
     &C\=!r0j^  
    bResult = DeviceIoControl(hDisk, _ ;%M2x5  
                                FSCTL_LOCK_VOLUME, _ [+yG DMLs  
                                ByVal 0&, 0, _ ,C
N#co  
                                ByVal 0&, 0, _ ?
#x'_2  
                                dwOutBytes, _ N" 8*FiZ|  
                                ByVal 0&) Bc5YW-QD  
    LockVolume = bResult 01'y^`\xQ  
End Function g521Wdtnn  
1fmSk$ y.9  
@^BS#  
Public Function UnlockVolume() As Boolean 2J1B$.3'  
'// 将卷解锁  `NTM%# w  
    Dim dwOutBytes As Long 3KB|NS  
    Dim bResult As Boolean V,`!rJ  
     ~D$#>'C#  
    bResult = DeviceIoControl(hDisk, _ ZE{aS4c  
                                FSCTL_UNLOCK_VOLUME, _ JvT%R`i  
                                ByVal 0&, 0, _ r{bg
TG  
                                ByVal 0&, 0, _ /vMQF+  
                                dwOutBytes, _ jo]m12ps  
                                ByVal 0&) )j$b
9ZBk  
    UnlockVolume = bResult p|xs|O6{  
End Function wV7@D[8  
':5Trx  
R994R@gz  
Public Function DismountVolume() As Boolean f6@^
Mg  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 ]:[)KZ~  
    Dim dwOutBytes As Long 9<+;hH8J_r  
    Dim bResult As Boolean vQ?MM&6  
     )*"T  
    bResult = DeviceIoControl(hDisk, _ mrw]yu;2<n  
                                FSCTL_DISMOUNT_VOLUME, _ 8') .ohD  
                                ByVal 0&, 0, _ };4pZceV  
                                ByVal 0&, 0, _ ~5x4?2  
                                dwOutBytes, _ ee4KMS  
                                ByVal 0&)
T2;v<(  
    DismountVolume = bResult .~FKyP>[$  
End Function b\<lNE!L  
ubiQ8Bx  
[1t\|v  
Public Function ReadDisk(ByVal Cylinders As Long, _ \HBVNBY  
                    ByVal Tracks As Long, _ !3O,DhH>MC  
                    db() As Byte) As Boolean UwvGr h  
'//按柱面和磁道来读取磁盘数据 *##QXyyg  
    Dim iPos    As Long ]?v?Q
fh2  
    Dim lRead   As Long k^L#,:\&V  
     GLbc/qs  
    iPos = Cylinders * Tracks * lBufferSize Gs
x^j?  
     EOMu qP)  
    If SeekAbsolute(0, iPos) Then =vB]*?;9  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) 8#NIs@DJ  
    End If 5]A$P\7~1  
End Function P]~N-xdV  
P2A ]qX  
Public Function WriteDisk(ByVal Cylinders As Long, _ JNU"5sB  
                     ByVal Tracks As Long, _ ?GaI6?lbn  
                     db() As Byte) As Boolean }[XB]Xf  
'//按柱面和磁道来写磁盘数据 5P5A,K  
    Dim iPos    As Long
&"@HWF  
    Dim lRead   As Long LZ=wz.'u  
     <(u3+`f1s  
    iPos = Cylinders * Tracks * lBufferSize iX0]g45o  
     }z9I`6[  
    If SeekAbsolute(0, iPos) Then a>;3 j  
        WriteDisk = WriteBytes(lBufferSize, db()) ,n /SDEL  
    End If 1Xk{(G<\  
End Function c+)36/; X  
ej)B R'*  
~Hp#6+  
'///////////////////////////////////////////////////////////////////////////////////// A)O_ es2  
'//file system M6o xtt4  
4eDmLC"Y *  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean =!I8vQ>  
'//seek file u&?yPR  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte b<2
9wL1  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) llTQ\7zP  
    If LowPos = -1 Then /6i Tq^.%  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) LLXg  
    Else Zpn*XG  
        SeekAbsolute = True Y&1!Z*OL;  
    End If @'k,\$/  
     rw40<SS"Z  
End Function vu !j{%GO  
XZUB*P}]D  
d=xI   
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean Y%n{`9=  
'//read data to array )sqp7["-  
    Dim RetVal    As Long S \yu%=h  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) \S|VkPv  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF i4{ /  
    ReadBytes = Not (RetVal = 0) H`+]dXLB  
     U#UVenp@  
End Function ]*k
P>  

pUCEYR  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean  k=ior  
'//write data from array o}r!qL
0c  
    Dim RetVal As Long ~x+:44*  
    Dim BytesToWrite As Long ".*a)  
    Dim BytesWritten As Long !DY2{Wb  
     gnKU\>2k  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) uJ)\P  
     ^>vO5Ho.  
    WriteBytes = Not (RetVal = 0) ?-(w][MT\  
End Function $h|I7`  

这才是我当年写出的一个比较烂的程序 @Z=y'yc'y.  
v0H>iKh7  
Main2.bas 1VPN#Q!  
Tg{dIh.Q~O  
Attribute VB_Name = "SubMain" n)wpxR  
Option Explicit i+T0}M<  
kHo;9j-U  
'采集文件与临时文件 o}AqNw60v  
Public Const TmpFile As String = "d:\30-0600.dat" ~;O=
7  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 ]>S$R&a  
*fuGVA  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long HpjIp.  
Public hBCFile As Long  '记录采集参数的文件 =%nqMV(y  
Public Const TmpBMP As String = "d:\1.bmp" e) /u>I  
Public hTmpFile As Long !z4Hj{A_  
-c<1H)W  
Lu#@~  
'采集窗口参数常量 /KJxn6  
Public Const FrameH As Long = 280& yrK-- C8  
Public Const FrameW As Long = 768& 5 a*'N~  
Public Const pFrameSize As Long = FrameW * FrameH ke;*uS  
d= T9mj.@  
'标志区范围，用于识别车辆 !tFU9Zt  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X f'zFg["aZS  
Public Const mkW As Integer = 28  '识别标志立柱宽度 7]HIE]#  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) _ /28Cw  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) K&"Pm9  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 );/5#b@<Y  
'车缝检测位置常数 RGPU~L  
Public Const sSize As Long = 32& e&a[k  
Public Const sPos As Long = 310& xzGsfd  
Public Const sPosL As Long = 200& 48"Y-TV  
Public Const sPosR As Long = 500& U~zN*2-  
'车缝检测框位置 ekk&TTp#  
Public Slice(1 To sSize, 1 To FrameH) As Byte ?
` ZGM  
Public SliceL(1 To sSize, 1 To FrameH) As Byte ZC\.};.  
Public SliceR(1 To sSize, 1 To FrameH) As Byte hz~CW-47  
Public avSL As Integer, avSLR As Integer, avSLL As Integer iR}i42Cu  
7+Jma!o  
%Cbc@=k  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 uK&wS#uY  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 h+'eFAZ  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 $xn%i\  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long (=&bo p  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte L!}j3(I  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ?\p
%Mx?  
|Nx!g fU  
:Ro" 0/d  
Iz$W3#hi  
'一次连续采集的帧数 51(`wo>LS  
Public tFrames As Long B6!<@*BI  
WUOPYYW<o
 
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 |EEz>ci  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 S bqM=I+  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize p~zT Rnm  
a518N*]j  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte o!_
; H}pq  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte Qj~W-^/ -  
Public pWorkSpace(1 To FrameW * FrameH) As Long (9[C0e
S  
Public Const pBufferSize As Long = FrameW * FrameH * 2 [{!j9E?(  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 [email protected] [  
u{lDof>  
Public hBoard As Long   '采集卡标识 /*p?UW<*4  
Public mBufferAddr As Long  '缓存地址 *$Wx*Jo  
Public BufferSize As Long  '缓存大小(字节) Kd[`m kmS  
Public iCurrentCard As Long ,DUQto  
Public CapStatus As Long 2Z9gOd<M~  
Public iFrames As Long G|Yp<W%o  
Public currentBr As Byte, currentContr As Byte n~>CE"q  
D!E 9@*Lf  
Public hMEM As Long, mStatus As Long ]B.,7  
Public Const hMemSize As Long = pFrameSize * 4 .gsu_
N_v  
Public hMemWork As Long yLa5tv/  
Public Const hMemWorkSize As Long = pFrameSize * 5 "E[*rnsLN  
= ]HJa
 
ZzaW@6LJF  
-0J<R;cVs  
'串口接收轨道衡数据 AiHDoV+-  
Public WeightFromCom As String '*{Rn 7B5  
Public bReceiveComplete As Boolean u9~V2>r\  
s1b\I6&:J  
$8ww]}K  
Public Type GrayBMPHeader A5H 8+gATK  
  Tag As Integer k49n9EX  
  FileLength As Long    '文件大小 xA1pDrfC/  
  Reserve1 As Long q}24U3ow
 
  DataOffset As Long    '图像数据偏移量 ]=XL9MI  
  BMPHeaderSize As Long  '文件头长 @_:?N(%(  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… (a4y1k t-  
                        'the following sizes are possible: J3}C T  
                        '28h - windows 3.1x, 95, nt, … m_ONsZHy  
                        '0ch - os/2 1.x jE5  9h  
                        'f0h - os/2 2.x Fu$Gl$qV?%  
O09g b[  
  ImageWidth As Long           '图像宽（像素数） `[u>NEb  
  ImageHeight As Long          '图像高(像素数) !";$Zu
 
  PlaneNumber As Integer  '图像层数 5N</Z6f'o  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap NTX+7<  
                                        '4 - 16 color bitmap [-94=|S @  
                                        '8 - 256 color bitmap 52R.L9Ai  
                                        '16 - 16bit (high color) bitmap RuEnr7gi  
                                        '24 - 24bit (true color) bitmap *wZV*)}  
                                        '32 - 32bit (true color) bitmap GN"LU
>9|  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) GQAg ex)D  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) ^|12~d_.T  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) <+JFa l  
                                    '3 - bitfields (also identified by bi_bitfields) 0J,d9a [1  
  IMAGESIZE As Long  '图像数据字节数 P*=3$-`  
  hResolution  As Long  '水平分辩率  像素数/米 Jt^JE{m9%  
  vResolution  As Long  '垂直分辩率 .xQ'^
P_q  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 M@ZpgAfq  
  ImportantColors As Long <T~fh>a  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数  jl%eO.  
End Type 1UWgOCc  
EC\:uK  
k#G7`dJl  
48*pKbbM4  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader QL!+.y%  
Public sRECT As RECT ;x C~{O  
6D]G*gwk[  
/faP]J)  
Public conn As ADODB.Connection t-m,~IoW  
Public rsTrain As ADODB.Recordset &zDFf9w2{  
Public rsOperater As ADODB.Recordset Pb&+(j  
Public rsGoods As ADODB.Recordset Jy NY *  
Public rsGood2 As ADODB.Recordset Z 2jMBe  
Public rsSender As ADODB.Recordset -.3k vL  
Public rsReceover As ADODB.Recordset D_kzR  
Public rsTrainTMP As ADODB.Recordset mP+yjRw  
on&=%tCAL  
n&&U9sf?  
'打开采集卡 6? ly.h$  
'设置参数 :rc[j@|pH  
'设置为实时单帧采集到缓存方式 X51$5%  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 Fd.d(  
1MFpuPJk  
4gt "dfy+  
Sub Main() zC;lfy{f=  
  Dim i As Integer, status As Long e[o ;l  
     &8L\FAY0%9  
   InitBMPinfo 9rc n*sm  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 ^moIMFl  
    BMPHeader.Tag = &H4D42 TmH13N]  
    BMPHeader.ImageWidth = FrameW hds4_  
    BMPHeader.ImageHeight = FrameH eT Hh  
    BMPHeader.BMPHeaderSize = &H28 l+qtA~V&2  
    BMPHeader.PlaneNumber = 1 <T[ui  
    BMPHeader.bpp = 8 epyYo&x}  
    BMPHeader.Compression = 0 m)w-mc  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 qn V9TeU)  
    BMPHeader.vResolution = &H1274 <R%6L&  
    BMPHeader.ColorsinBMP = 256 \> azY g  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP pC Is+1O/  
    BMPHeader.DataOffset = Len(BMPHeader) !9OgA  
    For i = 0 To 255 ()JDjzQT  
      BMPHeader.Pallate(i) = RGB(i, i, i) k}qiIMdI  
    Next i hvZR4|k>  
    BMPHeader.IMAGESIZE = FrameH * FrameW CUcjJ|M
Z  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE mQuaO# I,  
@y&,e,3!  
=x]dP
.  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) 1D DOUV  
     bd;f@)X  
    BMP1.ImageWidth = FrameW cYS+XBz  
    BMP1.ImageHeight = FrameH * 2 k= 1+mG  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight SXF_)1QO\W  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE !}48;Pl  
L#bQ`t  
  '确定标志位置,为pilarX, pilarY确定初始值 ay[*b_f  
   PilarW = mkW GQWTQIl
]  
   PilarH = mkH  '此两项为固定值 d'D\#+%>=  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) ?"u-@E[m  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 Ux]@prAq  
   S*:w\nXP~  
   >ON.ftZi  
  '连续采集记录文件 ]iX$p~riH  
  ' 建立一个缓冲区为页对齐方式的文件 Rj=Om  
  If Dir(TmpFile) <> "" Then DlO;EH  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ (LPD  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) S`.-D+.68  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 F\72^,0  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 I ^92b  
  Else F'*4:WD7  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ - mXr6R?  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) {mGWMv  
  End If VHNiTp  
  If hFile = 0 Then "V2$g  
    MsgBox TmpFile & ": File Open Error", vbOKOnly C>ZeG Vq  
    Exit Sub L<`g}iw  
  End If 9x,+G['Zt  
  '采集参数记录文件 )5x?Qn(B
 
hBCFile = FreeFile() KHiJOeLc  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile OO>2oH  
   zf u7
8  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 *?Y6qalSy  
If hMEM = 0 Then 5)6%D  
    fStatus = GetLastError +06j+I  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ n3,wwymQ  
     & "请向技术人员报告该错误代码。", vbOKOnly gu&oCT  
    CloseHandle hFile P2F>iK#U  
    Exit Sub G$<0_0GF  
End If px@\b]/  
H:6$)#  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 0k  [6  
If hMemWork = 0 Then INpub5  
    fStatus = GetLastError " z{w^k  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ _r'M^=yx[  
     & "请向技术人员报告该错误代码。", vbOKOnly N4-J !r@#~  
     '释放已成功分配的内存  ,iUx'U  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) 
l0)uu4|  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) #m>mYp8E.5  
     q5PYc.E([  
    CloseHandle hFile \>k+Oyj  
    Exit Sub 7i /Cax  
End If
BZ9iy~  
"dTXT  
' Test writing Q8i6kf!  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& {c;3$  
     dW68lVWq_  
   '初始化采集卡参数 ]+P &Y:  
   iCurrentCard = -1 W9"I++~f  
   hBoard = okOpenBoard(iCurrentCard) =ndKG5  
   Debug.Print hBoard ak[)+_k_  
   If hBoard = 0 Then TVA1FD
 
      ExitGrabber O6]~5&8U.  
      End W[s>TDc`v  
   End If AF6'JxG7  
   okGetBufferSize hBoard, mBufferAddr, BufferSize ba13^;fm#  
   If mBufferAddr = 0 Then H=C;g)R  
     MsgBox "缓存不存在！" cK&o C$[r-  
     ExitGrabber =@o}  
   End If 63=m11Z4  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) KHtY +93  
   AAcbY;  
   I"4B1g  
   currentBr = 128: currentContr = 128 Ip0q&i<6  
   '设置视频输入参数 .<dmdqk]  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 v!Z9T  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input CgC wM=!r  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 4aC#Cv:0  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 3I+pe;  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 C+5nft6:  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 8vK&d>  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） J^4k}  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) 2wCRT}C  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) 8n?.w:Y/  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 tw66 XxE  
   >.|gmo>b  
   '设置采集参数 @Rm/g#!h"  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 LNkyV*TI  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 nmr>Aj8[  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 /&yT2p  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 a2TC,   
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 g:U ul4  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 j
7&l&)5  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 4KCxhJq  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 +Sfv.6~v  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 e=2D^G#qE  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 F*f)Dv$p  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 q@:&^CS  
   LxT]-  
   lS^0*(Y  
   okCloseBoard hBoard @zbXG_J  
   Sleep 50 s><co]  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 00i9yC8@6  
   (agdgy:#  
   '设置数据传送方式 .FUEF)  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ;/@R{G{+~;  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 W=
!f  
   U{EW +>  
   sRECT.Right = -1   '用于获得当前设置值 q<VhP2R  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) (P?
9Jct  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom T (qu ~}  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 cO:x{~  
   sRECT.Left = 0 i(WWF#N5  
   sRECT.Top = 0 2xX7dl(cC  
   sRECT.Right = sRECT.Left + FrameW L6^h3*JyD  
   sRECT.Bottom = sRECT.Top + FrameH * 2 cu-WY8n  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Ty=}A MMyE  
   E_K7.c4M  
   sRECT.Right = -1   '检查新设置值 :R)IaJ6)  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) E'Bt1u  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom . fIodk  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) a;K:~R+@,  
  
isjkfl-!  
   If TESTSignal = False Then ]l%j>Vb!L  
      'ExitGrabber k;sUDmrO  
   End If S~T[*Z/m  
   =u(fP" |{  
   Gkl#s7'  
   Ot
?rsr  
   '设为实时采集状态 7u zN/LAF  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) xk/(|f{L  
   >qE$:V"_5  
   t`Sh!e  
   '单帧采集 U&6f}=vC  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 [#:k3aFz  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) Ev%\YI!MaY  
   okCaptureTo hBoard, BUFFER, 0, 1 'single QUt!fF@t  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 V+^\SiM  
   '   Sleep 20 v,jU9D\  
   'Loop D)Zv  
   okGetCaptureStatus hBoard, True 4:.M *Dz  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize x-1[2K1"[  
   '写入768*576测试图象 ^N]*Zf~N?  
   ArrayToBMP TmpBMP oW6.c]Vo  
   WCH>9Z>cj  
   '打开数据库 >9 iv>  
   Set conn = New ADODB.Connection }^H_|;e1p  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ zSu2B6YU}  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ Xy._&&pt  
      "; Mode=Read|Write" ?g'l/xuRe  
   conn.Open W;=ZQ5Lw  
   \21!NPXH2  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) "k.<"p
f  
   frmRecord.Visible = True jzQgDed ]  
   frmQuery.Visible = True 6vDgMfw  
   Load frmReceiveFromComm E~B LY{3:  
   Fq8Z:;C8  
   '调试参数 [(C lvGx  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then y3x_B@}BY  
     SignalBox.Visible = True <%5ny!]  
   End If \?j
(U8mB>  
   If InStr(UCase(Command()), "/COMM") > 0 Then *d=pK*g  
     frmReceiveFromComm.Visible = True u>BR WN  
   End If %vW@_A~  
VD4(
  
End Sub kW"N~Xw)  
%:NI@59  
Sub ExitGrabber() !59q@Mya[  
  '关闭数据库 ZR1EtvVG  
  '关闭采集卡 6Pz\6DU,I  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) d$!ibL#o
 
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) OA_ %%A;o  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) 8W{R&Z7aL  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) &:rf80`z.  
  okStopCapture hBoard EB\\ F  
  okCloseBoard hBoard F J)la9  
  CloseHandle hFile
J&Ah52  
  Close #hBCFile n}"MF> zDK  
  conn.Close  +p2)uXqW  
  End hQ9VcS6=gD  
End Sub j:0z/gHp$  
c5JxKU_  
Function ArrayToBMP(ByVal File As String) [|v
dr.  
Dim BytesWrite As Long dwRJ0D]&  
37VSE@Z+  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ i]P]o)  
  CREATE_ALWAYS, 0&, 0&) Yv>% 5`  
=dPrG=A  
If hTmpFile = 0 Then |g~.]2az  
   ArrayToBMP = False nkxVc  
   Exit Function zJPzI{-w|  
End If Ta_#Rg*!  
=7a9~&|  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN sPut@4[S  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& Lx.X#n.]T  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN ~MOIrF  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& -0Ps.B  
'2eggX%  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN O[!]/qP+.  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 4g|}]K1s  
)gZ yW  
If BytesWrite < pFrameSize Then WHL@]^E@m  
  ArrayToBMP = False zFlW\wc  
End If D_g+O"];P  
]`LMy
t0  
CloseHandle hTmpFile .RdnJ&K*  
vForj*Xo  
End Function cY5h6+
_  
$. Ih-   
Function ArrayToBMP1(ByVal File As String) {<V{0 s%  
U<zOR=_  
Dim BytesWrite As Long 6:H@=fEv  
BPW2WSm@<  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ uT_bA0j
K  
  CREATE_ALWAYS, 0&, 0&) )Zox;}WK+  
H?PaN)_6-+  
If hTmpFile = 0 Then kIyif7  
   ArrayToBMP1 = False m
k}8Cu4  
   Exit Function 1$4dzI()  
End If
f mf(5  
svN&~@l  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Vf0m7BJc3  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& _G@)Bj^*  
3:s!0t y"  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN G22u+ua  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& QN":Qk(,q  
[ &51m^  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN m)V%l0  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& A2..gs/  
dj 4:r!5_  
If BytesWrite < pBufferSize Then 29:] cL(5  
  ArrayToBMP1 = False o!:   
End If umI@ej+D  
G@s rQum(  
CloseHandle hTmpFile XsEDI?p2  
09/Mg  
End Function ,VI2dNst\  
`Ps&N^[  
'使用该过程建立的文件要求在用后关闭 U<K)'l6#2n  
Public Function ArrayToBMP2(File As String) As Boolean c1Skt  
9J*.' Y  
Dim BytesWrite As Long K9]L>Wj  
+JsMYv  
ArrayToBMP2 = True iU+O(vi  
Ko:<@h  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 
!Wgi[VB  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) !ap}+_IA7^  
;ry~x:7L7  
If hTmpFile = 0 Then Pd)mLs Jg  
   ArrayToBMP2 = False 3VaL%+T$,  
   Exit Function Phr+L9Eog  
End If Cs))9'cD]  
c~SR@ZU  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN  Z/RSZ-  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& s^#B*
 
#ozui-u>  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN n&1q*  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& NYw>Z>TD8c  
:<hM@>eFn  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN #A\@)wJ  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& k..AP<hH  
}2
0~5 !  
If BytesWrite < pFrameSize Then uVN2}3!)Y  
  ArrayToBMP2 = False kntYj}F(  
End If W[/Txc0$  
qz95)  
CloseHandle hTmpFile tnE),  
JVydTvc  
End Function #x*\dL  
7H.3.j(L  
Private Function TESTSignal() As Boolean ?fW['%  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long e>0gE`8A  
g-?@a  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) 
@Z.BYC  
>e>%AMzo[  
If extsign = 1 Then CVE(N/&b  
   TESTSignal = True 5:|9pe)  
Else &n9&k Em  
    If extsign = 0 Then ,Wv+Ek  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly ~[<C6{  
        TESTSignal = False [n4nnmM  
        Exit Function Wz%H?m:g#  
    End If galzk$D  
End If LY-,cXm&|  
G>=Fdt7Oc  
'测试视频输入类型 9A~w2z\G  
'video type L>LIN 1
A  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 U$|q]N  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) e.\dqt~%y  
If videotype = 1 Then <p/zm}?')  
        '"隔行信号(Interlaced)" bMn)lrsX  
Else -U*J5Q  
   If videotype = 0 Then Qo32oT[DM  
       '"逐行信号(Non-interlaced)" Me79:+d  
   Else S4\a"WYg  
     If videotype = -1 Then 1*" 7q9x  
       ' "不支持" F/x2}'
 
     End If 4O<sE@X  
   End If JR8|!Of@B  
End If 'i',M+0>jC  
/k8I6  
'测试垂直扫描线数 <?s@-mpgN  
'video scanlines rGQ 2 ve  
scanlines = -1 Bv<aB(c  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) wx^Det  
    If scanlines = -1 Then hC[=e`j  
        ' "不支持" ]VL} eHZ  
    Else Z_[ P7P  
        'Trim(Str(ScanLines)) + " 行数/幅" 4%2A
PvLW  
    End If 63'm @oZ  
9#TD1B/  
'测试帧频 @R%*;)*F  
'video field frequency ~7 `,}) d  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) G9NI`]k  
    If fieldfrq = -1 Then 3Q'vVNFh<  
        'lblSignal(8) = "不支持" /poGhB1k  
    Else |.VSw  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" ^s6}[LDW>@  
    End If Y?TS,   
End Function @Ddz|4vEi  
"
4\k1H"_  
^D<CoxG  
Sub PicIdentify() L&c & <+0T  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 :.4O Hp1  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 KCO.8=y3  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 D(l,Z  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 6@TU9AZS`  
A|GtF3:G  
  Dim fPTR As Long, cFrame As Long 8tQ;N'  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer TG[u3Y4  
     Q7rBc wm5  
qCg<
g  
cFrame = 0 EjL]#,QR  
[0EWIdT*b  
=* G3Khz!  
Do While cFrame < tFrames udu<Nis4  
   7mq&]4-G  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) .<zKBv  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) d\uN  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize =WjHf8v;  
   :`e#I/,  
  frmRecord.RText.Text = Str(cFrame)  V1B!5N<  
  frmRecord.RText.Refresh }/dk2!?ig  
       9wZ?")2  
  If CheckMark = True Then @4hzNi+  
   ArrayToBMP TmpBMP g'KxjjYT,  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) ffG<hclk  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" PJiU2Y33  
   TKM^  
   DrawSlice %ggf|\-e  
   P&sWn?q Ol  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) XHekz
6_  
   'If i = vbNo Then ?<${?L>  
   '  Exit Do /i3JP}  
   'End If )O"E#%  
   'cFrame = cFrame + 1 Qn7T{ BW  
   '{cSWa| #  
  End If Rjq Xz6  
  DoEvents ._^}M<o L  
  cFrame = cFrame + 1 0W(mx-[H/  
Loop  ][wb4$2  
End Sub ]R_R`X?  
n9xP8<w8  
])wdd>'  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean @>HTbs6W  
i+h*<){X  
'如标志区模式反差存在则为TRUE，否则返回FALSE /kY9z~l  
db~^Gqv6k  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long 5>I-? Ki  
CheckMark = True JcWp14~e  
   4d`YZNvZW/  
'复制标志区 qFD ZD)K  
For i = 1 To mkH 3Rc*vVnI  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 4~,Z 'k  
Next i d #1Y^3n  
H"FK(N\  
For j = 1 To PilarW * PilarH / 2 sqrLys_S  
   mTop = mTop + MKpilar(j) l::q F 0  
Next j QQBh)5F  
QkBw59L7  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH J-hJqR*;K  
   mBot = mBot + MKpilar(j) ZU73UL  
Next j g%&E~V/g$  
sq!$+ =1-X  
mTop = mTop / PilarW / PilarH * 2 HohCb4d o  
mBot = mBot / PilarW / PilarH * 2 rS{}[$Zpl  
pR$(V4>  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 D`T;j[SsS#  
 !BsQJ_H  
'平均值极值化 U?#wWbE1  
  For j = 1 To PilarH * PilarW jc&k-d>=G  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) !&{rnK  
  Next j au{)5W4~  
   5dm~yQN/  
mTop = 0: mBot = 0 2)n`Bd  
For j = 1 To PilarH * PilarW / 2 o]4]fLQ  
  mTop = mTop + MKpilar(j) x~V[}4E%>  
Next j j(=w4Sd_W  
hm,{C  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW I/`"lAFe  
  mBot = mBot + MKpilar(j) 8@t8P5(vL  
Next j `gX|q3K\s  
D5,]E`jwu  
oZa'cZN s  
  mTop = mTop / PilarH / PilarW * 3 J,F1Xmr4  
  mBot = mBot / PilarH / PilarW * 3 p?i.<Z  
   fOV_ >]u  
lI<jYd 0fZ  
If mBot > iWhite And mTop < iBlk Then GGp.u@\r  
  CheckMark = True uzBQK  
Else w}ji]V}  
  CheckMark = False Zz0bd473k?  
End If FJ_7<4ET  
End Function <y@vv  
1Cw] ~jh  
Sub Capture1Frame() }R%H?&P  
   okCaptureTo hBoard, BUFFER, 0, 1 'single qYC&0`:H  
   okGetCaptureStatus hBoard, True \baY+,Dr+  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize ZwkUd-=0i  
End Sub Cz0FA]-g  
=rA?,74  
4!IuTPmr  
Sub CopyMark(iBlk As Integer, iWhite As Integer) nGH6D2!F  
'复制标志区并返回标志区暗区与亮区的亮度平均值 N&HI)X2&  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long, mMid As Single, bsTotal As Long >v] ^nJl  
   iH8we,s'  
'复制标志区 wXIRn?z  
For i = 1 To mkH B*Tn@t W  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW )[ V8YiyU  
Next i 1&|]8=pG7  
{DRk{>K,  
For j = 1 To mkW * mkH / 2 *?FVLE  
   mTotal = mTotal + MKpilar(j) V|8'3=Z=
 
Next j mtmC,jnD  
<tD,Uu {P  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 O] @E8<?^  
j'D%eQI,V  
mTotal = 0 ek][^^4o  
For j = mkW * mkH / 2 + 1 To mkW * mkH "`>6M&`U  
   mTotal = mTotal + MKpilar(j) 0P$1=oK  
Next j 8A#,*@V[  
i#'K7XM2  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 MgeC-XQM  
M gXZN{  
'背景亮度 W_W!v&@E=  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW NiZfaC6V  
  For i = 1 To 4 * FrameW |0n )U(  
    bsTotal = bsTotal + BsLine(i) Gy q 6?  
  Next i ?()*"+N(ck  
  bsAV = bsTotal / FrameW / 4 W'C>Fn}lO?  
]3LLlXtK[  
End Sub ZSuo D$~k[  
TxJk.
c  
OG5{oH#K  
Sub AdjIMGbright(Optional bInit As Boolean = True) t#^Cem<  

7kLurv  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） )ros-dp`  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 LCivZ0?|X  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 v\:AOY '  
     jZA1fV  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer p*Z<DEh#  
   ,X|Oe@/  
  '按标准亮度与对比度采集一帧，确定背景亮度 0Y8gUpe3P6  
  currentContr = 128   '初始对比度 $gl|^
c\  
  currentBr = 128   '初始亮度 zG9FO/@av  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 cXq9k!I%  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 %g9ym@s  
  DoEvents 74([~Qs _M  
  Capture1Frame |5^ iq
W  
  '获得图像上缘4行象素 C m:AU;  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW bBi>BP=  
  CopyMark iBlack, iBright   '图像标志区亮度 ),x0G*oebj  
  For i = 1 To 4 * FrameW W`[VLi}fe  
    bsTotal = bsTotal + BsLine(i) Ca ~8cQ  
  Next i ,;pUBrz/[  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 dcf,a<K\  
   jr`swyg  
  Select Case bsAV !]F`qS>  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 o@)Fy51DD  
       currentBr = 150 Ue}1(2.v  
       currentContr = 60 1S?~c25=h  
     Case 61 To 80   '有可见背景 j,OA>{-$  
       currentBr = 140 d]E=w6+;Q  
       currentContr = 70  .\oz  
     Case 81 To 100  '有清晰背景 Ic'D#m  
       currentBr = 128 |Yli~Qx  
       currentContr = 80 & DP"RWT/  
     Case 100 To 150  '有明亮背景 OeQ[-e  
       currentBr = 140                '5:30-6:00钟实测数据 -HF?1c  
       currentContr = 50 k6#$Nb606  
     Case 151 To 180 v?He]e'  
       currentBr = 130 jkk%zu  
       currentContr = 60 _ s 3aaOL  
     Case 181 To 220  '背景全为白色 O~5t[  
       currentBr = 110 D"4*l5l  
       currentContr = 130
?8O5%IrJ  
     Case 221 To 255  '背景全为白色 g:!U,<C^a  
       currentBr = 100 n*[ZS[I  
       currentContr = 100 !j$cBf4  
  End Select ]!TE   
   bPTtA;u  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 -|V#U`mwF  
        Case 100 To 150 H,D5)1Uu  
          currentBr = currentBr - 10 JZ}zXv  
        Case 151 To 255 S<T'B0r8  
          currentBr = currentBr - 20 ?=7k<a~  
  End Select }XUL\6U  
   wqG#jC!5  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 &k'<xW?x  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ]y#'U  
End Sub !$NK7-  
y(DT^>0  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) CzlG#?kU?2  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long (PPC?6s  
     a<-aE4wdm  
    For i = 1 To 8 _n:RA)4*  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& >a975R*g  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& \:@6(e Bh  
    Next i _OGv2r  
     q lM<X?  
    For j = 1 To 1024 o
}
=*
E  
      L1 = L1 + LeftBK(j, 0) P].Eb7I  
      L2 = L2 + LeftBK(j, 1) >~ *wPoW  
      R1 = R1 + RightBK(j, 0) ,|*Gr"Q=  
      R2 = R2 + RightBK(j, 1) "EpH02{i  
    Next j ,x\qYz+7|  
    diffL = Abs(L1 - L2) / 1024 %vO(.A+  
    diffR = Abs(R1 - R2) / 1024 `
\@n&y[`7  
End Sub Lx_Jw\YO  
qb;b.P?~D$  
Function CheckSlice() As Boolean @tSB^&jUWu  
  CopySlice avSL, avSLR, avSLL |cd"cx+  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then W$X/8K bn  
    CheckSlice = True Fug4u?-n  
  Else >K'dgJ245  
    CheckSlice = False uG -+&MU?  
  End If '9QEG
/v  
End Function %e[E@H7  
B9,39rG/7+  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) t;+b*S6D  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long ;HCK iHC  
  For i = 1 To FrameH -~c-mt  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize vVMoCG"f  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize F=Xb_Gd`  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize </kuJh\  
  Next i E q4tcZ  
  For i = 1 To FrameH #6a!OQj  
    For j = 1 To sSize l[~$9C'ji  
       total = total + Slice(j, i) @|cH
DltH  
       totalL = totalL + SliceL(j, i) E-1u_7  
       totalR = totalR + SliceR(j, i) Z;N3mD+\ye  
    Next j .RmFYV0,  
  Next i ekY)?$v3  
  avSL = total / FrameH / sSize 6*B%3\z)  
  avSLR = totalR / FrameH / sSize GPni%P#a@0  
  avSLL = totalL / FrameH / sSize ts<\n-f  
End Sub r?u4[ Oe#  
;i.MDW^N  
Sub DrawSlice() Pek[j)g}  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B GH':Yk  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B N( 7(~D=)B  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B jvv=  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) wdt2T8`I/  
End Sub $hc=H
  
Sub DrawMark(pic As Control) &bq1n_  
   Dim i As Long, j As Long i\;ZEM{  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B Y'0
00#+  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B :ek^M
(  
   For i = 1 To PilarH  y=sae  
     For j = 1 To PilarW Lios1|5  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) &3IkC(yD  
     Next j sCJ|U6Q-  
   Next i ;1yF[<a  
End Sub ,~,q0PA7J  
rMVcoO@3  
Function avIMG() As Integer  #*rJI3  
  Dim i As Long, j As Long, totalIMG As Long #yIHr&'oX  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize u ]y[g  
  For i = 1 To pFrameSize '0~?zP  
    totalIMG = totalIMG + pBuffer(i) ogS
DV   
  Next i =p5]r:9 W  
  avIMG = totalIMG / pFrameSize t]Ln(r  
End Function 3{.]!  
: ' 5J[]J  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer y=pW+$k  
  Dim i As Long, j As Long, totalIMG As Long P(yLRc
 
  For i = 1 To FrameH \^0>h`[  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth (xvg.Nby  
  Next i FO>!T@0G  
  For i = 1 To FrameH * barWidth =}tomN(F~[  
    totalIMG = totalIMG + pBuffer(i) 4pMp@b  
  Next i $aEv*{$y  
  avRegion = totalIMG / pFrameSize s)E8}-v  
End Function tq,^!RSbZ  

一共这么多文件。 y@$E5sz  
{5  pK8  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 'ParM
T  
第6车皮 - |DWPU! "  

S-\wX.`R1  
hR0a
5  
第9车皮 ud)WH
|Z  
% X\A|V&  
  

从这里里分离出来的。

,%x2SyA  
%nq<nfDT  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 Kc^ctAk7;  
&Q"vXs6Gt  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ txnH~;(  
? uTuO  

继续填个坑： hF^JSCDz l  
s/~[/2[bnf  
用VBA控制WORD自己修订学生毕业文的格式。 =M@)qy