引用

引用第20楼newport93于06-14-2010 13:47发表的  : +h }>UK\  
-Cjc~{B>7X  
老五，I 服了U。 w~NQAHAvo  
S0\
;FmLIc  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 !TH3oLd"  

UvSvgDMl  
zoV4Gl  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! v>FsP$p4yE  

引用

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

T[}A7a6g_  
7 cGc`7  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : 9qUc{ydt  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 |H`}w2U[j  

G_GV  
S+^*rw
  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 9`P<|(  
nRYHp7`  
可以从宽不？

引用

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

xq`mo  
Tm!pAD  
其实标题没有什么，卡总既然改了就不必再改回了。 :fo.9J  
^P4q6BW  
主要是当初写的时候真是顶着锅盖写的。 X$aN:!1  
Gwyjie9t  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : ((& y:{?G  
哦, 打倒忽悠大家的家伙.      caG5S#8-"  

0m3:!#\  
*Sd}cDCO%  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : 2F}D?]A  
每个人的故事对其他人都是故事, 3I"xuKxc  
自己的故事也是其中之一. VVd9VGvh  
跳出来看, g6AEMer  
不过是众人中的一个人的故事. =d+~l  
4Nb&(p  
所以,接着听故事. u&M:w5EM  
0A,u!"4[  
女人们有兴趣的就等老伍开个新帖或者跟贴, U4$}8~o4  
听他痛说恋爱革命历史.... QL].)Vgf  
k},@2#W]  
杂家接着听他自学程序员历史, i1c z+}  
高级程序员考了吗? [:hTwBRF  

g-C)y 06  
i%FpPni  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ @IXvp3r  
DB=^Z%%Z  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 =c-Y >  
sYfiC`9SO  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 .RazjXAY  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : lH%%iYBM  
引用第19楼伍胥之于06-14-2010 12:33发表的  : >D\jyd$wh&  
>s%&t[r6  
B[$L)y'-;  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 fb=[gK#*,  
@cS(Bb!(M  
我连一级也没有考过。 -$2B!#]3
 
. -:V0pb  

j}`XF?2D  

引用

>h Rq  
矬子里拔将军... ZZ? KD\S5  
你们那里的俗语是吧? *3!#W|#=]N  
\yE*nZ  
我们这里说"矮子里拔长脚"..应该是同一个意思... Fkvf[!Ci  
'kBq@>  
有趣....各地有表达意思一样却方式不同的俗语.... MnPk+eNJm  
Ya*<me>`  
w/oXFs&FK  
你的文章写的有脸皮,没屁眼的, t/vw%|AS  
让看客大为不满... (nDen5Q|  
_{C =d3  
你等着,,估计你以后接到的午夜凶铃就多了... FJ+n- \  

%a=^T?8  
i-YSt5iq  
我到现在也没有接到你的午夜凶铃呢！ F97HFt6{  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : lD-HQd  
伍SIR，再次抱拳佩服 sK/Z'h{|  

VprrklZ  
5OM*NT t  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : O $(#gB'B  
佩服，玩也玩得这么专业！ vUR@P -  

0..]c-V(G  
kKs}E| T  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : {:TOm0eK  
\q
kb8H  
介个真的看不懂。 h1+y.4   
你说你老啦，喜欢怀旧了，才想起来填坑。 >zV  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 :I(d-,C  

:zQNnq:|  
m9mkZ:r(kV  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 ,FK.8c6g  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ b6d}<b9#  
DWORD dwCB; rAZ~R PrW  
LARGE_INTEGER  offset; E[Bj+mX9  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); Hn}m}A  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); -u^f;4|u  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ j_0xE;g"]  
DWORD error = GetLastError(); >Q2kXwN  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); >^GAfvW  
return FALSE; F
nCMr_  
} f/670Acv  
return TRUE; ?>DwNz^.!  
} rCd*'Qg  

'VB 6.0 版 Xu7lV  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 S r>5V  
nk"nSXm3SR  
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 A-l[f\  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long >9,LN;Ic
 
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 ,!QtViA7  
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 |&
_(I  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long 3|(3jIa  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 |w.h97fj  
KtcuGI/A  
iZE7 B7K  
Private Const GENERIC_READ = &H80000000 "eIE5h  
Private Const GENERIC_WRITE = &H40000000 tR<L9h  
vu~7Z;y(<j  
Private Const FILE_SHARE_READ = &H1 e3WEsD+  
Private Const FILE_SHARE_WRITE = &H2 _Jn@+NoO  
Private Const OPEN_EXISTING = 3 nq:'jdY5|  
:_:o%  
Private Const INVALID_HANDLE_VALUE = -1 %+oV-o\ #A  
%(B6eiA  
'//file seek KvumU>c#A  
Private Const FILE_BEGIN = 0 &F.L* M  
Private Const FILE_CURRENT = 1 (s,u9vj=>L  
Private Const FILE_END = 2 NEt_UcC  
a,eEP43dn  
Private Const ERROR_SUCCESS = 0& Tbj}04;I  
5l]
qhi3f  
'//device io control >"[Nmx0;w  
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 0QY9vuhL<  
]<k+a-Tt  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 M;sT+Z{  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 BeFXC5-qat  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 y3ST0=>j}  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 FKy2C:R(]  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C rw#?NI:  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 `S |T&|ad0  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F 2Y
g\<PsN  
T/?C_
i  
'//type LY2 QKjgP  
Private Type LARGE_INTEGER p7Z/%~0v:  
    lowpart As Long xiO10:L4  
    highpart As Long "DSRyD0M  
End Type {Z}zT1kA  
11B8 LX  
Private Enum MEDIA_TYPE 1"No~/_  
    Unknown >M7(<V  
    F5_1Pt2_512 Lj1>X2.gD  
    F3_1Pt44_512 VgO.in^q  
    F3_2Pt88_512 ,S?M;n?z_  
    F3_20Pt8_512 }1|FES  
    F3_720_512 P,)\#([vc  
    F5_360_512 zYEb#*Kar  
    F5_320_512 |XJ|vQGU  
    F5_320_1024 GpC joNcW{  
    F5_180_512 y'_2|5!Qs  
    F5_160_512 _VJG@>F9-  
    RemovableMedia w01u~"E  
    FixedMedia I Z@M K  
End Enum aPin6L$;)  
Ebp=du  
Private Type DISK_GEOMETRY ZOy^TR  
    Cylinders           As LARGE_INTEGER %UB+N8x`a  
    MediaType           As MEDIA_TYPE !=?Q>mz  
    TracksPerCylinder   As Long fJ;1ii~  
    SectorsPerTrack     As Long X<d`!,bn@  
    BytesPerSector      As Long COcS w  
End Type $s ,(-C  
FSb4RuD9  
'//private vars S"%W^)mZ  
Private hDisk           As Long             'disk handle z q@"qnr  
Private lpGeometry      As DISK_GEOMETRY    'disk info v[~Q  
Private lBufferSize     As Long             'the buffer size of read/write 3aFD*S  
Nc*z? 0wP  
Public Function OpenDisk(ByVal FileName As String) As Boolean ~8EzK_c  
'// 打开磁盘 5UvqE_  
    hDisk = CreateFile(FileName, _ T^S $|d  
                        GENERIC_READ Or GENERIC_WRITE, _ -o+; e3#  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ U98e=57N  
                        ByVal 0&, _ -+WE9  
                        OPEN_EXISTING, _ Jp(CBCG{F  
                        0, _ (/C 8\}Ox  
                        0) V eLGxc  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) c3J12+~;  
End Function `%$+rbo~  
q{pa _  
Public Function CloseDisk() As Boolean ZL'krV  
'//关闭磁盘 is`~C  
    CloseDisk = CloseHandle(hDisk) }Io5&ww: U  
End Function T&->xef=  
4S*dNYc  
Public Function GetDiskGeometry() As Boolean YXDuhrs}  
'//获取磁盘参数 Bh7dAV(  
    Dim dwOutBytes      As Long Na<);Pg  
    Dim bResult         As Boolean Hli22~7T:  
     7w.9PNhy  
    bResult = DeviceIoControl(hDisk, _ I[P_j`aE  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ !JbWxGN`jn  
                                ByVal 0&, 0, _ #,;Q|)AD:e  
                                lpGeometry, Len(lpGeometry), _ *#j_nNM4  
                                dwOutBytes, _ gaR~K  
                                ByVal 0&) 3ZhuC".c  
     d?A!0;(*  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack k; n
ed  
    GetDiskGeometry = bResult z0?IQzR^T  
End Function 8b< 'jft  
8>
[o.xV  
Public Sub GetDiskInfo(MediaType As Long, _ HAAU2A9B2  
                        Cylinders As Long, _ Y``]66\Fp  
                        TracksPerCylinder As Long, _ %VS+?4ww  
                        SectorsPerTrack As Long, _ ?L6pB]l8b  
                        BytesPerSector As Long) %(>,eee_  
'//返回磁盘的参数 \I7,
1I  
    MediaType = lpGeometry.MediaType 3zzl|+# 6  
    Cylinders = lpGeometry.Cylinders.lowpart l Me+.P|  
    TracksPerCylinder = lpGeometry.TracksPerCylinder {`V ^V_  
    SectorsPerTrack = lpGeometry.SectorsPerTrack m:c .dei5  
    BytesPerSector = lpGeometry.BytesPerSector Sw`+4 4  
okH*2F(-  
End Sub WU~L#Ih.V  
!rff/0/x"  
Public Property Get BufferSize() As Long Nq#B4Zx  
'//返回每次读/写的缓冲大小 %jxeh.B3B  
    BufferSize = lBufferSize 98lz2d/Fcq  
End Property ?cB26Zrcb  
U&gI_z[  
,=dc-%J  
Public Function LockVolume() As Boolean 4MP8t@z  
'// 将卷锁定 Y,{pG]B$w  
    Dim dwOutBytes  As Long ,OBJ>_5  
    Dim bResult     As Boolean Z |<  
     9/dADJe0b  
    bResult = DeviceIoControl(hDisk, _ mJ+mTA5 bW  
                                FSCTL_LOCK_VOLUME, _ `W2 o~r*&  
                                ByVal 0&, 0, _ !CR#Fyt+9  
                                ByVal 0&, 0, _ 4oN*J +"=+  
                                dwOutBytes, _ mj&$+zM>  
                                ByVal 0&) F87c?Vh)K  
    LockVolume = bResult QZFH>,d  
End Function SEIJ+u9XsA  
TnJNs  
) h=[7
}|  
Public Function UnlockVolume() As Boolean Ym 1; /'  
'// 将卷解锁 gq050Bl)  
    Dim dwOutBytes As Long URj2 evYW  
    Dim bResult As Boolean $8>II0C.  
     F-GH
?sfvi  
    bResult = DeviceIoControl(hDisk, _ #1Iev7w  
                                FSCTL_UNLOCK_VOLUME, _ [!U! Z'i  
                                ByVal 0&, 0, _ a6 w'.]m  
                                ByVal 0&, 0, _ B4x@{rtER  
                                dwOutBytes, _ 0D&-BAzi  
                                ByVal 0&) om8`^P/b  
    UnlockVolume = bResult N 'YzCq;M  
End Function |};-.}u^`h  
o`{^ptu1q  
&)!4rABn  
Public Function DismountVolume() As Boolean U|+c&TY
 
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 NB3ar&.$S  
    Dim dwOutBytes As Long L+_ JKc  
    Dim bResult As Boolean fiW2m=h_  
     sU"sd7#A  
    bResult = DeviceIoControl(hDisk, _ O8/r-?4.  
                                FSCTL_DISMOUNT_VOLUME, _ '?d5L+9  
                                ByVal 0&, 0, _ z~#d@c\  
                                ByVal 0&, 0, _ ISg-?h/  
                                dwOutBytes, _ bd)Sb?  
                                ByVal 0&) d?N[bA  
    DismountVolume = bResult q:9CFAX0=  
End Function D(#6H~QN%  
vo^2k13  
_xr@dK<   
Public Function ReadDisk(ByVal Cylinders As Long, _ 6`Diz_(  
                    ByVal Tracks As Long, _ 8p PQ   
                    db() As Byte) As Boolean mLDuizWI  
'//按柱面和磁道来读取磁盘数据 6\xfoy|j  
    Dim iPos    As Long ~xf uq{L;  
    Dim lRead   As Long #aIV\G  
     ]BfJ~+ N  
    iPos = Cylinders * Tracks * lBufferSize drS>~lSxB  
     ,ygDNF  
    If SeekAbsolute(0, iPos) Then CB`GiH/j  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) s,H }km  
    End If YB376/  
End Function r;GAQH}j_  
GB}!7W"  
Public Function WriteDisk(ByVal Cylinders As Long, _  BF /4  
                     ByVal Tracks As Long, _ co{i~['u  
                     db() As Byte) As Boolean lCGEd  3  
'//按柱面和磁道来写磁盘数据 3 V$ \s8  
    Dim iPos    As Long k<y~n*{_  
    Dim lRead   As Long =,Z5F`d4  
     {2LV0:k2  
    iPos = Cylinders * Tracks * lBufferSize pI( H7 (  
     Qb'Q4@.  
    If SeekAbsolute(0, iPos) Then QI`&N(n  
        WriteDisk = WriteBytes(lBufferSize, db()) 7towjwr  
    End If dUkZ_<5''  
End Function G'mg-{  
),5A&qT*  
Fz2CXC  
'///////////////////////////////////////////////////////////////////////////////////// 3z -="_p  
'//file system #Ht;5p>5  
ICzcV };$  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean %XH%.Ps/  
'//seek file .7> g8  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte s,-}}6WO  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) #BX}j&h_  
    If LowPos = -1 Then >Zh^,T={G  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) E6#")2C~  
    Else o&Y R\BI/  
        SeekAbsolute = True :"`1}Q  
    End If fHXz{,?/w  
     q>[}JtXK  
End Function )p[Qj58  
#2;8/"v  
&0SgEUZr  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean {0L)B{|  
'//read data to array ](>YjE0  
    Dim RetVal    As Long ksF4m_E>YB  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) %!]CP1S  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF 3V3q vd  
    ReadBytes = Not (RetVal = 0) >w#&f
d  
     ;I~UQgE6H  
End Function X 1}U  
g:Fo7*i  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean S%o6cl=  
'//write data from array xmHW,#%ui\  
    Dim RetVal As Long s"x(i  
    Dim BytesToWrite As Long =4K:l} }  
    Dim BytesWritten As Long fK+[r1^  
     )|KZGr  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) iwI}  
     <=@6UPsn2  
    WriteBytes = Not (RetVal = 0) @*iT%p_L  
End Function %S<))G  

