引用

引用第20楼newport93于06-14-2010 13:47发表的  : t` ^Vb-  
x BnbF[  
老五，I 服了U。 *gsAn<  
5"Kx9n|  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 ^C^*,V3  

,2[ra9n  
I0= NaZ7  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! Yn51U6_S  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : h5%|meZQb  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? h\[\\m O  

qB6dFl\ (  
]hw-Bu\{  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : n
n~YK  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 _cqy`p@"  

cz
Ww~'."  
$ r.U  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 Ibr%d2yS=  
*b(wVvz  
可以从宽不？

引用

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

Y>6.t"?Q^  
BNm4k7 ]M  
其实标题没有什么，卡总既然改了就不必再改回了。 Pi6C/$ K  
{")\0|2\x  
主要是当初写的时候真是顶着锅盖写的。 
GuQRn  
"cUg>a3  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : bg7n  
哦, 打倒忽悠大家的家伙.      nB@UKX  

R 1zC.m  
DZ`k[Z.VZ  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : xy^1US,L1  
每个人的故事对其他人都是故事, -Zy)5NB-tZ  
自己的故事也是其中之一. /6tcSg)  
跳出来看, zB)%lb  
不过是众人中的一个人的故事. x-Z^Q C  
vDDljQXw4  
所以,接着听故事. VWa|Y@Dc]  
7`Du5>b8  
女人们有兴趣的就等老伍开个新帖或者跟贴, L(o#4YH}>J  
听他痛说恋爱革命历史.... vA>W9OI 
 
9M2f!kJP$  
杂家接着听他自学程序员历史, bx; f`8SN  
高级程序员考了吗? ^#SBpLw  

WmVVR>0V|  
{*xBm#  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ _wu*M  
3N%{B  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 3wt  
f_<Y\  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 sBjXE>_#)  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : qS]G&l6QF  
引用第19楼伍胥之于06-14-2010 12:33发表的  : `ue?Z%p|  

P9yw&A  
Xp^$ E6YFy  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 Xw(3j)xQ  
H m8y]>$  
我连一级也没有考过。 <.$,`m,  
. ;,`]O!G:P  

ZNy9_a:dX  

引用

