下大雪了,出不去门啦!

[csdngoodnight]

下大雪了,出不去门啦!搜集整理了一下从前的一些代码,多是些基础的东西.其中一些很有趣.有些原作者不祥,谨给刚过门的媳妇......错了,是朋友们看看玩玩,暖和一下吧.




实现毫秒精度的延时

'Module Code:
Option Explicit

Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Declare Function QueryPerformanceCounter Lib "kernel32" _
(lpPerformanceCount As LARGE_INTEGER) As Long
Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type

'实现毫秒量级精确延时,(n 毫秒)
Public Sub Wait(ByVal n As Long)
Dim PFrequency As LARGE_INTEGER
Dim Interval As LARGE_INTEGER
Dim Privious As LARGE_INTEGER
Dim Current As LARGE_INTEGER

'获得高精度计数器的频率
QueryPerformanceFrequency PFrequency

'获得高精度运行计数器的值
QueryPerformanceCounter Privious
Current = Privious
Interval.LowPart = (PFrequency.LowPart / 1000) * n
'下面这句可以精确到微秒,好像不太实用,也未必精确到如此地步
'Interval.LowPart = (PFrequency.LowPart / 1000000) * n
Interval.HighPart = 0

'通过比较两次计数器的值差实现高精度延时
Do While (Abs(Current.HighPart * 2 ^ 16) + Current.LowPart) - _
(Abs(Privious.HighPart * 2 ^ 16) + Privious.LowPart) < _
(Abs(Interval.HighPart * 2 ^ 16) + Interval.LowPart)
QueryPerformanceCounter Current

'此句若省略,循环期间其它事就都不能做了
DoEvents
Loop
End Sub


'Form Code:
Option Explicit

Dim l As Long

Private Sub Command1_Click()
l = 0
'对照时钟计时(它并不很精确,这里仅对照而已)
'间隔10毫秒已经很小了
Timer1.Interval = 10

'延时
Wait 5000

'停止计时
Timer1.Interval = 0
MsgBox "你够狠,憋了我5000毫秒才放出来"
End Sub

Private Sub Form_Load()
'共三个控件:一个时钟,一个标签,一个按钮
Command1.Caption = "等待5000毫秒"
Label1.AutoSize = True
Label1.Caption = "这里是时钟计时"
End Sub

Private Sub Timer1_Timer()
l = l + 10
Label1.Caption = l
End Sub




-------------------------------------------------------

VB未公开的三个函数ObjPtr,StrPtr,VarPtr

'Form Code:

'ObjPtr: 返回对象实例私有域的地址
'StrPtr: 返回字符串第一个字的地址
'VarPtr: 返回变量的地址

'使用对象浏览器（Object Browser），你可以发现更多其他对象未公开的细节。


'使用诸如金山游侠之类的游戏修改器可以跟踪到这个变量的地址(查99887766数值)
'需生成EXE,这样容易操作,不会受到VB6干扰
Dim l As Long

Private Sub Command1_Click()
Print "对象实例私有域:", ObjPtr(Command1)

Dim str As String
str = "字符串第一个字的地址:"
Print str, StrPtr(str)

Print "----------------------------------"
Dim ramid As Double
ramid = VarPtr(l)
l = 99887766
Print "变量的内存地址:", VarPtr(l)
Print "转换成十六进制:", Hex(ramid)
Print "变量 l 的值:", l
End Sub

Private Sub Form_Load()
'为了能持久显示,便于查看
Me.AutoRedraw = True
End Sub


'VarPtr用在包含字符串的变量时,可能返回的指针是临时地址(UNICODE转换的缘故)
'StrPtr还是唯一能直观地告诉你空字符串和null字符串的不同的方法。
'对于null字符串(vbNullString)，StrPtr的返回值为0，而对于空字符串，函数的返回值为非零
'详细信息请查阅相关文档
------------------------------------------------------------

'返回阿拉伯数字的中文大写或者普通写法的一个函数


