Visual Basic 技巧库
第 13 部分 (121-131)
在 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
|