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

显示用户信息 
80楼  发表于: 2015-09-05   
引用
引用第20楼newport93于06-14-2010 13:47发表的  : ]Z nASlc)  
t"s$YB>}  
老五,I 服了U。 OO2uE ;( 3  
ZkJLq[:cM  
哪一天等俺退休了,也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 q|{z9V<  
I&U.5wf  
BCfmnE4%  
新港妹妹,虽然你还没有退休,但是孩子读了大学你应该有些时间了嘛!就开帖写吧!我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! QWc,JCu  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
81楼  发表于: 2015-09-05   
引用
引用第3楼阿散于03-19-2010 22:49发表的  : q3v v^~  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? _NB*+HVo  
?[uHRBR'  
DRpF EWsm  
阿散这个家伙,已经被我全局禁言了,但是在他不犯错的时候,也还是个很好玩的同学。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
82楼  发表于: 2015-09-05   
引用
引用第6楼沧桑于06-13-2010 14:39发表的  : *u-$$@|y  
老伍在写交代材料啊,而且写在一个ZT的贴下,哈哈。 h\p!J-V  
t7xJ$^p[|K  
DS;\24>H  
这不是怕您见笑嘛!现在露馅了,只得继续招供了。 c4u/tt.)  
O,Tp,w T  
可以从宽不?
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
83楼  发表于: 2015-09-05   
引用
引用第10楼卡拉于06-13-2010 21:49发表的  : HAL\j 5i  
老伍,对不住,我把你原来的英文标题改了,太不吸引人眼球了,有些人还当是英文的都不会去点击。我通篇读了一下,改成了现在的标题。如果你不喜欢,可以改回来。 m I5J] hk  
Xy%||\P{)  
Z1jxu;O(  
其实标题没有什么,卡总既然改了就不必再改回了。 1)^\R(l  
KJV8y"^=Q  
主要是当初写的时候真是顶着锅盖写的。 ZG 0^O"B0  
EcL6lNTR+  
阿散说得对。我就是把一堆鸡毛蒜皮的小事,用了一个big title.
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
84楼  发表于: 2015-09-05   
引用
引用第16楼阿平于06-13-2010 22:25发表的  : tO{{ci$-T  
哦, 打倒忽悠大家的家伙.      ppRmC,0f^  
F| eWHw?t  
LWv<mtuYf  
阿平姐,这可不是忽悠,我可是认真交待经历呢!
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
85楼  发表于: 2015-09-05   
引用
引用第17楼阿散于06-13-2010 22:29发表的  : (p{%]M  
每个人的故事对其他人都是故事, RFL * qd4  
自己的故事也是其中之一. PP$sdmo  
跳出来看, x|a&wC2,{  
不过是众人中的一个人的故事. J)YlG*  
!CUl1L1DSi  
所以,接着听故事. a2B71RT~  
uP'L6p5  
女人们有兴趣的就等老伍开个新帖或者跟贴, :oZ<[#p"*  
听他痛说恋爱革命历史.... 4>=M"D hB  
DLrV{8%W  
杂家接着听他自学程序员历史, 2.aCo, Kb;  
高级程序员考了吗? oj djy#:  
MvpJ0Y (  
rS_G;}Zr  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧! = g{I`u  
d}4NL:=&  
我什么程度员也没有考过,连大学生的计算机应用等级证明都没有。 rP4T;Clout  
:s_> y_=g  
我唯一考过的计算机科目是职称评审时要求有证书,所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏,我都觉得对不起微软了。 OF7hp5  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
86楼  发表于: 2015-09-05   
引用
引用第21楼阿散于06-14-2010 22:33发表的  : @3?>[R  
引用第19楼伍胥之于06-14-2010 12:33发表的  : Q]K` p(  
,,{;G'R|  
n{;Q"\*Sg  
我平生唯一参加的计算机考试就是职称考试,任选4个模块。 L(TM& ps\-  
U*[E+Uq}:N  
我连一级也没有考过。 P+j=]Yg  
.
zvV&Hks-  
\EfX3ghPI  
引用
GM6, LzH  
矬子里拔将军... S[F06.(1  
你们那里的俗语是吧? BX?DI-o^h  
o^@"eG$,  
我们这里说"矮子里拔长脚"..应该是同一个意思... #-;c!<2  
zL yI|%KH  
有趣....各地有表达意思一样却方式不同的俗语.... 7.h{"xOx{  
b)I-do+  
"r&,#$6W6  
你的文章写的有脸皮,没屁眼的, _Q5mPBO  
让看客大为不满... eB5>uKa  
C#U(POA  
你等着,,估计你以后接到的午夜凶铃就多了... Bz ;r<Kn  
Q~(Gll;  
Dx-P]j)4x  
我到现在也没有接到你的午夜凶铃呢! M- ^I!C  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
87楼  发表于: 2015-09-05   
引用
引用第25楼猪小秘于01-20-2011 20:51发表的  : -%` ~3*L  
伍SIR,再次抱拳佩服  \(\a=  
_@ao$)q{J  
_RIU,uJs  
小秘倒是好久不见了呢!宝贝几岁了?很健康活泼吧?
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
88楼  发表于: 2015-09-05   
Re:回 38楼(伍胥之) 的帖子
引用
引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : _w\9 \<%  
佩服,玩也玩得这么专业! 6eSo.@*l  
cu/"=]D  
8oX1 F(R  
只是票友而已,算不上专业的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
89楼  发表于: 2015-09-05   
引用
引用第46楼清水于03-03-2011 14:50发表的  : puOtF YZ\  
?IGp?R^j"  
介个真的看不懂。 |nQfgl=V  
你说你老啦,喜欢怀旧了,才想起来填坑。 wiN0|h>,  
提醒我也想想,是不是也老啦,是不是也有坑没填呢。 >j?5?J"  
Z[@ i/. I  
|P5dv>tb F  
你肯定有许多坑没有填,但是我挖的坑更多,但同是我也在你的某个坑里等你填埋呢!
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
90楼  发表于: 2015-09-05   
//从指定扇区号dwSector开始,写dwLength长度的数据 \:m~ +o$<-  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ RE t &QP  
DWORD dwCB; d*6f,z2=  
LARGE_INTEGER  offset; ?AFb&  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); }U7IMONU  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); b~.$1oZ  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ Q6(~VvC-  
DWORD error = GetLastError(); k4s V6f  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); s\d3u`G  
return FALSE; Q`bXsH  
} /O[6PG  
return TRUE; n{QyqI  
} MXSD8]je  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
91楼  发表于: 2015-09-06   
'VB 6.0 版 ]>~.U ~  
'这不是我写的,它更强悍了。因为可以直接读写物理扇区(CHS),而不是逻辑扇区。 ' #K@%P  
J^"_H:1[  
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long 0L>3 i8'  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long z_'^=9m  
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 XGZZKvp  
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 le5@WG/x  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long `ulQ C  
'如果用绝对扇区写,那么文件的建立打开都不能用VB的 open 语句了。 9'( _*KSH  
>)K3  
rai'x/Ut}+  
Private Const GENERIC_READ = &H80000000 0eO!,/  
Private Const GENERIC_WRITE = &H40000000 /o4_rzR?  
s`x2Go  
Private Const FILE_SHARE_READ = &H1 n~0wq(8M  
Private Const FILE_SHARE_WRITE = &H2 B>i%:[-e  
Private Const OPEN_EXISTING = 3 S\Z*7j3; M  
:Ou~?q%X  
Private Const INVALID_HANDLE_VALUE = -1 ^?e[$}  
 C6gSj1  
'//file seek fS}Eu4Xe  
Private Const FILE_BEGIN = 0 pqg2#@F.  
Private Const FILE_CURRENT = 1 `)O9 '568  
Private Const FILE_END = 2 xiW}P% bf  
S:!5 |o|  
Private Const ERROR_SUCCESS = 0& 7O)ATb#up  
Cx;it/8+  
'//device io control :awa  
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 Z*Ffdh>*:&  
}P2*MrkcHB  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 w (HVC  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04 TD\TVK3P  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 N)(m^M(~0  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 Y5 E0n(Z  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C f?Ex$gnI  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 pKLcg"{[F  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F VY/r2o#  
*c#DB{N  
'//type 6`9QGi,)  
Private Type LARGE_INTEGER /%m?D o  
    lowpart As Long U,b80%k:  
    highpart As Long UusAsezm:  
End Type }'<Z&NW6  
b$2 =w^ *  
Private Enum MEDIA_TYPE (B\Kb4m  
    Unknown K14.!m  
    F5_1Pt2_512 3+>R%TX6i<  
    F3_1Pt44_512 zDYJe_m ~  
    F3_2Pt88_512 p cD}SY  
    F3_20Pt8_512 .;?ha'  
    F3_720_512 !wAnsK  
    F5_360_512 lsV>sW4]Z  
    F5_320_512 igOX0  
    F5_320_1024 2\{/|\  
    F5_180_512 A#$l;M.3R  
    F5_160_512 7'+`vt#E  
    RemovableMedia 86%k2~L  
    FixedMedia EW]DzL 3  
End Enum /;_$:`|/  
tic 3a1  
Private Type DISK_GEOMETRY 0of:tZU  
    Cylinders           As LARGE_INTEGER ${Lrj}93  
    MediaType           As MEDIA_TYPE kX V  
    TracksPerCylinder   As Long ,pcyU\68v  
    SectorsPerTrack     As Long ~JZLWTEe  
    BytesPerSector      As Long FBNi (D  
End Type #NT~GhWFf  
O#tmB?n*  
'//private vars i8<5|du&?  
Private hDisk           As Long             'disk handle a3A-N] ;f  
Private lpGeometry      As DISK_GEOMETRY    'disk info |%4nU#GoB  
Private lBufferSize     As Long             'the buffer size of read/write i.9}bw 9u@  
+ o< 7*  
Public Function OpenDisk(ByVal FileName As String) As Boolean Gad&3M0r  
'// 打开磁盘 .dzw5R&  
    hDisk = CreateFile(FileName, _ ~RLjL"  
                        GENERIC_READ Or GENERIC_WRITE, _ ]UO zz1   
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ tQj=m_  
                        ByVal 0&, _ ^/2O_C  
                        OPEN_EXISTING, _ wOUCe#P|r  
                        0, _ V,ZRX}O  
                        0) v2|zIZ  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) pz2E+o  
End Function -0(+a$P7e  
4-O.i\1q  
Public Function CloseDisk() As Boolean '1!%yKc0  
'//关闭磁盘 K{y`Sb~k  
    CloseDisk = CloseHandle(hDisk) mmFcch$Jv  
End Function  :SFf}  
GF9iK|i/  
Public Function GetDiskGeometry() As Boolean 1 =?pL$+G  
'//获取磁盘参数 }f> 81[^  
    Dim dwOutBytes      As Long "=?JIQ  
    Dim bResult         As Boolean XPYf1 H  
     rDaiA x&  
    bResult = DeviceIoControl(hDisk, _ P Jb /tKC  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ F\+9u$=  
                                ByVal 0&, 0, _ v 'L"sgW6I  
                                lpGeometry, Len(lpGeometry), _ (Vey]J  
                                dwOutBytes, _ gd3MP^O1  
                                ByVal 0&) z@[n?t!7k  
     7<jr0)  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack /L,iF?7  
    GetDiskGeometry = bResult !OV+2suu1  
End Function ]mBlXE:Z  
$xvwnbq#y  
Public Sub GetDiskInfo(MediaType As Long, _ 2wU,k(F_  
                        Cylinders As Long, _ BI2'NN\  
                        TracksPerCylinder As Long, _ +L?;g pVE&  
                        SectorsPerTrack As Long, _ 'o]}vyz;  
                        BytesPerSector As Long) Pd:tRY+t/  
'//返回磁盘的参数 B%Oi1bO  
    MediaType = lpGeometry.MediaType s/?(G L+Ae  
    Cylinders = lpGeometry.Cylinders.lowpart 5'Mw{`  
    TracksPerCylinder = lpGeometry.TracksPerCylinder I-s$U T[p  
    SectorsPerTrack = lpGeometry.SectorsPerTrack aS3-A 4  
    BytesPerSector = lpGeometry.BytesPerSector Mn\L55?E(  
<O9WCl  
End Sub <c`,fd8  
W[!bF'- 10  
Public Property Get BufferSize() As Long  ">|L<  
'//返回每次读/写的缓冲大小 ^CwS'/fdN  
    BufferSize = lBufferSize ),;h  
End Property W*c^(W  
=w7k@[Bq  
5;{*mJ:F  
Public Function LockVolume() As Boolean ~O;?; @  
'// 将卷锁定 R{4[.  
    Dim dwOutBytes  As Long !H^R_GC  
    Dim bResult     As Boolean l5e`m^GK  
     g[2[ zIB=  
    bResult = DeviceIoControl(hDisk, _ #I yM`YB0  
                                FSCTL_LOCK_VOLUME, _ Qe[ai?iJkt  
                                ByVal 0&, 0, _ gO~>*q &  
                                ByVal 0&, 0, _ 1g!%ej jd  
                                dwOutBytes, _ n-9X<t|*?a  
                                ByVal 0&) aLevml2:T  
    LockVolume = bResult +],2smd@N  
End Function c1%ki%J#  
-J!k|GK#MX  
"(F:'J} X  
Public Function UnlockVolume() As Boolean blV'-Al  
'// 将卷解锁 USf;}F:-C  
    Dim dwOutBytes As Long ({rescQB  
    Dim bResult As Boolean TGP di5Eq  
     {flxZ}  
    bResult = DeviceIoControl(hDisk, _ az:lG(ZGw  
                                FSCTL_UNLOCK_VOLUME, _ K!jau|FS  
                                ByVal 0&, 0, _ ]N'4q}<5o  
                                ByVal 0&, 0, _ q[Y* .%~  
                                dwOutBytes, _ e]jzFm~  
                                ByVal 0&) +Y~,1ai 5^  
    UnlockVolume = bResult A- hWg;  
End Function b#e|#!Je  
$<wU>X  
i#lO{ ]  
Public Function DismountVolume() As Boolean Q!Dr3x  
'// 将卷卸下,使系统重新辨识磁盘,等效于重新插盘 %]DJ-7 xE  
    Dim dwOutBytes As Long AK;G_L  
    Dim bResult As Boolean 53 ^1;  
     tIX|oWC$q  
    bResult = DeviceIoControl(hDisk, _ b|Ed@C  
                                FSCTL_DISMOUNT_VOLUME, _ /i~n**HeF?  
                                ByVal 0&, 0, _ kZ_5R#xK  
                                ByVal 0&, 0, _ >>7m'-k%D  
                                dwOutBytes, _ .Wyx#9  
                                ByVal 0&) jK=-L#hz  
    DismountVolume = bResult G_p13{"IM  
End Function i V%tn{fc  
=uR[Jewa  
ZONe}tv:  
Public Function ReadDisk(ByVal Cylinders As Long, _ Yi"jj;!^S  
                    ByVal Tracks As Long, _ 9T;l*   
                    db() As Byte) As Boolean )vur$RX  
'//按柱面和磁道来读取磁盘数据 N'5!4JUI  
    Dim iPos    As Long 6v -2(Y  
    Dim lRead   As Long BYDOTy/%nJ  
     A^7Y%  
    iPos = Cylinders * Tracks * lBufferSize ! F&{I  
     [k + fkr]  
    If SeekAbsolute(0, iPos) Then u|8V7*)3  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) n;dp%SD  
    End If bO{wQ1)Z_  
End Function -/qu."9(B  
.!Q[kn0a  
Public Function WriteDisk(ByVal Cylinders As Long, _ ! +Hc(i  
                     ByVal Tracks As Long, _ ;@u+b0 j  
                     db() As Byte) As Boolean 0w l31k{  
'//按柱面和磁道来写磁盘数据 wmS:*U2sc  
    Dim iPos    As Long _Ai\XS Am  
    Dim lRead   As Long q(@hYp#O"3  
     == i?lbj  
    iPos = Cylinders * Tracks * lBufferSize 5E|/ n(  
     'v3> "b  
    If SeekAbsolute(0, iPos) Then 0SLn0vD!  
        WriteDisk = WriteBytes(lBufferSize, db()) /?8rj3  
    End If Oz,/y3_  
End Function ~_L_un.R  
qxwD4L`S  
;lb@o,R :  
'///////////////////////////////////////////////////////////////////////////////////// 78+PG(Q_M  
'//file system FU~:9EEx  
8-R; &  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean zw X 1&rN  
'//seek file i%_nH"h  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte z+@Jx~<i  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) 2}R)0][W  
    If LowPos = -1 Then b{d@:"  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) 93N:?B9  
    Else [318Q%W&  
        SeekAbsolute = True n|iO)L\9aB  
    End If 4~{q=-]V  
     r(qU~re'  
End Function yX8$LOjE  
ddjaM/.E  
1@0ZP~LTB  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean VJ(#FA2  
'//read data to array a)8M'f_z  
    Dim RetVal    As Long uod&'g{N  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) #PRkqg+|  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF 0~XZ  
    ReadBytes = Not (RetVal = 0) m]U`7!  
     *X lnEHv  
End Function V5LzUg]  
aTY\mKk  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean 1~q| %"J  
'//write data from array Q|o~\h<  
    Dim RetVal As Long t7DT5SrR  
    Dim BytesToWrite As Long nz]+G2 h  
    Dim BytesWritten As Long !n/"39KT  
     3+jqf@fO  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) )Wm:Ilq  
     fL&bN[XA"$  
    WriteBytes = Not (RetVal = 0) )b Ac U  
End Function rfMzHY}%  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
92楼  发表于: 2015-09-06   
这才是我当年写出的一个比较烂的程序 (a i&v  
4HK#]M>yz  
Main2.bas L Y^pmak  
mMvt#+O  
Attribute VB_Name = "SubMain" #Hr>KQ5mJQ  
Option Explicit ~O}LAzGb  
4`7:gfrO,  
'采集文件与临时文件 H?>R#Ds-  
Public Const TmpFile As String = "d:\30-0600.dat" 9q -9UC!g  
'已有数据:30-0600.dat /30日早6点进车与6:30出车头 v9OK <  
qG%'Lt  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long .qCD(XZ+  
Public hBCFile As Long  '记录采集参数的文件 5l"v:Px  
Public Const TmpBMP As String = "d:\1.bmp" q~=]_PMP  
Public hTmpFile As Long AA um1xl  
#}W^d^-5t5  
rBZ 0(XSZQ  
'采集窗口参数常量 *1KrI9i  
Public Const FrameH As Long = 280& Rs cU=oaKi  
Public Const FrameW As Long = 768& y  ZsC>  
Public Const pFrameSize As Long = FrameW * FrameH bgjo_!J+Pp  
Q_F8u!qrZ  
'标志区范围,用于识别车辆 eZm,K'/!  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X Hb;#aXHSd  
Public Const mkW As Integer = 28  '识别标志立柱宽度 Q0_UBm^f  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) Vn6g(:\w  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) \]W*0t>s  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 f6ad@2  
'车缝检测位置常数 viT/$7`AI  
Public Const sSize As Long = 32& xCMcS~ 3/  
Public Const sPos As Long = 310& bi bjFg   
Public Const sPosL As Long = 200& vo[Zuv?<h  
Public Const sPosR As Long = 500& T0ebW w  
'车缝检测框位置 Q!:J.J  
Public Slice(1 To sSize, 1 To FrameH) As Byte /K"koV;  
Public SliceL(1 To sSize, 1 To FrameH) As Byte !;^sIoRPV  
Public SliceR(1 To sSize, 1 To FrameH) As Byte afcI5w;>}  
Public avSL As Integer, avSLR As Integer, avSLL As Integer N(W ;(7  
[g:ZIl4p\P  
_kb $S  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析,比使用二维数组更便于VB编译优化 z5v)~+"1  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 VMUK|pC4 K  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 ~ b ;%J:  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long h p]T^  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte SAt{At  
'前后帧左右上角128列*8行像素块,根据平均值差绝对值判断进车方向  IR,`-  
Uzb~L_\Rmt  
MGd 7Ont  
uf (`I  
'一次连续采集的帧数 G:QaWqUb  
Public tFrames As Long dw8Ce8W  
M3350  
'在采集卡申请的缓存中,是按帧为单位的,每一帧包含奇偶场两场的数据 R*D0A@  
'而该卡的硬件设置是按场采集,只需要读第一场的数据即可。 d3AOuVUf  
'所以要设置的缓存帧的大小是frameW*frameH*2,而一场的数据量为pFrameSize `2y2Bk  
$e7dE$eH  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte <8>gb!DG  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte '@h5j6:2  
Public pWorkSpace(1 To FrameW * FrameH) As Long >v9 ("  
Public Const pBufferSize As Long = FrameW * FrameH * 2 Yqy7__vm  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 I_IDrS)O  
Tt.wY=,K  
Public hBoard As Long   '采集卡标识 H\7Qf8s|{  
Public mBufferAddr As Long  '缓存地址 wPYz& &W  
Public BufferSize As Long  '缓存大小(字节) Lc!% 3,#.  
Public iCurrentCard As Long QcGyuS.B  
Public CapStatus As Long 3eqnc),Z  
Public iFrames As Long G-[fz  
Public currentBr As Byte, currentContr As Byte PYYOC"$  
X/fk &Cp  
Public hMEM As Long, mStatus As Long _ a|zvH  
Public Const hMemSize As Long = pFrameSize * 4 ,25Qhz]  
Public hMemWork As Long CfA^Xp@vc  
Public Const hMemWorkSize As Long = pFrameSize * 5 mVN^X/L(y  
N*N@wJy:5  
xZ} 1dq8  
NZSP*#!B  
'串口接收轨道衡数据 W~J@[email protected]  
Public WeightFromCom As String SNB >  
Public bReceiveComplete As Boolean 4 e1=b,  
A=/|f$s+  
18pi3i[  
Public Type GrayBMPHeader *4;MO2g  
  Tag As Integer y-gSal  
  FileLength As Long    '文件大小 QXnL(z  
  Reserve1 As Long *wcb5p  
  DataOffset As Long    '图像数据偏移量 V^WR(Q}  
  BMPHeaderSize As Long  '文件头长 b/='M`D}#G  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… L<encPJt  
                        'the following sizes are possible: C d)j %  
                        '28h - windows 3.1x, 95, nt, … _ 6"!y ]Q  
                        '0ch - os/2 1.x AXhV#nZt0  
                        'f0h - os/2 2.x K)c` G_%G  
xJ)hGPrAl  
  ImageWidth As Long           '图像宽(像素数) G/Nb@pAy[  
  ImageHeight As Long          '图像高(像素数) GpV"KVJJ/  
  PlaneNumber As Integer  '图像层数 -ckk2D?  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap rYbb&z!u  
                                        '4 - 16 color bitmap 9pD=E>4?#  
                                        '8 - 256 color bitmap o/bmS57  
                                        '16 - 16bit (high color) bitmap p=vu<xXtD  
                                        '24 - 24bit (true color) bitmap y{ReQn3> y  
                                        '32 - 32bit (true color) bitmap )>$@cH  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) u;m[,  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) U)%gzXTZ%  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) 2B{~ "<  
                                    '3 - bitfields (also identified by bi_bitfields) tY^MP5*  
  IMAGESIZE As Long  '图像数据字节数 6H,n?[zTt  
  hResolution  As Long  '水平分辩率  像素数/米 sHx>UvN6  
  vResolution  As Long  '垂直分辩率 L$^ya%2  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 z{w!yMp"  
  ImportantColors As Long ."<mL}Fi(  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 8_6\>hW&  
End Type vq|o}6Et  
s)ymm7?  
lL.3$Rp;  
^fT|Wm<  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader 5_@ u Be~  
Public sRECT As RECT h=uwOi6}  
!%<bLD8  
Ly1V@  
Public conn As ADODB.Connection &R:$h*Wt|  
Public rsTrain As ADODB.Recordset \*Ro a&<!  
Public rsOperater As ADODB.Recordset E(F<shT#  
Public rsGoods As ADODB.Recordset 2yk32|  
Public rsGood2 As ADODB.Recordset a%a_sR\)  
Public rsSender As ADODB.Recordset h0ufl.N_%  
Public rsReceover As ADODB.Recordset |[/[*hDZ9  
Public rsTrainTMP As ADODB.Recordset n$n)!XL/  
m0+X 109  
u6{= Z:  
'打开采集卡 z;GR(;w/  
'设置参数 |X/ QSL  
'设置为实时单帧采集到缓存方式 ;q&6WO  
'由另一线程查询采集状态,如果完成采集,传送至用户数组分析或保存 D3s]49j)  
7yGc@kJ?  
S3rN]!B+  
Sub Main() hm"i\JZ3N  
  Dim i As Integer, status As Long ]5X=u(}  
     }=CL/JHz  
   InitBMPinfo 3[plwe  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 <QoSq'g#,=  
    BMPHeader.Tag = &H4D42 E?1"&D m  
    BMPHeader.ImageWidth = FrameW rcUXYJCh-  
    BMPHeader.ImageHeight = FrameH [;3` Aw  
    BMPHeader.BMPHeaderSize = &H28 ;*K@8GnU  
    BMPHeader.PlaneNumber = 1 zWYm* c"n\  
    BMPHeader.bpp = 8 AV\6K;~  
    BMPHeader.Compression = 0 Gj^JpG  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 !e?g"5r{Bv  
    BMPHeader.vResolution = &H1274 J0@<6~V6o  
    BMPHeader.ColorsinBMP = 256 ]3Z?Q  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP x#ub % t  
    BMPHeader.DataOffset = Len(BMPHeader) #?/&H;n_8S  
    For i = 0 To 255 Fdsaf[3[v  
      BMPHeader.Pallate(i) = RGB(i, i, i) EY=`/~|c  
    Next i SXfuPM  
    BMPHeader.IMAGESIZE = FrameH * FrameW #jAlmxN  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE B -XM(C j  
x9Veg4Z7  
MYgh^%w:  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) 1 oq5|2p  
     42X N*br  
    BMP1.ImageWidth = FrameW $ Fx:w  
    BMP1.ImageHeight = FrameH * 2 jU\vg;nr  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight \~|+*^e)  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE <smi<syx  
Gq_rZo(@  
  '确定标志位置,为pilarX, pilarY确定初始值 q 65mR!)  
   PilarW = mkW `NqX{26GV+  
   PilarH = mkH  '此两项为固定值 56k89o  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) \8v{9Yb  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 o";5@NH  
   k*)O]M<,  
   wg<UCmfu!  
  '连续采集记录文件 tW4|\-E"s4  
  ' 建立一个缓冲区为页对齐方式的文件 8zv=@`4@G  
  If Dir(TmpFile) <> "" Then (\^| @  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ n]$50_@  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) =SJwCT0;  
    ' 在95/98中,如果打开文件时没有声明overlapped方式,在读定文件时就不能使用overlapped参数项 gFR9!=,/V%  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 +L(0R&C  
  Else wLyQ <[$  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ VhdMKq~`  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) P%`|Tu!B  
  End If Ml`tDt|;  
  If hFile = 0 Then fx &b*O C  
    MsgBox TmpFile & ": File Open Error", vbOKOnly jiS|ara"  
    Exit Sub :<$B o  
  End If * 7: )k  
  '采集参数记录文件 4 [2^#t[  
hBCFile = FreeFile() _&!%yW@  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile !QK ~l  
   6[g~p< 8n}  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 ~Pq(Ta  
If hMEM = 0 Then 6%  +s`  
    fStatus = GetLastError X2>qx^jT  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ u~MD?!LV  
     & "请向技术人员报告该错误代码。", vbOKOnly gd~# uR\  
    CloseHandle hFile Jj=0{(X  
    Exit Sub F/c 7^  
End If &?\ 'Z~B4  
KLqn`m`O;  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) LgN\%5f-  
If hMemWork = 0 Then $FV!HD  
    fStatus = GetLastError (#6E{@eq  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ 'BY{]{SL  
     & "请向技术人员报告该错误代码。", vbOKOnly x8H%88!j*  
     '释放已成功分配的内存 NHKIZx8sR  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) WVaIC$Y  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) 6*3J3Lc_<  
     Q2[@yRY/z  
    CloseHandle hFile ~ KNdV  
    Exit Sub t[Dg)adc  
End If So &c\Ff  
$6\-8zNk  
' Test writing Ul@ Jg    
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& e_3KNQ`kA  
     d5?"GFy  
   '初始化采集卡参数 8SmtEV[b3  
   iCurrentCard = -1 \wW'Hk=  
   hBoard = okOpenBoard(iCurrentCard) fNz*E|]8&  
   Debug.Print hBoard hZ_0lX}  
   If hBoard = 0 Then P} =eR  
      ExitGrabber )U4h?J  
      End moO=TGG;F  
   End If a o_A %?Ld  
   okGetBufferSize hBoard, mBufferAddr, BufferSize .{6?%lt  
   If mBufferAddr = 0 Then JN;92|x  
     MsgBox "缓存不存在!" uM3F[p%V^  
     ExitGrabber -cW`qWbd  
   End If dxm_AUM  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) 9y/gWE  
   /9/svPc]  
   \Kh@P*7  
   currentBr = 128: currentContr = 128 \@]/ks=K  
   '设置视频输入参数 Of| e]GR  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 GtZkzVqLd  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input OE,uw2uaT  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 XI6LPA0%  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 YDEUiZ~  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 yP:/F|E$  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 A)I4 `3E  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行(低字)同步开槽(高字) /0|niiI  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移,低字X偏移 (144/44经验值) V,>_L  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小:低字X高字Y (768/576采集卡最大值) $.Fti-5  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 nsChNwPX  
   "X/cG9Lw  
   '设置采集参数 cZ$!_30N+  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 6*@\Qsp615  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 7/c[ f  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 "]BefvE  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 /rRQ*m_  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 " bHeNWZ  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 /($!("b  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 w3j51v` 0'  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 rx^vh%/ Q!  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 *ml&}9  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 pPztUz/.  
   'Buffer Block Size不用设置,而用okSetTargetRect函数进行动态调节 1iOQ8hD  
   *h ~Y=#`8*  
   6 isz  
   okCloseBoard hBoard .BLF7> M1  
   Sleep 50 ,,+ ~./)  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 f@roRn8p?  
   :v/6k  
   '设置数据传送方式 )IIQ{SwQq  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 ]s lYr8m  
   '该设置对本程序无意义,因为程序直接用CopyMemory方法读缓存,而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 @d5G\1(%  
   UloZo? e`  
   sRECT.Right = -1   '用于获得当前设置值 rV LUT  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) i*16k dI.  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom D} Jhg`9  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 $#V ^CmW.  
   sRECT.Left = 0 F">>,Oc)U"  
   sRECT.Top = 0 !A>VzW  
   sRECT.Right = sRECT.Left + FrameW @uc N|r}=R  
   sRECT.Bottom = sRECT.Top + FrameH * 2 pa0'\  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) mPR(4Ol.  
   %y zFWDg  
   sRECT.Right = -1   '检查新设置值 {V& 2k9*  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) ag6hhkj A  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom r30t`o12i  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) M,Y lhL  
   ypxqW8Xe  
   If TESTSignal = False Then U].u) g$  
      'ExitGrabber ,6[}qw) *  
   End If o6e6Jw  
   \-c8/=  
   kqYvd]ss  
   B"O5P>  
   '设为实时采集状态 8.e k_ r  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) _#c ^z;!  
   a$p2I+l X  
   s^_E'j$  
   '单帧采集 &JoMrcEZ  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 #k%3Ag   
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) )N QtjB$  
   okCaptureTo hBoard, BUFFER, 0, 1 'single nU"V@_?\  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 a7G0  
   '   Sleep 20 :j/PtNT@  
   'Loop 4_,l[BhsQG  
   okGetCaptureStatus hBoard, True c"+N{$ vp  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize M4a- +T"  
   '写入768*576测试图象 ],r?]>  
   ArrayToBMP TmpBMP xN t  
   -C$Z%I7 0  
   '打开数据库 x/$s:[0B#  
   Set conn = New ADODB.Connection 02]9 OnWw  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ cK.T=7T  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ <DS+"#  
      "; Mode=Read|Write" UXB[3SP  
   conn.Open 9E{Bn#  
   qlUYu"`i  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) \mZ\1wzn'{  
   frmRecord.Visible = True 5G8 `zy  
   frmQuery.Visible = True A%u@xL,_  
   Load frmReceiveFromComm [c?']<f4  
   SM:SxhrGt  
   '调试参数 0D1yG(ck  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then ZIAiVq2)  
     SignalBox.Visible = True Xq&x<td  
   End If x>Ah4a d  
   If InStr(UCase(Command()), "/COMM") > 0 Then YBgHX [q  
     frmReceiveFromComm.Visible = True Y[8w0ve- g  
   End If g j`"|  
Fz+0h"  
End Sub nbYkr*: "t  
pk'@!|g%=  
Sub ExitGrabber() U5mec167  
  '关闭数据库 FAu G`zu  
  '关闭采集卡 ~Z5?\a2Ld  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) :)nn/[>fC  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) T6f{'.w  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) t" 1'B!4  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) to Ei4u)m  
  okStopCapture hBoard &/ lJ7=Nq  
  okCloseBoard hBoard d#T8|#O"  
  CloseHandle hFile n<:/ X tE  
  Close #hBCFile '3uj6Wq2  
  conn.Close zx\N^R;Jq  
  End  P9J3Ii!  
End Sub 9d2#=IJm  
>vg!<%]W ]  
Function ArrayToBMP(ByVal File As String) [|{yr  
Dim BytesWrite As Long `$`:PT\Zv4  
MBCA%3z08  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ Pf oAg*  
  CREATE_ALWAYS, 0&, 0&) 5| 2B@6-  
8eP2B281  
If hTmpFile = 0 Then uPe4Rr  
   ArrayToBMP = False 0_bt*.w I+  
   Exit Function aDa}@-F&a  
End If S=lA^#'UdX  
z) 5n&w S  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN ok X\z[X  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& 8xmw-s)  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN U'LO;s04m  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& G?QFF6)}!  
3m4?l ~  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN k>{i_`*  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& I=hgfo  
@M4~,O6-  
If BytesWrite < pFrameSize Then Sm#;fx+  
  ArrayToBMP = False bIizh8d?  
End If mM~!68lR  
7|6tH@4Ub  
CloseHandle hTmpFile K G~](4JE(  
*Rshzv[  
End Function %dZD;Vhg  
c> K/f7  
Function ArrayToBMP1(ByVal File As String) .Gl&K|/{j  
9Q :IgY?T  
Dim BytesWrite As Long |aN0|O2  
tBG :ECUL  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ !mL,Ue3/  
  CREATE_ALWAYS, 0&, 0&) fRT: @lV  
xy$FS0u  
If hTmpFile = 0 Then \E.t=XBn  
   ArrayToBMP1 = False <Q=ES,M  
   Exit Function 5fb,-`m.  
End If ~0?p @8  
5h[u2&;G  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN }M/w 0U0o  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& L4sN)EI  
QN-n9f8  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN k`js~/Xv  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& 6K P!o  
MCQ>BP  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN )T#;1qNB  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ^Gv<Xl  
,@!8jar@w}  
If BytesWrite < pBufferSize Then c i7;v9  
  ArrayToBMP1 = False nx=#QLi  
End If K_`*ZV{r  
iCN@G&rVw  
CloseHandle hTmpFile 2Z@<llsi  
$E|W|4N  
End Function uGl0z79  
<Xy8}Z`s  
'使用该过程建立的文件要求在用后关闭  -/  
Public Function ArrayToBMP2(File As String) As Boolean !U>"H8}dv  
N(&FATZUW  
Dim BytesWrite As Long Xkl^!,  
/db?ltb  
ArrayToBMP2 = True J+\F)k>r  
D4'? V Iz  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ T-&CAD3 ,O  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) 8<P$E!  
r_xo>y~S  
If hTmpFile = 0 Then '*>LZo4  
   ArrayToBMP2 = False (Wq9YDD@  
   Exit Function |[K7oa~#  
End If TFxb\  
`P/*x[?  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN =[{Pw8['  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& j`BF k>  
i*_KHK  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN kRiWNEw  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& R)cns7oW  
W~k!qy `  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN '! 1ts@  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& ^&&dO*0{  
-xXNzC   
If BytesWrite < pFrameSize Then K?[pCF2C  
  ArrayToBMP2 = False zwU8iVDe  
End If NG'VlT  
%~p_bKd~  
CloseHandle hTmpFile ,_rarU)[J  
@+1E|4L1vf  
End Function 4Bx1L+Cg  
d?N"NqaN  
Private Function TESTSignal() As Boolean  8k J k5  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long RMC|(Q<  
}C*o;'o5G  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) S$+ v?Y`)  
T|.Q81.NE  
If extsign = 1 Then #j-,#P@  
   TESTSignal = True ";s5It  
Else )SA$hwR  
    If extsign = 0 Then %hrv~=  
        MsgBox "无视频输入信号,检查摄像机电源!", vbOKOnly +1d\ZZA|6&  
        TESTSignal = False +8^9:w0}  
        Exit Function 1AE/ILGo  
    End If YfMe69/0I  
End If 20?i4h_  
F5 LQgK-z  
'测试视频输入类型 f=K1ZD  
'video type -&)^|Atm  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 h!K B%4V  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) `zzX2R Je  
If videotype = 1 Then o95O!5 hl  
        '"隔行信号(Interlaced)" MCh8Q|Yx4  
Else {+xUAmd  
   If videotype = 0 Then Qmn5umd=?\  
       '"逐行信号(Non-interlaced)" ,xD{A}} V  
   Else Z~?:r  
     If videotype = -1 Then 1xguG7  
       ' "不支持" k 5"3*  
     End If )sV# b  
   End If 3]N}k|lb%  
End If G)# ,39P  
h*MR5qa  
'测试垂直扫描线数 tB_V%qH  
'video scanlines S_bay8L1  
scanlines = -1 e982IP  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) W$'pUhq\H  
    If scanlines = -1 Then -m|b2g}"3  
        ' "不支持" l42m81x"  
    Else J$e.$ah;  
        'Trim(Str(ScanLines)) + " 行数/幅" Czv lZDo  
    End If w|L~+   
N7oMtlvL[w  
'测试帧频 On'3K+(_  
'video field frequency ?G?=,tV  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) J.<eX=<  
    If fieldfrq = -1 Then p,tB  
        'lblSignal(8) = "不支持" i[\[xfk  
    Else =rBFMTllM  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" 22BJOh   
    End If ,x Tbt4J  
End Function }2NH>qvY  
raqLXO!j  
U~H'c p  
Sub PicIdentify() d:pp,N~2o  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 21o_9=[^  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 "~V}MPt  
'判定标准:如果在立柱位置上有明显的模式反差,则视为车皮之间的间隔 "L8V!M_e  
'方法:对立柱标志区进行平均值二值化,面积为32*40,亮区(255)与暗区(0)的亮度平均值理论差大于200倍,实际差值应不小于100倍 \^#1~Kx  
HO@T2t[  
  Dim fPTR As Long, cFrame As Long BB%(!O4Dl  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer L//sJe  
     gE ,j\M*  
Ap!UX=HBb  
cFrame = 0 COHJJONR  
8fe"#^"sR  
mKsj7  
Do While cFrame < tFrames tjd"05"@:  
   }MIH{CMH  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) ESomw  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&) ZH0f32K  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize 3LXpe8$lJ  
   b8]oI"&G  
  frmRecord.RText.Text = Str(cFrame) O"#`i{^?2  
  frmRecord.RText.Refresh rq F PUp  
       zr[~wM  
  If CheckMark = True Then u^]yz&9V  
   ArrayToBMP TmpBMP Q5<vK{  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) xJ"Zg]d{  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" D~?kv yJ  
   25ayYO%PTc  
   DrawSlice 6~!YEuA  
   mefmoZ  
   'i = MsgBox("检测到立柱:第" & Str(cFrame) & "帧", vbYesNo) jSG jv>  
   'If i = vbNo Then  ]Ea7b  
   '  Exit Do  Nl_;l  
   'End If M`>W'<  
   'cFrame = cFrame + 1 *z+\yfOO"  
   <khx%<)P  
  End If F}AbA pTv  
  DoEvents )(:+q(m  
  cFrame = cFrame + 1 D EUd[  
Loop lgkl? 0!  
End Sub 9SRfjS{7  
laUu"cS  
c N02roQl  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean lj " Z  
0On? {Bw  
'如标志区模式反差存在则为TRUE,否则返回FALSE E3 ~,+68U  
a)3O? Y  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long sBP}n.#$  
CheckMark = True )z2|"Lp  
   Af2=qe  
'复制标志区 g,t3OnxS?  
For i = 1 To mkH _'! aj +{  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW 0t#NMW  
Next i JC c N>DtP  
N5pinR5 H  
For j = 1 To PilarW * PilarH / 2 ]}mly` Fw  
   mTop = mTop + MKpilar(j) ,s1&O`  
Next j 'GEBxNH:  
L.C ^E7;Z_  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH xoqiRtlY:  
   mBot = mBot + MKpilar(j) wF|0n t  
Next j  G0_&gx`  
@k=cN>ZMc  
mTop = mTop / PilarW / PilarH * 2 ,N;))3  
mBot = mBot / PilarW / PilarH * 2  /6+1{p  
CCbkxHMf|!  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 fH{9]TU_:  
"C_T]%'Wm  
'平均值极值化 uL2" StW  
  For j = 1 To PilarH * PilarW 1%$d D 2  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) l,*yEkU  
  Next j P'a0CE%  
   LYd}w(}  
mTop = 0: mBot = 0 5SoZ$,a<e  
For j = 1 To PilarH * PilarW / 2 ES^>[2Y  
  mTop = mTop + MKpilar(j) cZNi~  
Next j E S#rs="  
1^Kj8*O8e  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW ZWf-X  
  mBot = mBot + MKpilar(j) ?8 SK\{9r6  
Next j 6B7<  
GY oZ$p"C  
zq,iLoY[R  
  mTop = mTop / PilarH / PilarW * 3 eq^TA1>T  
  mBot = mBot / PilarH / PilarW * 3 38[)[{G)Hv  
   BQyvj\uJ  
C>*5=p|T  
If mBot > iWhite And mTop < iBlk Then H7{Q@D8  
  CheckMark = True 'M~BE\  
Else |ZS 57c:  
  CheckMark = False cU7rq j_  
End If z=ML(1c=  
End Function aQ(`6DQv  
G 6Wx3~  
Sub Capture1Frame() c u\ls^  
   okCaptureTo hBoard, BUFFER, 0, 1 'single RY9+ 9i  
   okGetCaptureStatus hBoard, True M (+.$uz  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize :z B}z^8-  
End Sub W[@i;f^g  
p]wP36<S!  
kP)YgkE  
Sub CopyMark(iBlk As Integer, iWhite As Integer) k/df(cs  
'复制标志区并返回标志区暗区与亮区的亮度平均值 mgy"|\]  
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 @@' nit  
   Q Oz9\,C  
'复制标志区 T#\p%w9d  
For i = 1 To mkH .CVUEK@Z4  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW U{73Xax  
Next i }X=87ud  
,VPbUo@  
For j = 1 To mkW * mkH / 2 HH"$#T^-  
   mTotal = mTotal + MKpilar(j) %oAL  
Next j - G8c5b[  
Wm<z?.lS  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 D`~JbKV5@^  
,5/V@;i  
mTotal = 0 #2h+dk$1  
For j = mkW * mkH / 2 + 1 To mkW * mkH +IG1IF  
   mTotal = mTotal + MKpilar(j) o[o:A|n  
Next j ddo ST``G  
sT)6nV  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度  M{] e5+  
D,MyI#  
'背景亮度 N*~_\x  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW }c} ( 5  
  For i = 1 To 4 * FrameW kt :)W])V  
    bsTotal = bsTotal + BsLine(i) >4,{6<|  
  Next i C1V# ?03eI  
  bsAV = bsTotal / FrameW / 4 #:$O=@@?M  
' nMApPl  
End Sub 3DH.4@7P  
#;d)?  
1<`9HCm  
Sub AdjIMGbright(Optional bInit As Boolean = True) _)Qy4[S=d  
6 ^Ph '  
  '自动调节亮度与对比度,此时处于无车辆状态(白天特别高,而夜间特别暗) N6h1|_o  
  '图像平均亮度白天不高于200(当车辆通过时可能会下降到100左右),不低于100 Y5HfN[u^7  
  '            夜间不高于80(过高时通常是由于雪花噪声引起),但立柱不低于30 9u?(^(.  
     I[ai:   
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer jRofG'  
   ,!`SY)  
  '按标准亮度与对比度采集一帧,确定背景亮度 2-~a P  
  currentContr = 128   '初始对比度 Hz E1r+3Q@  
  currentBr = 128   '初始亮度 N;<//,  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 \3r3{X _<`  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 \ZS\i4  
  DoEvents "LOnDa7E^  
  Capture1Frame 8)sg_JC  
  '获得图像上缘4行象素 sYI~dU2H  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW xS"$g9o0  
  CopyMark iBlack, iBright   '图像标志区亮度 G-arnu)  
  For i = 1 To 4 * FrameW WM/#.  
    bsTotal = bsTotal + BsLine(i) !L77y^oV  
  Next i T'8RkDI}-  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 8 4z6zFv?Q  
   v51EXf  
  Select Case bsAV ]pWP?Ws  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 WE")xhV6  
       currentBr = 150 +O'vj  
       currentContr = 60 oAY_sg+  
     Case 61 To 80   '有可见背景 )!cI |tovs  
       currentBr = 140 ):krJ+-/y  
       currentContr = 70 =HMmrmz:  
     Case 81 To 100  '有清晰背景 i`+B4I8[  
       currentBr = 128 S."7+g7Ar  
       currentContr = 80 Tj`yJ!0  
     Case 100 To 150  '有明亮背景 GJX4KA8J  
       currentBr = 140                '5:30-6:00钟实测数据 gA_krK ,Z  
       currentContr = 50 BBvZeG $Y  
     Case 151 To 180 s|Zx(.EP  
       currentBr = 130 &Cq{ _M  
       currentContr = 60 } &1Iyb  
     Case 181 To 220  '背景全为白色 _ENuwBYW-  
       currentBr = 110 ;+ G9-  
       currentContr = 130 v Xb:  
     Case 221 To 255  '背景全为白色 Te;gVG*  
       currentBr = 100 m=QCG)s  
       currentContr = 100 @&5A&(  
  End Select =N_,l'U\^  
   :7\9xH  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 &s:=qQa1  
        Case 100 To 150 eaQ90B4  
          currentBr = currentBr - 10 k^^:;OR  
        Case 151 To 255 PPa^o8jd  
          currentBr = currentBr - 20 AliRpxxd  
  End Select Z v4<b  
   7IW> >RBF  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 O-j$vzHpdY  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 R uLvG+  
End Sub E:FO_R(Xq  
2Pp&d>E4  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer) .j U Z  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long %w7m\nw@  
     "x&3Z @q7  
    For i = 1 To 8 -u|l}}bh  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& kg3ppt  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& hq?jdNy :  
    Next i L~dC(J)@ZI  
      5@ foxI  
    For j = 1 To 1024 azo0{`S?  
      L1 = L1 + LeftBK(j, 0) khAqYu" )  
      L2 = L2 + LeftBK(j, 1) }~Q5Y3]#~  
      R1 = R1 + RightBK(j, 0) ?>V6P_r>  
      R2 = R2 + RightBK(j, 1) B;!f<"a8  
    Next j |) Pi6Y  
    diffL = Abs(L1 - L2) / 1024 7 jjU  
    diffR = Abs(R1 - R2) / 1024 w>qCg XU3  
End Sub f jI#-  
(;}tf~~r  
Function CheckSlice() As Boolean b{RqwV5P  
  CopySlice avSL, avSLR, avSLL =Y9\DeIZ  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then h>wcT VF  
    CheckSlice = True x l0DN{PG  
  Else <qhBc:kc  
    CheckSlice = False &x0C4Kh  
  End If ^Dr.DWi{$  
End Function PKA }zZ  
;xK_qBIP  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) C0fmmI0z~  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long ` U{mbw,  
  For i = 1 To FrameH 5 lTD]d  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize :Q_x/+-  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize cXN _*%  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize $b>}C= gt  
  Next i &aPl`"j  
  For i = 1 To FrameH Ax!Gu$K2o  
    For j = 1 To sSize :[sOKV i  
       total = total + Slice(j, i) m=TJDr-  
       totalL = totalL + SliceL(j, i) z/1{OL  
       totalR = totalR + SliceR(j, i) ?z/Vgk+9|  
    Next j aI(>]sWJ  
  Next i  i-W  
  avSL = total / FrameH / sSize gi]ZG  
  avSLR = totalR / FrameH / sSize m&IsDAn  
  avSLL = totalL / FrameH / sSize Q> 8pP\ho  
End Sub TJaeQqob  
)`8pd 7<.  
Sub DrawSlice() 5j{Np,K  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B D|_V<'  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B ([ dT!B#aH  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B @T& t.|`  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) zX kx7d8  
End Sub H{V)g  
Sub DrawMark(pic As Control) \DA$6w\\  
   Dim i As Long, j As Long 3]U]?h  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B >fzwFNdo  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B (ZP87Gz  
   For i = 1 To PilarH +;q.Y?  
     For j = 1 To PilarW K>1X}ZMdD(  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) uLN[*D  
     Next j 9s`/~ a@  
   Next i #U=;T]!'$  
End Sub alm- r-Kb3  
pm US F #u  
Function avIMG() As Integer J!h^egP  
  Dim i As Long, j As Long, totalIMG As Long o>c ^aRZ{  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize <\@ 1Zz@ms  
  For i = 1 To pFrameSize &Y7C0v  
    totalIMG = totalIMG + pBuffer(i) !QEL"iJ6M'  
  Next i = .oHnMX2M  
  avIMG = totalIMG / pFrameSize Ht[{ryTxu  
End Function '{ f=hE_/  
}nud  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer '#Dg8/r!  
  Dim i As Long, j As Long, totalIMG As Long W f@t4(i  
  For i = 1 To FrameH /N)5 3!LT  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth [f!O6moR6  
  Next i # |^^K!%  
  For i = 1 To FrameH * barWidth ?znSx}t  
    totalIMG = totalIMG + pBuffer(i) Ct]A%=cZW  
  Next i 8]< f$3.  
  avRegion = totalIMG / pFrameSize ?4[H]BK  
End Function @Bs0Avj.  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

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

一共这么多文件。 T7lj39pJq  
,+ \4 '`  
这是我用VB写出的最大的程序,也是用API最多的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
94楼  发表于: 2015-09-06   
拍下的火车 z)&naw.  
第6车皮 4/HY[FT  

K9C@dvFH  
k(-Z@   
第9车皮 J}) $  
sP6 ):h  
  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

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

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

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

W>p\O9BG  
5E]UI YAkV  
这个地方现在已经变化很大了。以前紧靠山东农科院的实验田
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

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

显示用户信息 
98楼  发表于: 2021-01-02   
继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ? f![xn2T  
-d|BO[4j  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
99楼  发表于: 2021-07-18   
继续填个坑: ~8jThi U  
**T:eI+  
用VBA控制WORD自己修订学生毕业文的格式。 %:" RzHN  
杺栫杣杊椌柮栬,䒴蓉艿芖。
描述
快速回复

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