Public Function ChnNumber(Number As Double, _
Optional Capital As Boolean = False, _
Optional Simple As Boolean = False) As String
'返回阿拉伯数字的中文大写或者普通写法
'调用方法例如:Debug.Print ChnNumber(12300.43) '返回:壹萬贰仟叁佰点肆叁
' Debug.Print ChnNumber(12300.43, 1) '返回:一万二千三百点四三
' Debug.Print ChnNumber(12300.43, , 1) '返回:一二三○○点四三
'作者:csdngoodnight
'E-mail:[e-mail]

'Number:阿拉伯数字(12300.43)
'Capital:True为中文大写(壹萬贰仟叁佰点肆叁),默认为False普通(一万二千三百点四三)
'Simple:True为简单排列(壹贰叁零零点肆叁/一二三○○点四三)

If Abs(Number) > CDbl(9.99999999999999E+15) Then
'9999兆9999万9990 or 9999999999999990 or 9.99999999999999E+15
MsgBox "超出这个范围的数字,将会有四舍五入进位情况。" & Space(5) & vbCrLf & _
"难道你...要计算星星的数量?偶帮不了你啦 :(", vbInformation, "老兄:天文数字啊"
'Exit Function
End If

Dim varNumber As Variant
Dim ChnString(1) As String, strClass(1) As String
Dim iNumberLen As Integer, iCapital As Integer
Dim boolZero As Boolean
Dim strTemp As String
Dim i As Integer, j As Integer
strClass(0) = "十百千万亿兆"
strClass(1) = "拾佰仟萬億兆"
ChnString(0) = "○一二三四五六七八九"
ChnString(1) = "零壹贰叁肆伍陆柒捌玖"

varNumber = Split(Format(Number, "0.################"), ".")
iNumberLen = Len(varNumber(0))
If Number < 0 Then
varNumber(0) = Right$((varNumber(0)), iNumberLen - 1)
iNumberLen = iNumberLen - 1
End If
iCapital = Abs(CInt(Capital))

If Simple Then
For i = 1 To iNumberLen
j = CInt(Mid$(varNumber(0), i, 1))
ChnNumber = ChnNumber & Mid$(ChnString(iCapital), j + 1, 1)
Next
If UBound(varNumber) > 0 Then
iNumberLen = Len(varNumber(1))
For i = 1 To iNumberLen
j = CInt(Mid$(varNumber(1), i, 1))
strTemp = strTemp & Mid$(ChnString(iCapital), j + 1, 1)
Next
End If
If Len(strTemp) > 0 Then ChnNumber = ChnNumber & "点" & strTemp
If Number < 0 Then ChnNumber = "[负]" & ChnNumber
Exit Function
End If

If iNumberLen < 2 Then
If iNumberLen = 0 Then varNumber(0) = "0"
ChnNumber = Mid$(ChnString(iCapital), CInt(varNumber(0)) + 1, 1)
Else
For i = 0 To iNumberLen - 1
j = CInt(Mid$(varNumber(0), iNumberLen - i, 1))
strTemp = Mid$(ChnString(iCapital), j + 1, 1)

If j = 0 Then
If boolZero = True Then strTemp = ""
If i Mod 4 = 0 Then
strTemp = ""
boolZero = True
If i > 0 Then
strTemp = Mid$(strClass(iCapital), i / 4 + 3, 1)
If iNumberLen - i > 4 Then
If CInt(Right$(Left$(varNumber(0), iNumberLen - i), 4)) = 0 Then strTemp = ""
End If
End If
End If
If strTemp = "零" And Capital Then boolZero = True
If strTemp = "○" And Not Capital Then boolZero = True
Else
boolZero = False
If i Mod 4 = 0 Then '万亿兆
j = i / 4 Mod 3
If j = 0 Then j = 6 Else j = j + 3 '可能出现的天文数字
If i > 0 Then strTemp = strTemp & Mid$(strClass(iCapital), j, 1)
Else '十百千位
strTemp = strTemp & Mid$(strClass(iCapital), i Mod 4, 1)
End If
End If
ChnNumber = strTemp & ChnNumber
strTemp = ""
Next
End If
'处理小数部分
If UBound(varNumber) > 0 Then
iNumberLen = Len(varNumber(1))
For i = 1 To iNumberLen
j = CInt(Mid$(varNumber(1), i, 1))
strTemp = strTemp & Mid$(ChnString(iCapital), j + 1, 1)
Next
End If
If Len(strTemp) > 0 Then ChnNumber = ChnNumber & "点" & strTemp
If Number < 0 Then ChnNumber = "[负数]" & ChnNumber
End Function

