登录注册
社区应用 最新帖子 精华区 社区服务 会员列表 统计排行
主题 : [ZT]我和电脑亲密接触的心路历程
伍胥之 离线
级别: 军区司令员

显示用户信息 
80楼  发表于: 2015-09-05   
引用
引用第20楼newport93于06-14-2010 13:47发表的  : 'fA D Dh}  
JNp`@`0V  
老五,I 服了U。 gy =`cMS@  
PYHm6'5BtB  
哪一天等俺退休了,也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 [ !R%yD;  
M<$l&%<`G  
NuO>zAu  
新港妹妹,虽然你还没有退休,但是孩子读了大学你应该有些时间了嘛!就开帖写吧!我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! ,t+ATaOF  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
81楼  发表于: 2015-09-05   
引用
引用第3楼阿散于03-19-2010 22:49发表的  : Wq9s[)F"Z  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? G>RYQ{O  
Lv^j l  
mW-@-5Wda  
阿散这个家伙,已经被我全局禁言了,但是在他不犯错的时候,也还是个很好玩的同学。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
82楼  发表于: 2015-09-05   
引用
引用第6楼沧桑于06-13-2010 14:39发表的  : OXacI~C  
老伍在写交代材料啊,而且写在一个ZT的贴下,哈哈。 j>b OnCp~  
Q]7Q  
]s -6GT  
这不是怕您见笑嘛!现在露馅了,只得继续招供了。 aBI ]' D;  
3 #wj-  
可以从宽不?
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
83楼  发表于: 2015-09-05   
引用
引用第10楼卡拉于06-13-2010 21:49发表的  : 0l=}v%D  
老伍,对不住,我把你原来的英文标题改了,太不吸引人眼球了,有些人还当是英文的都不会去点击。我通篇读了一下,改成了现在的标题。如果你不喜欢,可以改回来。 EC~t 'v  
mCGcM^21-x  
m%V[&"5%e  
其实标题没有什么,卡总既然改了就不必再改回了。 vRq xZN  
0|ps),  
主要是当初写的时候真是顶着锅盖写的。 %yMzgk[u  
}m H>lN  
阿散说得对。我就是把一堆鸡毛蒜皮的小事,用了一个big title.
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
84楼  发表于: 2015-09-05   
引用
引用第16楼阿平于06-13-2010 22:25发表的  : Sqf.#}u<=  
哦, 打倒忽悠大家的家伙.      !>y}Xq{bm3  
IKDjatn  
)m8>w6"  
阿平姐,这可不是忽悠,我可是认真交待经历呢!
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
85楼  发表于: 2015-09-05   
引用
引用第17楼阿散于06-13-2010 22:29发表的  : 'eDgeWt/CQ  
每个人的故事对其他人都是故事, `$Flgp0P  
自己的故事也是其中之一. D 2:a  
跳出来看, WFB|lNf&  
不过是众人中的一个人的故事. pt%~,M _  
Cn;H@!8<s  
所以,接着听故事. q4GW=@eD  
_@pf1d$  
女人们有兴趣的就等老伍开个新帖或者跟贴, @GZa:(  
听他痛说恋爱革命历史.... ilp;@O6  
&@utAuI  
杂家接着听他自学程序员历史, m2uML*&O5K  
高级程序员考了吗? Usf"K*A  
a/<pf\O  
y2"S\%7$h  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧! 06 Esc^D  
gQd=0"MV  
我什么程度员也没有考过,连大学生的计算机应用等级证明都没有。 G\>\VA  
/Np"J  
我唯一考过的计算机科目是职称评审时要求有证书,所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏,我都觉得对不起微软了。 p5;,/ |Ft  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
86楼  发表于: 2015-09-05   
引用
引用第21楼阿散于06-14-2010 22:33发表的  : yp2'KES>  
引用第19楼伍胥之于06-14-2010 12:33发表的  : &PBWJ?@O)r  
=PKt09b^  
_h=< _Z  
我平生唯一参加的计算机考试就是职称考试,任选4个模块。 4R*<WdT(  
F `pyhc>1;  
我连一级也没有考过。 JIbzh?$aD  
.
BRU9LS  
&>zy_)  
引用
hXQg=Sj  
矬子里拔将军... 9CK\tx&  
你们那里的俗语是吧? t:"=]zUU  
9Ajgfy>  
我们这里说"矮子里拔长脚"..应该是同一个意思... <W=[ sWJ  
o(X90X  
有趣....各地有表达意思一样却方式不同的俗语.... *VC4s`<  
n?e@):  
vgQh dtt  
你的文章写的有脸皮,没屁眼的, ~?`9i>3W~  
让看客大为不满... Z!RRe ]"y  
G9'YgW+$7  
你等着,,估计你以后接到的午夜凶铃就多了... r6`^>c  
Q0q)n=i }]  
"E ok;io  
我到现在也没有接到你的午夜凶铃呢! llaZP(pJ  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
87楼  发表于: 2015-09-05   
引用
引用第25楼猪小秘于01-20-2011 20:51发表的  : <^*+8{*  
伍SIR,再次抱拳佩服 q]iKz%|Z/  
Jp.3KA>  
O Htg n  
小秘倒是好久不见了呢!宝贝几岁了?很健康活泼吧?
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
88楼  发表于: 2015-09-05   
Re:回 38楼(伍胥之) 的帖子
引用
引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : G%j/eTTf  
佩服,玩也玩得这么专业! \~z?PA.$  
Y>78h2AU  
<i:*p1#Bm  
只是票友而已,算不上专业的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
89楼  发表于: 2015-09-05   
引用
引用第46楼清水于03-03-2011 14:50发表的  : #uD)0zdw  
C}(<PNT  
介个真的看不懂。 Rm,[D)D^0N  
你说你老啦,喜欢怀旧了,才想起来填坑。 Lo|NE[b:G  
提醒我也想想,是不是也老啦,是不是也有坑没填呢。 gJFR1  
o;M.Rt\A  
=2.tu*!C  
你肯定有许多坑没有填,但是我挖的坑更多,但同是我也在你的某个坑里等你填埋呢!
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
90楼  发表于: 2015-09-05   
//从指定扇区号dwSector开始,写dwLength长度的数据 9atjK4+o  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ ~8H&m,{j  
DWORD dwCB; [ 5CS}FB  
LARGE_INTEGER  offset; p|FlWR'mA  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); Gsds!z$  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); _XH4;uGg  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ QQ^Gd8nQ  
DWORD error = GetLastError(); pgz:F#>  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); njy~   
return FALSE; xQNw&'|UU  
} ot|N;=ZKo  
return TRUE; *<`7|BH3  
} P3wU#qU  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
91楼  发表于: 2015-09-06   
'VB 6.0 版 rmY,v  
'这不是我写的,它更强悍了。因为可以直接读写物理扇区(CHS),而不是逻辑扇区。 90  
8BYIxHHz  
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 I!|y;mh:it  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 2gQY8h8  
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 ri/t(m^{W  
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 J- t=1  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long M(n<Iu4 ^_  
'如果用绝对扇区写,那么文件的建立打开都不能用VB的 open 语句了。 R4#;<)  
i_ |9<7a  
:0 W6uFNOU  
Private Const GENERIC_READ = &H80000000 & cM u/}  
Private Const GENERIC_WRITE = &H40000000 +G*"jI8W  
XAjd %Xv<  
Private Const FILE_SHARE_READ = &H1 `FZ(#GDF  
Private Const FILE_SHARE_WRITE = &H2 y;,=a jrF  
Private Const OPEN_EXISTING = 3 jGO9n  
MxM]( ew~7  
Private Const INVALID_HANDLE_VALUE = -1 2x-'>i_|g  
tj#=%m?8V;  
'//file seek l?3vNa FeR  
Private Const FILE_BEGIN = 0 qiG]nCq  
Private Const FILE_CURRENT = 1 Zvd ;KGO(a  
Private Const FILE_END = 2 3[MdUj1y[  
BKa A=Bl  
Private Const ERROR_SUCCESS = 0& 52>[d3I3  
RpHpMtvNo/  
'//device io control #5'c\\ ?Q  
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 ?60>'Xj j  
f|- m ^/y  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 _v1bTg"?  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 Si#"Wn?|  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 .o-0aBG  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 Zij"/gx\  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C X4d Xm>*?=  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 @MNl*~'$.[  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F R<0Fy=z  
> ]>0KQfO  
'//type ry$tK "v/  
Private Type LARGE_INTEGER +90u!r^v  
    lowpart As Long 4^ c!_K&&  
    highpart As Long _ oQtk^fp  
End Type #=X)Jx~  
[Xxw]C6\>(  
Private Enum MEDIA_TYPE +\+Uz!YS  
    Unknown J y]FrSm^  
    F5_1Pt2_512 $cRcap  
    F3_1Pt44_512 * e(:["v  
    F3_2Pt88_512 =jJ H^Y2  
    F3_20Pt8_512 Of1IdE6~  
    F3_720_512 NY4!TOp  
    F5_360_512 `)rg|~#k  
    F5_320_512 %)zk..K{l  
    F5_320_1024 * <B)Z  
    F5_180_512 17e=GL  
    F5_160_512 v57N^DR{  
    RemovableMedia xCR; K]!  
    FixedMedia Oamv9RyDvC  
