刘福兴的个人资料

让窗口永远在最底层 Const HWND_BOTTOM = 1 Const SWP_NOSIZE = &H1 Const SWP_NOMOVE = &H2 Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long SetWindowPos Form.hWnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE

VB编程乐园联合开发项目倡议书,本活动难度不高,初学者,高手都可参在VB吧里看到联合开发项目的贴真是高兴级了,可是等了这么长时间了还是没有动静,看来凶多吉少,如果有兴趣的话,去我的吧里看看,我把软件的模块已经都写好了,大家各尽所能,让我们一起努力开发出属于我们自己的软件,本活动难度不高,不管初学者,高手都可以参加,让我们一起努力!http://post.baidu.com/f?ct=&tn=&rn=&pn=&lm=&sc=&kw=VB%B1%E0%B3%CC%C0%D6%D4%B0&rs2=0&myselectvalue=1&word=VB%B1%E0%B3%CC%C0%D6%D4%B0&submit=%B0%D9%B6%C8%D2%BB%CF%C2&tb=on

VB编程乐园联合开发项目倡议书前段时间看到VB吧联合开发项目的倡议书后真的非常高兴,原以为这次终于可以看到集体开发的软件了,可是等了这么长时间还是没有动静,真的很失望,看来又是凶多及少,所以我在这里写下了这个倡议书,希望大家加入这个团队,让我们一起努力开发属于我们自己的项目. 这里真诚的欢迎每一个喜欢VB的人,不管是初学者还是高手,在这里一视同仁,我们都是为了一个目标而努力,只要你对项目有心就行,这里欢迎真心的朋友来一起努力,对捣乱的人只好抱歉的说一声:对不起. 这是本吧第一次联合开发,我们把第一次定位在一个小型的软件上,这次只求开发成功,为我们以后的联合开发打下基础,下面我把我的设想写在下面,这只是我的临场发挥,我并没有深刻的考虑过,肯定有不妥的地方,大家有好的建议,可以随时联系我.我的电话:0315-3987809,刘福兴,真心希望大家加入.大家可以选择自己擅长的模块去做,可以一人做,也可以几个人做,最后我们把源码组到一起,在软件中加入我们团体人员的名字,相信自己看到软件的时候也是非常高兴的,闲话少说,我把软件模块写在下面,大家选择好后回贴.软件模块:1.一键操作(把一些我们常用的软件设定好热键,然后按键运行,方便我们的操作)2.文件加密器(算法自选,加密后的文件双击出现密码输入窗口,密码正确后解开文件)3.灰色按钮精灵(在网上有类似的软件,就是把一些不可操作的菜单,按钮,也就是黑色的,让它变亮,变成可以操作的,这些对于我这些想用正版软件却没有钱买的人很有用的,相信不会只有我这样)4.墙纸自动更换(这个就不用多说了,就是换我们的桌面,要求可以设定时间,可以把图片列表保存,下次打开时自动载入)5.系统锁定（这是游戏玩家常用的一个模块，就是锁定屏幕，不允许进行任何操作，输入密码后锁定，再次输入解锁）6.迷你关机，重启，注锁，并可以设成热键，一键操作。7.游戏防火墙（就是帮助一些家长管理孩子，把一些不想让别人玩的游戏设定好，防火墙定时检测系统，如果发现这些游戏，把游戏关闭并做出提示）8.任务管理器（这个应该不陌生吧，但功能要比windows的有所增强，比如可以把进程设定密码，可以隐藏进程，可以结束系统进程等，大家发挥自己的想象力吧）9.键盘锁定（可以设定锁定任何键，并要求设定密码，不解锁后永远也不能用）10.注册表修改精灵（可以做一些常用的优化，不需要了解过多的注册表知识就能完成，为了方便初学者）11.破解ACCESS97密码12.破解ACCESS2000密码（这两项功能对于我们VB人来说应该是有用的吧！）13.网络记时器（可以设定时间，到时间后自动挂断，这也应该是为了家长考虑的）14.监控上网过程（就是记录下上网开的网页，也是为了家长考虑的）好了，由于时间的关系就先写到这里吧，一会我要下班了：），大家有好的建议可以留言，或给我打电话，发邮件：[email protected]也行，让我们一起努力做的最好。大家选择自己最擅长的模块，我们用最少的时间做好，让我们一起努力吧！本次活动将开放所有源程序，但是只是在参与者之间进行，因为这是我们共同的成果。

让程序的鼠标支持滚轮以下代码写在模块里面 Public Const GWL_WNDPROC = (-4) Public Const WM_COMMAND = &H111 Public Const WM_MBUTTONDOWN = &H207 Public Const WM_MBUTTONUP = &H208 Public Const WM_MOUSEWHEEL = &H20A Public Oldwinproc As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _ ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _ ByVal nIndex As Long) As Long Public Function FlexScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '支持滚轮的滚动 Yu 2004-5-10 15:33 Select Case wMsg Case WM_MOUSEWHEEL Select Case wParam Case -7864320 '向下滚 SendKeys "{PGDN}" Case 7864320 '向上滚 SendKeys "{PGUP}" End Select End Select FlexScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam) End Function 以下代码写在窗体里面 Private Sub MfgMonth_GotFocus() Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC) SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll End Sub Private Sub MfgMonth_LostFocus() SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc End Sub

自己编程模拟 MouseEnter,MouseExit 事件以下代码写在模块里面 Public Const GWL_WNDPROC = (-4) Public Const WM_COMMAND = &H111 Public Const WM_MBUTTONDOWN = &H207 Public Const WM_MBUTTONUP = &H208 Public Const WM_MOUSEWHEEL = &H20A Public Oldwinproc As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _ ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _ ByVal nIndex As Long) As Long Public Function FlexScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '支持滚轮的滚动 Yu 2004-5-10 15:33 Select Case wMsg Case WM_MOUSEWHEEL Select Case wParam Case -7864320 '向下滚 SendKeys "{PGDN}" Case 7864320 '向上滚 SendKeys "{PGUP}" End Select End Select FlexScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam) End Function 以下代码写在窗体里面 Private Sub MfgMonth_GotFocus() Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC) SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll End Sub Private Sub MfgMonth_LostFocus() SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc End Sub

制作TopMost窗口制作TopMost窗口很简单，只需一个API函数就可以实现。下面的例子就实现了这个功能。 >>步骤1----建立新工程，在窗体上放置一个CommandButton按钮。 >>步骤2----编写如下代码： Private Const SWP_NOSIZE = &H1 Private Const SWP_NOMOVE = &H2 Private Const HWND_TOPMOST = -1 Private Declare Function SetWindowPos Lib \"user32\" ( _ ByVal hwnd As Long,ByVal hWndInsertAfter As Long, _ ByVal X As Long,ByVal Y As Long, _ ByVal cx As Long, ByVal cy As Long, _ ByVal wFlags As Long) As Long Private Sub Command1_Click() SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE _ Or SWP_NOSIZE End Sub >>步骤3----编译运行，点击Command1,看看是不是始终位于最上层。要去掉TopMost属性，只要将参数HWND_TOPMOST换成HWND_NOTOPMOST, 当然，得说明常量：HWND_NOTOPMOST = -2

将繁体中文字转化成简体中文 VB6中提供的StrConv这个函数，完全可以解决简繁体的转换问题。下面是一个简繁体的转换的函数，利用该函数区区几行代码，就可以轻松地实现简体到繁体、繁体到简体的相互转化。'****** 简繁体互换 GB-->BIG5 Or BIG5-->GB *****************'参数sStr为需要转换的文本'参数iConver为要转化的类型，为1时表示繁体到简体的转换，为2时表示简体到繁体的转换Function GBBIG5(sStr As String, iConver As Integer) As StringOn Error Resume Next Dim STR If iConver = 1 Then 'BIG5-->GB STR = StrConv(sStr, vbFromUnicode, &H804) GBBIG5 = StrConv(STR, vbUnicode, &H404) ElseIf iConver = 2 Then 'GB-->BIG5 STR = StrConv(sStr, vbFromUnicode, &H404) GBBIG5 = StrConv(STR, vbUnicode, &H804) End IfEnd Function使用方法Private Sub Command1_Click() Text2.Text = GBBIG5("我是中国人，我爱我的人民", 2)End Sub

在WIN2000下实现程序的关机在Win2000下比较难用，你还要获得系统权限的你须要引用下面的APIPublic Const EWX_FORCE = 4Public Const TOKEN_ADJUST_PRIVILEGES = &H20Public Const TOKEN_QUERY = &H8Public Const SE_PRIVILEGE_ENABLED = &H2Public Const ANYSIZE_ARRAY = 1Type LUID lowpart As Long highpart As LongEnd TypeType LUID_AND_ATTRIBUTES pLuid As LUID Attributes As LongEnd TypeType TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTESEnd TypeDeclare Function GetCurrentProcess Lib "kernel32" () As LongDeclare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As LongDeclare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As LongDeclare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongSub AdjustTokenPrivilegesForNT() Dim hdlProcessHandle As Long Dim hdlTokenHandle As Long Dim tmpLuid As LUID Dim tkp As TOKEN_PRIVILEGES Dim tkpNewButIgnored As TOKEN_PRIVILEGES Dim lBufferNeeded As Long hdlProcessHandle = GetCurrentProcess() OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _ TOKEN_QUERY), hdlTokenHandle LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid tkp.PrivilegeCount = 1 tkp.Privileges(0).pLuid = tmpLuid tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED AdjustTokenPrivileges hdlTokenHandle, False, tkp, _ Len(tkpNewButIgnored), tkpNewButIgnored, _ lBufferNeededEnd Sub关机时用下面的代码 AdjustTokenPrivilegesForNT ExitWindowsEx uFlags, 0