[csdngoodnight]

关机消息的拦截

'模块代码
Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_ENDSESSION = &H16
Public Const WM_QUERYENDSESSION = &H11

Public preWinProc As Long

Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_QUERYENDSESSION Then
Debug.Print "QryEnd", wParam, lParam
Else
If Msg = WM_ENDSESSION Then
If wParam = 0 Then '代表将顺利关机或LogOff，这时便得做正常结束程序的操作
'实际下面这些代码不会被执行,为了测试结果,先写上
Open "c:\ttt.txt" For Output As #1
Print #1, "正常关闭程序" & vbCrLf
Close #1
Else 'wParam = 1
Open "c:\ttt.txt" For Output As #1
Print #1, "非正常关闭程序. wParam = " & wParam & vbCrLf & "关机时间:" & Now & vbCrLf
Close #1
End If
End If
End If

'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function


'关机消息的拦截

'在关机或Logff前信息的拦截

'如果我们关机或Logoff时，我们的程序有时会因而无法按正常程序结束，一般我们会在Form的Unload中一段程序结束时
'要做什么事，但是，如果使用者直接用开始功能菜单的关机，会使UnLoad的部份没有做到，
'我们现在就想办法来拦截关机(或Logoff)时的信息?

'一般来说，关机或Logff后，Windows会传依序送出WM_QUERYENDSESSION的信息给每个Process，
'如果中间有一个Process不能顺利结束(例如：Word修改后未存档，而出现是否存档，但我们按取消)，
'这时该信息执行的结果会传回False(0)，这时Windows也就不再继续送WM_QUERYENDSESSION给下一个Proccess。
'反之，如果所有的Process都可以顺利结束(也就是每个送出的WM_QUERYENDSESSION都传回True)，
'那才代表可以顺利结束。

'不管WM_QUERYENDSESSION最后的结果是可以顺利结束或不能顺利结束，
'Windows会再送一个WM_ENDSESSION的信息给所有的Process，
'而wParam的内容便是指出是否可以顺利结束(True菜单可以，False菜单不行，
'在vb中则Check wParam = 0 菜单False，1菜单True)，说到这里大概就知道该如何做啦，程序如下：

'窗体代码
Private Sub Form_Load()
Dim ret As Long

'记录原来的Window Procedure的位址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'设定form的window Procedure到wndproc
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
Dim fno As Long

'取消Message的截取，而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)

'这里只是要看看用关机的方式结束程序时，会不会执行到这里
'退出程序时,会建立这个文件,并写入一段内容
fno = FreeFile
Open "c:\tt2.txt" For Append As fno
Print #fno, "ccc1" & vbCrLf & Now
Close #fno
End Sub


------------------------------------------------
'利用API实现清除文档名

'范例
'其中uFlags如为1,pv则为一路径字符串的地址;如为2,则为项标示列表的地址。
Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)

Private Sub Command1_Click()
Call SHAddToRecentDocs(2, vbNullString)
End Sub

'如果程序设计需要往"文档"菜单中添加文件,只需把vbNullString改为文件的路径,如“c:\windows\a.txt"

[csdngoodnight]

