computer 版 (精华区)

发信人: kammi (未), 信区: Program
标  题: 水母VB精华-Visual Basic编程问答集(三)
发信站: 听涛站 (Fri Dec 24 14:49:01 1999), 转信

《电脑》杂志1998年第5期 暨南大学软件工具研究所 吴锡桑
----------------------------------------------------------
Visual Basic编程问答集（三）
(接上期)
□ 怎么在VB中实现Delphi那样的MouseEnter和MouseExit的功能？
VB中的鼠标事件驱动只有MouseDown,MouseMove,MouseUp三个事件，没有象
Delphi那样提供MouseEnter(OnEnter)和MouseExit(OnExit)的事件。而这两个事件是平
时编编写程序经常要用到的，我们可以通过调用SetCapture和ReleaseCapture这两个Wi
ndows API函数的方法来实现它。具体步骤如下?
1) 在VB中新建一个标准EXE工程；
2) 画出一个按钮Command1；
3) 在窗体Form1中定义Windows API的声明；
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Lon
g
Private Declare Function ReleaseCapture Lib "user32" () As Long
4) 在Command1的MouseMove事件中编写以下代码：
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Sin
gle,, Y As Single)
Dim MouseEnter As Boolean '鼠标进入的标志位
MouseEnter = (0 <= X) And (X <= Command1.Width) And (0 <= Y) And (Y <= Comma
and1.Height) '计算鼠标的移动是否在Command1里面
If MouseEnter Then '鼠标已经进入
Me.Caption = "Mouse In Button!"
SetCapture Command1.hWnd
Else '鼠标已经离开
Me.Caption = "Mouse Out!"
ReleaseCapture
End If
End Sub
□ 如果在Windows中为自己的软件建立程序组和程序项？
可以用Windows DDE(动态数据交换)的办法跟Program Manager(程序管理器)进行应答，
建亮 程序组和程序项。程序实现如下：
1) 在VB中新建一个标准EXE工程；
2) 建立一个用于DDE数据交换的Label1；
3) 编写创建程序组CreateProgManGroup()和创建程序项CreateProgManItem()函数如下
：
Sub CreateProgManGroup(frm As Form, GroupName$, GroupPath$)
On Error Resume Next
Screen.MousePointer = 11
frm.Label1.LinkTopic = "ProgMan|Progman"
frm.Label1.LinkMode = 2
For i% = 1 To 10 '等待应答
z% = DoEvents()
Next i%
frm.Label1.LinkTimeout = 100
frm.Label1.LinkExecute "[CreateGroup(" + GroupName$ + Chr$(44) + GroupPath$
+ ")]"
DoEvents
frm.Label1.LinkTimeout = 50
frm.Label1.LinkMode = 0
Screen.MousePointer = 0
End Sub
Private Sub CreateProgManItem(frm As Form, CmdLine$, IconTitle$, IconFile$)
On Error Resume Next
Screen.MousePointer = 11
frm.Label1.LinkTopic = "ProgMan|Progman"
frm.Label1.LinkMode = 2
For i% = 1 To 10
z% = DoEvents()
Next i%
frm.Label1.LinkTimeout = 100
frm.Label1.LinkExecute "[ReplaceItem(" + IconTitle$ + ")]"
frm.Label1.LinkExecute "[AddItem(" + CmdLine$ + Chr$(44) + IconTitle$ + Chrr
$(44) + IconFile$ + Chr$(44) + ",,)]"
frm.Label1.LinkTimeout = 50
frm.Label1.LinkMode = 0
Screen.MousePointer = 0
End Sub
4) 在Form_Click()中编写主程序；
Sub Form_Click()
fname = "C:\TEST\TEST.EXE"
icontle = "图标标题"
iconpath = "C:\TEST\TEST.ICO" + ",0"
'建立图标
CreateProgManGroup Form1, "我的程序组", "TEST.GRP"
CreateProgManItem Form1, fname, icontle, iconpath
End Sub
□ 讨厌了千编一律的矩形窗体，如何建立一个不规则形状的窗体？
Windows API函数SetWindowRgn会让你得到满意的答复，下面的程序显示一个椭圆形的窗
体体，程序实现如下?
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, By
yVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVa
al hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Load()
SetWindowRgn hWnd, CreateEllipticRgn(100, 100, 320, 200), True
Me.Show
Me.Show
End Sub
□ 安装软件的时候总有由蓝到黑渐变的背景，是如何实现的？
其实就是由上到下画渐变颜色的线，程序如下：
Private Sub DrawBackGround()
Const intBLUESTART% = 255
Const intBLUEEND% = 0
Const intBANDHEIGHT% = 2
Const intSHADOWSTART% = 8
Const intSHADOWCOLOR% = 0
Const intTEXTSTART% = 4
Const intTEXTCOLOR% = 15
Dim sngBlueCur As Single
Dim sngBlueStep As Single
Dim intFormHeight As Integer
Dim intFormWidth As Integer
Dim intY As Integer
intFormHeight = ScaleHeight
intFormWidth = ScaleWidth
sngBlueStep = intBANDHEIGHT * (intBLUEEND - intBLUESTART) / intFormHeight
sngBlueCur = intBLUESTART
For intY = 0 To intFormHeight Step intBANDHEIGHT
Line (-1, intY - 1)-(intFormWidth, intY + intBANDHEIGHT), RGB(0, 0, snggBlue
Cur), BF
sngBlueCur = sngBlueCur + sngBlueStep
Next intY
End Sub
Private Sub Form_Activate()
DrawBackGround
End Sub
□ 当用Shell运行别的软件时候，我想等该程序结束再继续我的程序语句，能做得到吗
？　?
当用Shell函数调用外部软件时，VB总会在Shell执行后，继续执行下面的程序代码，而
而我们无法确定外部软件什么时候调用结束。我们可以通过Windows API的OpenProcess
和CloseHandle函数来实现对被调用软件的检测：
1) 在VB中新建一个标准EXE工程；
2) 在Form1中声明OpenProcess和 CloseHandle 这两个Windows API 函数；
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccesss
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Lonng)
 As Long
3) 然后编写下面的函数:
Function IsRunning(ByVal ProgramID) As Boolean ' 传入进程标识ID
Dim hProgram As Long '被检测的程序进程句柄
hProgram = OpenProcess(0, False, ProgramID)
If Not hProgram = 0 Then
IsRunning = True
Else
IsRunning = False
End If
CloseHandle hProgram
End Function
4) 在Form_Click()中加入代码：
Sub Form_Click()
Dim X
Me.Caption = "开始运行"
X = Shell("NotePad.EXE", 1)
While IsRunning(X)
DoEvents
Wend
Me.Caption = "结束运行"
End Sub
□ 如何获得当前的Windows目录和System子目录？
Windows API函数GetWindowsDirectory()，用于读取当前Windows目录。
？
Windows API函数GetWindowsDirectory()，用于读取当前Windows目录。
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirecto
ryA"" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function GetWindowsDir() As String
Dim strBuf As String
strBuf = Space(80) '最大长度
If GetWindowsDirectory(strBuf, 80) > 0 Then
GetWindowsDir = UCase$(strBuf)
End If
End Function (待续)

--