您的位置:寻梦网首页编程乐园VB 编程乐园VB 技巧库
Visual Basic 技巧库
第 13 部分 (121-131)
(1-10) (11-20) (21-30) (31-40) (41-50) (51-60) (61-70) (71-80) (81-90) (91-100) (101-110) (111-120) (121-131)
(121) 在 VB 中控制 Word
(122) 在菜单上增加图标
(123) 在程序中注册和注销 OCX 控件
(134) 在桌面上建立 Internet 快捷键
(125) 增加快捷方式到启动组
(126) 制作窗口背景
(127) 重新验证 Win 95 用户口令
(128) 桌面的大小
(129) 字符淡出淡入的实现
(130) 自动更新工作站的应用程序
(131) 自动选择 Text 的内容


在 VB 中控制 Word
在 VB 中控制 Word 98-8-02
Word 提供了一个 Word 对象, 通过在 “引用” 中的该对象, 可以实现对 Word 的控制。 以下的代码演示了执行 WordBasic 语句,该段代码是动态引用对象, 无须在工程中引用Word 对象。


Dim wd As Object
Set wd = CreateObject ("Word.Basic")
wd.FileNewDefault
wd.FontSize 20
wd.Insert "Hello, World"
wd.FileSaveAs "Hello.Doc"
wd.FileClose
Set wd = Nothing


执行后,将产生一个 Hello.Doc 。 一个种办法是在 Word 中调试好 WordBasic 语句后, 再发布到 VB 中。类似的处理应该也可以用在 Execl 中。