vb实现多线程！ S.F.（原作）
昨晚2:30的时候还没睡着，觉得有必要把vb编写多线程程序再次写一次；主要是以前忽略
的细节和重要的环节；今天在公司打开一年多没用的vb，写了如下的代码；想写多线程
的朋友可以调试一下看看，关于多线程的任务模式，同步和互斥，临界资源和临界区
（文中提到）欢迎跟帖讨论；
'请将该部分数据保存为 FORM1.frm 文件
VERSION 5.00
Begin VB.Form Form1
Caption = "多线程"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 6450
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 6450
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text1
Height = 270
Left = 960
TabIndex = 2
Text = "2"
Top = 2760
Width = 2415
End
Begin VB.CommandButton Command2
Caption = "返回"
Height = 255
Left = 3480
TabIndex = 1
Top = 2760
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Start Count"
Height = 255
Left = 3480
TabIndex = 0
Top = 240
Width = 1455
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "主线程执行结果测试:"
Height = 180
Left = 600
TabIndex = 3
Top = 2400
Width = 1710
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'下载地址:http://www.bssoft.com.cn/vbThread.rar

Private Sub Command1_Click()
'声明了线程ID
Dim threadid1 As Long
Dim threadid2 As Long

'参数一，lpThreadAttributes 线程安全属性，传递为NULL
'参数二，dwStackSize ，线程堆栈大小，可以为0，表示堆栈和此应用堆栈相同
'参数三，lpstartAddress ，执行函数地址，用AddressOf 获取
'参数四，lpParameter ，执行函数的参数地址，可以是一个记录或者是别的类型，用VarPtr获取参数地址（varptr为未公开函数）！！
'参数五，dwCreationFlags ，表示线程创建后的状态！，0表示立即运行，create_SUSPENDED表示线程挂起
'参数六，lpThreadID 表示分配给线程的线程号
Call CreateThread(Null, ByVal O&, AddressOf Module1.OutText1, VarPtr(0), ByVal 0&, threadid1)
Call CreateThread(Null, ByVal 0&, AddressOf Module1.OutText2, VarPtr(0), ByVal 0&, threadid2)

End Sub

Private Sub Command2_Click()
'该事件运行于主线程！
Dim i As Long
i = CLng(Text1.Text)
Text1.Text = CStr(i * i) '不要点击次数太多，LONG 类型会溢出
End Sub

Private Sub Form_Load()
'保存窗体句柄全局变量，用于在form 上绘图
formhandle = Form1.hwnd
End Sub



'请将该部分数据保存为 Module1.bas 文件
Attribute VB_Name = "Module1"

'线程安全属性数据结构；
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

'这个是用于多线程访问临界资源同步Api的数据结构
Public Type CRITICAL_SECTION
dummy As Long
End Type
'为什么用GDI 函数绘图？原因等下再讲
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
'请注意；createThread APi声明已被我修改过，修改的地方请自行参照APIView复制的内容
Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
'这个是sleep,作用就是让两个线程绘图频率不一致，效果才明显。
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Sub EnterCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION) '进入临界区
Public Declare Sub LeaveCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION) '离开临界区

'几个重要的函数举例
'ObjPtr：返回对象实例私有域的地址。
'StrPtr：返回字符串第一个字的地址。
'VarPtr：返回变量的地址。

'全局的form的句柄！
Public formhandle As Long
'临界数据结构
Public sect As CRITICAL_SECTION

Sub OutText1() '过程一
Dim i As Long
Dim dc As Long
Dim s As String
dc = GetDC(formhandle) '获取窗体句柄的DC
For i = 1 To 100000
s = CStr(i)
Call SetBkColor(dc, &HF0F0F0) '设置绘制区域的背景色，也起清除作用
Call TextOut(dc, 10, 10, s, Len(s)) '输出文本！
Call Sleep(40) '等待
Next
Call ReleaseDC(formhandle, dc) '释放资源！
' Call EnterCriticalSection(sect)
' 上下表示该处为临界区，如果要对工程全局变量做操作，最好在该区域内
' 否则线程同步过程中，非常容易让程序崩溃
' Call LeaveCriticalSection(sect)
End Sub