j+0.=#{??  
矬子里拔将军... "::9aYd!  
你们那里的俗语是吧? %UG/ak%
z  
x]'H jTqX  
我们这里说"矮子里拔长脚"..应该是同一个意思... |[WL2<  
=uc^433.  
有趣....各地有表达意思一样却方式不同的俗语.... m/?h2McS  
V.j#E1P  
<9N4"d!A  
你的文章写的有脸皮,没屁眼的, 8p,>y(o  
让看客大为不满... ;Jo*|pju  
P# bm uCOS  
你等着,,估计你以后接到的午夜凶铃就多了... 32y[  

fLM.kCD?u  
=Z
MF]|  
我到现在也没有接到你的午夜凶铃呢！ nKu(XgFv  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : &<t79d%{  
伍SIR，再次抱拳佩服 J~'~[,K  

I1v@\Rb  
/J.0s0@  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : =xoBC&u  
佩服，玩也玩得这么专业！ /rOnm=P+Q  

!8Y3V/)NU  

C?(y2p`d\  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : cS5w +
`,L  
)v};C<  
介个真的看不懂。 Zr5'TZ`$  
你说你老啦，喜欢怀旧了，才想起来填坑。 v(a9#bMZU  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 Ag<4r  

EI<"DB  
M$#+W?m&  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 l(.7t'  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ :S#eg1y.w]  
DWORD dwCB; 
]}5`7  
LARGE_INTEGER  offset; i4 P$wlO  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); Yo>%s4_,  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN);
y+l<vJu  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ Qz'O{f  
DWORD error = GetLastError(); $B*qNYpPy.  
MessageBox(NULL,"写入文件失败!",NULL,IDOK);  h=:*7>}  
return FALSE; EWSr@}2j .  
} bL+sN"Km  
return TRUE; YHJ'  
} l DgzM3  

'VB 6.0 版 -DA;KWYS  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 n(9F:N  
\?J=mE@;1  
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 H3W_}f  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long w6%l8+{R  
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 hU |LFjc  
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 $cyL
I+uz|  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long A[K:/tB  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 XA=|]5C  
B[C7G7<B  
q
=T<^Tk#e  
Private Const GENERIC_READ = &H80000000 0m qSA  
Private Const GENERIC_WRITE = &H40000000 *4zoAslU1  
?SB h^/zf  
Private Const FILE_SHARE_READ = &H1 (L]T*03#  
Private Const FILE_SHARE_WRITE = &H2 g]:..W7  
Private Const OPEN_EXISTING = 3 w;@`Yi.WQ  
R65;oJh  
Private Const INVALID_HANDLE_VALUE = -1 4&#vU(-H  
^XtHF|%0T  
'//file seek 77)OW$G  
Private Const FILE_BEGIN = 0 $[WN[J  
Private Const FILE_CURRENT = 1 ^!N;F"  
Private Const FILE_END = 2 0^-z?Kb<}  
y[TaM9<  
Private Const ERROR_SUCCESS = 0& 7MR:X#2v>  
=9#i<te  
'//device io control &pa)Ee>  
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 !$g(&  
Lx9hq7<  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 s9^"wN YQ  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 f:)]FHPB1  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 T[`QO`\5O  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 F^4*|g  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C 0;.e#(`-  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 9?EY.}~  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F aMe%#cLI  
|j\eBCnH3  
'//type PGC07U:B  
Private Type LARGE_INTEGER =f/avGX  
    lowpart As Long Yk(NZ3O  
    highpart As Long 1Al =v  
End Type +3(CGNE  
c`Lpqs`  
Private Enum MEDIA_TYPE DK2c]i^|=  
    Unknown fo/((
)  
    F5_1Pt2_512 cuJ/ Vc  
    F3_1Pt44_512 Ut0qrkqF  
    F3_2Pt88_512 RXIH(WiK  
    F3_20Pt8_512 ZYpD8u6U  
    F3_720_512 &QiAM`MbC=  
    F5_360_512 HJ2O@e  
    F5_320_512 g;| n8]  
    F5_320_1024 "a2H8x  
    F5_180_512 T#ecLD#  
    F5_160_512 +z{x
7  
    RemovableMedia cx,u2~43A&  
    FixedMedia mE)x7  
End Enum BN bb&]  
%a%+!wX0x  
Private Type DISK_GEOMETRY 1K
fJl S+  
    Cylinders           As LARGE_INTEGER kW*W4{Fth  
    MediaType           As MEDIA_TYPE }[YcilU_  
    TracksPerCylinder   As Long pZNlcB[Qn-  
    SectorsPerTrack     As Long LWp?U!N  
    BytesPerSector      As Long C{lB/F/|!  
End Type KyVe0>{_u  
x`&P}4v0  
'//private vars IFHgD}kp%#  
Private hDisk           As Long             'disk handle 6'3Ey'drH  
Private lpGeometry      As DISK_GEOMETRY    'disk info J~PTVR
  
Private lBufferSize     As Long             'the buffer size of read/write CJ37:w{%*Y  
>B|ofwm*  
Public Function OpenDisk(ByVal FileName As String) As Boolean B$iMU?B3  
'// 打开磁盘 ,58kjTM  
    hDisk = CreateFile(FileName, _ zwF7DnW<<  
                        GENERIC_READ Or GENERIC_WRITE, _ *R1d4|/G  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ &k {t0>  
                        ByVal 0&, _ y0W`E/1t  
                        OPEN_EXISTING, _ nJ
nO/~|  
                        0, _ 4kN:=g  
                        0) ^^U)WB  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) J\,@Bm|1n{  
End Function pJ<)intcbE  
YQlpk@X`2  
Public Function CloseDisk() As Boolean qCv}+d)  
'//关闭磁盘 :{e`$kz  
    CloseDisk = CloseHandle(hDisk) zXA= se0U  
End Function ~}FLn9@*  
2l;ge>DJ  
Public Function GetDiskGeometry() As Boolean n~L'icD[  
'//获取磁盘参数 QZeb+r  
    Dim dwOutBytes      As Long 0:nt#n~_  
    Dim bResult         As Boolean &AkzSgP  
     ixUiXP  
    bResult = DeviceIoControl(hDisk, _ QQ2OZy>W  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ LQuYCfj|  
                                ByVal 0&, 0, _ "@):
*3 4  
                                lpGeometry, Len(lpGeometry), _ \n('KVbf  
                                dwOutBytes, _ `\}zm~  
                                ByVal 0&) ln_EL?V  
     `s]zk {x  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack 8I|1Pl  
    GetDiskGeometry = bResult wZ#~+ }T  
End Function 6'X.[0M  
TO8\4p*tE  
Public Sub GetDiskInfo(MediaType As Long, _ Sxx.>gP"61  
                        Cylinders As Long, _ J^e|"0d  
                        TracksPerCylinder As Long, _ }p
U! 1GsO  
                        SectorsPerTrack As Long, _ SK~;<>:37  
                        BytesPerSector As Long)  Q}`2Y^.  
'//返回磁盘的参数 6 I>xd  
    MediaType = lpGeometry.MediaType pRa
oR  
    Cylinders = lpGeometry.Cylinders.lowpart u+"hr"}${  
    TracksPerCylinder = lpGeometry.TracksPerCylinder ?7uStqa  
    SectorsPerTrack = lpGeometry.SectorsPerTrack o7Z#,>`2  
    BytesPerSector = lpGeometry.BytesPerSector bC>yIjCTn  
M 2U@gC|{  
End Sub UBpM8/U  
mSqk[ Ig\  
Public Property Get BufferSize() As Long Z2Y583D  
'//返回每次读/写的缓冲大小 ;U5x'}%0]  
    BufferSize = lBufferSize <CdG[Ih  
End Property V%Z[,C u+  
E,nYtn|B  
uc{Qhw!;:  
Public Function LockVolume() As Boolean Yqj.z|}Nb  
'// 将卷锁定 m/"=5*pA  
    Dim dwOutBytes  As Long }@t'rK[  
    Dim bResult     As Boolean [~&:`I1  
     F'T= Alf  
    bResult = DeviceIoControl(hDisk, _ pu m9x)y1  
                                FSCTL_LOCK_VOLUME, _ N*c?Er@8U  
                                ByVal 0&, 0, _ 7Ohu$5\  
                                ByVal 0&, 0, _
{mq$W  
                                dwOutBytes, _ *~MiL9m+?  
                                ByVal 0&) A+P m "|  
    LockVolume = bResult A/W7;D  
End Function EKI+Dq,  
2v; 7ohK  
ps4Wwk(  
Public Function UnlockVolume() As Boolean TPmZ/c^  
'// 将卷解锁 ](( >i%%~  
    Dim dwOutBytes As Long LxYM"_1A;  
    Dim bResult As Boolean ^5iY/t~Q  
     /m|&nl8"qe  
    bResult = DeviceIoControl(hDisk, _ Aghj)V  
                                FSCTL_UNLOCK_VOLUME, _ H;"N|pBy  
                                ByVal 0&, 0, _ I'wk/  
                                ByVal 0&, 0, _ _yXeX   
                                dwOutBytes, _ WG!;,~f>o  
                                ByVal 0&) vo^9qSX f  
    UnlockVolume = bResult smQpIB;  
End Function ^?l-YnQqm?  
Ny&Fjzl  
;Bc <u[G  
Public Function DismountVolume() As Boolean j,V$vKP  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 :j50]zLy{  
    Dim dwOutBytes As Long t+Q|l&|0  
    Dim bResult As Boolean E6d8z=X(  
     w[n>4?
"{  
    bResult = DeviceIoControl(hDisk, _ Y+5A2Z)f[  
                                FSCTL_DISMOUNT_VOLUME, _ 1Tk\n  
                                ByVal 0&, 0, _ `W;cft4  
                                ByVal 0&, 0, _ )}g4Rvr  
                                dwOutBytes, _ z]4g`K+  
                                ByVal 0&) wh[:wE]eX  
    DismountVolume = bResult A0 w `o  
End Function F<'l'AsC-  
=M km:'1r  
M#gGD-  
Public Function ReadDisk(ByVal Cylinders As Long, _ 3qd-,qC  
                    ByVal Tracks As Long, _ dzC&7 9$  
                    db() As Byte) As Boolean gpTF^.(  
'//按柱面和磁道来读取磁盘数据 y{},{~FA"  
    Dim iPos    As Long 6 GevO3  
    Dim lRead   As Long ?tM].\  
     @):NNbtA  
    iPos = Cylinders * Tracks * lBufferSize SwmPP-n  
     M`,Z#)Af  
    If SeekAbsolute(0, iPos) Then X;[zfEB  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) . I9] `Q  
    End If #p:jKAc3  
End Function =xQfgj  
7ump:|  
Public Function WriteDisk(ByVal Cylinders As Long, _ )@&?i.  
                     ByVal Tracks As Long, _ "

u>sS  
                     db() As Byte) As Boolean ]> "/<"  
'//按柱面和磁道来写磁盘数据 r:\5/0(  
    Dim iPos    As Long s%?p%2&RA  
    Dim lRead   As Long Wy-quq03"&  
     frO/ nx|9  
    iPos = Cylinders * Tracks * lBufferSize Bjrv;)XH  
     I4DlEX  
    If SeekAbsolute(0, iPos) Then JnKbd~  
        WriteDisk = WriteBytes(lBufferSize, db()) oVZ8p-  
    End If }R] }@i~i  
