引用

引用第20楼newport93于06-14-2010 13:47发表的  : l<UJ@XID$  
1Gp|_8  
老五，I 服了U。 ;~"#aL50fe  
xX~; /e&,  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 f^[u70c82  

|IZ
FWZd  
i:sb_U+M  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! {s
3j}&  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : ]}9D*V  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? (;2]`D [x  

VI;)VJbq  
0#!Z1:Y  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  :
4L/8Hj#g  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 Z:Nm9m  

+*Pj,+;W  
qA
irH1#  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 3sz?49tX  
822jZ sb  
可以从宽不？

引用

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

F'3-*>]P  
D",~?  
其实标题没有什么，卡总既然改了就不必再改回了。  &&sCaNb  
<"}WpT  
主要是当初写的时候真是顶着锅盖写的。 PtT$#>hx]  
JB(P-Y#yyA  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : RmcQGQ
 
哦, 打倒忽悠大家的家伙.      K^fH:pV  

>Vv
js  
}ikJa  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : 5\|u] ~b  
每个人的故事对其他人都是故事, "8|a4Y+F  
自己的故事也是其中之一. Rr0@F`"R  
跳出来看, sHi*\  
不过是众人中的一个人的故事. Lm}J&^>  
MEZc/Ru-[  
所以,接着听故事. U)g27*7
  
&@anv.D  
女人们有兴趣的就等老伍开个新帖或者跟贴, hJcN*2\:  
听他痛说恋爱革命历史.... c _faW  
O.g!k"nas&  
杂家接着听他自学程序员历史, ,@*Srrw  
高级程序员考了吗? (aa}0r5  

pHkhs{/X  
i9%cpPrg8  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ g0 NSy3t  
gkN )`/`*  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 !p#+I=  
(@y te  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 t)hAD_sf  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : h72#AN  
引用第19楼伍胥之于06-14-2010 12:33发表的  : !=w&=O0(  
#=* y7w  

B}YpIb]d  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 D)*OQLHW  
hn@T ]k  
我连一级也没有考过。 ")cJA f  
. mm,be.  

Z
So#vQ  

引用

[c=T)]E1  
矬子里拔将军... M XX:i  
你们那里的俗语是吧? YLEa;MR  
5sc`L  
我们这里说"矮子里拔长脚"..应该是同一个意思... M((]> *g  
6]*~!al?  
有趣....各地有表达意思一样却方式不同的俗语.... n,E=eNc  
h*JzJ0X  
e<;^P(g`E  
你的文章写的有脸皮,没屁眼的, vS$_H<;P  
让看客大为不满... H^<LnYZ  
_,m|gr,S  
你等着,,估计你以后接到的午夜凶铃就多了... KS6H`Mm}/  

5lc%GJybV  
#~Z55D_  
我到现在也没有接到你的午夜凶铃呢！ *+wGXm  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : ;GgW&*|  
伍SIR，再次抱拳佩服 0Ek+ }`  

Zss `##  
C25r3bj  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : ;0R>Dg  
佩服，玩也玩得这么专业！ krw_1Mm  

sU/R$Nbr  
`Z}7G@ol  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : <HLe,  
lYS+EVcR  
介个真的看不懂。 j#C1+Us  
你说你老啦，喜欢怀旧了，才想起来填坑。 M%3\]&  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 wQ7G_kVp  

fcuU,A  
'%u7XuU-]  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 =9lrPQ]w  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ 6
(Qr!<  
DWORD dwCB; Bc/'LI.%  
LARGE_INTEGER  offset; ?HP54G<{xz  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); #!m`A+!~!  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); _::q S!  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ \,w*K'B_Y  
DWORD error = GetLastError(); fI/?2ZH  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); 1|?8g2Vf  
return FALSE; D*>EWlZ   
} _e ]jz2j  
return TRUE; aXoD{zA  
} n9;z=   

'VB 6.0 版 'THcO*<  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 & *^FBJEa.  
IZ$7'Mo86  
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 V-y"@0%1  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long ;{n@hM*O  
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 Br}&  
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 >y2;sJ4]D%  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long Vr1Wr%  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 qfO=_z ES  
CO
E,pb17  
GwOn&EpY!  
Private Const GENERIC_READ = &H80000000 PY4RwN  
Private Const GENERIC_WRITE = &H40000000 %TY;}V59b  
X>[x7t:  
Private Const FILE_SHARE_READ = &H1 2 kOFyD  
Private Const FILE_SHARE_WRITE = &H2 fkp
rTk^#  
Private Const OPEN_EXISTING = 3 r((2.,\Z  
n~1'M/wh  
Private Const INVALID_HANDLE_VALUE = -1 _h% :Tu  
+0w~Skd,  
'//file seek wknr^A  
Private Const FILE_BEGIN = 0 !b esMZ  
Private Const FILE_CURRENT = 1 14[+PoF^A  
Private Const FILE_END = 2 NF}QQwG3  
YWV"I|Z  
Private Const ERROR_SUCCESS = 0& 69 PTo  
P9Gjsu #  
'//device io control 7j>NUx=j3  
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 *H"IW0I  
yj^LX2x"  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 y^rcUPLT  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 @} nI$x.  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 KtT.WHr(m  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 ~*3obZ2>2  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C S~dD;R  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 }~?B
>vZS  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F J3]!<v=  
~wMdk9RQ  
'//type x>>#<hOz[  
Private Type LARGE_INTEGER ]x8_f6;D  
    lowpart As Long *4i)aj  
    highpart As Long F S3MR9  
End Type Quc,,#u  
A
`=;yD  
Private Enum MEDIA_TYPE I9! eL4e  
    Unknown uCc .dluU  
    F5_1Pt2_512 )HrFWI'Y  
    F3_1Pt44_512 c+6/@y  
    F3_2Pt88_512 Q}KNtNCpx  
    F3_20Pt8_512 CQf<En|1  
    F3_720_512 E%eTjvvxus  
    F5_360_512 Dq#/Uw#  
    F5_320_512 tQSj[Yl  
    F5_320_1024 m;=wQYFr{I  
    F5_180_512 .6,+q2tyk,  
    F5_160_512 Xq3n7d.  
    RemovableMedia IL:d`Kbqf  
    FixedMedia dLtSa\2Hn  
