发信人: msnet()
整理人: cobe(2000-03-12 14:39:43), 站内信件
|
编者的话
==============================================
凡未署名的文章是网友推荐的作品，如果原作者
看到自己的文章未署自己的名字，请与版主联系，版
主会在主页的巳发表的文章中给予更正。
如要转载本VB邮件请与原作者联系，不是版主的
文章请不要署版主的名字，但请注明摘自:
goodvbhome.yeah.net
谢谢大家的合作。
版主 冯德平
[email protected]
=============================================
目 录
a 菜单项的动态装入
b 防止将重复项目添加到列表框控件中
c 动态改变屏幕设置
=============================================
VB邮件(7.16)
a 菜单项的动态装入
菜单项的动态装入是指菜单项的个数不固定. 例子就是文件菜单中最近打开
的文件的列表。在第一次打开文件之前,该列表是空的,并且不在文件菜单中出现
;打开一个文件后,该列表不再是空的,并且文件菜单中出现代表被打开文件的菜单
项。
具体的实现过程如下:
在文件菜单里增加一个菜单项,标题任意,并假设菜单项的Name属性是opened
_files_ list;
更改菜单项opened_files_list的可见属性,使 opened_files_list.Visible
=False
更改菜单项opened_files_list的下标属性,使 opened_files_list.Index=0
在程序中控制菜单项opened_files_list的动态装入。
假设要显示打开过的第二个文件的文件名,并且该文件名存放在一个文件名数
组opened _file_name里。以下的代码就实现了这一功能:
Load opened_files_list(1)
opened_files_list(1).Caption="&2"+opened_file_name(1)
opened_files_list(1).Visible=True
需要注意的是,对于下标为0的菜单项,不能用Load方法。因为在程序执行时,
该菜单项就 已经被装入到内存里了;另外,在菜单项的标题属性字符里的"&"字符
具有特殊的含义,它的作 用是在显示该属性字符串的同时,并不显示"&"本身,而紧
跟"&"的字符在显示时具有下划线, 并且该字符成为热键。
如果下标不为0的菜单项不再需要,为了减少对内存资源的占用,可以用Unloa
d方法把它 从内存卸出;同样地,不能用Unload卸出下标为0的菜单项。
b 防止将重复项目添加到列表框控件中
谭 翁
Visual Basic的列表框控件中包含项目的列表，本文介绍如何检查列表中项
目是否已经存在，以及如何将新的项目添加到列表框控件中。
使用SendMessage函数搜寻重复的项目
在Visual Basic中开发应用程序时，可以使用列表框控件来创建一个项目的
列表。要将新的项目添加到列表中，可以使用AddItem方法，该方法不能自动地报
告在列表框控件中是否有重复的信息存在，所以必须在将新项目添加到列表之前
首先检查一下。
可以通过使用Windows应用程序编程接口（API）的SendMessage函数来在列表
框控件中搜寻指定的项目，它函数允许向操作系统中发送消息。在本文的例子里
，我们让SendMessage函数往列表框控件中执行一个LB_FINDSTRING消息。
LB_FINDSTRING消息允许在一个列表框控件中搜索同目标字符串相匹配的项目
。该消息的第一个参数是希望进行的搜索类型，须将该值设为0，表示从列表框控
件中的第一个项目开始搜索。第二个参数是一个NULL结束的字符串，它是实际希
望搜索的项目。
如果该LB_FINDSTRING消息返回值-1，则表明在列表框控件中没有找到目标字
符串，此时可以使用AddItem方法来将新的项目添加到列表框控件中。如果该项目
已经在列表中存在，则可以简单地显示一个信息框或是执行一些其它的过程，来
通知用户一个重复的项目已经在列表框控件中存在。
样例程序
该程序显示了如何确定在一个列表框控件中是否已经包含了一个要添加到控
件中的项目。
1.在Visual Basic中开始一个新的工程，采用缺省的方法建立Form1。
2.将如下常量和声明语句添加到Form1的通用声明部分中（注意该声明语句需
要被书写在一行内）：
Private Declare Function SendMessageFind Lib "user32" Alias "SendMessa
geA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer,
ByVal lParam As String) As Long
Const WM_USER = &H400
Const LB_ERR = (-1)
Const LB_FINDSTRING = &H18F
3.将如下代码添加到Form1的Form_Load事件中：
Private Sub Form_Load()
List1.AddItem "Item #1"
List1.AddItem "Item #2"
List1.AddItem "Item #3"
List1.AddItem "Item #4"
End Sub
4.在Form1上添加一个文本框控件，采用缺省的方法建立Text1。
5.在Form1上添加一个列表框控件，采用缺省的方法建立List1。
6.在Form1上添加一个命令按钮控件，采用缺省的方法建立Command1，将起C
aption属性设置为“重复”。
7.将如下代码添加到Command1的单击事件中：
Private Sub Command1_Click()
CheckForDupes
End Sub
8.创建一个新的名为CheckForDupes的函数，将如下代码添加到该函数中：
Sub CheckForDupes()
Dim Ret As Long
Dim A As String
A = Text1.TEXT
Ret = SendMessageFind(List1.hwnd, LB_FINDSTRING, 0, (A))
If Ret = LB_ERR Then
List1.AddItem Text1.TEXT
Else
List1.ListIndex = Ret
MsgBox " 重 复 项 目 － 不 能 被 添 加 到 列 表 框 中", 16, " 错 误"
End If
End Sub
按下F5键来执行本程序。在列表框控件中有5个项目。在文本框控件中键入一
个新的项目，单击重复命令按钮。程序将在列表框控件中搜索刚刚键入到文本框
控件中的项目。如果该项目未被找到，则程序将把该项目添加到列表框控件中。
相反，如果该项目已经在列表框中存在了，则将显示出一个信息框以通知项目已
经存在。
c 动态改变屏幕设置
----------------------------------------------------------------------
----------
我们经常看到许多 Win95 的应用程序（尤其是游戏）在运行它的时候改变屏
幕的设置，运行完后恢复，在 VB 中，我们可以用以下方法实现：
定义
Private Declare Function lstrcpy _
Lib "kernel32" Alias "lstrcpyA" _
(lpString1 As Any, lpString2 As Any) _
As Long
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function _
ChangeDisplaySettings Lib _
"User32" Alias "ChangeDisplaySettingsA" (_
ByVal lpDevMode As Long, _
ByVal dwflags As Long) As Long
函数
Public Function SetDisplayMode(Width As _
Integer,Height As Integer, Color As _
Integer) As Long
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Dim NewDevMode As DEVMODE
Dim pDevmode As Long
With NewDevMode
.dmSize = 122
If Color = -1 Then
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
Else
.dmFields = DM_PELSWIDTH Or _
DM_PELSHEIGHT Or DM_BITSPERPEL
End If
.dmPelsWidth = Width
.dmPelsHeight = Height
If Color <> -1 Then
.dmBitsPerPel = Color
End If
End With
pDevmode = lstrcpy(NewDevMode, NewDevMode)
SetDisplayMode = ChangeDisplaySettings(pDevmode, 0)
End Function
例子调用：改变为 640x480x24位：
i = SetDisplayMode(640, 480, 24)
如果成功返回 0 。
=============================================
VB问答
问题部分：
回答部分：
=============================================
其 它
====================================================================
欢迎订阅VB免费邮件:
订阅地址 http://server.com/WebApps/mail-list-subscribe.cgi?id=16852
====================================================================
如果您觉得这个邮件列表好的话，请告诉您的朋友。
====================================================================
欢迎投稿 [email protected]
====================================================================
网易上的主页地址：http://www4.netease.com/~aaaaaaaaa
本网站主页镜像地址：goodvbhome.yeah.net
广东视灵通：http://personal.gz168.gnet.gd.cn/vbok/
====================================================================
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.103.46.6]
|
|