|
楼主 |
发表于 2004-6-11 21:03:45
|
显示全部楼层
[推荐]编程问答
57,Q:VB 编程中打开默认网址和 Email 的更简单的方法:
A:打开网址:Call Shell("start http://www.alchemydev.com", vbHide)
打开 Email:Call Shell("start mailto:admin@alchemydev.com", vbHide)
58,Q:我用 VB6.0 的 ActiveX dll 工程开发了一个在 ASP 中调用的 dll 类型库,里面有好多封装的函数,我能不能在 VB 的 EXE 工程中利用它们?
A:当然可以! 这正是微软 COM 模型的具体应用之一。具体用法是:在 VB 的 EXE 工程的 IDE 界面中,引用你建立的类库文件,然后在“对象浏览器”里就可以看到你的所有类及其函数。比方你的类 myobj 中有函数 myfun(),则调用语句是:
dim theobj as new myobj
ret = theobj.myfun() 'ret 为函数返回值
当然如果你要在别的机器上使用你的组件,就必须先进行注册:regsvr32 <你的组件名>
59,Q:“我爱你”病毒传播的秘密:
A:千禧年五月分大面积流行的 "ILOVEYOU" 病毒至今让人记忆尤新。这种病毒是一种通过电子邮件流行的典型的蠕虫病毒。她是通过调用 Outlook 的应用程序对象的属性和方法进行信件发送的,其发送邮件的基本代码如下:
Set OlApp = CreateObject("outlook.application")
Set Oitem = OlApp.CreateItem(olMailItem)
With Oitem
.Subject = "邮件主题"
.To = "收件人"
.Body = "邮件正文"
.attachments.Add "path:附件" ' 添加附件
.Send ' 发送邮件
End With
60,Q:在 PowerBuilder 中使用 RichTextEdit 控件,属性中没用 Font,我想设置字体怎么办(如果不设字体,读入一个文本文件,缺省的字体对不齐)?
A:RichTextEdit 没有 Font 属性,在 Document 属性页中选择 Toolbar,使用的时候可以自行选择字体。
61,Q:在一个 PowerBuilder 程序中,我想用 RichTextEdit 控件从本地取文本文件显示,可是在我的机器上 RTE 只能显示出少量英文和乱码,程序并没有编错,因为相同的程序在其他人的机器上显示出的是正确的文本,不知是什么原因?
A:应该是默认的类型不正确,导入的时候指定类型为 FileTypeText 试试。
62,Q:如何在 PowerBuilder 的 BLOB 字段中写入大于 1M 的文件(数据库为MSSQL 7.0)?
A:源文件分块写。
63,Q:用程序控制电脑说英语?
A:现在,应用 Microsoft 提供的一套文字朗读引擎(Text-To-Speech Engine,简称 TTS),可以在程序中编写代码来使安装了声卡的电脑流畅的朗读英文。如果安装了“金山词霸2000”,那么 Windows 文件夹下会有一个 Speech 文件夹,里面的文件 vtxtauto.tlb 文件就包含了有关的类型库和函数,我们完全可以在我们的程序中调用它们,使电脑开口说话。TTS 包含在“金山词霸2000”的安装盘上,文件名为 mstts.exe 和 spchapi.exe。要在 VB 程序中调用 TTS,必须首先引用 vtxtauto.tlb 文件中的“VoiceText 1.0 Type Library”类型库,然后参考以下代码,电脑就可以说话了:
Option Explicit
Private Sub Form_Load()
Call VTxtAuto.VTxtAuto.Register(Space(1), Space(1))
VTxtAuto.VTxtAuto.Speed = 170 '设置语速(170 为正常语速,值越小语速越慢)
Dim strTxt
strTxt = "I love you very much.Do you love me? "
On Error GoTo ErrorHandler
Call VTxtAuto.VTxtAuto.Speak(strTxt, vtxtsp_VERYHIGH + vtxtst_READING)
MsgBox "OK!"
End
ErrorHandler:
' 错误处理语句
End
End Sub
至于语速、频率等的控制,大家可以在“对象浏览器”里参看相关的控制属性。
(站长话题:什么时候能够让电脑说一口流利的中国普通话甚至是方言呢?
但愿不会让我们等待太久!
但愿生产厂家能够像微软一样把技术公布给普通用户!)
64,Q:怎样判断、防止程序重复执行?
A:
Private Sub Form_load()
'判断程序是否已经运行
If App.PrevInstance Then
MsgBox "本程序已经运行!", vbInformation Or vbOKOnly, "提示信息"
Unload Me
Exit Sub
End If
'以下是主要程序
' ……
End Sub
附:另一个例子:
Option Explicit
Public Sub CheckExist(fm As Form) '防止程序重复执行
Dim title As String
If App.PrevInstance Then
title = App.title
Call MsgBox("这程序已执行", vbCritical)
App.title = "" '如此才不会 Avtivate 到自己
fm.Caption = ""
AppActivate title 'activate 先前就已运行的程序
End ' 结束
End If
End Sub
Private Sub Form_Load()
Call CheckExist(Me)
End Sub
65,Q:如何结束 Shell 所启动的程序?
A:如果被 Shell 所启动的程序还没有结束,我们就想主动结束它,该怎么做呢? 此时应调用的 Windows API 是 TerminateProcess, 细节如下:
1. API 的声明:
Const SYNCHRONIZE = &H100000
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
(注1:如果以上的声明放在「一般模块」底下,应将 Declare 之前的 Private 保留字去掉,并且在 Const 之前加上 Public 保留字。)
2. Shell 的程序范例:(以执行 MS-DOS 为例)
Dim pId As Long, pHnd As Long ' 分别声明 Process Id 及 Process Handle 变数
pId = Shell("Command.com", vbNormalFocus) ' Shell 传回 Process Id
pHnd = OpenProcess(SYNCHRONIZE, 0, pId) ' 取得 Process Handle
Call TerminateProcess( pHnd, 0 ) ' TerminateProcess 所传入的是 Process Handle
Call CloseHandle( pHnd )
(注2:以上的方案只适用于 Shell 所启动的程序,ShellExecute 则不适用,原因是 ShellExecute 函数是通过资源管理器来启动程序,而资源管理器启动程序之后,并没有将 Process ID 或 Process Handle 传回来。
注3:以上程序在 Windos98、VB6.0 下调试通过。)
66,Q:用 VB5.0 创建 Windows 程序组中的快捷方式:
A:
'API 函数声明:要在 VB5.0 中创建 Windows 的快捷方式,需要用到一个动态链接库 Vb5stkit.dll。在该动态链接库中提供了三个函数 OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink,分别用于创建快捷方式程序组、快捷方式、删除快捷方式。这三个函数的声明形式分别如下:
Private Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" Alias "fCreateShellFolder" (ByVal lpstrDirName As String) As Long
Private Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String,ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
Private Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" Alias "fRemoveShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As Long
'实现的语句:
Dim lresult As Long
lresult = OSfCreateShellGroup("Test") '在程序菜单中添加一个名为 Test 的程序组
lresult = OSfCreateShellLink("test", "记事本", "c:\Windows\notepad.exe", "")
'在程序菜单的Test程序组下创建记事本的快捷方式
lresult = OSfRemoveShellLink("Test", "记事本") '删除 Test 程序组下的快捷方式
(注:在 Windows98/NT4.0、VB5.0 下可以正常运行。但创建桌面快捷方式和 Start Menu 快捷方式有些问题。在 VB6.0 中也有些问题(是否要安装 SP3?)。)
67,Q:VB 中使 TextBox 按 Mouse 右键时只出现自定 PopUp Menu?
A:一般我们可能在 TextBox 的 MouseDown Event 中 Check 是否按右键,若是,则设定出现 Popup Menu 程式如下:
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu MyMenu
End If
End Sub
可是出现的还是原先内定的 Popup Menu,之后再按一次右键,才出现我们自定的 menu。很奇怪吧?如果用 API 来解决,那便是要拦截 Mouse 的按键(使用 SubClassing 的技巧),但是有人发现了以下的方式便可以解决(也是一个十分实作性的经验):
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Text1.Enabled = False : Text1.Enabled = True
PopupMenu MyMenu
End If
End Sub
68,Q:用 VB 实现拖放功能:
A:拖放是用鼠标拖动一个对象到其它对象的活动。在图形操作过程中,拖放是最常用的功能之一,下面我们来看看怎样用 VB 实现拖放功能。
首先介绍与拖放有关的控件:
1.属性:DragMode 决定拖动操作的初始化是人工方式还是自动方式,DragIcon 确定在拖动过程中显示的指针的图标形状;
2.方法:Drag 开始,结束或取消拖动控件;
3.事件:MouseDown 事件发生于用户按下鼠标按钮时,DragOver 事件发生于拖动操作完成时,DragDrop 事件发生于拖动操作正在进行时。
然后编写一个小程序,这个程序能实现在窗口中或窗口间拖动图标的功能。建立窗口 Form1 和 Form2,在窗口中都加入 Image1,为它们设置初始显示的图片。键入以下代码(本程序在 VB5.0/6.0,Window95/98/NT4.0 环境下通过):
' Form1 下程序代码为:
Option Explicit
Dim dragx As Single
Dim dragy As Single
Const BEGIN_DRAG=1
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Image1.Picture=Source 'Sourse为被拖动的控件
Form2.Image1.Picture=LoadPicture("")
Image1.Move(X-dragx),(Y-dragy) ' X,Y为鼠标所在目标窗体或控件的当前坐标
End Sub
Private Sub Form_Load()
Load Form2
Form2.Show 0
End Sub
Private Sub Image1_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single)
dragx=X
dragy=Y
Image1.Drag BEGIN_DRAG '开始拖动操作
Image1.DragIcon = LoadPicture("按下鼠标时想显示的光标")
End Sub
' Form2 下程序代码为:
Option Explicit
Dim dragx As Single
Dim dragy As Single
Const BEGIN_DRAG=1
Private Sub Form_DragDrop(Source As Control,X As Single,Y As Single)
Image1.Picture=Source
Form1.Image1.Picture=LoadPicture("")
Image1.Move(X-dragx),(Y-dragy)
End Sub
Private Sub Image1_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single)
dragx=X
dragy=Y
Image1.Drag BEGIN_DRAG
Image1.DragIcon=LoadPicture("按下鼠标时想显示的光标")
End Sub
69,Q:用 VB 程序如何改变桌面的墙纸图片?
A:此一问题需调用 SystemParametersInfo API 函数,细节如下:
1. API 的声明:
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
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
注:如果以上的声明放在「一般模块」底下,应在 Const 之前加上 Public 保留字,并且将 Private 保留字去掉。
2. 程序范例:
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, BMP图档名称, SPIF_UPDATEINIFILE)
例如:
' 1. 将桌面图片设定成 c:\windows\setup.bmp:
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\setup.bmp", SPIF_UPDATEINIFILE)
' 2. 将桌面图片清掉:
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "", SPIF_UPDATEINIFILE)
程序如下:
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, BMP图档名称, SPIF_UPDATEINIFILE)
但以上程序设定图片之后,必须等到下次 Windows 重新启动时才生效,如果希望设定之后立刻生效,则程序须修改如下:
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2
Const SPI_SETDESKWALLPAPER = 20
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\setup.bmp", SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)
此外希望只有本次使用 Windows 时改变桌面图片(下次开机时还原原状),则程序如下:
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\setup.bmp", SPIF_SENDWININICHANGE) ' 去掉 SPIF_UPDATEINIFILE
70,Q:用 VB 程序捕捉屏幕图像:
A:在 Form1 上添加一个 Picture 和 Command 控件,代码如下(Windows98/NT、VB6.0):
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Sub ScrnCap(Lt, Top, Rt, Bot)
rWidth = Rt - Lt
rHeight = Bot - Top
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, Top, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub
Sub Command1_Click()
Form1.Visible = False
ScrnCap 0, 0, 640, 480
Form1.Visible = True
Picture1 = Clipboard.GetData()
End Sub
71,Q:测试表中的记录总数又一法(笨而准确):
A:
Dim db As Database ' DAO
Dim rs As Recordset
Dim theRecordNum As Long
Set db = OpenDatabase(App.Path & "\mylib.mdb")
Set rs = db.OpenRecordset("test") '测试表 test 中记录数
theRecordNum = 0
rs.MoveFirst
Do While Not rs.EOF()
theRecordNum = theRecordNum + 1
rs.MoveNext
Loop
Debug.Print theRecordNum ' 在监视窗口中输出
72,Q:如何判断生成的记录集是“空集”(记录数为 0)?
A:如果记录集的 eof 为真,则记录集是“空集”:
if AdoRS.EOF=true then
' ……
EndIf
73,Q:VB 编程中如何使窗口右上角的关闭按钮(X)失效?
A:用以下两个过程中的一个即可:
1、Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = True
End Sub
2、Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub
74,Q:用 VB 实现超级链接功能:
A:声明 ShellExecute 函数;在 form 上建立 label、line 控件各一个(myHttp、Line1),再仿照以下代码,即可打开浏览器登录 http://why100000.at.china.com 网站。
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
Private Sub myHttp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.Visible = False
End Sub
Private Sub myHttp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.Visible = True
End Sub
Private Sub Form_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.Visible = False
End Sub
Private Sub myHttp_Click()
Dim HttpJump
Dim MyUrl As String
MyUrl = "http://why100000.at.china.com"
HttpJump = ShellExecute(0&, vbNullString, MyUrl, vbNullString, vbNullString, vbNormalFocus)
End Sub
75,Q:在 VB 安装程序中加入“卸载”功能:
A:在制作安装盘的过程中,在建立程序项的时候,建立一个名为“卸载”的程序项,“目标”文本框中填入命令:
$(WinPath)\st6unst.exe -n "$(AppPath)\st6unst.log"
这样安装后的程序就会有卸载功能了。
76,Q:怎样在 VC++ 中产生闪烁的光标
A:先调用函数 CreateCaret(),然后再调用函数 ShowCaret()。例如:
if(CreateCaret(hWnd,NULL,2,20))
{
SetCaretPos(0,0);
ShowCaret(hWnd);
}
77,Q:VFP 程序编译成 .EXE 文件后运行,为在什么屏幕上一闪而过就结束了?
A:这是初学 VFP 的人易犯的一个错误,只要在主文件中加入 read events 语句,在退出程序中加入 clear events 即可。
78,Q:VB 中如何在保存并覆盖文件时让其出现对话框,询问是否替换
A:用 CommonDailog 控件,在 CommonDialog 控件 Flags 属性设定中添加 cdlOFNOverwritePrompt,如:
CommonDialog1.Flags=CommonDialog1.Flags Or cdlOFNOverwritePrompt
CommonDialog1.ShowSave
79,Q:VB6 中的字体出现乱码怎么办?
A:这是 VB 的 Bug。引起的原因是系统中安装了 Word2000 或 IE5.x 以及繁体支持,将繁体支持删除,或者安装 VB6 的 SP3 或 SP4 就可以解决问题。
80,Q:怎样用 VB 编写多线程程序
A:尽管 VB5.0 是单线程的,但用 addressof 加上一些 API 函数,就可以非常容易的做多线程程序。每一个线程约占用 20 毫秒的时间片。
VB5 有一个主线程,我们可以另外加一个工作线程。对于不清楚什么是单/多线程的程序员,我们用一个简单的列子来说明一下:
在 Form 里加上两个 timer 控件,把 interval 属性设成 5000(5秒),然后在两个 timer1_timer 事件中放一个大 Loop,如 for 10000 next, 运行。你会看到第二个 timer 控件不会在五秒后执行,除非 timer1 的for-next 结束。同样,如果你的程序中有大量的数据库读写,你的用户界面可能被“冻”。这时,我们就需要用多线程来改进程序了。(当然你可以用 DoEvents 来避免被冻,但用 DoEvents 有很多副作用-这里不提。)
我们用的第一个 API 是 CreateThread,VB 的格式是:
private declare function CreateThread Lib "kernel32" (byval pThreadAttributes as any, byval dwStackSize as long, byval lpStartAddress as long, lpParameter as any, byval dwCreationFlags as long, lpThreadID as long) as long
CreateThread 的参数指出你将要创立的线程是什么样子的,CreateThread 的返回值是一个线程的 handle。以下是
VB 的多线程初始化程序:
Public Sub Initialize(lpfnBasFunc as long)
dim dwStackSize as long
dim dwCreationFlags as long
dim lpThreadId as long
dim lpParameter as long
dim myNull as long
myNull = 0& 'create a null pointer
dwStackSize = 0 '0 表示用 exe stack size
dwCreationFlags = 4 '用 4 表示初始化后先不激活,让别人来激活
Me.Thread = CreateThread(myNull, dwStackSize, lpfnBasFunc, myNull, dwCreationFlags,lpThreadId)
If Me.Thread = myNull then
Msgbox "create thread failed"
End if
End Sub
下面是两个 API 用来激活/暂停该线程:
private declare function ResumeThread lib "kernel32"(byval hThread as long)as long
private declare function SuspendThread lib "kernel32"(byval hThread as long)as long
让我们来用一个变量表示当前线程的状态:
public ThreadStatus as boolean
在 VB 里,可用 property 来实现 ThreadStatus 的管理。
Public property Let Enabled(byval vNewValue as boolean)
if vNewValue = true and Me.ThreadStatus = false then
ResumeThread Me.Thread
Me.ThreadStatus = True
elseif Me.ThreadStatus = true then
SuspendThread Me.Thread
Me.ThreadStatus = False
end if
End Property
这个简单的类可以用 New Object 来引用:
'make new thread object
dim myThread as New clsThreads '创建县城 Foo
myThread.Initialize AddressOf Foo '激活县城
myThread.Enabled = True
执行后,你可以用 PVIEW95.EXE 看到你的线程。你还可以提高你的线程的优先级:
SetThreadPriority '设优先级
GetThreadPriority '查优先级
你把以上的程序加入 timer 例子,就会看到两个 timer 同时运行。
这里要提醒一下,VB5 的开发环境是单线程的,如果你的程序写错,或中断后试图恢复,往往会出错,有时是严重出错。总之,用 VB 的多线程可以写出和 VC++ 一样快的程序,而且开发容易的多,开发效率也快得多。
|
|