End Enum ,0'Yj?U>  
b`NXe7A  
Private Type DISK_GEOMETRY 4"OUmh9LHB  
    Cylinders           As LARGE_INTEGER hX-([
o  
    MediaType           As MEDIA_TYPE + d[A'&"  
    TracksPerCylinder   As Long DCJmk6p%0  
    SectorsPerTrack     As Long y_^w|  
    BytesPerSector      As Long bv.DW,l%'  
End Type 7eQE[C  
HF9\SVR B  
'//private vars
ugtzF  
Private hDisk           As Long             'disk handle Oz\mIVC#  
Private lpGeometry      As DISK_GEOMETRY    'disk info KGMX >t'  
Private lBufferSize     As Long             'the buffer size of read/write 6sRe. ct<  
&1O!guq%  
Public Function OpenDisk(ByVal FileName As String) As Boolean ]=s!cfu  
'// 打开磁盘 [}7j0&  
    hDisk = CreateFile(FileName, _ /5:f[-\s  
                        GENERIC_READ Or GENERIC_WRITE, _ GM.2bA(y  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ 6^W6As0  
                        ByVal 0&, _ e&Z\hZBb  
                        OPEN_EXISTING, _ s6#@S4^=\  
                        0, _ -S
7PnR6  
                        0) Wq bfZx  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) 9;Z2.P"w  
End Function =h?Q.vad  
}PZz(Ms  
Public Function CloseDisk() As Boolean 'bH',X8gF  
'//关闭磁盘 FmfPi .;1  
    CloseDisk = CloseHandle(hDisk) /jR]sC)xs  
End Function uCA!L)$  
,BK6a'1J  
Public Function GetDiskGeometry() As Boolean 2v!ucd}  
'//获取磁盘参数 IrAc&Ehul  
    Dim dwOutBytes      As Long =j)y.
x(  
    Dim bResult         As Boolean 4=j,:q  
     T6X%.tR>`  
    bResult = DeviceIoControl(hDisk, _ q|E0Y   
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ )V!9/d  
                                ByVal 0&, 0, _ }E01B_T9z  
                                lpGeometry, Len(lpGeometry), _ #q;hX;Va  
                                dwOutBytes, _ J{GtH[  
                                ByVal 0&) f@ &?K<  
     {K{&__Nk  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack '%W'HqVcG1  
    GetDiskGeometry = bResult 4_CV.?  
End Function ;z6Gk&?  
4Xna}7  
Public Sub GetDiskInfo(MediaType As Long, _ Mo+mO&B  
                        Cylinders As Long, _ =)56]ki}  
                        TracksPerCylinder As Long, _ U'pm5Mc\q  
                        SectorsPerTrack As Long, _ +]n.uA-`[a  
                        BytesPerSector As Long)
T5m
dC  
'//返回磁盘的参数 o8 A]vaa  
    MediaType = lpGeometry.MediaType ;Nw.  
    Cylinders = lpGeometry.Cylinders.lowpart }yCw|B|a  
    TracksPerCylinder = lpGeometry.TracksPerCylinder 8 S'g%  
    SectorsPerTrack = lpGeometry.SectorsPerTrack -Cb<T"7  
    BytesPerSector = lpGeometry.BytesPerSector ya8
1z4?  
!J34yro+s  
End Sub 9Fe(],AzF  
sZ,MNF8i  
Public Property Get BufferSize() As Long TBfX1v|Z)  
'//返回每次读/写的缓冲大小 ^*;{Uj+O~Y  
    BufferSize = lBufferSize LPjsR=xi  
End Property 5zebH  
P) ;:t~  
\
z}/=Qgc  
Public Function LockVolume() As Boolean ~R`Rj*Q2Y  
'// 将卷锁定 VS$ZR'OP0  
    Dim dwOutBytes  As Long rm7$i9DH2  
    Dim bResult     As Boolean j@1rVOmK  
     d^"dL" Q6m  
    bResult = DeviceIoControl(hDisk, _ <Sx smf0"  
                                FSCTL_LOCK_VOLUME, _ cz8%p;F:  
                                ByVal 0&, 0, _ 
gTI!b  
                                ByVal 0&, 0, _ HaP0;9q  
                                dwOutBytes, _ {HV$hU+_)Q  
                                ByVal 0&) )4d)G5{  
    LockVolume = bResult 9/lC
W  
End Function r]x;JBy  
\]y4e^FZZ  
\bt+46y@]  
Public Function UnlockVolume() As Boolean B]PTe~n^  
'// 将卷解锁 ,hj5.;
M  
    Dim dwOutBytes As Long ],*^wQ
 
    Dim bResult As Boolean zj!&12w%3  
     _":yUa0D  
    bResult = DeviceIoControl(hDisk, _
nwwKef(  
                                FSCTL_UNLOCK_VOLUME, _ ^!]Hm&.a  
                                ByVal 0&, 0, _
Tct[0B  
                                ByVal 0&, 0, _ ;4jRsirx9  
                                dwOutBytes, _ Oeo:
V"  
                                ByVal 0&) ,`7;S,f  
    UnlockVolume = bResult )" H$1  
End Function UcCkn7}  
<1(:W[M  
S~
"1q 0  
Public Function DismountVolume() As Boolean Zk+J=Cwq}  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 M@a?j<7P,m  
    Dim dwOutBytes As Long \`w!v,aM$  
    Dim bResult As Boolean {VC4rA  
     1Aq*|JSk(  
    bResult = DeviceIoControl(hDisk, _ Q AJX7  
                                FSCTL_DISMOUNT_VOLUME, _ !P7 ##ho0  
                                ByVal 0&, 0, _ y(pHt  
                                ByVal 0&, 0, _ O*3x'I*a  
                                dwOutBytes, _ q&IO9/[dk  
                                ByVal 0&) qyP|`Pm4  
    DismountVolume = bResult [\o+I:,}wi  
End Function K)2ZH@  
1'5I]D ec  
uN`{; Av  
Public Function ReadDisk(ByVal Cylinders As Long, _ {}?;|&_  
                    ByVal Tracks As Long, _ &Mset^o  
                    db() As Byte) As Boolean ^}XKhn.S'  
'//按柱面和磁道来读取磁盘数据 Z+!3m.q  
    Dim iPos    As Long zcrLd={  
    Dim lRead   As Long CIt>D'/YT  
     0B(<I?a/  
    iPos = Cylinders * Tracks * lBufferSize Bp3%*va  
     %0]vW;Q5  
    If SeekAbsolute(0, iPos) Then *_<P%J  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) "ei*iUBN:  
    End If ^(ks ^<}  
End Function ;!<WL@C~  
!GkwbHr+p  
Public Function WriteDisk(ByVal Cylinders As Long, _ =RR225  
                     ByVal Tracks As Long, _ aq[;[$w  
                     db() As Byte) As Boolean -b>"2B?  
'//按柱面和磁道来写磁盘数据 0NLoqq  
    Dim iPos    As Long S7-ka{S  
    Dim lRead   As Long I)~&6@Jn  
     Vp $]  
    iPos = Cylinders * Tracks * lBufferSize Jtj_R
l !  
     Si<9Oh  
    If SeekAbsolute(0, iPos) Then }i1p&EN^  
        WriteDisk = WriteBytes(lBufferSize, db()) nZ>bOP+,  
    End If 0_HdjK  
End Function t<O5_}R%d  
i2{xW`AcUh  
-GkNA"2M[  
'///////////////////////////////////////////////////////////////////////////////////// ;!4Bw"Gg  
'//file system /^~3Ib8Fw+  
7@g8nv(p  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean ~Mv@Bl  
'//seek file +w Oa  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte 'hl>pso.  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) Xtqjx@ye  
    If LowPos = -1 Then i/rdPbq  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) eTI<WFRc_  
    Else Bc x-t)[  
        SeekAbsolute = True uLYz!E+E  
    End If !g /&ws&  
     ~mc7O  
End Function EG5'kYw2  
W1X\!Y  
iw6qNV:\Z  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean +zxj-diM  
'//read data to array T>(nc"(  
    Dim RetVal    As Long daT[2M  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) 2M c/ah  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF F]~rA! g1  
    ReadBytes = Not (RetVal = 0) zdCeOZ 6  
     ?PNG@OK  
