引用

引用第20楼newport93于06-14-2010 13:47发表的  : cQy2"vtU  
s>7}zU]  
老五，I 服了U。 [+T.at  
Y']\Jq{OS  
哪一天等俺退休了，也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 i&bA2p3+d  

{Aw#?#GPW  
+
hg3I8q:  
新港妹妹，虽然你还没有退休，但是孩子读了大学你应该有些时间了嘛！就开帖写吧！我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! vlmB`T  

引用

引用第3楼阿散于03-19-2010 22:49发表的  : :}'=`wa  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? } gyj0  

4;e5H_}Oo  
<wN}X#M  
阿散这个家伙，已经被我全局禁言了，但是在他不犯错的时候，也还是个很好玩的同学。

引用

引用第6楼沧桑于06-13-2010 14:39发表的  : |mxDjgq  
老伍在写交代材料啊，而且写在一个ZT的贴下，哈哈。 o
[Q MTP  

MU@UfB|;u  
T0wW<_jh  
这不是怕您见笑嘛！现在露馅了，只得继续招供了。 ]#)()6)2v  
W9 GxXPA  
可以从宽不？

引用

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

xK *b1CB  
I5k$H$  
其实标题没有什么，卡总既然改了就不必再改回了。 Sq>d t[7  
|s7s6k)mm  
主要是当初写的时候真是顶着锅盖写的。 s JB;3"~  
|HiE@  
阿散说得对。我就是把一堆鸡毛蒜皮的小事，用了一个big title.

引用

引用第16楼阿平于06-13-2010 22:25发表的  : (of#(I[
m7  
哦, 打倒忽悠大家的家伙.      qrb[ -|ie&  

6|gCu T4  
;@mS^ik")$  
阿平姐，这可不是忽悠，我可是认真交待经历呢！

引用

引用第17楼阿散于06-13-2010 22:29发表的  : ^ sOQi6pL  
每个人的故事对其他人都是故事, jte.Xy~g  
自己的故事也是其中之一. 0CWvYC%e  
跳出来看, E~DQ-z  
不过是众人中的一个人的故事. qSM|hHDo)  
C(eTR1  
所以,接着听故事. -"R2  
{AhthR%(1  
女人们有兴趣的就等老伍开个新帖或者跟贴, JYMiLph<  
听他痛说恋爱革命历史.... ;!>rnxB?4  
6]&OrS[  
杂家接着听他自学程序员历史, ny]?I
  
高级程序员考了吗? I&fozO   

evya7^,F  
OTvPUkp*
 
这个恋爱革命史还是等你痛改前非换个新ID来讲吧！ a
[>/h3  
nXaC3W:"  
我什么程度员也没有考过，连大学生的计算机应用等级证明都没有。 WltQ63u  
oTEL?hw5  
我唯一考过的计算机科目是职称评审时要求有证书，所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏，我都觉得对不起微软了。 \S"isz  

引用

引用第21楼阿散于06-14-2010 22:33发表的  : $|zX|  
引用第19楼伍胥之于06-14-2010 12:33发表的  : 
X@--m6-  
j:Xq1f6a  
fnpYT:%fG  
我平生唯一参加的计算机考试就是职称考试，任选4个模块。 kYM~d07 V  
.Hescg/S  
我连一级也没有考过。 `jDTzhO~  
. 272q1~&  

~G)S   

引用

%h hf
U6[  
矬子里拔将军... -zCH**y%1  
你们那里的俗语是吧? ;d@#XIS&-(  
Nya QI<5D  
我们这里说"矮子里拔长脚"..应该是同一个意思... ZFA`s qT  
<kfnpB=  
有趣....各地有表达意思一样却方式不同的俗语.... ]>W6 bTK  
N&.H|5  
/?wtF4  
你的文章写的有脸皮,没屁眼的, df*#!D7oz  
让看客大为不满... Yc`o5Q\>  
FXpJqlhNv  
你等着,,估计你以后接到的午夜凶铃就多了... cF\;_0u  

48J@CvU  
Ozw.siD  
我到现在也没有接到你的午夜凶铃呢！ 1;JEc9#h  

引用

引用第25楼猪小秘于01-20-2011 20:51发表的  : Ij 79~pn  
伍SIR，再次抱拳佩服 $6qh| >z.  

# nc Rb  
Lt2u,9  
小秘倒是好久不见了呢！宝贝几岁了？很健康活泼吧？

引用

引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : {WJm  
佩服，玩也玩得这么专业！ ?)/#+[xa  

M "ui0 ac  
;Y)w@ bNt@  
只是票友而已，算不上专业的。

引用

引用第46楼清水于03-03-2011 14:50发表的  : 0`Kj25  
,t3wp#E2#  
介个真的看不懂。 UJ%R   
你说你老啦，喜欢怀旧了，才想起来填坑。 9
/9j+5}+  
提醒我也想想，是不是也老啦，是不是也有坑没填呢。 m.hkbet/R  

OwuE~K7b{  
'-wj9OU  
你肯定有许多坑没有填，但是我挖的坑更多，但同是我也在你的某个坑里等你填埋呢！

//从指定扇区号dwSector开始，写dwLength长度的数据 rr/B=O7  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ _ "E$v&_  
DWORD dwCB; /{Is0+)  
LARGE_INTEGER  offset; P)"noG_'i  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); K ~uXO  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); qjc8fP2  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ {baq+  
DWORD error = GetLastError(); O3;u G.:1  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); Id*Ce2B  
return FALSE; y+Ra4G#/}  
} ht|z<XJ  
return TRUE; W=lyIb{?^0  
} }~2LW" 1'  