程序只运行一个实例，并且把前一个激活 Option ExplicitPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As LongConst SW_RESTORE = 9Private Const OPEN_APPLICATION = 0Private Const SINGLE_INSTANCE_OPEN = 1Sub Main()Dim MultiInstResult As IntegerMultiInstResult = MultiInstIf MultiInstResult = OPEN_APPLICATION Then Form1.Show ElseIf MultiInstResult = SINGLE_INSTANCE_OPEN Then EndEnd IfEnd SubPrivate Function MultiInst() As IntegerDim hwndFound As Long Dim strWindowName strWindowName = App.TitleApp.Title = "temp title" hwndFound = FindWindow(vbNullString, strWindowName)If hwndFound Then MultiInst = SINGLE_INSTANCE_OPEN MsgBox "A instance of the application is already open." & vbCrLf & vbCrLf & "Only one open instance allowed.", vbOKOnly + vbExclamation, "App Name" If IsIconic(hwndFound) Then ShowWindow hwndFound, SW_RESTORE SetForegroundWindow hwndFound Else SetForegroundWindow hwndFound End IfElseIf hwndFound = 0 Then App.Title = strWindowName MultiInst = OPEN_APPLICATIONEnd IfEnd 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中则CheckwParam = 0 菜单False ，0菜单True)，说到这里大概就知道该如何做啦，程序如下：　　 ’以下在FormPrivate 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" For Append As fno　Print #fno, "ccc" + vbCrLf　Close #fnoEnd Sub　　 ’以下在.BasOption Explicit　　 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongDeclare 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 = &H16Public 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，这时便得做正常结束程序的操作　　　　　Dim fno As Long　　　　　Open "c:\ttt" For Output As #1　　　　　Print #1, "hahcccc5"　　　　　Close #1　　　End If　　End If　End If　’将之送往原来的Window Procedure　wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)End Function

一个自杀程序下面的代码演示将一个程序在执行时将自己删除。新建一个窗体，并加一上按钮，添如下代码Private Sub Command1_Click() KillMeEnd SubSub KillMe() Path = App.Path If Right(Path, 1) <> "\" Then Path = Path + "\" PathName = Path + App.EXEName + ".EXE" BatName = Path + "1.bat" Open BatName For Output As #1 Print #1, ":START" Print #1, "del " & PathName Print #1, "if exist " & PathName & " GOTO START" Print #1, "del " & BatName Close #1 Shell BatName, vbHide EndEnd Sub

如何学好VB 序：不要老是想着谁“最有钱途”，这些都不是我们应当考虑的，我们要考虑的是怎样才能真正的精通VB。如果成为了VB的专家，应当很容易赚到钱的。VB程序员为什么工资低，不是VB不行，是因为大部份VB程序员不行，他们只懂得用控件，而没有什么编程的思想。而VB的初学都只会用控件和简单的API就说精通VB了，显然影响的整个VB在程序界的地位，这些人显然不能称为程序员的，只能相当于会使用VB了，就像会Word一样。如果VB程序员都懂的数据结构，UML等，就完全是另外一回事了。有认为VB功能弱，请注意：仙剑95版就是用VB4做的，还有DirectX SDK7中有个一很好玩的3D游戏，声音和动画都非常好，也是用VB写的。所以VB能做很多东西，只要你想去做。（1）VB不只是数据库和报表。不要以为VB就是数据库和报表，这只是VB强大功能的一小部份。如果这此都搞不清，还是好好的看一下相关的书籍，比在这里问问题有用多了。我以前没有学过数据库，只是有些编程的思路，后来学数据库就非常容易了。我做报表一般用RichTextBox或是From来做，一般都能做的很好，也不用去考虑什么水晶报表了。（2）不要迷信于API。API能做很多东西，但有些东西在VB里面的函数中就有，API只是VB对WindowsSDK的封装而已。如果想学好API，建议学习SDK。如果VB本身就能很好的支持这个功能，何必还要用API呢。（3）不要什么都想着控件。如果做程序都想着第三方控件的话，代价是很高的，不仅程序大，安全性也低了很多。其实VB本身带的控件已经完全够用了。（4）认认真真的把MSDN中关于VB的内容好好看一看，特别是函数和语句，很有用的。（5）遇到问题不要直接来这里问，自己好好想一想，试着解决这个问题，这虽然在时间上慢了，可是在自身的提高上却有很大的帮助。（6）没事的时候，多研究些语言上的东西，如数据结构和算法，不要老是想着什么花哨的东西。这对以后的提高非常有帮助。（7）如果想精通VB，在VB的基础上，学学VC还是非常的帮助的。拿VC的东西对照VB来想一想。（8）有些很大的问题要自己动脑来想。如设计一整套软件，这是一个非常好的学习机会，不要让别人来帮你设计，只是让别人帮你提些建议。（9）学VB要付出代价的，没有不劳而获的。如果想成为高手，还要会好多与VB不相关的东西，但这些东西都能用到VB上，如photoShop可以做界面美化，TCP/IP协议可以帮你更容易的开发网络程序，MCI和WFV多媒体接口可以更好的开发多媒体应用，英语可以使用更好的学习英文文档。等等好多的。（10）祝初学者都能成功

求助吧友，谁有spltrbar.ocx控件，给我一个（急等着用）

我做了一个公交车查询软件（唐山市的），现在最基本的功能已经实现原来我看到过一个关于北京公交车查询的软件，觉得不错，我也照着那个软件的样子做了一个唐山市的公交车查询程序，（我这个已经和我发现的那个软件界面，功级一模一样了，整整做了差不多一个月了）大家有兴趣下载来看看，如果大家也想做的话，可以把数据库改一下就行，里面字段的数据改了就行，但数据库名称不要改，否则会出错的。下载地址：funlove.ys168.com

大家还为坐公交车不知道怎么走发愁吧，我做了一个公交车查询软件， funlove.ys168.com

VC吧好热闹呀 VC吧现在的人好多呀，大家好，我是新来的

利用VB6.0实现五线谱作曲工具摘要针对数字化音乐教学的需要，提出了基于VB环境开发五线谱作曲工具的可行性，并对其中技术原理、关键问题给出了具体的解决方法，实现了一个基本的可视化作曲工具，对一般音乐教育工作者具有很好的启发性。　　关键词数字化音乐;五线谱;音乐软件　　目前在数字化音乐教学过程中需要用到许多编辑软件和作曲软件。许多音乐教育工作者对如何开发自己的数字音乐工具很感兴趣，而一般的计算机类书刊对此类问题探讨和介绍的比较少，本文试图从这一领域做些原理性的研究工作，以供音乐教育工作者和其他相关爱好者发挥、扩展，起到抛砖引玉的作用。因此本文以业余程序员最熟悉的开发工具VB为平台，开发设计了一个基本的五线谱编辑工具，并实现了数字音乐的合成、播放、保存和读写。　　可视化图形界面的设计　　首先在VB环境中建立一个新的窗体并保存，然后在窗体中建立菜单和工具条，为简便起见，工具条用Option控件组来实现(需要把风格设为Graphical模式)，并把事先做好的图标加载到控件上。图1是五线谱作曲工具的主界面，其中Picture1控件作为可视化编辑工具的客户操作区，Picture2控件中所加载的位图包含了作曲过程中需要的基本音符，在操作过程中通过位图提取的方式来获得相应的音符，然后插入到所需的位置。　　　　图1 VB环境中的设计界面　　五线谱作曲功能的实现　　在工具条上的五个Option控件构成一个控件组，根据Option控件本身的特性，其中一个选中时其它的自动设为非选择项，因此操作起来很方便。当选中其中的一个音符图标后，自动触发相应的事件。事件处理代码如下：Private Sub Option1_Click(Index As Integer)　Picture1.SetFocus ‘ 焦点集中到客户区　Yinfu = Index ‘ 获得音符序号End Sub 　　其中整型数Yinfu是一个全局变量，通过控件组中的索引Index可以知道哪个音符按钮被选中。为了记录作曲过程中的操作，定义一个二维数组Music用来存放数据，光标点取在Picture1客户区中的坐标经过圆整后作为数组的行、列序号，数组元素记录所选的音符。整个处理过程放在Picture1控件的MouseDown事件中进行，代码如下：Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)　Dim LineY&, ColoumX&　LineY& = Round((Y - 13) / 5) ‘行圆整　ColoumX& = Round((X - 30) / 16) ‘列圆整　If Not (ColoumX& > 0 And LineY& > 0) Then　　Exit Sub　End If　If Music(LineY&, ColoumX& + HScroll1.Value) = 0 Then　　Music(LineY&, ColoumX&　　+ HScroll1.Value) = Selection ‘ 记录音符　End If　DisplayNotes ‘在客户区显示当前音符End Sub 　　当程序运行时，首先通过主窗体的Form Load事件在Picture1的客户区绘出五线谱的五条平行的水平线，作曲者便可以根据不同的音高在相应位置插入音符。插入音符的过程是通过上面的DisplayNotes函数来实现的，利用Windows系统的API(应用程序接口)函数Bitblt所具有的内存数据传送的功能将Picture2中位图的一部分提取出来并按照一定的变换后插入到Picture1的客户区制定位置，主要代码如下：Select Case ID　Case 1　　BitBlt Picture1.hdc, X& - 7, Y& - 18, 20, 30, Picture2.hdc, 66, 0, SRCAND　Case 2　　BitBlt Picture1.hdc, X& - 5, Y& - 18, 20, 30, Picture2.hdc, 0, 0, SRCAND　　… 　　　　图2 五线谱作曲工具的运行效果　　曲谱的保存和读取　　在可视化编辑工具中所作的曲目应当能够保存为数据文件。保存和读取的操作是通过通用对话框CommonDialog来实现的，设计程序界面时在窗体上加载一个通用对话框控件。当点取程序菜单上的“保存”时，弹出文件保存对话框，然后设置文件路径对音乐数据进行保存，其代码如下：CommonDialog1.FileName = App.Path & "\*.txt"CommonDialog1.ShowOpen ‘显示保存对话框If CommonDialog1.FileName = App.Path & "\*.txt" Then Exit Sub　Me.MousePointer = 11　For LineY& = 1 To 40　　OutputS = "Tone" & LeadingZeros$(LineY&, 2) & ": "　　For ColoumX = 1 To 150　　　A = Chr(Music(LineY&, ColoumX) + Asc("0"))　　　OutputS = OutputS & A ‘写入文件　　Next ColoumX　　Whole$ = Whole$ & OutputS & vbCrLf　　Next LineY　　Open CommonDialog1.FileName For Output As #1　　Print #1, Whole$　　Close #1 ‘关闭文件　　文件的读取过程与保存过程类似，只要通过Input语句将文件中的数据加载到二维数组Music中去就可以了。　　曲谱的合成与播放　　曲谱的合成是通过Windows自带的多媒体API函数来实现的，这些API函数在winmm.dll文件中，因此需要把该文件引用到程序中。该动态链接库中包含了多个数字音乐(Midi)输入、输出、合成等方面的库函数。在对曲谱进行Midi合成播放时，首先将二维数组Music中的数据转化为数字音频信号，然后通过计算机的声卡播放出来，其中的关键代码如下：For LineY& = 1 To 30　If Music(LineY&, X) <> 0 And Not ISAgainFlag Then　　midimsg = &H90 + ((46 + LineY&) * &H100) + (volume * &H10000) + TempChannel ‘定义音高　　midiOutShortMsg hmidi, midimsg ‘输出音频　End IfNext LineY