End Function c#-97"_8  
~k<31 ez  
EG:WE^4  
'///////////////////////////////////////////////////////////////////////////////////// as47eZ0\  
'//file system )-:f;#xJ  
Bv|9{:1%X}  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean 1ROgUJ;  
'//seek file *
,=
+R$  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte .j$bCKXGx  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) \/dm}' `  
    If LowPos = -1 Then d+| !6  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) ""KN?qh9  
    Else &+|4(d1  
        SeekAbsolute = True \:)o'-  
    End If 6}FDLBA  
     }\qdow-  
End Function 2ZIY{lBe  
g|*eN{g]uE  
W;9X*I8f8  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean f0'Wq^^  
'//read data to array 7)8}8tY^{  
    Dim RetVal    As Long H\>I&gC'  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) jQBdS. }'v  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF 2dlV'U_g  
    ReadBytes = Not (RetVal = 0) )jZ=/xG  
     Kgio}y  
End Function E3C[o! 5  
HC`3AQ12!&  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean H_r'q9@<>  
'//write data from array \EfwS% P  
    Dim RetVal As Long .2-JV0
  
    Dim BytesToWrite As Long 4 ~|TKd{  
    Dim BytesWritten As Long &@Gu~)^(  
     ~0$F V  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) L5P}%1 _  
     $}c@S0%P"  
    WriteBytes = Not (RetVal = 0) wuCtg=  
End Function 7%x+7  

这才是我当年写出的一个比较烂的程序 NjyIwo0  
t'/;Z:  
Main2.bas 5K-)X9z?  
:NyEd<'  
Attribute VB_Name = "SubMain" (dt_
D  
Option Explicit ]<?)(xz  
=}KbE4D+8  
'采集文件与临时文件 ZvKMRW  
Public Const TmpFile As String = "d:\30-0600.dat" &>b1ES.>  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 4gNRln-
 
r/<JY5  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long
~0{Kga  
Public hBCFile As Long  '记录采集参数的文件 6OW-Dif^AG  
Public Const TmpBMP As String = "d:\1.bmp" ^<Tp-,J$EN  
Public hTmpFile As Long T@WMT,J6j  
>o=p5#{  
{mitF  
'采集窗口参数常量 Z|GkM5QH:  
Public Const FrameH As Long = 280& nY0UnlB`  
Public Const FrameW As Long = 768& qiryC7.E  
Public Const pFrameSize As Long = FrameW * FrameH "{xv|C<*n  
|6Z MxY  
'标志区范围，用于识别车辆 ">&:(<  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X U:jf9L2  
Public Const mkW As Integer = 28  '识别标志立柱宽度 \)]2Uh|  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) A)\DPLAG  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) Cb-E<W&2D  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 Oo .Qz
 
'车缝检测位置常数 1}M.}G2u/  
Public Const sSize As Long = 32& Z69IHA[  
Public Const sPos As Long = 310& [1MEA;  
Public Const sPosL As Long = 200& m =F@CA~C  
Public Const sPosR As Long = 500& WYzaD}  
'车缝检测框位置 ?7ZlX?D[  
Public Slice(1 To sSize, 1 To FrameH) As Byte *g6o ;c  
Public SliceL(1 To sSize, 1 To FrameH) As Byte N6 8>`  
Public SliceR(1 To sSize, 1 To FrameH) As Byte zQ+t@;g1  
Public avSL As Integer, avSLR As Integer, avSLL As Integer vfDb9QP  
JB_`lefW,'  
.*7UT~o=CS  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 E\N=p&g$  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 ~8{3 Fc0  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 wdV?&W+  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long e>Y2q|S85  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte 'vIkA=  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 f)P/@rh  
0l@+xS;  
LkB!:+v |B  
tP{$}cEY  
'一次连续采集的帧数 -B(KQT,J  
Public tFrames As Long oA%[x  
jP'b! 4  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 X1dG'PQ  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 >7q,[:(gs  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize x7@HPf  
kweTK]mT  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte * v]UgPk  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte qE:DJy<  
Public pWorkSpace(1 To FrameW * FrameH) As Long Y\|J1I,Z4  
Public Const pBufferSize As Long = FrameW * FrameH * 2 Vgk ,+l!4  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 "A+F&C>  
I,3!uogn  
Public hBoard As Long   '采集卡标识 w8ld*z  
Public mBufferAddr As Long  '缓存地址 4TE ?mh}  
Public BufferSize As Long  '缓存大小(字节) ~l6Y <-!  
Public iCurrentCard As Long 9?c^~77  
Public CapStatus As Long _?c.
3+;s  
Public iFrames As Long [![(h %  
Public currentBr As Byte, currentContr As Byte ,e_#   
"-:\-sMt{  
Public hMEM As Long, mStatus As Long wO%:WL$5  
Public Const hMemSize As Long = pFrameSize * 4 ljON_*  
Public hMemWork As Long /CE d14.  
Public Const hMemWorkSize As Long = pFrameSize * 5 v |2j~  
=lD]sk  
,O!aRvzap  
O3: dOL/C  
'串口接收轨道衡数据 fMaNv6(  
Public WeightFromCom As String <] ^D({`  
Public bReceiveComplete As Boolean ,quTMtk ~  
BAHx7x#(  
!17Z\Ltqyj  
Public Type GrayBMPHeader S$WM&9U  
  Tag As Integer kR(=VM JU  
  FileLength As Long    '文件大小 c10).zZ  
  Reserve1 As Long Zw{tuO7}K  
  DataOffset As Long    '图像数据偏移量 nHrCSfK  
  BMPHeaderSize As Long  '文件头长 ;BVhkWA  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… mh]$g<*m  
                        'the following sizes are possible: +}/!yQtH  
                        '28h - windows 3.1x, 95, nt, … .x8$PXjPG  
                        '0ch - os/2 1.x `0D1Nh"%k  
                        'f0h - os/2 2.x [1GEe
 
/vMyf),2  
  ImageWidth As Long           '图像宽（像素数） D:EF@il  
  ImageHeight As Long          '图像高(像素数) b\S} ?{m5  
  PlaneNumber As Integer  '图像层数 3~la/$? p0  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap sR.j~R  
                                        '4 - 16 color bitmap D|:sSld @  
                                        '8 - 256 color bitmap j #YFwX4.  
                                        '16 - 16bit (high color) bitmap 8m<<tv
.  
                                        '24 - 24bit (true color) bitmap i8.[d5  
                                        '32 - 32bit (true color) bitmap 3Q)>gh*
 
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) 
b{Ss+F  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) 1D6O=
j\  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) elgQcJ99  
                                    '3 - bitfields (also identified by bi_bitfields) AMz=HN  
  IMAGESIZE As Long  '图像数据字节数 &Z!2xfQy>  
  hResolution  As Long  '水平分辩率  像素数/米 RkwY3s"  
  vResolution  As Long  '垂直分辩率 j56 An6g  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 >cL2PN_y  
  ImportantColors As Long ulM&kw.4i  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 c<e\JJY5?  
End Type @~3c;9LkY  
w'XgW0j{  
I!D*(>  
i@L2W>{P  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader n#cN[C9  
Public sRECT As RECT 3fTI&2:  
[+z:^a1?V  
s\!vko'M  
Public conn As ADODB.Connection  0 XzO`*  
Public rsTrain As ADODB.Recordset V p{5K
xq  
Public rsOperater As ADODB.Recordset >IjLFM+U  
Public rsGoods As ADODB.Recordset Y cpO;md  
Public rsGood2 As ADODB.Recordset s3 $Q_8H  
Public rsSender As ADODB.Recordset T%/w^27E  
Public rsReceover As ADODB.Recordset pnJT ]?},  
Public rsTrainTMP As ADODB.Recordset Q$j48,e  
!g"9P7p  
tvRy8u;
 
'打开采集卡 }wXD%X@)l  
'设置参数 p\S3A(  
'设置为实时单帧采集到缓存方式 5 ZPUY  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 )7J>:9h  
"mK (?U!A  
nDy=ZsK  
Sub Main() B,,d~\  
  Dim i As Integer, status As Long 7!;/w;C  
     YYW70k:  
   InitBMPinfo -+|[0hpw  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 *rT(dp!Y  
    BMPHeader.Tag = &H4D42 Kf~+jYobO  
    BMPHeader.ImageWidth = FrameW Bnq\Gg  
    BMPHeader.ImageHeight = FrameH V0i$"|F+E  
    BMPHeader.BMPHeaderSize = &H28 +~O{ UGB=  
    BMPHeader.PlaneNumber = 1 AAgA]OD,  
    BMPHeader.bpp = 8 [CX?Tt  
    BMPHeader.Compression = 0 NhX.yLb$   
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 UULL:vqq  
    BMPHeader.vResolution = &H1274 KL]!E ~i  
    BMPHeader.ColorsinBMP = 256 EQC  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP z?[DW*  
    BMPHeader.DataOffset = Len(BMPHeader) =i?,y+<  
    For i = 0 To 255 ?F{xDfqw  
      BMPHeader.Pallate(i) = RGB(i, i, i) F DX+  
    Next i 2zu~#qU[)M  
    BMPHeader.IMAGESIZE = FrameH * FrameW {m:Rv&T  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE f34&:xz2U  
e~?]F0/  
;bE6Y]"Rz  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) G.
TX1  
     wP?q5r5  
    BMP1.ImageWidth = FrameW cU|jT8Q4H  
    BMP1.ImageHeight = FrameH * 2 "@$STptkc  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight #jiq Rhm  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE *pp1Wa7O  
#"-^;Z  
  '确定标志位置,为pilarX, pilarY确定初始值 89mre;v`  
   PilarW = mkW S '+"+%^tj  
   PilarH = mkH  '此两项为固定值 eCD,[At/  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) @un }&URp  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 ]5/U}Um  
   H_nJST<v`  
   rK|&u v*b  
  '连续采集记录文件 F9r*ZyNlx  
  ' 建立一个缓冲区为页对齐方式的文件 8ZfIh   
  If Dir(TmpFile) <> "" Then ]{^vs'as \  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ \-ws[  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) =]"|x7'!  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 m28w4   
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 m
C(t;{  
  Else !H\GHA'DO]  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ B)8Hj).@B  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) l&xD3u^G  
  End If K9'*q3z   
  If hFile = 0 Then k
]pD3.QJ  
    MsgBox TmpFile & ": File Open Error", vbOKOnly I3Xh[% -!  
    Exit Sub x`i`]6q  
  End If 'U$VOq?!  
  '采集参数记录文件 XtdLKYET  
hBCFile = FreeFile() :G/]rDtd  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile e 8<nPt`C  
   W[<":NX2  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 #SNI dc>9\  
If hMEM = 0 Then v*'\w#  
    fStatus = GetLastError o1+]6s+j}  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ ,5*xE\9G  
     & "请向技术人员报告该错误代码。", vbOKOnly ^?[<!VBI  
    CloseHandle hFile :exuTn  
    Exit Sub mkzk$_  
End If E,yK` mPp^  
mXj Ljgc}  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) (OQ @!R&  
If hMemWork = 0 Then REBDr;tv  
    fStatus = GetLastError U-<"i6mg?  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ j],.`Y  
     & "请向技术人员报告该错误代码。", vbOKOnly g>P9hIl
 
     '释放已成功分配的内存 olxP`iK  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) ] Nipo'N;  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) of  
     KB
A%  
    CloseHandle hFile $VIq)s2az|  
    Exit Sub 'PYqp&gJ  
End If #!# X3j  
N\p]+[6  
' Test writing vK`h;  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& v=-3 ,C  
     J5( D7rp#  
   '初始化采集卡参数 ,s&~U<Z  
   iCurrentCard = -1 z} 8L}:  
   hBoard = okOpenBoard(iCurrentCard) Uy|=A7Ad c  
   Debug.Print hBoard iDc|9"|Tf3  
   If hBoard = 0 Then -wMW@:M_  
      ExitGrabber 6FMW g:{  
      End 2!?z%s-S  
   End If u?Mu*r?  
   okGetBufferSize hBoard, mBufferAddr, BufferSize #2ASzCe  
   If mBufferAddr = 0 Then de{YgN  
     MsgBox "缓存不存在！" [qMdOY%jx  
     ExitGrabber *r$.1nke  
   End If ER1mA:8>E  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) "m;]6B."  
   [;YBX]t  
   =2)t1 H  
   currentBr = 128: currentContr = 128 BM~niW;k  
   '设置视频输入参数 G$uOk?R#5c  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2
pu*u[n  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input FD+PD:cQn  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 Kg-X]yu*0  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 u(WQWsN  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 pF+wHMhUe  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 _5 tqO5'  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） /C2f;h(1  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) v1g5(  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) 4 xzJql  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 <>Ddxmw  
   #gJ~ {tA:  
   '设置采集参数 a;(zH*/XK  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 L#q9_-(#  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 l5]oS?>y  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 utJVuJw:t  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 HTyF<K  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 NVWeJ+w  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 b7sE  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 #ic 2ofI  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 rGGepd  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 y]f^`2L!8>  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 e4%*I8 ^e  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 A=
]F_  
   ey\{C`(__y  
   H<7DcwXv  
   okCloseBoard hBoard 3N0X?* (x|  
   Sleep 50 8'WMsp
X  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 ruA+1-<f  
   q)xl$*g
 
   '设置数据传送方式 ai  _fN  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ;Jn0e:x`E  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 T&"dBoUq>G  
   4{WV  
   sRECT.Right = -1   '用于获得当前设置值 *oX]=u&  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) @"Fp;Je\bN  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom `R52{B#&/  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 _Ge^ -7  
   sRECT.Left = 0 Mq lo:7 ^F  
   sRECT.Top = 0 #_\MD,(  
   sRECT.Right = sRECT.Left + FrameW 5po'(r|U  
   sRECT.Bottom = sRECT.Top + FrameH * 2 M
2P@ &  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) :_,]?n  
   |aAWWd5  
   sRECT.Right = -1   '检查新设置值 aX'g9E
 
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) i)PV{3v$J  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom |abst&yp  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) jNG?2/P6&  
   %g@3S!lK  
   If TESTSignal = False Then VN-#R=D  
      'ExitGrabber s_Oh >y?Aq  
   End If uPC qO+f  
   3]OP9!\6  
   q&d&#3Rh  
   nk|N.%E  
   '设为实时采集状态 D6)Cjc>a  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) 7e{X$'  
   jl-Aos"/  
   + >gbZ-S  
   '单帧采集 J$9xC{L4  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 W%9K5(e  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) @))}\:  
   okCaptureTo hBoard, BUFFER, 0, 1 'single K0RYI69_  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 ])j|< W/  
   '   Sleep 20 %i -X@.P  
   'Loop Fxth>O`$  
   okGetCaptureStatus hBoard, True X>Xp&o  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize :`u&TXsu  
   '写入768*576测试图象 ]{2{:`s  
   ArrayToBMP TmpBMP
K M\+  
   Ld3Bi2d|  
   '打开数据库 0ij~
e<  
   Set conn = New ADODB.Connection 3 [)s;e  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ hN:F8r+DG  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ rjAkpAT  
      "; Mode=Read|Write" KD"&_PX  
   conn.Open Zjic"E1  
   ={E!8"  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) /
.kna4k  
   frmRecord.Visible = True ~{,vg4L  
   frmQuery.Visible = True ^&';\O@)  
   Load frmReceiveFromComm cov#Z ux  
   :e<`U~8m  
   '调试参数 Lr}b,  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then %3c|  
     SignalBox.Visible = True x1V2|~;p|  
   End If H"q`k5R  
   If InStr(UCase(Command()), "/COMM") > 0 Then ~d7Wjn$@  
     frmReceiveFromComm.Visible = True Jt>[]g$  
   End If ,rB9esxic  
VXc+Wm*W  
End Sub jo;uRl  
P-OPv%jyi  
Sub ExitGrabber() %] [$y7  
  '关闭数据库 Ei9 _h  
  '关闭采集卡 *&d
W\fx  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Op/79]$  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) QTjftcu  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) P 5qa:<  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 5hH6G  
  okStopCapture hBoard x\J;ZiWwW  
  okCloseBoard hBoard <K#'3&*$s  
  CloseHandle hFile M o"JV  
  Close #hBCFile ZkB6bji  
  conn.Close x !:9c<  
  End hLytKPgt  
End Sub q 5v?`c  
$v'Y
:  
Function ArrayToBMP(ByVal File As String) bxhg*A  
Dim BytesWrite As Long :m++ iR  
JXLWRe  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ <{NYD.  
  CREATE_ALWAYS, 0&, 0&) g#'fd/?Q  
@"{'j  
If hTmpFile = 0 Then 42J';\)oP  
   ArrayToBMP = False UrhM)h?%  
   Exit Function gF,[u  
End If BU]WN7]D$  
k$-~_^4m  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN yXTK(<'  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& o!=lBfI  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN S\3AW,c]w  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& U%^eIXV|  
4Ay`rG  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN G V:$;  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 6_%]\37_Z  
^#BGA| j  
If BytesWrite < pFrameSize Then N$,/Q9h^  
  ArrayToBMP = False Z`oaaO
 
End If lsB9;I^+x  
u JQaHL!  
CloseHandle hTmpFile O\4+_y  
5@UC c  
End Function b$goF }b'g  
q M_/  
Function ArrayToBMP1(ByVal File As String) ]/o12pI  
zY1s7/$i  
Dim BytesWrite As Long =CKuiO.j  
t8DL9RW'  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ {C/L5cZ]J  
  CREATE_ALWAYS, 0&, 0&) k'@7ZH  
0eqi1;$b]  
If hTmpFile = 0 Then Xb=2/\}|f  
   ArrayToBMP1 = False :>P4L,Da]  
   Exit Function &SjHrOG?  
End If mWli}j#  
*,W!FxJ  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN hg?j)jl|  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& 0i5y(m&7  
9|N"@0<B  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN so!w!O@@  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& 3`fJzS%O  
5@+4
 
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN ]>)u+
|  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& {K45~ha9!m  
f2O*8^^Y{Q  
If BytesWrite < pBufferSize Then JQ"`9RNb  
  ArrayToBMP1 = False Y^f94s:2S  
End If ?E+:]j_  
ePq13!FC/  
CloseHandle hTmpFile .# 6n  
-t@y\vZF,  
End Function MegE--h  
cPq Dsl3  
'使用该过程建立的文件要求在用后关闭 WxVn&c\  
Public Function ArrayToBMP2(File As String) As Boolean \LdmGv@&  
.:{h{@a  
Dim BytesWrite As Long &o
*s !u  
|*tWF! D6`  
ArrayToBMP2 = True 11)/] ?/j  
@K$VV^wp  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ $hjP}- oUX  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) 4d^ \l!  
h"%|\o+3  
If hTmpFile = 0 Then =My}{n[  
   ArrayToBMP2 = False VqK%^  
   Exit Function :DdBn.  
End If Fl_dzh,E  
+mfe*'AU  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN n+{HNr  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& *L%6qxl`V  
\~@[QGKN  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN qIbg 4uE  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& x" >W u2  
.3lGX`d{  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN  <+AIt  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& .KLm39j(  
pg~zUOY  
If BytesWrite < pFrameSize Then >~I xyQp  
  ArrayToBMP2 = False }+91s'/c  
End If Pz]bZPHn  
AT B\^;n.  
CloseHandle hTmpFile 3h9Sz8  
Q_&}^  
End Function eyeNrk*2o  
w]>"'o{{  
Private Function TESTSignal() As Boolean q&X
CX$N  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long Gnbfy4Z  
oA4D\rn8"  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) ]d@^i)2LF  
-}{%Q?rYj  
If extsign = 1 Then 0'?V|V=v  
   TESTSignal = True Zm%VG(l  
Else
ixIV=#  
    If extsign = 0 Then q2x|%HRF  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly E rop9T1  
        TESTSignal = False lx\qp`w  
        Exit Function AbUDn\0$  
    End If FI
]P<)*r  
End If :+~KPn>w5  
~ X-)_zH  
'测试视频输入类型 :/C ?
FHs9  
'video type q>_vE{UB  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 Sa3I?+  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) .:}.b"%m  
If videotype = 1 Then aO8
ch  
        '"隔行信号(Interlaced)" 1)TK01R8  
Else };&HhBc
!g  
   If videotype = 0 Then vkd[:CC  
       '"逐行信号(Non-interlaced)" 8tb6 gZz  
   Else '[Mlmgc5  
     If videotype = -1 Then m#oh?@0}  
       ' "不支持" :s'o~  
     End If J\het2?\  
   End If xGYSi5}z  
