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

显示用户信息 
80楼  发表于: 2015-09-05   
引用
引用第20楼newport93于06-14-2010 13:47发表的  : "n e'iJf_(  
g.]'0)DMW  
老五,I 服了U。 m2! 7M%]GC  
h |H;ZC(B  
哪一天等俺退休了,也写一个The Non-Progamming career of an ex-programmer。哈哈哈。。。。。 Sy'>JHx  
y2U:( H:l!  
E\zhxiI  
新港妹妹,虽然你还没有退休,但是孩子读了大学你应该有些时间了嘛!就开帖写吧!我们很想看啊! 也特别想看看你的non-programming career中的恋爱史啊! -Fd i,\e  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
81楼  发表于: 2015-09-05   
引用
引用第3楼阿散于03-19-2010 22:49发表的  :  d!t@A  
Is that what you wanted to express yourself to us with the whole blank message but the very big title? Z:v1?v  
C|I 1 m  
:=Q|gRTL*  
阿散这个家伙,已经被我全局禁言了,但是在他不犯错的时候,也还是个很好玩的同学。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
82楼  发表于: 2015-09-05   
引用
引用第6楼沧桑于06-13-2010 14:39发表的  : *[H+8/n_  
老伍在写交代材料啊,而且写在一个ZT的贴下,哈哈。 3+-(;>>\  
LU{Z  
%5G BMMn  
这不是怕您见笑嘛!现在露馅了,只得继续招供了。 wuzz%9;@B  
8UIL_nPO  
可以从宽不?
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
83楼  发表于: 2015-09-05   
引用
引用第10楼卡拉于06-13-2010 21:49发表的  : (U_Q7hja?  
老伍,对不住,我把你原来的英文标题改了,太不吸引人眼球了,有些人还当是英文的都不会去点击。我通篇读了一下,改成了现在的标题。如果你不喜欢,可以改回来。 m0Syxb  
L"iyjL<M  
O->eg  
其实标题没有什么,卡总既然改了就不必再改回了。 ql~{`qoD~  
Fnpn_O XlH  
主要是当初写的时候真是顶着锅盖写的。 2&0<$>  
z#Vp S=  
阿散说得对。我就是把一堆鸡毛蒜皮的小事,用了一个big title.
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
84楼  发表于: 2015-09-05   
引用
引用第16楼阿平于06-13-2010 22:25发表的  : z|]oM#Gt  
哦, 打倒忽悠大家的家伙.      !mxh]x<e  
:"P hkR  
@B'8SLoP  
阿平姐,这可不是忽悠,我可是认真交待经历呢!
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
85楼  发表于: 2015-09-05   
引用
引用第17楼阿散于06-13-2010 22:29发表的  : <`xRqe:&9  
每个人的故事对其他人都是故事, R;E"Qdt  
自己的故事也是其中之一. + %#MrNM'  
跳出来看, Gr#rM/AfCK  
不过是众人中的一个人的故事. 03QEXm~|Q  
jqGo-C~  
所以,接着听故事. /GuS IZg"_  
^?X ^+  
女人们有兴趣的就等老伍开个新帖或者跟贴, aT1CpY=T|.  
听他痛说恋爱革命历史.... JNFT6T)T15  
{#*?S>DA  
杂家接着听他自学程序员历史, UI<PNQvo9  
高级程序员考了吗? nG ^M 2)(8  
'^ e/F)0  
6Sb'Otw.  
这个恋爱革命史还是等你痛改前非换个新ID来讲吧! J7?)$,ij%  
B~!G lT  
我什么程度员也没有考过,连大学生的计算机应用等级证明都没有。 L.0} UXd  
^[seK) S=  
我唯一考过的计算机科目是职称评审时要求有证书,所以我用了半小时考了word, powerpoint,和internet基础。都是小儿科的东东。如果没有用VBA写个Word的宏,我都觉得对不起微软了。 JQ@`EV9,  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
86楼  发表于: 2015-09-05   
引用
引用第21楼阿散于06-14-2010 22:33发表的  : ll(e,9.D  
引用第19楼伍胥之于06-14-2010 12:33发表的  : )"_Ff,9Z!  
?b@q5Y  
c#n4zdQd]5  
我平生唯一参加的计算机考试就是职称考试,任选4个模块。 wI@zPVY_i  
6>=-/)p}  
我连一级也没有考过。 FU5LY XCs  
.
Ql q#Zdru  
?K4.L?D#J  
引用
\2R`q*a+  
矬子里拔将军... ?79SPp)oo  
你们那里的俗语是吧? AY&9JSu 6  
{V%%^Zhwy  
我们这里说"矮子里拔长脚"..应该是同一个意思... n~,]KdU]  
8L7Y A)u  
有趣....各地有表达意思一样却方式不同的俗语.... k,;lyE  
EFRZ% Y  
TRk ?8  
你的文章写的有脸皮,没屁眼的, 0r0\b*r  
让看客大为不满... Krp <bK6  
Lz9$,Y[  
你等着,,估计你以后接到的午夜凶铃就多了... W>?f^C!+m  
vNC$f(cQ  
Pe$^Mo.q  
我到现在也没有接到你的午夜凶铃呢! wsf Hd<Z_  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
87楼  发表于: 2015-09-05   
引用
引用第25楼猪小秘于01-20-2011 20:51发表的  : yN9$gfJC^  
伍SIR,再次抱拳佩服 tA! M  
#.E\,N'  
&547`*  
小秘倒是好久不见了呢!宝贝几岁了?很健康活泼吧?
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
88楼  发表于: 2015-09-05   
Re:回 38楼(伍胥之) 的帖子
引用
引用第39楼suehan234于01-22-2011 08:00发表的 回 38楼(伍胥之) 的帖子 : :"M9*XeHO  
佩服,玩也玩得这么专业! K/f>f;c  
Y|%anTP  
MB ]#%g&  
只是票友而已,算不上专业的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
89楼  发表于: 2015-09-05   
引用
引用第46楼清水于03-03-2011 14:50发表的  : opm?':Qst  
OD  
介个真的看不懂。 &_"ORqn&  
你说你老啦,喜欢怀旧了,才想起来填坑。 x`]Of r'  
提醒我也想想,是不是也老啦,是不是也有坑没填呢。 +<pVf%u5  
J"%8:pL  
gW%pM{PW  
你肯定有许多坑没有填,但是我挖的坑更多,但同是我也在你的某个坑里等你填埋呢!
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
90楼  发表于: 2015-09-05   
//从指定扇区号dwSector开始,写dwLength长度的数据 ooTc/QEYi  
BOOL WriteDisk( HANDLE hpartition, DWORD dwSector, DWORD dwLength, char* lpBuffer){ -h>Z,-DE6  
DWORD dwCB; <e;jW K  
LARGE_INTEGER  offset; \:]DFZ=!  
offset.QuadPart  =  UInt32x32To64(dwSector ,  512); 8 ne/=N|,  
SetFilePointer(hpartition,  offset.LowPart,  &offset.HighPart,  FILE_BEGIN); yOX&cZ[  
if(!WriteFile(hpartition, lpBuffer, dwLength * 512, &dwCB, NULL)){ ;$vLq&(}  
DWORD error = GetLastError(); >F/XZ C  
MessageBox(NULL,"写入文件失败!",NULL,IDOK); nAIH`L"X  
return FALSE; L/Hv4={  
} v2Dt3$@H6  
return TRUE; xLA~1ZSVJw  
} 4cott^K.  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
91楼  发表于: 2015-09-06   
'VB 6.0 版 :~vxZ*a  
'这不是我写的,它更强悍了。因为可以直接读写物理扇区(CHS),而不是逻辑扇区。 8V6=i'GK  
Dq?E\  
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 j3 6,w[Y:  
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long &svx@wW  
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 cb +l"FI7  
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long '//declare has changed $[[?;g  
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long >eQbipn  
'如果用绝对扇区写,那么文件的建立打开都不能用VB的 open 语句了。 RG&I\DTyt  
Rb)|66&3&  
I`22Zwq:  
Private Const GENERIC_READ = &H80000000 `&7mHa61  
Private Const GENERIC_WRITE = &H40000000 Y^ QKp"  
yC W*fIaq  
Private Const FILE_SHARE_READ = &H1 -7k[Vg?  
Private Const FILE_SHARE_WRITE = &H2 F7\BF  
Private Const OPEN_EXISTING = 3 z(+&wa  
8h@q  
Private Const INVALID_HANDLE_VALUE = -1 gXLCRn!iR  
Ks#A<! ;=  
'//file seek 3FFaEl  
Private Const FILE_BEGIN = 0 5gSylts8  
Private Const FILE_CURRENT = 1 \,2gTi,=  
Private Const FILE_END = 2 Ffnk1/ Zy  
vwVVBG;t  
Private Const ERROR_SUCCESS = 0& '0 ]r<O  
o*X]b]  
'//device io control IrJ+Jov  
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 Yg/}ghF\  
+fM&su=wl  
Private Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000   '458752 Ski G2n]  
Private Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX  As Long = &H2D0C04  #;`Oj  
Private Const IOCTL_DISK_FORMAT_TRACKS As Long = &H7C018 x5oOF7#5  
Private Const FSCTL_LOCK_VOLUME As Long = &H90018 {{32jU7<  
Private Const FSCTL_UNLOCK_VOLUME As Long = &H9001C W$r^  
Private Const FSCTL_DISMOUNT_VOLUME As Long = &H90020 ,"B?_d6  
Private Const FSCTL_GET_VOLUME_BITMAP = &H9006F O#vn)+Y,*  
fO6[!M(  
'//type 4AQ[igTDP  
Private Type LARGE_INTEGER im8 -7Xt  
    lowpart As Long G%S6$@:  
    highpart As Long y`4{!CEyLW  
End Type >W r$Y{  
bMsECA&  
Private Enum MEDIA_TYPE  }<=3W5+  
    Unknown 0mTEim  
    F5_1Pt2_512 y=w`w >%  
    F3_1Pt44_512 )Nbc/nB$  
    F3_2Pt88_512 F$i$a b  
    F3_20Pt8_512 {J2#eiF  
    F3_720_512 |8bE9qt.P  
    F5_360_512 R\*)@[y9l  
    F5_320_512 Rv,82iEKs  
    F5_320_1024 @}(SR\~N]  
    F5_180_512 S.: 7k9  
    F5_160_512 ^00{Hd6  
    RemovableMedia IhE9snJ[  
    FixedMedia :/6()_>bO  
End Enum rIVvO  
JT04 vm4  
Private Type DISK_GEOMETRY '@bJlJB9>  
    Cylinders           As LARGE_INTEGER RwW$O@0  
    MediaType           As MEDIA_TYPE FqwIJ|ct  
    TracksPerCylinder   As Long GzdRG^vN  
    SectorsPerTrack     As Long vs +QbI6>-  
    BytesPerSector      As Long wFvT0  
End Type j9:/RJS  
fp{G|.SA  
'//private vars bG(x:Py&  
Private hDisk           As Long             'disk handle *<IR9.~{6%  
Private lpGeometry      As DISK_GEOMETRY    'disk info za T_d/?J  
Private lBufferSize     As Long             'the buffer size of read/write 4@6 <  
I+| uU g5  
Public Function OpenDisk(ByVal FileName As String) As Boolean ><=rIhG%H@  
'// 打开磁盘 je,c7ZFO  
    hDisk = CreateFile(FileName, _ h$pk<<  
                        GENERIC_READ Or GENERIC_WRITE, _ Yrxk Kw#  
                        FILE_SHARE_READ Or FILE_SHARE_WRITE, _ TiyUr [  
                        ByVal 0&, _ 09d9S`cS\  
                        OPEN_EXISTING, _ fJy)STQ4  
                        0, _ T6uMFD4 |  
                        0) wX0l?xdI  
    OpenDisk = Not (hDisk = INVALID_HANDLE_VALUE) :=9<  
End Function pA.._8(t  
(0OM "`j  
Public Function CloseDisk() As Boolean +< yhcSSTB  
'//关闭磁盘 -(9O6)Rs$  
    CloseDisk = CloseHandle(hDisk) }#6xFTH  
End Function ePEe?o4;  
 D,Lp|V  
Public Function GetDiskGeometry() As Boolean GF'f[F6oI  
'//获取磁盘参数 paWxanSt  
    Dim dwOutBytes      As Long MU1E_"Z)  
    Dim bResult         As Boolean "]#'QuR  
     |c0,  
    bResult = DeviceIoControl(hDisk, _ )t%h[0{{  
                                IOCTL_DISK_GET_DRIVE_GEOMETRY, _ cvfUyp;P  
                                ByVal 0&, 0, _ > H BJk:  
                                lpGeometry, Len(lpGeometry), _ |n`PESf_  
                                dwOutBytes, _ 'w.} 2(  
                                ByVal 0&) p x#suy  
     2bLI%gg3  
    If bResult Then lBufferSize = lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack !^iwQ55e2A  
    GetDiskGeometry = bResult 1[-vD =  
End Function 90fs:.  
qfYG.~`5  
Public Sub GetDiskInfo(MediaType As Long, _ Lc]1$  
                        Cylinders As Long, _ 3+>OGwfQ  
                        TracksPerCylinder As Long, _ =u=Kw R  
                        SectorsPerTrack As Long, _ g*y/j]  
                        BytesPerSector As Long) J4>;[\%m  
'//返回磁盘的参数 99u/fkL  
    MediaType = lpGeometry.MediaType "Zcu[2,  
    Cylinders = lpGeometry.Cylinders.lowpart d2~l4IL)~  
    TracksPerCylinder = lpGeometry.TracksPerCylinder &yU>2=/T  
    SectorsPerTrack = lpGeometry.SectorsPerTrack >3PMnI  
    BytesPerSector = lpGeometry.BytesPerSector \GL*0NJ  
@ 7W?8  
End Sub ^H3m\!h  
6\n?4 8x}  
Public Property Get BufferSize() As Long `\N]wlB2/b  
'//返回每次读/写的缓冲大小 >b48>@~bY  
    BufferSize = lBufferSize E!! alc{  
End Property j;\[pg MR/  
,q#2:b<E  
 $:EG%jl  
Public Function LockVolume() As Boolean !n<o)DsZR  
'// 将卷锁定 ^=+e?F`:{  
    Dim dwOutBytes  As Long ] 8Tzr  
    Dim bResult     As Boolean g1{/ 5{XI  
     }G'XkoI&  
    bResult = DeviceIoControl(hDisk, _ "|t!7hC  
                                FSCTL_LOCK_VOLUME, _ m5*[t7@%  
                                ByVal 0&, 0, _ GoIQ>n  
                                ByVal 0&, 0, _ SkHYXe"]  
                                dwOutBytes, _ =K(Jq Sw+M  
                                ByVal 0&) 0Z HDBh  
    LockVolume = bResult #{*LvI&  
End Function -bS)=L  
c -B / ~&  
ZzcPiTSO  
Public Function UnlockVolume() As Boolean fu R2S70d  
'// 将卷解锁 oa`#RC8N  
    Dim dwOutBytes As Long AnMV <  
    Dim bResult As Boolean }pawIf4V  
     ?pG/m%[  
    bResult = DeviceIoControl(hDisk, _ W`M6J}oG  
                                FSCTL_UNLOCK_VOLUME, _ 3vW4<:Lgy  
                                ByVal 0&, 0, _ . 'T40=7  
                                ByVal 0&, 0, _ yMxTfR  
                                dwOutBytes, _ Kkv<"^H  
                                ByVal 0&) {eQWO.C{  
    UnlockVolume = bResult "IFg RaP=  
End Function %;|0  
`/4:I  
W~ruN4q.  
Public Function DismountVolume() As Boolean S^N {wZo  
'// 将卷卸下,使系统重新辨识磁盘,等效于重新插盘 YQd:M%$  
    Dim dwOutBytes As Long m Ni2b*k  
    Dim bResult As Boolean P :k+ y$  
     CU$#0f>  
    bResult = DeviceIoControl(hDisk, _ SK R1E];4  
                                FSCTL_DISMOUNT_VOLUME, _ 8(lR!!=q  
                                ByVal 0&, 0, _ LZ<[ll#C  
                                ByVal 0&, 0, _ 1e}8LH7  
                                dwOutBytes, _ {@.Vh]  
                                ByVal 0&) IQnIaZ  
    DismountVolume = bResult "0Q1qZ  
End Function `}fw1X5L  
q3h' l,  
C6jR=@42Q  
Public Function ReadDisk(ByVal Cylinders As Long, _ x[i`S8D  
                    ByVal Tracks As Long, _ 7-* =|gl+  
                    db() As Byte) As Boolean +Gh7^v|"  
'//按柱面和磁道来读取磁盘数据 ?S tsH  
    Dim iPos    As Long % frfSGf.#  
    Dim lRead   As Long 6B6vP%H#  
     }k7'"`#?"  
    iPos = Cylinders * Tracks * lBufferSize ho.(v;  
     gXy -Mpzp  
    If SeekAbsolute(0, iPos) Then vzX ag*0  
        ReadDisk = ReadBytes(lBufferSize, db(), lRead) VkZ.6kV  
    End If Ck'aHe22'  
End Function 3t" 4TjAy  
"2{%JFE  
Public Function WriteDisk(ByVal Cylinders As Long, _ _<*Hv*Zm  
                     ByVal Tracks As Long, _ O0hu qF$K  
                     db() As Byte) As Boolean 8-M e.2K  
'//按柱面和磁道来写磁盘数据 pe.QiMW{8  
    Dim iPos    As Long LFf`K)q  
    Dim lRead   As Long I=Ij dwbH  
     M %`\P\A  
    iPos = Cylinders * Tracks * lBufferSize <9eu1^g  
     )D/ 6%]O  
    If SeekAbsolute(0, iPos) Then QlEd6^&  
        WriteDisk = WriteBytes(lBufferSize, db()) nidr\oFUIn  
    End If P^)q=A8Z#  
End Function  {mTytT  
(= ;N{u  
X`JV R"=4  
'///////////////////////////////////////////////////////////////////////////////////// ;Ii1B{W  
'//file system )Gk`[*q ;  
:O-1rD  
Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean %j+xgX/&  
'//seek file F9flSeN  
    '//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte ub K7B |p  
    LowPos = SetFilePointer(hDisk, LowPos, HighPos, FILE_BEGIN) %J~WC$=Qv  
    If LowPos = -1 Then fU+Pn@'  
        SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS) pqR\>d 0  
    Else [L(h G a  
        SeekAbsolute = True m3.sVI0I  
    End If nxo+?:**  
     -VT+O+9_A  
End Function %,U PJn  
2+Rv{%  
*%gF2@=r8F  
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean {whvTN1#dh  
'//read data to array BVpO#c~I  
    Dim RetVal    As Long Or0O/\D)  
    RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0) ,[!LCXp  
    'ActuallyReadByte =>> if the bytesRead=0 mean EOF '@=PGpRF  
    ReadBytes = Not (RetVal = 0) ,S&z<S_  
      P_Hv%g  
End Function #07!-)Gv  
6.c^u5;  
Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean d~9!,6XM  
'//write data from array eu#'SXSC F  
    Dim RetVal As Long Vba.uKNjk  
    Dim BytesToWrite As Long W|5_$p  
    Dim BytesWritten As Long Log|%P\  
     e0HfP v_  
    RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0) -{jdn%Y7CK  
     3tAU?sV!  
    WriteBytes = Not (RetVal = 0) F]+~x/!  
End Function pA}S5x  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
92楼  发表于: 2015-09-06   
这才是我当年写出的一个比较烂的程序 nH-V{=**  
{XCf-{a]~  
Main2.bas PnYBy| yl  
g(4b Ba9y  
Attribute VB_Name = "SubMain" quxdG>8  
Option Explicit 7'lZg<z{~j  
mY7>(M{  
'采集文件与临时文件 r@G#[.*A>  
Public Const TmpFile As String = "d:\30-0600.dat" m#7*:i&@Y  
'已有数据:30-0600.dat /30日早6点进车与6:30出车头 [1yq{n=  
f 2YLk  
Public fStatus As Long, hFile As Long, bytesRW As Long, lptrFile As Long Ea $aUORm  
Public hBCFile As Long  '记录采集参数的文件 R.9V,R5  
Public Const TmpBMP As String = "d:\1.bmp" c1XX~8  
Public hTmpFile As Long YN/ }9.  
a;AzY'R  
5*-3? <)e  
'采集窗口参数常量 &qM[g 9  
Public Const FrameH As Long = 280& 8V/L:h#7  
Public Const FrameW As Long = 768& +9;2xya2  
Public Const pFrameSize As Long = FrameW * FrameH >SbK.Q@ei  
L=; -x9  
'标志区范围,用于识别车辆 sW@krBxMv  
Public Const PilarC As Integer = 260   '识别标志立柱中线坐标X "sUyHt-&  
Public Const mkW As Integer = 28  '识别标志立柱宽度 vX|UgK?2^  
Public Const mkH As Integer = 80 ''识别标志立柱高度(上白中黑下白) T^.Cc--c  
Public Const mkY As Integer = 4 ''识别标志立柱Y坐标(40-79白, 80-119黑,120-159白) /~p+j{0L3W  
Public Const mkX As Integer = PilarC - mkW / 2 '识别标志立柱X坐标 }T_Te?<&  
'车缝检测位置常数 Wr?'$:  
Public Const sSize As Long = 32& K }$&:nao  
Public Const sPos As Long = 310& ca<"  
Public Const sPosL As Long = 200& K%5"u'  
Public Const sPosR As Long = 500& U9hS<}<Ki  
'车缝检测框位置 4Y\wnwI  
Public Slice(1 To sSize, 1 To FrameH) As Byte r(A.<`\   
Public SliceL(1 To sSize, 1 To FrameH) As Byte #I*QX%(H#  
Public SliceR(1 To sSize, 1 To FrameH) As Byte 4=8QZf0\  
Public avSL As Integer, avSLR As Integer, avSLL As Integer d^E [|w ;  
/8'S1!zc  
G X{XdJD  
Public MKpilar(1 To mkW * mkH) As Byte   '一维数组用于亮度对比度分析,比使用二维数组更便于VB编译优化 uBrMk  
'该数组用于亮度对比度调节、车辆通过识别与车皮间隔识别 iEyeX0nm  
Public BsLine(1 To 4 * FrameW) As Byte, bsAV As Integer  '图像的前4行。用于确定标志区的亮度与对比度范围 @R|'X  
Public PilarW As Long, PilarH As Long, PilarX As Long, PilarY As Long R:aa+ MX(1  
Public LeftBK(1 To 1024, 0 To 1) As Byte, RightBK(1 To 1024, 0 To 1) As Byte qoMfSz"(  
'前后帧左右上角128列*8行像素块,根据平均值差绝对值判断进车方向 J @IS\9O  
gb|Q%LS9R  
zbkMFD.{y  
f. }c7  
'一次连续采集的帧数 WYcA8 X/  
Public tFrames As Long C~% 1w%nn  
5VW|fI  
'在采集卡申请的缓存中,是按帧为单位的,每一帧包含奇偶场两场的数据 nw:-J1kWR  
'而该卡的硬件设置是按场采集,只需要读第一场的数据即可。 #U mF-c  
'所以要设置的缓存帧的大小是frameW*frameH*2,而一场的数据量为pFrameSize iA }vKQ  
9LJZ-/Wq  
Public pFRAME(1 To FrameW, 1 To FrameH) As Byte  t+uE  
Public pBuffer(1 To FrameW * FrameH * 2) As Byte \*t~==WB  
Public pWorkSpace(1 To FrameW * FrameH) As Long -V.d?A4"  
Public Const pBufferSize As Long = FrameW * FrameH * 2 _HOIT  
Public pGray(0 To 255) As Long '整幅图像的灰度直方图 $.%rAa_H  
f9$xk|2g  
Public hBoard As Long   '采集卡标识 E0n6$5Uc?  
Public mBufferAddr As Long  '缓存地址 G\d$x4CVGc  
Public BufferSize As Long  '缓存大小(字节) O[@ q%&_  
Public iCurrentCard As Long l`9t }  
Public CapStatus As Long yY).mxRN  
Public iFrames As Long i yesD  
Public currentBr As Byte, currentContr As Byte _l`e#XbG  
/b#l^x:j  
Public hMEM As Long, mStatus As Long OX]V) QHVZ  
Public Const hMemSize As Long = pFrameSize * 4 I^\&y(LJF  
Public hMemWork As Long >o,^b\  
Public Const hMemWorkSize As Long = pFrameSize * 5 =@x`?oev  
R"v 3!P  
),:c+~@@kT  
o`S ?  
'串口接收轨道衡数据 V N{NA+I  
Public WeightFromCom As String rZXrT}Xh{W  
Public bReceiveComplete As Boolean k44Q):ncY7  
1Tp/MV/>  
bPK Ow<  
Public Type GrayBMPHeader da!P 0x9p  
  Tag As Integer k;W@ LfP  
  FileLength As Long    '文件大小 aW_oD[l  
  Reserve1 As Long nuQ]8 -,  
  DataOffset As Long    '图像数据偏移量 x3+oAb@o/  
  BMPHeaderSize As Long  '文件头长 hB;VCg8  
                        'length of the bitmap info header used to describe the bitmap colors, compression,… -_OS%ARa  
                        'the following sizes are possible: 9p* gU[  
                        '28h - windows 3.1x, 95, nt, … Lo.rvt  
                        '0ch - os/2 1.x 8 )*2@-Rp  
                        'f0h - os/2 2.x ` mfq 2bVc  
x\e;+ubt}  
  ImageWidth As Long           '图像宽(像素数) VSX@e|Nj  
  ImageHeight As Long          '图像高(像素数) uP $ Cj  
  PlaneNumber As Integer  '图像层数 ,8'>R@o  
  bpp As Integer    'bits per pixels    '1 - monochrome bitmap g^Yl TB  
                                        '4 - 16 color bitmap yM.IxpT#$  
                                        '8 - 256 color bitmap u^Ku;RQo  
                                        '16 - 16bit (high color) bitmap "ICC B1N|  
                                        '24 - 24bit (true color) bitmap w8Q<r.  
                                        '32 - 32bit (true color) bitmap oTjyN\?H  
  Compression As Long '压缩方法     '0 - none (also identified by bi_rgb) 75T_Dx(H  
                                    '1 - rle 8-bit / pixel (also identified by bi_rle4) 9# 4Y1LS)  
                                    '2 - rle 4-bit / pixel (also identified by bi_rle8) E_z;s3AXQ  
                                    '3 - bitfields (also identified by bi_bitfields) <yA}i"-1W  
  IMAGESIZE As Long  '图像数据字节数 Cs3^9m6;d  
  hResolution  As Long  '水平分辩率  像素数/米 :'L2J  
  vResolution  As Long  '垂直分辩率 ]va>ex$d  
  ColorsinBMP As Long   '图中所用的颜色。对256色图像总为0x100 F'}'(t+oAm  
  ImportantColors As Long /wShUR{  
  Pallate(0 To 255) As Long  '图像每个值对应的实际显示颜色,项数对应PallateNumber所指调色板项数 q<W=#Sx  
End Type EI~"L$?  
Rgy- OA  
g6t"mkMY L  
3chPY4~A  
Public BMPHeader As GrayBMPHeader, BMP1 As GrayBMPHeader inb^$v  
Public sRECT As RECT O4 3YY2  
POI.]1i  
INs!Ame2  
Public conn As ADODB.Connection Ox!U8g8c  
Public rsTrain As ADODB.Recordset %q ;jVj[  
Public rsOperater As ADODB.Recordset QS.>0i/7l  
Public rsGoods As ADODB.Recordset h5_G4J{1  
Public rsGood2 As ADODB.Recordset g1E~+ @  
Public rsSender As ADODB.Recordset @H b'8F  
Public rsReceover As ADODB.Recordset +yob)%  
Public rsTrainTMP As ADODB.Recordset 1F8 W9b^D  
\`<cH#  
u6V/JI}g  
'打开采集卡 WO5O?jo'  
'设置参数 ~[o 4a'  
'设置为实时单帧采集到缓存方式 4BYE1 fUzd  
'由另一线程查询采集状态,如果完成采集,传送至用户数组分析或保存 _ZB\L^j)  
s.Y4pWd5@  
\`V$ 'B{.  
Sub Main() %_-zWVJ  
  Dim i As Integer, status As Long Di_2Plo)4  
     Y/<lWbj*A  
   InitBMPinfo -ezY= 0Q&  
   '生成BMP文件头---该文件头是固定将pFRAME数组写成BMP文件 sZWaV4  
    BMPHeader.Tag = &H4D42 / O/`<  
    BMPHeader.ImageWidth = FrameW J&/lx${  
    BMPHeader.ImageHeight = FrameH B$3 ?K  
    BMPHeader.BMPHeaderSize = &H28 RgdysyB  
    BMPHeader.PlaneNumber = 1 +6$g! S5{  
    BMPHeader.bpp = 8 -$VZte x  
    BMPHeader.Compression = 0 ^mWybPqx  
    BMPHeader.hResolution = &H1274   'Windows pBrush.exe的默认值,PhotoED.exe默值为0 qLL,F  
    BMPHeader.vResolution = &H1274 `nXVE+E@  
    BMPHeader.ColorsinBMP = 256 h}_~y'^!  
    BMPHeader.ImportantColors = BMPHeader.ColorsinBMP AmPMY:1i"  
    BMPHeader.DataOffset = Len(BMPHeader) 7\z ZpPDV  
    For i = 0 To 255 G0 J4O!3  
      BMPHeader.Pallate(i) = RGB(i, i, i) AE`We $!  
    Next i  9fnA  
    BMPHeader.IMAGESIZE = FrameH * FrameW i@5[FC  
    BMPHeader.FileLength = Len(BMPHeader) + BMPHeader.IMAGESIZE ]?1Y e8>Y<  
5Z/GK2[HL  
o; a:Dd  
    MoveMemory BMP1, BMPHeader, Len(BMPHeader) \@3Qi8u//  
     cq&*.  
    BMP1.ImageWidth = FrameW GPhl4#'  
    BMP1.ImageHeight = FrameH * 2 _-!sBK+F  
    BMP1.IMAGESIZE = BMP1.ImageWidth * BMP1.ImageHeight yH 9!GS#  
    BMP1.FileLength = Len(BMP1) + BMP1.IMAGESIZE PP~rn fE  
/v|"0  
  '确定标志位置,为pilarX, pilarY确定初始值 ZoB*0H-  
   PilarW = mkW kd:$oS_*s  
   PilarH = mkH  '此两项为固定值 m"\:o  
   PilarX = GetSetting(App.EXEName, "Mark", "MarkX", mkX) W%2 80\h  
   PilarY = GetSetting(App.EXEName, "Mark", "MarkY", mkY)  '此两项需要在程序初始化时检查并进行调整 1axQ)},o@p  
   1% F?B-k  
   &c(WE RW?-  
  '连续采集记录文件 jCAC `  
  ' 建立一个缓冲区为页对齐方式的文件 7'-L p@an  
  If Dir(TmpFile) <> "" Then >SN|?|2U/  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ r)9Dy,  
     0&, 0&, OPEN_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) 4to% `)]  
    ' 在95/98中,如果打开文件时没有声明overlapped方式,在读定文件时就不能使用overlapped参数项 PjT=$]  
    ' 而必须用setfilepointer函数调节与操作系统保留的文件指针。 Sd/?&  
  Else -! ;l~#K=  
    hFile = CreateFile(TmpFile, GENERIC_READ Or GENERIC_WRITE, _ H7U li]e3  
     0&, 0&, CREATE_ALWAYS, FILE_FLAG_NO_BUFFERING, 0&) jc[_I&Oc_  
  End If ,ox cq?7#4  
  If hFile = 0 Then )3YtIH_  
    MsgBox TmpFile & ": File Open Error", vbOKOnly =(a1+. O  
    Exit Sub s5.AW8X=?*  
  End If xqXDxJlns  
  '采集参数记录文件 _I`,Br:N  
hBCFile = FreeFile() 5J)=}e  
Open TmpFile + ".BC" For Binary Access Read Write As #hBCFile Ok7t@l$  
   do-ahl,  
hMEM = VirtualAlloc(ByVal 0&, hMemSize, MEM_COMMIT, PAGE_READWRITE)  ’分配系统内容 "LYh7:0s!k  
If hMEM = 0 Then o@]So(9f  
    fStatus = GetLastError H.<a`m m8  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ Q-Ux<#  
     & "请向技术人员报告该错误代码。", vbOKOnly 2$_9cF Wm  
    CloseHandle hFile JjpRHw8\  
    Exit Sub ?&LZB}1 R  
End If `~eX55W  
)k&a}u5y  
hMemWork = VirtualAlloc(ByVal 0&, hMemWorkSize, MEM_COMMIT, PAGE_READWRITE) 9`jcC-;iv  
If hMemWork = 0 Then ;4M><OS!  
    fStatus = GetLastError M/?KV9Xk2  
    MsgBox "内存分配错误: 错误代码 - " & Str(fStatus) & vbCrLf _ R+q"_90_  
     & "请向技术人员报告该错误代码。", vbOKOnly )VCzn~uf  
     '释放已成功分配的内存 "'8KV\/D  
    mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) kg][qn|>J]  
    mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) x83 !C}4:  
     N"/-0(9[  
    CloseHandle hFile l kyzNy9R  
    Exit Sub G2LK]  
End If ^=n+T7"J  
I1X /Lj=  
' Test writing (Rk_-9_E.  
'WriteFile hFile, ByVal hMEM, ByVal 4096&, bytesRW, ByVal 0& ^J Z^>E~  
     f\+f o  
   '初始化采集卡参数 =cN&A_L(  
   iCurrentCard = -1 ~U(,TjJb  
   hBoard = okOpenBoard(iCurrentCard) L%v^s4@  
   Debug.Print hBoard L@75- T  
   If hBoard = 0 Then .6O"| Mqb  
      ExitGrabber PkE5|d*,  
      End y-p70.'{U  
   End If gj\)CBOv  
   okGetBufferSize hBoard, mBufferAddr, BufferSize _LAS~x7,  
   If mBufferAddr = 0 Then ^_5L"F]sP  
     MsgBox "缓存不存在!" W"{v2xi  
     ExitGrabber IM$2VlC  
   End If /( .6bv  
   Debug.Print Hex(mBufferAddr), Hex(BufferSize) #po5_dE\*  
   >{eCh$L  
   zWpqJ K   
   currentBr = 128: currentContr = 128 PiV7*F4qI.  
   '设置视频输入参数 e__@GBG  
   okSetVideoParam hBoard, VIDEO_SOURCECHAN, 1 'Video2 }>^Q'BW;65  
      ' lParam=0,1.. Comp.Video; 0x100,101...to Y/C(S-Video), 0x200,0x201 to RGB Chan.Input E_F5(x SA  
   okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 >e2<!#er|  
   okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度  ---初始设置条件下如果图像亮度达不到基本要求则控制灯光 {7cX#1  
   okSetVideoParam hBoard, VIDEO_RGBFORMAT, FORM_GRAY8 '8位灰度模式 +$xeoxU>;  
   okSetVideoParam hBoard, VIDEO_TVSTANDARD, 0 'PAL制式 )&era ` e[  
   okSetVideoParam hBoard, VIDEO_SIGNALTYPE, &H10000 '逐行(低字)同步开槽(高字) 6Ao%>;e*  
   okSetVideoParam hBoard, VIDEO_RECTSHIFT, 144 + &H2C0000 '有效区起始位置:高字Y偏移,低字X偏移 (144/44经验值) ccC zu6  
   okSetVideoParam hBoard, VIDEO_AVAILRECTSIZE, FrameW + FrameH * 2 * &H10000 '有效区大小:低字X高字Y (768/576采集卡最大值) -U<Upn)2  
   okSetVideoParam hBoard, VIDEO_FREQSEG, 0 ' 低频部分信号 JG C=(;  
   Z3k(P  
   '设置采集参数 1:NrP'W^  
   okSetCaptureParam hBoard, CAPTURE_INTERVAL, 0  '逐帧 O3N0YGhJ  
   okSetCaptureParam hBoard, CAPTURE_CLIPMODE, 2 '裁剪方式 Zh5RwQNE~  
   okSetCaptureParam hBoard, CAPTURE_BUFRGBFORMAT, FORM_GRAY8  '8位灰度 aK,z}l(N  
   okSetCaptureParam hBoard, CAPTURE_HARDMIRROR, 0 '不作镜像变换 @prG%vb"  
   okSetCaptureParam hBoard, CAPTURE_FRMRGBFORMAT, FORM_GRAY8 '帧存格式 t E` cau  
   okSetCaptureParam hBoard, CAPTURE_SAMPLEFIELD, 0 ' 逐场采集 x}U8zt)yD3  
   okSetCaptureParam hBoard, CAPTURE_HORZPIXELS, 944  '水平像素数 PAL制式固定值 BR'I +lQ  
   okSetCaptureParam hBoard, CAPTURE_VERTLINES, 625 '垂直线数 *5zrZ] ^  
   okSetCaptureParam hBoard, CAPTURE_SEQCAPWAIT, 0 '不等结束立即返回 j-CnT)W<  
   'okSetCaptureParam hBoard, CAPTURE_BUFBLOCKSIZE, FrameW + FrameH * 2 * &H10000 !zPG? q]3  
   'Buffer Block Size不用设置,而用okSetTargetRect函数进行动态调节 Tu{ h<Zy  
   Lb{e,JH  
   h2ZkCML  
   okCloseBoard hBoard 2j(h+?N7k  
   Sleep 50 nf 1#tlIJd  
   hBoard = okOpenBoard(iCurrentCard)   '关闭后重新打开使新的设置值生效 nd;fy$<J\  
   ZYf2XI(_"  
   '设置数据传送方式 ,f}UGd[a  
   'okSetConvertParam hBoard, CONVERT_FIELDEXTEND, FIELD_COPYEXTEND '逐行并扩展行 2^t#6XBk/  
   '该设置对本程序无意义,因为程序直接用CopyMemory方法读缓存,而扩展行方式是在用采集卡内置函数读RECT过程中实现的。 -",=G\XZ  
   7 NC=*A~  
   sRECT.Right = -1   '用于获得当前设置值 -p-B2?)A  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) )$w*V9d  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom 9ukg}_Hx  
   Debug.Print okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)  'FrameW + FrameH * &H10000 +\li*G]:J  
   sRECT.Left = 0 vHAg-Av c  
   sRECT.Top = 0 1 )}=bhT  
   sRECT.Right = sRECT.Left + FrameW !R*-R.%  
   sRECT.Bottom = sRECT.Top + FrameH * 2 j1SMeDDM ~  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) =fm]Dl9h*  
   bX.ja;;   
   sRECT.Right = -1   '检查新设置值 )uv=S;+  
   iFrames = okSetTargetRect(hBoard, BUFFER, sRECT) *A}cL  
   Debug.Print sRECT.Left, sRECT.Right, sRECT.Top, sRECT.Bottom $Vc~/>  
   Debug.Print Hex(okSetCaptureParam(hBoard, CAPTURE_BUFBLOCKSIZE, -1)) QKN<+,h!z>  
   kc7lc|'z  
   If TESTSignal = False Then o7B[R) 4  
      'ExitGrabber =#mTfJ   
   End If @ S<-d  
   9Rek4<5  
   > 0{S  
   $?,a[79  
   '设为实时采集状态 7&KT0a*  
   'iFrames = okCaptureActive(hBoard, BUFFER, 0&) Ngb(F84H?  
   /h v4x9  
   2tROT][J%  
   '单帧采集 h25G/`  
   'okWaitSignalEvent hBoard, EVENT_FRAMEHEADER, -1 Rwr 2gMt7  
   'iFrames = okCaptureSingle(hBoard, BUFFER, 0&) aNyvNEV3C  
   okCaptureTo hBoard, BUFFER, 0, 1 'single f84:hXo6  
   'Do While okGetCaptureStatus(hBoard, False) <> 0 kc/{[ME  
   '   Sleep 20 )}TLC 2%  
   'Loop \% sVHt`c  
   okGetCaptureStatus hBoard, True h._nK\  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize @fu M)B1"  
   '写入768*576测试图象 t_ksvWUo  
   ArrayToBMP TmpBMP :K\mN/ x  
   Q'k\8'x  
   '打开数据库 o!:8nXw  
   Set conn = New ADODB.Connection `/Nm 2K  
   conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ p8s:g~ W  
      "Persist Security Info=False;Data Source=" & "c:\train\train.mdb" & _ ;> m"x  
      "; Mode=Read|Write" [^8n0{JiN  
   conn.Open L< zD<M  
   vP7K9K x  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) -XRn~=5   
   frmRecord.Visible = True tO_H!kP  
   frmQuery.Visible = True 2+Px'U\  
   Load frmReceiveFromComm Y(\T- bI  
   #fj/~[Ajv  
   '调试参数 !*2%"H*  
   If InStr(UCase(Command()), "/CAPTURE") > 0 Then qQ!1t>j+H  
     SignalBox.Visible = True #W.vX?-'0  
   End If ;q0uE:^ S  
   If InStr(UCase(Command()), "/COMM") > 0 Then Qb8 KPpd  
     frmReceiveFromComm.Visible = True p3/*fH98  
   End If 2 _Wg!bq  
pfx3C*  
End Sub 6#j$GH *  
@/r^%G  
Sub ExitGrabber() d:G]1k;z  
  '关闭数据库 Ro2d,'   
  '关闭采集卡 R<i38/ ~G  
  mStatus = VirtualFree(ByVal hMEM, hMemSize, MEM_DECOMMIT) AxxJk"v'y  
  mStatus = VirtualFree(ByVal hMEM, 0&, MEM_RELEASE) DK0.R]&4(  
  mStatus = VirtualFree(ByVal hMemWork, hMemWorkSize, MEM_DECOMMIT) &V>fYg ui  
  mStatus = VirtualFree(ByVal hMemWork, 0&, MEM_RELEASE) 3] 1-M  
  okStopCapture hBoard T[= S$n -'  
  okCloseBoard hBoard "EU{8b  
  CloseHandle hFile "O8gJ0e  
  Close #hBCFile v/*Y#(X  
  conn.Close >NB?& |  
  End E7Cy(LO  
End Sub X=8Y&#%  
H:p Z-v*  
Function ArrayToBMP(ByVal File As String) = 8gHS[  
Dim BytesWrite As Long B\g]({E  
i{D=l7j|w  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, 0&, 0&, _ C"lJl k9g^  
  CREATE_ALWAYS, 0&, 0&) yL;M"L  
9Lh|DK,nV/  
If hTmpFile = 0 Then B2Xn?i3 l  
   ArrayToBMP = False ~}K5#<   
   Exit Function H3{GmV8  
End If i(? ,6)9  
K78rg/`  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN -@>BHC  
WriteFile hTmpFile, BMPHeader, 2&, BytesWrite, ByVal 0& +n}$pM|NKU  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN e!fqXVEVR  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& 9w9jpe#  
6<0n *&  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN (M =Y&M'f  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& qS&%!  
UD~p'^.m_  
If BytesWrite < pFrameSize Then B3Jgd, [  
  ArrayToBMP = False TpA\9N#$  
End If PA6=wfc  
T32BnmB{  
CloseHandle hTmpFile _Lw OOZj  
[FUjnI  
End Function (Qgde6  
l"n{.aL  
Function ArrayToBMP1(ByVal File As String) T5Dw0Y6u,  
kt4d; 4n  
Dim BytesWrite As Long S4witIK5  
S osj$9E  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ j@Qg0F  
  CREATE_ALWAYS, 0&, 0&) !ZDzEP*  
10#oG{ 9  
If hTmpFile = 0 Then Sx    
   ArrayToBMP1 = False O4<g%.HC6  
   Exit Function uP\lCqK,  
End If Kb =@ =Xta  
Bx[rC  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN /~4 "No@  
WriteFile hTmpFile, BMP1, 2&, BytesWrite, ByVal 0& 2iu_pjj  
 Av0y?oGH  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN `Q+moX  
WriteFile hTmpFile, BMP1.FileLength, Len(BMP1) - 2, BytesWrite, ByVal 0& {_RWVVVe  
>:=|L%]s;\  
SetFilePointer hTmpFile, Len(BMP1), 0&, FILE_BEGIN -T6 (hT\  
WriteFile hTmpFile, pBuffer(1), pBufferSize, BytesWrite, ByVal 0& ]d[ge6  
?S ?2 0  
If BytesWrite < pBufferSize Then >zkRcm  
  ArrayToBMP1 = False `V[!@b:  
End If Ifk#/d  
kP xa7  
CloseHandle hTmpFile 5>J=YLq  
7VK}Dy/Vvn  
End Function 0?WcoPU  
q H"Gm  
'使用该过程建立的文件要求在用后关闭 v){ .Z^_C  
Public Function ArrayToBMP2(File As String) As Boolean ^$%Z! uz  
H' T  
Dim BytesWrite As Long RFh"&0[  
g<*BLF  
ArrayToBMP2 = True B12$I:x `  
J8y0d1SG  
hTmpFile = CreateFile(File, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, _ EkT."K  
  CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0&) Iqs+r?  
C@N1ljXJT  
If hTmpFile = 0 Then mj?16\ |]  
   ArrayToBMP2 = False k%[3Q>5iM  
   Exit Function e6=]m#O9  
End If y]%w)4PS  
%AF5=  
SetFilePointer hTmpFile, 0&, 0&, FILE_BEGIN +l^LlqA  
WriteFile hTmpFile, BMPHeader, 2, BytesWrite, ByVal 0& 6.t',LTB  
R{,ooxH\J  
SetFilePointer hTmpFile, 2&, 0&, FILE_BEGIN */ G<!W  
WriteFile hTmpFile, BMPHeader.FileLength, Len(BMPHeader) - 2, BytesWrite, ByVal 0& CukC6u b  
BQ^H? jo  
SetFilePointer hTmpFile, Len(BMPHeader), 0&, FILE_BEGIN UN"(5a8.  
WriteFile hTmpFile, pFRAME(1, 1), pFrameSize, BytesWrite, ByVal 0& Khh0*S8.K  
7^} Ll@  
If BytesWrite < pFrameSize Then |%~+2m  
  ArrayToBMP2 = False vi@Lz3}::  
End If EL3|u64GO  
(h']a!  
CloseHandle hTmpFile B7\k< Nit0  
q.Nweu!jQ  
End Function 6)pH |d.FR  
*%Qn{x  
Private Function TESTSignal() As Boolean 61U<5:#l  
Dim extsign As Long, videotype As Long, scanlines As Long, fieldfrq As Long lCW8<g^  
rzp +:  
extsign = okGetSignalParam(hBoard, SIGNAL_VIDEOEXIST) C1T_9}L-A  
b'zR 9V  
If extsign = 1 Then !~_zm*CqbZ  
   TESTSignal = True ZxGP/D  
Else }0,>2TTDN  
    If extsign = 0 Then y{q*s8NY  
        MsgBox "无视频输入信号,检查摄像机电源!", vbOKOnly uH3D{4   
        TESTSignal = False e lG;jB  
        Exit Function 3cj3u4y  
    End If M>jtFP <S  
End If $ _8g8r}  
W"L&fV+3  
'测试视频输入类型 {;2i.m1  
'video type :hG PTf  
okWaitSignalEvent hBoard, EVENT_ODDFIELD, 40 %iJ%{{f`  
videotype = okGetSignalParam(hBoard, SIGNAL_VIDEOTYPE) \b}~2oX  
If videotype = 1 Then H7i$xWs  
        '"隔行信号(Interlaced)" ozsxXBh-`'  
Else M Jj4Hd  
   If videotype = 0 Then H1!iP$1#V  
       '"逐行信号(Non-interlaced)" %7Kooq(i  
   Else T+LJ* I4  
     If videotype = -1 Then >]'yK!a?  
       ' "不支持" .@iFa3  
     End If `"vZ);i <  
   End If ck#"*] ,  
End If }U@m*dEG  
- Xz?s  
'测试垂直扫描线数 9>/wUQs!]  
'video scanlines `SO|zz|'  
scanlines = -1 %tA57Pn>  
scanlines = okGetSignalParam(hBoard, SIGNAL_SCANLINES) =TR,~8Z|  
    If scanlines = -1 Then S{',QO*D6  
        ' "不支持" eUS   
    Else -{h   
        'Trim(Str(ScanLines)) + " 行数/幅" >#+IaKL7  
    End If Bs`$ i ;&  
4Z[V uQng  
'测试帧频 g%[n4  
'video field frequency -ZW0k@5g  
    fieldfrq = okGetSignalParam(hBoard, SIGNAL_FIELDFREQ) ,n2i@?NHZ  
    If fieldfrq = -1 Then J H.K.C(  
        'lblSignal(8) = "不支持" 0;,IKXK6X  
    Else 4LI0SwD#^/  
        'lblSignal(8) = Trim(Str(FieldFRQ)) + " 场数/秒" SFH-^ly&D  
    End If ()PKw,pD  
End Function Hy{ Q#fq  
=1dI>M>tm  
V+?]S  
Sub PicIdentify() Z?MoJ{.!?R  
'本程序完成从文件中按顺序读出一幅图像并完成图像识别 ^"8G`B$r  
'根据固定位置判断透过车皮连接处接收的对面的立柱影像。出现立柱后该帧前1-2帧与后1-2帧分别为车号信息与车皮信息 {Hr$wa~  
'判定标准:如果在立柱位置上有明显的模式反差,则视为车皮之间的间隔 r%Rs0)$yj  
'方法:对立柱标志区进行平均值二值化,面积为32*40,亮区(255)与暗区(0)的亮度平均值理论差大于200倍,实际差值应不小于100倍 u% 2<\:~j  
XwM611  
  Dim fPTR As Long, cFrame As Long 59(U`X  
  Dim i As Long, j As Integer, pTotal As Long, pAV As Integer elJ)4Em  
     h72UwJ2rw  
`h;k2Se5  
cFrame = 0 "s W-_j]  
o6"*4P|  
! BU)K'mj  
Do While cFrame < tFrames .AV)'j#6P  
   _9:@Vl]Q@  
  fStatus = SetFilePointer(hFile, cFrame * pFrameSize, 0&, FILE_BEGIN) nW\(IkX\  
  fStatus = ReadFile(hFile, ByVal hMEM, ByVal pFrameSize, bytesRW, ByVal 0&)  Z:2I/  
  MoveMemory pFRAME(1, 1), ByVal hMEM, pFrameSize lA>\Ko  
   R)!`JKeO/  
  frmRecord.RText.Text = Str(cFrame) /Tz85 [%6  
  frmRecord.RText.Refresh ,1Qd\8N9  
       4X NxI1w)  
  If CheckMark = True Then '%v#v3'  
   ArrayToBMP TmpBMP m9M FwfZ  
   frmRecord.Picture1.Picture = LoadPicture(TmpBMP) ,]R8(bD)  
   frmRecord.RText.Text = "第" & Str(cFrame) & "帧" c*\<,n_  
   HOt>}x  
   DrawSlice 8:ggECD  
   U7 &x rif  
   'i = MsgBox("检测到立柱:第" & Str(cFrame) & "帧", vbYesNo) ^=cXo<6D  
   'If i = vbNo Then ba@ax3  
   '  Exit Do ;??ohA"{5  
   'End If b M;`s5d  
   'cFrame = cFrame + 1 kfC0zd+  
   E_ $z`or  
  End If p]W+eT  
  DoEvents 4{9d#[KW  
  cFrame = cFrame + 1 JU0]Wq<^[  
Loop 4dH}g~[P9  
End Sub ]T O/kl/  
[n,?WwC  
ETv9k g  
Function CheckMark(Optional iBlk As Integer = 30, Optional iWhite As Integer = 230) As Boolean 8YY|;\F)J~  
,KW;2t*IQ@  
'如标志区模式反差存在则为TRUE,否则返回FALSE 8U~.\`H-PT  
t $^l<ppQ  
Dim i As Integer, j As Integer, mTotal As Long, mAV As Single, mTop As Long, mBot As Long " oy\_1|  
CheckMark = True jm>3bd  
   ~WVO  
'复制标志区 dOa!htx]  
For i = 1 To mkH B7Ntk MK  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW bC@k>yC-  
Next i "YFls#4H-  
)J/HkOj"V  
For j = 1 To PilarW * PilarH / 2 x_@i(oQ:_  
   mTop = mTop + MKpilar(j) ;mm!0]V  
Next j .uZ7 -l  
9 -h.|T2il  
For j = PilarW * PilarH / 2 + 1 To PilarW * PilarH <*'cf2Q$Av  
   mBot = mBot + MKpilar(j) _3Q8n|  
Next j (g/7yO(s  
[nN7qG  
mTop = mTop / PilarW / PilarH * 2 bggusK<  
mBot = mBot / PilarW / PilarH * 2 5''*UFIF1  
p5c8YfM  
mAV = (mTop + mBot) / 2 + (mBot - mTop) / 4 '标志区平均亮度 B_3QQ tjAl  
Y{Ap80'\6  
'平均值极值化 pL oy  
  For j = 1 To PilarH * PilarW |oKu=/[K  
    MKpilar(j) = IIf(MKpilar(j) > mAV, 255, 0) ZIxRyo-i  
  Next j V7CoZnz  
   WbjF]b\  
mTop = 0: mBot = 0 (VHND%7P  
For j = 1 To PilarH * PilarW / 2 ? s} %  
  mTop = mTop + MKpilar(j) Uv?'m&_   
Next j D>ai.T%n  
x49!{}  
For j = PilarH * PilarW / 2 + 1 To PilarH * PilarW lpQP"%q  
  mBot = mBot + MKpilar(j) "#^MUQ!a  
Next j P1 +"v*  
a,'Cyv">  
7r{qJ7$%  
  mTop = mTop / PilarH / PilarW * 3 #,f{Ok+  
  mBot = mBot / PilarH / PilarW * 3 6=|&tE  
   4dhqLVgL{  
vg%QXaM  
If mBot > iWhite And mTop < iBlk Then 2iXoj&3e  
  CheckMark = True f%^'P"R  
Else  :,]S}R  
  CheckMark = False L0Vgo <A  
End If /dHs &SU,  
End Function >POO-8Q  
=7[)'  
Sub Capture1Frame() ESQ!@G/n  
   okCaptureTo hBoard, BUFFER, 0, 1 'single 5P^U_  
   okGetCaptureStatus hBoard, True .e[Tu|qo  
   MoveMemory pFRAME(1, 1), ByVal mBufferAddr, pFrameSize sn\;bq  
End Sub $B\E.ml.  
<3 @}Lj  
tR`S#rk  
Sub CopyMark(iBlk As Integer, iWhite As Integer) ~P1_BD(  
'复制标志区并返回标志区暗区与亮区的亮度平均值 I{.HO<$7D}  
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 K\=8eg93Z  
   ='Oj4T  
'复制标志区 J2Et-Cz1  
For i = 1 To mkH ;'kI/(;;C  
   MoveMemory MKpilar((i - 1) * PilarW + 1), pFRAME(PilarX, PilarY + i), PilarW QrjDF>   
Next i k M*T$JqN  
(*^DN{5  
For j = 1 To mkW * mkH / 2 Vk<k +=7  
   mTotal = mTotal + MKpilar(j) vx0UoKX  
Next j u?Hb(xZtg=  
?_4^le[;  
iBlk = mTotal / (mkW * mkH / 2)  '标志区上部白区平均亮度 %&] 1FhL  
a#(U 2OP  
mTotal = 0 M$#sc`4*  
For j = mkW * mkH / 2 + 1 To mkW * mkH )y50Mb0+  
   mTotal = mTotal + MKpilar(j) ki\uTD`mf  
Next j &W_th\%  
G\H q/4  
iWhite = mTotal / (mkW * mkH / 2) '标志区下部黑区平均亮度 /J%do]PDl  
MZm'npRf  
'背景亮度 (}H ,ng'4  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW &{^eU5  
  For i = 1 To 4 * FrameW 744=3v  
    bsTotal = bsTotal + BsLine(i) >Gd.&flSj  
  Next i ~^o=a?L`<  
  bsAV = bsTotal / FrameW / 4 z4O o@3$\R  
mX_)b>iW  
End Sub _\AUQ{  
>S&U.  
N)OCSeh  
Sub AdjIMGbright(Optional bInit As Boolean = True) 2bQ/0?.).-  
?9?4p@  
  '自动调节亮度与对比度,此时处于无车辆状态(白天特别高,而夜间特别暗) n E :'Zxj  
  '图像平均亮度白天不高于200(当车辆通过时可能会下降到100左右),不低于100 H:}}t]E  
  '            夜间不高于80(过高时通常是由于雪花噪声引起),但立柱不低于30 R8sck)k'}  
     }Jxq'B  
  Dim bsTotal As Long, i As Integer, iBlack As Integer, iBright As Integer `q?RF+  
   a+(j ?_FyI  
  '按标准亮度与对比度采集一帧,确定背景亮度 O8RzUg&  
  currentContr = 128   '初始对比度 *re 44  
  currentBr = 128   '初始亮度 a|x8=H  
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 r#h {$iW  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 8GB]95JWwp  
  DoEvents 04-Z vp2  
  Capture1Frame =:K@zlO:  
  '获得图像上缘4行象素 D u_$C[  
  MoveMemory BsLine(1), pFRAME(1, 1), 4 * FrameW ZxSsR{  
  CopyMark iBlack, iBright   '图像标志区亮度 +^Jwo)R'b  
  For i = 1 To 4 * FrameW d.}}s$Q  
    bsTotal = bsTotal + BsLine(i) 8]*Q79  
  Next i 8=H\?4)()Y  
  bsAV = bsTotal / FrameW / 4    '图像上缘基线亮度 Lt<oi8'N   
   h)B!L Ar  
  Select Case bsAV c>MY$-PD  
     Case 0 To 60    '夜间通过灯光照明,完全没有背景 |'w^n  
       currentBr = 150 )mD \d|7f  
       currentContr = 60 az(5o  
     Case 61 To 80   '有可见背景 #tz8{o?ebN  
       currentBr = 140 !RMS+Mm?  
       currentContr = 70 _EKF-&Q6  
     Case 81 To 100  '有清晰背景 K+ehr  
       currentBr = 128 Qilj/x68  
       currentContr = 80 zGs|DB  
     Case 100 To 150  '有明亮背景 "@t-Cy:!O  
       currentBr = 140                '5:30-6:00钟实测数据 >}]H;& l  
       currentContr = 50 # cWHDRLX  
     Case 151 To 180 N du7nKG  
       currentBr = 130 HWtPLlNt  
       currentContr = 60 b.Su@ay@(^  
     Case 181 To 220  '背景全为白色 "Pdvmur  
       currentBr = 110 Q_lu`F|  
       currentContr = 130 RK)l8c}  
     Case 221 To 255  '背景全为白色 Q]i[.ME  
       currentBr = 100 ./iXyta  
       currentContr = 100 U>3 >Ex  
  End Select 6 o lV+  
   /RF%1!M K  
  Select Case (iBlack + iBright) / 2   '图像反射光强度修正 n&7@@@cA  
        Case 100 To 150 ]7<m1Lg  
          currentBr = currentBr - 10 Sr7@buF  
        Case 151 To 255 2]Fu 1  
          currentBr = currentBr - 20 @a;sV!S{  
  End Select gE=Wcb!  
   O]_={%   
  okSetVideoParam hBoard, VIDEO_BRIGHTNESS, currentBr '亮度 twbcuaCTW  
  okSetVideoParam hBoard, VIDEO_CONTRAST, currentContr '对比度 yV_ L/,6}D  
End Sub ABiC9[Q0  
XARSGAuw  
Sub CopyCorner(rowID As Integer, diffL As Integer, diffR As Integer)  HD|sr{Z%  
    Dim i As Integer, j As Integer, L1 As Long, L2 As Long, R1 As Long, R2 As Long lZ a?Y@  
     w|G~Il  
    For i = 1 To 8 +FBi5h  
      MoveMemory LeftBK((i - 1) * 128 + 1, rowID), pFRAME(1, i), 128& NKh,z& _5-  
      MoveMemory RightBK((i - 1) * 128 + 1, rowID), pFRAME(640, i), 128& 59MR|Jt  
    Next i )<'yQW=6  
     `i4I!E  
    For j = 1 To 1024 32KR--mn%  
      L1 = L1 + LeftBK(j, 0) ,)uPGe"y  
      L2 = L2 + LeftBK(j, 1) .CmL7 5  
      R1 = R1 + RightBK(j, 0) .HDebi  
      R2 = R2 + RightBK(j, 1) _W+Q3Jx-(  
    Next j oP-;y&AS  
    diffL = Abs(L1 - L2) / 1024 d<Dn9,G  
    diffR = Abs(R1 - R2) / 1024 ^Ezcy?  
End Sub 7,su f }=  
{{zua- F  
Function CheckSlice() As Boolean o[{&!t  
  CopySlice avSL, avSLR, avSLL R#fy60  
  If Abs(avSL - avSLL) > (Abs(avSLL - avSLR) + 5) * 4 Then /$*; >4=>f  
    CheckSlice = True It\BbG=  
  Else t'Htx1#Zc[  
    CheckSlice = False a@k.$  
  End If &Q+]t"OA!  
End Function ] zIfC>@R  
#Y: ~UVV  
Sub CopySlice(avSL As Integer, avSLR As Integer, avSLL As Integer) Ys+N,:#R  
  Dim i As Long, j As Long, total As Long, totalL As Long, totalR As Long (\uA AW"  
  For i = 1 To FrameH %JaE4&  
    MoveMemory Slice(1, i), pFRAME(sPos, i), sSize V<W02\Hs  
    MoveMemory SliceL(1, i), pFRAME(sPosL, i), sSize x 8M#t(hw  
    MoveMemory SliceR(1, i), pFRAME(sPosR, i), sSize mS7E_A8  
  Next i ahoh9iJ  
  For i = 1 To FrameH h9Z[z73_a  
    For j = 1 To sSize z@n+7p`w  
       total = total + Slice(j, i) Zih 5/I  
       totalL = totalL + SliceL(j, i) okh0 _4  
       totalR = totalR + SliceR(j, i) VVN # $  
    Next j u;(K34!)  
  Next i Ei~] iZ}  
  avSL = total / FrameH / sSize aKOf;^@  
  avSLR = totalR / FrameH / sSize 0$?qoS  
  avSLL = totalL / FrameH / sSize o3= .T+B  
End Sub FLEg0/m0  
<[FS%2,0mb  
Sub DrawSlice() JOgmF_(>Z  
   frmRecord.Picture1.Line (sPosL, 0)-(sPosL + sSize, FrameH), RGB(255, 0, 0), B u= l0f6W  
   frmRecord.Picture1.Line (sPos, 0)-(sPos + sSize, FrameH), RGB(0, 255, 0), B hgif]?:C<  
   frmRecord.Picture1.Line (sPosR, 0)-(sPosR + sSize, FrameH), RGB(0, 0, 255), B kI]=&Rw  
   frmRecord.RText.Text = Str(avSLL) & "/" & Str(avSL) & "/" & Str(avSLR) SNxz*`@4  
End Sub YiBOi?h9  
Sub DrawMark(pic As Control) s #`cX0L)  
   Dim i As Long, j As Long C&FN#B  
   pic.Line (PilarX, FrameH - PilarY)-(PilarX + PilarW, FrameH - PilarY - PilarH / 2), RGB(255, 0, 0), B X@eg<]'m  
   pic.Line (PilarX, FrameH - PilarY - PilarH / 2 - 1)-(PilarX + PilarW, FrameH - PilarY - PilarH), RGB(0, 0, 255), B QS%,7'EG  
   For i = 1 To PilarH A ' )(SGSc  
     For j = 1 To PilarW &0 i71!Oy  
       pic.PSet (PilarX + PilarW + 10 + j, FrameH - PilarY - i), RGB(MKpilar((i - 1) * PilarW + j), 0, 0) e18T(g_i  
     Next j Nq  U9/  
   Next i $uTlbAuv  
End Sub gpsrw>nw  
S#hu2\9D,  
Function avIMG() As Integer & ]%\.m  
  Dim i As Long, j As Long, totalIMG As Long B,:23[v  
  MoveMemory pBuffer(1), pFRAME(1, 1), pFrameSize FBbm4NB  
  For i = 1 To pFrameSize n4XMN\:g{  
    totalIMG = totalIMG + pBuffer(i) Ol_/uy1r[  
  Next i B~BUW WMfp  
  avIMG = totalIMG / pFrameSize jUZ[`f;  
End Function 7j95"mI  
+}\29@{W  
Function avRegion(barCol As Integer, barWidth As Integer) As Integer u4C1W|x  
  Dim i As Long, j As Long, totalIMG As Long b/G8M r  
  For i = 1 To FrameH }o{!}g9  
     MoveMemory pBuffer((i - 1) * barWidth + 1), pFRAME(barCol, i), barWidth i!y\WaCp  
  Next i z.{HD9TD  
  For i = 1 To FrameH * barWidth y!BB7cK6  
    totalIMG = totalIMG + pBuffer(i) f5N<3m=  
  Next i - Ra\^uz  
  avRegion = totalIMG / pFrameSize Hq79/ wKj  
End Function V3%Krn1'  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

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

一共这么多文件。 TR+Q4Y:  
SG1&a:c+.  
这是我用VB写出的最大的程序,也是用API最多的。
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
94楼  发表于: 2015-09-06   
拍下的火车 rDK;6H:u{  
第6车皮 Omp i~  

TB ;3`  
>SY 2LmV'a  
第9车皮 F]/L!   
.G7]&5s  
  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

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

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

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

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

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

显示用户信息 
98楼  发表于: 2021-01-02   
继续填 BotNET 或Pynthon? 有没有XDJMs接龙啊 ? 1)P<cNj  
kz$6}&uk  
杺栫杣杊椌柮栬,䒴蓉艿芖。
伍胥之 离线
级别: 军区司令员

显示用户信息 
99楼  发表于: 2021-07-18   
继续填个坑: (7rz:  
BCa90  
用VBA控制WORD自己修订学生毕业文的格式。 z1{E:~f  
杺栫杣杊椌柮栬,䒴蓉艿芖。
描述
快速回复

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