这才是我当年写出的一个比较烂的程序 k]S`A,~  
=m U</F)  
Main2.bas S y^et  
6<No_x |_  
Attribute VB_Name = "SubMain" oWBjPsQ  
Option Explicit .B{:<;sa  
0xUn#&A~  
'采集文件与临时文件 0[ZwtfL1  
Public Const TmpFile As String = "d:\30-0600.dat" +5H1n(6)  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 !}=#h8fv  
|v:fP;zc  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long 9XX:_9|I  
Public hBCFile As Long  '记录采集参数的文件 +Oc |Oo  
Public Const TmpBMP As String = "d:\1.bmp" a@m  64l)  
Public hTmpFile As Long !XO"lS  
Xvxj-\ -  
spTI
hZ  
'采集窗口参数常量 ;Ngu(es6  
Public Const FrameH As Long = 280& |j}%"wOh  
Public Const FrameW As Long = 768& __[bKd.  
Public Const pFrameSize As Long = FrameW * FrameH >z k6{kC  
nk2H^RM^  
'标志区范围，用于识别车辆 #|F5Kh"  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X \{ff7_mLo  
Public Const mkW As Integer = 28  '识别标志立柱宽度 @Op7OF Y%  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) vUB*Qm]Y\  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) T*](oA @  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 mg<S7+  
'车缝检测位置常数 vxXrVPU3  
Public Const sSize As Long = 32& #xt-65^  
Public Const sPos As Long = 310& ogG:Ai)90  
Public Const sPosL As Long = 200& wSG!.Ejc7  
Public Const sPosR As Long = 500& *y
N#q>1  
'车缝检测框位置 bP7_QYQ6  
Public Slice(1 To sSize, 1 To FrameH) As Byte lSBu,UQP  
Public SliceL(1 To sSize, 1 To FrameH) As Byte }a!c  
Public SliceR(1 To sSize, 1 To FrameH) As Byte tW%!|T5/  
Public avSL As Integer, avSLR As Integer, avSLL As Integer O]G3l0  
{r:5\  
(*Q8!"D^6  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 o^+g2;Ro  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 Z%QU5.  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 +4V"&S|&  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long fn Pej?f:  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte oFp4*<\  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 $mn+  
y( Tb=:  
lD,;xu Q  
o= &/;X  
'一次连续采集的帧数 v[<;z(7Qk  
Public tFrames As Long 'v%v*Ujf[  
z W*Z  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 !XT2'6nu  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 <UbLds{+Uo  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize ^-%O  
bkIQ?cl<at  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte ij02J`w:Ra  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte ~--F?KUnL  
Public pWorkSpace(1 To FrameW * FrameH) As Long !uAqY\Is  
Public Const pBufferSize As Long = FrameW * FrameH * 2 pW-aX)\DR  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 HlXEU $e  
XF`?5G~~#  
Public hBoard As Long   '采集卡标识 _o?[0E  
Public mBufferAddr As Long  '缓存地址 GyGF<%nq  
Public BufferSize As Long  '缓存大小(字节) eV(   
Public iCurrentCard As Long h:4F
?'W  
Public CapStatus As Long i:
x<Vi  
Public iFrames As Long a4Y 43n  
Public currentBr As Byte, currentContr As Byte 2xt$w%  
B }  
Public hMEM As Long, mStatus As Long 6dKJt  
Public Const hMemSize As Long = pFrameSize * 4 :nxBM#:xu  
Public hMemWork As Long -x+K#T0Z  
Public Const hMemWorkSize As Long = pFrameSize * 5 kD#hfYs)i  
@MfZP~T+  
AIt;~x  
fDKV`  
'串口接收轨道衡数据 !0Eo9bU%@  
Public WeightFromCom As String Vs, &  
Public bReceiveComplete As Boolean b21@iW  
SFVqUg3"Z  
=&y6mQ  
Public Type GrayBMPHeader I?KGb:]|  
  Tag As Integer A<[BR*n  
  FileLength As Long    '文件大小 }=s64O9j  
  Reserve1 As Long ;bkvdn }  
  DataOffset As Long    '图像数据偏移量 o| 9Mj71  
  BMPHeaderSize As Long  '文件头长 Zn]!*}  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… K#[z5  
                        'the following sizes are possible: 3W55m@w  
                        '28h - windows 3.1x, 95, nt, … c<5(c%