'VB 6.0 版 y>:N{|  
'这不是我写的，它更强悍了。因为可以直接读写物理扇区(CHS)，而不是逻辑扇区。 N%kt3vmQ_  
FSP+? ((  
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/X<  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long toLV4BtIG  
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 w2Us!<x  
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 t9nqu! );  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long :1^LsLr5  
'如果用绝对扇区写，那么文件的建立打开都不能用VB的 open 语句了。 :v0U|\j8/V  
H[m:0 eF'5  
uyO/55;HO  
Private Const GENERIC_READ = &H80000000 ,aOl_o -&  
Private Const GENERIC_WRITE = &H40000000 
czA5n  
YD<:,|H  
Private Const FILE_SHARE_READ = &H1 !]42^?GH  
Private Const FILE_SHARE_WRITE = &H2 9FoHD  
Private Const OPEN_EXISTING = 3 A8x
vo/n$  
r`=+L-!  
Private Const INVALID_HANDLE_VALUE = -1 B|Du@^$  
09|K>UC)v  
'//file seek \@Ts+7%  
Private Const FILE_BEGIN = 0 i3dkYevs?  
Private Const FILE_CURRENT = 1 _uWpJhCT  
Private Const FILE_END = 2 -] LY,M  
Wf u(*  
Private Const ERROR_SUCCESS = 0& 4hO!\5-w:  
*jLJcb*.Ap  
'//device io control 7jxs
lI&F  
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 gK_Ymq5>"M  
RW|`nL  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 0\H\lKcK  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 C7XxFh  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 yZ @"\Z!  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 wYdb*"R  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C \ 4&
fxe  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 ,ly\Ka?zO  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F kh!FR u h  
i=ea ?eT`  
'//type Z|%_&M  
Private Type LARGE_INTEGER 7z/|\D_{  
    lowpart As Long 8k2?
}/+  
    highpart As Long C'G /AU  
End Type 6RG)`bu  
>c1!p]&V  
Private Enum MEDIA_TYPE R"4Vtww  
    Unknown vV6<^W:9F  
    F5_1Pt2_512 8H;t_B   
    F3_1Pt44_512 4Fa~Aog  
    F3_2Pt88_512 &[_g6OL  
    F3_20Pt8_512 %!]@J[*1  
    F3_720_512 Hek *R?M|  
    F5_360_512 @V(*65b2  
    F5_320_512 grS:j+_M2m  
    F5_320_1024 ;i8g41qjF  
    F5_180_512 k\wW##=v  
    F5_160_512 A]<y:^2])C  
    RemovableMedia t!*?dr  
    FixedMedia ^({})T0wu  
End Enum ]-PH^H  
Z"Zmo>cV4  
Private Type DISK_GEOMETRY <S\jpB  
    Cylinders           As LARGE_INTEGER +:8fC$vVfC  
    MediaType           As MEDIA_TYPE E08klC0
 
    TracksPerCylinder   As Long "K ~  
    SectorsPerTrack     As Long [V^WGW2oY  
    BytesPerSector      As Long c*(bO3
b  
End Type g
=39C
>  
DD7h^-x  
'//private vars 5k!g%sZ  
Private hDisk           As Long             'disk handle lun#^J  
Private lpGeometry      As DISK_GEOMETRY    'disk info pSoiH<3
3  
Private lBufferSize     As Long             'the buffer size of read/write D~biKrg?=  
3?[dE<  
Public Function OpenDisk(ByVal FileName As String) As Boolean 83E7k]7]  
'// 打开磁盘 R tGWG*v4]  
    hDisk = CreateFile(FileName, _ #~#R-
 
                        GENERIC_READ Or GENERIC_WRITE, _ qUh2h z:  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ 
Diy8gt  
                        ByVal 0&, _ ztnFhJ<a$  
                        OPEN_EXISTING, _ MPCBT!o 4Z  
                        0, _ 2 K< 8  
                        0) B,<da1(a  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) nePfuG]Q  
End Function N<|@y mi  
F{Z~ R  
Public Function CloseDisk() As Boolean #eQJEajv5  
'//关闭磁盘 f) znTJL  
    CloseDisk = CloseHandle(hDisk) "*($cQ$v  
End Function VkvB<3  
YbR!+ 0\g  
Public Function GetDiskGeometry() As Boolean .+qQYDEw  
'//获取磁盘参数 U}&
2k  
    Dim dwOutBytes      As Long 
Hv!U|L  
    Dim bResult         As Boolean 7/!8e.M\  
     ks"|}9\%<  
    bResult = DeviceIoControl(hDisk, _ Z&#('Z  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ ,3?Q(=j  
                                ByVal 0&, 0, _ J3,fk)  
                                lpGeometry, Len(lpGeometry), _ !i{aMxUP  
                                dwOutBytes, _ .}&`TU  
                                ByVal 0&) } uO);k5H  
     Vc_'hz]Z  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack !5.8]v
 
    GetDiskGeometry = bResult MTsM]o  
End Function OSlvwH%(EE  
Y?S!8-z  
Public Sub GetDiskInfo(MediaType As Long, _ "k/;[ Wt]  
                        Cylinders As Long, _ `q?8A3A  
                        TracksPerCylinder As Long, _ j!_;1++q  
                        SectorsPerTrack As Long, _ H#NCi~M>3  
                        BytesPerSector As Long) &atu
