精华区文章阅读

发信人: xiangchu (天歌), 信区: VisualBasic
标  题: Visual Basic编程问答集(三)
发信站: 紫丁香 (Tue Aug 31 14:59:22 1999), 转信

(接上期)

□   怎么在VB中实现Delphi那样的MouseEnter和MouseExit的功能？
   VB中的鼠标事件驱动只有MouseDown,MouseMove,MouseUp三个事件，没有象
Delphi那样提供MouseEnter(OnEnter)和MouseExit(OnExit)的事件。而这两个
事件是平时编写程序经常要用到的，我们可以通过调用SetCapture和ReleaseCapture
这两个Windows API函数的方法来实现它。具体步骤如下：
1)  在VB中新建一个标准EXE工程；
2)  画出一个按钮Command1；
3)  在窗体Form1中定义Windows API的声明；
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
4)  在Command1的MouseMove事件中编写以下代码：
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim MouseEnter As Boolean  '鼠标进入的标志位

    MouseEnter = (0 <= X) And (X <= Command1.Width) And _
(0 <= Y) And (Y <= Command1.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$ + Chr$(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, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

    Private Sub Form_Load()
      SetWindowRgn hWnd, CreateEllipticRgn(100, 100, 320, 200), True
      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, sngBlueCur), 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 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
    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目录。
Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (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                                                     (待续)

--
※ 来源:．紫丁香 bbs.hit.edu.cn．[FROM: 202.118.228.152]

VB 版 (精华区)