a  
                        '0ch - os/2 1.x @H8CU!J  
                        'f0h - os/2 2.x l*+9R  
5
wa!pR\c  
  ImageWidth As Long           '图像宽（像素数） /C/I_S}H  
  ImageHeight As Long          '图像高(像素数) 3EA`]&d>  
  PlaneNumber As Integer  '图像层数 YeV
kX{y  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap { 3K`yDF  
                                        '4 - 16 color bitmap oC|']r6  
                                        '8 - 256 color bitmap sEcg;LFp  
                                        '16 - 16bit (high color) bitmap MmD1@fW32#  
                                        '24 - 24bit (true color) bitmap &'W ~~ir  
                                        '32 - 32bit (true color) bitmap C |P(,Xp  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) lnt}l  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) (RI+4V1  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) PPj%
.i)  
                                    '3 - bitfields (also identified by bi_bitfields) ^) 5*?8#  
  IMAGESIZE As Long  '图像数据字节数 JO&+W^$uY}  
  hResolution  As Long  '水平分辩率  像素数/米 )KUEkslR:  
  vResolution  As Long  '垂直分辩率 SAokW,  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 C ,#D4  
  ImportantColors As Long yu$xQ
~ o  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 V~S(cO[vj  
End Type ZW`wA2R0   
P5o

Yv  
r WN%Tai-  
C*Wyw]:r  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader aThvq%;  
Public sRECT As RECT ?d@ zTAI  
@K}Bll.E  
AzFS6<_  
Public conn As ADODB.Connection -H"^;37T"  
Public rsTrain As ADODB.Recordset s@pIcNvx  
Public rsOperater As ADODB.Recordset aa/_:V@$~  
Public rsGoods As ADODB.Recordset R;H>#caJ  
Public rsGood2 As ADODB.Recordset 9bu1Ax1M  
Public rsSender As ADODB.Recordset mC./,a[  
Public rsReceover As ADODB.Recordset f<*-;  
Public rsTrainTMP As ADODB.Recordset ,`ju(ac!  
kB]*2o9-3  
i`7:^v;  
'打开采集卡 %KW NY(m  
'设置参数 ]ujXPK=t  
'设置为实时单帧采集到缓存方式 D[<~^R;*  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 JjnWv7W3$  
]3CW b>!_  
bs?&;R.5  
Sub Main() (dAE  
  Dim i As Integer, status As Long R)'[Tt`#R  
     eOs4c`  
   InitBMPinfo 5@`dKFB5  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 @8U8>'zDE  
    BMPHeader.Tag = &H4D42    
    BMPHeader.ImageWidth = FrameW yrFl,/8&G  
    BMPHeader.ImageHeight = FrameH !_+ok$"d  
    BMPHeader.BMPHeaderSize = &H28 x1`zD*{  
    BMPHeader.PlaneNumber = 1 =|
_k a8{?  
    BMPHeader.bpp = 8 HKG8X="  
    BMPHeader.Compression = 0 tJ Mm  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 UiH5iZ<r;  
    BMPHeader.vResolution = &H1274 Z >J3DH  
    BMPHeader.ColorsinBMP = 256 xv0y?#`z  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP TS@U0Ror  
    BMPHeader.DataOffset = Len(BMPHeader)  ].3@ Dk  
    For i = 0 To 255 s1 (UOd7}  
      BMPHeader.Pallate(i) = RGB(i, i, i) F tay8m@f  
    Next i F3&:KZ!V&m  
    BMPHeader.IMAGESIZE = FrameH * FrameW )*Rr5l /l  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE "hLmwz|a  