Visual Basic程序启动时，自动判断 Access 资料库是否损毁并自动修若程序使用 Access 资料库开发，当 Access 资料库损毁时，一进入程序，便会出现以下讯息： Can't open database 'name'. It may not be a database that your application recognizes, or the file may be corrupt. (Error 3049) 若是程序中未加入错误判断，程序便会中断跳出，这会给予使用者极不好的印象，要避免这种情形，甚至不让使用者发现资料库损毁，便要加入以下之程序码加以判断： Private Sub Form_Load() Dim db As Database On Error GoTo error1 Set db = OpenDatabase("c:\test.mdb") On Error GoTo 0 : '正常程序开始 : Exit Sub error1: If Err = 3049 Then '资料库损毁 DBEngine.RepairDatabase "C:\test.mdb" Resume Else MsgBox Err & Error(Err) End If

TextBox 中接受某些特定字符，例如 \'@#$%\"，简单的写法方法1: 可以使用 IF 或 Select Case 一个个判断, 但如果不接受的字符多时, 较麻烦! 方法2: 将要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 !! 如下： Private Sub Text1_KeyPress(KeyAscii As Integer) Dim sTemplate As String sTemplate = "!@#$%^&*()_+-=" '用来存放不接受的字符 If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then KeyAscii = 0 End If End Sub

在 TextBox 中限制只能输入数字参考下列程序： Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub

调用API函数设计ABOUT窗口 1 ．建立含有如下控件的窗体：控件 NAME CAPTION 窗体 FORM1 用VB6.0 设计ABOUT 窗口命令按钮 COMMAND1 关于销售管理系统 2 ．程序清单： Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hinst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Const GWL_EXSTYLE = (-20) Private Const GWL_STYLE = (-16) Private Const GWL_WNDPROC = (-4) Private Const GWL_HINSTANCE = (-6) Private Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Sub Command1_Click() Dim hinst As Long Dim icons As Long Dim abouts As Long Dim dispx As String Dim dispy As String Dim cps As String Dim space1 As String Dim space2 As String hinst = GetWindowWord(Me.hwnd, GWL_HINSTANCE) icons = ExtractIcon(hinst, "d:fpw26foxprow.exe", 0) Dim sysinfo As SYSTEM_INFO Dim cls1 As Long Dim cls2 As Long Dim secs As Long Dim bytes As Long Dim buffs As String buff = "C:" x = GetDriveType(buffs) x = GetDiskFreeSpace(buffs, secs, bytes, cls1, cls2) cls1 = cls1 * secs * bytes cls2 = cls2 * secs * bytes space1 = "C驱动器总共容量： " + Format$(cls2/1024, "#, #") + "千字节" space2 = "C驱动器可用容量： " + Format$(cls1/1024, "#, #") + "千字节" x = GetSystemMetrics(SM_CXSCREEN) dispx = "显示器分辨率：" + Str$(x) x = GetSystemMetrics(SM_CYSCREEN) dispy = Str$(x) Call GetSystemInfo(sysinfo) Select Case sysinfo.dwProcessorType Case 386 cpus = "处理器类型:386" Case 486 cpus = "处理器类型:486" Case 586 cpus = "处理器类型:586" End Select abouts = ShellAbout(Me.hwnd, "演示程序", "销售管理系统V2.0版权所有[C]1998-2007刘福兴" & Chr$(13) & Chr$(10) & space1 & Chr$(13) & Chr$(10) & space2 & Chr$(13) & Chr$(10) & cpus + " " + dispx + "*" + dispy , icons) End Sub

禁用 Alt-Tab 或 Ctrl-Alt-Del Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Integer, ByVal aBOOL As Integer) As Integer Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Integer) As Integer Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Integer) As Integer Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SystemParametersInfo Lib "user32" Alias " SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long Private TaskBarhWnd As Long Private IsTaskBarEnabled As Integer Private TaskBarMenuHwnd As Integer '禁止或允许使用 Alt-Tab Sub FastTaskSwitching(bEnabled As Boolean) Dim X As Long, bDisabled As Long bDisabled = Not bEnabled X = SystemParametersInfo(97, bDisabled, CStr(1), 0) End Sub '禁止使用Ctrl-Alt-Del Public Sub DisableTaskBar() Dim EWindow As Integer TaskBarhWnd = FindWindow("Shell_traywnd", "") If TaskBarhWnd <> 0 Then EWindow = IsWindowEnabled(TaskBarhWnd) If EWindow = 1 Then IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 0) End If End If End Sub '允许使用Ctrl-Alt-Del Public Sub EnableTaskBar() If IsTaskBarEnabled = 0 Then IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 1) End If End Sub '禁止 Ctrl+Alt+Del '声明(For Win95)： Const SPI_SCREENSAVERRUNNING = 97 Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long 使用： '禁止 Dim pOld As Boolean Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0) '开启 Dim pOld As Boolean Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)

用VB实现“木马”式隐形运行程序程序隐形的示例　　程序的具体编制操作如下：　　 1. 在VB6.0编程环境中，新建一个工程Project1。　　 2. 在Project1中添加模块Modulel，在工程属性中将工程名称改为HiddenMen，应用程序标题也改为HiddenMen（以下程序都经过实际运行测试，可以原样复制使用）。　　在模块Module1中加入如下声明： Public Declare Function GetCurrentProcessId Lib “kernel32” () As Long '获得当前进程ID函数的声明 Public Declare Function RegisterServiceProcess Lib “kernel32” (ByVal ProcessId As Long, ByVal ServiceFlags As Long) As Long '在系统中注册当前进程ID函数的声明　　 3. 在Project1中新建一个窗体Form1，设置Form1的属性： form1.Visible=False form1.ShowInTaskBar=False 　　在代码窗口添加如下代码： Private Declare Function GetDriveType Lib “kernel32” Alias “GetDriveTypeA” (ByVal nDrive As String) As Long '获得当前驱动器类型函数的声明 Private Declare Function GetVolumeInformation Lib “kernel32” Alias “GetVolumeInformationA” (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long '获得当前驱动器信息函数的声明 Private Sub Form_Load() Dim drive_no As Long, drive_flag As Long Dim drive_chr As String, drive_disk As String Dim serial_no As Long, kkk As Long Dim stemp3 As String, dflag As Boolean Dim strlabel As String, strtype As String，strc As Long RegisterServiceProcess GetCurrentProcessId, 1 ' 从系统中取消当前进程 strlabel = String(255, Chr(0)) strtype = String(255, Chr(0)) stemp3 = “172498135” '这是作者C盘的序列号（十进制）,读者可根据自己情况更改。 dflag = False For drive_no = 0 To 25 　 drive_disk = Chr(drive_no + 67) 　 drive_chr = drive_disk & “:\” 　 drive_flag = GetDriveType(drive_chr) 　 If drive_flag = 3 Then 　　 kkk = GetVolumeInformation(drive_chr, strlabel, Len(strlabel), serial_no, 0, 0, strtype, Len(strtype)) '通过GetVolumeInformation获得磁盘序列号　 Select Case drive_no 　　 Case 0 　　 strc = serial_no 　 End Select 　 If serial_no = stemp3 Then 　　 dflag = True 　　 Exit For 　 End If End If Next drive_no If drive_no = 26 And dflag = False Then '非法用户　 GoTo err: End If MsgBox (“HI，合法用户！”) Exit Sub err: 　 MsgBox (“错误!你的C：盘ID号是” & strc) End Sub Private Sub Form_Unload(Cancel As Integer) RegisterServiceProcess GetCurrentProcessId, 0 '从系统中取消当前程序的进程 End Sub 　　将上述程序代码编译后运行，在出现类似“错误!你的C盘ID号是172498135”对话框时，按下Ctrl+Alt+Del键，看看程序名叫“HiddenMen”是否在任务管理器名单列表里。如果把上述程序稍加改动，可以加到自己特定的程序中去。该程序在隐形运行之中，不知不觉就完成了预定功能。