End Enum ' oBo|  
whV&qe;sw  
Private Type DISK_GEOMETRY oHxGbvQc  
    Cylinders           As LARGE_INTEGER Q{H17]W  
    MediaType           As MEDIA_TYPE Z 6 tE{/  
    TracksPerCylinder   As Long ~Y\QGuT  
    SectorsPerTrack     As Long J9g|#1G  
    BytesPerSector      As Long /yLzDCKn  
End Type /6Y0q9  
\9046An  
'//private vars +n@f'a">  
Private hDisk           As Long             'disk handle %l Q[dXp  
Private lpGeometry      As DISK_GEOMETRY    'disk info 99J+$A1  
Private lBufferSize     As Long             'the buffer size of read/write g E\A9L~b  
N YCj; ,V  
Public Function OpenDisk(ByVal FileName As String) As Boolean q $t&|{  
'// 打开磁盘 7sj<|g<h(_  
    hDisk = CreateFile(FileName, _ zx ct(  
                        GENERIC_READ Or GENERIC_WRITE, _ aML#Z|n  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ [<_"`$sm=  
                        ByVal 0&, _ VT'0DQ!NIq  
                        OPEN_EXISTING, _ S$S_nNq  
                        0, _ Bx+d3  
                        0) 4uFIpS|rq  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) MinbE13?U  
End Function #0}Ok98P  
[_j6cj]  
Public Function CloseDisk() As Boolean CT|z[^  
'//关闭磁盘 6a7vlo  
    CloseDisk = CloseHandle(hDisk) `2>XH:+7F  
End Function +#0~:&!9  
\|v`l{  
Public Function GetDiskGeometry() As Boolean pI  &o?n  
'//获取磁盘参数 q_-ma_F#s  
    Dim dwOutBytes      As Long MKomq  
    Dim bResult         As Boolean Xwn3+tSIa  
     ]PeLcB  
    bResult = DeviceIoControl(hDisk, _ ||R0U@F,  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ )\8URc|J  
                                ByVal 0&, 0, _ cN62M=**  
                                lpGeometry, Len(lpGeometry), _ 1#/6r :  
                                dwOutBytes, _ KA `0g=  
                                ByVal 0&) |a%B|CX  
     +H41]W6  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack I!61 K  
    GetDiskGeometry = bResult ):/,w!1  
End Function ,o BlJvm  
:M@Mmp Ph  
Public Sub GetDiskInfo(MediaType As Long, _ OWqrD@  
                        Cylinders As Long, _ =.DTR 5(_h  
                        TracksPerCylinder As Long, _ U?^OD  
                        SectorsPerTrack As Long, _ Nfr:`$k  
                        BytesPerSector As Long) P=c?QYF  
'//返回磁盘的参数 _B}9 f  
    MediaType = lpGeometry.MediaType IDj_l+?c  
    Cylinders = lpGeometry.Cylinders.lowpart :lNg:r$4  
    TracksPerCylinder = lpGeometry.TracksPerCylinder /j11,O?72  
    SectorsPerTrack = lpGeometry.SectorsPerTrack I"B8_  
    BytesPerSector = lpGeometry.BytesPerSector _8 al  
s\6N }[s  
End Sub &j3` )N  
pQqbZ3]  
Public Property Get BufferSize() As Long nlaG<L#  
'//返回每次读/写的缓冲大小 Ft3I>=f{  
    BufferSize = lBufferSize I=U+G Y:  
End Property \xF;{}v  
w2k<)3 g~  
3QIdN  
Public Function LockVolume() As Boolean Dzo{PstM%  
'// 将卷锁定 P= e4lF.  
    Dim dwOutBytes  As Long FQ U\0<5  
    Dim bResult     As Boolean g`kY]lu  
     IeZ&7u  
    bResult = DeviceIoControl(hDisk, _ b9`iZ  
                                FSCTL_LOCK_VOLUME, _ AU/#b(mI  
                                ByVal 0&, 0, _ 5bXHz5i  
                                ByVal 0&, 0, _ ; {Xy`{Cg!  
                                dwOutBytes, _ q1STRYb   
                                ByVal 0&) WPtMds4  
    LockVolume = bResult >o#ERNf  
End Function %?Rs*-F.~1  
A1Ka(3"  
~xw 5\Y^  
Public Function UnlockVolume() As Boolean e$HQuA~Q;  
'// 将卷解锁 &D]&UQf  
    Dim dwOutBytes As Long 9MT? .q  
    Dim bResult As Boolean #hpIyy%n  
     2%5?F n=  
    bResult = DeviceIoControl(hDisk, _ L1rwIOgq^  
                                FSCTL_UNLOCK_VOLUME, _ sA3UeTf  
                                ByVal 0&, 0, _ Tj&'KF8?L  
                                ByVal 0&, 0, _ z* RSMfRW  
                                dwOutBytes, _ ^/k ,  
                                ByVal 0&) ) 9MrdVNv  
    UnlockVolume = bResult MvBD@`& 7  
End Function  O)OUy  
Mxo6fn6-46  
R'L?Xn}3  
Public Function DismountVolume() As Boolean 7 %3<~'v[  
'// 将卷卸下,使系统重新辨识磁盘,等效于重新插盘 '5AvT: ^u  
    Dim dwOutBytes As Long J,RDTXqn  
    Dim bResult As Boolean m#*h{U$  
     l^ARW E  
    bResult = DeviceIoControl(hDisk, _ #VO.%H}i  
                                FSCTL_DISMOUNT_VOLUME, _ Ey'J]KVW  
                                ByVal 0&, 0, _ W,DZ ;). %  
                                ByVal 0&, 0, _ ?d4Boe0-a2  
                                dwOutBytes, _ !Qcir&]C>  
                                ByVal 0&) MO-!TZ+6  
    DismountVolume = bResult A])OPqP{  
End Function O"\nR:\  
8`*`nQhWa  
aV<^IxE;  
Public Function ReadDisk(ByVal Cylinders As Long, _ RE 9nU%!  
                    ByVal Tracks As Long, _ wra byRjK  
                    db() As Byte) As Boolean #\LZ;&T'N  
'//按柱面和磁道来读取磁盘数据 Gbn4 *<N  
    Dim iPos    As Long t}VwVf<K  
    Dim lRead   As Long V'j@K!)~xR  
     Qo.Uqz.C  
    iPos = Cylinders * Tracks * lBufferSize nx B32  
     o*-9J 2V=J  
    If SeekAbsolute(0, iPos) Then DKTD Z*  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) _|X7 n~  
    End If a& C.=  
End Function {M [~E|@D  
;Xyte  
Public Function WriteDisk(ByVal Cylinders As Long, _ M'DWu|dIBA  
                     ByVal Tracks As Long, _ :&9TW]*g  
                     db() As Byte) As Boolean ~\ [?wN  
'//按柱面和磁道来写磁盘数据 * MEe,4  
    Dim iPos    As Long @ ICb Kg:  
    Dim lRead   As Long 7lR<@$q  
     .1LPlZ  
    iPos = Cylinders * Tracks * lBufferSize JD ]OIh  
     c yP,[?N  
    If SeekAbsolute(0, iPos) Then {\EOo-&A  
        WriteDisk = WriteBytes(lBufferSize, db()) 0vn[a,W<A  
    End If 8bt53ta  
End Function 0aogBg_@K  
\-c#jo.$8  
9#B x]wy  
'///////////////////////////////////////////////////////////////////////////////////// v77fQ0w3  
'//file system U; p e:  
x/xb1"  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean /=T H08  
'//seek file N 'i,>  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte 'y.Jc S!|  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) Ny^'IUu  
    If LowPos = -1 Then a8zZgIV  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) {OCJ(^8i  
    Else ;SKcbws  
        SeekAbsolute = True vr4O8#  
    End If L<=)@7  
     };r|}v !~_  
End Function tFiR!f)  
ddoFaQ8  
g8l5.Mpx  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean 1%jH^,t/m  
'//read data to array Tm_8<$ 7  
    Dim RetVal    As Long ?Wa<AFXQ  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) {]`p&@  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF ' S,2  
    ReadBytes = Not (RetVal = 0) m6i%DE  
     =m9i)Q  
End Function 4jGLAor|  
iDw.i"b  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean oNIFx5*Z  
'//write data from array csDQva\  
    Dim RetVal As Long U-g9C.  
    Dim BytesToWrite As Long Z(; AyTXA  
    Dim BytesWritten As Long m2O&2[g  
     =Dk7RKoHF  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) ?}8IQxU  
     '_ 0  
    WriteBytes = Not (RetVal = 0) 5ITq?%{M  
End Function h>klTPM>  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
92楼  发表于: 2015-09-06   
这才是我当年写出的一个比较烂的程序 b#a@ rh  
)Gb,^NGr  
Main2.bas 3D_"y Z  
f4"4Z V cr  
Attribute VB_Name = "SubMain" ="'- &   
Option Explicit |')-VhLLK  
>f$NzJ}  
'采集文件与临时文件 O%g\B8 ;  
Public Const TmpFile As String = "d:\30-0600.dat" utH%y\NMF|  
'已有数据:30-0600.dat /30日早6点进车与6:30出车头 ]Ik%#l.G_  
 %w5[*V  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long [l*;E f,  
Public hBCFile As Long  '记录采集参数的文件 wa ky<w,  
Public Const TmpBMP As String = "d:\1.bmp" opD-vDa h  
Public hTmpFile As Long >DP:GcTG  
5)M 2r!\  
L/i(KF{  
'采集窗口参数常量 !r e1EL  
Public Const FrameH As Long = 280& ~5 >[`)  
Public Const FrameW As Long = 768& *_"u)<J  
Public Const pFrameSize As Long = FrameW * FrameH [/$N!2'5  
j?-R]^-5  
'标志区范围,用于识别车辆 p/*"4-S  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X Qn|+eLY  
Public Const mkW As Integer = 28  '识别标志立柱宽度 B+"g2Y  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) ,2,5Odrz  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) P1V1as  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 9/kXc4  
'车缝检测位置常数 " U8S81'  
Public Const sSize As Long = 32& S GM!#K  
Public Const sPos As Long = 310& $iPP|Rw  
Public Const sPosL As Long = 200& }C,O   
Public Const sPosR As Long = 500& JJnYOau  
'车缝检测框位置 CVQB"L  
Public Slice(1 To sSize, 1 To FrameH) As Byte B4Lx{u no  
Public SliceL(1 To sSize, 1 To FrameH) As Byte ,S!w'0k|n  
Public SliceR(1 To sSize, 1 To FrameH) As Byte 0^ &!6R  
Public avSL As Integer, avSLR As Integer, avSLL As Integer Gx'TkU=  
f Iy]/  
l r~gG3   
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析,比使用二维数组更便于VB编译优化 3ZojE ux`  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 H~o <AmE0!  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 _u5dC   
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long :E'P7A  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte 6ep>hS4A&  
'前后帧左右上角128列*8行像素块,根据平均值差绝对值判断进车方向 3n48%5  
Vz"u>BP3~  
!9 f4R/ ?  
u|fXP)>.  
'一次连续采集的帧数 |[1D$Qv  
Public tFrames As Long z<&m*0WYA  
K5k?H  
'在采集卡申请的缓存中,是按帧为单位的,每一帧包含奇偶场两场的数据 A 5nO=  
'而该卡的硬件设置是按场采集,只需要读第一场的数据即可。 FS@A8Bb  
'所以要设置的缓存帧的大小是frameW*frameH*2,而一场的数据量为pFrameSize f*fE};  
A'-_TFwW  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte X3B{8qx_>  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte WG5W0T_  
Public pWorkSpace(1 To FrameW * FrameH) As Long ,.v7FM^gO  
Public Const pBufferSize As Long = FrameW * FrameH * 2 d8OL!Rk  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 BsLG^f  
Y7SacRO  
Public hBoard As Long   '采集卡标识 DDeE(E  
Public mBufferAddr As Long  '缓存地址 1@_T  m  
Public BufferSize As Long  '缓存大小(字节) gQouOjfP  
Public iCurrentCard As Long z-,VnhLx  
Public CapStatus As Long ; Lql_1  
Public iFrames As Long e;ty!)]  
Public currentBr As Byte, currentContr As Byte =k{`oO~:9+  
T3pdx~66  
Public hMEM As Long, mStatus As Long `.v(fC  
Public Const hMemSize As Long = pFrameSize * 4 s'u(B]E  
Public hMemWork As Long Vmi{X b]<  
Public Const hMemWorkSize As Long = pFrameSize * 5 p]ivf  
X?o( b/F -  
ln<]-)&C  
! '0S0a8  
'串口接收轨道衡数据 z$[C#5+2  
Public WeightFromCom As String s>%Pd7:  
Public bReceiveComplete As Boolean _Qd,VE 8u  
TH?9< C-C  
P8I*dvu _  
Public Type GrayBMPHeader ,t,wy37*D  
  Tag As Integer |d}MxS`^  
  FileLength As Long    '文件大小 L CSeOR  
  Reserve1 As Long x0Z5zV9  
  DataOffset As Long    '图像数据偏移量 _MfD   
  BMPHeaderSize As Long  '文件头长  }roG(  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… YZE.@Rz  
                        'the following sizes are possible: b,<9  
                        '28h - windows 3.1x, 95, nt, … rU2iy"L  
                        '0ch - os/2 1.x MGt]'}  
                        'f0h - os/2 2.x <Kt3PyF  
Vrp[r *V@E  
  ImageWidth As Long           '图像宽(像素数) Q6'nSBi:A_  
  ImageHeight As Long          '图像高(像素数) g^~Kze  
  PlaneNumber As Integer  '图像层数 ^p=L\SJ  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap uaw <  
                                        '4 - 16 color bitmap _[K#O,D,  
                                        '8 - 256 color bitmap ,pt%) c  
                                        '16 - 16bit (high color) bitmap G>z,#Xt  
                                        '24 - 24bit (true color) bitmap ,Em$!n  
                                        '32 - 32bit (true color) bitmap z" QJhCh7  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) ,1 UZv>}S  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) k6**u  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) uk7'K 0j  
                                    '3 - bitfields (also identified by bi_bitfields) ziEz.Wn"  
  IMAGESIZE As Long  '图像数据字节数 jbte *Ae  
  hResolution  As Long  '水平分辩率  像素数/米 ^^Jnv{)  
  vResolution  As Long  '垂直分辩率 Q0cRH"!:  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 %y<]Yzv.  
  ImportantColors As Long A6"Hk0Hf  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 ycr"Y|  
End Type glUo7^ay7  
;*cLG#&'M  
0 f/.>1M=  
f3tv3>p  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader !; v~^#M]~  
Public sRECT As RECT uT_!'l$fr  
c&'JmKV>&  
u8vuwbra!  
Public conn As ADODB.Connection ;#k-)m%  
Public rsTrain As ADODB.Recordset z#Nl@NO&  
Public rsOperater As ADODB.Recordset r\M9_s8  
Public rsGoods As ADODB.Recordset G/?~\ }:s  
Public rsGood2 As ADODB.Recordset .EP6oKA  
Public rsSender As ADODB.Recordset Hs(D/&6%  
Public rsReceover As ADODB.Recordset " I+p  
Public rsTrainTMP As ADODB.Recordset 'Kbl3fUF  
hOk00az  
{nMAm/kyj  
'打开采集卡 Es'Um,ku  
'设置参数 P?ep]  
'设置为实时单帧采集到缓存方式 !<n"6KA.  
'由另一线程查询采集状态,如果完成采集,传送至用户数组分析或保存 =A!S/;z>  
q4 k@l  
z/]q)`G  
Sub Main() K%j&/T j1  
  Dim i As Integer, status As Long ,FQK;BU!lh  
     buMq F-j  
   InitBMPinfo & >JDPB?5  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 _GoVx=t   
    BMPHeader.Tag = &H4D42 C"w {\ &R  
    BMPHeader.ImageWidth = FrameW .tXtcf/  
    BMPHeader.ImageHeight = FrameH Pz"`MB<'Ik  
    BMPHeader.BMPHeaderSize = &H28 kQv*eZ~  
    BMPHeader.PlaneNumber = 1 t?)pl2!A  
    BMPHeader.bpp = 8 \\4Eh2 Y  
    BMPHeader.Compression = 0 }1H=wg>\  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 C>QIrZu  
    BMPHeader.vResolution = &H1274 ,|T7hTn=  
    BMPHeader.ColorsinBMP = 256 &KC!*}<tx  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP pwX C  
    BMPHeader.DataOffset = Len(BMPHeader) SpSnoVI  
    For i = 0 To 255 { T]?o~W  
      BMPHeader.Pallate(i) = RGB(i, i, i) t+TYb#Tc  
    Next i 0$vj!-Mb^j  
    BMPHeader.IMAGESIZE = FrameH * FrameW X%{'<baR  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE s8gU7pT49  
slW3qRT\k  
'mMjjG9  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) V'gw\mcb  
     (ywo a  
    BMP1.ImageWidth = FrameW \wav?;z  
    BMP1.ImageHeight = FrameH * 2 s (2GFc  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight Qx`~g,wk8  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE 5g ;ac~g  
,^'R_efY  
  '确定标志位置,为pilarX, pilarY确定初始值 (lH,JX`$a  
   PilarW = mkW \5><3*\  
   PilarH = mkH  '此两项为固定值 NAFsFngqH  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) ;%!m<S|%k  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 ~H6;I$e[  
   k|E]YvnfG  
   YJF#)TkF  
  '连续采集记录文件 |M~ON=  
  ' 建立一个缓冲区为页对齐方式的文件 !~iGu\y  
  If Dir(TmpFile) <> "" Then 2#5,MP~r  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ yy2I2Bv  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) xytr2V ]aV  
    ' 在95/98中,如果打开文件时没有声明overlapped方式,在读定文件时就不能使用overlapped参数项 "$^0%-  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 Q(@IK&v  
  Else SZ!=`a]  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ <,1 fkq>,  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) ?Dsm~bkX[  
  End If :+&AY2`  
  If hFile = 0 Then KFWJ}pNq  
    MsgBox TmpFile & ": File Open Error", vbOKOnly mY&ud>,U:  
    Exit Sub 4Yjx{5QSAG  
  End If {G i h&N  
  '采集参数记录文件 jUMf6^^  
hBCFile = FreeFile() "^CXY3v  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile =U-r*sGLN  
   mZvG|P$}  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 +: Ge_-  
If hMEM = 0 Then oQ2KW..q  
    fStatus = GetLastError #=,(JmQPt  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ ,^s  
     & "请向技术人员报告该错误代码。", vbOKOnly hfM;/  
    CloseHandle hFile KLQ!b,=q  
    Exit Sub 40P) 4w  
End If ]s1 YaNq  
QLq@u[A  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 6`H.%zM  
If hMemWork = 0 Then A.%CAGU5w  
    fStatus = GetLastError 8<#U9]  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 3:CO{=`\7B  
     & "请向技术人员报告该错误代码。", vbOKOnly LXfCmc9|Z  
     '释放已成功分配的内存 ":W%,`@$  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) C2F0tr|  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) #gbH^a'  
     =tdSq"jh  
    CloseHandle hFile )@g;j>  
    Exit Sub E l&h;N   
