欢迎加入我们，一同切磋技术。 &
用户名： &&&
密　码： &
共有 297 人关注过本帖
标题：vb复杂的问题，请求高手支招。
等　级：新手上路
&&已结贴√
&&问题点数：5&&回复次数：2&&&
vb复杂的问题，请求高手支招。
我在做自己的系统时遇到了问题，请高手帮帮忙。
涉及到的表为yhls（此表包括：id，yhname,xb,dw,kzqname,dkqname,rq,sj）,yhtjk（此表包括：dw,tjkry,xb,crzhm）,yhcldj
(dw,tjkry,crzhm,clpzhm,crkqrq,rkqsj,ckqsj,zbry)
我的窗体中涉及到11个控件，他们是——单位(dw)：text1;提交款人员1(tjkry):text2;出入证号码1(crzhm):text3;提交款人员2(tjkry):text4;出入证号码2(crzhm):text5;车辆
牌照号(clpzhm):text6;车辆证件号(clzjhm):text7;出入库区日期(crkqrq):text8;入库区时间(rkqsj):text9;出库区时间(ckqsj):text10;值班人员(zbry):text11
我要实现的是窗体每隔几秒钟就刷新yhls表一次，然后需要的相应记录自动显示到text中去，入库时，如果同一个单位的同一个人(a)记录有重复则显示最新的记录，然后在数据
库中查找同一个单位的另一个人，将相应的信息填入相应的表格，如果同一个单位的另一个人(b)有重复记录则显示最新的时间（只显示不一样的字段，也就是时间字段）。出库
时显示出库时间(ckqsj),出库时间应该是a,b两个人中最晚出来的时间，别的字段不用显示。全部信息显示出来以后则点击保存，存入yhcldj表。然后删除yhls表中a,b两个人的记
录，再继续查找后面的数据。
给个例子：
dw,&&&tjkry,&&xb,&&crzhm
工行，张三，&&男，&&221
工行，李四，&&男，&&222
id，yhname,xb,&&dw,&&kzqname,&&&dkqname,&&&&&rq,&&&&&& sj
1，张三，&&男，工行，金库后门，金库后门进，：10
2，李四，&&男，工行，金库后门，金库后门进，：11
3，张三，&&男，工行，金库后门，金库后门出，：21
4，李四，&&男，工行，金库后门，金库后门出，：22
记录完以后保存到yhcldj表中记录为：
dw,&&& tjkry,&&&&&&crzhm,&&&&&clpzhm,&&& crkqrq,&&& rkqsj,&&&&&&ckqsj,&&& zbry
工行， 张三，李四&&221，222&&&123123&&&&&101&&&&&&&&&&& 10：11&&& 10：22
这里的车辆牌照号码和车辆证件号码我已经提取出来了，不用再提取了。
搜索更多相关主题的帖子:
等　级：贵宾
威　望：85
帖　子：4054
专家分：27589
以下是引用xjbozlxm在 18:04:10的发言：
我要实现的是窗体每隔几秒钟就刷新yhls表一次，
以下是引用xjbozlxm在 18:04:10的发言：
显示最新的记录
等　级：新手上路
回复 2楼 Artless
能说的详细点么？或者留个联系方式，方便交流。。。
版权所有，并保留所有权利。
Powered by , Processed in 0.051437 second(s), 8 queries.
Copyright&, BCCN.NET, All Rights ReservedVisual Basic编程常见问题及解答,VB教程,VB案例,VB实例
　　　　　本站短域名：珠江路.cn、zjlu.net
　　　　　　　　
　　　　　
　　　　　　　　　　
您的位置： &&
&& Visual Basic编程常见问题及解答
Visual Basic编程常见问题及解答
　　各位朋友大家好，如果你在的时间够长，那么你会发现很多帖子的是相同的，既然这样，不如总结到一起让初学者来翻看，再热心的大虾也不愿意把一个答案重复几十遍。　　若朋友您想要问如何才能学好vb，或者入门需要看什么教材一类的问题，建议你抱着一颗刻苦钻研的心去面对这门学问，多动脑，少提问，遇到不知道的，多查，多看老贴，或者用断点来亲自试验。实在不会了，请在此贴中查找您的，如果还没有，那请您发出新贴，向各位高手讨教。　　查找：按ctrl+f，输入要查找的问题关键字即可，本人只是稍微编辑了一下。　　如何用建立快捷
Private Declare
fCreateLink Lib "STK432." (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 = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\s\calc.exe", "")　’添加到组　lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe", "")　’添加到启动组　lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\calc.exe", "")End Sub　　如何让程序在
启动时自动？　　有以下二个方法：　　方法1: 直接将快捷方式放到启动群组中。　　方法2:
在注册档 HKEY_LOL_MACHINE 中找到以下机码\Software\Microsoft\Windows\CurrentVersion\Run新增一个字串值，包括二个部份1. 名称部份：自己取名，可设定为
名称。2. 资料部份：则是包含 ’全路径档案名称’ 及 ’执行’例如：Value Name = NotepadValue
= c:\windows\notepad.exe　　在 TextBox 中如何限制只能输入数字？　　参考下列程序：
Sub Text1_KeyPress(KeyAscii As Integer)　If KeyAscii & 48 Or KeyAscii & 57 Then　　KeyAscii = 0　End IfEnd Sub　　我希望 TextBox 中能不接受某些特定字符，例如 ’@#$%"，有没有简单一点的写法？　　方法有好几种, 以下列举二种：　　方法1: 可以使用 IF 或 Select Case 一个个, 但如果不接受的字符多时, 较麻烦! 　　方法2: 将要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 !! 如下：
Private Sub Text1_KeyPress(KeyAscii As Integer)　Dim s As String　sTemplate = "!@#$%^&*()_+-=" ’用来存放不接受的字符　If InStr(1, sTemplate, Chr(KeyAscii)) & 0 Then　　KeyAscii = 0　End IfEnd Sub　　如何让进入 TextBox 时自动选定 TextBox 中之整串文字？　　这个自动选定反白整串文字的动作，会使得输入的资料完全之前在 TextBox 中的所有字符。
Private Sub Text1_GotFocus()　Text1.SelStart = 0　Text1.SelLength = Len(Text1)End Sub　　如何检查软盘器里是否有软盘？　　使用：
Dim Flag As BooleanFlag = Fun_FloppyDrive("A:")If Flag = False Then MsgBox "A:驱没有准备好，请将插入驱动器！", vbCritical’-------------------------------’:检查软驱中是否有盘的存在’-------------------------------Private Function Fun_FloppyDrive(sDrive As String) As BooleanOn Error Resume NextFun_FloppyDrive = Dir(sDrive) && ""End Function　　如何弹出和关闭托盘？
Option ExplicitPrivate Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwnd As Long) As LongPrivate Sub Command1_Click()　mciExecute "set cdaudio door open" ’弹出光驱　Label2.Caption = "弹 出"End SubPrivate Sub Command2_Click()　Label2.Caption = "关 闭"　mciExecute "set cdaudio door closed" ’合上光驱　Unload Me　EndEnd Sub　　如何让你的程序在任务列表隐藏
Private Declare Function Registercess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As LongPrivate Declare Function GetCurrentProcessId Lib "kernel32" () As Long’请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了Private Sub Command1_Click()　i = RegisterServiceProcess(GetCurrentProcessId, 1)End Sub 　　如何用程序控制滑鼠游标 (Mouse Cursor) 到指置？　　以下这个例子，当 User 在 Text1 中按下 ’Enter’ 键后，滑鼠游标会自动移到 Command2 按钮上方 　　请在区中加入以下声明：
’16 位版本： ( Sub 无传回值 )Declare Sub SetCursorPos Lib "User" (ByVal X As Integer, ByVal Y As Integer)’32 位版本： ( Function 有传回值，Integer 改成 Long )Declare Function SetCursorPos Lib "32" (ByVal x As Long, ByVal y As Long) As Long’在 1 中加入以下程序码：Private Sub Text1_KeyPress(KeyAscii 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 IfEnd Sub　　如何用鼠标没有标题的 Form，或移动 Form 中的控制项？　　在声明区中放入以下声明：
’16 位版本： ( Sub 无返回值 )Private Declare Sub ReleaseCapture Lib "User" ()Private Declare Sub SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)’32 位版本： ( Function 有返回值，Integer 改成 Long )Private Declare Function ReleaseCapture Lib "user32" () 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 Long’共用常数：Const WM_SYSCOMMAND = &H112Const SC_MOVE = &HF012’若要移动 Form，程序码如下：Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)　Dim i As Long　i = ReleaseCapture　i = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)End Sub’以上也适用于用鼠标在 Form 中移动控制项，程序码如下：Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)　Dim i As Long　i = ReleaseCapture　i = SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)End Sub　　检查是否存在？
Function Exists(filename As String) As Integer　Dim i As Integer　On Error Resume Next　i = Len(Dir$(filename))　If Err Or i = 0 Then FileExists = False Else FileExists = End Function 　　如何对VB连接的路径　　我个人因为经常作一些数据库方面的程序，对于程序间如何与数据库进行的问题之烦是深有体会，因为VB在数据库的时候，一般是，即数据库存放的路径是固定的，如用VB的DATA，adodc,DataEnvironment 等到作时，如果存放数据库的路径被改变的话，就会找不到路经，真是一个特别烦的事。　　笔者的方法是利用app.path 来解决这个问题。 　　一、用data进行数据库链接，可以这样：　　在form_load()中放入：
private form_load()Dim str As String ’str = .PathIf Right(str, 1) && "\" Thenstr = str + "\"End Ifdata1.databasename=str & "\数据库名"data1.recordsource="数据表名"data1.refreshsub end　　这几句话的意为，打开当前程序运行的目录下的数据库，你只要保证你的数据库在你程序所在的目录之下就行了。　　二、利用adodc（ADO Data )进行数据库链接：
private form_load ()Dim str As String ’定义str = App.PathIf Right(str, 1) && "\" Thenstr = str + "\"End Ifstr = "=Microsoft.Jet.OB.1;Persist Security Info=FData Source=" & str & "\tsl.mdb"Adodc1.ConnectionString = str<mandType = adCmdTextAdodc1.RecordSource = " * from table3"Adodc1.Refreshend sub　　三、利用DataEnvironment进行数据库链接　　可在过程中放入：
On Error Resume NextIf DataEnvironment1.rsCommand1. && adStateClosed Then　DataEnvironment1.rsCommand1.Close ’如果打开，则关闭End If’i = InputBox("请输入友人编号:", "输入")’If i = "" Then Exit SubDataEnvironment1.Connection1.Open App.Path & "\userdatabase\tsl.mdb"DataEnvironment1.rsCommand1.Open "select * from table3 where 编号=’" & i & "’"’Set DataReport2.DataSource = DataEnvironment1’DataReport2.DataMember = "command1"’DataReport2.showend sub　　四、利用ADO(ActiveX Data Objects)进行：　　建立连接：
dim conn as new adodb.connectiondim rs as new adodb.recordsetdim strstr = App.PathIf Right(str, 1) && "\" Thenstr = str + "\"End Ifstr = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=FData Source=" & str & "\tsl.mdb"conn.open strrs.cursorlocon=aduseclientrs.open "数据表名",conn,adopenkeyset.adlockpessimistic用完之后关闭数据库：conn.closeset conn=nothing　　如何让自行输入方程式，并计算其结果？　　假设我们要让使用者在“方程式”栏位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。( ScriptControl 控件附属于VB 6.0，如果后没有看到此一控件，可在的 \Common\Tools\VB\Script 目录底下找此一控件， 其.文件名为Ms.ocx。) 假设放在上的ScriptControl控件名称为ScriptControl1，则在“计算”按钮的Click中编写如下：
Dim Statement As String Statement = "X=" + Text1.Text + vbCrLf + _ "Y=" + Text2.Text + vbCrLf + _ "MsgBox ""计算结果="" & Y " ScriptControl1.ExecuteStatement( Statement 　　如何让一个 App 永远保持在最上层 ( Always on Top )　　请在声明区中加入以下声明
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 LongConst SWP_NOMOVE = &H2 ’不更动目前视窗位置Const SWP_NIZE = &H1 ’不更动目前视窗大小 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 "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lption As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long　　在程序中
Intranet：ShellExecute Me.hWnd, "open", "http://Intranet主机/目录", "", "", 5Internet：ShellExecute Me.hWnd, "open", ".tw", "", "", 5　　VB可以产生四角形以外其他形状的 Form 吗？　　这个问题，您一定无法想像有多容易，您可以产生任何形状的 Form，但必须借助 CreateEllipticRgn 及 SetWindowRgn 二个
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As LongPrivate Sub Form_Load()Dim lReturn As LongMe.ShowlReturn = SetWindowRgn(hWnd, CreateEllipticRgn(, 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.04
’抓取系统 Menu 的 hwndPrivate Declare Function GetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As Long’移除系统 Menu 的 APIPrivate Declare Function RemoveMenu Lib "user32" Alias "RemoveMenu" (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 = &H20&Const SWP_FRACHANGED = &H20Const SWP_NOMOVE = &H2Const SWP_NOSIZE = &H1Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZEConst HWND_NOTOPMOST = -2Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate 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　　在 Form_Load 使用的范例如下：
Private Sub Form_Load()SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENTSetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWMEMe.RefreshEnd Sub　　如何在 Menu 中加入美美的图案？　　在模组中加入以下程序码：
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As LongDeclare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As LongPublic Const MF_BITMAP = &H4&Type MENTEMINFO　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 LongEnd TypeDeclare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As LongDeclare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As BooleanPublic Const MIIM_ID = &H2Public Const MIIM_TYPE = &H10Public Const MFT_STRING = &H0&　　在 Form 中加入一个 PictureBox，属性设定为：
AutoSize = TruePicture = .bmp (尺寸大小为 13x13，不可设定为 .ico)　　在 Form_Load 中的程序码如下：
Private Sub Form_Load()　’取得程序中 Mennu 的 handle　hMenu& = GetMenu(Form1.hWnd)　’取得第一个 submenu 的 handle　hSubMenu& = GetSubMenu(hMenu&, 0)　’取得 Submenu 第一个选项的 menuId　hID& = GetMenuItemID(hSubMenu&, 0)　’加入　SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture　’在一个 Menu 选项中您一共可以加入二张图片　’一张是 checked 用，一张是 unchecked 状态用End Sub　　如何把小图片填满 Form 成为背景图？　　对于这个问题，我看过很多方法，有的方法很麻烦，要声明一大堆 Type，用一大堆的 API，但是有一个最笨但我认为最好的方法如下： (就好像拼磁砖一样，不用任何 API, 不必声明任何 Type)　　在 Form 中放一个 PictureBox，Picture 属性设定为某一张小图，AutoSize 属性性设定 True，完成的模组如下：
Sub PictureTile(Frm As Form, Pic As PictureBox)　Dim i As Integer　Dim t As Integer　Frm.AutoRedraw = True　Pic.Border = 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 tEnd Sub　　PictureTile 这个模组共有二个参数，第一个是表单名称，第二个则是 PictureBox 的名称。以下为一：
Private Sub Form_Load()　PictureTile Me, Picture1End Sub　　如何把小图片填满 IForm 成为背景图？　　以下这个范例，要：　　1、一个 MDIForm：不必设定任何属性。　　2、一个 Form1：不一定是 MDIChild，最好 MDIChild 为 False，但是 AutoRedraw 设成 True。　　3、Form1 上面放一个隐藏的 PictureBox：名称为 Picture1，不必设定 Picture 属性。　　4、一张图片的完整路径。
’将以下模组放入 MDIForm 的声明区中：Sub TileMDIBkgd(MDIForm As Form, bkgdtiler As Form, bkgdfile As String)If bkgdfile = "" Then Exit SubDim ScWidth%, ScHeight%ScWidth% = Screen.Width / Screen.TwipsPerPixelXScHeight% = Screen.Height / Screen.TwipsPerPixelYLoad bkgdtilerbkgdtiler.Height = Screen.Heightbkgdtiler.Width = Screen.Widthbkgdtiler.ScaleMode = 3bkgdtiler!Picture1.Top = 0bkgdtiler!Picture1.Left = 0bkgdtiler!Picture1.Picture = LoadPicture(bkgdfile)bkgdtiler!Picture1.ScaleMode = 3For n% = 0 To ScHeight% Step bkgdtiler!Picture1.ScaleHeightFor o% = 0 To ScWidth% Step bkgdtiler!Picture1.ScaleWidthbkgdtiler.PaintPicture bkgdtiler!Picture1.Picture, o%, n%Next o%Next n%MDIForm.Picture = bkgdtiler.Unload bkgdtilerEnd Sub　　以下为一应用实例：
Private Sub MDIForm_Load()TileMDIBkgd Me, Form1, "c:\windows\Tiles.bmp"End Sub　　关闭指定的程序　　要做到像 Task Manager 一样，可以关闭指定的程序，方法如下：　　在声明区中放入以下声明：(16位　改成 win31 API)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongDeclare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Const WM_CLOSE = &H10　　以下之范例示范如何关闭一个视窗标题 (Caption) 为 【小算盘】的程序：
Dim winHwnd As LongDim RetVal As LongwinHwnd = FindWindow(vbNullString, "小算盘")Debug.Print winHwndIf winHwnd && 0 Then　RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)　If RetVal = 0 Then　　MsgBox "Error posting message."　End IfElse　MsgBox "并未开启小算盘程序."End If　　如何隐藏及再鼠标　　很简单，只用到了一个 ShowCursor API，参数也很简单，只有一个 bShow，设定值如下：
True：显示鼠标 / False：隐藏鼠标Declare Function ShowCursor Lib "user32" Alias "ShowCursor" (ByVal bShow As Long) As Long　　如何从您的应程序中结束 Windows 重开机？　　很多在 Setup 完之后都会自动关机重开机，以便让某些设定值可以生效，其实这个功能很简单，只要几行指令就可以做到了！　　关键就是要使用 ExitWindowsEx 这个 API，这个 API 只有二个参数，第一个参数是一个 Flag，目的是要告诉 Windows 要以什么方式关机，在下面的声明中会列出可用的 Flag 常数值，至于第二个参数则是一个保留值，只要设定成 0 就可以了。　　很重要的一点是：如果您想要让关机动作更顺利，记得要 Unload 您的程序！
’在声明区中 (Bas Module / Form Module) 加入以下声明：Public Const EWX_LOGOFF = 0 ’这四个常数值可以并用Public Const EWX_SHUTDOWN = 1 Public Const EWX_REBOOT = 2 Public Const EWX_FOE = 4Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long’实例：如果您想强迫关机重开机，程序码如下：ret = ExitWindowsEx(EWX_FORCE OR EWX_REBOOT, 0)　　如何用 VB 启动其他程序或开启各类文件？　　要在 VB 中启动其他程序或开启各类文件，最简单的方法就是使用 Shell 函数，例如：要开启 C:\Test.txt 这个文字文件，则要启动记事本来开启这个文件案，程序如下：
Dim RetVal As LongRetVal = Shell("C:\Windows\Notepad.exe C:\Test.txt", 3) ’3代表视窗会最大化，并具有驻点，细节请查 Help　　以上的虽然很简单，但有一个风险，若是我们不知道开启文件的执行文件位置，则程序便会有错误产生，尤其一般软件在安装的时候都可以让使用者自行选择安装目录，所以执行文件的路径不能写死在程序中，要解决这个问题，就是在注册文件中找到该副文件名之启动程序位置，再放入 Shell 中。　　但是以上的作法必须熟悉注册文件，而且必须使用 Windows API 来 Call (注册文件的存取以后会有专文来说明)，如果您对注册文件的存取及 API 的使用都很纯熟的话，当然没问题，但是有些人对于注册文件会有畏惧，这时候，您可以使用下面的方法： Shell("Start C:\Test.txt")　　您完全不用知道这份文件的启动程序是什么？它放在什么地方？参数 Start 便会自动依照附文件名到注册文件中找到启动程序来开启该份文件案！ 不赖吧！　　注一：在 Windows 95/98/NT 平台中, 什么副文件名之文件案, 该由什么执行文件来启动, 都设在关联中,　　代码为 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\ensions　　例如: 名称为 ".DOC" 之资料为 "C:\Progra'1\Micros'2\Office\WINWORD.EXE ^.DOC"　　名称为 ".TXT" 之资料为 "notepad.exe ^.txt"　　注二：使用 Start 之唯一缺点为 "会比直接指定执行文件稍为慢 0.5-1 秒钟."　　如何找出 Windows 目录的正确路径？　　有时候我们在程序中必须用到 Windows 的目录，以存取 Windows 目录下的文件，照理说，这应该是最简单的功能，前提是每个人在 Setup Windows 必须采用 Windows 的预设目录名称，也就是 C:\Windows，但是常常不是这样，有时候由於要使新旧版本共存，或者其他原因，有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......　　若是程序中必须用到 Windows 目录，要找到正确的路径，做法如下：
’在声明区中加入以下声明：Const MAX_PATH = Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPublic Function GetWinPath()　Dim strFolder As String　Dim lngResult As Long　strFolder = String(MAX_PATH, 0)　lngResult = GetWindowsDirectory(strFolder, MAX_PATH)　If lngResult && 0 Then　　GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)　Else　　GetWinPath = ""　End IfEnd Function’在程序中使用方法如下：Private Sub Command1_Click()　Call MsgBox("您电脑中 Windows 目录的正确路径是： " & GetWinPath, vbInformation)End Sub　　让您的文字框有 Undo / Redo 的功能　　很多软件都有提供 Undo / Redo 的功能，Microsoft 的都可以提供多次 Undo 反悔，功能更强大！　　在 VB 的程序中，我们也可以提供这样的功能！不过只能 Undo / Redo 一次
’在声明区中加入以下声明： ’32位元’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 EM_UNDO = &HC7’16位元Private Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As LongConst WM_USER = &HConst EM_UNDO = WM_USER + 23’在程序中使用的方式如下： ( Undo Text1 中的输入 )Private Sub Command1_Click()　Dim UndoResult As Long　UndoResult = SendMessage(Text1.hwnd, EM_UNDO, 0, 0)　’传回值 UndoResult = -1 表示 Undo 不成功End Sub’使用以上的方法，第一次是 Undo ，第二次就等于是 Redo　　如何得到某年每个月的第一天是星期几
Private Sub Command1_Click()Dim i As Integer, A As Integer, B As Integer, C As StringA = InputBox("请输入年份", "某年每个月的第一天是星期几")Form1.ClsFor i = 1 To 12C = A & "-" & i & "-1"B = Weekday(C)Select Case BCase vbSundayPrint A & "年" & i & "月1日是 星期日"Case vbMondayPrint A & "年" & i & "月1日是 星期一"Case vbTuesdayPrint A & "年" & i & "月1日是 星期二"Case vbWednesdayPrint A & "年" & i & "月1日是 星期三"Case vbThursdayPrint A & "年" & i & "月1日是 星期四"Case vbFridayPrint A & "年" & i & "月1日是 星期五"Case vbSaturdayPrint A & "年" & i & "月1日是 星期六"End SelectNext iEnd Sub　　如何隐藏及显示任务栏？　　有时候，我们希望在我们的程序执行中，将任务栏隐藏，让桌面变得比较清爽，等到我们的程序执行完毕之后，再将任务栏显示出来，这时就要用到 SetWindowPos 这个 API 了！
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 LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongConst SWP_HWINDOW = &H80 ’隐藏视窗Const SWP_SHOWWINDOW = &H40 ’显示视窗 ’在程序中若要隐藏任务栏Private Sub Command1_Click()　Dim Thwnd As Long　Thwnd = FindWindow("Shell_traywnd", "")　Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)End Sub’在程序中若要再显示任务栏Private Sub Command2_Click()　Dim Thwnd As Long　Thwnd = FindWindow("Shell_traywnd", "")　Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)End Sub　　模拟 Windows 的回收站！　　您现在将屏幕上所有的视窗全部缩小，找到资源回收站，按鼠标右键，选择【属性】，便会出现【资源回收站】的属性问话框。　　其中有几个选项如下：　　1、不要将文件移到资源回收站，删除时立即移除文件。　　2、显示删除？　　根据以上之状况，文件之删除有三种情形：　　1、删除文件，出现确认对话框，文件移到资源回收站。　　2、删除文件，出现确认对话框，文件不移到资源回收站。　　3、删除文件，不出现确认对话框，文件也不移到资源回收站。　　模拟程序如下：
’在模组的声明区中加入以下声明：Public Type SHFILEOPSTRUCT　hwnd As Long　wFunc As Long　pFrom As String　pTo As String　fFlags As Integer　fAnyOperationsAborted As Long　hNameMappings As Long　lpszProgressTitle As LongEnd TypePublic Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPublic Const FO_DELETE = &H3Public Const FOF_ALLOWUNDO = &H40 ’可以还原Public Const FOF_NOCONFIRMAT = &H10 ’不出现确认对话框Public Const FOF_SILENT = &H4’在程序中之使用方法如下：’以下之例子会出现确认对话框，文件也会移到资源回收站。Private Sub Command1_Click()　Dim SHop As SHFILEOPSTRUCT　Dim strFile As String ’要删除的文件(含全路径)　strFile = "c:\test.txt"　With SHop　　.wFunc = FO_DELETE　　.pFrom = strFile　　.fFlags = FOF_ALLOWUNDO　End With　SHFileOperation SHopEnd Sub’若要调整，只要更改 fFlags 之值即可，如下：.fFlags = FOF_SILENT ’删除文件，出现确认对话框，文件不移到资源回收站。.fFlags = FOF_NOCONFIRMATION ’删除文件，不出现确认对话框，文件也不移到资源回收站。　　如何得到文件路径的文件名
Dim sFilePath As StringsFilePath = "C:\Windows\System\sytem.dll"Dim lGetLen As Long, lNum As LongDim sGetFile As String, sTemp As StringlGetLen = Len(sFilePath) ’得到文件路径长度sTemp = lGetLenFor lNum = 1 To lGetLen　If Left(sGetFile, 1) = "\" Then Exit For　sGetFile = Mid(sFilePath, sTemp, lNum)　sTemp = sTemp - 1Next lNumsGetFile = Mid(sGetFile, 2) ’得到文件名MsgBox sGetFile　　如何防止使用者按下 CTRL + ALT + DEL　　有些时候，我们的执行时，不希望使用者按下 CTRL + ALT + DEL 来异常结束程序或关机，这时候我们可以在启动程序时，将 CTRL + ALT + DEL 功能键之功能取消，然后在结束程序之前，再从新恢复 CTRL + ALT + DEL 之功能。　　在模组声明区中加入以下声明及模组：
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal u As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As LongPublic Const SPI_SCREENSAVERRUNNING = 97Public Sub Disable_Ctrl_Alt_Del()　’让 CTRL+ALT+DEL 失效　Dim AyW As Integer　Dim TurFls As Boolean　AwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, TurFls, 0)End SubPublic Sub Enable_Ctrl_Alt_Del()　’让 CTRL+ALT+DEL 恢复功能　Dim AwY As Integer　Dim TurFls As Boolean　AwY = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, TurFls, 0)End Sub’实际使用时，在 Form 中加入以下程序码：Private Sub Form_Load()　Disable_Ctrl_Alt_DelEnd SubPrivate Sub Form_Unload(Cancel As Integer)　Enable_Ctrl_Alt_DelEnd Sub　　如何取得文件大小？　　VB6 提供了一个新的物件，叫做 FSO (File System Object) 物件模型，运用它，我们可以很方便的磁盘、资料夹和文件的一些动作。　　FSO 物件模型含有好几个物件，其中有一个 File 物件是用来求得文件的相关资讯，在目前这个主题，我们就可以使用 File 物件！它有一个属性是 Size，对文件来说就是指文件的大小 (单位为位元组)。 (注一)　　虽然使用 File 物件的 Size 属性就可以求得文件的大小，但是它有以下二个缺点：　　1、只能用于 VB6 以后的版本。　　2、它不是 VB6 内定的功能，必须另外引用 Scrrun.dll (Microsoft Scripting ) 才可以！　　以下的二个方法就可以使用在所有的 VB 版本中 (含 VB6)，而且是 VB 内定的功能：　　1、FileLen 函数：返回一个 Long，代表一个文件的长度，单位是位元组。　　语法：FileLen(pathname) ’ pathname 是全路径之文件名称　　适用：取得一个尚未开启的文件的长度大小 (注二)　　2、LOF 函数：返回一个 Long ，单位为位元组，用来代表由 Open 陈述式所开启的文件之大小。　　语法：LOF(filenumber) ’ filenumber 是一个文件代码　　适用：取得一个已开启的文件的长度大小　　注一：File 物件的 Size 属性除了可以求得一个文件的大小，也可以用来取得整个目录的所有文件大小！　　注二：使用 FileLen 函数时，如果所指定的文件正在开启中，则所返回的值是这个文件在开启前的大小。　　如何移除或更改桌面背景的底色图案 (Wallpaper)？　　SystemParametersInfo 这个 API 可以设定许多 Windows 系统的功能参数，而其中一个参数就是桌面底图！通常一般的使用者会透过控制面板中的【】来设定桌面底图。　　在底下的范例中，我们使用 SPI_SETDESKWALLPAPER 这个参数及图片文件名称来设定新的桌面底图，同时使用 SPIF_SENDWINIHANGE 来通知各个视窗这个改变。
’在表单的声明区中加入以下声明及常数：Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As LongConst SPI_SETDESKWALLPAPER = 20Const SPIF_UTEINIFILE = &H1Const SPIF_SENDWININICHANGE = &H2’在表单上加入一个 CommandButton (Command1) 来移除桌面底图，程序码如下：Private Sub Command1_Click()　Dim X As Long　X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, "(None)", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)　MsgBox "桌面底图 (Wallpaper) 已经被移除"End Sub’在表单上加入另一个 CommandButton (Command2) 来更改桌面底图，程序码如下：Private Sub Command2_Click()　Dim FileName As String　Dim X As Long　FileName = "c:\windows\test.bmp"　X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)　MsgBox "桌面底图 (Wallpaper) 已经被更改"End Sub 　　一个快速注册 DLL 及 OCX 的方法　　有时候我们在 VB 中要引用某一个 DLL 或 OCX 时，会出现文件未注册的讯息，这时，我们可以使用人工注册的方法，也就是直接在命令列中使用 regsvr32.exe 来做，做法如下：　　文件注册：C:\Windows\System\Regsvr32.exe C:\Windows\System\Test.ocx　　取消注册：C:\Windows\System\Regsvr32.exe /u C:\Windows\System\Test.ocx　　这些动作我们也可以直接写到程序中，使用 Shell 来执行，但是我现在要说的，都不是上面提到的方法！　　注意看罗！方法如下：　　1、在资源器中找到 C:\Windows\System\Regsvr32.exe 并【复制】 ( 按鼠标右键选复制 )　　2、将目录移到 C:\Windows\SendTo 后，执行【贴上快捷方式】 ( 按鼠标右键选贴上快捷方式 )　　3、将快捷方式名称改成【REGTER】　　4、OK　　现在，如果您想替某一个文件做注册动作，例如：C:\Windows\System\Test.ocx，您只要打开资源管理器，找到 C:\Windows\System\Test.ocx，按鼠标右键选【传送到】【REGISTER】即可完成注册动作了！　　注：有一个地方要注意的是，Regsvr32.exe 只能注册 32 位的文件！如果要用它来注册 16 位的文件，会有错误讯息产生。　　如何用TextBox打开和保存文件　　作为轻量级的控件，TextBox控件使用率很高，但相关的资料极少谈及如何用TextBox控件打开和保存文件，大都采用回避的态度，对VB初学者带来很多不便。笔者近日为友人做一个英文朗读软件，按友人的要求，软件要能象MS的记事本那样能打开和保存文档。其实实现方法并不复杂，现将心得写出来，希望对大家有。如果您有更好的方法，请来信：handanfang@163。
’新建EXE，加入一个TextBox控件，一个公共对话框，两个菜单。’打开Private Sub mnuOpen_Click()　CommonDialog1. = "文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"　CommonDialog1.ShowOpen　Open CommonDialog1.FileName For Input As #1　Text1.Text = StrConv(InputB$(LOF(1), 1), vb)　Close #1End Sub’保存Private Sub mnuSave_Click()　On Error Resume Next　CommonDialog1.Filter ="文档文件(*.txt)|*.txt|所有文件(*.*)|*.*"　CommonDialog1.ShowSave　Open CommonDialog1.FileName For Output As #1　Print #1, Text1.Text　Close 1End Sub　　TextBox只支持打开64K以下的文件，建议最好设置出错处理。以上程序在PWin98、VB6.0下通过。　　如何判断目前文件资源管理器中，文件名称之扩展文件名是显示或隐藏？　　由于我在集团性的资讯处工作，所负责的公司系统有的是属于外点，例如润泰建设有个单位是行销业务处，他们的工作是卖公司盖的房子，所以他们的业务人员平常都是待在各工地的接待中心，我替他们的系统在工地的部份是属于单机作业的，使用
资料库，每一个星期资料回传总公司一次。　　业务人员由于流动性大，不太了解系统，有时候，系统出了问题，业务人员又搞不清楚状况，于是我会要求他们将资料库 sale.mdb 回传公司，结果，常闹笑话，原来他们回传公司的，常常不是 sale.ldb 就是 sale.exe，为什么呢？ 原因很简单，因为他们的文件资源管理器中，设定了将扩展文件名隐藏起来，结果只看到三个不同图示的 sale 文件 (分别是 Sale.mdb、Sale.ldb、Sale.exe)，不太会操作的业务人员根本分不清楚那一个图示的 sale 文件才是资料库文件案！　　我们在 VB 的程序中要如何判断，目前文件资源管理器中的设定是否显示扩展文件名呢？
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As IntegerPrivate Function HasExtension(sFileName As String) As Long　Dim sTemp As String　Dim lTemp As Long　sTemp = String(1, 0)　lTemp = GetFileTitle(sFileName, sTemp, Len(sTemp))　If lTemp & 0 Then HasExtension = -1: Exit Function　sTemp = String(lTemp, 0)　Call GetFileTitle(sFileName, sTemp, Len(sTemp))　If (Left$(Right$(Left$(sTemp, lTemp - 1), 4), 1)) = "." Then　　HasExtension = 1　Else　　HasExtension = 0　End IfEnd Function　　若有显示扩展文件名，返回值是 1，否则返回0。&&阅读关于 VB 的全部文章
数据库开发
产品库推荐
All Rights Reserved.
珠江路在线版权所有
　|　　|　　|　}