在VB中如何创建闪烁(标语)屏大型应用系统启动运行的时间需要很长时间,其时间会根据需要初始化的数量和用户系统的速度变化,因此在主窗口显示前,应显示一个初始化窗口,使应用程序看起来更具吸引力,因为当装载程序时不断可以向用户显示一些信息，而且可产生美观的视觉效果。例如vb、delphi在启动时均在主界面前显示一splash窗口. ---- 1. 下面是显示闪烁(标语)屏splash的一种简单方法: option explicit private sub form_load() '显示主窗口 me.show '显示splash窗口 frmsplash.show doevents '执行应用程序初始化 initialize '关闭splash窗口 unload spalsh end sub ---- 该过程代码应放在应用程序的启动窗体中。第一个show方法可使windows在屏幕上显示主窗体，下一个show方法显示闪烁屏，它是你设计的名为frmsplash的窗体.在利用show方法之后，再利用Doevents函数，以确保闪烁屏窗体的所有元数立即绘制完。Initialize函数执行应用程序在启动时需要执行的费时任务，例如，从文件中装载数据，将窗体装入内存等等。这时一切都准备就绪. ---- 2.闪烁窗体模板 ---- Visual Basic 中含有许多摸板窗体，其中之一是闪烁屏。要为项目添加Splash screen 窗体，需要从project菜单中选择Add Form.在Add Form 对话框的New标签上选择Splash Screen图标，并单击Open.这样Splash Screen窗体就被添加到项目中. ---- 下列代码显示了如何定制Splash Screen 窗体摸板的实例: option explicit private sub form_load() frmsplash.lbllicenseto=app.legaltrademarks frmsplash.lblcompanyproduct=app.productname frmsplash.lblplatform="window 98" frmsplash.lblcopyright=app.legalcopyright frmsplash.lblcompany=app.companyname frmsplash.lblwarning="Warning:this program is protected" & _ "by copyright law,so don't copy " frmsplash.show doevents initialize unload frmsplash end sub ---- 注意这里使用了app对象，该对象可以访问有关你的应用程序的信息; ---- splash screen 窗体摸板代码模块的代码如下所示: Private Sub Form_keypress(keyascii as integer) unload me End sub Private sub form_load() lblversion.caption="version"&app.major&". "app.minor"."app.revision lblproductname.caption=app.title end sub private sub frame1_click() unload me End Sub