Sub OutText2() '和过程一类似
Dim i As Long
Dim dc As Long
Dim s As String
dc = GetDC(formhandle)
For i = 1 To 100000
s = CStr(i)
Call SetBkColor(dc, &HF0F0F0)
Call TextOut(dc, 10, 80, s, Len(s)) '文本位置改变了
Call Sleep(20) '延时改变了
Next
Call ReleaseDC(formhandle, dc)
' Call EnterCriticalSection(sect)
' Call LeaveCriticalSection(sect)
End Sub


'关于为何使用gdi 函数输出文本，这是一个很重要的内容；
'程序在记数时用了难用的TextOut 函数，而没有使用标签控件，这是因为
'vb的组件不都是线程安全的，当多线程访问不是线程安全的组件，那么会
'产生严重错误。

'mailto:[e-mail]
'作者：萧寒(410000)

--------------------------------------------

切换中文输入法

Option Explicit

Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" _
(ByVal pwszKLID As String) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" _
(ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
Private Declare Function ActivateKeyboardLayout Lib "user32" _
(ByVal hkl As Long, ByVal flags As Long) As Long

Const IME_CONFIG_GENERAL = 1
Const KLF_REORDER = &H8
Const KLF_ACTIVATE = &H1

Dim La(15) As Long
Dim LayoutName() As String

Private Sub Form_Load()
'获取输入法
Dim strTemp As String * 256
Dim x As Integer, i As Integer

'获得输入法总数
x = GetKeyboardLayoutList(32, La(1))
If x = 0 Then Exit Sub

ReDim LayoutName(x) As String
For i = 0 To x
ImmGetDescription La(i), strTemp, 256

If InStr(strTemp, Chr(0)) = 1 Then
LayoutName(i) = "英语（美国）"
Else
LayoutName(i) = Left(strTemp, InStr(strTemp, Chr(0)))
End If
Next


'加入列表
For i = 0 To x
Combo1.AddItem LayoutName(i)
Next
Combo1.ListIndex = 0

End Sub

Private Sub Text1_GotFocus()
'设置输入法
ActivateKeyboardLayout La(Combo1.ListIndex), 1
End Sub

[csdngoodnight]

查询回收站
【Form Code:将下面代码用记事本保存为 Form1.frm(窗体文件),此括弧及括弧内容除外】

VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Query Recycle Bin"
ClientHeight = 2715
ClientLeft = 5505
ClientTop = 3660
ClientWidth = 3195
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2715
ScaleWidth = 3195
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 615
Left = 2550
Picture = "Form1.frx":0000
ScaleHeight = 615
ScaleWidth = 615
TabIndex = 7
Top = 1575
Width = 615
End
Begin VB.CheckBox Check1
Caption = "全部"
Height = 375
Left = 150
TabIndex = 6
Top = 1560
Width = 1575
End
Begin VB.DriveListBox Drive1
Height = 315
Left = 150
TabIndex = 3
Top = 150
Width = 2895
End
Begin VB.CommandButton Command1
Caption = "查看"
Default = -1 'True
Height = 495
Left = 855
TabIndex = 0
Top = 2100
Width = 1485
End
Begin VB.Label Label4
Height = 255
Left = 975
TabIndex = 5
Top = 1125
Width = 2040
End
Begin VB.Label Label2
Height = 255
Left = 1815
TabIndex = 2
Top = 675
Width = 1200
End
Begin VB.Label Label3
Caption = "Bytes:"
Height = 255
Left = 150
TabIndex = 4
Top = 1125
Width = 840
End
Begin VB.Label Label1
Caption = "Number of Items:"
Height = 375
Left = 150
TabIndex = 1
Top = 675
Width = 1905
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function SHQueryRecycleBin Lib "shell32.dll" _
Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, _
pSHQueryRBInfo As SHQUERYRBINFO) As Long