K*W>  
'//返回磁盘的参数 <d,b'<z s  
    MediaType = lpGeometry.MediaType y6LWx:  
    Cylinders = lpGeometry.Cylinders.lowpart 0F]>Jby  
    TracksPerCylinder = lpGeometry.TracksPerCylinder !HrKXy0{  
    SectorsPerTrack = lpGeometry.SectorsPerTrack 'L 8n-TyL  
    BytesPerSector = lpGeometry.BytesPerSector lm!.W5-l  
mZk]l5Lc  
End Sub ? K;dp  
>CrA;\
l  
Public Property Get BufferSize() As Long d_CKP"TA  
'//返回每次读/写的缓冲大小 `)` n(B  
    BufferSize = lBufferSize <%($7VMev  
End Property p qfUW+>  
Y-pzy']4  
<Pap
skO>  
Public Function LockVolume() As Boolean ~kShq%  
'// 将卷锁定 ;hYS6  
    Dim dwOutBytes  As Long 
cU;iUf  
    Dim bResult     As Boolean Q
7   
     u2[iMd  
    bResult = DeviceIoControl(hDisk, _ >{N9kWY  
                                FSCTL_LOCK_VOLUME, _ U [S aY0Z  
                                ByVal 0&, 0, _ 6""G,"B  
                                ByVal 0&, 0, _ O/,aJCe  
                                dwOutBytes, _ cJN7bA{  
                                ByVal 0&) Ai:BEPKe  
    LockVolume = bResult &Nj3h(Ll  
End Function W=vG$  
DKne'3pH  
9bP^`\K[N  
Public Function UnlockVolume() As Boolean #i@;J]x(  
'// 将卷解锁 _]yn"p  
    Dim dwOutBytes As Long Id'X*U7Q  
    Dim bResult As Boolean PfreAEv,  
     Nd`%5%'::  
    bResult = DeviceIoControl(hDisk, _ F5?m6`g?  
                                FSCTL_UNLOCK_VOLUME, _ 1xD=ffM>8N  
                                ByVal 0&, 0, _ IAYR+c  
                                ByVal 0&, 0, _ cVubb}ou  
                                dwOutBytes, _ "^4_@ oo  
                                ByVal 0&) 3x5JFM  
    UnlockVolume = bResult G;&-\0>W  
End Function ?kWC}k{  
!+1<E*NQ S  
y&Mr=5:y  
Public Function DismountVolume() As Boolean 21 O'M  
'// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘 ZNf6;%oGG  
    Dim dwOutBytes As Long K&nE_.kbl  
    Dim bResult As Boolean KB%"bqB|  
     '>&^zg r  
    bResult = DeviceIoControl(hDisk, _ n1JRDw"e$$  
                                FSCTL_DISMOUNT_VOLUME, _ %`O
J.:k  
                                ByVal 0&, 0, _ M*z~gOZ  
                                ByVal 0&, 0, _ sp#p8@Cj  
                                dwOutBytes, _  `dFq:8v  
                                ByVal 0&) d\p, 2  
    DismountVolume = bResult >ZPsjQuf"  
End Function [pl'|B  
FuVnk~g
q  
i;NUAmx  
Public Function ReadDisk(ByVal Cylinders As Long, _ [<-
  
                    ByVal Tracks As Long, _ (&}i`}v_  
                    db() As Byte) As Boolean /`f^Y>4gD  
'//按柱面和磁道来读取磁盘数据 <0H"|:W>I]  
    Dim iPos    As Long !_`&Wks  
    Dim lRead   As Long 0ZBJ~W  
     2Or'c`|   
    iPos = Cylinders * Tracks * lBufferSize 8)O[Aq::  
     |zR8rqBX;  
    If SeekAbsolute(0, iPos) Then TT'[qfAI  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) {XNREjhm  
    End If >=RmGS  
End Function 3^R&:|,  
crqpV F]1]  
Public Function WriteDisk(ByVal Cylinders As Long, _ p<zSJLN  
                     ByVal Tracks As Long, _ :|_'f
Nd+!  
                     db() As Byte) As Boolean Y,WuBH  
'//按柱面和磁道来写磁盘数据 |(pRaiJ  
    Dim iPos    As Long >_o}  
    Dim lRead   As Long V^JV4 ` o  
     e<
=cdze  
    iPos = Cylinders * Tracks * lBufferSize U'8bdsF_  
     S'A> 2>  
    If SeekAbsolute(0, iPos) Then 7B
b9t  
        WriteDisk = WriteBytes(lBufferSize, db()) P/c&@_b  
    End If +s,Qmmb7)  
End Function Av"R[)  
Pf|siC^;s~  
 Jd%H2`  
'///////////////////////////////////////////////////////////////////////////////////// L!rw[x  
'//file system 'qjeXqGH$  
f #?fxUH~  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean VTG9$rQZ  
'//seek file LA@w:Fg  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte 94+KdHAo^M  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) ]F;
f`o  
    If LowPos = -1 Then <%maDM^_\(  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) Q7R~{5r>W  
    Else YQ39A_e g  
        SeekAbsolute = True f
J/e(t  
    End If ])L A42|  
     Db)?i?o}t  
End Function 
9A}# 6  
& @s!<9$W  
gUxP>hB  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean oX0D
 
'//read data to array b /@#}Gc  
    Dim RetVal    As Long dE:+k/  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) -M[$Zy^  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF IqC]!H0  
    ReadBytes = Not (RetVal = 0) y9_K, g  
     29!q!g|  
End Function b+@JY2dvj  
K@#(*."  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean wS4.8iJ  
'//write data from array CPP` qt%f  
    Dim RetVal As Long (@t(?Js  
    Dim BytesToWrite As Long <z]cy
Xv/  
    Dim BytesWritten As Long c/zJv*}x?  
     /wP@2ADB  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) aemc2b*  
     pcYG~pZ9  
    WriteBytes = Not (RetVal = 0) W.dt:_  
End Function 5#> 8MU?&  

这才是我当年写出的一个比较烂的程序 V#cqRE3XNi  
" Jt.lL ]5  
Main2.bas mMb'@  
O>^C4c!  
Attribute VB_Name = "SubMain" }"=AG  
Option Explicit QS{1CC9$  
*tgnYa[l  
'采集文件与临时文件 r9 ui|>U"  
Public Const TmpFile As String = "d:\30-0600.dat" Ys,{8Y,7  
'已有数据：30-0600.dat /30日早6点进车与6：30出车头 W6"v)Jc>_  
!R1.7}O  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long /RHo1  
Public hBCFile As Long  '记录采集参数的文件 qxFB%KqU  
Public Const TmpBMP As String = "d:\1.bmp" mH Ic f{RG  
Public hTmpFile As Long GG@md_  
O+?<h{"  
'[C.|)"  
'采集窗口参数常量 F'B8v3  
Public Const FrameH As Long = 280& UVw~8o9s  
Public Const FrameW As Long = 768& 7 Garnd b  
Public Const pFrameSize As Long = FrameW * FrameH 4F {)i  
:c q9f2)  
'标志区范围，用于识别车辆 Xb{ [c+.  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X `FYv3w2  
Public Const mkW As Integer = 28  '识别标志立柱宽度 >S'17D  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) |P -8HlOr  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) 5]HS^II"  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 4W3\P9p=  
'车缝检测位置常数 %kB8'a3  
Public Const sSize As Long = 32& @1DX  
Public Const sPos As Long = 310& ~v]!+`_J  
Public Const sPosL As Long = 200& 9[m6Li  
Public Const sPosR As Long = 500& y($%;l   
'车缝检测框位置 _Y
8hb!#(  
Public Slice(1 To sSize, 1 To FrameH) As Byte t?9v^vFR  
Public SliceL(1 To sSize, 1 To FrameH) As Byte gF[z fDm  
Public SliceR(1 To sSize, 1 To FrameH) As Byte O [i#9)  
Public avSL As Integer, avSLR As Integer, avSLL As Integer |4T!&[r  
FI3)i>CnW  
TiYnc3Bz}J  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析，比使用二维数组更便于VB编译优化 0%m)@ukb  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 &4b&X0pU  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 ai nG6Y<O`  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long <Wp QbQM  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte %n h
m  
'前后帧左右上角128列*8行像素块，根据平均值差绝对值判断进车方向 |lJX 3  
Bx/L<J@  
n@ U n  
_io+YzS  
'一次连续采集的帧数 4?-.ZUT-1  
Public tFrames As Long :{IO=^D=$  
xZ4~Oo@@_'  
'在采集卡申请的缓存中，是按帧为单位的，每一帧包含奇偶场两场的数据 1jc, Y.mP  
'而该卡的硬件设置是按场采集，只需要读第一场的数据即可。 ~$p2#Aq X  
'所以要设置的缓存帧的大小是frameW*frameH*2，而一场的数据量为pFrameSize P?t"jKp'  
"FTfk  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte B x (uRj  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte = !`j7#:  
Public pWorkSpace(1 To FrameW * FrameH) As Long SE),":aY  
Public Const pBufferSize As Long = FrameW * FrameH * 2 hir4ZO%Zt  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 |1b
_3?e  
'bo~%WA]n  
Public hBoard As Long   '采集卡标识 2I&o69x?  
Public mBufferAddr As Long  '缓存地址 T}"6wywM  
Public BufferSize As Long  '缓存大小(字节) SQqD:{#g"  
Public iCurrentCard As Long 9'{}!-(xR  
Public CapStatus As Long
PB#fP_0C  
Public iFrames As Long #B:hPZM1  
Public currentBr As Byte, currentContr As Byte 6x Z=^;H  
UN zlN  
Public hMEM As Long, mStatus As Long 91$]Qg,lB  
Public Const hMemSize As Long = pFrameSize * 4 %*&UJpbA  
Public hMemWork As Long :_t} QP"  
Public Const hMemWorkSize As Long = pFrameSize * 5 Sqo :-  
iK12pw  
i{ \%e  
df n9!h  
'串口接收轨道衡数据 #m[|2R  
Public WeightFromCom As String R,|d `)T  
Public bReceiveComplete As Boolean ;_^fk&+  
,4ei2`wV  
r8,romE$  
Public Type GrayBMPHeader Eh|]i;G%  
  Tag As Integer J41G&$j(  
  FileLength As Long    '文件大小 <o+<H  
  Reserve1 As Long |37 g ~  
  DataOffset As Long    '图像数据偏移量 GKoK7qH\J  
  BMPHeaderSize As Long  '文件头长 Nk
p)Ax&  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… P&b19K'  
                        'the following sizes are possible: !zPa_`P  
                        '28h - windows 3.1x, 95, nt, … I_xXDr  
                        '0ch - os/2 1.x zxf"87