在系统菜单上添加自定义菜单项 ---- 启动Visual Basic，新建标准EXE工程，在工程中添加一标准模块，名称可以是默认的。在标准模块的声明部分加入下列代码： '菜单API函数声明 Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long '菜单API函数常数声明 Public Const MF_BYCOMMAND = "H0" Public Const MF_SEPARATOR ="H800" Public Const MF_STRING = "H0" '有关窗口函数的API函数声明 Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long,ByVal dwNewLong As Long) As Long Public 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 Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '消息 Public Const GWL_WNDPROC = (-4) Public Const WM_NCLBUTTONDOWN = "HA1" Public Const WM_NCRBUTTONDOWN = "HA4" Public Const WM_USER = "H400" Public Const WM_SYSCOMMAND = "H112" Public Const HTSYSMENU = 3 Public Const HTCAPTION = 2 '自定义菜单项的标识号偏移量 Public Const IDM_SEPARATOR = 1 Public Const IDM_MYABOUT = 2 '其他变量 Dim sHwnd As Long Dim OldProc As Long 接着可向标准模块添加下面两个过程： Public Sub AddMenu(frm As Form) '置换窗口函数过程 sHwnd = frm.hwnd OldProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf AddCallBack) End Sub Public Sub Release() '释放自定义窗口函数过程 SetWindowLong sHwnd,GWL_WNDPROC, OldProc End Sub 最后向标准模块中添加一自定义窗口函数过程： Public Function AddCallBack(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case wMsg Case WM_SYSCOMMAND '系统消息 Select Case wParam '测试 Case WM_USER + IDM_MYABOUT '"关于..."菜单项 '此处可加入用户需要自己处理"关于…" 菜单项的代码 MsgBox "单击了添加的菜单条目",vbOKOnly Case Else '其它菜单项交换系统处理 AddCallBack =DefWindowProc(hwnd, wMsg, wParam, lParam) End Select Exit Function Case Else AddCallBack = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam) End Select End Function 关闭标准模块的代码窗口，打开窗体的代码窗口，在Form_Load()过程中加入下列代码： '加载自定义窗口过程 AddMenu Me '获得系统菜单的句柄 Dim hMenu As Long hMenu = GetSystemMenu(Me.hwnd, 0) '在系统菜单中添加自定义2条菜单项 AppendMenu hMenu, MF_SEPARATOR Or MF_BYCOMMAND, IDM_SEPARATOR, vbNullString '分隔符 AppendMenu hMenu, MF_BYCOMMAND Or MF_STRING, WM_USER + IDM_MYABOUT, "关于..." ' "关于…"菜单项在Form_Unload过程中加入下列代码： Release '释放自定义窗口过程

VB应用程序的启动与退出设计在缺省情况下，应用程序中的第一个窗体被指定为启动窗体。应用程序开始运行时，此窗体就被显示出来(因而最先执行的代码是该窗体Form_Initialize事件中的代码)。如果想在应用程序启动时显示别的窗体，就得改变启动窗体，其方法如下： 1从“工程”菜单中，选劝工程属性”。 2选劝通用”。 3在“启动对象”下拉列表中，选取要作为新启动窗体的窗体。 4选劝确定”。没有启动窗体时的启动有时候需要在应用程序启动时不加载任何窗体。例如想先运行装入数据文件的代码，然后再根据数据文件的内容决定显示几个不同窗体中的哪一个。为此，可在标准模块中创建一个名为Main的子过程，并将其设为启动对象。 SubMain() DimintStatusAsInteger ′调用一个函数过程来检验用户状态 intStatus=GetUserStatus ′根据状态显示某个启动窗体 IfintStatus=1Then frmMainShow Else frmPasswordShow End If 注意：这个过程必须是一个子过程，且不能在窗体模块内。结束应用程序当所有窗体都已关闭并且没有代码正在执行时，事件驱动的应用程序就停止运行。如果最后一个可见窗体关闭时仍有隐藏窗体存在，那么，应用程序表现为已经结束了(因为没有可见的窗体)，可实际上却仍在继续运行，直至所有隐藏窗体都关闭为止。之所以出现这种情况，是因为对已卸载窗体的属性或控件的任何访问，都将导致隐含地、不予显示地加载那个窗体。为了避免出现这类问题，最好的办法是确保所有的窗体都已卸载，可以使用Forms集合和Unload语句。例如在主窗体上可以用一个名为cmdQuit的命令按钮来退出程序，如果应用程序只有一个窗体，则Click事件过程可简单为：PrivateSubcmdQuit_Click()UnloadMeEndSub如果应用程序使用多窗体，通常把代码放入主窗体的Unload事件过程可以卸载这些窗体。可以使用Forms集合确保找到并关闭所有窗体。 PrivateSubForm_Unload DimiasInteger ′在窗体集合中循环并卸载每个窗体 Fori=0toFormsCount－1 UnloadForms(I) Next End Sub

DBF文件转为MDB文件的方法 1.用手动的话，Access 97 做比较轻松，工具也较完整。合成以后一样可以供 Vb 利用。 2.如果你坚持要自动，那么原则是 a.用 Access 做个同结构的 Mdb 空档。 b.用一个 FileListBox 指向 *.dbf 的目录。 c.用 Dao 物件读入 mdb 空档。 d.用 for next 回圈一一读入各 Dbf,如： for i=0 to FileListBox.listcount 开启 FileListBox.list(i) 的 dbf for j=0 to FileListBox.list(i).recordcount mdb空档.addnew FileListBox.list(i).record(j) next next

一组VB实用小程序用VB实现编程离不开函数调用及Windows API函数的调用，以下是笔者收集的一些实用的小例程，它们可以直接用在你的实际编程中，也可以根据实际应用加以扩充完善。其中涉及Windows API函数调用的代码你可以从VB5.0系统的API函数查看器中复制函数定义内容，以避免出错。 1.系统型表单系统型意味着用户完成当前表单操作之前无法进行其它操作，这对于编制系统口令保护界面尤为重要。如果你希望当前表单系统型表单，需如下定义API函数： Declare Function SetSysModalWindow Lib "User" (ByVal hWnd As Integer) As Integer 然后调用：oldSysModal = SetSysModalWindow([Form].hWnd) 2.获取驱动器类型代码如后： Declare Function GetDriveType Lib “Kernel" (ByVal nDrive As Integer) As Integer Global Const DRIVE_REMOVEABLE％ = 2, DRIVE_FIXED％ = 3 Global Const DRIVE_REMOTE％ = 4 3.表单在对中本子程序功能使表单定位在屏幕中央，在表单中任何需要表单对中的地方只需加入一行代码： “centerwindow.me”即可成功调用。 Public Sub CenterWindow(f As Form) f.Top = (Screen.Height ＊ .5) － (f.Height ＊ .5) f.Left = (Screen.Width ＊ .5) － (f.Width ＊ .5) End Sub 4. 定义变量许多的程序员习惯于如下定义变量： Dim iNum, iNextNum, iLastNum as Integer 实际上只有最后一个变量被设为了整型，前两个变量则是系统的缺省的Variant 数据类型，而Variant 数据类型可用来替换任何数据类型，显然对于精练的程序设计是不利的。正确的方法如下： Dim iNum as Integer Dim iNextNum as Integer Dim iLastNum as Integer 5. 使文本高亮本子程序使被触发的诸如文本，标签等控件的文本被选中 Public Sub SetSelected() Screen.ActiveControl.SelStart = 0 Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text) End Sub 6. 关闭其它程序下面的代码可关闭内存中的其它程序 title = "MyAPP" '定义你需关闭的程序窗口的标题 ihWnd = findWindow(0＆, Title) ihTask = GetWindowTask (ihWnd) iRet = PostAppMessage(ihTask, WM_QUIT, 0, 0＆) 7. 文件存在否? 本函数返回查找的文件是否存在。 Function FileExist(Filename as string) as Boolean FileExist = Iif(Dir(Filename) <> "", True, False) End Function 8. 主程序唯一用下面提供的代码作你的主程序可防止应用程序的多重执行，你应当将它放在确信需要它的代码模块内。 Public Sub Main() If App.PrevInstance Then BringWindowToTop frmMain.hwnd Else Load frmMain End If End Sub 上面这些精悍的代码对于专业程序员来说非常有实用价值，希望你能从中获得启发。

用VB6编写强力的windows隐藏引擎编程爱好者一定经常见到能够隐藏桌面项目和状态栏等的软件，其中最著名的就是Hide-It。其实我们能够编写一个功能更加强大的即时超级隐藏引擎，它不仅可以隐藏桌面项目、开始按钮、状态栏、时钟栏，而且可以隐藏任何软件的按钮、菜单、工具栏、文本框、状态栏等等，只要是能够看见的独立部分——当然也可以轻松的将它们恢复出来。操作更是方便到了点击“开始隐藏”按钮，然后将鼠标放到需要隐藏的项目上，按下F12键即可——点哪就隐藏哪——这也是我称之为“隐藏引擎”的原因。　　一、编程原理　　（1）WINDOWS API函数ShowWindow可以实现对程序界面（包括WINDOWS9X和其他应用软件）以及子项目的显示控制，通过调用相关消息常数SW_HIDE = 0（隐藏）和SW_SHOW = 5（显示）就可以执行对指定界面项目的隐藏和重新显示出来。它所需要的另外一个参数是被隐藏项目的句柄；　　（2）GetCursorPos函数能够返回当前鼠标所在位置的屏幕坐标，而函数WindowFromPointXY恰好能够根据屏幕坐标返回该位置的窗体项目句柄——这正是我们所需要的！　　（3）为了方便操作，我们需要为它注册一个系统级工作（激活）热键，我选择了F12；SetWindowLong、GetWindowLong、CallWindowProc、RegisterHotKey、UnregisterHotKey是五个必须的热键注册、反注册函数；使用它们一定要小心谨慎，否则可能会导致开发平台的暂时崩溃，你不得不看到“该程序执行了非法操作，即将被关闭”的警示窗口，而且你的工作成果会立即化为乌有；但是如果你按照本文的编写方法，保你“一路平安”；　　（4）为了方便“记忆力”不好的朋友，我们需要一个列表框来显示已经被隐藏的项目的句柄，以便能够适当、必要的提醒。　　二、编程实践　　（1）启动vb6，建立一个标准exe工程，添加一个窗体CHINAHIDE，添加四个command控件hideOK对应“开始隐藏”、unhide对应“恢复一个”、uNhideall对应“全部恢复”；添加listbox控件list1（用来纪录句柄）；两个标签控件用来显示有关提示信息。调整上述控件到适当位置和合适大小，双击窗体，写入以下代码： Dim LasthWnd As Integer '被隐藏项目句柄Private Sub Form_Load()　'程序启动时注册功能热键F12　preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)　SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf Wndproc　uVirtKey = vbKeyF12　RegisterHotKey Me.hwnd, 1, Modifiers, uVirtKeyEnd SubPrivate Sub uNhideall_Click()　'恢复所有被隐藏项目　For res = 0 To List1.ListCount - 1　　LasthWnd = List1.List(res)　　ShowWindow LasthWnd, SW_SHOW　Next res　List1.Clear　'清空句柄列表框End SubPublic Sub hideOK_Click()　'当"开始隐藏"按钮被点击时，将窗口最小化　Me.WindowState = 1End SubPrivate Sub UNHIDE_Click()　'恢复一个选定的被隐藏项目　If List1.ListIndex < 0 Then　　MsgBox "请首先选择一个被恢复的隐藏项目！", vbExclamation　　Exit Sub　End If'验证句柄列表栏目是否已经被选中　hideINDEX = List1.ListIndex　LasthWnd = List1.List(hideINDEX)　X = ShowWindow(LasthWnd, SW_SHOW)　'恢复选定的被隐藏项目　List1.RemoveItem (hideINDEX)　'移除该项目有关信息End SubPrivate Sub Form_Unload(Cancel As Integer)　'当程序被关闭时，取消已经注册的热键　SetWindowLong Me.hwnd, GWL_WNDPROC, preWinProc　UnregisterHotKey Me.hwnd, uVirtKey　'取消系统级热键,释放资源　End'终止程序运行End Sub　'主窗体代码结束

做个“网络助手”程序上网最麻烦的事莫过于在地址栏中输入网址了。虽然有收藏夹帮忙，喜爱的网站多了它也日渐臃肿，占用资源不算，用起来也不是很方便。用VB做个“网络助手”吧！这个网络助手至少要实现这样的功能：双击用户界面的网站名称，就能调出浏览器并进入该网站。(当然，如果你愿意，还可以添加其它功能，如删除、修改、添加网址，自动拨号，计时等)构想是这样：用文本文档记录网站名称，程序运行时读取文本文档并在用户界面显示网站名，当用户双击网站名称时调出网址、链接。为此，着手编程之前我们必须做两项准备工作：一.用记事本编写一个名为 homepage 的 TXT 文档。每行写一个网站名称，不要有空行。二.用数据库程序 Access (Office组件之一) 建立一个名为 address 的数据库，表名为 net，主字段名为 netaddress。给数据库输入记录：按照 homepage.txt 文档中的网站顺序写好各网站主页的详细网址，结束后存盘退出。现在可以进入具体编程了。这个程序所需控件不多：一个 data 控件，一个 ListBox 控件和一个 Label 控件即可。在属性窗口将 data 控件与库文件及其表链接好，并将 Label 控件与 Data 控件绑定。接着调整一下各控件的位置和大小。下面是具体的代码，我将在代码中穿插作些必要的解释： Option Explicit '调用浏览器的API Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Dim Sort As String '申明选择类别 Dim address As String '申明网址 Dim addresslink '申明网址链接 Dim AllLines As New Collection '内存中的行数据库(你可以看得出来，模仿了"日积月累"的代码来实现对文档文档的读取和显示) Dim CurrentLine As Long '当前行集合索引 '链接网址声明 Private Sub Link() address = ShellExecute(0&, vbNullString, address, vbNullString, vbNullString, vbNormalFocus) End Sub 'Form_Load 事件 Private Sub Form_Load() Data1.DatabaseName = App.Path + "\address.mdb" '定位库文件(虽然在属性中已经绑定了数据库，为使程序能在别的机器上正常运行，这行是有必要的) Data1.RecordSource = "net" '字段 Data1.Visible = False 'data控件不可见 Dim nextLine As String '从文件中读出的每一行 Dim InFile As Integer '文件的描述符 InFile = FreeFile Open App.Path + "\homepage.txt" For Input As InFile '打开文件 While Not EOF(InFile) Line Input #InFile, nextLine AllLines.Add nextLine Wend Close InFile '将所有行集合按顺序添加到列表框 Dim i As Integer For i = 0 To AllLines.Count - 1 GetNextLine Next i End Sub '单击列表框 Private Sub List1_Click() Dim Ind As Integer Ind = List1.ListIndex If Ind < Data1.Recordset.RecordCount Then Data1.Recordset.AbsolutePosition = Ind Else Data1.Recordset.Move (Ind) End If address = Label1.Caption End Sub '双击列表框 Private Sub List1_dblClick() Link End Sub '提取当前行 Public Sub GetCurrentLine() If AllLines.Count > 0 Then List1.AddItem AllLines.Item(CurrentLine) End If End Sub '提取下一行 Private Sub GetNextLine() CurrentLine = CurrentLine + 1 If AllLines.Count < CurrentLine Then CurrentLine = 1 End If GetCurrentLine End Sub 至此，程序已经可以达成我们的目的了。如果需要添加其它功能，请参阅 VB编程乐园的其它文章和源码自行补充。