i#(+Kxr]>  
H<ZXe!q(nx  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) RwDXO dg
u  
     Nu c2CB)J  
    BMP1.ImageWidth = FrameW cb%ML1c  
    BMP1.ImageHeight = FrameH * 2 I
S%e5  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight +p0Y*.  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE &f
<Ltdw  
$c7Utms  
  '确定标志位置,为pilarX, pilarY确定初始值 Y&1Yc)*O  
   PilarW = mkW Zxn>
]Z_  
   PilarH = mkH  '此两项为固定值 V(3rTDg  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) Gu#wH  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 x(y=.4Yf+  
   ![/
 QW  
   ew*;mQd  
  '连续采集记录文件 !c=EB`<*  
  ' 建立一个缓冲区为页对齐方式的文件 KBwY _  
  If Dir(TmpFile) <> "" Then n[  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ x)-n[Fu  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) RKwuvVI  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 NU.YL1  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 (]sk3 A  
  Else qWb8"  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ ad`=A V]  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) AJ)N?s-=  
  End If \bv JZ_  
  If hFile = 0 Then nVGWJ3  
    MsgBox TmpFile & ": File Open Error", vbOKOnly tS6r4d%~=  
    Exit Sub D<(VP{,G  
  End If A5%cgr
% 6  
  '采集参数记录文件 JwcC9 O  
hBCFile = FreeFile() (zIF2qY  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile zN7Ou .  
   JeU1r-i  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 GW!%DT  
If hMEM = 0 Then Tu-I".d+  
    fStatus = GetLastError P B"nf|pm  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ PAs.T4Av^  
     & "请向技术人员报告该错误代码。", vbOKOnly ]vq=~x  
    CloseHandle hFile XA
-,  
    Exit Sub BaOPtBYA:  
End If >^Y)@J
 
<gx"p#JbZ  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 1-?TjR  
If hMemWork = 0 Then K"g`,G6S  
    fStatus = GetLastError ;  8u5  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 89a`WV@}  
     & "请向技术人员报告该错误代码。", vbOKOnly mZ4I}_\,  
     '释放已成功分配的内存 .oz(,$CS"  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) &|c] U/_w  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) oL*ZfF3  
     js)I%Z  
    CloseHandle hFile `&g1`vg  
    Exit Sub yr34&M(a  
End If trM)&aQto  
iK9#{1BpML  
' Test writing a\Dw*h?b~  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& E9:p A5H-j  
     MTeCmFe0;  
   '初始化采集卡参数 ^LAdN8Cbb  
   iCurrentCard = -1 ki9vJ<  
   hBoard = okOpenBoard(iCurrentCard) R1C2d+L  
   Debug.Print hBoard +M.!_2t$2  
   If hBoard = 0 Then J
|N>}di  
      ExitGrabber 7:X@lmBz=  
      End ~0Xx]   
   End If !k=~a]  
   okGetBufferSize hBoard, mBufferAddr, BufferSize xoNn
'LF#u  
   If mBufferAddr = 0 Then 77~l~EX  
     MsgBox "缓存不存在！" WZ ^u%Z  
     ExitGrabber <O9.GHV1v  
   End If `d!~)D  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) F/0x`l  
   `(pe#Xxn  
   & 6~AY:0r  
   currentBr = 128: currentContr = 128 }R)A%FKi@  
   '设置视频输入参数 r9$7P?zm  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 `&>CK`%Xu  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input }