在菜单上增加图标
在菜单上增加图标 98-8-14
声明:
Declare Function GetMenu Lib "user32"  (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32"  (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32"  (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare 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 Long
Public Const MF_BITMAP = &H4&
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 "user32"  (ByVal hMenu As Long) As Long
Declare Function GetMenuItemInfo Lib "user32"  Alias "GetMenuItemInfoA" (ByVal hMenu As Long,  ByVal un As Long, ByVal b As Boolean,  lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&



使用: 在 Form1 中增加一个 PictureBox1, AutoSize 为 True, 放一个小 Bmp (不是 Icon!推荐 13*13)。
Private Sub Command1_Click()


'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)


'Get the handle of the first submenu (Hello)
hSubMenu& = GetSubMenu(hMenu&, 0)


'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)


'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
'You can add two bitmaps to a menuentry
'One for the checked and one for the unchecked
'state.


End Sub



在程序中注册和注销 OCX 控件
在程序中注册和注销 OCX 控件 98-7-20
声明(在本例子里使用的是 ComCtl32.OCX,如果是其他,使用相应的名称):
Declare Function RegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllRegisterServer" () As Long
Declare Function UnRegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllUnregisterServer" () As Long
Const ERROR_SUCCESS = &H0  


使用:


If RegComCtl32 = ERROR_SUCCESS Then
   MsgBox "Registration Successful"
Else
   MsgBox "Registration Unsuccessful"
End If


If UnRegComCtl32 = ERROR_SUCCESS Then
   MsgBox "UnRegistration Successful"
Else
   MsgBox "UnRegistration Unsuccessful"
End If  




在桌面上建立 Internet 快捷键
在桌面上建立 Internet 快捷键 98-8-21
以下的代码可以在桌面上建立一个 Internet 快捷键。
Dim StrURLFile As String
Dim StrURLTarget As String
Dim FileNum As Integer


StrURLFile = "C:\Windows\Desktop\VB 加油站.url"    '桌面目录和标题
StrURLTarget = "http://vbtt.yeah.net"   '地址
FileNum = FreeFile


'Write the Internet Shortcut file
Open StrURLFile For Output As FileNum
Print #FileNum, "[InternetShortcut]"
Print #FileNum, "URL=" & StrURLTarget
Close FileNum  




增加快捷方式到启动组
增加快捷方式到 启动 组
利用 DDE 可方便地建立快捷方式:(Text1 为表单中的 Textbox)
 Text1.LinkTopic = "Progman|Progman"
 Text1.LinkMode = 2
 Text1.LinkExecute "[ShowGroup(启动, 4)]"
 Text1.LinkExecute "[AddItem(c:\vb5\myprog.exe, 我的程序)]"




制作窗口背景
制作窗口背景
现有图片 Picture, 用以下的方法,将该图片布满整个窗口:
For I = 0 To ScaleWidth \ Picture.Width
 For J = 0 To ScaleHeight \ Picture.Height
   PaintPicture Picture, I * Picture.Width, J * Picture.Height
Next
Next




重新验证 Win 95 用户口令
重新验证 Win 95 用户口令
在进行重要的操作或特定的情况下,我们可能需要重新验证用户的口令,以提高系统的安全性。


Private Declare Function WNetVerifyPassword Lib "mpr.dll" Alias "WNetVerifyPasswordA" (ByVal lpszPassword As String, ByRef pfMatch As Long) As Long


Function VerifyPassWin95(sPassword As String) As Boolean
Dim lRetVal As Long
If (WNetVerifyPassword(sPassword, lRetVal)) <> 0 Then
MsgBox "VerifyPassWin95: Application Error"
Else
If lRetVal <> 0 Then
VerifyPassWin95 = True
Else
VerifyPassWin95 = False
End If
End If
End Function




桌面的大小
桌面的大小 98-7-16
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


Public Const SPI_GETWORKAREA = 48


Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long


Private Sub Command1_Click()


Dim lRet As Long
Dim apiRECT As RECT


lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)


If lRet Then
Print "Left: " & apiRECT.Left
Print "Top: " & apiRECT.Top
Print "Width: " & apiRECT.Right - apiRECT.Left
Print "Height: " & apiRECT.Bottom - apiRECT.Top
Else
Print "调用 SystemParametersInfo 失败"
End If


End Sub


98-7-16 更新 其他方法:
Sub Command1_Click ()
CR$ = Chr$(13) + Chr$(10)
TWidth% = screen.Width \ screen.TwipsPerPixelX
THeight% = screen.Height \ screen.TwipsPerPixelY


MsgBox "屏幕大小为" + CR$ + CR$ + Str$(TWidth%) + " x" + Str$(THeight%), 64, "Info"
End Sub



字符淡出淡入的实现
          Visual Basic 中字符淡出淡入的实现
                      
                      作者 姜军
                      
                      
---- 笔者偶尔在《计算机世界》上读到一篇关于在
VISUAL FOXPRO 中实现字符的淡出淡入的文章,受此启
发,笔者参照原文章用Visual Basic4.0 也编写了一段类
似的字符的淡出淡入程序,以此说明Microsoft 的可视
化开发工具具有的共性:相同或相似的图形用户界
面(GUI),面向对象和事件驱动的特性以及相同或
相似的函数等等。这个特点使得程序开发和设计人
员可以借鉴使用不同的Microsoft 可视化工具开发的
应用程序,并进行方便的移植,缩短开发周期。同
时,这对计算机语言的学习可以起到触类旁通的作
用。


---- 字符的淡入淡出功能可以通过对标签(LABEL)控
件的前景做不断的改变来完成。控件前景的变化,
可以在设计时用标签控件的前景属性来设置,也可
以在程序中通过给前景属性赋予不同的色彩值来
实现。色彩由RGB 函数提供(Visual Foxpro 也有该函数
)。用定时器控件产生的中断不断改变RGB 参数值,
因此能够使得字符的前景随之改变,实现了淡出淡
入的目的。


---- 下面用Visual Basic4.0 编写的程序完成了两个功
能:(1)字符的淡出淡入,而且颜色的变化有
256*256*256 种,此处只选择了由灰色到红色的变化;
(2)淡出时字符由小到大,淡入时则由大到小。另
外,本程序的实现过程可完全方便地向Visual C、
Visual Java 等可视话语言移植。


---- 一. 启动Visual Basic 4.0 ,自动生成一个窗体,默
认为FORM1。


---- 二. 将该窗体的属性设置如下:


NAME:DEMO
   CAPTION:VB 实现字符的淡入淡出
   BACKCOLOR:&H00C0C0C0%, 即背景为灰色


---- 三. 在窗体DEMO 中定义以下窗体变量, 即
在General-declaration 过程中定义色彩参数R,G,B。


   Dim r As Integer
   Dim g As Integer
   Din b As Integer


---- 四. 在Form-load 过程中设置字符色彩初值, 即灰
色:


   Private Sub Form_Load()
   r = 192
   g = 192
   b = 192
   End Sub  


---- 五. 在窗体DEMO 中加入一标签,其属性设置如下:


   NAME:LABEL1  
   CAPTION:哈尔滨国投债券交易系统
   AUTOSIZE:TRUE,用以实现字符的缩放
   BACKSTYLE:0-TRANSPARENT,即透明
   FONT:字体为隶书,大小选择为8


---- 六. 在窗体中加入定时器控件,用以完成淡出功
能,设置如下:


   NAME:OUTTIMER
   INTERVAL:50,即隔一秒中断一次,色彩变化一次。


---- 七. 再加入一个定时器,完成淡入功能:


   NAME:INTIMER
   INTERVAL:50


---- 八. 在OUTTIMER 的TIMER 过程中加入以下代码:


Private Sub Outtimer_Timer()
If r < 255 Then
r = r + 1
Else
r = 255
End If
If g > 3 Then
g = g - 3
Else: g = 0
End If
If b > 3 Then
b = b - 3
Else: b = 0
End If
Label1.FontSize = Label1.FontSize + 0.75
Label1.ForeColor = RGB(r, g, b)
If Label1.FontSize >= 72 Then
Outtimer.Enabled = False
Intimer.Enabled = True
End If
End Sub


---- 九. 在INTIMER 中加入如下代码:


Private Sub Intimer_Timer()
If r > 192 Then
r = r - 1
Else
r = 192
End If
If g < 192 Then
g = g + 3
Else: g = 192
End If
If b < 192 Then
b = b + 3
Else: b = 192
End If
Label1.FontSize = Label1.FontSize - 0.75
Label1.ForeColor = RGB(r, g, b)
If Label1.FontSize <= 8 Then
Intimer.Enabled = False
Outtimer.Enabled = True
End If
End Sub


---- 当完成上述步骤后,按运行按扭,就可看到在
窗体内“哈尔滨国投证券交易系统”几个字由小到
大、有浅入深地显示出来;当字体达到规定的大小
时,又渐渐地消失在窗体之中,实现淡出淡入的功
能。



自动更新工作站的应用程序
自动更新工作站的应用程序
Private Sub Form_Load()
   On Error GoTo errorhandler
   ' Command 函数返回
   ' 命令行的字符串信息
   ' 该程序需要两个参数
   ' 如:(thisprog.exe c:\localdir\prgcopied.exe
   ' k:\servrdir\prgtocopy.exe)
   If FileDateTime(Left(Command$, _
       InStr(Command$, " ") - 1)) < _
       FileDateTime(Mid$(Command$, _
       InStr(Command$, " ") + 1)) Then
       Top = (Screen.Height - Height) / 2
       Left = (Screen.Width - Width) / 2
       label1 = "拷贝 " & Mid$(Command$, InStr_
           (Command$, " ") + 1) & _
           " 到你的硬盘..."
       Visible = True
       Refresh
       FileCopy Mid$(Command$, _
           InStr(Command$, " ") + 1), _
           Left(Command$, InStr(Command$, " ") - 1)
   End If
   '开始程序
   x = Shell(Left(Command$, InStr(Command$, " ") - 1), 3)
   End
   Exit Sub
errorhandler:
   If Err = 53 Then '文件没有
       Resume Next '还是要拷贝
   Else
       MsgBox "错误 # " & Err & Chr(10) & Error _
          & Chr(10) & "结束"
       End
   End If
   Exit Sub
End Sub




自动选择 Text 的内容
自动选择 Text 的内容
在使用 VFP 的应用进行录入时,每进入一个录入框,就自动选择该框中的所有内容。利用以下的代码,也可实现类似的功能。


Private Sub MyTextBox_GotFocus()
   AutoSelect MyTextBox
End Sub


Sub AutoSelect(SelObject As Control)
   SelObject.SelStart = 0
   If TypeOf SelObject Is MaskEdBox Then
       SelObject.SelLength = Len(SelObject.FormattedText)
   Else
       If TypeOf SelObject Is TextBox Then
           SelObject.SelLength = Len(SelObject.Text)
       End If
   End If
End Sub