解除网虫心病 VB做定时断线程序运行VB 6，向窗体添加7个Label控件、1个Timer控件、3个Text文本输入框以及4个Command按钮。　　原理简介：用Timer控件的True或者False值，控制倒计时的开始，当到达设定时间的时候，弹出对话框提示断开连接。　　 Option Explicit 　　 Dim Hours As Integer 　　 Dim Minutes As Integer 　　 Dim Seconds As Integer 　　 Dim time As Date 　　 Private Declare Function RasHangUp Lib "RasApi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long 　　 Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long 　　 Const RAS95_MaxEntryName = 256 　　 Const RAS95_MaxDeviceName = 128 　　 Const RAS_MaxDeviceType = 16 　　 Private Type RASCONN95 　　 dwSize As Long 　　 hRasConn As Long 　　 szEntryName(RAS95_MaxEntryName) As Byte 　　 szDeviceType(RAS_MaxDeviceType) As Byte 　　 szDeviceName(RAS95_MaxDeviceName) As Byte 　　 End Type 　　下面一段代码是对Timer的控制，以及到设定时间的时候断开连接的代码　　 Private Sub Timer1_Timer() 　　 Timer1.Enabled = False 　　 If (Format100 100time, "hh") && ":" && Format100 100time, "nn") && ":" && Format100 100time, "ss"))〈〉"00:00:00" Then 　　 time = DateAdd("s", -1, time) 　　 Label1.Visible = False 　　 Label1.Caption = Format100 100time, "hh") && ":" && Format100 100time, "nn") && ":" && Format100 100time, "ss") 　　 Label1.Visible = True 　　 Timer1.Enabled = True 　　 Else 　　 Timer1.Enabled = False 　　 End If 　　 If Label1.Caption = "00:00:01" Then 　　 dsdklj.WindowState = 0 　　 Command1.Enabled = True 　　 MsgBox "时间到了，正在断开连接" 　　 Dim lngRetCode As Long 　　 Dim lpcb As Long 　　 Dim lpcConnections As Long 　　 Dim intArraySize As Integer 　　 Dim intLooper As Integer 　　 ReDim lprasconn95(intArraySize) As RASCONN95 　　 lprasconn95(0).dwSize = 412 　　 lpcb = 256 * lprasconn95(0).dwSize 　　 lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections) 　　 If lngRetCode = 0 Then 　　 If lpcConnections〉0 Then 　　 For intLooper = 0 To lpcConnections-1 　　 RasHangUp lprasconn95(intLooper).hRasConn 　　 Next intLooper 　　 Unload Me 　　 Else 　　 MsgBox "时间到了，没有拨号网络连接" 　　 Unload Me 　　 End If 　　 End If 　　 End If 　　 End Sub 　　

用VB编写“红绿灯”程序第一件事当然是新建一个工程，然后引入所需控件。在“红绿灯”程序中，我们需要用到的控件有：OptionButton（选项按钮）、Image（图像框）及Timer（时钟）控件。引入两个OptionButton，其中Option1的Caption设置为“红灯”，Option2的Caption设置为“绿灯”；Image1的Picture属性设置为红灯图片，选择一张红灯图片（读者可以自己创建一个红灯及绿灯图片）。设计好的程序界面如图1。　　好了，现在我们开始添加程序代码。　　我们要求程序能够通过我们所选择的是红灯或绿灯来显示相应的图像，实现的原理就是当我们单击“红灯”时显示红灯图片，单击“绿灯”时显示绿灯图片，只要用户准备好这两张图片后，要实现这个功能就非常的容易了。其具体的程序代码如下：　　双击Option1（即红灯）控件，添加如下代码：（黑体部分为系统自动生成的代码，下同）　　 Private Sub Option1_Click()　　 ′显示红灯图片　　 On Error GoTo LoadErr　′当载入图片发生错误时跳到LoadErr处　　 If Option1.Value=True Then　′当单击了Option1控件时　　 Image1.Picture=LoadPicture(〃C:\Windows\Desktop\red.jpg〃)　′载入red.jpg图片，并显示在Image1控件中。　　 End If　　 LoadErr:　′设置捕获错误标签　　 If Err.Number=53 Then　′当发生错误时　　　 MsgBox Err.Description,vbOKOnly＋vbCritical,〃错误〃　′显示错误信息　　 End If　　 End Sub 　　上面一段代码中有一句“On Error Goto LoadErr”，该句是用作捕获程序错误的，当程序执行过程中发生了错误则跳到处理错误语句处执行。在这段代码中，如果在载入图片时发生了错误（通常是所要载入的文件不存在或路径错误）则跳到LoadErr处执行LoadErr后的程序代码。　　在VB中，所有的程序错误都是用数字表示的，如53则表示未找到文件的错误码，其实要知道哪个错误码表示哪种错误也并不难，当你在VB中运行这个程序时，如果出现了错误，会有一个错误的提示框，在该提示框中则有该错误的错误码。如果我们没有在该段程序中加入“On Error Goto LoadErr”语句及给出错误的文件名或文件路径的话，则会出现如图2所示的提示框。　　LoadPicture是载入图片的函数，其中第一个参数则是所要载入图片的完整路径，当然在本例中这个路径是固定了的，所要想使其路径随程序路径的变化而变化则需要使用App.Path值，可以写成Image1.Picture=LoadPicture(App.Path＆〃\red.jpg〃)，其中App.Path返回的值则是程序所在的路径，当然red.jpg必须放在程序所在的同一目录中。　　双击Option2（即绿灯）控件，添加如下代码：　　Private Sub Option2_Click()　　 ′显示绿灯图片　　 On Error GoTo LoadErr　′当载入图片发生错误时跳到LoadErr处　　 If Option2.Value=True Then　′当单击了Option2控件时　　 Image1.Picture=LoadPicture(〃C:\Windows\Desktop\green.jpg〃)　′载入green.jpg图片，并显示在Image1控件中。　　 End If　　 LoadErr:　′设置标签　　 If Err.Number=53 Then　′当发生错误时　　　 MsgBox Err.Description,vbOKOnly＋vbCritical,〃错误〃　′显示错误信息　　 End If　　 End Sub 　　OK！现在我们就可以单击F5键运行一下，看看我们自制的“红绿灯”程序吧。点击一下“绿灯”看看，红灯变成绿灯了吧？再试试红灯，怎样？现在我们就可以控制红绿灯了吧。　　如何才能让“红绿灯”自动更换呢？要实现这个功能也非常简单，只要加入Timer（时钟）控件，将Timer1的Interval设置为3000（即3秒）。其原理就是每隔3秒更换一种图片，这样便实现了自动更换。　　双击Timer1控件，添加如下代码：　　Private Sub Timer1_Timer()　　 ′实现自动化　　 If Option1.Value=True Then　′如果当前显示的是红灯　　　 Option2.Value=True　′使Option2被选中，执行Option2中的代码（即显示绿灯）　　 Else　　　 Option1.Value=True　′使Option1被选中，执行Option1中的代码（即显示红灯）　　 End If　　 End Sub

窗体改变时控件随之改变 Option Explicit Private FormOldWidth As Long 　 '保存窗体的原始宽度 Private FormOldHeight As Long 　 '保存窗体的原始高度 '在调用ResizeForm前先调用本函数 Public Sub ResizeInit(FormName As Form) 　 Dim Obj As Control 　 FormOldWidth = FormName.ScaleWidth 　 FormOldHeight = FormName.ScaleHeight 　 On Error Resume Next 　 For Each Obj In FormName 　　 Obj.Tag = Obj.Left & " " & Obj.Top & " " _ 　　　　　 & Obj.Width & " " & Obj.Height & " " 　 Next Obj 　 On Error GoTo 0 End Sub '按比例改变表单内各元件的大小，在调用ReSizeForm前先调用ReSizeInit函数 Public Sub ResizeForm(FormName As Form) 　 Dim Pos(4) As Double 　 Dim I As Long, TempPos As Long, StartPos As Long 　 Dim Obj As Control 　 Dim ScaleX As Double, ScaleY As Double 　 ScaleX = FormName.ScaleWidth / FormOldWidth 　 '保存窗体宽度缩放比例　 ScaleY = FormName.ScaleHeight / FormOldHeight 　 '保存窗体高度缩放比例　 On Error Resume Next 　 For Each Obj In FormName 　　 StartPos = 1 　　 For I = 0 To 4 　　 '读取控件的原始位置与大小　　　 TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare) 　　　 If TempPos > 0 Then 　　　　 Pos(I) = Mid(Obj.Tag, StartPos, TempPos - StartPos) 　　　　 StartPos = TempPos + 1 　　　 Else 　　　　 Pos(I) = 0 　　　 End If 　　　 '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小　　　 Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, _ 　　　　　　　 Pos(2) * ScaleX, Pos(3) * ScaleY 　　 Next I 　 Next Obj 　 On Error GoTo 0 End Sub Private Sub Form_Load() 　 Call ResizeInit(Me) '在程序装入时必须加入 End Sub Private Sub Form_Resize() 　 Call ResizeForm(Me) '确保窗体改变时控件随之改变 End Sub 　例中给出了二个函数: ResizeInit 和 ResizeForm ，在调用 ResizeForm 之前必须先调用 ResizeInit。你可以将本程序拷到窗体代码段里，然后在窗体里加入任意控件即可进行测试。