End Function
! /Z{uy  
*|MHQp'A  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean u49zc9  
'//write data from array I__|+%oC  
    Dim RetVal As Long Wvl>iHB  
    Dim BytesToWrite As Long 3Oy-\09  
    Dim BytesWritten As Long !j8h$+:K  
     (yFR;5Fo  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) qO= _i d  
     *F+t`<2  
    WriteBytes = Not (RetVal = 0) ^5TSo&qZ  
End Function (: IU
g   

这才是我当年写出的一个比较烂的程序 Ghgx8 ]e  
*>!O2c  
Main2.bas vS-k0g;   
H4LZNko  
Attribute VB_Name = "SubMain" Efi@hdEV  
Option Explicit O=}4?Xv  
orn9;|8q  
'采集文件与临时文件 |pJ)w  
Public Const TmpFile As String = "d:\30-0600.dat" wZVY h  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 ;crQ7}k  
A87JPX#R?  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Hlq vXt\  
Public hBCFile As Long  '记录采集参数的文件 ig:/60Z  
Public Const TmpBMP As String = "d:\1.bmp" c0]^V>}cl  
Public hTmpFile As Long 9I8{2]  
2Yt#%
bj7^  
; >3q@9\D  
'采集窗口参数常量 9l2,:EQ
*  
Public Const FrameH As Long = 280& o{yEF1,c\  
Public Const FrameW As Long = 768& e&f9/r
fx  
Public Const pFrameSize As Long = FrameW * FrameH #%k!`?^fbK  
(OT /o&cQ  
'标志区范围，用于识别车辆 2"lDKjj  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X $X_JUzb  
Public Const mkW As Integer = 28  '识别标志立柱宽度 @'U9*:}U  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) gK/mm\K@  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) &P&LjHFK  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 ZSq7>}  
'车缝检测位置常数 <A&mc,kj  
Public Const sSize As Long = 32& #|fa/kb~  
Public Const sPos As Long = 310& pN/)$6=  
Public Const sPosL As Long = 200& |R:gu\gG  
Public Const sPosR As Long = 500& fk)ts,p?  
'车缝检测框位置 &~U!X~PpB  
Public Slice(1 To sSize, 1 To FrameH) As Byte I%^Ks$<"  
Public SliceL(1 To sSize, 1 To FrameH) As Byte |du@iA]dP  
Public SliceR(1 To sSize, 1 To FrameH) As Byte W R@=[G#TJ  
Public avSL As Integer, avSLR As Integer, avSLL As Integer vz:P2TkM  
LtKiJ.j
?A  
{]plT~{e  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 N2uxiXpQZ=  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 D.o|pTZ  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 T9]|*~ ,T  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long 6>v`6  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte ([zt}uf  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 3DnlXH(h1  
\o9-[V#Gm  
 6\ /x  
Z<ozANbk  
'一次连续采集的帧数 ?P[uf  
Public tFrames As Long 9;s:Bo  
j<>|Hi #`  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 9ctvy?53H  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 `m?%{ \  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize 'EJ

8)2  
IbC(/i#%`  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte !)RND 6.  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte WyVFhAuU  
Public pWorkSpace(1 To FrameW * FrameH) As Long @\v,
  