End If y=sGe!^  
sq0 PBEqq  
' Test writing  u\e\'\  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ]]iPEm"@  
     b=PVIZ  
   '初始化采集卡参数 !]?$f=  
   iCurrentCard = -1 }iN2KeLAF  
   hBoard = okOpenBoard(iCurrentCard) ": ;@Hnb/  
   Debug.Print hBoard g@v s*xE  
   If hBoard = 0 Then HK=[U9 o?  
      ExitGrabber ' /%zi,0  
      End dE=Ue#1U@5  
   End If ' [0AHM  
   okGetBufferSize hBoard, mBufferAddr, BufferSize )mcEQ-!b  
   If mBufferAddr = 0 Then %@J1]E;  
     MsgBox "缓存不存在!" /Wj,1WX~  
     ExitGrabber MXh "Y*}  
   End If #Z!b G?="  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) K\.5h4k  
   X]*QUV]i  
   WMuD}s  
   currentBr = 128: currentContr = 128 =[tSd)D,y  
   '设置视频输入参数 Sfjje4R  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 j|_E$L A\  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input H=MCjh&$q  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 _7)F ?  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 NY B[Zyp  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 %1U`@0  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 2z0n<`  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行(低字)同步开槽(高字) udqS'g&  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移,低字X偏移 (144/44经验值) P&A|PY,P  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小:低字X高字Y (768/576采集卡最大值) qoU3"8  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 L\aBc}  
   30cd| S?  
   '设置采集参数 RuRt0Sd3  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 l:(Rb-Wy  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 ?w&SW{ I  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 {bNXedZ\  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 6tjcAsV  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 Cpl;vQ  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 8\ha@&p  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 wzWbB2Mb5  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 ] Uc`J8p,  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 j6}R7 $JR  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 u:gtOjk2  
   'Buffer Block Size不用设置,而用okSetTargetRect函数进行动态调节 N=1JhjVk"  
   fZWGn6$   
   h5zVGr  
   okCloseBoard hBoard FH5ql~  
   Sleep 50 TCVl8)j  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 y }2F9=  
   [w \?j,  
   '设置数据传送方式 C*70;:b  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 3tS~:6-/  
   '该设置对本程序无意义,因为程序直接用CopyMemory方法读缓存,而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 T=Z.U$  
   C*6S@4k  
   sRECT.Right = -1   '用于获得当前设置值 bha?eN  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) _GtBP'iN  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom  b`mj_b  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 p='-\M74K  
   sRECT.Left = 0 hsLzj\)6  
   sRECT.Top = 0 .V'V:;BE%  
   sRECT.Right = sRECT.Left + FrameW 8cg`7(a  
   sRECT.Bottom = sRECT.Top + FrameH * 2 wo^Sy41bF  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) QDmYSY$  
   W  0[N0c  
   sRECT.Right = -1   '检查新设置值 ;e8V +h  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) JqUADm  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom F phDF  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) in%;Eqk  
   !^fa.I'mM  
   If TESTSignal = False Then 'Pltn{iq[  
      'ExitGrabber Wa"(m*hW  
   End If f<jb=\}x  
   HL{$ ^l#v  
   g^>#^rLU  
   2(YPz|~W  
   '设为实时采集状态 g=)J~1&p  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) \>/M .2  
   Z'v-F^  
   -`c :}m  
   '单帧采集 mry N}  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 'W. V r4  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) q!,zq  
   okCaptureTo hBoard, BUFFER, 0, 1 'single 6gO9 MQY  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 Jc*XX u)  
   '   Sleep 20 K`:=]Z8  
   'Loop CZ{k@z`r  
   okGetCaptureStatus hBoard, True tJI ,r_  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize D$ e B ,~  
   '写入768*576测试图象 XR+3j/zEQ  
   ArrayToBMP TmpBMP BNGe exs@  
   3ha|0[r9  
   '打开数据库 u62)QJE  
   Set conn = New ADODB.Connection S5=Udd"  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _  3yS  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ,t$,idcT+  
      "; Mode=Read|Write" rJfqA@  
   conn.Open 4g _"ku  
   ZFh+x@  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) b B  
   frmRecord.Visible = True (X[2TT3j!  
   frmQuery.Visible = True Yn51U6_S  
   Load frmReceiveFromComm D vkxI<Xa  
   ffDc 6*.Q  
   '调试参数 vlWw3>4  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then d4^`}6@  
     SignalBox.Visible = True N1EezC'^  
   End If B)SLG]72f  
   If InStr(UCase(Command()), "/COMM") > 0 Then pa .K-e)Mu  
     frmReceiveFromComm.Visible = True b%(6EiUA  
   End If vxlOh.a|/L  
?h\mk0[  
End Sub tB(4Eq \  
USML~]G z  
Sub ExitGrabber() ;^k7zNf-  
  '关闭数据库 S9 sR#  
  '关闭采集卡 LX+5|u  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) Mio>{%/  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) Bn wzcl  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) W=}Okq)x9I  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 25{ uz  
  okStopCapture hBoard obClBO)@Y  
  okCloseBoard hBoard *=F(KZ  
  CloseHandle hFile ")#<y@Rv  
  Close #hBCFile 2-If]Fc  
  conn.Close AD5) .}[F  
  End qztV,R T  
End Sub p QE)p  
wNCCH55Pt  
Function ArrayToBMP(ByVal File As String) "&YYO#YO  
Dim BytesWrite As Long y&T&1o  
FpV`#6i7  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ gz#4{iT~  
  CREATE_ALWAYS, 0&, 0&) tl8O6`<Z  
US&B!Q:v  
If hTmpFile = 0 Then *6ZCDm&N  
   ArrayToBMP = False =ZYThfAEw  
   Exit Function 43:t \  
End If ,lN5,zI=S  
P<dy3 ;  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN VkmRh,T  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& j} HFs0<L  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN Do-^S:.  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& pNaiXu3  
t@zdm y  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN KJhN J  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& ` vk0c  
"`tXA  
If BytesWrite < pFrameSize Then &&8'0 .M{  
  ArrayToBMP = False 3SG?W_  