End If j/)"QiS*?  
ZCy`2Fir  
'测试垂直扫描线数 _W)`cr  
'video scanlines &w+;N5}3  
scanlines = -1 +kjzn]}f  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) -1qZqU$h  
    If scanlines = -1 Then (k%GY< bP  
        ' "不支持"
fCgBH~w,9  
    Else @S
`$C  
        'Trim(Str(ScanLines)) + " 行数/幅" ry.;u*F  
    End If [Q4_WKI0T  
*#3*;dya]  
'测试帧频 9
$Ig~W)  
'video field frequency j*uXB^4  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) wL4ZW8_  
    If fieldfrq = -1 Then 9YP*f  
        'lblSignal(8) = "不支持" ipG5l  
    Else `J72+RA  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" )!tCC-Cr  
    End If ?h/xAl  
End Function )O,wRd>5  
8YNu<   
3`8dii  
Sub PicIdentify() >(hSW~i~  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 >qR7'QwP  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 Ne3R.g9;Z  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 S8 :"<B)  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 <,\ `Psa)N  
i 3m3zXt  
  Dim fPTR As Long, cFrame As Long hf;S]8|F  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer P @zz"~f7  
     gks ==|s.  
QL2Nz@|k  
cFrame = 0 ,Pn-ZF  
_p\6 29`  

8RVS)D''  
Do While cFrame < tFrames z0#-)AeS  
   ?2{bKIV_  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) -x{dc7y2  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) fJaubDxa  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 3pvYi<<D'  
   sU\c#|BSC"  
  frmRecord.RText.Text = Str(cFrame) *yJ[zXXjJ  
  frmRecord.RText.Refresh v @:~mwy  
       w{pUUo:<  
  If CheckMark = True Then P Q7A~dw9  
   ArrayToBMP TmpBMP @.'z* |z  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) _`H.h6h  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" BR+nL6sU  
   !RS9%ES_?  
   DrawSlice z9[[C^C  
   LH4>@YPGE#  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) U4Z[!s$  
   'If i = vbNo Then 7 _`L$<-n  
   '  Exit Do C)NC&fV  
   'End If 2@v J  
   'cFrame = cFrame + 1 pgT9hle/  
   CJJD@=  
  End If COR;e`%,  
  DoEvents m9Ax\lf  
  cFrame = cFrame + 1 8O>}k  
Loop mw_ E&v  
End Sub 3P1&;  
*n8%F9F  
F8H'^3`b`U  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean :M06 ;:e  
x<)G( Xe*  
'如标志区模式反差存在则为TRUE，否则返回FALSE %m9CdWb=w  
r#A_RZ2~@  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long OA[&Za#w  
CheckMark = True wuA
^'T  
   7c-Gm R2  
'复制标志区 F*M|<E=  
For i = 1 To mkH $f#a gq_  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW "NDxgJ%J35  
Next i >
&OUGu|  
Ht#@'x  
For j = 1 To PilarW * PilarH / 2 7|YN:7iA  
   mTop = mTop + MKpilar(j) zrs<#8!Y_!  
Next j oK2pM18  
$(ewk):  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH -T7%dLHY  
   mBot = mBot + MKpilar(j) U[R@x `  
Next j ;6ky5}z  
Wt^|BjbB4  
mTop = mTop / PilarW / PilarH * 2 J{`eLmTu  
mBot = mBot / PilarW / PilarH * 2 9:5:`'b  
=VNSiK>F  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 SyO79e*t  
'Gjq/L/x  
'平均值极值化 Ir5WN_EaS  
  For j = 1 To PilarH * PilarW h4/X 0@l`  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) RPVT*`o  
  Next j mLwoi!]m  
   3\AM=`  
mTop = 0: mBot = 0 [8"ojhdV  
For j = 1 To PilarH * PilarW / 2 UfO7+_2  
  mTop = mTop + MKpilar(j) LOr|k8t
L%  
Next j D==Mb~  
#O~XVuvF0  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW 3o *FPO7?  
  mBot = mBot + MKpilar(j) $J.T$0pFa  
Next j H6gU?9%  
IS BV%^la|  
I^D0<lHl~  
  mTop = mTop / PilarH / PilarW * 3 ~]
BMrgn  
  mBot = mBot / PilarH / PilarW * 3 RsW9:*R  
   'CXRG$
D  
BYi)j6"  
If mBot > iWhite And mTop < iBlk Then $<|o cUC7  
  CheckMark = True p~2UUmV  
Else 9GgA6#  
  CheckMark = False 9XX>A*  
End If JQ@fuo %  
End Function 9AHSs,.t  
_tAQ=eBO  
Sub Capture1Frame() P}V=*g
  
   okCaptureTo hBoard, BUFFER, 0, 1 'single +R6a}d/K  
   okGetCaptureStatus hBoard, True Q6IQV0{p  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize *#y;8  
End Sub @m~RtC-Q  
XX6 T$pA6  
B
6]<G-
 
Sub CopyMark(iBlk As Integer, iWhite As Integer) QK; T~ _k  
'复制标志区并返回标志区暗区与亮区的亮度平均值 /4$4h;_8  
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 iEIg
:  
   w%dL8k  
'复制标志区
Sw8kIC  
For i = 1 To mkH I;7nb4]AmF  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW y,=du  
Next i ^N{ltgQY  
BByCMY  
For j = 1 To mkW * mkH / 2 <*|?x86~  
   mTotal = mTotal + MKpilar(j) N8v'70  
Next j 99=s4*xzM  
WZZ4]
cC  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 ""{|3XJe  

wvMW|  
mTotal = 0 ~9=aT1S|  
For j = mkW * mkH / 2 + 1 To mkW * mkH BI2; ex  
   mTotal = mTotal + MKpilar(j) zP!J/}z  
Next j ]X
eO0Y  
at|g%$%  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 kS :\Oz\  
b.F^vv"]]  
'背景亮度 15{Y9
!  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW G^wtE90  
  For i = 1 To 4 * FrameW :!fG; )
=  
    bsTotal = bsTotal + BsLine(i) v>A=2i*j  
  Next i cCY/gEv  
  bsAV = bsTotal / FrameW / 4 &<5+!cV=  
4f^C\i+q  
End Sub -"Q-H/qh  
@]HXP_lyD/  
8i}< k$S  
Sub AdjIMGbright(Optional bInit As Boolean = True) \*0yaSQF  
TZRcd~5$  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗）  U4
7}QDh  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 e-5?p~>  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 8' K0L(3[  
     ^V3v{>D>  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer 3= -pG  
   -x`G2i  
  '按标准亮度与对比度采集一帧，确定背景亮度 &\C [@_  
  currentContr = 128   '初始对比度 '9?;"=6(  
  currentBr = 128   '初始亮度 xd-XWXc  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 O7t(,uox3y  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 ZH,4oF  
  DoEvents BVw Wj-,  
  Capture1Frame &v!WVa?  
  '获得图像上缘4行象素 dQb.BOI)h  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW k(%QIJH  
  CopyMark iBlack, iBright   '图像标志区亮度 G{9X)|d  
  For i = 1 To 4 * FrameW Thr*^0$C  
    bsTotal = bsTotal + BsLine(i) _:`!DIz~9}  
  Next i pS[KBQ"F  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 ;AJTytE>%  
   Y+~g\z-]c  
  Select Case bsAV a l&(-#1  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景
%7hB&[ 5  
       currentBr = 150 9\;|x  
       currentContr = 60 O 5Nb  
     Case 61 To 80   '有可见背景 ILw
n&[A0  
       currentBr = 140 awewYf$li  
       currentContr = 70 kJQ#Wz|z]  
     Case 81 To 100  '有清晰背景 ($nrqAv4  
       currentBr = 128 8|Y.|\  
       currentContr = 80 ?7MqeR4/E  
     Case 100 To 150  '有明亮背景 ,8MLoZ _  
       currentBr = 140                '5:30-6:00钟实测数据 |=a}iU8  
       currentContr = 50 &~e $:8+  
     Case 151 To 180 v"^~&q0x  
       currentBr = 130 ? 1*m,;Z  
       currentContr = 60 J;$N{"M  
     Case 181 To 220  '背景全为白色 gEQNs\Jn L  
       currentBr = 110 r\`+R"  
       currentContr = 130 [5$w=u"j  
     Case 221 To 255  '背景全为白色 1w(JEqY3h:  
       currentBr = 100 <?Wti_ /M  
       currentContr = 100 sJ z@7.  
  End Select DI|:p!
Nx  
   $2~\eG=u H  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 h*B|fy4K9U  
        Case 100 To 150 ]aryV?! 6  
          currentBr = currentBr - 10 U
LH0'@BJ  
        Case 151 To 255 sZ<9A Xk-E  
          currentBr = currentBr - 20 ~z5R{;Nbz|  
  End Select }MbH3ufC  
   ]rN5Ao}2  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 fV:4#j  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 C1EtoOv K  
End Sub *Vw\' %p*  
TXXy\$  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) k0-G$|QgIp  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long 6 sxffJt  
     WQNE 2Q  
    For i = 1 To 8 qU6nJi+-I  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& XjioZ  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& _c$9eAe  
    Next i Gfp1mev  
     x35cW7R}T_  
    For j = 1 To 1024 X^9d/}uTa  
      L1 = L1 + LeftBK(j, 0) L I>(RMv  
      L2 = L2 + LeftBK(j, 1) JPn$FQD  
      R1 = R1 + RightBK(j, 0) Va V
N  
      R2 = R2 + RightBK(j, 1) R%D'`*+  
    Next j )6KMHG  
    diffL = Abs(L1 - L2) / 1024 L6Wt 3U`l  
    diffR = Abs(R1 - R2) / 1024 h].~#*  
End Sub {%2vGn  
`#-P[q<v-  
Function CheckSlice() As Boolean `(6r3f~XJ  
  CopySlice avSL, avSLR, avSLL F0vM0e-  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then CzCQFqXI  
    CheckSlice = True kql0J|P?  
  Else z+a%5J  
    CheckSlice = False )vg5((C  
  End If )u]9193  
End Function 3bZIYF2@  
KOz(TZ?u  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) Wo~vhv$E  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long !HeSOzN  
  For i = 1 To FrameH l
7{oi!   
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize }N0Qm[
R  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize  7R#+Le)  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize 
1?*  
  Next i .`<@m]m-  
  For i = 1 To FrameH vsWHk7 9  
    For j = 1 To sSize &UCsBqI Y  
       total = total + Slice(j, i)