我在我自己的贴吧：“VB编程乐园”里发了一些VB的一些小技巧，有兴让我们一起学习VB，一起享受VB的快乐

如何用VB建立捷径(ShortCut) Private Declare Function fCreateShellLink Lib "vb5stkit.dll" _ (ByVal Forder As String, ByVal ShortCutName As String, _ ByVal ExePath As String, ByVal Params As String) As LongDim ret As Long'放在DeskTopret = fCreateShellLink("..\..\Desktop", "MyName", "c:\tools\spe3\pe2.exe", "")'放在开始功能表ret = fCreateShellLink("..", "MyName", "c:\tools\spe3\pe2.exe", "")'放在程式集功能表ret = fCreateShellLink(".", "MyName", "c:\tools\spe3\pe2.exe", "")

隐藏Mouse Type POINTAPI x As Long y As LongEnd TypeDeclare Function GetCursorPos Lib "user32" Alias "GetCursorPos" _ (lpPoint As POINTAPI) As Long'隐藏MousePublic Sub toHideCursor()ShowCursor 0End Sub'显示MousePublic Sub toShowCursor() ShowCursor 1End Sub

设定Mouse 在某个固定范围 Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypeDeclare Function ClipCursor Lib "user32" (lpRect As Any) As LongDeclare Function ShowCursor Lib "user32" (ByVal bShow As Long) As LongDeclare Function SetCursorPos Lib "user32" (ByVal x As Long, _ ByVal y As Long) As LongDeclare Function GetWindowRect Lib "user32" Alias "GetWindowRect" _ (ByVal hwnd As Long, lpRect As RECT) As Long'设定Mouse可移动的围是在某个control项之内Public Function toLockCursor(ByVal ctlHwnd As Long) As BooleanDim rect5 As RECTDim res As LongGetWindowRect ctlHwnd, rect5 '取得window的四个角rect5.Top = rect5.Toprect5.Left = rect5.Leftrect5.Bottom = rect5.Bottomrect5.Right = rect5.RightSetCursorPos (rect5.Top + rect5.Bottom) \ 2, (rect5.Left + rect5.Right) \ 2res = ClipCursor(rect5)If res = 1 Then toLockCursor = TrueElse toLockCursor = FalseEnd IfEnd Function'设定Mouse移动的围为个萤幕Public Sub toUnLockCursor()Dim rscreen As RECTrscreen.Top = 0rscreen.Left = 0rscreen.Right = Screen.Width \ Screen.TwipsPerPixelXrscreen.Bottom = Screen.Height \ Screen.TwipsPerPixelYClipCursor rscreenEnd Sub例如：设定Mouse只能在Form的范围Private Sub Command1.Click() Call toLockCursor(Me.hWnd)End SubPrivate Sub Command2.Click() Call toUnLockCursor()End Sub

如何将的游标显示成动画游标动画在 Windows 底下是 .ani 格式的档案，要显示此类游标，首先要利用LoadCursorFromFile API 载入.ani 档案，然後利用 SetSystemCursor API 加以显示，Const OCR_NORMAL = 32512Const IDC_ARROW = 32512&Private Declare Function LoadCursorFromFile Lib "user32" Alias _ "LoadCursorFromFileA" (ByVal lpFileName As String) As LongPrivate Declare Function LoadCursor Lib "user32" Alias " LoadCursorA" _ (ByVal hInstance As Long, lpCursorName As Any) As Long ' modifiedPrivate Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, _ ByVal id As Long) As LongDim hCursor As LonghCursor = LoadCursorFromFile( 欲显示的 .ani 或 .cur 档案名称 )Call SetSystemCursor(hCursor, OCR_NORMAL)若要将鼠标游标还原原状，则是执行以下叙述：hCursor = LoadCursor(0&, ByVal IDC_ARROW)Call SetSystemCursor(hCursor, OCR_NORMAL)

更精确的计时一般使用Timer物件，没有办法精确的算到微秒，(每秒目更新18.2次)，若要算到微秒，则使用GetTickCount ，它传回Windows启动後到目前为止所经过的时间，传回值以微秒为单位。Private Declare Function GetTickCount Lib "kernel32" Alias _ "GetTickCount" () As LongPrivate CanContinue as BooleanPrivate Sub Command1_click()Dim i as LongDim j as Longi = GetTickCount()CanContinue = TrueDo While CanContinue j = GetTickCount() if j - i > 50 Then Debug.Print "已过50微秒" i = j End If DoEventsLoopEnd SubPrivate Sub Command2_Click() CanContinue = FalseEnd Sub

Disable Form右上的 "X"也就是禁止要Disable Form "X" --> Close的功能(变暗灰色)，事实上便是从Form左上方的SystemMenu将关闭(Close)的MenuItem去除掉便可以了，去除後，又该如何Enable "X"呢，那便是再将关闭(Close)的MenuItem加回去，但这里有个小问题，加回去之後"X"仍是暗灰色，要等到我们做了某些固定的动作之後(如TitleBar上click一下，或选一下SystemMenu等)，它才会再度变Enable的颜色，我不知道让TitleBar上的这些东西Refresh要送什麽讯息，知道者请告诉我，所以现在我暂且Send一个在TitleBar上按下Mouse左键的讯息给Form，令"X"能出现Enable的颜色。'需一个Command ButtonPrivate Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As LongPrivate Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As LongPrivate Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As LongPrivate Declare Function GetMenuString Lib "User32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As LongPrivate Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongConst WM_NCLBUTTONDBLCLK = &HA3Const WM_NCLBUTTONDOWN = &HA1Const HTCAPTION = 2Const MF_STRING = &H0&Const MF_BYCOMMAND = &H0&Const SC_CLOSE = &HF060Private hMenu As LongPrivate CloseStr As String '记录Close MenuItem的字串'将"关闭"的那一个MenuItem 加回来Private Sub Command1_Click()Call AppendMenu(hMenu, MF_STRING, SC_CLOSE, CloseStr)'令"X"能出现Enable的颜色Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)End SubPrivate Sub Form_Load()hMenu = GetSystemMenu(Me.hwnd, 0)CloseStr = String(255, 0)'SC_CLOSE指的便是"关闭"的那一个MenuItem IDCall GetMenuString(hMenu, SC_CLOSE, CloseStr, 256, MF_BYCOMMAND)CloseStr = Left(CloseStr, InStr(1, CloseStr, Chr(0)) - 1)Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)End Sub

按下HotKey以叫起视窗如何做到在任何一个程式之下，按下某个HotKey组合键，便将我们的视窗Activate起来，这便得使用 WM_SETHOTKEY 来达成WM_SETHOTKEY所需的参数如下：wParam = (WPARAM) MAKEWORD(vkey, modifiers) lParam = 0vkey 指的是virtual-key code，它是在低位元组，modifier是以下四种键的组合，它是在高位元组。HOTKEYF_ALT ALT keyHOTKEYF_CONTROL CTRL keyHOTKEYF_EXT Extended keyHOTKEYF_SHIFT SHIFT SendMessage()的传回值有以下的意义：-1 hotkey 设定不对 0 hWnd的指定有误 1 成功，而且没有其他window的HotKey与之相同 2 成功，但有其他window的HotKey与之相同Option ExplicitPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongConst WM_SETHOTKEY = &H32Const HOTKEYF_SHIFT = &H1Const HOTKEYF_CONTROL = &H2Const HOTKEYF_ALT = &H4Const HOTKEYF_EXT = &H8Private Type tInteger aint As IntegerEnd TypePrivate Type t2Byte lByte As Byte hByte As ByteEnd TypePrivate ii As tIntegerPrivate bb As t2BytePrivate Sub Command1_Click()Dim wParam As Long, I As Long'设定ctl-shift-T 为该window的hotkeybb.hByte = HOTKEYF_CONTROL Or HOTKEYF_SHIFTbb.lByte = vbKeyTLSet ii = bbwParam = CLng(ii.aint)I = SendMessage(Me.hwnd, WM_SETHOTKEY, wParam, 0)If I = 1 Then Debug.Print "Ctl-Shift-T 为hotkey"Else If I = 2 Then Debug.Print "有其他Window也用Ctl-Shift-T当Hotkey" Else Debug.Print "指定失败" End IfEnd IfEnd Sub