Private Type int64
LowPart As Long
HighPart As Long
End Type

Private Type SHQUERYRBINFO
cbSize As Long ' SHQUERYRBINFO结构变量的大小
i64Size As int64 ' 回收站中对象大小
i64NumItems As int64 ' 回收站中对象数名
End Type

Private Sub Command1_Click()
Dim pSHQueryRBInfo As SHQUERYRBINFO

pSHQueryRBInfo.cbSize = Len(pSHQueryRBInfo)

If Check1.Value Then
SHQueryRecycleBin "", pSHQueryRBInfo
Else
SHQueryRecycleBin Drive1.Drive, pSHQueryRBInfo
End If

' Items in Recycle Bin
Label2.Caption = pSHQueryRBInfo.i64NumItems.LowPart

' Bytes in Recycle Bin
Label4.Caption = pSHQueryRBInfo.i64Size.LowPart & " bytes"
End Sub

------------------------------------------------



'任务栏的显示与隐藏

Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private hTaskWnd As Long

Private Sub Command1_Click()
Call ShowWindow(hTaskWnd, SW_HIDE)
End Sub

Private Sub Command2_Click()
Call ShowWindow(hTaskWnd, SW_NORMAL)
End Sub

Private Sub Form_Load()
hTaskWnd = FindWindow("shell_traywnd", "")
End Sub


---------------------------------------------------------

搜寻所有字体名称

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Const CB_FINDSTRING = &H14C

Private Sub Combo1_Change()
Dim iStart As Integer
Dim sString As String
Static iLeftOff As Integer

iStart = 1
iStart = Combo1.SelStart

If iLeftOff <> 0 Then
Combo1.SelStart = iLeftOff
iStart = iLeftOff
End If

sString = CStr(Left(Combo1.Text, iStart))
Combo1.ListIndex = SendMessage(Combo1.hwnd, B_FINDSTRING, -1, ByVal CStr(Left(ombo1.Text, iStart)))

If Combo1.ListIndex = -1 Then
iLeftOff = Len(sString)
Combo1.Text = sString
End If

Combo1.SelStart = iStart
iLeftOff = 0
End Sub

Private Sub Form_Load()
Dim i As Integer
For i = 0 To Screen.FontCount - 1
Combo1.AddItem Screen.Fonts(i)
Next i
End Sub


-----------------------------------------------


隐藏Windows开始按钮
【Form Code:将下面代码用记事本保存为 Form1.frm(窗体文件),此括弧及括弧内容除外】
VERSION 5.00
Begin VB.Form frmMain
Caption = "隐藏Windows开始按钮"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.OptionButton Option1
Caption = "隐藏Windows开始按钮"
Height = 495
Index = 1
Left = 1268
TabIndex = 1
Top = 1650
Width = 2145
End
Begin VB.OptionButton Option1
Caption = "显示Windows开始按钮"
Height = 495
Index = 0
Left = 1268
TabIndex = 0
Top = 1050
Value = -1 'True
Width = 2145
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const SW_HIDE = 0
Private Const SW_SHOW = 5

Private Sub Form_Unload(Cancel As Integer)
If Option1(1).Value Then Call Option1_Click(0)
End Sub

Private Sub Option1_Click(Index As Integer)
Dim hLong As Long
Dim hwnd As Long

hwnd = FindWindow("Shell_TrayWnd", vbNullString)
hLong = FindWindowEx(hwnd, 0, "Button", vbNullString)

Select Case Index
Case 0
ShowWindow hLong, SW_SHOW
Case 1
ShowWindow hLong, SW_HIDE
End Select
End Sub

[vbman2003]

呵呵，LZ辛苦了

先收藏，慢慢消化

[viena]

LZ辛苦

vbman2003(佳人)大哥还收藏呢，呵呵
我一起收藏过好多代码，都没时间看；
后来都丢了，
现在不用VB了，唉~