se  
                        'f0h - os/2 2.x |\U5),m  
=k/IaFg 6w  
  ImageWidth As Long           '图像宽（像素数） VY)9|JJCO  
  ImageHeight As Long          '图像高(像素数) DqX{'jj  
  PlaneNumber As Integer  '图像层数 RTv qls  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap s1e:v+B]  
                                        '4 - 16 color bitmap ^_
kJKM,  
                                        '8 - 256 color bitmap # g_Bx  
                                        '16 - 16bit (high color) bitmap nzmDA6d  
                                        '24 - 24bit (true color) bitmap "dI;  
                                        '32 - 32bit (true color) bitmap <<i3r|
}  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) nv0]05.4  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) PSPmO'C+  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) aBNZdX]vzO  
                                    '3 - bitfields (also identified by bi_bitfields) '3<fsK=  
  IMAGESIZE As Long  '图像数据字节数 `&-
Mi[1  
  hResolution  As Long  '水平分辩率  像素数/米 FI
bp"~  
  vResolution  As Long  '垂直分辩率 5!EJxP9  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 3"G>>nC&  
  ImportantColors As Long s%2v3eb  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 [+OnV&  
End Type e0J6Ae4V[  
*&d<yJM`b  
=e8bNg  
jK' N((Hz  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader %/YcL6o(  
Public sRECT As RECT vq!_^F<  
Ur5FC r  
6$ Gep  
Public conn As ADODB.Connection Op>%?W8/UF  
Public rsTrain As ADODB.Recordset 1.gG^$Jd  
Public rsOperater As ADODB.Recordset 1 }tbH[  
Public rsGoods As ADODB.Recordset ?}m']4p  
Public rsGood2 As ADODB.Recordset qA!]E^0*Ke  
Public rsSender As ADODB.Recordset <0S,Q+&  
Public rsReceover As ADODB.Recordset jq+A-T}@  
Public rsTrainTMP As ADODB.Recordset MW PvR|Q  
1!.(4gV  
lhtZaU~V  
'打开采集卡 F35#dIs`&  
'设置参数 +e-G,%>9  
'设置为实时单帧采集到缓存方式 (sQr X{~  
'由另一线程查询采集状态，如果完成采集，传送至用户数组分析或保存 ZeEWp3vW  
%zSuK8kxV  
"h|'}7p  
Sub Main() 8 O67  
  Dim i As Integer, status As Long OX"j#  
     _z54Ycr4H  
   InitBMPinfo UQ[B?jc  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 J]q%gcM  
    BMPHeader.Tag = &H4D42 i| ZceX/  
    BMPHeader.ImageWidth = FrameW z8[yt282  
    BMPHeader.ImageHeight = FrameH r" K':O6y  
    BMPHeader.BMPHeaderSize = &H28 #vzEu
)Ul  
    BMPHeader.PlaneNumber = 1 ;>AL`M+  
    BMPHeader.bpp = 8 g7&9"  
    BMPHeader.Compression = 0 n_ B"-n  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 YS
j+\Z$(  
    BMPHeader.vResolution = &H1274 HgBGV0  
    BMPHeader.ColorsinBMP = 256
}sx_Yj  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP .58qL-iC  
    BMPHeader.DataOffset = Len(BMPHeader) BSkDpr1C
 
    For i = 0 To 255 VwEb7v,^0\  
      BMPHeader.Pallate(i) = RGB(i, i, i) m\ddp_l  
    Next i M4d47<'*~  
    BMPHeader.IMAGESIZE = FrameH * FrameW x ul]m*Z  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE |gsE2vV  
U-:ieao@  
=&},;VOh  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) MNg^]tpf  
     4T?h  
    BMP1.ImageWidth = FrameW qY>{cjo  
    BMP1.ImageHeight = FrameH * 2 b
O&7-Z~:=  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight |=EZ1<KzD  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE eYC^4g%l(  
H<QT3RF2  
  '确定标志位置,为pilarX, pilarY确定初始值 zLF?P3^  
   PilarW = mkW h(F<h_  
   PilarH = mkH  '此两项为固定值 MSV2ip3  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) 8@PX7!9  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 QMsHC%l3b  
   =+x yI  
   (%U@3._  
  '连续采集记录文件 AQc,>{Lm  
  ' 建立一个缓冲区为页对齐方式的文件 .cR -V`  
  If Dir(TmpFile) <> "" Then 6:]*c[7  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ UThB7(O,  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) jZ% TJ0(H  
    ' 在95/98中，如果打开文件时没有声明overlapped方式，在读定文件时就不能使用overlapped参数项 YFTjPBV  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 5l,ZoB
8  
  Else e#B#B  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ Nr0 (E   
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ]q6;#EUr?  
  End If sg8/#_S1i  
  If hFile = 0 Then HF qm6|  
    MsgBox TmpFile & ": File Open Error", vbOKOnly doB  
    Exit Sub )LdyC`S\c  
  End If meCC?YAB  
  '采集参数记录文件 /l{&iLz[  
hBCFile = FreeFile() Z(ZiFPx2Z  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile (?H0+zws^  
   3  E3qd'  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 VOr1  
If hMEM = 0 Then YOrrkbJ(  
    fStatus = GetLastError 3( ]M{4j  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ (D 9Su^:1  
     & "请向技术人员报告该错误代码。", vbOKOnly de]zT^&C  
    CloseHandle hFile OKHX)"j\\  
    Exit Sub YhRWz=l  
End If {<5ybbhLV  
P1zdK0TM  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) HBY.DCN [Z  
If hMemWork = 0 Then 4pln5v=  
    fStatus = GetLastError <BW[1h1k5_  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ i@][rdhT  
     & "请向技术人员报告该错误代码。", vbOKOnly ;P;((2_X9  
     '释放已成功分配的内存 u-1;'a  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) m] W5+  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) 8v7
1e>  
     2>\v*adG  
    CloseHandle hFile JMCW}bA  
    Exit Sub fi+R2p~vs  
End If XK"
-'  
fl;s9:<  
' Test writing ?X-)J=XG  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& [lk'xzE  
     5'Q|EIL  
   '初始化采集卡参数 @A+RVg*=  
   iCurrentCard = -1 -!)xQvagD.  
   hBoard = okOpenBoard(iCurrentCard) fRfn2jA)d  
   Debug.Print hBoard TyKWy0x-3  
   If hBoard = 0 Then l?iSxqdT  
      ExitGrabber c,Euv>*`  
      End cv(PP-'\  
   End If :iiw3#]  
   okGetBufferSize hBoard, mBufferAddr, BufferSize ;r/;m\V  
   If mBufferAddr = 0 Then 5~
.ZlGd  
     MsgBox "缓存不存在！" H K~xOAF  
     ExitGrabber r|*&GHo L  
   End If U#n#7G6fRp  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) @ a4/ELx  
   jAh2N3)  
   QaGlR`Y  
   currentBr = 128: currentContr = 128 2..,Sk  
   '设置视频输入参数 $HG}[XD?  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 4G@nZn  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input ?go:e#  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 ?DH"V7bs  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 hb/]8mR  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 cD4 kC>P*  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 f""`cdqAOh  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行（低字）同步开槽（高字） v?c 0[+?  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移，低字X偏移 (144/44经验值) zyg:nKQW  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小：低字X高字Y (768/576采集卡最大值)
`+#G+Vu5  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 {ls+dx/  
   f,z P*  
   '设置采集参数 a,Gx
m!  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 W[[bV  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 JxjI]SF02  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 4 V1bLm  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 dDDGM:]  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 xvNo(>  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 @R m-CWa  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 hfcIvs/!  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 \*\R1_+  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 `p'Q7m2y/b  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 h8G5GRD  
   'Buffer Block Size不用设置，而用okSetTargetRect函数进行动态调节 1shBY@mlq  
   XM<KF&pVB  
   ^>?CMcN4*  
   okCloseBoard hBoard \ j.x0/;  
   Sleep 50 __@zTSVb  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 ?%O3Oi Xz  
   .d?%;2*{q  
   '设置数据传送方式 =H8 xSJLh  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 _al|'obomy  
   '该设置对本程序无意义，因为程序直接用CopyMemory方法读缓存，而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 f(D_FTTO  
   b.O9I TR  
   sRECT.Right = -1   '用于获得当前设置值 pr,p=4m{\  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) IZ3{>NV  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 81%8{yn!$"  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 lZ&]|*>  
   sRECT.Left = 0 h7X_S4p/Mg  
   sRECT.Top = 0 &ff&Y.q~  
   sRECT.Right = sRECT.Left + FrameW 0e[d=)XG  
   sRECT.Bottom = sRECT.Top + FrameH * 2 N4K8 u'f^  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ^2odr \  
   FA90`VOWYU  
   sRECT.Right = -1   '检查新设置值 PS S?|V k  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) idRD![!UI  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom q@hp.(V  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) Gq#~vr  
   j%V["?)  
   If TESTSignal = False Then !'=15&5@  
      'ExitGrabber U6[ang'l  
   End If 8wH.et25k  
   mfny4R
1_  
   Zs2-u^3&  
   ?8,%
LIQ?  
   '设为实时采集状态 i{^Z1;Yl  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) %g]vxm5?  
   < P%}|@  
   h5kPn~  
   '单帧采集 >%Ee#m  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 qEUT90  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&)
QFPfIb/  
   okCaptureTo hBoard, BUFFER, 0, 1 'single }]UB;id'  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 QMo}W{D  
   '   Sleep 20 GO! uwo:  
   'Loop U"f??y%)  
   okGetCaptureStatus hBoard, True X~Rl 6/,  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize W YW|P2*  
   '写入768*576测试图象 mqfO4"lt  
   ArrayToBMP TmpBMP HftxS  
   x\s,= n3z  
   '打开数据库 $[@0^IJq=K  
   Set conn = New ADODB.Connection ?@6/Alk  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ I1U7.CT  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ~^)^q 8  
      "; Mode=Read|Write" iv(5&'[p  
   conn.Open Q6C-4ja  
   wzjU,Mwe  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) ZiFooA  
   frmRecord.Visible = True W2-=U@  
   frmQuery.Visible = True ]+DI.%   
   Load frmReceiveFromComm 'rb'7=z5  
    \4ghYQ:  
   '调试参数 O)R(==P26P  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then 2h {q h  
     SignalBox.Visible = True iP3Z  
   End If B6}FIg)  
   If InStr(UCase(Command()), "/COMM") > 0 Then 9^F2$+T[:  
     frmReceiveFromComm.Visible = True  6qo^2  
   End If <uP
^-bv;(  
2WvN2"f3  
End Sub DZ ^1s~  
]J2:1
94  
Sub ExitGrabber() rAQF9O[  
  '关闭数据库 HjWq[[Nz  
  '关闭采集卡 W&"|}Pi/  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) EA<}[4#jS  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) t j Vh^
 
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) IB9%QW"0  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) ]7AX%EG3  
  okStopCapture hBoard Z<b"`ty.  
  okCloseBoard hBoard P5QQpY{<I  
  CloseHandle hFile }iBC@`mg(  
  Close #hBCFile G&eP5'B4i  
  conn.Close Cup@TET35  
  End % 0:p)Z0  
End Sub $trAC@3O@  
tGcya0R
L  
Function ArrayToBMP(ByVal File As String) -m 5}#P89  
Dim BytesWrite As Long w-N1.^  
]r]k-GZ$  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _
;P?q2jI  
  CREATE_ALWAYS, 0&, 0&) Lp:6 ;  
2_QN&o ~h  
If hTmpFile = 0 Then 0m9ZQ O  
   ArrayToBMP = False m:Go-tk  
   Exit Function h7_)%U<J2  
End If '_+9y5  
X7*`  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ts9pM~_~  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& 24\gb v<  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN J?:[$C5  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& P}3}ek1Ax  
O,V9R rG  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN YJ7V`Np  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& 1D([@)^  
o5Rz%k#h  
If BytesWrite < pFrameSize Then ZC ^C  
  ArrayToBMP = False ^%oUmwP<$  
End If 3mt%!}S  
HO|-@yOF^  
CloseHandle hTmpFile 8_\W/I!7b  
)E7 FA|  
End Function I12KT~z<r  
K=u0nrG*  
Function ArrayToBMP1(ByVal File As String) ZX`J8lZP  
%NHYW\sKX  
Dim BytesWrite As Long 1ywU@].6J]  
yfjXqn[Z4  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ u~ F;xQ  
  CREATE_ALWAYS, 0&, 0&) r@)A k  