End If !-]C;9 Zd  
 ^y.UbI  
CloseHandle hTmpFile $+= <(*  
8}p8r|d!ls  
End Function B;zt#H4  
FVWfDQ$&v  
Function ArrayToBMP1(ByVal File As String) Gy29MUF  
N0TeqOi4Y  
Dim BytesWrite As Long &vUq}r%P  
n[+'OU[  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 8Cf|*C+_'  
  CREATE_ALWAYS, 0&, 0&) 4n( E;!s  
oW}!vf3z  
If hTmpFile = 0 Then x!TZ0fq0  
   ArrayToBMP1 = False 6o&ZIYJ9k  
   Exit Function ]Tp U"JD  
End If q%3<Juq~$  
dJ3 IUe  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN =C7 khE  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& c-]fKj7  
$K}. +`vVO  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN &K%aw  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& gvavs+H%  
$Rtgr{ {;"  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN ?s%v0cF  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& !|{IVm/J  
{+T/GBF-K=  
If BytesWrite < pBufferSize Then |WqOk~)[Z3  
  ArrayToBMP1 = False {a q9i  
End If :> -1'HC  
ZXiRw)rM  
CloseHandle hTmpFile Ggm` ~fS  
3x*z\VJ  
End Function >wON\N0V_  
XJ\hd,R   
'使用该过程建立的文件要求在用后关闭 eb:A1f4L  
Public Function ArrayToBMP2(File As String) As Boolean W.}] .7}h  
mX# "+X|  
Dim BytesWrite As Long H?rg5TI0  
y2Bh?>pg  
ArrayToBMP2 = True C0 ) Z6  
fjz) Gp  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ 7ET jn)%bs  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) 5>0.NiXGf'  
mB 55PYA  
If hTmpFile = 0 Then %uDG75KP{  
   ArrayToBMP2 = False i2,U,>.  
   Exit Function \{|ImCH  
End If I2Ev~!  
T|4snU2M  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN _2Py\+$  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& cgZaPw2 bw  
d.F)9h]XHO  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN ?Hz2-Cn  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& |H)cuZ  
iw]k5<qKj  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN LK7Xw3  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& +c,[ Q  
-E>)j\{PX7  
If BytesWrite < pFrameSize Then HxwlYx,4  
  ArrayToBMP2 = False t%0?N<9YkU  
End If 8v_C5d\  
o \L!(hm  
CloseHandle hTmpFile :- +4:S  
fib#CY  
End Function X)Gp7k1w  
**;p (CI  
Private Function TESTSignal() As Boolean {ISE'GJj  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long j BS4vvX?  
-$k>F#  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) zQ)+/e(8  
XX;6 P  
If extsign = 1 Then 'ig, ATY  
   TESTSignal = True jZ9[=?   
Else i?}>.$j   
    If extsign = 0 Then j'rS&BI G  
        MsgBox "无视频输入信号,检查摄像机电源!", vbOKOnly Iin#Wd-/  
        TESTSignal = False t 0O4GcAN  
        Exit Function 6qp5Xt+  
    End If Di(9]: +  
End If %_)zWl N  
F@W*\3)  
'测试视频输入类型 i.a _C'<$  
'video type S3 \jcgrS  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 /p`&;/V|  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) `u'dh{,gE  
If videotype = 1 Then JSVeU54T^<  
        '"隔行信号(Interlaced)" @PkJY  
Else zmFws-+A  
   If videotype = 0 Then |m>}%{  
       '"逐行信号(Non-interlaced)" Lk, +Tfk"  
   Else MiGcA EF;  
     If videotype = -1 Then b5`KB75sbo  
       ' "不支持" ]#eh&jw  
     End If ]r"Yqv3  
   End If yXfMz G  
End If W4(?HTWZ  
gQVBA %  
'测试垂直扫描线数 m#@_8_ M  
'video scanlines ?[1SiJT  
scanlines = -1 c[(Pg%  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) a|qsQ'1,;  
    If scanlines = -1 Then ;Rnhe_A.  
        ' "不支持" wq0aF"k  
    Else bH9Le  
        'Trim(Str(ScanLines)) + " 行数/幅" |ng%PQq)  
    End If EQ >t[ &  
.XH8YT42  
'测试帧频 R{}qK r  
'video field frequency nB@UKX  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) Wr%7~y*K  
    If fieldfrq = -1 Then .[pUuVq]  
        'lblSignal(8) = "不支持" %efGt6&  
    Else " ~Q*XN2  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" &r_uQbx  
    End If H'Qo\L4H  
End Function U6j/BJT"  
 00<{:  
x7ATI[b[  
Sub PicIdentify()  &"S/Lt  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别  W'/>et  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 ;bjnL>eW  
'判定标准:如果在立柱位置上有明显的模式反差,则视为车皮之间的间隔 HYClm|   
'方法:对立柱标志区进行平均值二值化,面积为32*40,亮区(255)与暗区(0)的亮度平均值理论差大于200倍,实际差值应不小于100倍 z1j|E :  
<|F-Dd  
  Dim fPTR As Long, cFrame As Long y?:dE.5p|  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer uH{'gd,q8  
     Z7#7N wy4  
Zw JciT!_~  
cFrame = 0 -F`he=Ev9  
 H!eh J$[  
zY APf &5  
Do While cFrame < tFrames ,;i A2  
   McP.9v}H0_  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) Da,Tav%b  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) @EZ>f5IO+  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize mnQ'X-q3iO  
   7 `Du5>b8  
  frmRecord.RText.Text = Str(cFrame) $G";2(-k  
  frmRecord.RText.Refresh vA>W9OI   
       9M2f!kJP$  
  If CheckMark = True Then rw u3Nb  
   ArrayToBMP TmpBMP wh6&>m#r  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) tY_5Pz(@  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" h_ ZX/k  
   wq\G|/%  
   DrawSlice 3wt  
   2P}I'4C-  
   'i = MsgBox("检测到立柱:第" & Str(cFrame) & "帧", vbYesNo) FmT `Oa>  
   'If i = vbNo Then _Z#eS/,O@  
   '  Exit Do hPO>,j^  
   'End If esq<xuZM4  
   'cFrame = cFrame + 1 &YX6"S_B  
   O% $O(l  
  End If RaNeZhF>M  
  DoEvents "'{OIP  
  cFrame = cFrame + 1 i\x~iP&F$  
Loop iJnh$jo  
End Sub k|j:T[_  
^Q2ZqAf^a  
i^g~~h F  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean ?!S GiARW?  
lX;mhJj!  
'如标志区模式反差存在则为TRUE,否则返回FALSE Rc9<^g`  
gGbI3^ r#  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long htHv&  
CheckMark = True }~zO+Wf2  
   tgN92Q.i6T  
'复制标志区 *x,HnHT  
For i = 1 To mkH ]N}]d +^6  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 2ksA.,UB^9  
Next i P;GprJ`l  
qi\n]I  
For j = 1 To PilarW * PilarH / 2 \y~)jq:d"  
   mTop = mTop + MKpilar(j) u4"r>e6 _B  
Next j b(&] >z  
&o.iUk  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH ^, wnp@  
   mBot = mBot + MKpilar(j) $c =&0yt5  
Next j l>Av5g)  
mw+j|{[  
mTop = mTop / PilarW / PilarH * 2 el*9 Ih  
mBot = mBot / PilarW / PilarH * 2 CA^.?&CH^O  
l%PnB )F  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 fv ?45f  
pGkef0p@  
'平均值极值化 wZ>Y<0,  
  For j = 1 To PilarH * PilarW pt})JMm  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) I~RcOiL)  
  Next j EAyukM2  
   w%u5<  
mTop = 0: mBot = 0 p7[(z  
For j = 1 To PilarH * PilarW / 2 SCq3Ds^  
  mTop = mTop + MKpilar(j) d}% (jJ(I  
Next j !sK#zAR2  
7^wE$7hS  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW Lz6*H1~   
  mBot = mBot + MKpilar(j) !R{em48D  
Next j 4A  o{M  
<7RfBR.9  
BE4\U_]a3  
  mTop = mTop / PilarH / PilarW * 3 ZdJer6:Z}  
  mBot = mBot / PilarH / PilarW * 3 {lhdropd  
   QhHexr6  
XS'0fq a  
If mBot > iWhite And mTop < iBlk Then aF'9 &A;q  
  CheckMark = True .C2.j[>  
Else  xedbr  
  CheckMark = False sN `NZyG  