Public Const pBufferSize As Long = FrameW * FrameH * 2 Tx?,]c,(u  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 k|Vq-w  
v!?b
EM3D  
Public hBoard As Long   '采集卡标识 N-|E^XIV  
Public mBufferAddr As Long  '缓存地址 /]_T
  
Public BufferSize As Long  '缓存大小(字节)
R*IO%9O  
Public iCurrentCard As Long  sBY*9I  
Public CapStatus As Long 'M185wDdAl  
Public iFrames As Long d_=@1JM>  
Public currentBr As Byte, currentContr As Byte ;>_\oZGj_  
6lO]V=+  
Public hMEM As Long, mStatus As Long GwxxW  
Public Const hMemSize As Long = pFrameSize * 4 V0 x[sEW  
Public hMemWork As Long qEr2Y/:i"  
Public Const hMemWorkSize As Long = pFrameSize * 5 }$3eRu +  
+9G GC  
x/
Se /C  
#k8bZ?*:  
'串口接收轨道衡数据 aO('X3?  
Public WeightFromCom As String 0ZPwE
P  
Public bReceiveComplete As Boolean BL<
.u  
Xn-GSW3{  
/kE3V`es  
Public Type GrayBMPHeader <y=VDb/  
  Tag As Integer M>dP 1  
  FileLength As Long    '文件大小 9K~2! <  
  Reserve1 As Long X=_pQ+j`^  
  DataOffset As Long    '图像数据偏移量 pDb5t>  
  BMPHeaderSize As Long  '文件头长 =8$//$  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… o9G%KO&;D,  
                        'the following sizes are possible: B PTQm4TN  
                        '28h - windows 3.1x, 95, nt, … {8UYu2t  
                        '0ch - os/2 1.x TSqfl/UI  
                        'f0h - os/2 2.x $A"kHS7T  
s42M[BW]  
  ImageWidth As Long           '图像宽（像素数） #pP4\n-~hU  
  ImageHeight As Long          '图像高(像素数) y0cHs|8  
  PlaneNumber As Integer  '图像层数 jW*|Mu>2  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap m\`dLrPX4j  
                                        '4 - 16 color bitmap n"8vlNeW  
                                        '8 - 256 color bitmap q\ FF)H  
                                        '16 - 16bit (high color) bitmap %`%oupqm+  
                                        '24 - 24bit (true color) bitmap pC l[DE  
                                        '32 - 32bit (true color) bitmap c
jt<&b*  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) PE3FuJGz  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) By{zX,6'  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) 7l> |G,[c  
                                    '3 - bitfields (also identified by bi_bitfields) ;LE4UOK  
  IMAGESIZE As Long  '图像数据字节数 8A}w}h  
  hResolution  As Long  '水平分辩率  像素数/米 PVH
JIB  
  vResolution  As Long  '垂直分辩率 q65KxOf`  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 ia 1Sf3  
  ImportantColors As Long >_P7k5Y^  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 Nq1la8oQ3  
End Type 0xrr9X<  
G%w.Z< qy  
zbK=yOIOd  
tAFKq>\  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader l P& 7
U  
Public sRECT As RECT XL@i/5C[  
,/AwR?m  
Vy0s%k  
Public conn As ADODB.Connection \Km!#:  
Public rsTrain As ADODB.Recordset #j -
bT4!  
Public rsOperater As ADODB.Recordset P:h
;"  
Public rsGoods As ADODB.Recordset $X8(OS5d'  
Public rsGood2 As ADODB.Recordset :+{G|goZ*  
Public rsSender As ADODB.Recordset `<!Nk^2ap  
Public rsReceover As ADODB.Recordset '^ bB+  
Public rsTrainTMP As ADODB.Recordset /ylO["<Q  
JP`$A  
jY%&G#4  
'打开采集卡 rF:C( {y  
'设置参数 /!;oO_U:#  
'设置为实时单帧采集到缓存方式 |niYN7 17  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 <+UEM~)  
+a aj3m  
GL$!JKWp  
Sub Main() qp_lMz  
  Dim i As Integer, status As Long "V-k_d "  
     j78WPG  
   InitBMPinfo Hs/ aU_  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 A^:[+PJHN  
    BMPHeader.Tag = &H4D42 =!T@'P?  
    BMPHeader.ImageWidth = FrameW \7PPFKS  
    BMPHeader.ImageHeight = FrameH F8M&.TE_3  
    BMPHeader.BMPHeaderSize = &H28 DhY.5  
    BMPHeader.PlaneNumber = 1 r!SMF]?SJ  
    BMPHeader.bpp = 8  H"czF  
    BMPHeader.Compression = 0 I Y%M5
(&Q  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 u~n*P``{  
    BMPHeader.vResolution = &H1274 x8k7y:
 
    BMPHeader.ColorsinBMP = 256 ,T@+QXh  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP .zQ:u{FT  
    BMPHeader.DataOffset = Len(BMPHeader) &5puGnTZ  
    For i = 0 To 255 IvGQ7 VLr  
      BMPHeader.Pallate(i) = RGB(i, i, i) 6yk=4l \  
    Next i j#QJ5(
#  
    BMPHeader.IMAGESIZE = FrameH * FrameW 52?zBl`|  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE )QYg[<e6  
Ix @rn  
c*2U'A  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) [xzgk[>5  
     eygmhaE  
    BMP1.ImageWidth = FrameW OE
' ?3S  
    BMP1.ImageHeight = FrameH * 2 r/zuo6"5  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight jGpSECs  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE {T4F0fu[eR  
Oxs O  
  '确定标志位置,为pilarX, pilarY确定初始值 |f), dC  
   PilarW = mkW ITJ{]7N  
   PilarH = mkH  '此两项为固定值 D \|$!i}  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) F: %-x=q  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 )!.ef6

|  
   yO*~)ALb+  
   lM1~K  
  '连续采集记录文件 it]im  
  ' 建立一个缓冲区为页对齐方式的文件 i ,Cvnp6Lv  
  If Dir(TmpFile) <> "" Then TI4#A E  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ i!g}PbC[  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) .j?`U[V%a  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 "1O!Ck_n  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 873$EiyXR  
  Else abiZ"?(  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ Cbu/7z   
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) hkV;(Fr&z  
  End If t80s(e  
  If hFile = 0 Then fB^h2  
    MsgBox TmpFile & ": File Open Error", vbOKOnly a(AKVk\  
    Exit Sub e$]`  
  End If -!MrG68  
  '采集参数记录文件 f%vJmpg  
hBCFile = FreeFile() HT&CbEa4'  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile /(I V+  
   ~hK7(K  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 uQh dg4  
If hMEM = 0 Then  m(CW3:|  
    fStatus = GetLastError Z(DCR/U=(>  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 0VsQ$4'V^  
     & "请向技术人员报告该错误代码。", vbOKOnly d 90  
    CloseHandle hFile oV"d%ks  
    Exit Sub x`T  
End If ro|mWP0  
xCN6?  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) YXCltM E  
If hMemWork = 0 Then Zjis0a]v~k  
    fStatus = GetLastError _M'WTe  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ fkf69,+"]  
     & "请向技术人员报告该错误代码。", vbOKOnly k(LZ,WSR  
     '释放已成功分配的内存 n@5Sp2p  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) @>`+eg][?P  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) ,/0Q($oz
 
     |dIP &9  
    CloseHandle hFile K$v SdpC  
    Exit Sub \kSoDY`l&  
End If e_'/4 n  
$pW6a %7  
' Test writing y/=:F=H@w  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ^b|Z<oF  
     'a.n
  
   '初始化采集卡参数 yg({g "  
   iCurrentCard = -1 mGx!{v~i&  
   hBoard = okOpenBoard(iCurrentCard) ;fomc<  
   Debug.Print hBoard HYVSi3[  
   If hBoard = 0 Then +B(x:hzY9  
      ExitGrabber j"(o>bv7  
      End tGt/=~n9  
   End If <0lXJqd  
   okGetBufferSize hBoard, mBufferAddr, BufferSize 5=/&[=  
   If mBufferAddr = 0 Then $!Z><&^/  
     MsgBox "缓存不存在！" ycYT1Sg8  
     ExitGrabber 0XouHU  
   End If s18o,Zs'  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) vHR-mQUs  
   X3 [gi`  
   fH#yJd2?f  
   currentBr = 128: currentContr = 128 l e+6;'Q  
   '设置视频输入参数 ;R[  xo!  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 t~5m[C[`w  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input 3#GZ6:rVJ  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 |OW/-&)  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 &\<!{Y<'  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 q
5 eyle6  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 7$3R}=Z`\q  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） V{!fag  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) YywiY).]@  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值)
wq yw#)S  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 Br/qOO:n$}  
   +*u'vt?  
   '设置采集参数 \s_lB~"P!3  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 {g8uMt\4  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 3OnIAk3  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 3V=(P.ATm  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 GJZGHUB=>  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 Bmx+QO  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 c:#<g/-{wM  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 Pd gn 9  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 [zXKS|  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 bVfFhfh*  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 5)712b(&  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 )ph**g  
   UN ;9h9  
   vW6 a=j8  
   okCloseBoard hBoard 1.S7MSpTV  
   Sleep 50 -CV_yySc  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 J%VcvBaJm  
   Xjb 4dip  
   '设置数据传送方式  R&oC
9<  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ?O(@BT  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 tW<i;2 l  
   MZYh44  
   sRECT.Right = -1   '用于获得当前设置值 ]5(T{  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) 5zk<s`h  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom JFAmND;+  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 SCwAAE9s]  
   sRECT.Left = 0 w+A:]SU  
   sRECT.Top = 0 mjgwU8'![  
   sRECT.Right = sRECT.Left + FrameW pypW  
   sRECT.Bottom = sRECT.Top + FrameH * 2 5L ]TV\\  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) /#mq*kNIM6  
   DI9hy/T(  
   sRECT.Right = -1   '检查新设置值 >?Y)evW  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) { 'A`ram  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom eKRslMa  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) Z_b^K^4  
   &d,chb (  
   If TESTSignal = False Then j /d?c5  
      'ExitGrabber 3=[#(p:  
   End If nsT]Yxo%M  
   JFOto,6L:  
   |gXtP-  
   ,m4M39MWJ  
   '设为实时采集状态 E`E$ }iLs  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) MmIVTf4  
   0!4;."S  
   b:%z<vo
 
   '单帧采集 Kmy'z  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 S8=Am7D] 1  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) \.0cA4)[$  
   okCaptureTo hBoard, BUFFER, 0, 1 'single mM`zA%=  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 V[9#+l~#  
   '   Sleep 20 K6u Z4 m;  
   'Loop /"~ D(bw0=  
   okGetCaptureStatus hBoard, True bx!uHL=  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize {;:QY1QT  
   '写入768*576测试图象 QuF76&)7  
   ArrayToBMP TmpBMP u_kcuN\Sq  
   cb36~{  
   '打开数据库 X?6E0/r&9  
   Set conn = New ADODB.Connection kXjrc  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ K&L9Ue  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ rw CFt6;v  
      "; Mode=Read|Write" |X}H&wBWo  
   conn.Open (I<]@7>  
   !T+jb\O_  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) [cJQ"G '  
   frmRecord.Visible = True z-9@K<`H  
   frmQuery.Visible = True Mn)>G36(  
   Load frmReceiveFromComm $O
\I9CGr$  
   i4sd29v  
   '调试参数 p#14  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then |\HYq`!g%7  
     SignalBox.Visible = True @.rVg XE=!  
   End If ';H"Ye:D=7  
   If InStr(UCase(Command()), "/COMM") > 0 Then WUC-*(  
     frmReceiveFromComm.Visible = True }Iyr u3M][  
   End If r'TxYM-R  
t1LIZ5JY  
End Sub (~59}lu~  
3o).8b_3g  
Sub ExitGrabber() \VL_  
  '关闭数据库 i oIOyj  
  '关闭采集卡 Z)JJ-V!  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) eA4dDKX+  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Kmk}Yz  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) 6CQ.>M:R  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) C-wwQbdG/  
  okStopCapture hBoard O"'.n5>:`  
  okCloseBoard hBoard 
"o| f  
  CloseHandle hFile ;N+ v  x  
  Close #hBCFile 8S8^sP  
  conn.Close |6qxRWT"  
  End ? nVwT[  
End Sub 4[\$3t.L
 
o0yyP,?yh  
Function ArrayToBMP(ByVal File As String) 5,Q3#f~!  
Dim BytesWrite As Long JPo.&5k  
* ':LBc=%  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ rwZI;t$hf  
  CREATE_ALWAYS, 0&, 0&) y#Cp Vm#!>  
F'
v3caE  
If hTmpFile = 0 Then tVAWc$3T  
   ArrayToBMP = False {z^6V\O5  
   Exit Function t>f61<27eB  
End If ^A&i$RRO  
A$6T)  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN q5Bj0r[/o  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& 4jWzYuI&J  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN ZQL4<fy'E  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& >rbHpLm1`  
uq
/z.m  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN \BRxdK'  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& y15 MWZ  
`5HFRgL`.
 
If BytesWrite < pFrameSize Then K;n2mXYGM  
  ArrayToBMP = False $A4rdhvd  
End If V
XE85  
=)h<" 2  
CloseHandle hTmpFile tEU}?k+:j)  
G<F+/Oi&DX  
End Function \hlQu{q.  
`&3hfiI}  
Function ArrayToBMP1(ByVal File As String) | c:E)S\  
;8|D4+  
Dim BytesWrite As Long |E& Fe8  
 9S<87sO  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ -K"" 4SC2  
  CREATE_ALWAYS, 0&, 0&) \t pJ   
Z$UPLg3=;_  
If hTmpFile = 0 Then <N4)X"s  
   ArrayToBMP1 = False rP5&&Hso  
   Exit Function TO(2n8'fdO  
End If asT/hs SNS  
Lc&L F*  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN 5} v(Ks>  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& Vxr_2Kra  
WFGcR9mN?  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN dkHye>  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0&
t:N YsL  
/J0Y
F  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN G,{=sFX  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& Z.4 vKO[<  
r>>4)<C7J  
If BytesWrite < pBufferSize Then uTWij4)a  
  ArrayToBMP1 = False "wPA;4VQ  
End If n]G_# ;  
qw#wZ'<n  
CloseHandle hTmpFile :,<G6"i  

r Jo8|  
End Function FW~{io]n  
&Zxo\[lP  
'使用该过程建立的文件要求在用后关闭 cWNZ +Q8Y  
Public Function ArrayToBMP2(File As String) As Boolean z~O#0Q!  
4qd =]i  
Dim BytesWrite As Long [lU0TDq  
>A]U.C  
ArrayToBMP2 = True # N
oY}*  
bF85T(G  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 3SI~?&HU!/  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) 8+7n"6GY2/  
qD/GYqvm  
If hTmpFile = 0 Then xSf&*wLE  
   ArrayToBMP2 = False .C6wsmQ  
   Exit Function G}2DZ=&>'  
End If I.4o9Z[?  
}3
b3^f  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN iY|zv|;]=  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& sp&s 5aw  
pBZf=!+E  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN BzVF!<!  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& d`XC._%^J  
+t9$*i9`L  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN 3?}\Hw  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 34D7qR  
A:-MRhE9X  
If BytesWrite < pFrameSize Then
v$WH#;(\  
  ArrayToBMP2 = False v+), u j  
End If jfLkp>2E'  
i)@IV]]6yL  
CloseHandle hTmpFile +qWrm|
O]  
fZq_]1(/uP  
End Function bOB<m4  
gv
6}GE
 
Private Function TESTSignal() As Boolean "k;j@  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long eX{: &Do  
vU4Gw4  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) Bql
5=p  
xr;:gz!h  
If extsign = 1 Then tny^sG/'  
   TESTSignal = True K)D5%?D  
Else hc2AGeZr  
    If extsign = 0 Then \!*3bR  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly H3}eFl=i2  
        TESTSignal = False s(0S)l<  
        Exit Function y ~PW_,  
    End If 6\+ZTw  
End If JU6PBY~C'  
Q5ZZ4`K!  
'测试视频输入类型 ZaNZUVBh  
'video type 4!q4WQ ;  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 %2S+G?$M?  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) f;PPB@ :`$  
If videotype = 1 Then 0 P+B-K>n  
        '"隔行信号(Interlaced)" vp[;rDsIJ$  
Else Tz`O+fx&  
   If videotype = 0 Then `<?{%ja  
       '"逐行信号(Non-interlaced)" TKwMgC}<[  
   Else *X_-8 ^~  
     If videotype = -1 Then u|.c?fW'3  
       ' "不支持" 4s:S_Dw  
     End If o+wG69  
   End If M0B6v}^H  
End If X\=m  
?k 4|;DD  
'测试垂直扫描线数 tx+KxOt9Y  
'video scanlines ym]12PAU5  
scanlines = -1 ?Z1&ju,Hd-  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) 4lb(qKea  
    If scanlines = -1 Then KTmduf7DL  
        ' "不支持" j;BMuLTm1  
    Else ?Nbc#0pb7  
        'Trim(Str(ScanLines)) + " 行数/幅" q2$-U&  
    End If :rdw0EROy  
 Y  ,  
'测试帧频 >*wF~G*k  
'video field frequency M*+MhM-  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) Pse1NMK9 [  
    If fieldfrq = -1 Then hoj('P2a#n  
        'lblSignal(8) = "不支持" Yn~N;VUA  
    Else 8E/wUN,Lxj  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" lI)RaiMr=  
    End If Vgj&hdbd  
End Function @)\{u$  
t+H=%{z  
ycD}7  
Sub PicIdentify() Z$X[x7e.  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 v MlT  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 WGK:Xf
OBQ  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 >u-6,[(5X*  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 rUz-\H(-  
7CGxM  
  Dim fPTR As Long, cFrame As Long I7S#vIMXR.  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer #W]
4aZ1  
      pxuZ=<  
Uo~-^w}  
cFrame = 0 }C'H@:/  
?*nFz0cs^  
76} a  
Do While cFrame < tFrames m|CB')  
   cn3F3@_"\  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) Miw*L;u@W  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) q
^I/   
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize .{=|N8*py8  
   ycPGv.6  
  frmRecord.RText.Text = Str(cFrame) pBbfU2p  
  frmRecord.RText.Refresh ='\Di '*  
       *l-f">?|  
  If CheckMark = True Then 2w7PwNb*32  
   ArrayToBMP TmpBMP e7$ZA#A_5v  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) v/s6!3pnl  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" 4
PcsU HR  
   d3IMQ_k  
   DrawSlice {9,!XiF.:  
   p`PBPlUn  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) j "^V?e5  
   'If i = vbNo Then AB:JXMyK  
   '  Exit Do Sc?UjEs  
   'End If O^2@ 9 w  
   'cFrame = cFrame + 1 p'fD:M:  
   xMpQPTte  
  End If H}p5qW.tH:  
  DoEvents #Bih=A #  
  cFrame = cFrame + 1 &Q>tV+*  
Loop 
nZtP!^#  
End Sub 3= q,k<=L  
fqY;>Z  
'G#T 6B!  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean a*D])Lu[  
1Z$` }a  
'如标志区模式反差存在则为TRUE，否则返回FALSE Q,`R-?v  
\y^Ho1Fj  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long Ofm?`SE*|  
CheckMark = True Ch;wvoy  
   fecV[  
'复制标志区 Twi7g3}/jB  
For i = 1 To mkH "R!)"B==  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW qs|{  
Next i f6*6*=  
?x\tE]  
For j = 1 To PilarW * PilarH / 2 O/N@Gz[g%  
   mTop = mTop + MKpilar(j) -aV!ZODt  
Next j K8R}2K-Y  
>Av[`1a2F  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH l$\
OSG  
   mBot = mBot + MKpilar(j) CI}zu;4|  
Next j  45qSt2  
B(zcoWQ*B  
mTop = mTop / PilarW / PilarH * 2 lG>,&(  
mBot = mBot / PilarW / PilarH * 2 nG~#o  
h,palP6^  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 `a+"[%  
jMAZ4M  
'平均值极值化 ; Pd nE~  
  For j = 1 To PilarH * PilarW e r%D`VHe  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) ?nwFc3qw  
  Next j )*CDufRFz  
   `zw^ WbCO{  
mTop = 0: mBot = 0 [2l2w[7Rid  
For j = 1 To PilarH * PilarW / 2 ^tr?y??k  
  mTop = mTop + MKpilar(j) oZ!1^o3V  
Next j nRSiW*;R  
~Q
3y3,x  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW h;lg^zlTb  
  mBot = mBot + MKpilar(j) Y+kfMAv  
Next j d$?sS9"8(  
W[R^5{k`  
JHvawFBN<u  
  mTop = mTop / PilarH / PilarW * 3 qx;8Hq(E[  
  mBot = mBot / PilarH / PilarW * 3 b<]
Ae!I'  
   "gQ-{ W  
 A|90Ps  
If mBot > iWhite And mTop < iBlk Then -"9&YkN  
  CheckMark = True 3$yOv"`  
Else y+"6Y14  
  CheckMark = False vTk\6o q  
End If fp)%Cr  
End Function Af`qe+0E  
937 z*mh  
Sub Capture1Frame() knS(\51A  
   okCaptureTo hBoard, BUFFER, 0, 1 'single Ob~7r*q  
   okGetCaptureStatus hBoard, True >Hd0l L  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize {: H&2iF  
End Sub 6]D%|R,Q#}  
.:U`4->E  
\8}!aTC  
Sub CopyMark(iBlk As Integer, iWhite As Integer) IHs^t/;Iv  
'复制标志区并返回标志区暗区与亮区的亮度平均值 Z6S?xfhr'{  
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 $.0l%
$7  
   OBm#E}  
'复制标志区 S!r,p
};  
For i = 1 To mkH xk/osbKn  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW er44s^$  
Next i Fs}vI~}  
c*~/`lG  
For j = 1 To mkW * mkH / 2 7+Z%#G~T  
   mTotal = mTotal + MKpilar(j) pFW^  
Next j 5X1z^(   
hUo}n>Aa  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 EG &97lb  
Al0ls  
mTotal = 0 6 *GR_sMm  
For j = mkW * mkH / 2 + 1 To mkW * mkH =U- w!uW  
   mTotal = mTotal + MKpilar(j) >[A7oH  
Next j S5(VdMd"^  
Xk]:]pl4W  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 ^K]`ZQjKC  
t~0!K;nn  
'背景亮度 a:V2(nY  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW m,X8Cy|vQ  
  For i = 1 To 4 * FrameW k7cM.<s!  
    bsTotal = bsTotal + BsLine(i) ~#SLb=K   
  Next i i .GJO +K  
  bsAV = bsTotal / FrameW / 4 Gp.XTz#=  