BLT2] y0  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 UjH+BC+9`b  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 DWcEl:  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 .*+e?-  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 l&
6+ykQ  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） J]qx4c  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) &z%DX   
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) U$T (R2@  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 n^k Uu2g|  
   07A2@dx  
   '设置采集参数 VMV~K7%0  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 CU a`#  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 bTc'E#  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 z|sR `
]K  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 ej{7)#  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 CB>O%m[1  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 <PXnR\  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 k"J=CDP\  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 q%c"`u/v/  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 JsbH'l  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 #(d /A<  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 $/;<~Pzi  
   T.iVY5^<  
   BV6 U -  
   okCloseBoard hBoard G,A;`:/  
   Sleep 50 Q)l~?Fx  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 'tun;Y  
   F=8gtk|U  
   '设置数据传送方式 FHbw&  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ~
6Df~uN  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 L_ 2R3w  
   mKhlYVn  
   sRECT.Right = -1   '用于获得当前设置值 s&Ml1A:  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) O -N> X  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom P>;uS
  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 VU(#5X%Pn  
   sRECT.Left = 0 y2NVx!?n  
   sRECT.Top = 0 ,)P6fa/  
   sRECT.Right = sRECT.Left + FrameW ~OOD#/  
   sRECT.Bottom = sRECT.Top + FrameH * 2 #;Z+X)  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) * AjJf)o  
   t7b\#o  
   sRECT.Right = -1   '检查新设置值
hPgDK.R'  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) +B-;.]L T  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom $_b^p=  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) `~{0  
   6'QlC+E  
   If TESTSignal = False Then S9@)4|3C|p  
      'ExitGrabber e*jfxQ=qG  
   End If *OMW" NZ;  
   !UW{xHu  
   C4 @"@kbr  
   h|Udw3N1L  
   '设为实时采集状态 i V8O<en&i  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) =%$BFg1a(  
   xgv&M:%D-  
   pPtw(5bH  
   '单帧采集 bAm ,gP  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 iJ 8I# j+N  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) !nyUAZ9 :  
   okCaptureTo hBoard, BUFFER, 0, 1 'single yZ57uz  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 lv0}
d  
   '   Sleep 20 7P7d[KP<  
   'Loop Q>[GD(8k  
   okGetCaptureStatus hBoard, True y/yg-\/XF  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize Z<n%~z^  
   '写入768*576测试图象 _0=$ 2Y^  
   ArrayToBMP TmpBMP +hKH\]  
   y|[YEY U)  
   '打开数据库 :} 9Lb)Yp  
   Set conn = New ADODB.Connection #J)83  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ WbDD9ZS  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ [wR x)F"  
      "; Mode=Read|Write" ;+iw?"  
   conn.Open _4MT,kN  
   ^ G@o} Z  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) +5IC-= ZB  
   frmRecord.Visible = True )6,Pmq~)  
   frmQuery.Visible = True {1]/ok2k5  
   Load frmReceiveFromComm 8nOent0a  
   j q"iLgEMO  
   '调试参数 0@*EwI  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then ?^W`7HF%0  
     SignalBox.Visible = True QX&1BKqWn  
   End If aO>Nev  
   If InStr(UCase(Command()), "/COMM") > 0 Then =K\.YKT  
     frmReceiveFromComm.Visible = True 30nR2mB Kt  
   End If e-/+e64Q@  