w5~i^x  
If hTmpFile = 0 Then q<=: >?  
   ArrayToBMP1 = False ? S=W&  
   Exit Function R -e
lIp  
End If D>T],3U(H  
i&+w _hD  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ySN
V^+  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& GSVdb/+  
_94s(~g:  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN rE!1wc>L  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& {M~lbU  
*8g<R  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN sJr5t?  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& 2C+(":=}  
s'a=_cN  
If BytesWrite < pBufferSize Then ^Ip3A  
  ArrayToBMP1 = False R 4EEelSZu  
End If 3-wD^4)O,  
1|y$~R.H  
CloseHandle hTmpFile GaNq2G  
d}0qJoH4  
End Function ?H;{~n?  
f_r0})  
'使用该过程建立的文件要求在用后关闭 W5DbFSgB  
Public Function ArrayToBMP2(File As String) As Boolean T.?k>Ak  
u"VS* hSH  
Dim BytesWrite As Long ]= x 1`j  
- HOnB=  
ArrayToBMP2 = True Aa(<L$e!`  
Bmr<O!  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ |D G@ht  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) +GNWF% zN  
0~E 6QhV:  
If hTmpFile = 0 Then )q? $
p9  
   ArrayToBMP2 = False '?/
&n8J\  
   Exit Function ]YD(`42x  
End If -]"T^wib  
jD<pIHau  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN nTnRGf\T  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& ~5#)N{GbY  
j64 4V|z  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN 9fVj 8G  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& M?:\9DDd  
}~enEZ  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN w^VSj%XH!  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& Q^h5">P  
Xza
4iV  
If BytesWrite < pFrameSize Then #+sF`qR,  
  ArrayToBMP2 = False XdIah<F2  
End If )@PnTpL*  
mc@M,2@D  
CloseHandle hTmpFile mA{#]Yvf1  
!QC<n/  
End Function iK}v`xq  
a>Re^GT+z  
Private Function TESTSignal() As Boolean 3B18dv,V  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long z&'f/w8  
2>y:N.  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) wa3F  
Z$2L~j"=!  
If extsign = 1 Then F,Fo}YQX  
   TESTSignal = True nmE5]Pcg  
Else 6&!l'[hU  
    If extsign = 0 Then :k"rhI  
        MsgBox "无视频输入信号，检查摄像机电源！", vbOKOnly ,w\ wQn>]K  
        TESTSignal = False [ #]jC[  
        Exit Function 03E3cp"  
    End If L DX
*<(  
End If Kmry=`=A  
1MQ/r*(  
'测试视频输入类型 #vnT&FN0[  
'video type )bW<8f2  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 1$[
"79k  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) ^e9aD9  
If videotype = 1 Then (wL3 +  
        '"隔行信号(Interlaced)" 5d 5t9+t  
Else Ee?;i<u  
   If videotype = 0 Then i-13~Dk  
       '"逐行信号(Non-interlaced)" a&5g!;.  
   Else zHFTCL>"  
     If videotype = -1 Then ^87
42.  
       ' "不支持" h(:<(o@<  
     End If $pu3Ig$^  
   End If (Pz8iz  
End If D!l8l49hLu  
i,OKfXp  
'测试垂直扫描线数 STT2o=  
'video scanlines *wUdC   
scanlines = -1 kEAhTh&g*  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) 1i,4".h?M  
    If scanlines = -1 Then q+/l"&j.  
        ' "不支持" 3q~Fl=|.
o  
    Else 6F5,3&  
        'Trim(Str(ScanLines)) + " 行数/幅" jU$Y>S>l  
    End If KS! iL=i  
NNX%Bq  
'测试帧频 AVpuM Nd@  
'video field frequency ER<eX4oU  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) -Cj_B\  
    If fieldfrq = -1 Then ,C!n}+27  
        'lblSignal(8) = "不支持" 46ChMTt  
    Else |3@=CE7G  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" 0eA5zFU7  
    End If ec'tFL #u{  
End Function .~<]HAwq  
=J.EH|  
ZlM_m >,o  
Sub PicIdentify() UX}*X`{  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 _7 `E[&v  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 Jr ?!Mh-  
'判定标准：如果在立柱位置上有明显的模式反差，则视为车皮之间的间隔 7 \/u&  
'方法：对立柱标志区进行平均值二值化，面积为32*40，亮区（255）与暗区（0）的亮度平均值理论差大于200倍，实际差值应不小于100倍 zz3 r<?#5  
i<:p.ug-O  
  Dim fPTR As Long, cFrame As Long qc-C>Ra  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer Ao*FcrXN  
     Y\8+}g;KR  