O`rKxP  
End Sub ~B704i  
t)__J\xF  
mFa%d8Y  
Sub AdjIMGbright(Optional bInit As Boolean = True) 7J6D wh{  
{S6:LsFfm  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） 9[@K4&  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 U
1y8Y/  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 5 >c,#*  
     Q8GI;`Rb  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer U-6pia/o  
   H(rK39Q  
  '按标准亮度与对比度采集一帧，确定背景亮度  rFLm!J]  
  currentContr = 128   '初始对比度 }1}L&M@  
  currentBr = 128   '初始亮度 q,%lG$0v  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ,"xr^@W
 
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 h|Ah\P?o  
  DoEvents Wq"5-U;:w  
  Capture1Frame ; VH:dg  
  '获得图像上缘4行象素 $e
U oFa5A  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW \nbGdka  
  CopyMark iBlack, iBright   '图像标志区亮度 O}Mu_edM  
  For i = 1 To 4 * FrameW d
Z6P)R  
    bsTotal = bsTotal + BsLine(i) 7mT iO?/y<  
  Next i pj9*$.{  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 BufXnMh.  
   ,3P@5Ef  
  Select Case bsAV DPg\y".4Y&  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 EU,f;H  
       currentBr = 150 >2BWie?T  
       currentContr = 60 41XS/# M$*  
     Case 61 To 80   '有可见背景 ygo4.  
       currentBr = 140 9,J^tN@^  
       currentContr = 70 6>)oG6  
     Case 81 To 100  '有清晰背景 C>=[fAr mO  
       currentBr = 128 Po*G/RKu4W  
       currentContr = 80 eR|u']Em>T  
     Case 100 To 150  '有明亮背景 E},^,65  
       currentBr = 140                '5:30-6:00钟实测数据 ZT d)4f  
       currentContr = 50 RqU^Q*/sF
 
     Case 151 To 180 (`cXS
5R  
       currentBr = 130 *Ud=x^JxO  
       currentContr = 60 sL",Ho  
     Case 181 To 220  '背景全为白色 J`d_=C?J  
       currentBr = 110 !+H)N  
       currentContr = 130 ODFCA. t  
     Case 221 To 255  '背景全为白色 /JGE