FV W&)-I  
End Sub 29GcNiE`T  
8lcB.M  
Sub ExitGrabber() 0xe*\CAo  
  '关闭数据库 ?q+^U>wy&  
  '关闭采集卡 @8s:,Y _  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) /6a617?9J  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) #ZvDf5A  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) 3# r`e  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) /|z_z%=  
  okStopCapture hBoard VA0p1AD  
  okCloseBoard hBoard <zE~N~;  
  CloseHandle hFile @I,:(<6  
  Close #hBCFile 2v9T&xo=  
  conn.Close 8.R~Y
s*  
  End 0R[onPU_vZ  
End Sub @E@5/N6M  
:OvTZ ?\  
Function ArrayToBMP(ByVal File As String) IL2OVLX  
Dim BytesWrite As Long [_,Gk]F=  
&[iunJv:eq  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ @2Ca]2,4  
  CREATE_ALWAYS, 0&, 0&) hhynB^o  
RFq&#3f$  
If hTmpFile = 0 Then -Rz%<`  
   ArrayToBMP = False ]@bu%_s"  
   Exit Function Th[Gu8b3  
End If A~7q=
-  
A*_ |/o
 
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN Ci?A4q$.  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& w UBug  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN q'~F6$kv5  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& &fuJ%  
S6pvbaMZ  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN I&Y9  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& N J_#;t#j  
`SGI Qrb  
If BytesWrite < pFrameSize Then FfR%@ V'  
  ArrayToBMP = False xh raf1v3\  
End If 5u3SP?.&  
}| !9aojr  
CloseHandle hTmpFile yQM<(;\O  
Zn9ecN  
End Function It8m]FN  
2or!v^^u  
Function ArrayToBMP1(ByVal File As String) !>Ru= $9  
xfJ&11fG2  
Dim BytesWrite As Long |g}~7*+i  
4ZN&Yf`  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ y
% ^TZ[S  
  CREATE_ALWAYS, 0&, 0&) TScI_8c>  
i4 Vv6Sx1  
If hTmpFile = 0 Then 1l*O;J9By  
   ArrayToBMP1 = False  y+.E}  
   Exit Function 6}9`z8  
End If V]I+>Zn| 7  
1ZK~i  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN {s/u[T_D2  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& _p
S!sY~d  
zP$Ef7bB  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN &XE eJ  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& m^rrbU+HM?  
fPLi8`r  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN a'm\6AW2)  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& Jg\1(ix  
o#ajBOJ  
If BytesWrite < pBufferSize Then mrvPzoF,]  
  ArrayToBMP1 = False #O2e[ E-  
End If pJpTOq\h  
Kgw_c:/'  
CloseHandle hTmpFile 3A5:D#  
'z.: e+Q_  
End Function ]&l%L4Z  
z'+k]N9Q^  
'使用该过程建立的文件要求在用后关闭 ,V}Vxq3  
Public Function ArrayToBMP2(File As String) As Boolean 4RXF.kJ3=  
2%F!aeX  
Dim BytesWrite As Long 'HdOW[3o  
3"XS#~l%  
ArrayToBMP2 = True :P1/kYg  
P:8P>#L  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ Lj(y>{y  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) o}4J|@Hi|4  
d|c>Y(  
If hTmpFile = 0 Then }qhNz0*  
   ArrayToBMP2 = False 540,A,>:tb  
   Exit Function PC3-X['[  
End If ttaYtV]]  
lp=8RbQYC  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN :n t \uwh  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& +W-,74A  
31@m36? X  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN o/Cu^[an  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& M~/R1\'&j  
{F~:86z(g  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN F;,LY:s|Z  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& OY>0qj  
KKLW-V\6K  
If BytesWrite < pFrameSize Then t/HUG#W{  
  ArrayToBMP2 = False <h"*"q|9  
End If D^%DYp  
R?K[O   
CloseHandle hTmpFile r-+S^mOE]  
,{_;q :  
End Function l~v BA$,  
wK[Xm'QTPJ  
Private Function TESTSignal() As Boolean eGJ}';O,g  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long \X?GzQkr  
R:LThFx  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) Q|`sYm'.  
(2vf <x  
If extsign = 1 Then ~>]/1JFz  
   TESTSignal = True Q[M?LNE`  
Else cqyrao3;  
    If extsign = 0 Then &InMI#0mV  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly c8 xZT  
        TESTSignal = False IT~pp_6g  
        Exit Function s[HQq;S  
    End If 0,x<@.pW  
End If # *|0WaC  
WO=,NQO w  
'测试视频输入类型 !ufSO9eDx"  
'video type }N6r/ VtOQ  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 %wD<\ XRM  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) :)9^T<  
If videotype = 1 Then u3>Dvl@  
        '"隔行信号(Interlaced)" zwyK \j  
Else DY~zi  
   If videotype = 0 Then iA[WDB\|0  
       '"逐行信号(Non-interlaced)" tLzX L*  
   Else tbP ;iK'  
     If videotype = -1 Then ZTwCFn  
       ' "不支持" 5yhfCe m|  
     End If <&$:$_ah  
   End If 8eVQnp*  
End If X+*"FKm S.  
&74*CO9B9  
'测试垂直扫描线数 mCY+V~^~kz  
'video scanlines Dm.tYG
 
scanlines = -1 QE8aYPSFf  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) i1k TP9  
    If scanlines = -1 Then z'FJx2  
        ' "不支持" {hLS,Me  
    Else CAPPOh  
        'Trim(Str(ScanLines)) + " 行数/幅" 9W[ ~c"Ku  
    End If <hO|:LX  
6UkX?I`>  
'测试帧频 bz=B&YR  
'video field frequency ]5=
C3Y  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) J
:q:g*Wi  
    If fieldfrq = -1 Then # [0>wEq  
        'lblSignal(8) = "不支持" A]FjV~PB  
    Else qL03iV#h*V  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" !AGjiP$  
    End If dgIEc]#pH  
End Function <CJ`A5N  
pxs#OP  
5l&9BS&  
Sub PicIdentify() ?_+h+{/@B  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 6,*o;<k[  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 Cy~Pfty  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 #(5hV7i  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 Ao:<aX,=  
}8W5m(Zq9n  
  Dim fPTR As Long, cFrame As Long ?oc#$fcQ~  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer qrj:H4#VB  
     * @QC:1k  
=[$zR>o*%  
cFrame = 0 kh'R/Dt  
;6?VkF  
#!WD1a?L  
Do While cFrame < tFrames $ 4& )  
   #z*-  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) 9Xu O\+z  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) {I2qnTN_a  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize *UJ &9rQ
 
   m'Thm{Y,?n  
  frmRecord.RText.Text = Str(cFrame) e uF@SS  
  frmRecord.RText.Refresh -zq_W+)ks  
       }4; \sY  
  If CheckMark = True Then
-]?F  
   ArrayToBMP TmpBMP A{!D7kwTz~  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) QF7iU@%-  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" Yzr|Z7rq}  
   ^,$>z*WQ.  
   DrawSlice [email protected]:uU  
   b\U p(]  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) <~[A  
   'If i = vbNo Then *c[X{  
   '  Exit Do 1P'R-I  
   'End If Of*z9YI  
   'cFrame = cFrame + 1 #SzCd&hI   
   2[Ja|W\If  
  End If 0PK*ULwSN  
  DoEvents d`_X$P4y  
  cFrame = cFrame + 1 }h6N.vz  