x(6vh2#vD  
cFrame = 0 C"No5r'K3  
/+P5)q TKL  
<JH9StGGc?  
Do While cFrame < tFrames @zs1>\J7  
   V_M@g;<o  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) 4<yK7x  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) E4m:1=Nd~]  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 44Qk;8*  
   %gTVW!q  
  frmRecord.RText.Text = Str(cFrame) +E#PJ_H=F8  
  frmRecord.RText.Refresh QZ0R:TY  
       Ld~4nc$H8  
  If CheckMark = True Then K{FhT9R'  
   ArrayToBMP TmpBMP 62NkU)u  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) kk
nhthJ  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" >Fh#DmQ  
   >nNl^ yqW  
   DrawSlice |UZOAGiBg  
   ~h|m&XK+Q  
   'i = MsgBox("检测到立柱：第" & Str(cFrame) & "帧", vbYesNo) =+( Q.LmhC  
   'If i = vbNo Then Xoi9d1fO  
   '  Exit Do
XW:%vJu^`  
   'End If y*|L:!   
   'cFrame = cFrame + 1 Qg{WMlyOP  
   \)GR\~z0h  
  End If jNqVdP]d\  
  DoEvents {9{J^
@@  
  cFrame = cFrame + 1 #fzw WP  
Loop dqwWfn1lt  
End Sub g 2#F _  
[iXi\Ex  
yjv&4pIc1  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean %(NN*o9"q  
<|Iyt[s  
'如标志区模式反差存在则为TRUE，否则返回FALSE m9b(3  
TPqvp|~2  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long ,Z4^'1{D  
CheckMark = True D?J#u;h~f  
   r$?Vx_f`Q  