qn1255fB  
       totalL = totalL + SliceL(j, i) wkqX^i7ls  
       totalR = totalR + SliceR(j, i) 2QpHvsl_  
    Next j 38DT2<qC  
  Next i ?Iyo9&1&  
  avSL = total / FrameH / sSize Rm1A>1a:  
  avSLR = totalR / FrameH / sSize G0O#/%%  
  avSLL = totalL / FrameH / sSize ps .]N   
End Sub + b$=[nfG  
#rO8Kf  
Sub DrawSlice() \#-
W <  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B p!O(Y6QM  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B #GDe08rOw  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B {j5e9pg1L|  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) m'\2:mDu0  
End Sub ~=<}\a~  
Sub DrawMark(pic As Control) v :Tzv^  
   Dim i As Long, j As Long mkh"Kb*{  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B ZQ^r`W9_+  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B vx_o(wof  
   For i = 1 To PilarH jcNT<}k C  
     For j = 1 To PilarW (/-hu[:  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) iy.2A!f^.  
     Next j ;w|b0V6  
   Next i Ghl'nqPlm  
End Sub P}ok*{"J<>  
AcI,N~~  
Function avIMG() As Integer KD
l_?9E5  
  Dim i As Long, j As Long, totalIMG As Long pD]0`L-HJU  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize l\M_-:I+4  
  For i = 1 To pFrameSize I):!`R.,  
    totalIMG = totalIMG + pBuffer(i) @_:]J1jw7  
  Next i ;,i]w"*  
  avIMG = totalIMG / pFrameSize %>-@K|:gS  
End Function 'TH15r@  
)[mwP.T=  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer :ISMPe3'  
  Dim i As Long, j As Long, totalIMG As Long G7--v,R1x  
  For i = 1 To FrameH dVB~Smsr  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth P0H6mn*  
  Next i bl_H4  
  For i = 1 To FrameH * barWidth kr$b^"Ku  
    totalIMG = totalIMG + pBuffer(i) x8\A<(G_M=  
  Next i \Y6WSj?E  
  avRegion = totalIMG / pFrameSize g;$Xq)Dd  
End Function Q+b D}emd  

一共这么多文件。 &Tl 0Pf  
^rvx!?zO  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 DJgTA]$&  
第6车皮 )M__ t5L  

hXqD< ?  
f!
O{%ev  
第9车皮 /-#I_>:8'  
v3v[[96p  
  

从这里里分离出来的。

Duc#$YfGm  
1Bpv"67  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 eds26(  
Bdj%hyW  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？  J/}:x;Y  
B/` !K  

继续填个坑： )c8j}  
F^hBtfz  
用VBA控制WORD自己修订学生毕业文的格式。 o1<_
fI