Loop #hOAG_a,  
End Sub d4h, +OU
 
v/4Bt2J  
jE!W&0  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean dz6i~&  
>4zH\T!  
'如标志区模式反差存在则为TRUE，否则返回FALSE Z|z+[V}[  
\*5_gPj!d  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long m 8Q[+_:$H  
CheckMark = True nEZoF  
   vPV=K+1  
'复制标志区 (oYM}#Q  
For i = 1 To mkH dh~+0FZ {A  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW ~;f,Ad`Q  
Next i 
)T=cd   
d +]Gw  
For j = 1 To PilarW * PilarH / 2 Qo!/n`19  
   mTop = mTop + MKpilar(j) <oE(I)r4,  
Next j !i|]OnJY  
p&:(D=pIu  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH pm*6&,  
   mBot = mBot + MKpilar(j) {hr+ENgV  
Next j Gj.u
/l  
Dt9[uyP&  
mTop = mTop / PilarW / PilarH * 2 `xO9xo#  
mBot = mBot / PilarW / PilarH * 2
aK%i=6j!  
Z"# /,?|3@  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 Felu`@b  
p.gaw16}>  
'平均值极值化 (>OCLmV $  
  For j = 1 To PilarH * PilarW H^N@fG<*dh  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) Uv(T HxVh  
  Next j k-v@sb24_  
   gU
oL8~  
mTop = 0: mBot = 0 )_bR"!Z  
For j = 1 To PilarH * PilarW / 2 )<D(Mb2p|  
  mTop = mTop + MKpilar(j) i_? S#L]h  
Next j llf|d'5Nl  
6%K,3R-d  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW QT5,_+ho  
  mBot = mBot + MKpilar(j) M``I5r*cg  
Next j @q?zh'@;  
pN[G?A  
]yxRaW9f  
  mTop = mTop / PilarH / PilarW * 3 *}t,:N;i  
  mBot = mBot / PilarH / PilarW * 3 f 2sv$#'  
   H)s$0Xd  
6o
_t;cpT  
If mBot > iWhite And mTop < iBlk Then BCE}Er&  
  CheckMark = True LM*#DLadk  
Else Hd1e9Q,:|  
  CheckMark = False PF,|Wzx  
End If $6ZO V/0  
End Function ;+dB-g[
 
.}}w@NO  
Sub Capture1Frame() Vp;^_,
  
   okCaptureTo hBoard, BUFFER, 0, 1 'single ^_5Nh^  
   okGetCaptureStatus hBoard, True o*OaYF'8  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize | %Dh  
End Sub 8?lp:kM  
y] Io`w(>  
OZ*V7o  
Sub CopyMark(iBlk As Integer, iWhite As Integer) (W<n<sl:-  
'复制标志区并返回标志区暗区与亮区的亮度平均值 ![wV}.}  
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 ; 7`y
##  
   >g+ogwZ  
'复制标志区 2BU%4IG  
For i = 1 To mkH PXZZPW/  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW vGK'U*gGD  
Next i y%X{[F  
yW&|ZJF?  
For j = 1 To mkW * mkH / 2 Ie#LZti  
   mTotal = mTotal + MKpilar(j) nyZUf{:  
Next j 7R 40t3  
M>CW(X  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度  )"im|9  
7I/  
mTotal = 0 S$!)Uc\)A  
For j = mkW * mkH / 2 + 1 To mkW * mkH cG|ihG5)  
   mTotal = mTotal + MKpilar(j) o%+8.Tx6wT  