[viena]

错字，汗
我一起收藏过 =〉我以前收藏过

[windlyc]

强

[vbman2003]

“佳人”我是“见利妄为”，有好东西就先据为己有再说，呵呵

不过确实平时很少有时间去看，不过真正遇到问题的时候，还是先会到收藏夹中去看看。

[bobdog1215]

原来大家都这样的啊
我有时候看到大家贴出好的东西拉
都要收藏着呢
想自己慢慢消化 整合到自己的Demo中
后来觉得这也满累的 就算了
等什么时候遇到问题
再去看看 嘿嘿

[csdngoodnight]

Replace函数


描述

返回一个字符串，该字符串中指定的子字符串已被替换成另一子字符串，并且替换发生的次数也是指定的。

语法

Replace(expression, find, replacewith[, start[, count[, compare]]])

Replace函数语法有如下几部分：

部分 描述
expression 必需的。字符串表达式，包含要替换的子字符串。
find 必需的。要搜索到的子字符串。
replacewith 必需的。用来替换的子字符串。
start 可选的。在表达式中子字符串搜索的开始位置。如果忽略，假定从1开始。
count 可选的。子字符串进行替换的次数。如果忽略，缺省值是 –1，它表明进行所有可能的替换。
compare 可选的。数字值，表示判别子字符串时所用的比较方式。关于其值，请参阅“设置值”部分。


设置值

compare参数的设置值如下：

常数 值 描述
vbUseCompareOption –1 使用Option Compare语句的设置值来执行比较。
vbBinaryCompare 0 执行二进制比较。
vbTextCompare 1 执行文字比较。
vbDatabaseCompare 2 仅用于Microsoft Access。基于您的数据库的信息执行比较。


返回值

Replace的返回值如下：

如果 Replace返回值
expression长度为零 零长度字符串("")。
expression为Null 一个错误。
find长度为零 expression的复本。
replacewith长度为零 expression的复本，其中删除了所有出现的find 的字符串。
start > Len(expression) 长度为零的字符串。
count is 0 expression.的复本。


说明

Replace函数的返回值是一个字符串，但是，其中从start所指定的位置开始，到expression字符串的结尾处的一段子字符串已经发生过替换动作。并不是原字符串从头到尾的一个复制。




'示例:
Private Sub Command1_Click()

Dim s As String
s = "AABBCDEFG1234567AA7654321AABAACDEFG"
'将所有"AA"替换为"@@"
Debug.Print Replace(s, "AA", "@@")
'@@BBCDEFG1234567@@7654321@@B@@CDEFG

'将所有"AA"去掉
Debug.Print Replace(s, "AA", "")
'BBCDEFG12345677654321BCDEFG
End Sub


-------------------------------------------------


StrReverse函数


描述

返回一个字符串，其中一个指定子字符串的字符顺序是反向的。

语法

StrReverse(string1)

参数string1是一个字符串，它的字符顺序要被反向。如果string1是一个长度为零的字符串("")，则返回一个长度为零的字符串。如

果string1为Null，则产生一个错误。



'示例:
Private Sub Command1_Click()

Dim s As String
s = "12345ABC"
'将字符串翻转
Debug.Print StrReverse(s)
'CBA54321

End Sub

[coldleafzl]

看了很有用，对vb的功能又有了新的理解

[efengxu]

楼主好人啊，真的是好人啊！

[x_x_j]

楼主好人，楼主牛人！

[maya091867]

楼主牛人，先收藏再说。呵呵

[csdngoodnight]

to:
b*****[e-mail]
林**
已经给你回复了.

[csdngoodnight]

to:
b*****[e-mail]
林**
已经给你回复了.

[Misszhangdi]

这哪里是下雪,下代码了

[wlk]

牛人一个

[xiaoMONKEY]

不管三七二十一，搬个板凳坐着学习.

[kmlxk0]

收藏！～