限制鼠标的移动一．限制鼠标的移动---- 有时我们的软件要求用户在未完成某一任务时，鼠标不能移出当前活动控件，换句话就是将鼠标限制在控件的内部，直到任务完成或用户中断为止。这个功能借助API函数实现起来思路很清楚，代码也很简洁。其思路是先确定当前鼠标的位置；然后确定当前活动控件的大小；最后将鼠标限制在活动控件内。（下面忽略项目建立等过程） ---- 1．建立一个新项目：新窗体为form1,在form1上添加一个commandbutton,设置其Name=CMButton1；Caption="将鼠标限制在此按钮中" ---- 2．拷贝API函数和POINTAPI结构：打开VB6.0自带的API浏览器，调入WIN32API.txt文件，复制以下结构和函数声明到form1的声明部分： Private Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd Type Private Type POINTAPI x As Long y As Long End Type Private Declare Function ClientToScreen Lib "user32" Alias "ClientToScreen" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long '用来确定当前鼠标的位置 Private Declare Function ClipCursor Lib "user32" Alias "ClipCursor" (lpRect As Any) As Long '用来限定当前鼠标的活动范围 ---- 3．定义一个通用过程ConfineTo Public Sub ConfineTo (myCtl As Object) On Error Resume NextDim tmpRect As RECTDim pt As POINTAPI With myCtlIf TypeOf myCtl Is Screen Then '锁定在屏幕范围内 tmpRect.Left = 0 tmpRect.Top = 0 tmpRect.Right = (.Width \ Screen.TwipsPerPixelX) tmpRect.Bottom = (.Height \ Screen.TwipsPerPixelY) Elseif TypeOf myCtl Is form '锁定在窗体范围内 tmpRect.Left = (.Left \ Screen.TwipsPerPixelX) tmpRect.Top = (.Top \ Screen.TwipsPerPixelY) tmpRect.Right = (.Left + .Width) \ Screen.TwipsPerPixelX tmpRect.Bottom = (.Top + .Height) \ Screen.TwipsPerPixelY else pt.X = 0 pt.Y = 0 Call ClientToScreen(.hWnd, pt) '获取当前控件在屏幕上的位置 tmpRect.Left = pt.X '保存当前控件位置 tmpRect.Top = pt.Y pt.X = .Width pt.Y = .Height Call ClientToScreen(.hWnd, pt) tmpRect.Bottom = pt.Y tmpRect.Right = pt.X End If Call ClipCursor(tmpRect)End WithEnd Sub ---- 4．在 CMButton1_Click()中加入以下代码 Static Cliped As Boolean '静态变量用来控制状态切换If Not Cliped Then ConfineTo Cmbutton1 Cliped = TrueElse ConfineTo Screen '取消鼠标限制 Cliped = TrueEnd If ---- 5. 运行后，鼠标点击cmbutton1,此时鼠标只能被锁定在此按钮内部，再次点击按钮，限制取消。二．创建临时文件 ---- 临时文件用来保存软件运行过程中的临时变化，这对于熟悉WORD等软件的人来说，经常会遇到。那么临时文件是如何产生的呢，其实很简单，只需要一个API函数就可以。 ---- 1．拷贝声明函数(方法同前) Private Declare Function GetTempFileName Lib "kernel32" _ Alias "GetTempFileNameA" (ByVal lpszPath As String, _ ByVal lpPrefixString As String, ByVal wUnique As Long, _ ByVal lpTempFileName As String) As Long参数定义如下：lpszPath ＝传入保存临时文件的路径，如"C:\mytemp"lpPrefixString=传入临时文件名开始的前三个字母，起到帮助识别临时文件来源的作用。wUnique ＝0 ,windows随机产生文件名；否则安其值定义文件名。lpTempFileName=返回随机文件名 ---- 2.返回临时文件名 Private Function GenTempName(sPath As String)Dim sPrefix As StringDim lUnique As LongDim sTempFileName As StringIf IsEmpty(sPath) Then sPath = "c:\temp"sPrefix = "TVB"lUnique = 0 'windows随机给名 sTempFileName = Space$(100) GetTempFileName sPath, sPrefix, lUnique, sTempFileNamesTempFileName = Mid$(sTempFileName, 1, InStr(sTempFileName, Chr$(0)) - 1) '去掉多余空格GenTempName = sTempFileNameEnd Function ---- 3．将下面代码加入到form1_click()事件中 MsgBox GenTempName("c:\temp") ---- 4.运行，鼠标点击form,弹出msgbox,显示生成"c:\temp\TVB724.tmp"文件，用文件管理器查看，在c:\temp下有TVB724.tmp 文件，长度为0K。 ---- 需要注意的是，传入的路径必须是有效路径，否则GenTempName函数返回0，lpTempFileName中也没有临时文件名。

如何在VB中使用导入API 有两种方法可以完成这项工作。一种方法就是在 VB 的 DECLARE 部分列出您希望调用的 C API，然后利用标准的调用序列从 VB 调用它，如下面的代码样本所示：Type SQLCA_STRUCT sqlcaid As String * 8 sqlcabc As Long sqlcode As Long sqlerrml As Integer sqlerrmc As String * 70 sqlerrp As String * 8 sqlerrd(6) As Long sqlwarn As String * 11 sqlstate As String * 5End TypePublic Declare Function sqlepstart Lib "db2app" Alias "sqlepstart_api" (ByVal junk&, ByRef sqlca As SQLCA_STRUCT) As Integer'DB2_start = sqlepstart(0, sqlca) ' Start DB2 call 另一种方法就是生成一个文件，然后发出一条命令在后台执行该函数（当然，取决于您正在试图做什么）：fileno = FreeFileOpen db2file For Output As #filenosqlstmt = "" + _ "db2start;" + vbNewLine + _ "quit;" Print #fileno, sqlstmt ' Write commands to a fileClose #fileno ' Close it and execute the commanddb2cmd = "db2cmd /i /c db2 -tvf " + db2file ' Generate the commandprogID = Shell(db2cmd, vbMinimizedNoFocus) ' Shell out to run it

我新建了一个吧：VB编程乐园，今天新建的，欢迎大家光临，请求与本本人也是一名VB爱好者，希望结交更多的朋友，让我们一起交流经验，一起发展，请吧主与我新建的吧建立友情链接，谢谢了

C语言学习经验 1.不要看到别人的回复第一句话就说：给个代码吧！你应该想想为什么。当你自己想出来再参考别人的提示，你就知道自己和别人思路的差异。 2.初学者请不要看太多太多的书那会误人子弟的，先找本系统的学，很多人用了很久都是只对部分功能熟悉而已，不系统还是不够的。 3.看帮助,不要因为很难而自己是初学者所以就不看；帮助永远是最好的参考手册，虽然帮助的文字有时候很难看懂，总觉得不够直观。 4.不要被对象、属性、方法等词汇所迷惑；最根本的是先了解最基础知识。 5.不要放过任何一个看上去很简单的小问题--他们往往并不那么简单，或者可以引伸出很多知识点；不会举一反三你就永远学不会。 6.知道一点东西，并不能说明你会写脚本，脚本是需要经验积累的。 7.学脚本并不难，JSP、ASP、PHP等等也不过如此--难的是长期坚持实践和不遗余力的博览群书； 8.看再多的书是学不全脚本的，要多实践 9.把时髦的技术挂在嘴边，还不如把过时的技术记在心里； 10.学习脚本最好的方法之一就是多练习； 11.在任何时刻都不要认为自己手中的书已经足够了； 12.看得懂的书，请仔细看；看不懂的书，请硬着头皮看； 13.别指望看第一遍书就能记住和掌握什么——请看第二遍、第三遍； 14.请把书上的例子亲手到电脑上实践，即使配套光盘中有源文件； 15.把在书中看到的有意义的例子扩充；并将其切实的运用到自己的工作中； 16.不要漏掉书中任何一个练习——请全部做完并记录下思路； 17.当你用脚本到一半却发现自己用的方法很拙劣时，请不要马上停手；请尽快将余下的部分粗略的完成以保证这个代码的完整性，然后分析自己的错误并重新编写和工作。 18.别心急，写脚本确实不容易；水平是在不断的实践中完善和发展的； 19.每学到一个脚本难点的时候，尝试着对别人讲解这个知识点并让他理解----你能讲清楚才说明你真的理解了； 20.记录下在和别人交流时发现的自己忽视或不理解的知识点； 21.保存好你做过的所有的源文件----那是你最好的积累之一； 22.对于网络，还是希望大家能多利用一下，很多问题不是非要到论坛来问的，首先你要学会自己找答案，比如google、百度都是很好的搜索引擎，你只要输入关键字就能找到很多相关资料，别老是等待别人给你希望，看的出你平时一定也很懒！ 23，到一个论坛，你学会去看以前的帖子，不要什么都不看就发帖子问，也许你的问题早就有人问过了，你再问，别人已经不想再重复了，做为初学者，谁也不希望自己的帖子没人回的。 24，虽然不是打击初学者，但是这句话还是要说：论坛论坛，就是大家讨论的地方，如果你总期望有高手总无偿指点你，除非他是你亲戚！！讨论者，起码是水平相当的才有讨论的说法，如果水平真差距太远了，连基本操作都需要别人给解答，谁还跟你讨论呢。能找到很多相关资料，别老是等待别人给你希望，看的出你平时一定也很懒！ 23，到一个论坛，你学会去看以前的帖子，不要什么都不看就发帖子问，也许你的问题早就有人问过了，你再问，别人已经不想再重复了，做为初学者，谁也不希望自己的帖子没人回的。 24，虽然不是打击初学者，但是这句话还是要说：论坛论坛，就是大家讨论的地方，如果你总期望有高手总无偿指点你，除非他是你亲戚！！讨论者，起码是水平相当的才有讨论的说法，如果水平真差距太远了，连基本操作都需要别人给解答，谁还跟你讨论呢。浮躁的人容易问：我到底该学什么；----别问，学就对了；浮躁的人容易问：JS有钱途吗；----建议你去抢银行；浮躁的人容易说：我要中文版！我英文不行！----不行？学呀！浮躁的人分两种：只观望而不学的人；只学而不坚持的人；浮躁的人永远不是一个高手。