【VB开源代码栏目提醒】:网学会员在VB开源代码频道为大家收集整理了“VB精典实用源代码 - 代理连锁“提供大家参考,希望对大家有所帮助!
若朋友您想要问如何才能学好
vb或者入门需要看什么教材一类的问题建议你抱着一颗刻苦钻研的心去面对这门学问多动脑少提问遇到不知道的多查资料多看看帖子或者用断点来亲自试验。
实在不会了请在此贴中查找您的常见问题如果还没有那请您发出新贴向各位高手讨教 查找方法按ctrlf输入要查找的问题关键字即可 每个问题中间用///分隔这只是一部分最常见到的问题以后会逐渐更新。
//////////////////////////////////////////////////////////////////////////////////// 如何用
VB建立快捷方式 Private Declare Function fCreateShellLink Lib quotSTKIT432.DLLquot ByVal lpstrFolderName As String ByVal lpstrLinkName As String ByVal lpstrLinkPath As String ByVal lpstrLinkArgs As String As Long Sub Command1_Click Dim lReturn As Long 添加到桌面 lReturn fCreateShellLinkquot....Desktopquot quotShortcut to Calculatorquot quotc:windowscalc.exequot quotquot 添加到程序组 lReturn fCreateShellLinkquotquot quotShortcut to Calculatorquot quotc:windowscalc.exequot quotquot 添加到启动组 lReturn fCreateShellLinkquotStartupquot quotShortcut to Calculatorquot quotc:windowscalc.exequot quotquot End Sub //////////////////////////////////////////////////////////////////////////////////// 如何让程序在 Windows 启动时自动执行 有以下二个方法 方法1: 直接将快捷方式放到启动群组中。
方法2: 在注册档 HKEY_LOCAL_MACHINE 中找到以下机码 SoftwareMicrosoftWindowsCurrentVersionRun 新增一个字串值包括二个部份 1. 名称部份自己取名可设定为 AP 名称。
2. 资料部份则是包含 全路径档案名称 及 执行参数 例如 Value Name Notepad Value Data c:windowsnotepad.exe //////////////////////////////////////////////////////////////////////////////////// 在 TextBox 中如何限制只能输入数字 参考下列程序 Sub Text1_KeyPressKeyAscii As Integer If KeyAscii lt 48 Or KeyAscii gt 57 Then KeyAscii 0 End If End Sub //////////////////////////////////////////////////////////////////////////////////// 我希望 TextBox 中能不接受某些特定字符例如 quot有没有简单一点的写法 方法有好几种 以下列举二种 方法1: 可以使用 IF 或 Select Case 一个个判断 但如果不接受的字符多时 较麻烦 方法2: 将要剔除的字符统统放在一个字串中只要一个 IF 判断即可 如下 Private Sub Text1_KeyPressKeyAscii As Integer Dim sTemplate As String sTemplate quotamp_-quot 用来存放不接受的字符 If InStr1 sTemplate ChrKeyAscii gt 0 Then KeyAscii 0 End If End Sub //////////////////////////////////////////////////////////////////////////////////// 如何让鼠标进入 TextBox 时自动选定 TextBox 中之整串文字 这个自动 选定反白整串文字的动作会使得输入的资料完全取代之前在 TextBox 中的所有字符。
Private Sub Text1_GotFocus Text1.SelStart 0 Text1.SelLength LenText1 End Sub //////////////////////////////////////////////////////////////////////////////////// 如何检查软盘驱动器里是否有软盘 使用 Dim Flag As Boolean Flag Fun_FloppyDrivequotA:quot If Flag False Then MsgBox quotA:驱没有准备好请将磁盘插入驱动器quot vbCritical ------------------------------- 函数:检查软驱中是否有盘的存在 ------------------------------- Private Function Fun_FloppyDrivesDrive As String As Boolean On Error Resume Next Fun_FloppyDrive DirsDrive ltgt quotquot End Function //////////////////////////////////////////////////////////////////////////////////// 如何弹出和关闭光驱托盘 Option Explicit Private Declare Function mciSendString Lib quotwinmm.dllquot Alias quotmciSendStringAquot ByVal lpstrCommand As String ByVal lpstrReturnString As String ByVal uReturnLength As Long ByVal hwndCallback As Long As Long Private Sub Command1_Click mciExecute quotset cdaudio door openquot 弹出光驱 Label2.Caption quot弹 出quot End Sub Private Sub Command2_Click Label2.Caption quot关 闭quot mciExecute quotset cdaudio door closedquot 合上光驱 Unload Me End End Sub //////////////////////////////////////////////////////////////////////////////////// 如何让你的程序在任务列表隐藏 Private Declare Function RegisterServiceProcess Lib quotkernel32quot ByVal ProcessID As Long ByVal ServiceFlags As Long As Long Private Declare Function GetCurrentProcessId Lib quotkernel32quot As Long 请你试试 CtrlAltDel 是不是你的程序隐藏了 Private Sub Command1_Click i RegisterServiceProcessGetCurrentProcessId 1 End Sub //////////////////////////////////////////////////////////////////////////////////// 如何用程序控制滑鼠游标 Mouse Cursor 到指定位置 以下这个例子当 User 在 Text1 中按下 Enter 键后滑鼠游标会自动移到 Command2 按钮上方 请在声明区中加入以下声明 16 位版本 Sub 无传回值 Declare Sub SetCursorPos Lib quotUserquot ByVal X As Integer ByVal Y As Integer 32 位版本 Function 有传回值Integer 改成 Long Declare Function SetCursorPos Lib quotuser32quot ByVal x As Long ByVal y As Long As Long 在 Form1 中加入以下程序码 Private Sub Text1_KeyPressKeyAscii As Integer If KeyAscii 13 Then x Form1.Left Command2.Left Command2.Width / 2 60 / Screen.TwipsPerPixelX y Form1.Top Command2.Top Command2.Height / 2 360 / Screen.TwipsPerPixelY SetCursorPos x y End If End Sub //////////////////////////////////////////////////////////////////////////////////// 如何用鼠标移动没有标题的 Form或移动 Form 中的控制项 在声明区中放入以下声明 16 位版本 Sub 无返回值 Private Declare Sub ReleaseCapture Lib quotUserquot Private Declare Sub SendMessage Lib quotUserquot ByVal hwnd As Integer ByVal wMsg As Integer ByVal wParam As Integer lParam As Long 32 位版本 Function 有返回值Integer 改成 Long Private Declare Function ReleaseCapture Lib quotuser32quot As Long Private Declare Function SendMessage Lib quotuser32quot Alias quotSendMessageAquot ByVal hwnd As Long ByVal wMsg As Long ByVal wParam As Long lParam As Any As Long 共用常数 Const WM_SYSCOMMAND ampH112 Const SC_MOVE ampHF012 若要移动 Form程序码如下 Private Sub Form_MouseDownButton As Integer Shift As Integer X As Single Y As Single Dim i As Long i ReleaseCapture i SendMessageForm1.hwnd WM_SYSCOMMAND SC_MOVE 0 End Sub 以上功能也适用于用鼠标在 Form 中移动控制项程序码如下 Private Sub Command1_MouseDownButton As Integer Shift As Integer X As Single Y As Single Dim i As Long i ReleaseCapture i SendMessageCommand1.hwnd WM_SYSCOMMAND SC_MOVE 0 End Sub //////////////////////////////////////////////////////////////////////////////////// 检查文件是否存在 Function FileExistsfilename As String As Integer Dim i As Integer On Error Resume Next i LenDirfilename If Err Or i 0 Then FileExists False Else FileExists True End Function //////////////////////////////////////////////////////////////////////////////////// 如何设置对
VB数据库连接的动态路径 我个人因为经常作一些数据库方面的程序对于程序间如何与数据库进行接口的问题之烦是深有体会因为
VB在数据库链接的时候一般是静态即数据库存放的路径是固定的如用
VB的DATAadodcDataEnvironment 等到作数据库链接时如果存放数据库的路径被改变的话就会找不到路经真是一个特别烦的事。
笔者的解决方法是利用app.path 来解决这个问题。
一、用data控件进行数据库链接可以这样 在form_load过程中放入 private form_load Dim str As String 定义 str App.Path If Rightstr 1 ltgt quotquot Then str str quotquot End If data1.databasenamestr amp quot数据库名quot data1.recordsourcequot数据表名quot data1.refresh sub end 这几句话的意为打开当前程序运行的目录下的数据库。
你只要保证你的数据库在你程序所在的目录之下就行了。
二、利用adodcADO Data Control进行数据库链接 private form_load Dim str As String 定义 str App.Path If Rightstr 1 ltgt quotquot Then str str quotquot End If str quotProviderMicrosoft.Jet.OLEDB.3.51Persist Security InfoFalseData Sourcequot amp str amp quottsl.mdbquot Adodc1.ConnectionString str Adodc1.CommandType adCmdText Adodc1.RecordSource quotselect from table3quot Adodc1.Refresh end sub 三、利用DataEnvironment进行数据库链接 可在过程中放入 On Error Resume Next If DataEnvironment1.rsCommand1.State ltgt adStateClosed Then DataEnvironment1.rsCommand1.Close 如果打开则关闭 End If i InputBoxquot请输入友人编号:quot quot输入quot If i quotquot Then Exit Sub DataEnvironment1.Connection1.Open App.Path amp quotuserdatabasetsl.mdbquot DataEnvironment1.rsCommand1.Open quotselect from table3 where 编号quot amp i amp quotquot Set DataReport2.DataSource DataEnvironment1 DataReport2.DataMember quotcommand1quot DataReport2.show end sub 四、利用ADOActiveX Data Objects进行编程 建立连接 dim conn as new adodb.connection dim rs as new adodb.recordset dim str str App.Path If Rightstr 1 ltgt quotquot Then str str quotquot End If str quotProviderMicrosoft.Jet.OLEDB.3.51Persist Security InfoFalseData Sourcequot amp str amp quottsl.mdbquot conn.open str rs.cursorlocationaduseclient rs.open quot数据表名quotconnadopenkeyset.adlockpessimistic 用完之后关闭数据库 conn.close set connnothing //////////////////////////////////////////////////////////////////////////////////// 如何让用户自行输入方程式并计算其结果 假设我们要让使用者在“方程式”栏位中自由输入方程式然后利用方程式进行计算则引用ScriptControl控件可以很方便地做到。
ScriptControl 控件附属于
VB 6.0如果安装后没有看到此一控件可在光盘的 CommonToolsVBScript 目录底下找此一控件 其.文件名为Msscript.ocx。
假设放在窗体上的ScriptControl控件名称为ScriptControl1则在“计算”按钮的Click事件中编写如下
代码 Dim Statement As String Statement quotXquot Text1.Text vbCrLf _ quotYquot Text2.Text vbCrLf _ quotMsgBox quotquot计算结果quotquot amp Y quot ScriptControl1.ExecuteStatement Statement //////////////////////////////////////////////////////////////////////////////////// 如何让一个 App 永远保持在最上层 Always on Top 请在声明区中加入以下声明 Private Declare Function SetWindowPos Lib quotuser32quot 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 Const SWP_NOMOVE ampH2 不更动目前视窗位置 Const SWP_NOSIZE ampH1 不更动目前视窗大小 Const HWND_TOPMOST -1 设定为最上层 Const HWND_NOTOPMOST -2 取消最上层设定 Const FLAGS SWP_NOMOVE Or SWP_NOSIZE 将 APP 视窗设定成永远保持在最上层 SetWindowPos Me.hwnd HWND_TOPMOST 0 0 0 0 FLAGS 取消最上层设定 SetWindowPos Me.hwnd HWND_NOTOPMOST 0 0 0 0 FLAGS //////////////////////////////////////////////////////////////////////////////////// 我要如何在程序中开启网页 在声明区中声明如下 在 .bas 档中用 Public 在 Form 中用 Private Private Declare Function ShellExecute Lib quotshell32.dllquot Alias quotShellExecuteAquot ByVal hWnd As Long ByVal lpOperation As String ByVal lpFile As String ByVal lpParameters As S tring ByVal lpDirectory As String ByVal nShowCmd As Long As Long 在程序中 Intranet ShellExecute Me.hWnd quotopenquot quothttp://Intranet主机/目录quot quotquot quotquot 5 Internet ShellExecute Me.hWnd quotopenquot quothttp://www.ruentex.com.twquot quotquot quotquot 5 //////////////////////////////////////////////////////////////////////////////////// 个人空间 发短消息 加为好友 当前离线 2楼 大 中 小 发表于 2006-12-29 09:17 只看该作者
VB可以产生四角形以外其他形状的 Form 吗 这个问题您一定无法想像有多容易您可以产生任何形状的 Form但必须借助 CreateEllipticRgn 及 SetWindowRgn 二个 API 例如 Private Declare Function CreateEllipticRgn Lib quotgdi32quot ByVal X1 As Long ByVal Y1 As Long ByVal X2 As Long ByVal Y2 As Long As Long Private Declare Function SetWindowRgn Lib quotuser32quot ByVal hWnd As Long ByVal hRgn As Long ByVal bRedraw As Boolean As Long Private Sub Form_Load Dim lReturn As Long Me.Show lReturn SetWindowRgnhWnd CreateEllipticRgn10 10 340 150 True End Sub 执行结果图片 CreateEllipticRgn 之四个参数说明如下 X1椭圆中心点之X轴位置但以 Form 的实№边界为限。
Y1椭圆中心点之Y轴位置但以 Form 的实№边界为限。
X2椭圆长边的长度 Y2椭圆短边的长度的 //////////////////////////////////////////////////////////////////////////////////// 如何移除 Form 右上方之『X』按钮 其实 Form 右上方之三个按钮分别对应到 Form 左上方控制盒 ControlBox 中的几个选项 缩到最小 / 放到最大 / 关闭而其中的最大化 MaxButton 及最小化 Minbutton 都可以直接在 Form 的属性中设定但是
VB 并没有提供设定『X』按钮的功能要达到这个功能必须借助 API 由于『X』按钮对应到 ControlBox 的关闭选项所以我们只要移除系统 Menu 就是ControlBox 的关闭选项即可您自己可以先看看您现在使用的 Browser 左上方的系统 Menu【关闭】选项是在第几个不是第 6 个是第 7 个分隔线也算一个分隔线才是第 6 个 当我们移除了关闭选项之后会留下一条很奇怪的分隔线所以最好连分隔线也一并移除。
而 Menu 的 Index 是从 0 开始分隔线是第 6 个所以 Index 5。
修正为了让程序码在 Windows NT 也能运作正常将各 Integer 型态改成 Long。
89.05.04 抓取系统 Menu 的 hwnd Private Declare Function GetSystemMenu Lib quotuser32quot Alias quotGetSystemMenuquot ByVal hwnd As Long ByVal bRevert As Long As Long 移除系统 Menu 的 API Private Declare Function RemoveMenu Lib quotuser32quot Alias quotRemoveMenuquot ByVal hMenu As Long ByVal nPosition As Long ByVal wFlags As Long As Long 第一个参数是系统 Menu 的 hwnd 第二个参数是要移除选项的 Index /////////////////////////////////////////////////// ///////////////////////////////// 如何制作透明的表单 Form 请在声明区中放入以下声明 Const GWL_EXSTYLE -20 Const WS_EX_TRANSPARENT ampH20amp Const SWP_FRAMECHANGED ampH20 Const SWP_NOMOVE ampH2 Const SWP_NOSIZE ampH1 Const SWP_SHOWME SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE Const HWND_NOTOPMOST -2 Private Declare Function SetWindowLong Lib quotuser32quot Alias quotSetWindowLongAquot ByVal hwnd As Long ByVal nIndex As Long ByVal dwNewLong As Long As Long Private Declare Function SetWindowPos Lib quotuser32quot 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 在 Form_Load 使用的范例如下 Private Sub Form_Load SetWindowLong Me.hwnd GWL_EXSTYLE WS_EX_TRANSPARENT SetWindowPos Me.hwnd HWND_NOTOPMOST 0amp 0amp 0amp 0amp SWP_SHOWME Me.Refresh End Sub //////////////////////////////////////////////////////////////////////////////////// 如何在 Menu 中加入MM的图案 在模组中加入以下程序码 Declare Function GetMenu Lib quotuser32quot ByVal hwnd As Long As Long Declare Function GetSubMenu Lib quotuser32quot ByVal hMenu As Long ByVal nPos As Long As Long Declare Function GetMenuItemID Lib quotuser32quot ByVal hMenu As Long ByVal nPos As Long As Long Declare Function SetMenuItemBitmaps Lib quotuser32quot ByVal hMenu As Long ByVal nPosition As Long ByVal wFlags As Long ByVal hBitmapUnchecked As Long ByVal hBitmapChecked As Long As Long Public Const MF_BITMAP ampH4amp Type MENUITEMINFO cbSize As Long fMask As Long fType As Long fState As Long wID As Long hSubMenu As Long hbmpChecked As Long hbmpUnchecked As Long dwItemData As Long dwTypeData As String cch As Long End Type Declare Function GetMenuItemCount Lib quotuser32quot ByVal hMenu As Long As Long Declare Function GetMenuItemInfo Lib quotuser32quot Alias quotGetMenuItemInfoAquot ByVal hMenu As Long ByVal un As Long _ ByVal b As Boolean lpMenuItemInfo As MENUITEMINFO As Boolean Public Const MIIM_ID ampH2 Public Const MIIM_TYPE ampH10 Public Const MFT_STRING ampH0amp 在 Form 中加入一个 PictureBox属性设定为 AutoSize True Picture .bmp 尺寸大小为 13x13不可设定为 .ico 在 Form_Load 中的程序码如下 Private Sub Form_Load 取得程序中 Mennu 的 handle hMenuamp GetMenuForm1.hWnd 取得第一个 submenu 的 handle hSubMenuamp GetSubMenuhMenuamp 0 取得 Submenu 第一个选项的 menuId hIDamp GetMenuItemIDhSubMenuamp 0 加入图片 SetMenuItemBitmaps hMenuamp hIDamp MF_BITMAP Picture1.Picture Picture1.Picture 在一个 Menu 选项中您一共可以加入二张图片 一张是 checked 状态用一张是 unchecked 状态用 End Sub 89、如何把小图片填满 Form 成为背景图 对于这个问题我看过很多方法有的方法很麻烦要声明一大堆 Type用一大堆的 API但是有一个最笨但我 认为最好的方法如下 就好像拼磁砖一样不用任何 API 不必声明任何 Type 在 Form 中放一个 PictureBoxPicture 属性设定为某一张小图AutoSize 属性性设定 True完成的模组如下 Sub PictureTileFrm As Form Pic As PictureBox Dim i As Integer Dim t As Integer Frm.AutoRedraw True Pic.BorderStyle 0 For t 0 To Frm.Height Step Pic.ScaleHeight For i 0 To Frm.Width Step Pic.ScaleWidth Frm.PaintPicture Pic.Picture i t Next i Next t End Sub PictureTile 这个模组共有二个参数第一个是表单名称第二个则是 PictureBox 的名称。
以下为一应用实例 Private Sub Form_Load PictureTile Me Picture1 End Sub 90、如何把小图片填满 MDIForm 成为背景图 以下这个范例 要 1、一个 MDIForm不必设定任何属性。
2、一个 Form1不一定是 MDIChild最好 MDIChild 为 False但是 AutoRedraw 设成 True。
3、Form1 上面放一个隐藏的 PictureBox名称为 Picture1不必.
上一篇:
用VB做游戏的源代码
下一篇:
关于大学英语教学