End If &2!F:L  
End Function K)`\u7Bu  
t/baze;V  
Sub Capture1Frame()  9g*MBe:  
   okCaptureTo hBoard, BUFFER, 0, 1 'single u/h!i@_w[  
   okGetCaptureStatus hBoard, True #VwA?$4g`  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize zFtwAa=r  
End Sub N!e?K=}tL  
Dl#%tYL+3h  
\q8D7/q  
Sub CopyMark(iBlk As Integer, iWhite As Integer) y/}>)o4Q  
'复制标志区并返回标志区暗区与亮区的亮度平均值 B !hrr  
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 t7%!~s=,M  
   7 vS]O$w<4  
'复制标志区 X%1fMC  
For i = 1 To mkH Yz?1]<X  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW "lp),  
Next i 3pp Y@_1  
R":nG7o  
For j = 1 To mkW * mkH / 2 ?CQ\9 4kO  
   mTotal = mTotal + MKpilar(j) cXJtN W@  
Next j f]BG`rJX  
Wh,{|R[  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 tN 5brf  
"5-S:+  
mTotal = 0 rX%qWhiEJ  
For j = mkW * mkH / 2 + 1 To mkW * mkH FJN,er~T[  
   mTotal = mTotal + MKpilar(j) Cz\(.MWNZ  
Next j V^t5 Y+7  
9K8f ##3  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 35 ;)O -  
@ P=eu3  
'背景亮度 =9 TAs? =  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW cs?@Ri=g  
  For i = 1 To 4 * FrameW U/B1/96lJ  
    bsTotal = bsTotal + BsLine(i) ]x hmM1$  
  Next i up~l4]b+  
  bsAV = bsTotal / FrameW / 4 ^;2dZgJ4^  
z:aT5D  
End Sub t:X[Blw3$  
\Mv8pU  
fWR]L47n  
Sub AdjIMGbright(Optional bInit As Boolean = True) `ecuquX'  
bT@7&  
  '自动调节亮度与对比度,此时处于无车辆状态(白天特别高,而夜间特别暗) "Q~6cH[#  
  '图像平均亮度白天不高于200(当车辆通过时可能会下降到100左右),不低于100 C/Ig.KmXF{  
  '            夜间不高于80(过高时通常是由于雪花噪声引起),但立柱不低于30 +|OkT  
     eXaa'bTx  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer j${:Y$VmE  
   / 4K*iq  
  '按标准亮度与对比度采集一帧,确定背景亮度 6t5)r lT  
  currentContr = 128   '初始对比度 W"rX$D [Le  
  currentBr = 128   '初始亮度 N.q4Ar[x#p  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 A}#@(ma7  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 i&^?p|eKa  
  DoEvents oOuhbFu  
  Capture1Frame G{ rUqo  
  '获得图像上缘4行象素 kNW&rg  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW %Hu Qc^  
  CopyMark iBlack, iBright   '图像标志区亮度 }Kq5!XJV9C  
  For i = 1 To 4 * FrameW [&rW+/  
    bsTotal = bsTotal + BsLine(i) Uq/(xh,t5  
  Next i j>M 'nQ,;d  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 l%"e Q   
   *g5df[  
  Select Case bsAV Y9m'RFZr  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 AQ-P3`bCb  
       currentBr = 150 Kbc-$ oneR  
       currentContr = 60 HLAYmXX"w  
     Case 61 To 80   '有可见背景 /D_8uTS>d[  
       currentBr = 140 jow^~   
       currentContr = 70 PZO7eEt8  
     Case 81 To 100  '有清晰背景 =MG  
       currentBr = 128 Z{/C4" F  
       currentContr = 80 Y}"|J ~  
     Case 100 To 150  '有明亮背景 ` "m"qUd  
       currentBr = 140                '5:30-6:00钟实测数据 ~Gc+naE>  
       currentContr = 50 J1"u,HF*(  
     Case 151 To 180 _c%]RE  
       currentBr = 130 :Qu!0tY  
       currentContr = 60 4j)Y>  
     Case 181 To 220  '背景全为白色 3Fh<%<=  
       currentBr = 110 J=TbZL4y}4  
       currentContr = 130 K+H?, I  
     Case 221 To 255  '背景全为白色 0At??Z py  
       currentBr = 100 %|Vo Zx ^  
       currentContr = 100 V0L^pDLOV  
  End Select DB_ x  
   C9Fc(Y?_  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 #JZf] rtp  
        Case 100 To 150 3l>P>[<o  
          currentBr = currentBr - 10 qo.~5   
        Case 151 To 255 K4xZT+Qb  
          currentBr = currentBr - 20 L]#J?lE&  
  End Select h GS";g[?  
   P]+^^ U  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 oC U8;z  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 7(~^6Ql!  
End Sub ]k{cPK  
/w!b2KwV  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) 3OFv_<6  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long M!=v"C#  
     E[LXZ h  
    For i = 1 To 8 P-No;/!B#  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& Y_%\kM?7  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& ekP=/;T#S  
    Next i uGJeQ  
     P _Zf(`jJ  
    For j = 1 To 1024 s.KJYP  
      L1 = L1 + LeftBK(j, 0) YFLWkdqAY  
      L2 = L2 + LeftBK(j, 1) )TM![^d  
      R1 = R1 + RightBK(j, 0) N{P (ym2yR  
      R2 = R2 + RightBK(j, 1) I~"-  
    Next j ]-)qL[Q  
    diffL = Abs(L1 - L2) / 1024 e\.|d<N?  
    diffR = Abs(R1 - R2) / 1024 {C*mn! u  
End Sub s Xl7  
5cyl:1Ln  
Function CheckSlice() As Boolean Q-}oe Q  
  CopySlice avSL, avSLR, avSLL .Rc&EO  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then d"5:/Mo  
    CheckSlice = True hS +;HB,  
  Else d[rxmEXht  
    CheckSlice = False D2>EG~xWq  
  End If V Q<Z`5eV  
End Function g@nk0lQewj  
"C=HBJdYB5  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) NEZF q?  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long 1&QI1fvx  
  For i = 1 To FrameH jzEimKDE's  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize ^gkyi/z  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize C-_u; NEu  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize .6$ST Ksr  
  Next i oL X6w  
  For i = 1 To FrameH ~AK!_EOs`  
    For j = 1 To sSize pa+^5N  
       total = total + Slice(j, i) QsDa b4  
       totalL = totalL + SliceL(j, i) >g93Bj*  
       totalR = totalR + SliceR(j, i) f QuphMOl6  
    Next j H:9( XW  
  Next i Aid{PGDk  
  avSL = total / FrameH / sSize |fTQ\q]W  
  avSLR = totalR / FrameH / sSize wGISb\rr  
  avSLL = totalL / FrameH / sSize 0,m*W?^31  
End Sub z]P|%  
4_t aCK  
Sub DrawSlice() MkJL9eG  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B `iI YZ3i  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B zK:/ 1  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B I U 4[}x  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) Cj5M  
End Sub $z@e19gT  
Sub DrawMark(pic As Control) 15U=2j*.b  
   Dim i As Long, j As Long )OH!<jW  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B j@kBCzX  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B uVu`TgbZ  
   For i = 1 To PilarH  IO>Cyo  
     For j = 1 To PilarW 9S6vU7W  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) 66)@4 3V  
     Next j d-N<VVcy\  
   Next i Os@ofnC  
End Sub _V:D7\Gs  
ZQl[h7c/N  
Function avIMG() As Integer giaO7Qh~  
  Dim i As Long, j As Long, totalIMG As Long 0<v~J9i  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize `p#A2Ap A  
  For i = 1 To pFrameSize )CdglPK  
    totalIMG = totalIMG + pBuffer(i) f#JLE+0Y  
  Next i ,{8~TVO  
  avIMG = totalIMG / pFrameSize MQ\:/]a  