T  
       currentBr = 100 `iZ){JfAH  
       currentContr = 100 DV!10NqUr  
  End Select y{k65dk-  
   =#so
[Pd  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 F[5sFkM7  
        Case 100 To 150 7]F@g}8  
          currentBr = currentBr - 10 'Z}3XVZEN  
        Case 151 To 255 m3']/}xHO  
          currentBr = currentBr - 20 J-U5_>S  
  End Select /!A?>#O&.  
   $)v`roDD.  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 &peUC n  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 {Q~HMe`,  
End Sub 
w'Vm'zo  
jM5w<T-2/  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) bD:[r))#e  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long IZSJ+KO
 
     s,|"s|P  
    For i = 1 To 8 &$NYZ3?9  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& e anR$I;Yj  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& KSgYf;  
    Next i |x+g5~$  
     <_ruVy0]  
    For j = 1 To 1024 S-2@:E  
      L1 = L1 + LeftBK(j, 0) {Lg]chJq?  
      L2 = L2 + LeftBK(j, 1) j0uu*)Rk  
      R1 = R1 + RightBK(j, 0) M$$Lsb [  
      R2 = R2 + RightBK(j, 1) 8:gUo8  
    Next j S9k A69O  
    diffL = Abs(L1 - L2) / 1024 {7Qj+e^  
    diffR = Abs(R1 - R2) / 1024 kdW$>Jqb  
End Sub lK"m|Z  
rInZd`\  
Function CheckSlice() As Boolean - U Elu4n&  
  CopySlice avSL, avSLR, avSLL yR$ld.[uf  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then $i9</Es P  
    CheckSlice = True X"EZpJ'W  
  Else u.rFZu?E\  
    CheckSlice = False X6-;vnlKN  
  End If kesuM3  
End Function iyJx~:  
76eF6N+%}t  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) 66C_XT  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long MG-