'复制标志区 !3?~#e{_  
For i = 1 To mkH N4+g("  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW ;r=?BbND?  
Next i *s36OF!  
UhA_1A'B  
For j = 1 To PilarW * PilarH / 2 yjR)Z9t  
   mTop = mTop + MKpilar(j) S]b xQa+  
Next j . ]zw*t*  
%OFj  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH H\f/n`@,G  
   mBot = mBot + MKpilar(j) $$~a=q,P[  
Next j H CuK  
h;}ODK(.
 
mTop = mTop / PilarW / PilarH * 2 &$Ci}{{n
#  
mBot = mBot / PilarW / PilarH * 2 ywe5tU  
.hgH9$\  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 7A[Ogro  
5"e+& zU~f  
'平均值极值化 "<T ~jk"u  
  For j = 1 To PilarH * PilarW ` Rsl]
GB  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) QP<FCmt8  
  Next j F b2 p(.  
   k?n]ZNlT  
mTop = 0: mBot = 0 ip674'bq7R  
For j = 1 To PilarH * PilarW / 2 q@w"yz>  
  mTop = mTop + MKpilar(j) VB's  
Next j J2=*-O:  
i)8gCDc  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW ( w5f(4  
  mBot = mBot + MKpilar(j) A{t"M-<  
Next j d{l{P]nr  
;6zPiaDQ  
5d(qtFH1  
  mTop = mTop / PilarH / PilarW * 3 W\a!Q]pV  
  mBot = mBot / PilarH / PilarW * 3 A _]D~HH  
   79a9L{gso  
YkVRl [  
If mBot > iWhite And mTop < iBlk Then g X8**g'  
  CheckMark = True p*!q}%U  
Else vQcUaPm\$  
  CheckMark = False ,=x RoXYB}  
End If ,.q8Xf  
End Function b+_hI)T  
lnjL7x  
Sub Capture1Frame() m"q/,}DR  
   okCaptureTo hBoard, BUFFER, 0, 1 'single :=Nb=&lst  
   okGetCaptureStatus hBoard, True Bjtj{B  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize
CCn/ udp@  
End Sub a6P !Wzb  
/xF 9:r  
b<8q 92F  
Sub CopyMark(iBlk As Integer, iWhite As Integer) }*Dd/'2+1  
'复制标志区并返回标志区暗区与亮区的亮度平均值 0+p 5/5  
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 >waN; &>/  
   n'Bmz  
'复制标志区 9G+y.^/6  
For i = 1 To mkH .h a`)@MsZ  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW m.Twgin  
Next i Slo9#26  
^YqbjL  
For j = 1 To mkW * mkH / 2 u5/t2}^T  
   mTotal = mTotal + MKpilar(j) 4^`PiRGt  
Next j <qr^Nyo4  
H[Cj7{V  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 v/ eB ,p  
#[Z<=i~C  
mTotal = 0 :K:f^o]s  
For j = mkW * mkH / 2 + 1 To mkW * mkH RpULm1b  
   mTotal = mTotal + MKpilar(j) -S7RRh'p  
Next j a&8l[xe1  
DYkC'+TEX  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 cJ2y)`  
([1=>Jw"  
'背景亮度 y3Y2QC(  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW QW,cn7  
  For i = 1 To 4 * FrameW i{P%{hVb  
    bsTotal = bsTotal + BsLine(i) _J` |<}?t;  
  Next i cu:-MpE  
  bsAV = bsTotal / FrameW / 4 +fPNen4E  
e7h\(`J0lj  
End Sub y>%W;r)  
 w}"!l G  
]u~Os<  
Sub AdjIMGbright(Optional bInit As Boolean = True) |iAEDZn  
|c=d;+  
  '自动调节亮度与对比度,此时处于无车辆状态（白天特别高，而夜间特别暗） e{:86C!d)  
  '图像平均亮度白天不高于200（当车辆通过时可能会下降到100左右）,不低于100 rAL1TU(vm  
  '            夜间不高于80（过高时通常是由于雪花噪声引起）,但立柱不低于30 (e0_RQ  
      &Q<EfB  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer 4S qvhz  
   sK#H4y+<  
  '按标准亮度与对比度采集一帧，确定背景亮度 f8R+7Ykx  
  currentContr = 128   '初始对比度 zv`zsqDJ  
  currentBr = 128   '初始亮度 >Sh0d
FqeT  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 9A(n_Rs7?  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 wXP_]-  
  DoEvents {a[&#Uv  
  Capture1Frame o}d2N/T  
  '获得图像上缘4行象素 k"0%' Y  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW d8D yv#gT  
  CopyMark iBlack, iBright   '图像标志区亮度 M\9IlV?'  
  For i = 1 To 4 * FrameW @h !U  
    bsTotal = bsTotal + BsLine(i) 8u/3?Kc  
  Next i MkkA{p  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 s87 a%  
   #&}%70R)  
  Select Case bsAV rA[nUJ,  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 gYRq
qV  
       currentBr = 150 Io2,% !D  
       currentContr = 60 =z+-l5Gu"  
     Case 61 To 80   '有可见背景 m9%yR"g9  
       currentBr = 140 )_X;9%L7  
       currentContr = 70 bJANZn|H  
     Case 81 To 100  '有清晰背景 vY4WQbz(  
       currentBr = 128 Zp^)_ 0  
       currentContr = 80 8f|9W%jt  
     Case 100 To 150  '有明亮背景 Q3(hK<Qh;  
       currentBr = 140                '5:30-6:00钟实测数据 /7.w
QeL9  
       currentContr = 50 +}&pVe\t  
     Case 151 To 180 :fl*w"
"V@  
       currentBr = 130 #)Ep(2  
       currentContr = 60 m=#aHF  
     Case 181 To 220  '背景全为白色 hT\p)w  
       currentBr = 110 RA!x  
       currentContr = 130 ZDW,7b%U  
     Case 221 To 255  '背景全为白色 ~WzMK  
       currentBr = 100 D`1I;Tb#  
       currentContr = 100 }<E sS  
  End Select 3O#~dFnp  
   zUe#Wp[  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 =" /R5fp  
        Case 100 To 150 aeLBaS  
          currentBr = currentBr - 10 Rd`{qW  
        Case 151 To 255 "r:H5) !  
          currentBr = currentBr - 20 [^h/(a`  
  End Select Dm&lSWW`/  
   MacL3f  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 qxRT1B]{Wx  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 f S(^["*G  
End Sub MoZU(j  
yjeq
v-7  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) YCtIeq%  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long U&w*Sb"  
     J11dqj  
    For i = 1 To 8 .%|OGl ?  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& niXHK$@5  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& `'dX /d  
    Next i ^H f+du  
     L~'^ W/N  
    For j = 1 To 1024 B.{8/.4  
      L1 = L1 + LeftBK(j, 0) Sr4dY`V*:z  
      L2 = L2 + LeftBK(j, 1) T^rz!k{  
      R1 = R1 + RightBK(j, 0) rOs)B21/  
      R2 = R2 + RightBK(j, 1) R~U2/6V  
    Next j ?IL! X-xx  
    diffL = Abs(L1 - L2) / 1024 B.h0" vJ  
    diffR = Abs(R1 - R2) / 1024 &z7N\n  
End Sub n%7A;l!{  
@hE7r-}]  
Function CheckSlice() As Boolean 9OE_?R0c!  
  CopySlice avSL, avSLR, avSLL \Mobq  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then E!:.G+SEl  
    CheckSlice = True L& +% Wd~  
  Else aa%Yk"V@  
    CheckSlice = False I|Vk.,  
  End If AaJ,=eQ  
End Function qpluk!  
at_dmU2[7  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer)  iuvtj]/  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long s?4%<jz  
  For i = 1 To FrameH 9{auleu R  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize }Z~pfm_S  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize J
R8 Z6  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize =e"H1^Ml  
  Next i I8E\'`:<  
  For i = 1 To FrameH X; e` y:9  
    For j = 1 To sSize CD XB&%Sr  
       total = total + Slice(j, i) .Y=Z!Q  
       totalL = totalL + SliceL(j, i) KfJ c  
       totalR = totalR + SliceR(j, i) V
2WUM+`uT  
    Next j ]L5Z=.z&  
  Next i ctnAVm  
  avSL = total / FrameH / sSize ; |
E! |w  
  avSLR = totalR / FrameH / sSize >FK)p   
  avSLL = totalL / FrameH / sSize :< KSf#O  
End Sub wFKu
Sd  
w*|=k~z  
Sub DrawSlice() ]w1BJZa36  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B Requ.?!fG;  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B n_e}
>1_  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B V\e13cL]  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) eH"qI2 A  
End Sub @vVRF Z  
Sub DrawMark(pic As Control) d;@E~~o?B]  
   Dim i As Long, j As Long 'fp<FeTg  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B e<ism?WG  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B C*Y :w  
   For i = 1 To PilarH  eLe,=  
     For j = 1 To PilarW O=4ceEmz  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) r"HbrQn  
     Next j e<: 4czh8  
   Next i ]