End Function iyH<!>a  
r7ywK9UL  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer _vU,avw  
  Dim i As Long, j As Long, totalIMG As Long *i%!j/QDAP  
  For i = 1 To FrameH Q1&: + 7 %  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth ,fET.s^|U  
  Next i pb E`Eq  
  For i = 1 To FrameH * barWidth >PySd"u  
    totalIMG = totalIMG + pBuffer(i) z^}T = $&  
  Next i tMyD^jVC  
  avRegion = totalIMG / pFrameSize mL6/NSSz  
End Function m(g$T  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
93楼  发表于: 2015-09-06   

一共这么多文件。 {5%<@<? )  
W8":lpp  
这是我用VB写出的最大的程序,也是用API最多的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
94楼  发表于: 2015-09-06   
拍下的火车 vNtbb]')m  
第6车皮 ,bH  

+ubO-A?  
*i$+i  
第9车皮 uNRGbDMA=  
/?J_7Lg  
  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
95楼  发表于: 2015-09-06   

从这里里分离出来的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
96楼  发表于: 2015-09-06   

-pjL7/gx  
b<7.^  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
97楼  发表于: 2015-09-06   
下一次练手,也是VB,不过只是用CCD测量济钢中板车间轧机出来的板的宽度。 Em?skUnG,  
(>Yii_Cd  
这一次,我自己做了一个二进制的尺子,用CCD在一个盒子里读尺。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
98楼  发表于: 2021-01-02   
继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ? cCj3,s/p  
5_i&}c23Vn  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
99楼  发表于: 2021-07-18   
继续填个坑: Q^ F- 8  
?O3 G  
用VBA控制WORD自己修订学生毕业文的格式。 EgO4:8$h  
杺栫杣杊椌柮栬,䒴蓉艿芖。
描述
快速回复

验证问题:
3 * 6 = ? 正确答案:18
按"Ctrl+Enter"直接提交