#p8  
  For i = 1 To FrameH !lxq,Whr{  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize UNF@%O4_T  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize p6AF16*f0  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize c_Lcsn  
  Next i E5QQI9ea  
  For i = 1 To FrameH uFYcVvbT@  
    For j = 1 To sSize ]y\Wc0q  
       total = total + Slice(j, i) zXZXp~7)  
       totalL = totalL + SliceL(j, i) 0?Bv zfb  
       totalR = totalR + SliceR(j, i) 
pZ)N,O3  
    Next j i38`2  
  Next i ]WvV*FL9D3  
  avSL = total / FrameH / sSize  \<u  
  avSLR = totalR / FrameH / sSize (,I9 |  
  avSLL = totalL / FrameH / sSize ,TlYQ/j%h  
End Sub 8Xx4W^*_  
W!o|0u!D  
Sub DrawSlice() oXFo  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B 1%$Z%?  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B Xx?~%o6  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B IcJQC  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) /*1p|c^  
End Sub ]S+KH \2  
Sub DrawMark(pic As Control) &B?*|M`)k  
   Dim i As Long, j As Long 9$s~ `z)  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B *b,4qMr  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B q(\kCUy!  
   For i = 1 To PilarH =Y {<&:%(  
     For j = 1 To PilarW xRbtiFk9H  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) N!%[.3o\K  
     Next j L]Dq1q8`  
   Next i rr^?9M*{V  
End Sub 36MNaQt'e  
MRN=-|fV^  
Function avIMG() As Integer ,!vI@>nhG  
  Dim i As Long, j As Long, totalIMG As Long tRVz4
fk[G  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize +[2ep"5H  
  For i = 1 To pFrameSize t|?eNKVV9'  
    totalIMG = totalIMG + pBuffer(i) IBYSI0  
  Next i S~hoAl"xb/  
  avIMG = totalIMG / pFrameSize d=eIsP'h  
End Function
TOw;P:-  
MG:eI?G/'  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer C17$qdV/  
  Dim i As Long, j As Long, totalIMG As Long @ D.MpM}~  
  For i = 1 To FrameH jT*?Z:U  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth C+%6N@  
  Next i _V,bvHWlM  
  For i = 1 To FrameH * barWidth *X\J[$!  
    totalIMG = totalIMG + pBuffer(i) {NUI8AL46A  
  Next i S1a6uE  
  avRegion = totalIMG / pFrameSize zGtv(gwk  
End Function U(:Di]>{  

一共这么多文件。 `+!F#.  
j:7AVnt  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 Of>2m<  
第6车皮 Hu+GN3`sx^  

ART0o7B  
RZ|M;c  
第9车皮 W5>emx'>  
m(`O>zS  
  

从这里里分离出来的。

b!r%4Ah  
@9
~x@[  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

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

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ ) O&zb_{n  
;y-:)7J  

继续填个坑： 7!wc'~;  
Z}{]/=h  
用VBA控制WORD自己修订学生毕业文的格式。 z$Le,+