VB精典实用源代码详细.docx
- 文档编号:4009888
- 上传时间:2022-11-27
- 格式:DOCX
- 页数:27
- 大小:30.86KB
VB精典实用源代码详细.docx
《VB精典实用源代码详细.docx》由会员分享,可在线阅读,更多相关《VB精典实用源代码详细.docx(27页珍藏版)》请在冰豆网上搜索。
VB精典实用源代码详细
个人收藏的VB精典实用源代码。
若朋友您想要问如何才能学好vb,或者入门需要看什么教材一类的问题,建议你抱着一颗刻苦钻研的心去面对这门学问,多动脑,少提问,遇到不知道的,多查资料,多看看帖子,或者用断点来亲自试验。
实在不会了,请在此贴中查找您的常见问题,如果还没有,那请您发出新贴,向各位高手讨教:
)
查找方法:
按ctrl+f,输入要查找的问题关键字即可
每个问题中间用///分隔,这只是一部分最常见到的问题,以后会逐渐更新。
////////////////////////////////////////////////////////////////////////////////////
如何用VB建立快捷方式
PrivateDeclareFunctionfCreateShellLinkLib"STKIT432.DLL"(ByVallpstrFolderNameAsString,ByVallpstrLinkNameAsString,ByVallpstrLinkPathAsString,ByVallpstrLinkArgsAsString)AsLong
SubCommand1_Click()
DimlReturnAsLong
'添加到桌面
lReturn=fCreateShellLink("..\..\Desktop","ShortcuttoCalculator","c:
\windows\calc.exe","")
'添加到程序组
lReturn=fCreateShellLink("","ShortcuttoCalculator","c:
\windows\calc.exe","")
'添加到启动组
lReturn=fCreateShellLink("\Startup","ShortcuttoCalculator","c:
\windows\calc.exe","")
EndSub
////////////////////////////////////////////////////////////////////////////////////
如何让程序在Windows启动时自动执行?
有以下二个方法:
方法1:
直接将快捷方式放到启动群组中。
方法2:
在注册档HKEY_LOCAL_MACHINE中找到以下机码
\Software\Microsoft\Windows\CurrentVersion\Run
新增一个字串值,包括二个部份
1.名称部份:
自己取名,可设定为AP名称。
2.资料部份:
则是包含'全路径档案名称'及'执行参数'
例如:
ValueName=Notepad
ValueData=c:
\windows\notepad.exe
////////////////////////////////////////////////////////////////////////////////////
在TextBox中如何限制只能输入数字?
参考下列程序:
SubText1_KeyPress(KeyAsciiAsInteger)
IfKeyAscii<48OrKeyAscii>57Then
KeyAscii=0
EndIf
EndSub
////////////////////////////////////////////////////////////////////////////////////
我希望TextBox中能不接受某些特定字符,例如'#$%",有没有简单一点的写法?
方法有好几种,以下列举二种:
方法1:
可以使用IF或SelectCase一个个判断,但如果不接受的字符多时,较麻烦!
方法2:
将要剔除的字符统统放在一个字串中,只要一个IF判断即可!
!
如下:
PrivateSubText1_KeyPress(KeyAsciiAsInteger)
DimsTemplateAsString
sTemplate="!
#$%^&*()_+-="'用来存放不接受的字符
IfInStr(1,sTemplate,Chr(KeyAscii))>0Then
KeyAscii=0
EndIf
EndSub
////////////////////////////////////////////////////////////////////////////////////
如何让鼠标进入TextBox时自动选定TextBox中之整串文字?
这个自动选定反白整串文字的动作,会使得输入的资料完全取代之前在TextBox中的所有字符。
PrivateSubText1_GotFocus()
Text1.SelStart=0
Text1.SelLength=Len(Text1)
EndSub
////////////////////////////////////////////////////////////////////////////////////
如何检查软盘驱动器里是否有软盘?
使用:
DimFlagAsBoolean
Flag=Fun_FloppyDrive("A:
")
IfFlag=FalseThenMsgBox"A:
驱没有准备好,请将磁盘插入驱动器!
",vbCritical
'-------------------------------
'函数:
检查软驱中是否有盘的存在
'-------------------------------
PrivateFunctionFun_FloppyDrive(sDriveAsString)AsBoolean
OnErrorResumeNext
Fun_FloppyDrive=Dir(sDrive)<>""
EndFunction
////////////////////////////////////////////////////////////////////////////////////
如何弹出和关闭光驱托盘?
OptionExplicit
PrivateDeclareFunctionmciSendStringLib"winmm.dll"Alias"mciSendStringA"(ByVallpstrCommandAsString,ByVallpstrReturnStringAsString,ByValuReturnLengthAsLong,ByValhwndCallbackAsLong)AsLong
PrivateSubCommand1_Click()
mciExecute"setcdaudiodooropen"'弹出光驱
Label2.Caption="弹出"
EndSub
PrivateSubCommand2_Click()
Label2.Caption="关闭"
mciExecute"setcdaudiodoorclosed"'合上光驱
UnloadMe
End
EndSub
////////////////////////////////////////////////////////////////////////////////////
如何让你的程序在任务列表隐藏
PrivateDeclareFunctionRegisterServiceProcessLib"kernel32"(ByValProcessIDAsLong,ByValServiceFlagsAsLong)AsLong
PrivateDeclareFunctionGetCurrentProcessIdLib"kernel32"()AsLong
'请你试试Ctrl+Alt+Del是不是你的程序隐藏了
PrivateSubCommand1_Click()
i=RegisterServiceProcess(GetCurrentProcessId,1)
EndSub
////////////////////////////////////////////////////////////////////////////////////
如何用程序控制滑鼠游标(MouseCursor)到指定位置?
以下这个例子,当User在Text1中按下'Enter'键后,滑鼠游标会自动移到Command2按钮上方
请在声明区中加入以下声明:
'16位版本:
(Sub无传回值)
DeclareSubSetCursorPosLib"User"(ByValXAsInteger,ByValYAsInteger)
'32位版本:
(Function有传回值,Integer改成Long)
DeclareFunctionSetCursorPosLib"user32"(ByValxAsLong,ByValyAsLong)AsLong
'在Form1中加入以下程序码:
PrivateSubText1_KeyPress(KeyAsciiAsInteger)
IfKeyAscii=13Then
x%=(Form1.Left+Command2.Left+Command2.Width/2+60)/Screen.TwipsPerPixelX
y%=(Form1.Top+Command2.Top+Command2.Height/2+360)/Screen.TwipsPerPixelY
SetCursorPosx%,y%
EndIf
EndSub
////////////////////////////////////////////////////////////////////////////////////
如何用鼠标移动没有标题的Form,或移动Form中的控制项?
在声明区中放入以下声明:
'16位版本:
(Sub无返回值)
PrivateDeclareSubReleaseCaptureLib"User"()
PrivateDeclareSubSendMessageLib"User"(ByValhwndAsInteger,ByValwMsgAsInteger,ByValwParamAsInteger,lParamAsLong)
'32位版本:
(Function有返回值,Integer改成Long)
PrivateDeclareFunctionReleaseCaptureLib"user32"()AsLong
PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLong
'共用常数:
ConstWM_SYSCOMMAND=&H112
ConstSC_MOVE=&HF012
'若要移动Form,程序码如下:
PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
DimiAsLong
i=ReleaseCapture
i=SendMessage(Form1.hwnd,WM_SYSCOMMAND,SC_MOVE,0)
EndSub
'以上功能也适用于用鼠标在Form中移动控制项,程序码如下:
PrivateSubCommand1_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
DimiAsLong
i=ReleaseCapture
i=SendMessage(Command1.hwnd,WM_SYSCOMMAND,SC_MOVE,0)
EndSub
////////////////////////////////////////////////////////////////////////////////////
检查文件是否存在?
FunctionFileExists(filenameAsString)AsInteger
DimiAsInteger
OnErrorResumeNext
i=Len(Dir$(filename))
IfErrOri=0ThenFileExists=FalseElseFileExists=True
EndFunction
////////////////////////////////////////////////////////////////////////////////////
如何设置对VB数据库连接的动态路径
我个人因为经常作一些数据库方面的程序,对于程序间如何与数据库进行接口的问题之烦是深有体会,因为VB在数据库的时候,一般是静态,即数据库存放的路径是固定的,如用VB的DATA,adodc,DataEnvironment等到作数据库时,如果存放数据库的路径被改变的话,就会找不到路经,真是一个特别烦的事。
笔者的解决方法是利用app.path来解决这个问题。
一、用data控件进行数据库,可以这样:
在form_load()过程中放入:
privateform_load()
DimstrAsString'定义
str=App.Path
IfRight(str,1)<>"\"Then
str=str+"\"
EndIf
data1.databasename=str&"\数据库名"
data1.recordsource="数据表名"
data1.refresh
subend
这几句话的意为,打开当前程序运行的目录下的数据库。
你只要保证你的数据库在你程序所在的目录之下就行了。
二、利用adodc(ADODataControl)进行数据库:
privateform_load()
DimstrAsString'定义
str=App.Path
IfRight(str,1)<>"\"Then
str=str+"\"
EndIf
str="Provider=Microsoft.Jet.OLEDB.3.51;PersistSecurityInfo=False;DataSource="&str&"\tsl.mdb"
Adodc1.ConnectionString=str
Adodc1.CommandType=adCmdText
Adodc1.RecordSource="select*fromtable3"
Adodc1.Refresh
endsub
三、利用DataEnvironment进行数据库
可在过程中放入:
OnErrorResumeNext
IfDataEnvironment1.rsCommand1.State<>adStateClosedThen
DataEnvironment1.rsCommand1.Close'如果打开,则关闭
EndIf
'i=InputBox("请输入友人编号:
","输入")
'Ifi=""ThenExitSub
DataEnvironment1.Connection1.OpenApp.Path&"\userdatabase\tsl.mdb"
DataEnvironment1.rsCommand1.Open"select*fromtable3where编号='"&i&"'"
'SetDataReport2.DataSource=DataEnvironment1
'DataReport2.DataMember="command1"
'DataReport2.show
endsub
四、利用ADO(ActiveXDataObjects)进行编程:
建立连接:
dimconnasnewadodb.connection
dimrsasnewadodb.recordset
dimstr
str=App.Path
IfRight(str,1)<>"\"Then
str=str+"\"
EndIf
str="Provider=Microsoft.Jet.OLEDB.3.51;PersistSecurityInfo=False;DataSource="&str&"\tsl.mdb"
conn.openstr
rs.cursorlocation=aduseclient
rs.open"数据表名",conn,adopenkeyset.adlockpessimistic
用完之后关闭数据库:
conn.close
setconn=nothing
////////////////////////////////////////////////////////////////////////////////////
如何让用户自行输入方程式,并计算其结果?
假设我们要让使用者在“方程式”栏位中自由输入方程式,然后利用方程式进行计算,则引用ScriptControl控件可以很方便地做到。
(ScriptControl控件附属于VB6.0,如果安装后没有看到此一控件,可在光盘的\Common\Tools\VB\Script目录底下找此一控件,其.文件名为Msscript.ocx。
)假设放在窗体上的ScriptControl控件名称为ScriptControl1,则在“计算”按钮的Click事件中编写如下代码:
DimStatementAsStringStatement="X="+Text1.Text+vbCrLf+_"Y="+Text2.Text+vbCrLf+_"MsgBox""计算结果=""&Y"ScriptControl1.ExecuteStatement(Statement
////////////////////////////////////////////////////////////////////////////////////
如何让一个App永远保持在最上层(AlwaysonTop)
请在声明区中加入以下声明
PrivateDeclareFunctionSetWindowPosLib"user32"(ByValhwndAsLong,ByValhWndInsertAfterAsLong,ByValxAsLong,ByValyAsLong,ByValcxAsLong,ByValcyAsLong,ByValwFlagsAsLong)AsLong
ConstSWP_NOMOVE=&H2'不更动目前视窗位置
ConstSWP_NOSIZE=&H1'不更动目前视窗大小
ConstHWND_TOPMOST=-1'设定为最上层
ConstHWND_NOTOPMOST=-2'取消最上层设定
ConstFLAGS=SWP_NOMOVEOrSWP_NOSIZE
'将APP视窗设定成永远保持在最上层
SetWindowPosMe.hwnd,HWND_TOPMOST,0,0,0,0,FLAGS
'取消最上层设定
SetWindowPosMe.hwnd,HWND_NOTOPMOST,0,0,0,0,FLAGS
////////////////////////////////////////////////////////////////////////////////////
我要如何在程序中开启网页?
在声明区中声明如下(在.bas档中用Public,在Form中用Private)
PrivateDeclareFunctionShellExecuteLib"shell32.dll"Alias"ShellExecuteA"(ByValhWndAsLong,ByVallpOperationAsString,ByVallpFileAsString,ByVallpParametersAsString,ByVallpDirectoryAsString,ByValnShowCmdAsLong)AsLong
在程序中
Intranet:
ShellExecuteMe.hWnd,"open","Intranet主机/目录","","",5
Internet:
ShellExecuteMe.hWnd,"open",".ruentex..tw","","",5
////////////////////////////////////////////////////////////////////////////////////
VB可以产生四角形以外其他形状的Form吗?
这个问题,您一定无法想像有多容易,您可以产生任何形状的Form,但必须借助CreateEllipticRgn及SetWindowRgn二个API,例如:
PrivateDeclareFunctionCreateEllipticRgnLib"gdi32"(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong)AsLong
PrivateDeclareFunctionSetWindowRgnLib"user32"(ByValhWndAsLong,ByValhRgnAsLong,ByValbRedrawAsBoolean)AsLong
PrivateSubForm_Load()
DimlReturnAsLong
Me.Show
lReturn=SetWindowRgn(hWnd,CreateEllipticRgn(10,10,340,150),True)
EndSub
执行结果图片
CreateEllipticRgn之四个参数说明如下:
X1:
椭圆中心点之X
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 实用 源代码 详细