Next j #6[7q6{4  
edt(Zzk@3-  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 `7|\Gqy  
{xm^DT  
'背景亮度 : -@o3Syg  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW tN'-4<+  
  For i = 1 To 4 * FrameW I/ pv0  
    bsTotal = bsTotal + BsLine(i) Rw$>()}H8  
  Next i ~aK@M4  
  bsAV = bsTotal / FrameW / 4 1D42+
cy  
7b,5*]oZ  
End Sub 'J&&F2O%  
;:JTb2xbb  
oC]|ARgQk|  
Sub AdjIMGbright(Optional bInit As Boolean = True) dF$Fd{\4^  

`TM[7'  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） vHY."$|H  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 RcUKe,  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 L{K:XiPn  
     {iG
k~qN  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer \0'7p-
T6  
   C F2*W).+  
  '按标准亮度与对比度采集一帧，确定背景亮度 Fd:A^]  
  currentContr = 128   '初始对比度 =?U"#a  
  currentBr = 128   '初始亮度 "y_A xOH  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 x0ZEVa0`4  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 -[cl]H)V  
  DoEvents k%iZ..  
  Capture1Frame jP{LMmV  
  '获得图像上缘4行象素 'Cq
WF"  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW >&0)d7Nu8m  
  CopyMark iBlack, iBright   '图像标志区亮度 ?fB}9(
6  
  For i = 1 To 4 * FrameW (fc /"B-  
    bsTotal = bsTotal + BsLine(i) #x"dWi(  
  Next i (UDR=7w)  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 "o +" Jd  
   7-nz'-'  
  Select Case bsAV #`tn:cP  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 S!0ocS !t  
       currentBr = 150 Cd:ofv/3  
       currentContr = 60 . Q3GA0O  
     Case 61 To 80   '有可见背景 rrGsam\.  
       currentBr = 140 2k,!P6fgl  
       currentContr = 70 4{Vw30DZ  
     Case 81 To 100  '有清晰背景 fr~e!!$H  
       currentBr = 128 Sm
;EWz-?  
       currentContr = 80 c;w%R8z  
     Case 100 To 150  '有明亮背景 y*,3P0*z  
       currentBr = 140                '5:30-6:00钟实测数据 A^PCI*SN[  
       currentContr = 50 LQ5W S  
     Case 151 To 180 \de824  
       currentBr = 130 9kcp(  
       currentContr = 60 &J~vXk: !  
     Case 181 To 220  '背景全为白色 PTfy#  
       currentBr = 110 M<t>jM@'A#  
       currentContr = 130 [KIK} :  
     Case 221 To 255  '背景全为白色 _ri1RK,  
       currentBr = 100 *I0{1cS T  
       currentContr = 100 <Z^t^ O  
  End Select p?OwcMT]M  
   J1I"H<}-6  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 Jsee8^_~  
        Case 100 To 150 gf`uC0  
          currentBr = currentBr - 10 S/j~1q_|G  
        Case 151 To 255 *@J  
          currentBr = currentBr - 20 \`N%77A  
  End Select :IFTiq5a;  
   , nqG* o  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 6Sh0%Fs  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 m^dK
ww  
End Sub T<*i($ [  
xU/Eu;m  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) r
>N5^  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long B;A^5~b  
     tcYbM+4e  
    For i = 1 To 8 5gP#V K  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& 2.=3:q!H<%  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& eW $G1h:  
    Next i @\ip?=  
     krkRP%jy  
    For j = 1 To 1024 M{S7tMX  
      L1 = L1 + LeftBK(j, 0) {K-]nh/  
      L2 = L2 + LeftBK(j, 1) <r (Y:2  
      R1 = R1 + RightBK(j, 0) ?MevPy`H  
      R2 = R2 + RightBK(j, 1) }-H<wQ&x  
    Next j r40#-A$  
    diffL = Abs(L1 - L2) / 1024 Ds|/\cI$%a  
    diffR = Abs(R1 - R2) / 1024 =/@c9QaVB  
End Sub &P>wIbE  
sidSY8j  
Function CheckSlice() As Boolean ,bRvj8"M  
  CopySlice avSL, avSLR, avSLL .YquOCc(  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then HH[b1z2D  
    CheckSlice = True k;v23  
  Else "x&hBJ  
    CheckSlice = False Ea@N:t?(8=  
  End If k$nQY  
End Function %C*oy$.  
8fzm CRFH  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) lc/q0  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long MIPmsEdBi  
  For i = 1 To FrameH {s}@$rW  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize pEIc?i*  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize =:rR%L!a  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize =T$-idx1l  
  Next i @DYxxM-  
  For i = 1 To FrameH DXj_\ R(}  
    For j = 1 To sSize MF/359r)Et  
       total = total + Slice(j, i) 4C2JyP
3  
       totalL = totalL + SliceL(j, i) [xT2c.2__J  
       totalR = totalR + SliceR(j, i) )>q.!
"B  
    Next j T" Ph@I<  
  Next i RG=!,#X  
  avSL = total / FrameH / sSize {l=!  
  avSLR = totalR / FrameH / sSize 8M m, a  
  avSLL = totalL / FrameH / sSize WAlsh
  
End Sub (q+U5Ls6  
oXG,8NOdC  
Sub DrawSlice() Pb$ep|`u  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B *9}2Bmojv  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B vS%r_gf(  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B JF]HkH_u  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) BBy"qkTe  
End Sub olzP=08aaV  
Sub DrawMark(pic As Control) pX ]K-  
   Dim i As Long, j As Long hPt(7E2ke~  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B :&X
y#.un  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B L 0kK'n?  
   For i = 1 To PilarH :(EU\yCzK  
     For j = 1 To PilarW uGl+"/uDu  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) (9x8,f0z  
     Next j CMa~BOt#  
   Next i p{7"a  
End Sub c F_hU"  
6 dO )]  
Function avIMG() As Integer ^y"Rdv  
  Dim i As Long, j As Long, totalIMG As Long V2kNJwwk  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize L_uliBn  
  For i = 1 To pFrameSize }0
c  
    totalIMG = totalIMG + pBuffer(i) n0#HPI"  
  Next i 0IoS|P}6a  
  avIMG = totalIMG / pFrameSize 9,y*kC  
End Function ot P7;l  
P` wp`HI  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer \k;)m-0bj{  
  Dim i As Long, j As Long, totalIMG As Long e$|g  
  For i = 1 To FrameH "FI]l<G&  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth &Mbpv)V8  
  Next i jJ-j   
  For i = 1 To FrameH * barWidth AZcWf8  
    totalIMG = totalIMG + pBuffer(i) SEQ bw](ss  
  Next i X_XeI!,b  
  avRegion = totalIMG / pFrameSize H)1< ;{:  
End Function az3rK4g  

一共这么多文件。 +~RiCZt  
|)QE+|?P  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 c*ac9Y'o  
第6车皮 G (Fi  

"#^11o8  
!Q
=H)\3  
第9车皮 ^'r/;(ZF*/  
GMRw+z4  
  

从这里里分离出来的。

C]K|;VQ  
 Hrm^@3  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 H->J.5~,K  
&wr0HrE\  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ sA=WU(4^  
l -us j%\  

继续填个坑： O`R@6KG   
+m kub}<a  
用VBA控制WORD自己修订学生毕业文的格式。 7<
['4*u