%vGC^  
End Sub G}Qk!r  
')Dp%"\?  
Function avIMG() As Integer uIVTs9\  
  Dim i As Long, j As Long, totalIMG As Long =R"Eb1  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize +35)=Uov  
  For i = 1 To pFrameSize .3S\Rrv  
    totalIMG = totalIMG + pBuffer(i) b |o`Q7Hj  
  Next i 1{;[q3a  
  avIMG = totalIMG / pFrameSize E@\d<c.  
End Function % zIl_/s  
ifgr<QlG  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer //`cwnjp  
  Dim i As Long, j As Long, totalIMG As Long y \mut m  
  For i = 1 To FrameH EU?&  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth f4A4  
  Next i s$2l"|h>B  
  For i = 1 To FrameH * barWidth `\WcF7  
    totalIMG = totalIMG + pBuffer(i) qr<-eJf  
  Next i lE VQA*u[  
  avRegion = totalIMG / pFrameSize 4{Yy05PFS  
End Function dA_V:HP  

一共这么多文件。 E9Qd>o  
yP1Y3Tga=  
这是我用VB写出的最大的程序，也是用API最多的。

拍下的火车 6Mf3)o2  
第6车皮 + 8K1]'t$  

Gn2 bZ%l  
fW4cHB9|  
第9车皮 a2klOX{  
_L `N^I.  
  

从这里里分离出来的。

6E\\`FE4y  
u8k{N  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田

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

继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ？ a+>W  
1f pS"_}  

继续填个坑： iP?
ASqo{  
Dy{`">a  
用VBA控制WORD自己修订学生毕业文的格式。 b-(UsY: