引用

引用第20楼newport93于06-14-2010 13:47发表的  : %|H]T]s  

>C_G~R  
老五，I 服了U。 [(*Eg!?W
=  
u=nd7:bv  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 =A,B'n\R  

$rW(*#C  
mF@7;dpr  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! i=<;$+tW  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : v*Gd=\88  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? pdJ]V`m  

| U0s1f  
0#TL$?=|  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : V5$Gb6?K  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 Y _
`JS;  

XgX~K:<jt  
kiJ=C2'&  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 v|~=rvXFC  
:z P:4NW  
可以从宽不？

引用

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

}0\SNp
VN  
40MKf/9  
其实标题没有什么，卡总既然改了就不必再改回了。 6M&ajl`o  
'.z7)n  
主要是当初写的时候真是顶着锅盖写的。
EpG9t 9S9  
A z@@0  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : $I-iq @  
哦, 打倒忽悠大家的家伙.      )x[=}0C  

}` `oojz  
2&'uO 'K  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : p({|=+bl  
每个人的故事对其他人都是故事, !#]kzS0  
自己的故事也是其中之一. J.2B B
y  
跳出来看, s
dXchVC  
不过是众人中的一个人的故事. O+XQP!T  
P >0S ZP  
所以,接着听故事. 056yhB  
#F .8x@  
女人们有兴趣的就等老伍开个新帖或者跟贴, ]lJ#|zd8o  
听他痛说恋爱革命历史.... hHw1<! M  
PTpCi
iA@  
杂家接着听他自学程序员历史, )I<VH+6  
高级程序员考了吗? nC/T$ #G  

A+Je?3/.  
<5]_u:  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ coaJDg+  
gDfM}2]/  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 UlN}SddI9  
6"?#s/fk  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 b,HXD~=  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : *=E4|>Ul,  
引用第19楼伍胥之于06-14-2010 12:33发表的  : /e*<-a  
r Z5eXew6  
^kB9 I8u  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 "J >, Hr9  
EjVB\6,  
我连一级也没有考过。 U_B`SS  
. Z.>?Dt  

NVC$8imip  

引用

E h_[8:dK  
矬子里拔将军... Yic'p0< ?V  
你们那里的俗语是吧? A]V<K[9:b  
yCg>]6B  
我们这里说"矮子里拔长脚"..应该是同一个意思... +xmZK<{<  
g=v[@{9Pw  
有趣....各地有表达意思一样却方式不同的俗语.... 4P24ySy9F  
/s:akLBaD  
Xw^:<Nx:  
你的文章写的有脸皮,没屁眼的, 9qZ|=r]y'  
让看客大为不满... yNx"Ey dk`  
QQ,w:OjA0  
你等着,,估计你以后接到的午夜凶铃就多了... MT&q~jx*  

8{Svax(  
>W8PLo+i  
我到现在也没有接到你的午夜凶铃呢！ e8]mdU{)  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : {la^useg[  
伍SIR，再次抱拳佩服 R?\8SdJ  

8%U )EU  
Nb{oH+$b  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : qC|re!K  
佩服，玩也玩得这么专业！ aA yFu
_  

EGM
cU|yL  
x[oYN9O  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : nW%c95E  
BPOWo8TqD^  
介个真的看不懂。 (jyJ-qe  
你说你老啦，喜欢怀旧了，才想起来填坑。 hP#&]W3:  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 ?3, *  

*:_hOOT+[  
4'8.f5  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 5m3sjcp_  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ DpR%s",Q  
DWORD dwCB; \5l}5<|  
LARGE_INTEGER  offset; VEZ/-s/  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); Ywr{/  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); eK@Y] !lz  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ ?d%}K76V<  
DWORD error = GetLastError(); %qv7;E2C  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); F y@D&j  
return FALSE; 0nd<6S+fs  
} xMh&C{q  
return TRUE; ljCgIfZ_4  
} OWkK]O  

'VB 6.0 版 5-QXvw(TH  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 334*nQ  
(TQXG^n$gY  
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 &_6:TqJ  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long WQ]pg "  
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 sig_2;  
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 G#*;3X$  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long kgu+q\?  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 M
/qiA.C@W  
$p@g#3X`  
v]!7=>/2  
Private Const GENERIC_READ = &H80000000 NlMx!f>b%/  
Private Const GENERIC_WRITE = &H40000000 >JMKEHl.q  
4c yv 8  
Private Const FILE_SHARE_READ = &H1 U|QDV16f  
Private Const FILE_SHARE_WRITE = &H2 s5dh]vNN  
Private Const OPEN_EXISTING = 3 BkF[nL*|  
V+q RDQ  
Private Const INVALID_HANDLE_VALUE = -1 Xz@>sY>Jc  
-wt2ydzos  
'//file seek td~3N,S  
Private Const FILE_BEGIN = 0 ?~{xL"  
Private Const FILE_CURRENT = 1 }R x%&29&  
Private Const FILE_END = 2 g s3}rW  
`xr%LsNn  
Private Const ERROR_SUCCESS = 0& 90!Ib~7zH  
fYi!Z/Ck2  
'//device io control \4[Ta,;t  
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 VGq]id{*$  
.wSAysiQ|P  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 )Fw)&5B!  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 #@fypCc  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 #wyS?FP-  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 one>vi`=  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C BSY#xe V  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 Y(f-e,  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F uwka 2aSS  
>A/=eW/q  
'//type KPhqD5, (  
Private Type LARGE_INTEGER +*q@=P,  
    lowpart As Long F8I<4S  
    highpart As Long ]lY9[~ v  
End Type ;~J~
g
#  
;<A/e  
Private Enum MEDIA_TYPE K&h6#[^\d  
    Unknown \zUsHK?L"t  
    F5_1Pt2_512 UK,P?_e  
    F3_1Pt44_512 aBnbu vp  
    F3_2Pt88_512 '3Ie0QO]"%  
    F3_20Pt8_512 [1U_c*;i  
    F3_720_512 v#FUD-Z  
    F5_360_512 K
36B9<F  
    F5_320_512 /WfxI>v  
    F5_320_1024 96avgyc  
    F5_180_512 _;{-w%Vf  
    F5_160_512 ||=Duk  
    RemovableMedia K;l'IN"N  
    FixedMedia gib]#n1!p  
End Enum 1^3#3duV  
?+\,a+46P_  
Private Type DISK_GEOMETRY ^d*>P|n*@e  
    Cylinders           As LARGE_INTEGER ,Mc2dhq  
    MediaType           As MEDIA_TYPE 'Ot[q^,KRG  
    TracksPerCylinder   As Long I1~g?jpH  
    SectorsPerTrack     As Long Vvj]2V3  
    BytesPerSector      As Long 4o3GS8  
End Type Tjqn::~D  
}t'^Au`X  
'//private vars `^kST><  
Private hDisk           As Long             'disk handle \t@ `]QzG:  
Private lpGeometry      As DISK_GEOMETRY    'disk info O|~'-^  
Private lBufferSize     As Long             'the buffer size of read/write jHCKV  
s|T7)PgR  
Public Function OpenDisk(ByVal FileName As String) As Boolean JPG!c
X%  
'// 打开磁盘 Fe.*O`  
    hDisk = CreateFile(FileName, _ I\~V0<"jI
 
                        GENERIC_READ Or GENERIC_WRITE, _ fn
a>>  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ =*Xf(mhc  
                        ByVal 0&, _ !*gAGt_  
                        OPEN_EXISTING, _ ihrrmlN?  
                        0, _ 3XtGi<u  
                        0) ,GIqRT4K  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) z<>_*Lfj  
End Function z sPuLn9G  
`%3p.~>  
Public Function CloseDisk() As Boolean #Au&2_O  
'//关闭磁盘 eZi<C}z  
    CloseDisk = CloseHandle(hDisk) ~tvoR&{I  
End Function $@)d9u cd  
b3lpNJ J  
Public Function GetDiskGeometry() As Boolean $NHWg(/R@  
'//获取磁盘参数 K7c8_g*>4=  
    Dim dwOutBytes      As Long f,>i%.  
    Dim bResult         As Boolean MavO`m&Cg  
     {@AcL:Eit  
    bResult = DeviceIoControl(hDisk, _ }i:'f2/  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ }o-P   
                                ByVal 0&, 0, _ beE%%C]X  
                                lpGeometry, Len(lpGeometry), _ r.;iO0[/  
                                dwOutBytes, _ D$E9%'i
r  
                                ByVal 0&) "S:N-Tf%U  
     lv*uXg.k^  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack +.I'U9QeUN  
    GetDiskGeometry = bResult }HorR2(`N  
End Function -;$/<  
2\de|'  
Public Sub GetDiskInfo(MediaType As Long, _ 6,1|y%(f  
                        Cylinders As Long, _ .<%M8rcj  
                        TracksPerCylinder As Long, _ [!mjUsut*  
                        SectorsPerTrack As Long, _ h$\hPLx  
                        BytesPerSector As Long) GcW}<g}  
'//返回磁盘的参数 ^E 17_9?  
    MediaType = lpGeometry.MediaType #7h fEAk  
    Cylinders = lpGeometry.Cylinders.lowpart !++62Lf  
    TracksPerCylinder = lpGeometry.TracksPerCylinder ,v_r$kh^  
    SectorsPerTrack = lpGeometry.SectorsPerTrack /g''-yT7#  
    BytesPerSector = lpGeometry.BytesPerSector w>_EM&r6~u  
[i7)E]*oTA  
End Sub 5FI>T=QF  
sEyl\GL  
Public Property Get BufferSize() As Long rU@?v+i  
'//返回每次读/写的缓冲大小
-d'|X`^nE  
    BufferSize = lBufferSize TP::y  
End Property "lf3hWGw  
,0]28D  
h+D=/:B  
Public Function LockVolume() As Boolean dy
?|Q33Y"  
'// 将卷锁定 I;H9<o5  
    Dim dwOutBytes  As Long .`N`M9  
    Dim bResult     As Boolean q&T'x> /  
     El s=:4  
    bResult = DeviceIoControl(hDisk, _ @98SC}}u  
                                FSCTL_LOCK_VOLUME, _ CJ   
                                ByVal 0&, 0, _ 5Suc#0y  
                                ByVal 0&, 0, _ GuvF    
                                dwOutBytes, _ )fc"])&8  
                                ByVal 0&) yW?%c#9D  
    LockVolume = bResult `r(J6,O  
End Function l0if#?4\r  
{+9\o ~  
P'9io!
Z-s  
Public Function UnlockVolume() As Boolean MPN=K|*  
'// 将卷解锁 [)>8z8'f  
    Dim dwOutBytes As Long m?$G(E5  
    Dim bResult As Boolean LW5ggU/  
     4CT9-2UC  
    bResult = DeviceIoControl(hDisk, _ g}QTZT8  
                                FSCTL_UNLOCK_VOLUME, _ J6D$ i+  
                                ByVal 0&, 0, _ zqr%7U  
                                ByVal 0&, 0, _ XF$]KAL0  
                                dwOutBytes, _ P%HyIODS  
                                ByVal 0&) $#3<rcOq  
    UnlockVolume = bResult PM!t"[@&  
End Function G!%XQ\a!  
[Od9,XBa  
y/hv H"f  
Public Function DismountVolume() As Boolean %5?-g[  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 l>Ja[`X@  
    Dim dwOutBytes As Long fcXk]W  
    Dim bResult As Boolean iGVb.=)  
     Z3>3&|&  
    bResult = DeviceIoControl(hDisk, _ b CUh^#]x  
                                FSCTL_DISMOUNT_VOLUME, _ B-'BJ|*4I  
                                ByVal 0&, 0, _  XYF~Q9~  
                                ByVal 0&, 0, _ +N:6wZ7<f  
                                dwOutBytes, _ (Gc`3jJ  
                                ByVal 0&) *[:CbFE0y  
    DismountVolume = bResult 6F/ OlK<  
End Function y7EX&  
\ZWmef  
yc=#Jn?S  
Public Function ReadDisk(ByVal Cylinders As Long, _ ![ID0}MjJ  
                    ByVal Tracks As Long, _ <L/vNP  
                    db() As Byte) As Boolean e7qMt[.  
'//按柱面和磁道来读取磁盘数据 .e
B"la|d  
    Dim iPos    As Long @i-@mxk6<  
    Dim lRead   As Long <JM%Kn )  
     )wv[!cYyW  
    iPos = Cylinders * Tracks * lBufferSize VQjFEJ  
     ~{Rt4o _W  
    If SeekAbsolute(0, iPos) Then Prz+kPP  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) 6-14Htsk6  
    End If f?^Oy!1]  
End Function E/$@ud|l"  
aw%v
u  
Public Function WriteDisk(ByVal Cylinders As Long, _ (A fbS=[  
                     ByVal Tracks As Long, _ ]G~N+\8]U  
                     db() As Byte) As Boolean !nBm}E7d  
'//按柱面和磁道来写磁盘数据 J*KBG2+13  
    Dim iPos    As Long lv_%  
    Dim lRead   As Long = M{CZm  
     LY:?OGh  
    iPos = Cylinders * Tracks * lBufferSize >@

"3Q`  
     PG[O?l  
    If SeekAbsolute(0, iPos) Then 8!Mzr1:  
        WriteDisk = WriteBytes(lBufferSize, db()) 5>[s
Cl-  
    End If  / !  
End Function dQ`ZrWd_U  
ZfCr"aL  
ur,"K'w  
'///////////////////////////////////////////////////////////////////////////////////// X3L[y\  
'//file system <&EO=A  
#s R0*  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean lWw!+[<:q1  
'//seek file s1 ^mk]  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte Hs-.83V  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) JX$NEq(  
    If LowPos = -1 Then AnE_<sPA  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) Mth`s{sATa  
    Else 
&\lS  
        SeekAbsolute = True B "F`OS[  
    End If $o$Ev@mi  
     Z6([/n  
End Function * r4/|.l  
@TPgA(5NR  
Iki+
5  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean +\[![r^P  
'//read data to array vp
75u93  
    Dim RetVal    As Long G[<[#$(  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) )F#< )Evw  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF !^bB/e  
    ReadBytes = Not (RetVal = 0) /Q>{YsRRB  
     ]op^dW1;0_  
End Function FoD/
Q  
],}afa!A  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean ~eOj:H  
'//write data from array cc(r,ij~4  
    Dim RetVal As Long m-S33PG{  
    Dim BytesToWrite As Long 1o~U+s_r  
    Dim BytesWritten As Long -WBz]GW4r  
     Vt)\[Tl~  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) w$[Ds  
     Fp6[W5>(-  
    WriteBytes = Not (RetVal = 0) 4OZ5hH h  
End Function ecqz@*d&  

这才是我当年写出的一个比较烂的程序 +=*m! 7Mr  
e]*=sp!T  
Main2.bas s3_e7D ^H  
BXK::M+  
Attribute VB_Name = "SubMain" Ril21o! j  
Option Explicit fByh";<`P  
V3A>Ag+^~  
'采集文件与临时文件 BUA6(  
Public Const TmpFile As String = "d:\30-0600.dat" fzFvfMAU  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 Rp`_Grcd  
9<(K6Q  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Wt)SdF=U/  
Public hBCFile As Long  '记录采集参数的文件 h6T/0YhWLP  
Public Const TmpBMP As String = "d:\1.bmp" +65~,e  
Public hTmpFile As Long #C,f/PXfaB  
q'Pz3/mk  
jPYe_y  
'采集窗口参数常量 3 +
8"  
Public Const FrameH As Long = 280& q4
.dLU,1  
Public Const FrameW As Long = 768& |h=+&*(:  
Public Const pFrameSize As Long = FrameW * FrameH ,F`KQ )\"  
eFj6p
<  
'标志区范围，用于识别车辆 |CZnq-,C  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X W]yClx \  
Public Const mkW As Integer = 28  '识别标志立柱宽度 |N=@E,33  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) _[{:!?-?  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) ,7fc41O3V  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 [N95.aD  
'车缝检测位置常数 ,8xP8T~Kmv  
Public Const sSize As Long = 32& PZ!dn%4jy  
Public Const sPos As Long = 310& 0nD=|W\@{  
Public Const sPosL As Long = 200& >SxZ9T|%  
Public Const sPosR As Long = 500& VM]GYz|#]  
'车缝检测框位置 oLqbR?  
Public Slice(1 To sSize, 1 To FrameH) As Byte o,Tr^e$  
Public SliceL(1 To sSize, 1 To FrameH) As Byte oF@x]bmU  
Public SliceR(1 To sSize, 1 To FrameH) As Byte !,6v=n[Nz  
Public avSL As Integer, avSLR As Integer, avSLL As Integer R<lNk<  
DNW2;i<hsz  
Y7:Y{7E7  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 +>!B(j\gx  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 ^`jZKh8)h  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 mj(&`HRs4  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long l@tyg 7CwY  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte |:e|~sism  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 ]Ic?:lKN  
aO^:dl5  
+F7<5YW&(  
(+gL#/u  
'一次连续采集的帧数 x'@32gv  
Public tFrames As Long s*)41\V0  
:B*vkwT  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 Oa}V>a  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 )p!*c,  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize >Z2,^5P{  
i#]aV]IT  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte )pZekh]v  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte 7Js>!KR  
Public pWorkSpace(1 To FrameW * FrameH) As Long s7.p$r  
Public Const pBufferSize As Long = FrameW * FrameH * 2 o1#:j?sN  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 C'8!cPFVv  
( *9I
p  
Public hBoard As Long   '采集卡标识 U7]<U-.&  
Public mBufferAddr As Long  '缓存地址 }l}yn@hYC  
Public BufferSize As Long  '缓存大小(字节) 'Wf?elB+  
Public iCurrentCard As Long W3jXZ>  
Public CapStatus As Long K{zCp6  
Public iFrames As Long 5U)ab3:  
Public currentBr As Byte, currentContr As Byte ?}=-eJ(7e  
FM9X}%5nu9  
Public hMEM As Long, mStatus As Long ;Y@!:p-H  
Public Const hMemSize As Long = pFrameSize * 4 c>R`jb@$N  
Public hMemWork As Long +w k]iH  
Public Const hMemWorkSize As Long = pFrameSize * 5 0E?s>-b  
ib(>vp$V  
|ilv|UV  
C?w <$DU  
'串口接收轨道衡数据 tIyuzc~U  
Public WeightFromCom As String q4Oxs  
Public bReceiveComplete As Boolean 0HHui7Yy>  
`\/toddUh[  
yNrinYw  
Public Type GrayBMPHeader 43J\8WBn@  
  Tag As Integer uEScAeQXsI  
  FileLength As Long    '文件大小 @ kJ0K  
  Reserve1 As Long jNe(w<',P  
  DataOffset As Long    '图像数据偏移量 7>'uj7r]=  
  BMPHeaderSize As Long  '文件头长 [:nx);\  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… o9
m
  
                        'the following sizes are possible: m1hW<  
                        '28h - windows 3.1x, 95, nt, … {*?sVAvj  
                        '0ch - os/2 1.x |-(IJG#)  
                        'f0h - os/2 2.x Zp7yaz3y  
b(}Gm@#  
  ImageWidth As Long           '图像宽（像素数） XdGpW   
  ImageHeight As Long          '图像高(像素数) jF38kj3O7  
  PlaneNumber As Integer  '图像层数 XDpfpJ,z"}  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap X!7VyE+n  
                                        '4 - 16 color bitmap ]3O 4\o  
                                        '8 - 256 color bitmap 6I v(  
                                        '16 - 16bit (high color) bitmap 2ec$xms  
                                        '24 - 24bit (true color) bitmap " K 8&{=  
                                        '32 - 32bit (true color) bitmap uq!;  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) *%T)\\H2  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) poXLy/K  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) 4?>18%7&  
                                    '3 - bitfields (also identified by bi_bitfields) VG<Hw{ c3r  
  IMAGESIZE As Long  '图像数据字节数 2gd<8a''  
  hResolution  As Long  '水平分辩率  像素数/米 Ic[}V0dk  
  vResolution  As Long  '垂直分辩率 YH)Opk  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 pKt-R07*  
  ImportantColors As Long mVv\bl?<  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 fJ)N:q`  
End Type ~!
nLbK2  
:W.jNV{e\F  
Q;$ 9qOF  
NI5]Nz<?  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader =zeFK_S!  
Public sRECT As RECT b&lN%+%}  

%s$rP  
. ]o3A8  
Public conn As ADODB.Connection gEr4zae  
Public rsTrain As ADODB.Recordset ioC@n8_[G  
Public rsOperater As ADODB.Recordset U,Z"G1^  
Public rsGoods As ADODB.Recordset <i_> y~v`  
Public rsGood2 As ADODB.Recordset XYqpI/s  
Public rsSender As ADODB.Recordset V&Xi> X8  
Public rsReceover As ADODB.Recordset dSOl D/c  
Public rsTrainTMP As ADODB.Recordset On{~St'V
 
E /fw?7eQ  
10C 2=  
'打开采集卡 ]ZzoJ7lr  
'设置参数
-A/ds1=;  
'设置为实时单帧采集到缓存方式 ^Yj"RM$;N  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 AVXX\n\_  
zVM4BT(  
NXzU0  
Sub Main() ds*m6#1b  
  Dim i As Integer, status As Long I?_E,.)[ I  
     )Qh>0T+(  
   InitBMPinfo G1kaF/`O  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 U/T4i#  
    BMPHeader.Tag = &H4D42 uP{;*E3?  
    BMPHeader.ImageWidth = FrameW ''#p47$8<d  
    BMPHeader.ImageHeight = FrameH .MDYGWKt  
    BMPHeader.BMPHeaderSize = &H28 ! jbEm8bt  
    BMPHeader.PlaneNumber = 1 c%|vUAq *  
    BMPHeader.bpp = 8 )n\*
ht7  
    BMPHeader.Compression = 0 J0^{,eY<  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 ss?]  
    BMPHeader.vResolution = &H1274 Y
]C;T  
    BMPHeader.ColorsinBMP = 256 :8p&#
M  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP \*f;!{P{  
    BMPHeader.DataOffset = Len(BMPHeader) v~^ks{  
    For i = 0 To 255 I2TD.wuIW  
      BMPHeader.Pallate(i) = RGB(i, i, i) Vh"MKJ'R^  
    Next i 1&"-*)  
    BMPHeader.IMAGESIZE = FrameH * FrameW 79)A%@YHQQ  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE <Ctyht0c.  
_9D|u<D  
"'['(e+7  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) 3g4e']t  
     #F_'}?09%  
    BMP1.ImageWidth = FrameW }qc#lz  
    BMP1.ImageHeight = FrameH * 2 9<xTu>7J  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight zuUT S[  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE [f<"p[  
\'n$&PFe  
  '确定标志位置,为pilarX, pilarY确定初始值 G/ v|!}?wG  
   PilarW = mkW puFXPw.3  
   PilarH = mkH  '此两项为固定值 ^C!mCTL1N  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) 'oleB_B
  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 m)s xotgXf  
   blJIto'  
   \Ut6;  
  '连续采集记录文件 ZhH+D`9  
  ' 建立一个缓冲区为页对齐方式的文件 n!GWqle  
  If Dir(TmpFile) <> "" Then f?,-j>[.=f  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ CN$I:o04C  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) *;<e '[Y7f  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 \r)%R5_CQ  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 12idM*  
  Else ]]>nbgGn#  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ h^}_YaT\  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) vG Y!4@[  
  End If /&CUspb  
  If hFile = 0 Then Pj'62
[5z  
    MsgBox TmpFile & ": File Open Error", vbOKOnly >@^<S_KVh  
    Exit Sub *"1~b
Pl  
  End If G49Ng|qn  
  '采集参数记录文件 as>:\hjP##  
hBCFile = FreeFile() l`SK*Bm~<  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile 82lr4  
   9160L qY  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 5^\m`gS  
If hMEM = 0 Then .>P~uZiX!  
    fStatus = GetLastError \I;cZ>{u"}  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ QV0M/k<'  
     & "请向技术人员报告该错误代码。", vbOKOnly ugno]5Ni  
    CloseHandle hFile ^%;"[r  
    Exit Sub ;Tta
H  
End If XJUEwX  
@8|Gh]\P  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) g^jJ8k,7(  
If hMemWork = 0 Then #zxd;;p3  
    fStatus = GetLastError d>&\V)E  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ i<mevL  
     & "请向技术人员报告该错误代码。", vbOKOnly )]73S@P(=  
     '释放已成功分配的内存 j~epbl)pC  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) <KtBv Ip]  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) 8/Mx5~ R  
     h6g:(3t6m  
    CloseHandle hFile +kM\ D~D1  
    Exit Sub 6#E7!-u(-  
End If Vn'?3Eb<  
L_^`k4ct  
' Test writing ~x'zX-@rC  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ,(P %z.P@  
     |"Z-7@/k$i  
   '初始化采集卡参数 /9pbnzn  
   iCurrentCard = -1 OZ^h\m4  
   hBoard = okOpenBoard(iCurrentCard) l8^y]M  
   Debug.Print hBoard Vb2\/e:k  
   If hBoard = 0 Then zO%w_7w  
      ExitGrabber I:F <vE  
      End 6J\q`q(W(  
   End If [UoqIU  
   okGetBufferSize hBoard, mBufferAddr, BufferSize H<,bq*@  
   If mBufferAddr = 0 Then 0pD[7~^o  
     MsgBox "缓存不存在！" #pX8{
Tf[  
     ExitGrabber }wfI4?}j}  
   End If mf}\s]_c  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) 5C B%=iL{  
   6+iK!&+=  
   8 }-7{  
   currentBr = 128: currentContr = 128 ;Z*'
D}  
   '设置视频输入参数 #7o0dE;Kg9  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 ?;^5ghY$  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input /l^y}o %?  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 4f!dYo4L  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 ilv_D~|  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 X@!X6j  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 gGI8t@t:  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字）  // <:k8  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) MI\]IQU  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值) 7,h3V=^)Q  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 :W~f;k  
   \#++s&06  
   '设置采集参数 9\AS@SH{^T  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 as(*B-_n~  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 Atd1qJ  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 ailG./I+  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 x9%-plP  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 ';6X!KY+]  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 dMJ!>l>2  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 Wab .|\c  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 >yKpM }6l{  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 
KY g3U  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 )!eEO [\d  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 @V$I?iXV  
   12lEs3  
   088C|  
   okCloseBoard hBoard -D#5o,]3  
   Sleep 50 )pS8{c)E  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 B7!;]'&d  
   <1 S+'  
   '设置数据传送方式 !lhFKb;  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 j7}lF?cJ2  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 VHW`NP 5Jl  
   T`?n,'!(  
   sRECT.Right = -1   '用于获得当前设置值 ,Aj }]h\L  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) Y%g "Y  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom .b,~f  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 :G}DAUFN  
   sRECT.Left = 0 E_3r[1l  
   sRECT.Top = 0 FZp<|t  
   sRECT.Right = sRECT.Left + FrameW '00J~j~  
   sRECT.Bottom = sRECT.Top + FrameH * 2 EjSD4   
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) "U{,U`@?  
   y@3kU*-1  
   sRECT.Right = -1   '检查新设置值 4{Udz!  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) b66R}=P l  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom MqdB\OW &  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) zmb
@*/fK  
   ,]7XMU3  
   If TESTSignal = False Then &DLhb90  
      'ExitGrabber v U}: U)S  
   End If nhewDDu  
   y"-{$N  
   `VZZ^K9zR  
   IBET'!j4"  
   '设为实时采集状态 VhvTBo<cw  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) vTd-x>n  
   H* /&A9("  
   dF e4K"  
   '单帧采集 "15=ET  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 2:'lZQ  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) GJ`UO  
   okCaptureTo hBoard, BUFFER, 0, 1 'single /lJjQ]c;>  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 DWrb
p  
   '   Sleep 20 RM,'o[%  
   'Loop PBrnzkoY  
   okGetCaptureStatus hBoard, True E*k([ZL  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize nLJBq)i  
   '写入768*576测试图象 x> \Bxa8  
   ArrayToBMP TmpBMP K2HvI7$-  
   E0YU[([G  
   '打开数据库 3]^'  
   Set conn = New ADODB.Connection X2^_~<I{,  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ E eB3 }  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ t#5:\U5r.  
      "; Mode=Read|Write" r?^"65=  
   conn.Open :Fw?{0  
   \XS]N_}8>  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP)  hgO?+x  
   frmRecord.Visible = True fa{@$ppx  
   frmQuery.Visible = True "0-y*1/m  
   Load frmReceiveFromComm &$#99\/  
   hk} t:<  
   '调试参数 W2<3C  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then EwQae(PpA  
     SignalBox.Visible = True JYV\oV{  
   End If .&iN(Bd  
   If InStr(UCase(Command()), "/COMM") > 0 Then fhRjYYGI  
     frmReceiveFromComm.Visible = True zQc"bcif5(  
   End If 3ji:O T  
h<% U["   
End Sub OQFi.8  
^f|<R8`  
Sub ExitGrabber() l.oBcg[  
  '关闭数据库 KjOi(YUnq7  
  '关闭采集卡 L\L"mc|O  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) G9Qe121m  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) X*O9JGh  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT)
wyw<jH  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) <d"Gg/@a  
  okStopCapture hBoard xNX'~B^4d  
  okCloseBoard hBoard -:SIS`0s  
  CloseHandle hFile X NE+(Bt  
  Close #hBCFile Hf%_}Du /`  
  conn.Close t ',BI
  
  End azX`oU,l  
End Sub $XGtS$  
"w&/m}E,[  
Function ArrayToBMP(ByVal File As String) JIxiklk  
Dim BytesWrite As Long kA^A mfba  
_| <BF  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ *1bzg/T<  
  CREATE_ALWAYS, 0&, 0&) jNc<~{/  
ug#<LO-.Rd  
If hTmpFile = 0 Then )0-o%- e  
   ArrayToBMP = False Wc|z7P~',%  
   Exit Function c'05{C  
End If 2~FPw{]j  
nxQ}&n  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN |<(t}}X  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& _~A~+ S}  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN yM ,VrUh  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& A1-qtAO]  
? )_7U  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN Qq3fZ =  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& /{X_ .fv<v  
%v4ZGtKC@  
If BytesWrite < pFrameSize Then ~@P)tl>  
  ArrayToBMP = False z+/LS5$  
End If Rd%0\ B  
|$e:*  
CloseHandle hTmpFile 9j#@p  
zfjw;sUX  
End Function rk,p!}FqL  
f#P_xn&et  
Function ArrayToBMP1(ByVal File As String) `?uPn~,e8  
U$'y_}V  
Dim BytesWrite As Long uD(t`W"  
<HQ&-jx  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ }bMWTT  
  CREATE_ALWAYS, 0&, 0&) hYb9`0G"2  
Df@/cT  
If hTmpFile = 0 Then ?@UAL.y  
   ArrayToBMP1 = False .pvxh|V  
   Exit Function +(mL~td
01  
End If A5XR3$
5P  
Mm#[&j[Y  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN c7qwNs*f  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& <Wy>^<`  
[5Y<7DS
 
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN RrWNJ&o  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& }q'WC4.  
 O<GF>  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN D9-Lg%  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& frqJN  
0JXqhc9'  
If BytesWrite < pBufferSize Then @^?XaU  
  ArrayToBMP1 = False Of`c`-<j  
End If T"!EK&  
"H1 :0p  
CloseHandle hTmpFile ,4Y*:JU4  
``9 GY  
End Function kG^dqqn6  
g X,9Gh  
'使用该过程建立的文件要求在用后关闭 <TxC!{<  
Public Function ArrayToBMP2(File As String) As Boolean q#vlBL  
oT3Y!Y3=<  
Dim BytesWrite As Long 254~:eB0  
w^o}E)O  
ArrayToBMP2 = True HmV />9  
|+NuYz?  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ El6bD% \G  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) DB@EVH  
/2@["*^$  
If hTmpFile = 0 Then >}SRSqJu  
   ArrayToBMP2 = False X/+OF'p o  
   Exit Function {oWsh)[x2  
End If c3k|G<C2  
j}RzXJ~t  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN yVS\Q,:J9  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& s, XM9h>P4  
bGv4.:)  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN .7Kk2Y  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& <LA^%2jT  
E*|tOj9`1n  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN VJ{pN~_1  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& Uix{"  
.wc = ]  
If BytesWrite < pFrameSize Then PayV,8   
  ArrayToBMP2 = False "l,UOv c  
End If ;&?pd"^<_Z  
@ls.&BHUP  
CloseHandle hTmpFile O3%[dR  
J_ J+cRwq  
End Function r(`nt-o@  
k/lFRi-i  
Private Function TESTSignal() As Boolean 0H:dv:#WAI  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long _/ Os^>R  
@2e2^8X7f  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) ~O4|KY  
C5n? 0I9  
If extsign = 1 Then ]}LGbv"`A  
   TESTSignal = True CBHc A'L  
Else 8#f$rs(}  
    If extsign = 0 Then ~FUa:KYD  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly eb!_ie"D  
        TESTSignal = False {4rQ7J4Ux  
        Exit Function , Oli  
    End If \0AiCMX[  
End If ]rW8y%yD  
{L0;{
  
'测试视频输入类型 J70D+  
'video type nG
rVw&  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 ^M|K;jt>  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) /#t&~E_|  
If videotype = 1 Then bPd-D-R  
        '"隔行信号(Interlaced)" T:!MBWYe|  
Else 0"4@;e_)>  
   If videotype = 0 Then _V@P-Ye  
       '"逐行信号(Non-interlaced)" z[&s5"  
   Else wUp)JI  
     If videotype = -1 Then '6zd;l9Z  
       ' "不支持" _;e\:7<m  
     End If zWIeHIt  
   End If ,7,;twKz  
End If Z+idLbIs  
O9]\Q@M.  
'测试垂直扫描线数 X+ f9q0  
'video scanlines (@&I_>2Q  
scanlines = -1 XDLEVSly7  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) JBcY!dy-d  
    If scanlines = -1 Then 40K2uT{cq  
        ' "不支持" -G b-^G  
    Else 8$}OS-  
        'Trim(Str(ScanLines)) + " 行数/幅" (0jr;jv  
    End If PZM42"[&  
t(?<#KUB-  
'测试帧频 ^7u#30,}3~  
'video field frequency zvf3b!}  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) $TG?4  
    If fieldfrq = -1 Then p|VcMxT 9-  
        'lblSignal(8) = "不支持" `WlE| G[  
    Else n33kb /q*  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" d6.}.*7Whc  
    End If Iql5T#K+  
End Function GLh]G(  
)=H{5&e#u  
P5URvEnz:  
Sub PicIdentify() 'G#SLqZy  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 +d
39f-[  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ((MLM3zJ  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 ;f%|3-q1[  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 crn k|o  
kuS/S\Z5K  
  Dim fPTR As Long, cFrame As Long ybvI?#  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer P s#>y&  
     r nBOj#N  
c8ZCs?   
cFrame = 0 R&So4},B  
Do;#NLrWb  
i\p:#'zk5  
Do While cFrame < tFrames =A
 n`D  
   ~_PYNY`"  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) U e*$&VlT  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) nj2g
s,k  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize C\Ayv)S#2  
   5py R~+  
  frmRecord.RText.Text = Str(cFrame) ;KcFy@ 6q5  
  frmRecord.RText.Refresh *not.2+  
       arj$dAW  
  If CheckMark = True Then F6dr  
   ArrayToBMP TmpBMP ^ d\SPZ  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) 0.DQO;  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" yQ[u3tI  
   "ahvNx;x  
   DrawSlice Tf-CEHWD  
   $D_HZ"ytu  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) oI@9}*  
   'If i = vbNo Then 4lz{G*u  
   '  Exit Do "!q?P" @C  
   'End If E`xU m9F  
   'cFrame = cFrame + 1 frH)_YJ%  
   t[2i$%NVM  
  End If !_^g8^>2(  
  DoEvents 7rIlTrG  
  cFrame = cFrame + 1 \4s;! R!  
Loop IZ~.{UQ  
End Sub K`4GU[ul  
Z.Pi0c+  
f\}22}/  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean
*K)0UKBr  
yJ/#"z=h?  
'如标志区模式反差存在则为TRUE，否则返回FALSE u~'OcO  
=_QkH!vI  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long \A(5;ZnuD  
CheckMark = True #x~_`>mDN  
   d=F-L  
'复制标志区 )N)ljA3]  
For i = 1 To mkH ,- HIFbXx@  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW }ND' 0*#  
Next i +X^4; &  
V/bH^@,sA  
For j = 1 To PilarW * PilarH / 2 MsjnRX:c3u  
   mTop = mTop + MKpilar(j) >L[lV_M_>
 
Next j se,Z#H  
zilaP)5x6  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH j>!sN`dBj  
   mBot = mBot + MKpilar(j) \dV Too  
Next j ( u f5\}x  
\"d?=uFe  
mTop = mTop / PilarW / PilarH * 2 JEHK:1^  
mBot = mBot / PilarW / PilarH * 2 v*r9j8
 
ma]? )1<{  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 r~oSP^e'  
SE!L :  
'平均值极值化 n\= (S9  
  For j = 1 To PilarH * PilarW f z%tA39m  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) "{( [!  
  Next j [hU=mS8=^  
   Bp3 L>AcVu  
mTop = 0: mBot = 0 t _\MAK  
For j = 1 To PilarH * PilarW / 2 A,c'g}:  
  mTop = mTop + MKpilar(j) yWHne~!  
Next j #:{6b*}  
 :]c=pH  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW I:t^S.,  
  mBot = mBot + MKpilar(j)  >&hX&,hG  
Next j d@g2k> >  
RWikJ   
k/#>S*Ne  
  mTop = mTop / PilarH / PilarW * 3 Ae3,^  
  mBot = mBot / PilarH / PilarW * 3 ,!>fmU`E4  
   QS\ x{<e/  
!6E:5=L^  
If mBot > iWhite And mTop < iBlk Then l0`'5>
  
  CheckMark = True h7?.2Q&S  
Else }ywi"k4>  
  CheckMark = False fn1pa@P  
End If AZwa4n}"  
End Function ,so4Lb(vG  
HV\"T(89  
Sub Capture1Frame() ^saM$e^c:  
   okCaptureTo hBoard, BUFFER, 0, 1 'single rzV"Dm$'  
   okGetCaptureStatus hBoard, True CG9ba|  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize z%};X$V`J  
End Sub h{/ve`F>@  
F5IZ"Itu(  
}n95< {  
Sub CopyMark(iBlk As Integer, iWhite As Integer) Wk[)+\WQ?  
'复制标志区并返回标志区暗区与亮区的亮度平均值 q\H7&w  
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 _?b;0{93u  
   XS|mKuMcC  
'复制标志区 -N z}DW>  
For i = 1 To mkH l* Y[^'  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW mP!N<K  
Next i :t>Q:mX(N  
1Z:R,\+L  
For j = 1 To mkW * mkH / 2 an KuTI  
   mTotal = mTotal + MKpilar(j) m!Af LSlwm  
Next j yW>RRE;  
\)R-A '*U  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 ,?y7,nb  
mV zu~xym  
mTotal = 0 b *9-}g:  
For j = mkW * mkH / 2 + 1 To mkW * mkH $ !5f"<FCB  
   mTotal = mTotal + MKpilar(j) R3G@G  
Next j <E}N=J
'uJ  
(1 yGg==W.  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 C BlXC7_Mi  
P6we(I`"2  
'背景亮度 ~4^p}{  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW if@,vc  
  For i = 1 To 4 * FrameW J wFned#T  
    bsTotal = bsTotal + BsLine(i) <gcmsiB|  
  Next i stXda@y<p  
  bsAV = bsTotal / FrameW / 4 DMMLzS0A  
[&daG:  
End Sub .e$%[)D  
>zR14VO`_|  
iGa}3 pF  
Sub AdjIMGbright(Optional bInit As Boolean = True) UE7'B ?  
 XnA6/^  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） sVoR?peQ  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 %EoH4LzT  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 ]xrD<  
     hVZo"XUb  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer x@Vt[}e  
   %uuH^A  
  '按标准亮度与对比度采集一帧，确定背景亮度 #eLN1q&Z  
  currentContr = 128   '初始对比度 z8tl
0gd%D  
  currentBr = 128   '初始亮度 8uA<G /Q;  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 YFqZe6g0$  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 fq(5Lfe}  
  DoEvents 4:3_ER]J  
  Capture1Frame o^PuhVu  
  '获得图像上缘4行象素 8[HZ@@  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW k<Oy%+C  
  CopyMark iBlack, iBright   '图像标志区亮度 ue9h   
  For i = 1 To 4 * FrameW p1^
0{ILx  
    bsTotal = bsTotal + BsLine(i) yoW> BX  
  Next i qUg9$oh{LI  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 -<
d(  
   ^4UcTjh  
  Select Case bsAV ?cxr%`E  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 I>Y{>S  
       currentBr = 150 y.ql#eQ,  
       currentContr = 60 % $.vOFP9  
     Case 61 To 80   '有可见背景 f9F2U )  
       currentBr = 140 xgs@gw7!n0  
       currentContr = 70 uk6g s)qxC  
     Case 81 To 100  '有清晰背景 >Bx8IO1_\d  
       currentBr = 128 ~
me\  
       currentContr = 80 GBr,LN  
     Case 100 To 150  '有明亮背景 `Sx .|`x8  
       currentBr = 140                '5:30-6:00钟实测数据 l/F!Bq[*g  
       currentContr = 50 [`9^QEj  
     Case 151 To 180 H9E(\)@  
       currentBr = 130 +"Ub/[J{G1  
       currentContr = 60 kp; &cQu!  
     Case 181 To 220  '背景全为白色 `WlH*p)z9  
       currentBr = 110 cz>mhD  
       currentContr = 130 {? 2;0}3?;  
     Case 221 To 255  '背景全为白色 \!4|tBKVY  
       currentBr = 100 >KHp-|0pv  
       currentContr = 100 9m~t j_
  
  End Select 6Pijvx^0  
   GEfY^!F+  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 (HJ$lxk<2h  
        Case 100 To 150 q_pmwJ:UL  
          currentBr = currentBr - 10 ,`"K  
        Case 151 To 255 ifHU|0_=  
          currentBr = currentBr - 20 ]|y}\ 7Aa  
  End Select "ZqEP R)  
   )-#i8?y3C  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 a7=YG6[  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 QQq/5r4O`q  
End Sub e&ts\0  
0V7 _n  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) i*z0Jf["  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long Z>h{` X\2  
     +Y;8~+  
    For i = 1 To 8 L]*`4L  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& %y KKUZ~  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& S;h&5.p  
    Next i B6uRJcD4  
     [x|)}P7%s  
    For j = 1 To 1024 :fW.-^"VP  
      L1 = L1 + LeftBK(j, 0)
}v&K~!*  
      L2 = L2 + LeftBK(j, 1) Z:TFOnJ  
      R1 = R1 + RightBK(j, 0) Onyh1  
      R2 = R2 + RightBK(j, 1) 90(UgK&Y  
    Next j fOLnK y#  
    diffL = Abs(L1 - L2) / 1024 W W35&mI)k  
    diffR = Abs(R1 - R2) / 1024 =G*z 53  
End Sub g<a<{|  
K?JV ]^  
Function CheckSlice() As Boolean 6qf-Y!D5  
  CopySlice avSL, avSLR, avSLL ?ff [$ab  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then X7b!;%3@  
    CheckSlice = True \eT/%$  
  Else py.!%vIOQ  
    CheckSlice = False 1Df,a#,y"  
  End If _E(x2BS?  
End Function ;xI0\a7  
.=CH!{j  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) Y=|CPE%V  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long p$X
nOh  
  For i = 1 To FrameH _}^u-fJ/~  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize :U8k|,~f  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize 1[px`%DR~  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize CMFC"eSe  
  Next i YLE/w@*  
  For i = 1 To FrameH )Z&HuEg{ZR  
    For j = 1 To sSize Z) t{JHm:  
       total = total + Slice(j, i) {F/q{c~]  
       totalL = totalL + SliceL(j, i) e]Puv)S>{8  
       totalR = totalR + SliceR(j, i) xjE7DCmA  
    Next j -FaaFw:Z;A  
  Next i m' c#uU  
  avSL = total / FrameH / sSize *cPN\Iu.W  
  avSLR = totalR / FrameH / sSize ~\3l!zIq  
  avSLL = totalL / FrameH / sSize L@+Z)# V  
End Sub IBDVFA  
8,H~4Ce3  
Sub DrawSlice() )u-ns5  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B ys/vI/e\  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B 0a@c/XGBp  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B !;jgzi ?z  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) !L/t
LHk+  
End Sub 1S
&0  
Sub DrawMark(pic As Control) >I|<^$/  
   Dim i As Long, j As Long :Nkz,R?  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B sc9]sIb  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B B9AbKK$`  
   For i = 1 To PilarH i:{:xKiCa  
     For j = 1 To PilarW +~:x}QwGT  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) my]P_mE  
     Next j j+ I*Xw  
   Next i q{[1fE"[K4  
End Sub n~.%p  
d;<.;Od$`  
Function avIMG() As Integer >6w@{p2B  
  Dim i As Long, j As Long, totalIMG As Long y1nP F&_  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize m+p4Mc%u  
  For i = 1 To pFrameSize fH; |Rm  
    totalIMG = totalIMG + pBuffer(i) ; tm3B2  
  Next i GG*BN<(>!  
  avIMG = totalIMG / pFrameSize ~RAzFLt6x  
End Function Ls(&HOK[p  
"7:u0p!  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer :ET x*c  
  Dim i As Long, j As Long, totalIMG As Long qR_SQ VN  
  For i = 1 To FrameH k~& o  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth T:Bzz)2/  
  Next i " xlJs93c  
  For i = 1 To FrameH * barWidth {rz>^  
    totalIMG = totalIMG + pBuffer(i) [@x  
  Next i aE}=^%D  
  avRegion = totalIMG / pFrameSize G}Gb|sD Zq  
End Function v [dAywW  

一共这么多文件。 {`($Q$Q1  
{_rZRyr  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 'm  
第6车皮 ZD$-V3e`  

d 4b 9rtM  
+8L(pMI4  
第9车皮 z4 GN8:~x  
w:~nw;.T  
  

从这里里分离出来的。

Pn'QOVy  
DTX/3EN  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

下一次练手，也是VB，不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 l<0[ K(  
*IMF4x 5M  
这一次，我自己做了一个二进制的尺子，用CCD在一个盒子里读尺。

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ &vJ(P!2f<  
i
OX4Kl  

继续填个坑： tF;& x g  
)<]w23i  
用VBA控制WORD自己修订学生毕业文的格式。 zd6Qw-D7x