Untitled Document

File Name | File Describe | Browse
◆ 01.txt | 《 VB6.0中通过MSChart控件调用数据库 》 | browse
◆ 02.txt | 《 用VB6实现动态增减控件 》 | browse
◆ 03.txt | ActiveX控件的创建 | browse
◆ 04.txt | ADO控件和DATA控件的冲突（不能共存）的解决方法 | browse
◆ 05.txt | Combo的自动查询技术 | browse
◆ 06.txt | DirectX7.0使用心得（1） | browse
◆ 07.txt | DirectX7.0使用心得（2） | browse
◆ 08.txt | DirectX7.0使用心得（3） | browse
◆ 09.txt | FSO对象模型在VB中的应用 | browse
◆ 10.txt | MsComm 控件的文字传输范例 | browse
◆ 11.txt | Office或IE4风格的ToolBar | browse
◆ 12.txt | Regsvr32.exe注册控件的具体用法 | browse
◆ 13.txt | TextBox的自动调节 | browse
◆ 14.txt | TextBox实现打印机效果 | browse
◆ 15.txt | TreeView的基本操作 | browse
◆ 16.txt | VB5中DBGRID控件在VB6中使用 | browse
◆ 17.txt | VB6.0动态加载ActiveX控件漫谈 | browse
◆ 18.txt | VB与MS-Draw开发通用作图软件 | browse
◆ 19.txt | VB中APP对象及其应用 | browse
◆ 20.txt | VB中list控件的功能扩充 | browse
◆ 21.txt | VB中防止将重复项目添加到列表框控件中 | browse
◆ 22.txt | VB中用Multimedia MCI控件开发多媒体应用 | browse
◆ 23.txt | Win Api在VB中的妙用 | browse
◆ 24.txt | WINDOWS SCRIPT HOST对象在VB中的使用 | browse
◆ 25.txt | 安装向导生成程序组并建立多个程序项 | browse
◆ 26.txt | 保存复选框选项 | browse
◆ 27.txt | 不用OCX来创建自己的控件（一） | browse
◆ 28.txt | 成组更新控件属性 | browse
◆ 29.txt | 创建数据驱动窗体 | browse
◆ 30.txt | 得到鼠标位置 | browse
◆ 31.txt | 调整 Combo 下拉部分的宽度 | browse
◆ 32.txt | 动态加入控件到VB控件数组中 | browse
◆ 33.txt | 对ListView中的列排序 | browse
◆ 34.txt | 放一个Combo到Toolbar中 | browse
◆ 35.txt | 改变 ListIndex而不发生 Click 事件 | browse
◆ 36.txt | 改变 TreeView 的背景 | browse
◆ 37.txt | 改进ＶＢ的驱动器列表框 | browse
◆ 38.txt | 给TreeView控件添加弹式菜单 | browse
◆ 39.txt | 功能强大的增强列表框 ――VB6控件LISTVIEW使用指南 | browse
◆ 40.txt | 计算从开机到现在用了多少秒 | browse
◆ 41.txt | 将立体的ListView标题栏转换成平面式的标题栏 | browse
◆ 42.txt | 禁用窗体上所有控件 | browse
◆ 43.txt | 拷贝或移动列表框或组合框中的内容 | browse
◆ 44.txt | 利用VB5开发ActiveX控件 | browse
◆ 45.txt | 利用VB三维面板控件设计流动条 | browse
◆ 46.txt | 浅谈用VB6.0编写BO程序 | browse
◆ 47.txt | 巧用Visual Basic的TIMER控件 | browse
◆ 48.txt | 取得控件绝对Top值 | browse
◆ 49.txt | 如 何 解 决VB 中 的Grid 控 件 的 打 印 问 题 | browse
◆ 50.txt | 如果自定义 MsgBox 的按钮标题等 | browse
◆ 51.txt | 如何创建数据绑定控件 | browse
◆ 52.txt | 如何检查您的电脑是否打开 ActiveDesktop？ | browse
◆ 53.txt | 如何解决VB中的Grid控件的打印问题 | browse
◆ 54.txt | 如何强制文件对话框再次读取正确的磁盘 | browse
◆ 55.txt | 如何取得RichTextBox控件中光标所在行的值？ | browse
◆ 56.txt | 如何让用户自行输入方程式，并计算其结果？ | browse
◆ 57.txt | 如何设定 MsgBox 在若干时间之后若无回应則自动关闭？ | browse
◆ 58.txt | 如何使用VB控件Commom Dialog | browse
◆ 59.txt | 如何用VB6写COM组件（二） | browse
◆ 60.txt | 如何用VB6写COM组件（一） | browse
◆ 61.txt | 如何在VB中使用Delphi的控件 | browse
◆ 62.txt | 如何在运行时动态增加控件 | browse
◆ 63.txt | 显示和隐藏鼠标 | browse
◆ 64.txt | 隐藏文本框控件的环境菜单 | browse
◆ 65.txt | 用ActiveX Control Pad | browse
◆ 66.txt | 用API函数改进ListView 控件的显示效果 | browse
◆ 67.txt | 用VB6.0中文版进行DHTML程序开发 | browse
◆ 68.txt | 用VB编写标准CGI程序 | browse
◆ 69.txt | 用VB编写留言板 | browse
◆ 70.txt | 用VB播放FLASH动画 | browse
◆ 71.txt | 用VB开发进程管理软件 | browse
◆ 72.txt | 用VB设计聚焦框程序 | browse
◆ 73.txt | 用WinSock设计Chat程序 | browse
◆ 74.txt | 用两分法搜索列表框或组合框中的数据 | browse
◆ 75.txt | 运用MSChart，生成统计图形 | browse
◆ 76.txt | 在vb的文本框等等控件的系统右键菜单里追加自己定义的菜单。 | browse
◆ 77.txt | 在VB中用定时控件实现长定时操作 | browse
◆ 78.txt | 在Visual Basic中，在GotFocus事件中快速选定文本 | browse
◆ 79.txt | 在程序中注册和注销 OCX 控件 | browse
◆ 80.txt | 在文本框中快速增加一串字符 | browse
◆ 81.txt | 在文本框中实现由加减号输入数据 | browse
◆ 82.txt | 在运行时维护DBGRID的栏位宽度 | browse
◆ 83.txt | 怎样使用VB开发基于Sybase的软件 | browse
◆ 84.txt | 怎样在运行时动态生成多个相同的控件 | browse
◆ 85.txt | 直接编辑VB中网格控制项的两种方法 | browse
◆ 86.txt | 自制IE风格按纽控件 | browse
◆ 87.txt | 自制控件方面的有关知识 | browse


《 VB6.0中通过MSChart控件调用数据库 》

    VB6.0中的MSChart控件是一个功能强大的高级图表工具，拥有丰富的图表绘制功能，可显示二维和三维的棒图、区域图、线形图、饼图等多种常用图表。近日我为了在双击图表的某个区域时将与该区域相对应的数据库的内容在DataGrid控件上显示出来，遇到了许多困难，最后用一个自定义的变量SelectSeries解决了问题，具体方法如下：
    设数据库名称为“学生信息”，有一Access表“学生成绩”，其内容为一个班学生的考试成绩，包括学号、姓名、成绩3个字段，成绩字段格式是字符型，值为“优”、“良”、“中”、“差”中的一个。
    窗体Form1包括一个MSChart控件McScore，类型为二维饼图，用于显示每种成绩的学生数；一个ADO控件AdScore用于连接数据库；一个DataGrid控件DgScore用于以表格形式显示数据库内容。
    工作过程为：双击饼图的某个区域，则DgScore显示相应成绩的学生名单。
    代码如下：
    Option Explicit
    Dim SelectedSeries as Integer ′自定义变量
    Dim Rs() as String ′提取记录集用的字符串数组
    Private Sub Form_Load()
    ′设定DataGrid控件的数据源
    DgScore.DataSource=″AdScore″
    ′设定ADO控件的连接字串和初始的记录源，即显示内容
    AdScore.ConnectString=″Provider=Microsoft.OLEDB.3.51;Persist_Security Info=False;Data Source=学生信息″
    AdScore.RecordSource=″selet ＊ from学生成绩order by成绩″
    AdScore.Refresh
    ′预设好提取记录用的SQL语句
    Rs(1)=″select＊ from学生成绩where成绩=″＋Chr(34)＋″优″＋_Chr(34)＋″order by成绩″
Rs(2)=″select ＊from学生成绩where成绩=″＋Chr(34)＋″良″＋_Chr(34)＋″order by成绩″
Rs(3)=″select ＊ from学生成绩where成绩=″＋Chr(34)＋″中″＋_Chr(34)＋″order by成绩″
Rs(4)=″select ＊ from学生成绩where成绩=″＋Chr(34)＋″差″_Chr(34)＋″order by成绩″
End Sub
    Private Sub McScore_SeriesSelected(Series as Integer,MouseFlags as _Integer,Cancel as Integer)
SelectedSeries=Series
    End Sub
    Private Sub McScore_PointSelected(Series as Integer,DataPoint as_Integer,MouseFlags as
Integer,Cancel as Integer)
    SelectedSeries=Series
    End Sub
    Private Sub McScore_Db1Click()
    ′改变ADO控件的记录源并刷新
    Adoc1.RecordSource=Rs(SeletedSeries)
    Adoc1.Refresh
    End Sub
  (湖南　高文杰)


《 用VB6实现动态增减控件 》

用过Internet Explorer收藏夹的朋友都知道，利用鼠标单击时收藏夹会出现，再次单击则收藏夹消失。从编程角度讲，这是个在程序运行阶段动态增减控件的问题。以前，这仅仅是C＋＋之类编程语言的专利。如今，微软在Visual Basic6.0中也新增了这个功能，下面就此举例进行介绍:
    1.新建一个工程，窗体Form1为缺省窗体，Form1的属性项Caption=″动态增减控件的例子″。
    2.加入两个命令按钮（CommandButton）,其中：
    Command1的属性项Caption=″增加控件″;
    Command2的属性项Caption=″删除控件″。
    3.加入如下代码，运行该工程，单击″增加控件″则出现新增按钮。若单击″新增按钮″时会出现对话框，表明你触发的是动态增加控件的单击事件。
    Option Explicit
    ′通过使用 WithEvents 关键字声明一个对象变量为新的命令按钮
    Private WithEvents NewButton As CommandButton
    ′增加控件
    Private Sub Command1_Click()
    If NewButton Is Nothing Then
    ′增加新的按钮cmdNew
    Set NewButton =Controls.Add(″VB.CommandButton″, ″cmdNew″, Me)
    ′确定新增按钮cmdNew的位置
    NewButton.Move Command1.Left ＋ Command1.Width ＋ 240, Command1.Top
    NewButton.Caption = ″新增的按钮″
    NewButton.Visible = True
    End If
    End Sub
    ′删除控件(注：只能删除动态增加的控件)
    Private Sub Command2_Click()
    If NewButton Is Nothing Then
    Else
    Controls.Remove NewButton
    Set NewButton = Nothing
    End If
    End Sub
    ′新增控件的单击事件
    Private Sub NewButton_Click()
    MsgBox ″您选中的是动态增加的按钮！″
    End Sub
    注意：如果你希望添加一个用户控件或任何 ActiveX 控件到您的窗体，必须把这个控件添加到“工具箱”，或者把控件的 License 关键字添加到 Licenses 集合中。而且，你不能选定“工程属性”对话框的“生成” 选项卡上的“删除有关未使用的 ActiveX 控件”选项，否则controls.Add 方法将失败，因为必需的信息已经被丢失。
（广西　周涛）


ActiveX控件的创建
作者：顾岱鸿
1）概述

    ActiveX是一个Microsoft的术语，它指的是一组包括控件，DLL和ActiveX文档的组件，它通常是以动态链接库的形式存在,因此必须在一个叫容器的独立执行软件中运行。这样的容器包括Authorware、Delphi，Visual Basic，Visual C＋＋，Internet Explorer和Access等等。

    ActiveX控件数据输入和函数功能执行都必须通过容器，因此ActiveX控件和容器都必须支持一些特定的接口协议。根据Microsoft 相应的规格标准，ActiveX控件应具备如下的性能机制。

属性和方法：ActiveX控件必须提供属性的名称、方法的名称及参数,通过这项机制容器可以存取和改变ActiveX控件的属性参数。

事件：ActiveX控件由这项机制通知容器在ActiveX控件中发生的事件，比如属性参数的改变，用户按下鼠标左键等。

存储：容器由这项机制通知ActiveX控件存储和提取有关信息数据等。

    ActiveX控件只要在Windows的Registry数据库中注册后，就可以像其他Windows应用程序一样发挥各自的功能。

    ActiveX控件是一个模块化的灵活对象,如果某个应用程序或网页需要增加一项特殊的功能，无须重写整个程序，只要灵活地插入一个具有此项功能的ActiveX控件即可实现。ActiveX的优势还在于它的动态可交互性，用户可以动态地在使用过程中，通过改变它的属性和参数，在应用程序中实现自己的特殊要求。

    也许有的读者会问：目前在市面上可以找到各种各样现成的ActiveX控件，还有没有必要自己创建ActiveX控件呢？关于这个问题很容易解释，现有的控件种类是很多，功能也比较齐全，问题是有许多时候会遇到这种情况：使用现成的控件虽能完成任务，但自己需要的一些特性（属性、事件或方法）该控件却没有提供，还需要自己手工写代码来实现，而这些特
性偏偏在自己的应用系统中又经常会用到，为了避免大量的重复劳动，一劳永逸的办法就是在创建自己的ActiveX控件。

    目前可以使用Visual Basic或其它开发工具创建 ActiveX控件。无论按照哪种标准，Visual Basic都是计算机历史上最为成功的（同时也是最流行的）编程语言，其中最令人兴奋的特性就是可以创建用户自己的控件并可以像其他控件一样应用于支持 ActiveX控件技术的应用程序中。下面通过一个具体实例来阐述如何在Visual Basic 6.0（中文企业版）下进行
ActiveX控件创建。

  2）创建ActiveX控件的步骤

    使用Visual Basic编程语言编写过应用程序的用户，一定非常熟悉诸如TextBox、Label和Data等控件。要利用这些控件，可以将它们绘制在窗体中，通过属性，方法和事件控制它们的行为。当用户创建自己的ActiveX控件时，除了确定属性、方法和事件以外，用户是在创建一个相似的对象。当创建了自己的ActiveX控件以后，就可以在其他Visual Basic 工程中使
用它，就像使用TextBox控件一样。可以在能使用ActiveX控件的任何应用程序或开发工具（包括其他Visual Basic工程、Authorware或者Microsoft Internet Explorer）中使用自己的控件。

    在Visual Basic中创建一个ActiveX控件不同于创建一个Standard EXE
应用程序。因此当创建一个新控件时，一般应遵循的步骤是：

（1）确定控件将要提供的功能。因为ActiveX控件类似于一个独立的对象，所以需要明确这个对象的目的，希望它在屏幕上有什么样的外观？使用此控件时，需要什么属性、方法以及事件用于应用程序中？
（2）设计控件的外观。
（3）设计控件的接口，即属性、事件和方法。
（4）创建由控件工程和测试工程组成的工程组。
（5）通过把控件和或代码添加到 UserControl 对象中来实现控件的外观。
（6）实现控件的接口和功能。
（7）编译控件部件（.ocx 文件）。

下面按照上述步骤建立一个可直接显示数据库内容的DataListView控件。

3）具体实现方法

（1）确定DataListView控件的功能

    标准的ListView控件在显示数据库记录时还存在一些不足，如必须编写大量的代码等，DataListView通过在ListView的基础上添加部分功能而弥补了ListView的不足，因此它除了本身固有的属性、方法和事件外，添加了如下成员：

◆ DataServerName属性 -- 确定所操作的数据库服务器。
◆ DataBaseName属性 -- 确定所操作的数据库。
◆ AdministratorName属性 -- 确定操作数据库的管理员名称。
◆ PasswordName属性 -- 确定操作数据库的管理员口令。
◆ ShowDataBase方法 -- 显示Select命令所执行的数据库操作结果。
◆ErrorDataBase事件 -- 当遇到错误的数据库操作时引发该事件。

（2）设计控件的外观

    DataListView由于仅包含一个ListView控件，所以其外观没有太多需要考虑的问题。如果要创建的控件是多个控件构成，或新控件不包括任何现存控件即完全从头开始创建一个全新的控件的话，则外观问题是一个很重要的问题。

（3）设计控件的接口，即属性、事件和方法

    对ListView控件所作的改进是为了让ListView控件支持数据库的内容显示,以便在所有能支持ActiveX控件的应用程序中使用。通过添加用户自己的属性DataServername、DataBaseName、AdministratorName、PasseordName和方法ShowDataBase等可以实现这项功能。DataListView的其他属性、事件和方法都和标准ListView一样。

（4）创建由控件工程和测试工程组成的工程组

◆启动一个新的ActiveX控件工程。
◆按下CTRL+T 组合键或者选择【工程】|【部件】菜单选项，显示【部件】对话框，在【控件】选择框中选择Microsoft Windows Common Controls 6.0。
◆ 选择【工程】|【引用】菜单选项，显示【引用】对话框，在【可用的引用】选择框中选择Microsoft ActiveX Data Objects 2.0 Library。
◆在UserControl窗口中添加一ListView控件，ListView控件的左上角位置为0，0。
◆设置ActiveX工程和UserControl控件属性值，如下表所示。

    条目　　　　　　　　　　　　　设置
  工程类型　　　　　　　　　　　ActiveX控件
  工程名称　　　　　　　　　　　DataLV
  工程描述　　　　　　　　　　　通过ADO，使得ListView控件能够直
                                接操作数据库
  UserControl 的Name属性　　　　DataListView
  UserControl 的Public属性　　　True

◆保存这个工程。
◆选择【文件】|【添加工程】菜单选项。然后添加一个标准EXE工程。建　　立该工程的目的是为了在创建ActiveX控件时不断地进行测试。

    此时已建立了一个由控件工程和测试工程组成的工程组，下面就可以正式开始创建DataListView控件。

（5）实现控件的外观

    确定控件外观的方式取决于当前控件的创建模型。如果要创建一个用户绘制控件，那么必须自己在UserControl_Paint 事件过程编写代码来完成所有的绘制工作，同时还需要确定何时绘制控件，以便在需要的时候调用UserControl的Refresh方法来产生Paint 事件。如果是改进一个现有控件，那么只需正确地将组成控件放置在UserControl上即可。

    由于DataListView控件仅包含ListView一个组成控件，那么只需简单地在UserControl1上绘出一个标准ListView控件，控件名为缺省的ListView1，即可完成外观绘制工作。

    为了在使用控件时，使ListView控件和自己绘制的空间相匹配，必须建立UserControl的Resize事件过程。Resize事件过程的代码如下：

Private Sub UserControl_Resize()
    ListView1.Left = 0
    ListView1.Top = 0
    ListView1.Width = UserControl.Width
    ListView1.Height = UserControl.Height
End Sub

    仅四行代码的Resize事件过程是简单控件的用户界面的所有必须的代码，其目的是使ListView控件和UserControl对象有相同的尺寸。

（6）实现控件的接口和功能

    这是整个创建过程中最核心、最重要也是最复杂的步骤。对于创建控件的每一属性、事件和方法均需逐一实现。

◆创建DataServerName属性

    要创建DataServerName属性值，首先需要添加一个在内部存贮属性值的局部变量。要做到这一点，在UserControl对象的Genaral Declarations通用声明语句中创建此变量。如下所示：

Dim m_DataServerName As String

    接着需要创建称为DataServerName的新属性，可以通过手工输入Get和Let过程，或者选择【工具】|【添加过程】|【类型】创建这个新属性。DataServerName属性的代码相当容易理解。当置DataServerName属性的值时，Property Get过程仅将局部变量的存贮内容取出来。当设置DataServerName属性值时，Property Let过程将为局部变量赋予一个有效值。以下是两个Property过程的代码：

Public Property Get DataServername() As String
    DataServername = m_DataServerName
End Property

Public Property Let DataServername(ByVal New_DataServerName As　String)
    m_DataServerName = New_DataServerName
    PropertyChanged "DataServerName"
End Property

    需要注意的是在Property Let过程中，有一个PropertyChanged方法，它的功能是通知容器（可以理解为存放所有属性的单元）属性值已变更，需产生一个WriteProperties 事件，来保存新属性值。事实上不仅在Property Let过程需要调用PropertyChanged方法，在UserControl的代码模块中无论何时改变了ActiveX控件的某个属性值，均需调用该过程,以保存属性的变化。

    注意Property DataServerName方法的用法，此方法与ReadProperties
和WriteProperties事件在一起使用。

    此时需要使用用户控件的InitProperties事件指定此属性的初始值：

Private Sub UserControl_InitProperties()
    m_DataServerName = m_def_DataServerName
End Sub

    即使用户没有设置初始值，这些代码也会确保设置了一个初始值。

    至于DataBaseName、AdministratorName、PasseordName 属性的创建过程跟DataServername属性的创建过程完全一样，这里就不再重复叙述。

◆使用PropertyBag对象

    用户还需要为WriteProperties和ReadProperties事件创建代码,从而保护DataServername、DataBaseName、AdministratorName、PasseordName属性在设计阶段的属性值。这两个事件都使用PropertyBag 对象保存和检索DataServername、DataBaseName、AdministratorName、PasseordName属性的值。PropertyBag对象能够保持DataServername、DataBaseName、
AdministratorName、PasseordName的设计值。具体实现代码如下：

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_DataServerName = PropBag.ReadProperty("DataServerName",
                       m_def_DataServerName)
    m_DataBaseName = PropBag.ReadProperty("DataBaseName",
                       m_def_DataBaseName)
    m_AdministratorName = PropBag.ReadProperty("AdministratorName", m_def_AdministratorName)
    m_PasswordName = PropBag.ReadProperty("PasswordName",
                       m_def_PasswordName)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("DataServerName", m_DataServerName,
                        m_def_DataServerName)
    Call PropBag.WriteProperty("DataBaseName", m_DataBaseName,
                        m_def_DataBaseName)
    Call PropBag.WriteProperty("AdministratorName",
                   m_AdministratorName, m_def_AdministratorName)
    Call PropBag.WriteProperty("PasswordName", m_PasswordName,
                   m_def_PasswordName)
End Sub

    由于这两个过程是针对"容器"对象的，因此所有属性值的保存和读取都通过这两个过程来实现，而不是每个属性都需要单独的两个过程。其中，PropertyBag就是"容器对象"的名称。

    WriteProperty方法有三个参数：第一个字符串标识需要保存的属性，第二个参数是需要保存的值，最后的参数是属性的缺省值。

    ReadProperty 方法需要两个参数：一个字符串用来保存属性的名称，另一个为缺省值。

    在窗体上绘制ActiveX控件的那一刻，就会开始执行ActiveX控件的代码。在控件设计过程中，将DataServername、DataBaseName、AdministratorName、PasseordName属性的默认值设置为：

Const m_def_DataServerName = "lyc"
Const m_def_DataBaseName = "pubs"
Const m_def_AdministratorName = "sa"
Const m_def_PasswordName = ""

    当然，也可以在程序运行时多次修改它。控件的正常行为是当程序终止时恢复其默认值，这样增加了保持属性的两种独立状态的要求。

    简言之，如果在设计阶段改变了一个属性值，那么控件必须得到这个新值，而不是使用默认值。相反，如果在程序运行时改变属性值，那么当返回设计状态时，控件必须检索此属性值。

    PropertyBag对象允许ActiveX控件存贮有关它自己的属性值，使它能执行这个动作。PropertyChanged 方法会通知用户已经改变了一个属性。通过了解程序的状态以及是否调用了PropertyChanged方法，VB 就可以激发WriteProperties和ReadProperties事件。

◆为ShowDataBase方法编写代码

  ShowDataBase方法实现在ListView控件中显示Select命令所执行的数据库操作结果。在其具体实现过程中采用了 ADO（ActiveX Data Objects）的数据存取方法。ADO的主要特点是使用更加容易，访问速度更快,而对磁盘和存储容量的要求更小,ADO支持建立各种客户/服务器模式与基于Web的应用程序，具有远程数据服务RDS（Remote Data Service）的特性，通过RDS能够在一次往返中将服务器端的数据传送到客户端的应用程序或Web页面中，并在客户端对数据进行处理后，立即更新服务器端的数据。采用ADO所基于的OLE DB技术，可以对电子邮件、文本文件、数据表格等各类数据通过统一的接口API接口进行存取，是远程数据存取的一个主要发展方向。ShowDataBase方法具有一个字符串参数，但无任何返回值，具体代码如下所示：
Public Sub showdatabase(ssql As String)
Dim AdoDatabase As New ADODB.Connection
Dim AdoTable As New ADODB.Recordset
Dim scnn As String
Dim response As String
Dim I As Integer
On Error GoTo errorhandle
scnn = "Provider=SQLOLEDB;Data Source="
& Trim(m_DataServerName) & ";
Initial Catalog=" & Trim(m_DataBaseName) & ";
User Id=" & Trim(m_AdministratorName) & ";
Password=" & Trim(m_PasswordName) & ";"
AdoDatabase.Open scnn
AdoTable.CursorType = adOpenKeyset
AdoTable.LockType = adLockOptimistic
AdoTable.CursorLocation = adUseClient
AdoTable.Open ssql, AdoDatabase, , , adCmdText
If AdoTable.BOF And AdoTable.EOF Then
response = MsgBox("没有符合条件的记录！！",
vbOKOnly + vbInformation, "数据库控件")
AdoTable.Close
Set Adotable=Nothing
AdoDatabase.Close
Set AdoDataBase=Nothing
Exit Sub
End If
ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear
Dim clmX As ColumnHeader
For I = 0 To AdoTable.Fields.Count - 1
Set clmX = ListView1.ColumnHeaders.Add()
With clmX
.Text = AdoTable.Fields(I).Name
End With
Next
Dim itmX As ListItem
AdoTable.MoveFirst
Do While Not AdoTable.EOF
Set itmX = ListView1.ListItems.Add()
With itmX
If IsNull(AdoTable.Fields(0).Value) Then
.Text = "NULL"
Else
.Text = AdoTable.Fields(0).Value
End If
End With
For I = 1 To AdoTable.Fields.Count - 1
If IsNull(AdoTable.Fields(I).Value) Then
itmX.SubItems(I) = "NULL"
Else
itmX.SubItems(I)
= AdoTable.Fields(I).Value
End If
Next
AdoTable.MoveNext
Loop
ListView1.View = lvwReport
AdoTable.Close
Set Adotable=Nothing
AdoDatabase.Close
Set AdoDataBase=Nothing
Exit Sub
errorhandle:
RaiseEvent Errordatabase
End Sub

当对数据库的操作发生错误后，除了不能正常显示以外，还应通知宿主程序用户。可以通过创建一个叫做Errordatabase的事件实现上述功能。要创建这个事件，把下述代码添加到UserControl对象的GeneralDeclarations段中。

Public Event Errordatabase()

    此事件的工作像其他控件的事件一样。使用控件的用户可以将代码放到这个事件中，用户要做的唯一的事情就是用RaiseEvent方法激发此事件。

（7）编译控件部件（.ocx 文件）。

    现在已经完成了DataListView控件的创建工作，为了在DataLV工程外也可以使用该控件，只需将DataLV工程编译.ocx控件部件即可。

    在【工程组】窗口单击【DataLV】以选择该工程，在【文件】菜单上单击【生成DataLV.ocx】，在【生成工程】对话框中选择控件存放的目录后， 单击【确定】即可创建.ocx 文件。

    一旦生成了.ocx文件的控件，就可以象使用其它控件一样来随心所欲地使用它了。

  4）结束语

    ActiveX技术可以灵活、高效的实现可交互、重入、重用、完全分布式、与语言无关的各种应用。随着ActiveX技术的发展，ActiveX控件在应用程序中的作用将会显得越来越重要，那么创建一个功能完善、具有自己特色的ActiveX控件就非常具有现实意义。只要掌握了创建ActiveX控件的基本方法，就不难创建自定制的可在各种应用领域使用的ActiveX控件。

    但是，ActiveX技术也有一些明显缺点，ActiveX技术依赖于Windows平台，对广泛应用的UNIX平台目前仍不兼容，另外 ActiveX在许多方面的性能还较弱，ActiveX技术仍需要不断完善和发展。


ADO控件和DATA控件的冲突（不能共存）的解决方法

你知道ADO控件和DATA控件有冲突吗？试一试下面的例子：
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase("d:\stock\yline.mdb")
Set rs = db.OpenRecordset("select count(*) as totalcount from yline where 条件") ***
MsgBox (rs(0))
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

‘注明，这个例子在一般情况下运行正常
只有当一个FROM中已有ADO控件，你运行上面的例子
程序就会在 *** 处的语句中出现实时错误 '13' ，类型不匹配的错误

这就是ADO控件和DATA控件的冲突，如果你想共存的话，下面的对你就有用了。

1.如果你是新建一个程序
当你新建一个程序时，在FROM中要先添加DATA控件，再添加ADO控件，OK一切正常
2.如果你已有一个程序，还想添加一个FROM（其中包括DATA控件）
解决方法是：1.新建FORM，建一个DATA控件，输入你要输入的代码，保存文件
2.添加文件，把你原来的工程文件添加进来
3.改变工程属性，把启动对象设置为你原来的工程

注意事项：ADO控件在DATA控件前面加入=“错误”
ADO控件在DATA控件后面加入=“正确”


Combo的自动查询技术
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
As Long
Public Const CB_FINDSTRING = &H14C
Private Sub Combo1_Change()
Dim iStart As Integer
Dim sString As String
Static iLeftOff As Integer
iStart = 1
iStart = Combo1.SelStart
If iLeftOff <> 0 Then
Combo1.SelStart = iLeftOff
iStart = iLeftOff
End If
sString = CStr(Left(Combo1.Text, iStart))
Combo1.ListIndex = SendMessage(Combo1.hwnd,B_FINDSTRING, -1, ByVal CStr(
Left( ombo1.Text, iStart)))

If Combo1.ListIndex = -1 Then
iLeftOff = Len(sString)
combo1.Text = sString
End If
Combo1.SelStart = iStart
iLeftOff = 0
End Sub
静态变量 iLeftOff 指定了字符长度。


DirectX7.0使用心得（1）
DirectX 7.0终於支援VB了，让我们这些VB的爱好者也能享受到DirectX带来的便利，现在我在这里提出使用DirectDraw的心得。使用DirectDraw时可以不用安装DirectX7.0的SDK，只要确定有装DirectX7.0就可以了。

现在我们实际来使用DirectDraw：
在“工程(Project)”里点选“设定引用项目”，来引用DirectX物件。
接著将“DirectX 7 for Visual Basic Type Library”的那一行打勾，就可以开始使用DirectX了。

我们首先得建立DirectDraw物件，先宣告一个Direct物件和一个DirectDraw物件：
Dim objDX As New DirectX7
Dim objDD As DirectDraw7

接下来是使用DirectDrawCreate函式来建立DirectDraw物件：
Set objDD = objDX.DirectDrawCreate("")

然后必须设定是视窗模式还是全屏幕模式：
Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
第一个参数是设定DirectDraw的视窗是那一个，填入视窗的Handle代码而后面的参数是设定具备的能力，可以不止一个，使用Or组合起来。
DDSCL_FULLSCREEN 使用全屏幕(必须和DDSCL_EXCLUSIVE一起用)
DDSCL_ALLOWMODEX 使用Modex模式
DDSCL_EXCLUSIVE 使用独占模式
DDSCL_NORMAL 使用Windows的程式视窗
DDSCL_NOWINDOWCHANGES 禁止改变视窗大小

今天就先讲到这边，Direct实在很麻烦，一次不要太多比较好，下次就从建立Surface开始。


DirectX7.0使用心得（2）
设定完视窗模式或全屏幕模式后，如果你是设定成全屏幕模式的话(也就是独占模式)，接著就必须设定显示模式。
objDD.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
参数中的640,480指的是640x480的模式，而16指的是16万色，如果是8的话则是256色，想改变显示模式的话只要改变这三个变数就可以了，一般常用的模式有：
320x200 16万
320x240 256
640x480 256
640x480 16万

Surface简介：
Surface就是DirectDraw用的显示记忆体，图像就是要画在Surface上面，一般来说有分成几种类型。
primary surface 屏幕上可以看到的显示记忆体，图像画在上面就能显示在屏幕上。
backbuffer surface 这是一个能跟primary surface作快速切换的Surface。
offscreen surface 这是一个屏幕上看不见的Surface，可以用来存放图像。

我们现在就先来介绍建立primary surface的方法，首先得宣告一个Surface物件和一个DDSURFACEDESC结构。
Dim objDDPrimSurf As DirectDrawSurface7
Dim ddsd1 As DDSURFACEDESC2

'DDSURFACEDESC主要是记录一个Surface的结构，像是Surface的高度、宽度之类的，建立一个primary surface通常只要填入ddsCaps就可以了。
ddsd1.lFlags = DDSD_CAPS '设定DDSURFACEDESC结构中的ddsCaps有效。
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE '设定要建立的是primary suface。
Set objDDPrimSurf = objDD.CreateSurface(ddsd1) '呼叫CreateSurface后即建立完成。

'offscreen surface的建立法则是要设定DDSURFACEDESC结构中的ddsCaps、dwHeight、dwWidth。
Dim objDDOffSurf As DirectDrawSurface7
Dim ddsd1 As DDSURFACEDESC2

ddsd1.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
'设定ddsCaps、lHeight、lWidth有效
ddsd1.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN '设定要建立offscreen surface
ddsd1.lWidth = 640 '设定Surface的宽度
ddsd1.lHeight = 480 '设定Surface的长度
Set objDDOffSurf = objDD.CreateSurfaceFromFile("img1.bmp", ddsd1)
'offscreen surface建立完成并把img.bmp图档读取到offscreen surface里面。

一般来说不会直接在primary surface上直接画图，我通常都是先在backbuffer surface上画，再利用切换的功能将Primary surface和backbuffer surface交换，所以在这里介绍backbuffer surface的建立方法，由於要跟primary surface一起建立，所以Primary surface的建立方法也就有点不同。
Dim objDDPrimSurf As DirectDrawSurface7
Dim objDDBackSurf As DirectDrawSurface7
Dim ddsd1 As DDSURFACEDESC2

ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
'设定ddsCaps和lBackBufferCount有效
ddsd1.lBackBufferCount = 1 '设定Backbuffer surface的数量
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
'设定要建立一个由primary surface和backbuffer surface 所构成的Surface
Set objDDPrimSurf = objDD.CreateSurface(ddsd1) 'primary surface建立完成

Dim caps As DDSCAPS2 宣告一个DDSCAPS结构
caps.lCaps = DDSCAPS_BACKBUFFER 设定要建立backbuffer surface
Set objDDBackSurf = objDDPrimSurf.GetAttachedSurface(caps) backbuffer suface 建立完成

Surface的部分讲完了，下一篇要说的是如何使用Blt和BltFast来作Surface间的图形的复制和搬移，就可以开始在Surface上画画罗。


DirectX7.0使用心得（3）
上一次我们一共建立了三个Surface，分别是objDDPrimSurf(Primary surface)、objDDBackSurf(BackBuffer surface)、objDDOffSurf(Offscreen surface)。
现在我打算把objDDOffSurf拿来存放图片，再用BltFast()把图片给复制到objDDBackSurf上，然后用objDDPrimSurf的Flip来跟objDDBackSurf作交换的动作，因为objDDPrimSurf代表的就是显示记忆体，所以交换后图片就显示在屏幕上啦！

现在我先介绍BltFast()的用法：
BltFast(dx As Long,dy As Long,dds As DirectDrawSurface7,srcRect As RECT,trans As CONST_DDBLTFASTFLAGS) As Long

dx、dy
图形复制到目标Surface上的位置(座标)
dds
图片来源的Surface
srcRect
复制图形的范围
trans
复制图片的方式
DDBLTFAST_DESTCOLORKEY '使用目标Surface上的透明色
DDBLTFAST_NOCOLORKEY '直接复制图形
DDBLTFAST_SRCCOLORKEY '使用来源Surface上的透明色
DDBLTFAST_WAIT '若暂时无法执行的话就等到可以执行时

例：想把objDDOffSurf上640x480的图形复制到objDDBackSurf
Dim r1 As RECT

r1.left=0
r1.top=0
r1.right=640
r1.bottom=480

objDDBackSurf 0, 0, objDDOffSurf, r1, DDBLTFAST_WAIT

这样就把图形给复制到了objDDBackSurf上了，不过这样也只是在objDDBackSurf上而已，并不是在屏幕上，所以必须跟objDDPrimSurf作Flip才行，怎堋作呢？只要执行下面这一行就可以了：

objDDPrim.Flip Nothing, DDFLIP_WAIT


FSO对象模型在VB中的应用
从 Visual Basic 的第一版至今，VB中有关文件的处理都是通过使用 Open 、Write以及其它一些相关的语句和函数来实现的。随着软件技术的不断发展，加上面向对象编程概念的日臻成熟，这些文件操作语句已经不能适应软件不断增加的复杂程度的需要了。因此，从VB6.0开始，微软提出了一个全新的文件系统对象FSO。
一、简介
文件系统对象FSO的英文全称是File System Object ，这种对象模型提出了有别于传统的文件操作语句处理文件和文件夹的方法。通过采用object.method这种在面向对象编程中广泛使用的语法，将一系列操作文件和文件夹的动作通过调用对象本身的属性直接实现。
FSO 对象模型不仅可以象使用传统文件操作语句那样实现文件的创建、改变、移动和删除，而且可以检测是否存在指定的文件夹，如果存在，那么，这个文件夹又位于磁盘上的什么位置。更令人高兴的是FSO 对象模型还可以获取关于文件和文件夹的信息，如名称、创建日期或最近修改日期等以及当前系统中使用的驱动器的信息，如驱动器的种类是CD－ROM还是可移动磁盘，当前磁盘的剩余空间还有多少。而以前要获取这些信息必须通过调用Windows API函数集中的相应函数才能实现。
FSO对象模型包含在Scripting 类型库 (Scrrun.Dll)中，它同时包含了Drive、Folder、File、FileSystemObject和TextStream五个对象。其中Drive用来收集驱动器的信息，如可用磁盘空间或驱动器的类型；Folder用于创建、删除或移动文件夹，同时可以进行向系统查询文件夹的路径等操作；File的基本操作和Folder基本相同，所不同的是Files的操作主要是针对磁盘上的文件进行的；FileSystemObject是FSO对象模型中最主要对象，它提供了一套完整的可用于创建、删除文件和文件夹，收集驱动器、文件夹、文件相关信息的方法。需要注意的是，FSO对象模型提供的方法是冗余的，也就是说在实际使用中，FSO对象模型中包含的不同对象的不同方法进行的却是同样的操作，而且FileSystemObject对象的方法直接作用于其余对象，所以在后面的文章中并没有单独提到FileSystemObject对象，千万不要以为没有提到就不重要，事实上FileSystemObject对象在整个FSO对象模型中无处不在；最后的TextStream对象则是用来完成对文件的读写操作的。
在初步了解了FSO对象模型之后，下面我们通过实际的代码对不同的对象进行进一步的阐述。
二、FSO对象模型的应用
（一）创建FSO对象模型
由于FSO对象包含在Scripting 类型库 (Scrrun.Dll)中，所以在使用前首先需要在在工程中引用这个文件，单击“工程”，“引用”，然后在“引用”对话框中选中“Microsoft Scripting Runtime”前的复选框，然后单击“确定”。
要创建FSO对象可以采用两种方法，一种是将一个变量声明为FSO对象类型：Dim fsoTest As New FileSystemObject；另一种是通过CreateObject方法创建一个FSO 对象：Set fsoTest = CreateObject(“Scripting.FileSystemObject")。在实际使用中具体采用哪种声明方法，可根据个人的使用习惯而定。
完成了FSO对象模型的创建之后，就可以利用创建的对象模型的方法访问下属各个对象的属性来获取所需信息或进行相关操作了，具体的方法在下面结合各个对象分别讲述。
（二）Drive对象
上面已经提到Drive对象是用来获取当前系统中各个驱动器的信息的。由于Drive对象没有方法，其应用都是通过属性表现出来的，所以我们必须熟悉Drive对象的属性：
AvailableSpace：返回在指定的驱动器或网络共享上的用户可用的空间容量。
DriveLetter ：返回某个指定本地驱动器或网络驱动器的字母，这个属性是只读的。
DriveType：返回指定驱动器的磁盘类型。
FileSystem： 返回指定驱动器使用的文件系统类型。
FreeSpace：返回指定驱动器上或共享驱动器可用的磁盘空间，这个属性是只读的。
IsReady：确定指定的驱动器是否准备好。
Path ：返回指定文件、文件夹、或驱动器的路径。
RootFolder ：返回一个 Folder 对象，该对象表示一个指定驱动器的根文件夹。只读属性。
SerialNumber：返回用于唯一标识磁盘卷标的十进制序列号。
ShareName：返回指定驱动器的网络共享名
TotalSize ：以字节为单位，返回驱动器或网络共享的总空间大小。
VolumeName ：设置或返回指定驱动器的卷标名。
从上面的属性可以看到Drive对象基本上包含了日常操作所需的全部的驱动器信息，因此在使用中是非常方便的。下面通过一个实例讲述Drive对象的使用。首先在VB中建立一个工程，然后添加一个命令按钮，将其Caption设置为“TestDrive”，然后在click事件中加入以下代码：
Dim fsoTest As New FileSystemObject
Dim drv1 As Drive, sReturn As String
Set drv1 = fsoTest.GetDrive(“C:\")
sReturn = “Drive " ＆ “C:\" ＆ vbCrLf
sReturn = sReturn ＆ “VolumeName" ＆ drv1.VolumeName ＆ vbCrLf
sReturn = sReturn ＆ “Total Space: " ＆ FormatNumber(drv1.TotalSize / 1024, 0)
sReturn = sReturn ＆ “Kb" ＆ vbCrLf
sReturn = sReturn ＆ “Free Space: " ＆ FormatNumber(drv1.FreeSpace / 1024, 0)
sReturn = sReturn ＆“Kb" ＆ vbCrLf
sReturn = sReturn ＆“FileSystem:" ＆ drv1.FileSystem ＆ vbCrLf
MsgBox sReturn
其中GetDrive方法返回一个与指定路径中的驱动器相对应的 Drive 对象。该方法的语法格式为object.GetDrive drivespec，object是一个FSO对象的名称，drivespec用于指定驱动器的名称。
按F5运行上述代码，按下TestDrive按钮就会弹出一个消息框显示C盘的信息。
（三）Folder对象
在FSO 对象模型中，提供了丰富的有关文件夹操作的方法，这些方法分别是：
FileSystemObject对象有关文件夹的方法：
CreateFolder ：创建一个文件夹 。
DeleteFolder：删除一个文件夹 。
MoveFolder ：移动一个文件夹 。
CopyFolder：复制一个文件夹 。
FolderExists： 查找一个文件夹是否在驱动器上 。
GetFolder ：获得已有Folder对象的一个实例 。
GetParentFolderName： 找出一个文件夹的父文件夹的名称。
GetSpecialFolder： 找出系统文件夹的路径。
Folder对象的方法：
Delete ：创建一个文件夹 。
Move ：移动一个文件夹 。
Copy：复制一个文件夹。
Name：检索文件夹的名称。
在此需要强调一点，前面我们曾经提到过FSO对象模型包含的方法是冗余的，所以Folder对象的Delete、Move、Copy方法和FileSystemObject对象的DeleteFolder、MoveFolder、CopyFolder方法实际上是相同的，因此在实际使用中可以任选其中的一种。
和Drive对象一样，下面通过实例演示Folder对象的应用。在VB下新建一个工程，然后在上面添加三个命令按钮，然后在Form1的通用部分加入以下代码：
Option Explicit
Dim fsoTest As New FileSystemObject
Dim folder1 As Folder
并且分别在三个命令按钮的click事件输入以下代码：
Private Sub CmdCreate_Click()
' 获取 Folder 对象。
Set folder1 = fsoTest.GetFolder(“C:")
'创建文件夹
fsoTest.CreateFolder (“C:\Test")
MsgBox “folder C:\Test has created"
End Sub
Private Sub CmdDelete_Click()
' 获取 Drive 对象。
Set folder1 = fsoTest.GetFolder(“C:")
'删除文件夹
fsoTest.DeleteFolder (“C:\Test")
MsgBox“folder C:\Test has deleted"
End Sub
Private Sub CmdGetPro_Click()
'获取文件夹的有关信息
Dim sReturn As String
Set folder1 = fsoTest.GetFolder(“C:\Windows")
'sReturn = “The folder's Attributes is " ＆ folder1.Attributes ＆ vbCrLf
'获取最近一次访问的时间
sReturn = sReturn ＆ “The folder's last access time is " ＆ folder1.DateLastAccessed ＆ vbCrLf
'获取最后一次修改的时间
sReturn = sReturn ＆ “The folder's last modify time is " ＆ folder1.DateLastModified ＆ vbCrLf
'获取文件夹的大小
sReturn = sReturn ＆ “The folder's size is " ＆ FormatNumber(folder1.Size / 1024, 0)
sReturn = sReturn ＆ “Kb" ＆ vbCrLf
'判断文件或文件夹类型
sReturn = sReturn ＆ “The type is " ＆ folder1.Type ＆ vbCrLf
MsgBox sReturn
End Sub
上述代码中提到的CreateFolder方法的语法形式为object.CreateFolder(foldername)。foldername指定了要创建的文件夹的名称，而DeleteFolder方法的语法形式为object.DeleteFolder folderspec[,force]，其中，folderspec用来指定要删除的文件夹的名称，force是一个可选的布尔型参数，如果希望删除只读属性的文件夹则将该值设为TRUE，默认为FALSE。至于代码中用到的 Folder 对象的属性限于篇幅，就不详细介绍了，读者可参考VB文档中的相关内容。
（四）File对象和TextStream对象
由于有关File对象的复制，删除，移动等操作和Folder对象类似，所以这部分内容就不再重复。这里主要讲述利用File对象和TextStream对象操作文本文件。
通常对文本文件的操作包括在文本文件中创建数据，在文本文件中添加数据，删除文本文件的数据等操作。这些操作都可以通过File对象和FileSystemObject对象的相关方法完成。不过在使用之前，首先要创建一个文本文件，这可以通过三种方法完成。一种方法是使用FileSystemObject对象的 CreateTextFile 方法。要创建一个空文本文件，可以用以下语句：
Dim fsoTest As New FileSystemObject, fil1 As File
Set fil 1= fsoTest.CreateTextFile(“c:\testfile.txt", True)
第二种方法是使用 FileSystemObject 对象带 ForWriting 标志设置的 OpenTextFile 方法，
Dim fsoTest As New FileSystemObject, ts1 As New TextStream
Set ts1 = fsoTest.OpenTextFile(“c:\testfile.txt", ForWriting)
第三种方法是使用File对象的带 ForWriting 标志设置的 OpenAsTextStream 方法：
Dim fsoTest As New FileSystemObject, fil 1As File, ts 1As TextStream
Set fsoTest = CreateObject(“Scripting.FileSystemObject")
fsoTest.CreateTextFile (“c:\testfile.txt")
Set fil1 = fsoTest.GetFile(“c:\testfile.txt")
Set ts1 = fil1.OpenAsTextStream(ForWriting)
其中CreateTextFile方法的第一个参数用来指定，第二个参数用来指定如果磁盘上已经存在要创建的文件是否覆盖，TRUE表示覆盖，FALSE表示不覆盖，省略表示不覆盖；OpenTextFile方法的第一个参数确定要打开的文本文件，第二个参数表示对该文件进行写操作；OpenAsTextStream方法的参数和OpenTextFile方法的第二个参数含义相同。
在创建了写入数据的文本之后就可以利用TextStream 对象的 Write 或 WriteLine 方法了，它们之间的区别在于 WriteLine 在指定的字符串末尾添加换行符，而Write方法没有。如果想要向文本文件中添加一个空行，可以使用 WriteBlankLines 方法。 在完成写的动作之后，用Close方法关闭打开的文本文件。如果要读取一个存在的文本文件的内容，就要用到 TextStream 对象的 Read、 ReadLine 或 ReadAll 方法；这些方法的区别是 Read：从一个文件中读取指定数量的字符 ；ReadLine：读取一整行（紧跟，但不包括，换行符）； ReadAll ：读取一个文本文件的所有内容。下面在一个VB的工程中演示上述的效果。
在VB中新建一个工程，然后在Form1上添加两个命令按钮，然后输入以下代码：
Private Sub CmdRead_Click()
Dim fsoTest As New FileSystemObject, file1 As File, ts As TextStream, s As String
Set file1 = fsoTest.GetFile(“C:\testfile.txt")
Set ts = file1.OpenAsTextStream(ForReading)
'读取一行
s = ts.ReadLine
MsgBox s
ts.Close
End Sub
Private Sub CmdWrite_Click()
Dim txtfile As File, ts As TextStream
Set txtfile = fsoTest.GetFile(“c:\testfile.txt")
Set ts = txtfile.OpenAsTextStream(ForWriting)
'使用Write方法写入一行。
ts.Write (“This is only a Test")
' 写入一行带有换行符的文本。
ts.WriteLine (“Testing 1, 2, 3.")
' 向文件中写入三个换行符。
ts.WriteBlankLines (3)
ts.Close
End Sub
在这里我们假设已经在磁盘上建立了一个名为testfile.txt的文件。在按下F5运行时，先单击Write写入数据，然后按下Read读取数据。
三、结束语
通过上面的介绍，我们可以看到FSO对象模型的确在传统的文件操作语句之外，提供了一种更方便，功能更强大的访问文件的操作方法。不过，我们还需要注意到FSO对象模型目前还不完善，当前使用的FSO对象模型还不支持创建随机文件或二进制文件。要创建随机文件和二进制文件，仍然要使用带 Random 或 Binary 标志的 Open 命令。但从目前FSO对象模型的实际应用来看，我们仍然可以将FSO对象模型作为一种比较简便的文件操作解决方案。
注：上述代码均在VB6.0 SR3，


MsComm 控件的文字传输范例

MsComm 文字传输

假如您对 MSComm 的基本属性还不了解, 建议请先至MSComm 基本介绍一文中详读

表单画面

' 表单部分
'-------------------------------------------------------------
Form.Name = "Form1"
Caption = "Form1"
CommandButton.Name = Command2
Caption = "停止测试"
CommandButton.Name = Command1
Caption = "开始测试"
TextBox.Name = Text1
MSComm.Name = MSComm1
DTREnable = -1'True
Label.Name = Label1
AutoSize = -1'True
Caption = "欲送出的资料 - 按下[Enter]送出"
Label.Name = Label3
BorderStyle = 1'单线固定
Label.Name = Label2
AutoSize = -1'True
Caption = "折返显示"

' 程式部分
'-------------------------------------------------------------
Option Explicit
' 设一个此表单的区域变数，来作终止读取通讯埠的指标
Dim bStop As Boolean
' 设一个区域变数，来作读取通讯埠的暂存区
Dim InString As String

Private Sub Command1_Click()
bStop = False
Text1.SetFocus
With MSComm1
' 设定通讯埠号，可依照您的需求更改
.CommPort = 2
' 设定传输速率等，可依照您的需求更改
.Settings = "14400,N,8,1"
' 将通讯埠打开
.PortOpen = True
End With
' 假如使用者未按下「停止测试」钮(bStop = False), 则继续读取
Do While Not bStop
If MSComm1.InBufferCount Then
' 通讯埠中假如有资料的话, 则读取进来
InString = InString & MSComm1.Input
' 如果资料中有 Chr(13) 和 Chr(10) 的话, 则显示出来
If InStr(InString, vbCrLf) Then
Label3.Caption = Label3.Caption & InString
InString = ""
' 暂时把系统资源让出来给其它的程式使用
DoEvents
End If
End If
DoEvents
Loop
End Sub

Private Sub Command2_Click()
' 按下「停止测试」钮时, 把 bStop 设为「真」(True)
' 如此程式才会停止等待(或读取)通讯埠所收到的资料
bStop = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
bStop = True
' 把通讯埠关闭, 才不会影响其它程式的使用通讯埠
MSComm1.PortOpen = False
End
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
' 当按下 [Enter] 时, 把 Text1 文字框中的资料送至通讯埠
If KeyAscii = 13 Then
MSComm1.Output = Text1.Text & vbCrLf
Text1.Text = ""
KeyAscii = 0
End If
End Sub


Office或IE4风格的ToolBar
用API 可以轻松改变 ToolBar 的风格。需要 4.70 或其以上版本的 comctl32.
dll 支持。
声明：
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (
ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal
lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal
lpsz2 As String) As Long
Private Const WM_USER = &H400
Private Const TB_SETSTYLE = WM_USER + 56
Private Const TB_GETSTYLE = WM_USER + 57
Private Const TBSTYLE_FLAT = &H800
Private Const TBSTYLE_LIST = &H1000
函数：
' tlbToolbarStyle :
'1 为 Office97 风格
'2 为 IE4 风格
Public Sub ToolbarStyle(tlb As Toolbar, tlbToolbarStyle As Long)
Dim lngStyle As Long
Dim lngResult As Long
Dim lngHWND As Long
'


Regsvr32.exe注册控件的具体用法

EXE文件中的类注策可以双击该文件，即刻注策。或用命令行(XXX.exe / regserver)注策DLL，OCX文件可用命令行 (REGSVR32.EXE /s xxx.dll 或 xxx.ocx)注策。
大批量注策时可以编一个批处理文件。或编程处理。
如果以前注策过，注策前要先反注策，EXE文件(xxx.exe /unregserver)DLL,OCX文件(regsvr32 /u /s xxx.dll ),否则会保留原信息。
还有一个比较方便的方法就是把Regsvr32.exe的快捷键拷到WINDOW目录下的SENDTO里，这样用鼠标右键点击文件然后在弹出的菜单里选发送到Regsvr32即可。


TextBox的自动调节
     你一定见过这样的TextBox，当焦点离开后，TextBox的内容按一定的格式自动调整。 比如：你在TextBox中输入“34”，当TextBox失去焦点时，其内容自动调节为“0034”。 其实，实现起来很简单。
下面的例子就实现了这个功能。
>>步骤1----建立新工程，在窗体上放置TextBox控件，再在窗体上放置一个可以得 到焦点的控件，比如PictureBox。
>>步骤2----编写如下代码：

Private Sub Form_Load()
    Text1.Text = ""
End Sub

Private Sub Text1_Change()
    If Not IsNumeric(Text1.Text) Then
        SendKeys "{bs}" 'To ensure your inputs is number
    End If
End Sub

Private Sub Text1_LostFocus()
    Text1.Text = AutoRec(Text1.Text, 4)
End Sub

Private Function AutoRec(ByVal strString As String, ByVal nLength As Integer) As String
    Dim nTmpLth As Integer
    nTmpLth = Len(strString)
    Dim i As Integer
    AutoRec = strString
    For i = 1 To nLength - nTmpLth
        AutoRec = "0" & AutoRec
    Next
End Function

>>步骤3----编译运行，先在TextBox中输入一个数字，然后再在PictureBox上点一下，看看TextBox的内容是不是自动调整了。


TextBox实现打印机效果
     利用TextBox可以实现打印机效果的显示信息。
请看下例：
>>步骤1----建立新工程，在窗体上放置一个TextBox，一个CommandButton按钮， 一个Timer控件。设置Timer的Enable=false;Interval = 200;
>>步骤2----编写如下代码：

Private Sub Command1_Click()
    Timer1.Enabled = True
    Text1.SetFocus
End Sub

Private Sub Timer1_Timer()
    Static i As Integer
    Dim Str1 As String, Str2 As String, Str3 As String
    Dim Len1 As Integer, Len2 As Integer, Len3 As Integer
    Str1 = "程序编制：小马哥"
    Str2 = "EMail:Schunter@263.net"
    Str3 = "Http://MaJiFeng.top263.net"
    Len1 = Len(StrConv(Str1, vbFromUnicode))
    Len2 = Len(Str2):Len3 = Len(Str3)

    With Text1
        .FontSize = 20
        .FontName = "黑体"
        .ForeColor = &HFF0000
        .BackColor = &HFFFF&
    End With

    Str2 = Mid$(Str1 + Str2 + Str3, i + 1, 1)
    SendKeys Str2
    i = i + 1

    If i = Len1 + 1 Then
        Text1.Text = ""
    ElseIf i = Len1 + Len2 + 1 Then
        Text1.Text = ""
    ElseIf i = Len1 + Len2 + Len3 + 1 Then
        i = 0
        Text1.Text = ""
    End If
End Sub


TreeView的基本操作
1.增加顶节点
2.增加分节点
3.删除所选节点
4.预防错误的发生
5.补充说明：
6.添加弹出式菜单(有点难)
7.改变背景颜色(调用 API 函数)

1.增加顶节点
TreeView1.Nodes.Add , tvwLast, , "顶节点" '注：基本的语法看Cmctl198.CHM这里就不说了

2.增加分节点
TreeView1.Nodes.Add 1, tvwChild, , "分节点" '1表示一个已经存在的Node对象的索引号，这就是指在索引号为1的Node对象下新建一个分节点，可用下列语句取得你所点击的Node对象的索引号 ：
Private Sub TreeView1_Click() ‘点击TreeView时发生
index = TreeView1.SelectedItem.index
End Sub
下面这句就是在你任意点击的Node对象下建立一个分节点&127;
TreeView1.Nodes.Add index, tvwChild, , "分节点"

3.删除节点
TreeView1.Nodes.Remove index '删除你所点击的Node对象

4.预防错误的发生
（1）没有任何Node对象了，你仍然再删除节点，解决方法如下：
On Error GoTo err
TreeView1.Nodes.Remove index '删除节点
err:
Exit Sub
（2）没有任何Node对象时，你建立分节点，解决方法如下：
On Error GoTo err
TreeView1.Nodes.Add index, tvwChild, , "分节点" '增加顶节点
Exit Sub
err:
TreeView1.Nodes.Add , tvwLast, , "顶节点 " '增加顶节点

5.补充说明：
如要显示图像，请加载ImageList控件与TreeView邦定，然后使用如下语句：
TreeView1.Nodes.Add , tvwLast, , "顶节点",1 '这里的1就是ImageList控件的图像索引
最好把TreeView的Style属性设置为7，LineStylen属性设置为1会比较好看些。

Hi，如果你把上面的都搞清楚了，就可以学习一下下面的小技巧(有点难度哟)

6.增加右键弹出式菜单
Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim nod As Node

If Button = vbRightButton Then '检测鼠标的点击

Set nod = TreeView1.HitTest(x, y) '返回你所点击的Node对象的坐标

On Error GoTo EmptyNode

nod.Selected = True ' 设置你所点击的Node对象被选中

On Error GoTo 0

'<<下面是你的自定义菜单>>

Me.PopupMenu mnuPopUp

EmptyNode:

On Error GoTo 0

End If

End Sub

好了好了，看来你的基本操作都差不多会了，现在就来个难的(没有注释)，请向下接着看：

7.调用 API 函数改变 TreeView 的背景色
首先声明 API 函数
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = -16&
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&

下面就是改变背景色的代码
Dim lngStyle As Long
Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0))
'改变背景到红色

lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)


VB5中DBGRID控件在VB6中使用

问题：我原来的程序是在VB5中作的，用了DBGRID控件，但在VB6中没有这个控件，我想把程序从VB5升级到VB6，我先把DBGRID32.OCX，DBGRID32.DEF拷到Windows／System32／下,然后注册，当用到这个控件时，提示“该部件的许可信息没有找到，在设计环境中，没有合适的许可证使用该功能”。为什么？请问该怎么做？
    答：解决方法有两种，其一、可以先安装VB5，再安装VB6即可；其二、也可以将VB5下的dbgrid32.reg和dbgrid32.ocx等文件复制到Windows\System下，运行dbgrid32.reg进行注册，最后在VB6下引用即可。


VB6.0动态加载ActiveX控件漫谈
深圳 罗汉军 罗德昌

---- 熟悉VB的朋友对使用ActiveX控件一定不会陌生，众多控件极大地方便了编程，但
唯一的缺陷是不能动态加载控件，必须在设计时通过引用，将控件放置在窗体上。
VB6.0已能够解决该问题，只是帮助中没有明确说明，并且没有描述到一些关键功能，
由于以前的版本中可以动态创建进程外服务：如果对象是外部可创建的，可在 Set 语
句中用 New 关键字、CreateObject 或 GetObject 从部件外面将对象引用赋予变量。
如果对象是从属对象，则需使用高层对象的方法，在 Set 语句中指定一个对象引用：

Dim xlApp1 As Excel.Application
Set xlApp1 = New Excel.Application
或
Dim xlApp As Object '定义存放引用对象的变量。
Set xlApp = CreateObject("excel.application")
xlApp.Visible = True

---- 这些语法很容易造成误导，以为动态加载ActiveX控件也是此方法，可能有朋友也
象我一样利用CreateObject尝试了无数次，却无功而返，不知微软公司是出于何种考
虑，动态加载ActiveX控件是扩展控件集合的方式实现，通过实际摸索，终于就如何实
现动态ActiveX控件找出了一条切实可行的方法，下面以一个具体的实例来详细说明。

一、ActiveX控件

---- ActiveX 控件是 Visual Basic 工具箱的扩充部分。使用 ActiveX 控件的方法与
使用其它标准内装的控件，如 CheckBox 控件，完全一样。在程序中加入 ActiveX 控
件后，它将成为开发和运行环境的一部分，并为应用程序提供新的功能。

---- ActiveX 部件通过客户端/服务器关系与应用程序— 及与部件相互之间— 交互作
用。客户端是使用部件功能的应用程序代码或部件。服务器是部件及其关联的对象。例
如，假设应用程序使用 ActiveX 控件来提供一个标准的雇员窗体，供公司的多种应用
程序使用。提供雇员窗体的 ActiveX 控件就是服务器，使用这个控件的应用程序就是
服务器的客户端。

二、加载方法

---- VB6.0中对Controls 集合进行了扩展，以前版本中Controls 集合在窗体上列举出
已加载的控件，这在迭代过程中是很有用的。Controls 集合标识一个叫做 Controls
的内在窗体级变量。如果忽略可选的 object 所在处的整数，则关键字 Controls 必须
包括在内。我们通常在窗口中使用如下代码：

Text1.Text="Hello, world"
其实也可以使用如下代码达到同一目的：
Controls(1).Text="Hello, world"

---- 在VB6.0中除了原来的Clear、Remove 方法外(很奇怪，为什么微软在VB5.0中只提
供这两种方法，而没有提供Add方法，因为没有Add，这两种方法也就没什么用处)，增
加了Add方法，该方法就是用于动态加载控件的：
Controls.Add(progid as String, Name as String);
progid： ActiveX部件的ProgID，如："VB.CheckBox"；
Name：ActiveX部件加载后的名称，如： "MyCheckBox"；

若要在窗体上添加一个名为MyButton的按钮，可以使用：
dim oControl as Object '窗体级变量
注意：这里声明为Object对象类型
Private Sub LoadControl()
Set oControl = Controls.Add
("VB.CommandButton", "MyButton")
    oControl.Left = 10
    oControl.Top = 10
    oControl.Visible = True '使控件可见
End Sub

---- 这是VB6.0的标准语法，它在例程中也是如此演示的，不过该方法虽然现实了控件
的动态加载，按钮显示在窗体上，可以象普通按钮一样按下去，但加载的控件不能预先
设计响应事件代码，如：事件Sub MyButton_Click()将是非法的，当然，可以将要响应
的事件封装在控件内部。就编程的观点来看该方法没什么大的用处，开发ActiveX控件
的目的是为了资源共享，为了被其他开发人员利用，所以要提供必要的事件接口，显然
利用该方法不行，通过分析VBControls等相关对象，找出VBControlExtender对象与
EventInfo相结合能提供事件陷井捕捉，VBControlExtender对象对动态添加控件特别有
用，它提供了一套通用的属性、方法、事件给开发人员，它的一个突出特点是能编程设
计控件的事件，熟习类编程的朋友对带事件的对象声明一定不会陌生：
---- Dim WithEvents objElemt as CElemtVBControlExtender也不例外，声明的语法
一样，只不过它有个特殊的事件ObjectEvent(Info As EventInfo)，它能捕捉到对象使
用RaiseEvent产生的所有事件，EventInfo数据结构映射了事件的名称、参数个数和参
数的值。VBControlExtender和 EventInfo相结合，采用Select Case 就可以预先将不
同类对象的事件放置一起，各自独立运作。将上面的代码改写一下就能提供Click事件
了：

---- Dim WithEvents oControl As VBControlExtender '带事件声明声明之后您就可
以在代码窗口的左上角的对象下拉框中发现该对象出现了，也就是说，该对象有了事件
或方法了，它的事件有DragDrop，DragOver ，LostFocus ，GotFocus ，ObjectEvent
和Validate，其中ObjectEvent是通用的事件捕捉。

Private Sub LoadControl()
   Set oControl = Controls.Add
("VB. CommandButton", "MyButton")
   oControl.Visible = True
End Sub

Private Sub oControl_ObjectEvent(Info As EventInfo)
  Select Case Info.Name
   Case "Click" 'Click事件
 '您可以添加处理Click事件代码
 MsgBox "您按了MyButton!"
   Case Else ' 其他事件
      ' Handle unknown events here.
   End Select
End Sub

---- 当然对微软提供的标准控件能采用该方法添加，大家都不会怀疑，但自己开发的
控件也能吗？答案是肯定的，我们可以用一个实际的例子进行说明。

三、实例描述

---- 假设一个本地网络的监控系统，需要在原理图与实物示意图间切换，原理图包括
组网结构、传输资源、监控主机等，而实物示意图包括路由器、设备、采集器等，当然
两种图的事件要一致，如双击某个设备图形将显示给设备的实时数据等，为了简化维
护，将原理图与实物示意图封装成ActiveX控件，由于每种图需要加载许多图形控件，
消耗资源较大，不能同时加载，需要将其分解为两个控件，在切换时首先卸载一个控
件，然后加载另一个控件，所以要实现动态加载ActiveX控件。

---- 原理图控件为--Theory.ocx ，对应工程为CTheory；

---- 实物图控件为---Fact.ocx ，对应工程为CFact；

---- 注意：为了简化，在设计控件时不设置许可证关键字。

---- 实物图控件上的图形对象可以被拖动，拖动后的位置信息通过事件
ChangePosition来通知拥有该控件的窗体，以便下次加载能显示在最后位置，实物图和
原理图控件都有双击事件完成的工作相同，其他事件此处忽略。

---- 四、具体示例

---- 1、准备工作

---- 对控件Theory.ocx 、Fact.ocx 进行注册(利用Regsvr32.exe注册)；

---- 建立窗体frmTest.frm ，在窗体上放置按钮cmdLoadOcx—“原理图”

---- 2、声明窗体级变量与加载函数LoadControl

Dim WithEvents oControl As VBControlExtender
'地图仿真控件对象
Dim mblnTheory As Boolean   '是否显示原理图

Private Function LoadControl(intType As Integer)

If  Not oControl Is Nothing Then
'首先判断对象是否存在，若存在则卸载
 Controls.Remove("MapView")
'卸载控件，此操作非常重要
End If
If intType = 0 Then
Set oControl = Controls.Add
("CTheory. Theory", "MapView")
Else
Set oControl = Controls.Add
("CFact.Fact", "MapView")
End If

oControl.Height = 3500
oControl.Width = 6500
oControl.Top = 100
oControl.Visible = True
End Function

Private Sub Form_Load()
mblnTheory = True
End Sub

---- 3、为按钮cmdLoadOcx编写代码
Private Sub cmdLoadOCX_Click()
If mblnTheory Then
    Call LoadControl(0)
    mblnTheory = False
    cmdLoadOCX.Caption = "实物图"
Else
    Call LoadControl(1)
    mblnTheory = True
    cmdLoadOCX.Caption = "原理图"
End If
End Sub

---- 4、为事件ChangePosition编写代码
Private Sub oControl_ObjectEvent
(Info As EventInfo)
   Select Case Info.Name
   Case "ChangePosition"
      MsgBox CStr(Info.EventParamters.Item(
1).Value) + ":" + _
  CStr(Info.EventParamters.Item(2).Value)
   Case "DbClick"
 '双击处理代码
   Case Else '
   End Select
End Sub

---- 注意： EventInfo的参数EventParamters集合中是以1开始的，一般来说，微软新
的集合一般是以1开始的，而旧的是以0开始的，如RdoErrors.Item(0)。
---- 5、关闭窗口前卸载控件

Private Sub Form_Unload(Cancel As Integer)
Controls.Remove("MapView")
Set oControl = Nothing
End Sub

---- 6、特别注意
---- 通过Controls.Add方法添加的ActiveX控件一定不能在该工程中有该控件的任何引
用，否则系统将出错。

四、小结

---- 通过使用动态加载ActiveX控件使用庞大的应用程序变得很小，将不同的ActiveX
控件进行各种组合，使应用程序更加灵活多变，如您的应用系统要处理三十种门禁，而
某个具体的用户可能只有一种或两种门禁，根本没必要首先将所有门禁包含到应用中，
可将各个门禁独立封装，只安装注册需要的组件，就象Windows的自定义安装一样。

---- 本代码在Win98、VB6.0(英文版)上编译、运行。


VB与MS-Draw开发通用作图软件

一、OLE技术介绍

OLE和DDE,是支持Windows应用之间相互通讯的一种机制。OLE技术通过"对象"集成win dows应用程序,它采用图象、图表、数据库、声音、文本
等构成复合对象(也称复合文档)。 OLE技术是在复合文档中实现链接对象或嵌入对象的一组协议,该技术首先由Aldus公司在1 988年提出,后被
Microsoft公司引进到Windows中。使用OLE,一个应用程序可以和其他应用程序合作,以产生包含有不同种类对象的复合文档,并且文档中所包含
的对象易于被用户操作。

支持OLE调用的Windows软件,在Windows中会有注册登记信息,查看WIN.INI中[embeddi ng]节的内容,可知道Windows中包含哪些可以调用的OLE对象。画笔(PBRUSH.EXE)、统计图 (Microsoft Graph)、对象包装程序(PACKGER.EXE)和录音机(SOUNDREC.EXE)是Windows环境下常用的OLE嵌
入对象。

Windows环境下的大部分开发工具(如C、C++、PASCAL、Visual Basic 3.0、CA-Reali zer、FoxPro for Windows、Visual FoxPro for Windows等)大都支持开发具有调用OLE对象能力的应用程序,相比之下,Visual Basic 3.0开发OLE调用程序更容易。

Windows环境下采用OLE技术开发应用程序有许多优点:

(1)、提高软件开发效率:通过OLE的嵌入其它WINDOWS应用程序,应用程
序员所进行的软件开发工作实际上变成了软件集成(或称"软件组合"),
这样就比逐个开发软件功能模块要快得多,应用软件的开发周期大大缩短;

(2)、性能稳定、可靠:由于OLE嵌入对象程序都是经过严格测试过的商品
软件,因此,经过"组合"的软件,只要经过对"组合过程"部分进行严格测试
(测试的工作量相对来说较小), 就能成为性能稳定可靠的高质量软件;

(3)、功能完善:OLE嵌入其它WINDOWS应用程序,不仅"嵌入"了其它应用程
序的数据,同时也"嵌入"了其它应用程序的功能。应用软件中能够"嵌入
"所有的WINDOWS OLE嵌入对象, 例如,你通过Word,Excel,Mail,Microsoft
Graph等建立起一个包含文字处理、电子报表、电子邮件和统计图形的综
合性办公自动化系统软件;

(4)、开发人员不再需要是编程专家:Visual Basic 3.0中提供了OLE 2.0
调用功能,大大降低了OLE调用的难度,一般的软件开发人员即可开发出调
用Windows OLE对象的应用程序。

Visual Basic for Windows 3.0(以下简称VB)是一个面向Windows的高级
开发系统,它采用事件驱动机制、可视化界面设计及集成化的开发、调试、
编译环境,VB同时还提供DDE 、OLE程序开发功能。VB既适合于初级程序
员,又适合于高级程序员编写功能强大的应用软件。

二、通用作图系统的设计

1、在Windows中添加Microsoft Draw OLE工具:

(1)修改win.ini:
[embedding]
MSDraw=MicrosoftDrawing,MicrosoftDrawing,c:\yzgraph\msdraw.exe,picture

(2)创建MSDRAW.REG:

REGEDIT
HEKY_CLASSES_ROOT\MSDraw=Microsoft Drawing
HKEY_CLASSES_ROOT\MSDraw\protocol\StdFileEditing\server=c:\yzgraph\msdraw. exe

(3)运行REGEDIT.EXE MSDRAW.REG,屏幕上会出现"c:\yzgraph\msdraw.exe
中的信息已成功地登录在登录数据库中"。

(4)从Microsoft Word 5.0中文版中\windows\msapps\msdraw子目录中拷贝
MSDRAW.EXE、MS-DRAW.HLP至c:\yzgraph子目录下。

2、在VB中创建一个FORM1:启动Visual BASIC 3.0,选File-NEW Project菜单;

3、在FORM1上创建"存盘""打印""退出"三个按钮对象;

4、在FORM1上创建一个OLE2对象:在Toolbox窗口选OLE2.0控件,移动鼠标至
Forml窗口上,按下左鼠标同时移动鼠标光标拖出一个小小的矩形。松开左鼠
标,这时,屏幕上会出现" insert object"对话窗口,选择Create New-Microsoft
Drawing-ok,这时Microsoft Drawi ng就会启动,退出Microsoft Drawing;

5、在Visual Basic 3.0中增加一个图形存盘及打印控件(mhoutbx.vbx):

mhoutbx.vbx是MicroHelp公司提供的具有图形显示打印功能的通用VBX控件。
在Visua l Basic 3.0中选File-Add File菜单,选中mhoutbx.bx;

AutoSize =-1 'True

EraseForRead = -1'True

6、在FORM1上创建一个图形存盘及打印的mhoutbx对象(用于Microsoft Draw的
结果存盘、打印输出);

7、使FORM1始终处于"最上层"(即不被其它窗口覆盖):

Global.bas:

Global Const SWP_MOVE=2
Global Const SWP_NOSIZE=1
Global Const FLAGS=SWP_MOVE Or SWP_NOSIZE
Global Const HWND_TOPMOST=-1
Global Const HWND_NOTOPMOST=-2
Declare Function SetWindowsPos Lib"user"(ByVal h%,ByVal hb%,ByVal X%,
ByVal y%,ByVal cx%,ByVal cy%,By-Val f%)As Integer
Declare Function GetSystemMetrics% Lib"user"(ByVal nIn-dex%)
Global Const
NILL=0&
Global Const WM_SYSCOMMAND=&H112
Global Const WM_LBUTTONDBLCLK=&H203
Global Const SC_CLOSE=&HF06O
Global Const WM-CLOSE=&H10
Global Const WM_GETMINMAXINFO=&H24
Declare Function FindWindows Lib "User"(ByVal lpClassName As Any,
ByVal lpW indowsName As Any)
As Integer

Declare Function sendmessage& Lib "user"(ByVal hWnd%,ByVal wmsg%,
ByVal wpa ram%,ByVal Iparam As Long)

Global Const SW_SHOWMAXIMIZED=3

Declare Function ShowWindows Lib "User"(ByVal hWnd As Integer,
ByVal nCmd S how As Integer)As Integer

8、激活MSDraw,并使其最大化:

Sub Form_Load()
Dim rc%,msdraw_h,Ipclass$,lpcaption$
form1,Width=Pane13D1.Width
rc%=SetWindowPos(form1.hWnd,HWND
_TOPMOST,0,0,0,0,Flags)
rc%=sendmessage(form1,OLE1.hWnd,WM
_LBUTTONDBLCLK,0,NILL)
AppActivate"Microsoft Draw-绘图"
SendKeys"%F",True
SendKeys"{LEFT}X",True
form1.Show
End Sub

9、图形存盘:

Sub Panel3D1_Click()
a$="c:\test.wmf"
AppActivate"Microsoft Draw-绘图"
SendKeys "%FU",True
FORM1.MhOutbox1.MetaFileName=a$
FORM1.MhOutbox1.SaveMetaFile=True
End Sub

10、图形打印:

Sub Panel3D2_Click()
AppActivate"Microsoft Draw-绘图"
SendKeys"%FU",True
MhOutboxl.OutContext=1
MhOutbox.EndPage=True
End Sub
11、退出:
Sub Panel3D3_Click()
Unload form1
End
End Sub


VB中APP对象及其应用
作者：韩潮涌
初学VB编程，很快就能编出些实用的程序了。我便将它们制成安装盘送给朋友，但很快就发现一个问题，程序总是按编程时固定好的路径读写文件，但文件路径改变，程序就找不到路径了，因此不能正常写文件。例如编程时设定：picture1.picture=Load Picture("c:\HVB\HAN.BMP")但若安装使用时，工作目录变为E：\HVB\HAN.BMP或其它路径，程序就会出错，并提示：找不到文件路径。这个问题看起来很复杂，但实际上很好解决，这只需用VB的App对象。
App对象有两种重要属性：(1)App.Path，它在VB编程状态下返回你的.MAK文件所在目录；在以.EXE文件运行时，则返回你的.EXE文件所在目录。(2)App.EXE Name它返回你的程序名。下面举一个简单的例子，假如你有一个程序为DDC，其目录为C：\HVB\DDC4(包括DDC.EXE)在VB编程环境下，在Debug窗口运行：Print App.Path,显示结果：C：HVB\DDC4，再运行Print App.EXEName显示结果：DDC。知道了以上两种属性，前面所述问题就很好解决了，可以将其修改为：Dim Apath ,Dim FilePath
Apath=App.Path
FilePath=Apath＋"\HAN.BMP"
Picture1.Picture=LoadPicture(FilePath)
这样，这程序的工作目录无论改为什么，都能正常工作了。
(注：文件目录为根目录时，以上情况略有不同，App对象在VB2.0以上版本中均存在。)
(四川 韩潮涌)


VB中list控件的功能扩充

中原油田计算中心 武正伦

    List控件是VB中常用、方便而有效的控件，是开发者非常喜欢的控件之一，但开发者常常会遇到这样的麻烦：一方面由于列表筐列表项内容长短不一，有的可能很长；另一方面由于界面的限制又不能把List控件作的很大，结果造成list控件中列表项内容太长而无法完整地显示出来。

    笔者在多年的开发过程中找到了两种简便的解决方法。

    一种是利用list控件的tooltiptext属性，在List控件mousemove事件中编程动态地改变list控件的tooltiptext属性值从而全部显示鼠标所在项的全部内容。

    另一种是在form中另加一个Label控件，把其caption属性设为false，利用list控件mousemove事件中编程，当鼠标移至list控件是则把鼠标所在列表项的内容赋给label控件的caption，label控件的visible属性设为true，这样就可通过label控件来显示鼠标所在项的全部内容，当鼠标离开list控件再把其visible属性设为false。这两种方法都必须解决一个问题，就是当鼠标移至List控件时从鼠标点阵位置算出鼠标所在list控件列表项位置。好在Win API为我们提供了一个API函数SendMessage可以解决这个问题，使用时作以下说明：

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

    函数中hwnd为list控件的hwnd，而wmsg为LB_ITEMFORMPOINT,lParam设为"x坐标+y坐标*65535"。

    下面详细介绍这两种方法，源程序已在VB5.0上调试通过。

    方法一：利用利用list控件的tooltiptext属性

    1、在Module1中作以下说明

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

    2、在form1中加入以下代码：

Const LB_ITEMFROMPOINT = &H1A9

Private Sub Form_Load()
  With List1
    .AddItem "fdhvgkh;lsbkfgjlkglkmjl,k'j;l,';hj"
    .AddItem "我是一个兵"
  End With
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim lcx As Long
  Dim lcy As Long
  Dim lci As Long
  If Button = 0 Then '若不按下鼠标键
    lcx = CLng(X / Screen.TwipsPerPixelX)
    lcy = CLng(Y / Screen.TwipsPerPixelY)
    '获得当前鼠标位置
    With List1
      lci = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lcy * 65536) + lcx))
      '计算鼠标所在列表项
      If (lci >= 0) And (lci <= .ListCount) Then
        ToolTipText=".List(lci)"
      Else
        .ToolTipText
      End If
    End With
  End If
  'MsgBox CStr(lci)
End Sub

    这种方法利用list控件本身的tooltiptext属性直接、简便。但是，显示时位置总是和鼠标所在的列表项错一行。方法2 可以解决这个问题。

    方法2：利用label控件

    1、在form1中加入label控件label1，autosize属性设为true,其visible属性设为False，字体属性设为和list1字体属性相同。

    2、写入下列代码

Const LB_ITEMFROMPOINT = &H1A9

Private Sub Form_Load()
  With List1
    .AddItem "fdhvgkh;lsbkfgjlkglkmjl,k'j;l,';hj"
    .AddItem "恢复稻谷单簧管列士大夫国家了发火点"
  End With
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Label1.Visible = False
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim lcx As Long
  Dim lcy As Long
  Dim lci As Long
  If Button = 0 Then '若不按下鼠标键
    lcx = CLng(X / Screen.TwipsPerPixelX)
    lcy = CLng(Y / Screen.TwipsPerPixelY)
    '获得当前鼠标位置
    With List1
      lci = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((ly * 65536) + lx))
      If (lci >= 0) And (lci <= .ListCount) Then
        Label1.Left="List1.Left"
        Label1.Top="List1.Top" + lci * (List1.Height / 3) ' Y
        Label1.Caption="List1.List(lci)"
        Label1.Visible="True"
      Else
        .ToolTipText
      End If
    End With
  End If
   'MsgBox CStr(lci)
End Sub

(其实在WIN32API中有一个消息可以直接给List控件增加一个横向的滚动条的方式来简单的解决该问题，这样也许可以成为第三种方式。)


VB中防止将重复项目添加到列表框控件中
谭 翁
---- 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 "SendMessageA" (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， 将 起Caption 属 性 设 置 为“ 重 复”。
---- 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 个 项 目。 在 文 本 框 控 件 中 键 入 一 个 新 的 项 目， 单 击 重 复 命 令 按 钮。 程 序 将 在 列 表 框 控 件 中 搜 索 刚 刚 键 入 到 文 本 框 控 件 中 的 项 目。 如 果 该 项 目 未 被 找 到， 则 程 序 将 把 该 项 目 添 加 到 列 表 框 控 件 中。 相 反， 如 果 该 项 目 已 经 在 列 表 框 中 存 在 了， 则 将 显 示 出 一 个 信 息 框 以 通 知 项 目 已 经 存 在。


VB中用Multimedia MCI控件开发多媒体应用

    VB是微软公司开发的32位Window开发工具软件，它控制多媒体的手段灵活和多样，如在VB 中调用Multimedia MCI控件就容易实现集成音乐和视频。
    一、Multimedia MCI控件的调用及说明

    在调用Multimedia MCI控件之前，须要执行“工程\部件”菜单命令，将Microsoft Multimedia Controls前的方框选中，在工具箱中便会出现Multimedia 控件图标。把 Multimedia 控件添加到窗体上。当你打开有效的多媒体设备并且控件可用时,系统会自动完成相应工作。按钮被分别定义为：Prev、 Next、 Play、 Pause、 Back、 Step、 Stop、 Record 和 Eject。你可以为某一个按钮编写程序，从而为其增加特殊功能，但一般情况，缺省的按钮功能就能很好地播放音乐和视频。
    在引用控件时，你须要指定控件的Device Type 属性，也可以缺省，对于复杂的MCI设备和播放CD音乐你必须要说明。格式是MMControl1.Device Type=Devname。下表列出了Multimedia控件支持的多媒体设备。
    在Multimedia控件中非常有用的一个属性是Command，它在运行过程中向多媒体设备发出命令。格式是：MMControl.Command = cmdstringS,其中cmdstringS变量与每一个按钮的定义名称一致。此外，还有Mode、Wait、Shareable、Notify、UpdateInterval、Position、Length等属性和Done、StatusUpdate事件是我们经常用到的。
    二、示例程序

    下面是一个用Multimedia控件集成音乐和视频的应用程序，它可播放＊.wav、＊.mid、＊.avi文件，可显示打开文件的时间长度和在播放时的进度，并在状态栏里有相关的说明。编程如下：
    1．设计窗体
    新建工程，在部件中分别引入Multimedia控件、Common Dialog Control 、Windows Common Control，在窗体中分别加入CommonDialog、MMControl、Slider、Status Bar、CheckBox。Label（1－3）分别放在Slider 下的左端、中间和右端，并在窗体上加一个菜单。将Slider的SelectRange的复选框选定，设置Smallchange和Maxchange为10，TickFrequengcy为20。在Status Bar的属性中的Panels项用鼠标点击Insert Panels 5 次。Index有5项，在Index第一项、第三项的Text项中分别输入“剩余时间”、“总时间”，适当设置每一项的Minimun Width(可参见后面对Panels的控制)。将CheckBox的Caption改为“循环”，把3个Label的Caption都改为空字符串。最后进入菜单编辑器，设置标题为“文件”，名称MnuFile；在“文件”下设立子菜单标题分别为“＆Open”、“＆Close”、“＆Exit”，名称分别为MnuOpen、MnuClose、MnuExit（在MnuExit_Click()事件填完代码后，要将其设为无效）。设计后如图1所示。

    2．控件代码

    本示例的源程序如下：
    Private Sub MnuOpen_Click()
    ′ 设定打开文件类型
    CommonDialog1.Filter = ″MIDI音乐序器＊.mid|＊.mid|声音＊.wav|＊.wav|Widows视频＊.avi|＊.avi″
    CommonDialog1.ShowOpen
    MMControl1.Notify = False
    MMControl1.Wait = True
    MMControl1.Shareable = False
    ′由系统默认设备类型
    MMControl1.DeviceType = ″″
    MMControl1.filename = CommonDialog1.filename
    ′ 打开 MCI 设备。
    MMControl1.Command = ″Open″
    MnuClose.Enabled = True
    Slider1.Visible = True
    End Sub
    Private Sub MMControl1_StatusUpdate()
    On Error GoTo Erropen
    ′设置文件长度以毫秒形式返回，
    MMControl1.TimeFormat = 0
    Slider1.Max = MMControl1.Length ／ 1000
    If MMControl1.Position <> MMControl1.Length Then
    Slider1.Value = MMControl1.Position ／ 1000
    Else
    MMControl1.Command = ″Prev″
    Slider1.Value = 0
    End If
    ′调用Tstring函数计算剩余时间和总时间
    StatusBar1.Panels(2) = Tstring(MMControl1.Length － MMControl1.Position)
    StatusBar1.Panels(4) = Tstring(MMControl1.Length)
    Label1.Caption = ″00:00″
    Label2.Caption = Tstring(MMControl1.Length ／ 2)
    Label3.Caption = Tstring(MMControl1.Length)
    ′ 由Mode返回不同值并在状态栏经出相应的提示
    Select Case MMControl1.Mode
    Case 524
    StatusBar1.Panels(5) = ″ 未打开设备……″
    Case 525
    StatusBar1.Panels(5) = ″停止状态……″
    Case 526
    StatusBar1.Panels(5) = ″正在播放……″ ＆ CommonDialog1.FileTitle
    Case 527
    StatusBar1.Panels(5) = ″正在录音……″
    Case 528
    StatusBar1.Panels(5) = ″正在搜索……″
    Case 529
    StatusBar1.Panels(5) = ″暂停播放……″
    Case 530
    StatusBar1.Panels(5) = ″设备就绪……″
    End Select
    Erropen:
    ′ 放弃打开文件
    End Sub
    ′ 自定义将毫秒转化为分、秒Tstring函数
    Private Function Tstring(sm As Long) As String
    s = (sm ／ 1000 ／ 60) Mod 60
    m = (sm ／ 1000) Mod 60
    Tstring = Format(s, ″00″) ＆ ″;″ ＆ Format(m, ″00″)
    End Function
    Private Sub MMControl1_Done(NotifyCode As Integer)
    MMControl1.UpdateInterval = 100 ′ 间隔100毫秒
    End Sub
    Private Sub MnuClose_Click()
    MMControl1.Command = ″Close″
    MnuClose.Enabled = False
    End Sub
    Private Sub MnuExit_Click()
    MMControl1.Command = ″Close″
    End
    End Sub
    Private Sub Check1_Click()
    If Check1.Value = 1 Then
    MMControl1.Command = ″Play″ ′ 继续播放
    End If
    End Sub
    此外，欲在当前窗口播放＊.avi文件，可在窗体加一个PictureBox，在Private Sub MMControl1_StatusUpdate()中加入MMControl1.hWndDisplay = Picture1.hWnd一句。运行时如图2。
（本程序在VB5.0，PⅡ350中通过）
    （黑龙江　王晓东）


Win Api在VB中的妙用

    Windows API作为一套功能强大的应用程序接口，使VB可以实现对Windows底层的控制，完成VB不具有的功能。下面介绍几种使用API函数的方法。
    一、制作特殊窗口
    1.各种形状的窗口(仅给出了函数名，具体定义可以查阅API Viewer)
    1)CreateEllipticRgn 建立一个椭圆形的区域；
    2)CreateRoundRectRgn 建立一个圆角矩形的区域；
    3)CreatePolygonRgn 建立一个多边形区域；
    4)CreatePolyPolygonRgn建立多个可重叠的多边形区域；
    5)CreateRectRgn 建立一个矩形区域；
    6)CombineRg连接两个区域，通过代入不同的参数可以实现多种合并方式；
    7)SetWindowRgn 设定窗口的范围，使用前边创建的区域；
    8)FrameRgn 在指定区域画上
边框。
    下边的程序就是建立一个形如“棒槌”的窗口：
Private Sub Form1_Load()
Dim p, q As Long
p = CreateEllipticRgn(0, 0, 200, 200) ′通过制定左上角和右下角的坐标建立一个圆
q = CreateRoundRectRgn(40, 120, 160, 400, 20, 20) ′通过制定左上角和右下角的坐标以及圆角的宽度建立一个圆角矩形
CombineRgn p, q, p, RGN_OR ′联合两个区域,使用或(就是取并集)运算
SetWindowRgn hWnd, p, True ′设置窗口区域
Me.Refresh ′刷新窗口
End Sub
    2.浮动窗口
    Delphi中实现浮动窗口非常容易，只要在属性栏中设置就可以。用VB实现就只有借助于API函数:
SetWindowPos hWnd,HWND_TOPM
OST,0,0,0,0,SWP_NOMOVE＋SWP_NOSIZE＋SWP_SHOWWINDOW就可以了。其中hWnd是窗口的句柄，HWND_TOPMOST指定了窗口的位置—总是在最上边。如果你要取消这个属性，只要把TOPMOST改成NOTOPMOST就可以了。后面4个参数指定了窗口的位置和大小，和VB提供的MOVE方法一样。不过最后一个参数如果指定了SWP_NOMOVE(不改变位置)和 SWP_NOSIZE(不改变大小)，那么这四个参数就会被忽略。
    3.透明窗口
    去年的《电脑报》上提供了一个制作透明窗口的办法，这里再介绍另一种方法：
Private Sub Form1_Load()
Dim p As Long
p = GetWindowLong(hWnd,GWLEX
STYLE) ′取得当前窗口属性
SetWindowLong hWnd, GWL_EXSTY
LE,p ＋ WS_EX_TRANSPARENT
′加上一个透明属性
Me.Refresh
End Sub
    GetWindowLong 和 SetWindowLong 配合使用还可以更改窗口的不少属性，有兴趣的读者不妨一试。
    二、读取外部图标
    下面的一段程序就显示了如何读取程序中的图标，其中Picture1是一个图像框，dlgOpen是一个标准对话框，Command1是一个按钮；ExtractIcon函数有三个参数，第一个参数指定调用的应用程序，一般都用App.hInstance；第二个参数指定图标文件，可以是DLL、EXE和ICO。第三个参数的不同就决定了其返回值的不同：如果代入－1，就返回文件中包含的图标数，代入0则返回第一个图标的句柄，其余依次类推。
Private Sub Command1_Click()
Static total As Long,p(50) As Long，i As Integer
dlgOpen.Filter = ″图标|＊.Exe;
＊.Ico;＊.Dll″
dlgOpen.ShowOpen
If Dir(dlgOpen.filename)<>″″ Then
If ExtractIcon(App.hInstance, dlgOpen.filename, －1) = 0 Then ′如果没有图标
MsgBox ″No Icon!″
Else
total = ExtractIcon(App.hIns
tance, dlgOpen.filename, －1)
′取得总图标数
For i = 0 To total － 1
p(i) = ExtractIcon(App.hIn
stance, dlgOpen.filename, i) ′读取每个图标
Next i
For i = 0 To total － 1 ′依次显示每个图标
DrawIcon Picture1.hdc, 34 ＊ i, 0, p(i)
Next i
End If
End If
End Sub
    三、在桌面上画图
    下面一段程序就是使用API函数在屏幕上画图标。(注：p是图标的句柄，可以由ExtractIcon取得)
deskhwnd = GetNextWindow(hwnd, GW_HWNDLAST) ′取最下面一个窗口
deskdc = GetWindowDC(deskhwnd)
′取窗口的情景设备
For i=0 To Screen.Width/32/15 ′将屏幕坐标单位换算成“Pixel”，并计算可画的图标数
For j=0 To Screen.Height/32/15
DrawIcon deskdc, 32＊i, 32＊j, p
′在桌面上画图
Next j
Next i
    用函数GetNextWindow取得其句柄，用函数GetWindowDC取出它的虚拟设备。不过，一旦窗口被覆盖，图标就会消失。
    四、屏蔽系统功能键
    在去年《电脑报》第22期上介绍了一种在Delphi中屏蔽系统功能键的方法。可是在VB中无论你怎么设置数据类型，系统总是提示“数据类型不匹配”, 下面就是API Viewer中给出的定义：
    Declare Function SystemParametersInfo Lib ″user32″ Alias “SystemParametersInfoA” (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
    笔者经过反复思考，终于恍然大悟：看到黑体的“ByVal”了吗？问题就出在这里。原来该函数使用的lpvParam 参数应该按地址传送而非按值传送，然而VB Viewer 中使用的是按值传送，所以会出现错误提示。
(福建　桃花岛主)


WINDOWS SCRIPT HOST对象在VB中的使用

作者：陈锐

    我们知道在DOS下我们可以利用批处理文件来执行一些基本的系统和文件操作。而为了让用户能在Windows下同样得到功能，微软提供了Windows Script Host。在本文中我向大家介绍的是如何在VB中使用Windows Script Host对象来丰富自己的程序。

    打开VB，点击菜单中的Project|References项，在弹出的References列表中如果有一项：Windows Script Host Object Modle。那么说明你的系统中已经安装了Windows Script Host对象，选中该对象然后再按确定键就可以将Windows Script Host对象加入到自己的工程中了。

    1、获得Windows下一些特殊目录

    如何获得Windows下一些特殊的文件目录（例如桌面、程序菜单）呢？使用下面的程序就可以获得这些特殊目录并在ListBox1中列出：

    Dim iw1 As New IWshRuntimeLibrary.IWshShell_Class

     List1.AddItem iw1.SpecialFolders(″Desktop″)

    ’获得桌面目录

    List1.AddItem iw1.SpecialFolders(″Fonts″)

    ’获得系统字体目录

    List1.AddItem iw1.SpecialFolders(″Programs″)

    ’获得程序菜单目录

    List1.AddItem iw1.SpecialFolders(″StartUp″)

    ’获得程序启动目录

    List1.AddItem iw1.SpecialFolders(″Recent″)

    ’获得最近使用文件目录

    List1.AddItem iw1.SpecialFolders(″FAVORITES″)

    ’获得收藏夹目录

    List1.AddItem iw1.SpecialFolders(″SENDTO″)

    ’获得发送到目录

    List1.AddItem iw1.SpecialFolders(″NETHOOD″)

    ’获得网络邻居目录

    List1.AddItem iw1.SpecialFolders(″AppData″)

    ’获得微软程序数据目录

    2、运行程序

    在VB中，我们有时候需要调用外部程序。而且还要暂停VB程序等待外部程序程序执行完毕。使用Windows Script Host对象，简直易如反掌。例如下面的语句：

    Dim iw1 As New IWshRuntimeLibrary.IWshShell_Class

    iw1.Run ″c:\windows\notepad.exe″,WshMaximizedFocus, True

    就可以执行Windows下的记事本程序并使当前程序等待直到记事本程序关闭再执行下面的语句，如果不需要等待，将Run语句中的第三个参数从True改为False就可以了。

    3、建立和断开网络驱动器映射

    在一般情况下要在VB中建立网络驱动器连接需要使用复杂的API函数，而使用了Windows Script Host对象就可以使得一切变得十分简单，来看下面的范例：

    Dim iwNet As New IWshNetwork_Class

    ’获得计算机名

    Debug.Print iwNet.ComputerName

    ’获得用户所在的域名

    Debug.Print iwNet.UserDomain

    ’获得用户名

    Debug.Print iwNet.UserName

    ’将网络上的主机Server1的共享驱动器Share_d映射为本机的H盘

    iwNet.MapNetworkDrive ″H:″,″\\Server1\Share_d″

    For i=0 To iwNet.EnumNetworkDrives.Count－1

    List1.AddItem iwNet.EnumNetworkDrives(i)

    Next i

    上面的程序首先在Debug窗口中显示本计算机和所在网络的名称以及用户名，然后建立一个网络驱动器映射，最后将映射到本机的驱动器在ListBox1中列出来。如果要断开映射的驱动器，只要调用下面的语句就可以了：

    ’断开驱动器

    iwNet.RemoveNetworkDrive ″H:″

    需要注意的一点是：调用Windows Script Host对象建立网络连接如果出现错误（例如要连接的主机不存在或驱动器错误），它不会象API函数那样返回一个错误码而会产生一个OLE错误，所以在程序中对于错误处理的代码一定要写好。

    4、建立快捷方式

    建立文件快捷方式并将快捷方式保存到文件也是Windows Script Host对象提供的功能之一，来看下面的代码：

    Dim iw1 As New IWshRuntimeLibrary.IWshShell_Class

    Dim iwSC As New IWshShortcut_Class

    ’建立一个快捷方式文件

    Set iwSC=iw1.CreateShortcut(″c:\windows\notepad1.lnk″)

    ’设定快捷方式指向的对象

    iwSC.TargetPath=″c:\windows\notepad.exe″

    ’设定对象（这里是Notepad.exe）运行时的参数

    iwSC.Arguments=″c:\a.txt″

    ’设定对象运行时的工作目录

    iwSC.WorkingDirectory=″c:\″

    ’设定快捷方式的图标

    iwSC.IconLocation=″c:\windows\notepad.exe,1″

    ’保存快捷方式到文件

    iwSC.Save

    上面的程序建立一个指向Windows下记事本的快捷方式并保存到文件中。

    5、注册表操作

    使用Windows Script Host对象还可以进行注册表操作，例如建立、修改、读取、删除主键或者键值等。而且只需要三个函数，比使用Windows API来说方便的多。下面的语句就是一个建立和删除注册表键值的范例：

    Dim WSHShell As New IWshRuntimeLibrary.IWshShell_Class

    ’在HKEY_CURRENT_USER下建立一个项，将默认值设置为Top level key

    WSHShell.RegWrite ″HKCU\MyRegKey\″,″Top level key″

    ’在MyRegKey下建立一个子项，将默认值设置为Second level key

    WSHShell.RegWrite ″HKCU\MyRegKey\Entry\″,″Second level key″

    ’在MyRegKey下建立一个值，名称为Value

    WSHShell.RegWrite ″HKCU\MyRegKey\Value″, 1

    ’在MyRegKey下建立一个值,名称为Entry,类型设置为REG_DWORD

    WSHShell.RegWrite ″HKCU\MyRegKey\Entry″,2,″REG_DWORD″

    WSHShell.RegWrite ″HKCU\MyRegKey\Entry\Value1″,3,″REG_BINARY″

    ’删除相应的键

    WSHShell.RegDelete ″HKCU\MyRegKey\Entry\Value1″

    WSHShell.RegDelete ″HKCU\MyRegKey\Entry\″

    WSHShell.RegDelete ″HKCU\MyRegKey\″

    上面的程序建立并删除建立的项，要看到程序运行效果，可以将上面的最后三句RegDelete语句删除，然后打开注册表编辑器察看。从上面的语句可以看到，使用RegWrite语句可以建立和修改一个项或者值，如果第一个参数字符串最后有一个“\”符号的话就是操作一个项，否则就是操作一个值。

    6、获得当前Windows环境参数

    环境参数就是操作系统保存在内存中的一些标记或指示性字符串，它纪录了一些基本的系统设置，例如路径、临时文件目录等，使用Windows Script Host对象可以获得所有的Windows环境参数：

    Dim iw1 As New IWshRuntimeLibrary.IWshShell_Class

    Dim strinfo

    For Each strinfo In iw1.Environment(″Process″)

    List1.AddItem strinfo

    Next

    上面的程序得到当前所有的环境参数并在List1上列出来。

    从上面我的介绍可以看到Windows Script Host对象的确是一个很有用的Windows系统操作对象，易于使用并且功能强大。(微软提供Windows Script Host对象以及另外一个文件操作对象Microsoft Scripting Run的另外一个目的是这两个对象可以在VB Script中建立，这样就可以通过Web执行文件和系统操作了，但是却被一些人利用，例如著名的I Love You 病毒，就是利用Windows Script Host对象操作注册表使自己附身Windows中，在利用Microsoft Scripting Run对象破坏系统文件)

    以上程序用VB6编写，在Windows98、2000下运行通过。


安装向导生成程序组并建立多个程序项

1 在使用安装向导时，加入相应的文件：如Readme，帮助文件等。
2 生成安装程序后，修改 Setup.lst 文件中的[Files]，例如要把 File1 放到程序组中， 修改 File1 的最后两项：
File1 = .... "","" 改为 ->
File1 = .... "程序项名称","应用全路径"
例如：
File1 = .... "工程说明","$(AppPath)\Readme.hlp"
3 [Setup] 中的 DefProgramGroup 为组名。
注意：如果只有一个 File 要求安装，不会建立程序组。


保存复选框选项

选项

在一些情况下，应用程序会用复选框来让用户对某些属性进行设置，并将这些设置保存到磁盘上以供下次使用。下面的程序能让减少处理用户设置所需的代码量。

一个复选框有两种状态，被选中(Checked)或是未被选中(UnChecked)。复选框的二进制的本质使我们能轻松地表示该控件的这两种状态。由于所有的复选框对这两种状态的回应都是一样的，因此把这些复选做为一个控件数组来处理会大大减少编写代码的工作量。

CBO_Click过程

CBO_Click过程通过控件数组的Click事件调用。它有两个常数，来决定复选框应做出怎样的反应。当设置LikeOptions时，一次只能选中一个复选框。当设置AllowNone时，允许用户不选中任何复选框。这两个开关能使复选框数组如同一组选择按钮一样。如果想让这些复选框操作起来象标准的复选框一样，就将LikeOptions设置为False或0，并将AllowNone设置为True或1. 如果想让这些复选框操作起来象一组选项按钮，就将LikeOptions设置为True或1，并将AllowNone设置为False或0。

CBO_Set过程

CBO_Set过程被用来调协复选框的状态。它通过CBO_Click过程调用，来强制一组复选框按照上面两个开关的设置来作出反应。同时它也可被程序员用来将一组复选框设为他所希望的状态。

过程参数

上面的两个过程都要求将对复选框数组的引用及当前正在使用的复选框的索引值作为参数传递给过程。将复选框的引用作为参数传递给过程，可以使这两个过程处理多个复选框数组。数组中所有复选框的当前状态用一个32位的数字来表示，该数字被储存在数组中第一个复选框的Tag属性中。在这里你可以访问些将被存盘以供下一个进程使用的数字。

第二个参数在两个过程中的使用情况和有不同。BO_Click过程需要VB提供复选框的Index值并传递给Click事件。但是CBO_Set过程却使用一个32位的数字。为把二者分开，用Index来保存VB提供的Index参数；CBOIndex用来保存32位的数字。在下面将分析这两个参数是如何使用的。

示例

为了说明这两个过程的功能，在窗体上放置一组复选框和一个文本框。为产生复选框数组，可以先在窗体上放置一个复选框，将其Index属性设为零，然后用拷贝、粘贴的方法产生一个复选框数组。然后输入下面的代码。

Dim CBOBusy As Boolean
Private Sub Check1_Click(Index As Integer)
CBO_Click Check1, Index
Text1 = Check1(0).Tag
End Sub
按F5运行程序，注意在点击复选框时文本框中的变化。我们可以看到对于不同的选择组合，都有一个唯一的值与之对应。这个值就是我们用来存放到磁盘上的，并将其作为CBOIndex参数传递给CBO_Set过程的。

语法

CBO_Click CBOArray, Index
CBO_Set CBOArray, CBOIndex
参数  说明

--------------------------------------------------------------------------------

CBOArray  数组名
Index  必需. 由VB提供的索引值
CBOIndex  必需。32位复合值

--------------------------------------------------------------------------------

代码

Dim CBOBusy As Boolean
Public Sub CBO_Click(CBOArray, Index)
Dim CBOState&, CBOIndex&
'开关
Const LikeOptions = 0
Const AllowNone = 1
If Index 30 Then Err.Raise 6
If CBOBusy Then Exit Sub
CBOBusy = True
'取得当前索引及状态
CBOIndex = 2 ^ Index
CBOState = Val(CBOArray(0).Tag)
'按照开关调整复选框
If CBOState = CBOIndex Then
If AllowNone Then
CBO_Set CBOArray, 0
Else
CBO_Set CBOArray, CBOIndex
End If
ElseIf LikeOptions Then
CBO_Set CBOArray, CBOIndex
End If
'设置新的状态并分配给 Tag
CBOState = Val(CBOArray(0).Tag) Or CBOIndex
If CBOArray(Index).Value = 0 Then CBOState = CBOState - CBOIndex
CBOArray(0).Tag = CBOState
CBOBusy = False
End Sub

Public Sub CBO_Set(CBOArray, CBOIndex&)
Const Log2 = 0.693147180559945
Dim Bit&
If CBOIndex &H7FFFFFFF Then Err.Raise 6
CBOBusy = True
CBOArray(0).Tag = CBOIndex
Bit = 1
On Error GoTo CBOError
Do
CBOArray(Log(Bit) / Log2).Value = Abs((CBOIndex And Bit)>0 )
Bit = Bit + Bit
Loop
CBOError:
CBOBusy = False
End Sub
分析

复选框数组必须使用基于零的连续的索引值以便同32位的数字关联。数组的索引值由VB通过Index参数传递给Click事件，Index与CBOIndex的关系如下：

CBOIndex = 2 ^ Index
Index = Log(CBOIndex) / Log(2)
如果使用了大于30的索引，则会产生致命的错误，因此程序首先检查索引的合法性。如果超过30，就产生一个溢出错误。

设置复选框
在Form_Load事件中初始化复选框。将0赋值给CBOIndex来使所有的复选框处于未被选中的状态。或用其他可接受的数值设置
一个或多个复选框的状态。这个数字可从注册表中读入或从INI文件中读入。


不用OCX来创建自己的控件（一）
让我们以进度条Progress Bar这个通用控件（Common Control）为例。进度条是一个较为简单的Windows通用控件，它为一个操作的时间长短提供了一种图形化的显示方式。要使用该控件 一般是将Comctl32.ocx添加到工程中。Comctl32.ocx是一个超级 OCX,它本身包含了许多其它的控件。
但是如果你只想用进度条而不想用Comctl32.ocx中的其它控件，通常有两种方法可供选择。一种是用VB的PictureBox或 Label控件做一个假的进度条；另一种是自己做一个进度条。

你可以通过引用Comctl32.dll来自己做一个进度条。该动态链接库包含所有的common controls的功能。用Comctl32.dll来创建进度条或其它的common control，控件的定义（它的window风格, API函数,数据结构以及window消息）必须包含进去。common control的定义被储存在Comctl32.dll的头文件Commctrl.h中，你可以用Visual C++读取这些信息或者到微软网站中的某个地方找到。找到这些定义．将其转换为VB风格的声明并应用它们，就是本文所要讲的东西。

下面的例子向你讲述如何在不利用Comctl32.ocx的情况下创建自己的进度条。将下面的代码分别粘贴到工程模块和窗体模块中，为完成该程序，你还需要在你的工程窗体中添加一个命令按钮，名为“Command1”和一个标签控件，名为“Label1”.
Desclare

Declare Sub InitCommonControls Lib "comctl32.dll" ()

Public Const PROGRESS_CLASS = "msctls_progress32"

Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long

' Styles
' The PBS_SMOOTH & PBS_VERTICAL progress bar window styles
' are defined in Comctl32.dll that comes w/ IE3 and later (v4.70).

Public Const PBS_SMOOTH = &H1
Public Const PBS_VERTICAL = &H4
Public Const WS_VISIBLE = &H10000000
Public Const WS_CHILD = &H40000000

Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long

Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Any, lParam As Any) As Long

' Messages
Public Const WM_USER = &H400

' The PBM_SETRANGE message sets the minimum and maximum values
' for a progress bar and redraws the bar to reflect the new range.
' wParam = 0
' lParam = nMinRange Or (nMaxRange * &H10000)
' nMinRange: Minimum range value. By default, the minimum value is zero.
' nMaxRange: Maximum range value. By default, the maximum value is 100.
' Returns the previous range values if successful, or zero otherwise. The
' low-order word specifies the previous minimum value, and the high-order
' word specifies the previous maximum value.

Public Const PBM_SETRANGE = (WM_USER + 1)

' The PBM_SETSTEP message specifies the step increment for a progress bar.
' The step increment is the amount by which the progress bar increases its
' current position whenever it receives a PBM_STEPIT message. By default, the
' step increment is set to 10.
' wParam = New step increment.
' lParam = 0
' Returns the previous step increment.

Public Const PBM_SETSTEP = (WM_USER + 4)

' The PBM_STEPIT message advances the current position for a progress bar by
' the step increment and redraws the bar to reflect the new position. An application
' sets the step increment by sending the PBM_SETSTEP message.
' wParam = 0
' lParam = 0
' Returns the previous position.
' When the position exceeds the maximum range value, this message resets the
' current position so that the progress indicator starts over again from the beginning.

Public Const PBM_STEPIT = (WM_USER + 5)

' The five remaining progrss bar constants not included here (as well as all of the
' other common control definitions) can be found in the file Commctrl.h at:
' http://www.microsoft.com/msdn/sdk/platforms/doc/sdk/headers/c35.htm
' (this URL was current as of 5/20/97)
' End Bas module declares

Code

' Begin Form module code:

Private Sub Form_Load()

    ScaleMode = vbPixels

    Command1.Caption = "Do stuff..."

End Sub

Private Sub Command1_Click()

' Dynamically creates a 15 pixel wide vertical progress bar and
' places it at the right of the form, does stuff that takes a while &
' shows the progress, then destroys the progress bar.

Dim hProgBar As Long
Dim dwIncrement As Long
Dim dwIdx As Long
Dim vDummy As Variant
Static bRunning As Boolean

On Error GoTo Out

    ' Allows this proc to cancel itself
    If bRunning Then bRunning = False: Exit Sub

    ' Make sure the library is loaded
    InitCommonControls

    ' Create the progress bar using the standard window styles
    ' and the two new IE3 progress bar styles, smooth & vertical.
    ' Addition standard or extended window styles can be specified
    ' to alter the default appearance of the progress bar.

    hProgBar = CreateWindowEx(0, PROGRESS_CLASS, vbNullString, WS_CHILD Or WS_VISIBLE Or     PBS_SMOOTH Or PBS_VERTICAL, ScaleWidth - 15, 0, 15, ScaleHeight, hWnd, 0, App.hInstance, ByVal 0)

    If hProgBar = 0 Then MsgBox "Uh oh...": Exit Sub

    ' Here we go...

    bRunning = True

    Command1.Caption = "Cancel"

    ' Set the range of the progess bar.

    ' 0 (lParam low word) to &H4FFF (lParam high word).

    SendMessage hProgBar, PBM_SETRANGE, 0, ByVal (&H4FFF * &H10000)

    ' Set the value of the highlight increment. We''ll go w/ 100 itins here.
    ' The width and number of progress blocks are determined by the
    ' progress bar's width & height.

    dwIncrement = &H4FFF \ 100

    SendMessage hProgBar, PBM_SETSTEP, ByVal dwIncrement, 0

    ' Let's do some stuff...

    For dwIdx = 1 To &H4FFF

        DoEvents

        If Not bRunning Then Exit For

        vDummy = vDummy & Format(Chr(Asc(Trim(Left("a", InStr(1, "a", "a", 1)))))) '\___/'

        If dwIdx Mod dwIncrement = 0 Then

            ' Advance the current position of the progress bar by the step increment.

            SendMessage hProgBar, PBM_STEPIT, 0, 0

            Label1 = dwIdx \ dwIncrement & "%"

        End If

    Next

Out:

    ' Frees all resources associated with the progress bar.

    If IsWindow(hProgBar) Then DestroyWindow hProgBar

        bRunning = False

    Command1.Caption = "Do stuff..."

    Label1 = ""

End Sub

' End Form module code


成组更新控件属性

下面是成组更新 Enabled 属性的例子：
Sub EnableAll(Enabled As Boolean, ParamArray objs() As Variant)
Dim obj As Variant
For Each obj In objs
obj.Enabled = Enabled
Next obj
End Sub
应用：
EnableAll True, Text1, Text2, Command1, Command2


创建数据驱动窗体

所谓数据驱动窗体就是根据所请求的数据的不同生成相应的窗体。举例来讲，假设你现在有一个数据库，其中有些字段必须根据登录者的身份加以显示，授权级别高的用户可以浏览并修改这些字段的内容；授权级别一般的用户只能浏览这些字段中的数据；授权级别低的用户则不能浏览这些字段中的内容。要做到这一点就得利用VB动态添加控件的功能。

动态创建控件

无论你想要创建何种类型的数据驱动窗体，你必须知道如何在运行时动态地创建控件。你可以通过控件数组做到这一点，但VB6的Controls集合所提供的Add方法，功能更强大，灵活性更高。使用该方法，你不需要在设计时将控件的实例放在窗体上。实际上，用Add方法你甚至可以创建程序在编译时根本不存在的控件。这种方法的用法也很简单：

' 声明一个窗体级的变量
Dim WithEvents txtTotal As TextBox

Sub CreateTextbox()
   ' 创建新的Textbox控件
   Set txtTotal = Controls.Add("VB.TextBox", "txtTotal")
   ' 将控件移动到你所需要的地方
   txtTotal.Move 1000, 800, 1200, 300
   ' 创建时，所有的控件都是不可见的
   txtTotal.Visible = True
End Sub
请注意Add方法的第二个参数：分配给控件的名称。从代码可读性出发，这个名称一般都与变量名相同。你可以用这个名称从Controls集合中获取相应的控件或移除该控件。例如：

Controls.Remove "txtTotal"

在变量声明时加上WithEvents关键字，即使在设计时窗体不存在该控件，你也可以为该控件的事件编写代码。

上面所讲的方法只适合解决VB内置的控件。例如，当你要添加一个TreeView控件时，VB会要求你证明你已经得到了合法的授权来创建该控件的实例。换句话说，VB要证明这个控件是买来的，而不是从其它附有该控件的程序中借来的。

要证明你经过了合法的授权有下面几种方法：

在窗体上放置一个控件。这也是最简单的方法。你完全没有必要将这个窗体显示出来。
将相关的控件添加到工具箱中，然后在“工程属性”对话框的“生成”标签页中取消选择“删除有关未使用的ActiveX控件的信息”这一项。
向Licenses集合添加一个元素。例如：Debug.Print Licenses.Add("MSMask.MaskedEdBox")
仅仅创建了控件并不足够

要创建一个数据驱动窗体，仅仅知道动态创建控件还不够。例如：现在你要创建一个能根据数据库中表的不同字段自动生成控件的窗体。该窗体可能会创建单行文本框，其长度随字段长度不同而不同；也可能会创建单选按钮或复选按钮以显示布尔型字段；甚至可能创建一个多行文本框显示备注型字段。

你需要解决的第一个问题是：文本框控件的Multiline属性在运行时是只读的，只在设计时可用。幸好，微软的Microsoft Windowless Controls 6.0可以解决这个问题。这组控件集包括了轻量级的TextBox,ComboBox,ListBox,CheckBox,OptionButton,CommandButton和两个scrollbar控件。这些控件与VB内置的相应的控件最大的区别在于：这些控件的所有属性在运行时是可读写的。在VB的安装光盘中的Common\Tools\VB\WinLess文件夹中可以找到这个控件组。用下面的代码可以创建一个多行文本框：

Dim WithEvents txtEditor As  MSWLess.WLText

Private Sub CreateEditor()
   Set txtEditor = Controls.Add( "MSWLess.WLText", "txtEditor")
   txtEditor.Move 0, 0, 4000, 4000
   txtEditor.MultiLine = True
   txtEditor.ScrollBars = wlBoth
   txtEditor.Visible = True
End Sub
另外一个问题比较复杂：在事先不知道要创建多少个控件的情况下，如何给每个对新创建的控件的引用分配唯一的带WithEvents关键字的变量。换句话说就是要对新创建的控件的事件进行编程，前提是你在设计时不知道程序会创建多少个控件。使用对象数组显然不行，因为不能用WithEvents关键字声明一个对象数组；更坏的情况是，资一个变量定义为As Control或As Object也不行，因为还是不能用WithEvents。

问题源自于我们无法在运行时捕获一个对象数组事件。所以我们只能采取曲线救国的办法。所要的编写的代码可能比你想象的多，不过这个解决方法很有趣，值得我们这样去做。

我们需要两个辅助类模块来捕获事件，分别取名为ControlItems和ControlItem。ControlItems是一个集合类，其中保存了ControlItem对象及其数量。该数量等于你所要对之编程的控件的数量。ControlItem类的每一份实例捕获控件产生的事件，然后调用在其所属的ControlItems集合类中的过程，最后由ControlItems在窗体中触发事件并执行事件中的代码。整个过程如下图所示：

捕获多个控件的事件

为简单起见，假设你要捕获来自所有的动态添加到窗体上去的控件的Validate事件。为完成这个工作，ControlItems集合类必须向父窗体展示该事件，并随时准备接收来自其子ControlItem类的通知以触发事件。代码如下：

Event Validate(CtrlItem As ControlItem, Cancel As Boolean)
Private m_ControlItems As New Collection

' 向集合中添加一个新的ControlItem项目
Function Add(ctrl As Control) As ControlItem
   Dim newItem As New ControlItem
   newItem.Init ctrl, Me
   ' 添加到私有类
   m_ControlItems.Add newItem
   ' 返回新项目给调用者
   Set Add = newItem
End Function

Friend Sub Notify_Validate(Item As ControlItem, Cancel As Boolean)
   RaiseEvent Validate(Item, Cancel)
End Sub
ControlItem类必须捕获来自动态添加到窗体中的控件的事件，并通知其所属的ControlItems集合类。很显然，ControlItem类必须有一个用WithEvents关键字定义的变量来引用真正的控件。这意味着你不能将变量声明为As Control或As Object。如果你决定在窗体中所动态添加的控件不使用ＶＢ内置的控件的话，这个问题的解决办法相当的简单。你只需要将变量声明为VBControlExtender类型就行了。对于创建数据驱动窗体来讲，不使用ＶＢ内置的控件并不是一件大不了的事。

将变量声明为VBControlExtender，并加上WithEvents关键字，你就能直接捕获Validate,GotFocus,LostFocus,DragDrop和DragOver这几个事件了。如果要捕获其它更多的事件，你可以使用ObjectEvent。下面是ControlItem类模块中的代码：

Public WithEvents Ctrl As VBControlExtender
' 所属的ControlItems对象
Dim m_Parent As ControlItems

Sub Init(ctl As Object, parnt As ControlItems)
   Set Ctrl = ctl
   Set m_Parent = parnt
End Sub

Private Sub Ctrl_Validate(Cancel As Boolean)
   ' 通知所属的ControlItems类
   m_Parent.Notify_Validate Me, Cancel
End Sub
将下面的代码放入窗体中，就可以捕获动态添加的控件所产生的事件了：

Dim WithEvents CtrlItems As New ControlItems

Private Sub cmdCreateControls_Click()
   Dim ctrl As Control
   ' 创建两个文本框并将它们添加到ControlItems集合?   Set ctrl = Controls.Add("MSWLess.WLText", "One")
   ctrl.Move 100, 200, 1000, 300
   ctrl.Visible = True
   CtrlItems.Add ctrl
   ' 注意你可以使用同一个变量
   Set ctrl = Controls.Add("MSWLess.WLText", "Two")
   ctrl.Move 100, 800, 1000, 300
   ctrl.Visible = True
   CtrlItems.Add ctrl
End Sub

Private Sub CtrlItems_Validate( CtrlItem As ControlItem, Cancel As Boolean)
   ' 拒绝空字符串 - 注意如何引用控件的属?   If CtrlItem.Ctrl.Text = ""
   Then Cancel=True
End Sub

现在解决了最困难的部分，要创建一个数据驱动窗体就变得简单了


得到鼠标位置

声明：
Private Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

例子：
Dim p As POINTAPI
Call GetCursorPos( p )
' ( p.x, p.y )为鼠标位置


调整 Combo 下拉部分的宽度
声明：
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (
ByVal hwnd As Long, ByVal Msg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_ERR = -1
函数：
' 取得 Combo 下拉的宽度
' 可以利用该函数比例放大或缩小宽度
Public Function GetDropdownWidth(cboHwnd As Long) As Long
Dim lRetVal As Long
lRetVal = SendMessage(cboHwnd, CB_GETDROPPEDWIDTH, 0, 0)
If lRetVal <> CB_ERR Then
GetDropdownWidth = lRetVal
'单位为 pixels
Else
GetDropdownWidth = 0
End If
End Function
'设置 Combo 下拉的宽度
'单位为 pixels
Public Function SetDropdownWidth(cboHwnd As Long, NewWidthPixel As Long)
As Boolean
Dim lRetVal As Long
lRetVal = SendMessage(cboHwnd, CB_SETDROPPEDWIDTH, NewWidthPixel, 0)
If lRetVal <> CB_ERR Then
SetDropdownWidth = True
Else
SetDropdownWidth = False
End If
End Function


动态加入控件到VB控件数组中
湖北省襄樊市劳动保险处
闫东
---- VB为我们提供了一种特殊的控件，就是控件数组。控件数组是共享控件名称、类型和事件的控件组，与可实现相同功能的多个控件相比，它们使用了更少的资源。有的时候，你或许会想在程序运行时动态的在控件数组中加入一个控件，如一个按钮。这时，你可以使用Load语句，语法如下： Load Object(Index)

---- 这里的Object 是指控件数组名称，Index是你想增加的控件的索引号。为了要在运行时刻动态加入一个控件到控件数组中，你必须保证控件数组中至少有一个控件（可以将控件的Index属性设为0）。需要注意的是VB仅仅允许一个控件数组中包含32767个控件。

---- 例如，假设在一个表单中有一个按钮控件数组名为cmdBtn。在它们的Click事件中，你将要加入新的按钮到表单中。打开一个新的工程并加入一个按钮到默认的表单中，设置按钮的Index属性为0。当你这样做了之后，VB就会将这个按钮转变成按钮数组。然后，加入下面的代码到程序中：

Private Sub cmdBtn_Click(Index As Integer)
    Dim btn As CommandButton
    Dim iIndex As Integer
    iIndex = cmdBtn.Count
    If iIndex <= 32767 Then
        Load cmdBtn(iIndex)
        Set btn = cmdBtn(iIndex)
        With btn
            .Top = cmdBtn(iIndex - 1).Top + 620
            .Caption = "Command" & iIndex + 1
            .Visible = True
        End With
        Set btn = Nothing
    End If
End Sub
---- 运行程序并点击按钮，程序就会在表单中增加新的按钮。


对ListView中的列排序

设置 ListView 控件到 report 视图。下面的代码允许你使用
任何的列进行排序，主要在列头上点击。
如果已经排序，顺序将反一下。

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
With ListView1
If (ColumnHeader.Index - 1) = .SortKey Then
.SortOrder = (.SortOrder + 1) Mod 2
Else
.Sorted = False
.SortOrder = 0
.SortKey = ColumnHeader.Index - 1
.Sorted = True
End If
End With
End Sub


放一个Combo到Toolbar中
1. 放一个 ComboBox 到表单.
2. 放一个 Toolbar?在表单.
3. 增加下面的代码到 Form1 :
Private Sub Form_Load()
Dim btn As Button
Me.Show
Set btn = Toolbar1.Buttons.Add()
btn.Style = tbrSeparator
Set btn = Toolbar1.Buttons.Add()
btn.Style = tbrPlaceholder
btn.Key = "ComboBox"
btn.Width = 2000
With Combo1
.ZOrder 0
.Width = Toolbar1.Buttons("ComboBox").Width
.Top = Toolbar1.Buttons("ComboBox").Top
.Left = Toolbar1.Buttons("ComboBox").Left
End With
End Sub


改变 ListIndex而不发生 Click 事件
在修改 Combo 或 Listview 的ListIndex 时， 会发生 Click 事件， 下面的
函数可以阻止该事件。
声明：
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (
ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long
Const CB_GETCURSEL = &H147
Const CB_SETCURSEL = &H14E
Const LB_SETCURSEL = &H186
Const LB_GETCURSEL = &H188
函数：
Public Function SetListIndex(lst As Control, ByVal NewIndex As Long) As
Long

If TypeOf lst Is ListBox Then
Call SendMessage(lst.hWnd, LB_SETCURSEL, NewIndex, 0&)
SetListIndex = SendMessage(lst.hWnd, LB_GETCURSEL, NewIndex, 0&)
ElseIf TypeOf lst Is ComboBox Then
Call SendMessage(lst.hWnd, CB_SETCURSEL, NewIndex, 0&)
SetListIndex = SendMessage(lst.hWnd, CB_GETCURSEL, NewIndex, 0&)
End If
End Function


改变 TreeView 的背景

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = -16&
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&

Dim frmlastForm As Form

Private Sub Form_Load()
Dim nodX As Node
Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
nodX.EnsureVisible
TreeView1.style = tvwTreelinesText ' Style 4.
TreeView1.BorderStyle = vbFixedSingle
End Sub

Private Sub Command1_Click()
Dim lngStyle As Long
Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0))
'改变背景到红色

lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)
End Sub


改进ＶＢ的驱动器列表框

信 阳 师 范 学 院 计 算 机 系
董 建 军

Ｖ Ｂ 是 一 个 高 效 快 捷 的 ＷINDOWS 应 用 程 序 开 发 工 具， 倍 受 人 们 青 睐。 然 而， Ｖ Ｂ 也 有 其 局 限 性， 部 分 控 件 不 够 完 善， 许 多 事 件 和 属 性 没 有 提 供， 又 加 上 Ｖ Ｂ 自 身 的 封 闭 性（ 不 允 许 自 我 创 建 对 象）， 使 得 我 们 很 难 开 发 出 具 有 一 定 特 色 的 程 序， 如 Ｖ Ｂ 的 驱 动 器 列 表 框 便 是 一 例。
在 要 求 不 高 的 情 况 下， Ｖ Ｂ 的 驱 动 器 列 表 框 能 很 好 的 胜 任 其 工 作。 在 使 用 它 时 候， 一 般 在 其 CHANGE 事 件 中 加 入 以 下 代 码， 用 以 改 变 当 前 路 径， 从 而 带 动 目 录 列 表 框： DIR.PATH= DRIVE1.DRIVE
其 中 DIR1、DRIVE1 分 别 是 驱 动 器 列 表 框 和 目 录 列 表 框 的 名 字（NAME 属 性， 以 下 同）。 这 样， 在 运 行 时 只 要 从 驱 动 器 列 表 框 中 任 选 一 项（ Ａ：、 Ｂ：、 Ｃ：、...）， 目 录 列 表 框 中 的 内 容 便 会 跟 着 变 动。
然 而， 事 情 远 不 象 它 显 示 的 那 么 简 单， 在 程 序 运 行 时 可 能 会 出 现 以 下 情 况：

⑴、 如 果 驱 动 器 中 没 有 磁 盘 便 会 产 生 运 行 时 错 误， 从 而 导 致 整 个 程 序 运 行 终 止， 这 是 我 们 所 不 想 见 到 的。 这 时 有 必 要 在 CHANGE 事 件 中 加 入 出 错 处 理：
SUB DRIVE1.CHANGE ()
DIM BACK%
ON ERROR GOTO ERRHANDL
DIR1.PATH=DRIVE1.DRIVE
EXIT SUB
ERRHANDL:
BEEP
'显示惊叹号图标和 RETRY ,CANCLE按钮
BACK=BMSGBOX (ERROR(ERR),5 OR 48,"错误")
IF BACK=4 THEN '按下 RETRY按钮
RESUME
ELSE
RESUME NEXT
ENDIF
EXIT SUB
END SUB
在 这 种 情 况 下， 当 错 的 时 候， 往 驱 动 器 中 插 入 磁 盘 并 按 下 REYRY 按 钮， 程 序 得 以 正 确 运 行； 若 按 下 CANCEL 按 钮 就 会 出 现 以 下 问 题：

目 录 列 表 框 的 当 前 内 容 没 有 发 生 改 变， 而 驱 动 器 列 表 框 的 内 容 则 为 刚 才 选 中 的 驱 动 器， 也 即 驱 动 器 列 表 框 和 目 录 列 表 框 的 内 容 没 有 指 向 同 一 磁 盘， 这 当 然 是 我 们 所 不 能 容 忍 的。 原 因 在 于 这 个 出 错 处 理 过 程 是 加 在 CHANGE 事 件 中 的， 而 CHANGE 事 件 是 在 当 前 驱 动 器 发 生 变 化 以 后 才 产 生 的。 如 果 驱 动 器 列 表 框 有 CLICK 事 件 的 话， 那 么 问 题 便 迎 刃 而 解 了。
⑵、 若 更 换 软 驱 中 的 磁 盘， 再 次 选 中 当 前 驱 动 器 进 行 目 录 列 表 时， 则 驱 动器 列 表 框 和 目 录 列 表 框 中 的 内 容 不 会 有 变 动， 仍 为 上 一 张 盘 的 内 容，


给TreeView控件添加弹式菜单

如果你想为你的应用程序添加类似于Windows资源浏览器的功能的话，相信你十有
八九会用到TreeView控件。问题在于TreeView控 件不支持标右键菜单。要想告诉
你的程序鼠标在哪一个节点处单击了右键，从而引发NodeClick事件，并不是件容
易的事。

下面的这段代码利用TreeView的MouseUp事件，捕获特定节点处的鼠标右键单击，
从而使你能为那个节点弹出定制的菜单。

代码如下：

Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As
Single, y As Single)

Dim nod As Node

If Button = vbRightButton Then

Set nod = TreeView1.HitTest(x, y)

On Error GoTo EmptyNode

nod.Selected = True

On Error GoTo 0

'<<下面是你的自定义菜单>>

Me.PopupMenu mnuPopUp

EmptyNode:

On Error GoTo 0

End If

End Sub


功能强大的增强列表框 ――VB6控件LISTVIEW使用指南
作者：河南省南召县人民政府计划委员会
邹刚
---- VB6无疑是当前最先进的编程工具之一,无论是它的代码编写还是与视窗98的完美结合, 都令人们特别是程序员们赞叹不已。在这里,我将自己在编程实践中对LISTVIEW控件的一些使用经验和心得体会与广大的同仁们作以探讨,希望大家批评指正,或者有所借鉴。

---- 在VB6专业版或者企业版中,LISTVIEW控件并不是默认的工具箱的配置项目,你必须要手工添加---单击"工程"菜单项目,选择"部件",在部件对话框的"控件"栏目中选择"MICROSOFT WINDOWS COMMON CONTROLS 6.0",确认在它前面的复选框中有一个黑色的对号,单击"确认" 按钮,这时你的工具箱中便添加了几个控件,其中,有五个空心圆圈的便是LISTVIEW控件了, 当然怎么把它添加到窗体上就不用我多说了吧。

---- 我个人认为,作为一个增强功能的列表框,它的本质是用来显示更多的信息的.因此, 在这篇文章中,我着重介绍它VIEW属性的LVWREPORT(报表)值的使用.至于它的外观怎样设计,诸位当然可以随心所欲了.为了直观一点,我举一个应用实例来说明。

---- 设计完成后的主界面参见图一,它实际上是一个增强功能的文件浏览器。

---- 首先新建一个标准EXE工程,主窗体名称为FRMMAIN,添加一个驱动器列表框DRIVE1,一个文件列表框FILE1（设置VISIBLE属性FALES，PATTERN属性(*.EXE；*.DLL)），一个目录列表框DIR1,一个增强列表框LISTVIEW1,一个IMAGE控件IMAGE1和一个IMAGELIST控件IMALIST1，在IMALIST1控件上单击右键,设计IMAGELIST控件，添加一个你最喜欢的图标（最好使用ICON图标），索引为一。在主窗体FRMMAIN的通用声明段输入以下代码：

Dim clmX As ColumnHeader；标题栏
Dim itmX As ListItem；列表项目
Dim Counter As Long；计数器
Dim Fname As String；读取文件名
Dim dname As String；增强列表框完整路径名称
Public CurrentDir As String；完整的目录名称
在主窗体的LOAD事件中写入以下代码：
Private Sub Form_Load()
Me.Caption = App.Title;
窗体的标题为生成可执行文件的标题
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2；
窗体位置在屏幕中间
ListView1.ColumnHeaders.Add ,
, "文件名称",ListView1.Width / 3, 0
’第一个标题栏是“文件名称“,长度为ListView1
宽度的三分之一,文字左对齐
Set clmX = ListView1.ColumnHeaders.Add(,
, "序号", ListView1.Width / 5, 2)
’第二个标题栏是“序号“ 依次往下
Set clmX = ListView1.ColumnHeaders.Add(,
, "文件大小 ", ListView1.Width / 4, 1)
Set clmX = ListView1.ColumnHeaders.Add(,
, "创建时间", ListView1.Width / 3, 0)
ListView1.BorderStyle = ccFixedSingle；边界类型
ListView1.SmallIcons = ImageList1 ；
关联图标仓库ImageList1
For Counter = 0 To File1.ListCount - 1
Fname = File1.List(Counter)；
获取当前目录下符合条件的文件名
Set itmX = ListView1.ListItems.Add(,
, Fname)’文件名称栏目
itmX.SubItems(1) = CStr(Counter + 1) +
"/" + CStr(File1.ListCount)’文件在列表框位置
itmX.SubItems(2) = CStr(FileLen(Fname))；
文件长度
itmX.SmallIcon = 1；列表项目图标
itmX.SubItems(3) = Format(FileDateTime(Fname),
"hh:mm yyyy/MMMM/dd")；文件创建时间
Next Counter
ListView1.View = lvwReport;报表类型
ListView1.Arrange = 0
ListView1.LabelWrap = False
Dir1.ToolTipText = "当前目录是:" & Dir1.Path
END SUB
双击驱动器列表框，输入以下代码：
Private Static Sub Drive1_Change()
On Error GoTo IFerr;拦截错误
Dir1.Path = Drive1.Drive；关联目录列表框
Exit Sub
IFerr:；如果磁盘错误
MsgBox ("请确认驱动器是否准备好或者磁盘已经不可用!"),
vbOKOnly + vbExclamation
；弹出注意对话框
Drive1.Drive=Dir1.Path；忽略驱动器改变
End Sub
双击目录列表框，输入以下代码：
Private Static Sub Dir1_Change()
File1.Path = Dir1.Path；关联文件列表框
If Right(Dir1.Path, 1) < > "\" Then
CurrentDir = Dir1.Path & "\"
Else
CurrentDir = Dir1.Path
End If；设置选定的目录名称
ListView1.ListItems.Clear；清除过期的列表项目
For Counter = 0 To File1.ListCount - 1
Fname = File1.List(Counter)
Set itmX = ListView1.ListItems.Add
(, , Fname);添加文件名
itmX.SubItems(1) = CStr(Counter + 1) + "/"
+ CStr(File1.ListCount)
itmX.SubItems(2) = CStr(FileLen(CurrentDir & Fname))
itmX.SmallIcon = 1
itmX.SubItems(3) = Format(FileDateTime(CurrentDir
& Fname), "HH:MM YYYY/MMMM/DD")
Next Counter；添加增强列表框的各个项目
Dir1.ToolTipText = "当前目录是:" & Dir1.Path；提示
End Sub

---- 通过以下代码取得鼠标单击增强列表框返回的项目名称：
Private Sub ListView1_ItemClick(ByVal Item As
MSComctlLib.ListItem)
allfname = Item;文件名
dname= CurrentDir& Item;完整的路径和文件名
sElectmain = ListView1.SelectedItem.Index;文件序号
End Sub

---- 好了,只要在经过适当的完善,一个增强功能的文件浏览器就制作完成了，你是不是很满意。
---- 当然，增强列表框的功能远远不止这些，而且,它能反映出的信息更多,但作为文件浏览功能的实现，上述的操作已经足够了，读者如有兴趣，完全可以自己探索、发掘，相信你一定会成功的。


计算从开机到现在用了多少秒

下面的程序与标准的Timer控件相比，有两个同的地方：

1。该程序计算的起点是系统启动的时间，而不是从午夜开始算起。如果你想从午夜开始算起，用(Now-Int(Now))*86400这条语句就行了。

2。精度更高，标准Timer控件的Tick频率为1KHz,而该程序为1.4MHz

下面是程序的源代码：

Option Explicit

Private Declare Function osQueryPerformanceCounter Lib "Kernel32" Alias "QueryPerformanceCounter" _ (lpPerformanceCount As Currency) As Long

Private Declare Function osQueryPerformanceFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (lpFrequency As Currency) As Long

Public Function Timer() As Single

Dim freq As Currency, count As Currency

osQueryPerformanceFrequency freq

osQueryPerformanceCounter count

Timer = count / freq

End Function

需要说明的一点是，如果你查阅API手册，你会发现API并不能识别Currency数据类型。在API手册中，osQueryPerformanceFrequencey要求的参数是一个Large_Integer的数据结构，该数据结构由两个Long类型的数据组成。Currency实际上也是按同样的方法来储存的。只不过在计算时被除以10000。因此你也可以写成：, (freq/10000) / (count/10000) = freq/count。关于上面的两个API函数，osQueryPerformanceFrequecy表示一秒内，计时器Tick了多少次；osQueryPerformanceCounter表示从开机到现在，计时器一共Tick了多少次。二者相除，就是从开机到现在过去了多少秒钟。


将立体的ListView标题栏转换成平面式的标题栏

当你想将你的ListView控件的标题栏变为平面式且对鼠标单击不做出反应的话，就
试试下面的代码吧。通常立体的标题栏会让用户认为这一栏的数据可以排序。如果
改成平面式的，用户就不会这样想了。

Private Declare Function GetWindowLong Lib "user32" Alias "
GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "
SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (
ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long

Private Const GWL_STYLE = (-16)
Private Const LVM_FIRST = &H1000
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const HDS_BUTTONS = &H2

Call ToggleHeader(ListView1.hWnd)

Private Sub ToggleHeader(lsvhWnd As Long)

Dim hHeader As Long, lStyle As Long

hHeader = SendMessage(lsvhWnd, LVM_GETHEADER, 0, ByVal 0&)

lStyle = GetWindowLong(hHeader, GWL_STYLE)

SetWindowLong hHeader, GWL_STYLE, lStyle Xor HDS_BUTTONS

End Sub


禁用窗体上所有控件

Dim i As Integer
For i = 0 To Form1.Controls.Count - 1
Form1.Controls(i).Enabled = False
Next i

另一种方法是：

Dim ctrTemp As Control
For Each ctrTemp In Me.Controls
ctrTemp.Enabled = False
Next


拷贝或移动列表框或组合框中的内容

在做数据据库程序时，通常会要求用户将数据从一个列表框移动到别一个列表框中。下面的子程序可以让你轻松实现这一功能。同时还提供参数，指定操作是移动数据(不保留原数据)，还是拷贝数据(保留数据的副本在原列表框或组合框中)；并且还可以选择是全部移动或拷贝数据，还是只移动或拷贝用户选定的部分。

参数 值 说明
FromCtl 源列表框或组合框名 源列表框或组合框
ToCtl 目的列表框或组合框名 目的列表框或组合框
strMode   可选参数，默认情况下只拷贝选中的项目
－ 移动选中的项目
ALL 拷贝所有的项目，不需选中
－ALL 移动所有的项目，不需选中

源程序如下：

Public Sub CopyComboList(FromCtl As Control, ToCtl As Control, Optional strMode As String)

On Error Resume Next

Dim intN As Integer

Screen.MousePointer = vbHourglass

If strMode <> "" Then
strMode = UCase(strMode)
End If

With FromCtl

If TypeName(FromCtl) = "ListBox" Then
For intN = .ListCount - 1 To 0 Step -1
If .Selected(intN) Or InStr(strMode, "ALL") Then
ToCtl.AddItem .List(intN)
ToCtl.ItemData(ToCtl.NewIndex) = .ItemData(intN)
If InStr(strMode, "-") = 1 Then
.RemoveItem (intN)
End If
Next
Else
For intN = .ListCount - 1 To 0 Step -1
ToCtl.AddItem .List(intN)
ToCtl.ItemData(ToCtl.NewIndex) = .ItemData(intN)
If InStr(strMode, "-") = 1 Then
.RemoveItem (intN)
Next
End If
End With

Screen.MousePointer = vbDefault

End Sub


利用VB5开发ActiveX控件

我们可以利用Visual C++ 4.0来开发自己的ActiveX控件,但是开发比较复杂。微软新发表的Visual Basic 5.0是一个极好的开发工具。过去我们使用VB4就已经觉得相当不错,新的VB5则在技术上变得更加完善,现在一般的程序员也能利用VB5开发各种ActiveX程序,包括Active.EXE,Active.DLL,Active Control以及Active Document。

一、利用VB5开发ActiveX控件的实例

假设我们要设计这样一个控件,它包含一个Label控件和一个Picture控件,但在同一时间两者只显示一个:即当Label显示时,它显示的是图像的文件名,Picture不显示;当Picture显示时,它显示的是图像的内容,Label不显示。通过鼠标的单击操作在两者之间切换。这个控件的好处是在显示包含有图像的文本文件时简洁明了,能充分地利用显示区域。

制作这个控件我们需要使用VB中的常用控件Label和Picture,要给它赋予一个Caption的属性,还要自己编制一个Click事件的过程函数。具体的开发过程如下。

1.运行VB5,在File菜单中选择New Project建立一个新的项目,这时会弹出一个New Pro ject对话框,与VB4只有一种项目类型不同的是,VB5的项目类型有很多种,在此我们选择ActiveX Control类型。

这时在Project Explorer窗口出现了一个Project1的项目,其中的User Controls中已包含有一个User Control1的控件。可以在Properties窗口里去修改User Control1的有关属性,如Name等。

为了调试的方便,我们可以在File菜单中选Add a Project,建立一个Standard Exe类型的Project和刚才的Project1一起形成一个Project Group,本文中省略相关步骤。

2.双击Project Explorer窗口中User Control1把它激活,然后从工具箱中把Label控和Picture控件添加到设计窗口当中。在进行控件设计时,Resize事件是一个相当重要的事件,它既发生在窗体设计时,也可以在程序运行时被执行,以控制控件的大小,我们把以下程序段加入到User Control1的代码窗口当中:

Private Sub UserControl-Resize()

Label1.Move 0,0, Scale Width, ScaleHeight

Picture1.Move 0,0, Scale Width, ScaleHeight

End Sub

3.然后我们要给这个ActiveX控件加一个Caption属性。打开Tools菜单,单击AddProce dure,在随后出现的对话框中设置Name为Caption,单击Property和Public项后再单击OK。

在代码窗口中加入以下有关代码:

Public Property Get Caption() As String

Caption=Label11.Caption

End Property

Public Property Let Caption(ByVal NewCaption As String)

Label1.Caption=NewCaption

PropertyChanged "Caption"

End Property

Private Sub UserControl-InitProperties()

Caption=Extender.Name

End Sub

Private Sub UserControl-ReadProperties(ProBag As PropertyBag)

Caption=PropBag.ReadProperty("Caption", Extender.Name)

Set Picture1.Picture=LoadPicture(Caption)

End Sub

Private Sub UserControl-WriteProperties(PropBag as PropertyBag)

PropBag.WriteProperty "Caption",Caption,Extender.Name

End Sub

4.有了控件的属性,下面我们就要为这个控件编写事件过程,本文的例子较为简单,只写一个Click事件过程。

先激活User Control1的代码窗口,为了避免变量名称及事件名称与其他事件过程或是子程序的名称发生冲突,我们把以下代码加入到Declarations当中去:

Option Explicit

Public Event Click()

然后选择Label1,加入以下代码:

Private Sub Label1-Click()

Label1.Visible=False

Picture1.Visible=True

RaiseEvent Click

End Sub

再选择Picture1,加入以下代码:

Private Sub Picture1-Click()

Picture1.Visible=False

Label1.Visible=True

RaiseEvent Click

End Sub

这样,我们就已经编制好了一个简单的ActiveX控件,可以在其他支持ActiveX技术的软件当中使用这个控件了。使用这个控件时,先给它赋予Caption属性,即输入图形文件的完整的文件名,它就显示这个文件名,当鼠标单击它时,它就把图形内容显示出来,以后再单击时,则依次在这两者之间切换。

   二、ActiveX控件的运用

运用ActiveX控件的第一步是编译当前的项目以生成OCX文件。打开File菜单,选择Make User Control1.ocx项,经过编译之后,在当前目录下就生成文件User Control1.ocx,为了使用的方便,我们最好把这个文件拷贝到WIN95\SYSTEM目录下。

1.ActiveX控件在VB5中的运用

我们生成的ActiveX控件可以在VB5程序设计中像其他常用控件一样使用,例如:

(1)打开File菜单,选择建立一个新的Standard.Exe类型的Project。

(2)打开Project菜单,单击Component,在随后弹出的对话框中的Control项中找到我们刚才编制的User Control1控件,选中并单击OK。

(3)在工具箱里可以看到已多了一个新的ActiveX控件,这时就可以像使用其他控件一样地使用它了。但不要忘记设置好控件的Caption属性。

2.ActiveX控件在Visual FoxPro 5.0中的运用

在VB5中编写的ActiveX控件也可以在其他支持ActiveX技术的软件当中使用。同样是微软公司产品的Visual FoxPro在其新发表的5.0版本中开始支持ActiveX技术。Visual FoxPro在数据库技术方面功能十分强大,但进行某些界面的程序设计时,不能使人感到得心应手。

利用ActiveX技术,我们可以把两者的长处结合起来,在两者之间取长补短。假如我们要在Visual FoxPro中使用刚才编制的User Control1控件,具体过程如下。

(1)在Tools菜单中选Option项。在随后弹出的对话框中,选Control项,再在其中选ActiveX Control,然后在列表框中找到我们刚才编写的User Control1控件,选中并单击OK。

(2)在File菜单中选择建立一个New From。

(3)打开Form Control Toolbox,这时一般出现的是一些常用控件,如Label, Textbox等。我们单击其中的View Classes图标,选择ActiveX Control项,就可以看到包括User Contr ol1控件在内的诸多ActiveX控件。

(4)单击User Control1控件放置在窗体设计器中,并在Properties窗口里设置好其Caption属性,就可以像使用其他常用控件那样使用我们自己编制的ActiveX控件了。 从以上实例可以看到,ActiveX技术是一项很有前途的技术。它在不同的编程语言之间架起了一座桥梁,方便了编程者,扩展了各种编程语言的开发程序的能力。


利用VB三维面板控件设计流动条

VB提供了一个三维面板控件，利用这个控件可设计图形效果的立体界面，从而使应用程序的界面显得更生动、美观，该控件还可以设置各种形式的背景，然后在背景上显示各种形式的字符，令人感兴趣的是，使用三维面板控件，还可设计我们经常在安装程序中看到的表示安装进程的流动条，并可显示进程百分比，改变流动条的颜色等。
    一、介绍属性
    FloodColor：确定流动条的颜色，缺省为蓝色。
    FloodPercent：显示当前过程如流动条进行的百分比，参数改变时显示的百分数和流动条的面积改变，设为一整型值，取值范围是0～100。
    FloodShowpct：决定是否在三维面板控件上显示百分比，是一个逻辑值。为True时显示，为False时不显示。
    FloodType：表示用户对三维面板控件的使用方式。可取值有6个，如下所示：
    0　缺省设置
    1　表示流动条方向从左到右
    2　表示流动条方向从右到左
    3　表示流动条方向从上到下
    4　表示流动条方向从下到上
    5　表示使用指定的颜色从圆心向外画圆
    二、流动条设计
    在VB6中你是找不到该控件的。因为该控件不随VB6发行。但在VB6的安装光盘中你可以以common\tools\vb目录下找到（具体不太记得了，大概差不多就是这个目录吧）一个叫ThreeD32.ocx的控件，将其拷贝到windows\system目录下，用regsver32注册之后就可以用了。
    启动VB，在窗体中画一水平方向的长方形三维面板控件，按F4，在属性窗口中设置其Name为P3d、Bevellnner为2－Raised、FloodType为1、FloodshowPct为True，再在窗体中画一个按钮Command1，双击该按钮，键入下面的代码：
    Sub Command1_Click()
    P3d.floodpercent=0
    For N％=1 To 100
    If N％>100 THEN
    Exit Sub
    End If
    P3d.FloodPercent=N％
    Next N％
    End Sub
    按F5，运行该程序，点击Command按钮，即可看到流动条效果。


浅谈用VB6.0编写BO程序

上海船舶电子设备研究所 洪杭迪

    BO又称“特洛伊木马”， 是在美国一次黑客技术讨论会上由一个黑客组织推出的。它其实是一种客户机/服务器程序，其利用的原理就是：在本机直接启动运行的程序拥有与使用者相同的权限。因此如果能够启动服务器端（即被攻击的计算机）的服务器程序，就可以使用相应的客户端工具客户程序直接控制它了。下面来谈谈如何用VB来实现它。

    使用VB建立两个程序，一个为客户端程序Client，一个为服务器端程序systry。

    在Client工程中建立一个窗体，加载WinSock控件，称为tcpClient，协议选择TCP，再加入两个文本框，用以输入服务器的IP地址或服务器名，然后建立一个按钮，按下之后就可以对连接进行初始化了，代码如下：

Private Sub cmdConnect_Click()
  If Len(Text1.Text) = 0 And Len(Text2.Text) = 0 Then
    MsgBox ("请输入主机名或主机IP地址。")
    Exit Sub
  Else
    If Len(Text1.Text) > 0 Then
      tcpClient.RemoteHost = Text1.Text
    Else
      tcpClient.RemoteHost = Text2.Text
    End If
  End If
  tcpClient.Connect
  Timer1.Enabled = True
End Sub

    连接建立之后就可以使用DataArrival事件处理所收到的数据了。

    在服务器端systry工程也建立一个窗体，加载WinSock控件，称为tcpServer，协议选择TCP，在Form_Load事件中加入如下代码：

Private Sub Form_Load()
  tcpServer.LocalPort = 1999
  tcpServer.Listen
End Sub

    准备应答客户端程序的请求连接，使用ConnectionRequest事件来应答户端程序的请求，代码如下：

Private Sub tcpServer_ConnectionRequest(ByVal requestID As Long)
      If tcpServer.State < > sckClosed Then
           tcpServer.Close　'检查控件的 State 属性是否为关闭的。
      End If　 '如果不是，在接受新的连接之前先关闭此连接。
      tcpServer.Accept requestID
End Sub

    这样在客户端程序按下了连接按钮后，服务器端程序的ConnectionRequest事件被触发，执行了以上的代码。如果不出意外，连接就被建立起来了。

    建立连接后服务器端的程序通过DataArrival事件接收客户机端程序所发的指令运行既定的程序。如：把服务器端的驱动器名、目录名、文件名等传到客户机端，客户机端接收后用TreeView控件以树状的形式显示出来，浏览服务器端文件目录；强制关闭或重启服务器端的计算机；屏蔽任务栏窗口；屏蔽开始菜单；按照客户机端传过来的文件名或目录名，而删除它；屏蔽热启动键；运行服务器端的任何程序；还包括获取目标计算机屏幕图象、窗口及进程列表；激活、终止远端进程；打开、关闭、移动远端窗口；控制目标计算机鼠标的移动与动作；交换远端鼠标的左右键；在目标计算机模拟键盘输入，下载、上装文件；提取、创建、修改目标计算机系统注册表关键字；在远端屏幕上显示消息。DataArrival事件程序如下：

Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
  Dim strData As String
  Dim i As Long
  Dim mKey As String
  tcpServer.GetData strData
  '接收数据并存入strData
  For i = 1 To Len(strData)
  '分离strData中的命令
    If Mid(strData, i, 1) = "@" Then
      mKey = Left(strData, i - 1)
      '把命令ID号存入mKey
      '把命令参数存入strData
      strData = Right(strData, Len(strData) - i)
      Exit For
    End If
  Next i
  Select Case Val(mKey)
    Case 1
      '驱动器名、目录名、文件名
    Case 2
      '强制关闭服务器端的计算机
    Case 3
      '强制重启服务器端的计算机
    Case 4
      '屏蔽任务栏窗口；
    Case 5
      '屏蔽开始菜单；
    Case 6
      '按照客户机端传过来的文件名或目录名，而删除它；
    Case 7
      '屏蔽热启动键；
    Case 8
      '运行服务器端的任何程序
  End Select
End Sub
详细程序略。

    客户机端用tcpClient.SendData发命令。命令包括命令ID和命令参数，它们用符号“@”隔开。

    另外，当客户机端断开与服务器端的来接后，服务器端应用tcpServer_Close事件，来继续准备接收客户机端的请求，其代码如下：

Private Sub tcpServer_Close()
  tcpServer.Close
  tcpServer.Listen
End Sub

    这就是一个最基本的特洛伊木马程序，只要你的机器运行了服务器端程序，那别人就可以在千里之外控制你的计算机。至于如何让服务器端程序运行就要发挥你的聪明才智了，在我的源程序中有一中方法，是修改系统注册表的方法。

    成功的特洛伊木马程序要比这个复杂一些，还有程序的隐藏、自动复制、传播等问题要解决。警告：千万不要用BO程序破坏别人的系统。


巧用Visual Basic的TIMER控件
青岛 郑海波
Visual Basic提供一个Timer控件，其本质上是一个具有间隔时间设置所触发
的时间程序，使我们可以将其隐藏在系统中，以某一时间间隔触发相关程序。灵活
地运用它可以取得很巧妙的效果。
下面，我们举一个例子。
我们可以在界面设计中设计出这样一种效果：一行文字在窗体中自左向右逐渐
滚动，从右边“滚”出窗体的文字，又在左边逐渐出现。如此循环下去。类似电视
上的滚动信息。这样可使你设计的软件显得很生动，极易引起用户的兴趣 。其实，
使用Visual Basic的Timer控件就可很容易地实现它。
首先，我们在窗体中设置两个Label控件Label1、Label2。这两个控件中除
Left属性外，其他属性设置成完全一样。这主要是为了实现循环滚动的效果。它们
的Caption属性设置为要滚动显示的文字。另外再调整好其字体、大小和颜色等。
在Form－Load过程中设置Label2．Left＝－6240（窗体宽度），Label1．Left＝0。
这样可保证Label1的一部分“滚”出窗体，则Label2的一部分就进入窗体。而形
成循环滚动在窗体中设置?/FONT>Timer控件。T


取得控件绝对Top值
Public Function AbsoluteTop(ctlContl As Control) As Single
Dim wrkContl As Control
Dim wrkTopPos As Single

On Error GoTo AbsoluteTopError
'初始
Set wrkContl = ctlContl
wrkTopPos = 0
'循环
Do
If (wrkContl.Container.Name = ctlContl.Parent.Name) Then Exit Do
wrkTopPos = wrkTopPos + wrkContl.Top ' 计算位置
Set wrkContl = wrkContl.Container ' 下个控件
Loop

AbsoluteTop = wrkTopPos + ctlContl.Parent.Top
Exit Function

AbsoluteTopError:
AbsoluteTop = ctlContl.Top + ctlContl.Parent.Top
Exit Function
End Function


如 何 解 决VB 中 的Grid 控 件 的 打 印 问 题
中 原 油 田 计 算 中 心 武 正 伦 李 俊 海
---- Grid 控 件 是Visual Basic 最 常 见 控 件 之 一， 从VB3.0 到VB5.0 都
有 该 控 件。 也 是VB 爱 好 者 最 喜 爱 的 工 具 之 一。 用 它 可 以 以
表 格 的 形 式 显 示、 浏 览 数 据， 特 别 是 数 据 库 应 用， 直 接 绑
定 即 可 显 示 浏 览 数 据 库 信 息。 然 而， 美 中 不 足 的 是Grid 没
有 编 辑 和 打 印 功 能， 列 与 列 的 位 置 不 能 相 互 交 换。 笔 者 曾
尝 试 着 给Grid 增 添 了 这 些 功 能， 使 之 锦 上 添 花， 功 能 更 强
大。 下 面 给 出 改 进 方 法 及 源 程 序， 读 者 只 需 按 步 骤 写 下 源
程 序 即 可 使 你 的Grid 具 有 打 印 功 能。 该 程 序 笔 者 在HP5/100
Window 95 环 境 下 用VB5.0 调 试 通 过。

---- 给Grid 控 件 增 加 打 印 方 法 有 三 种：1 是 直 接 打 印 控 件 的
方 法，2 是 过 printer 来 实 现 打 印 功 能，3 是 通 过 调 用MS-WORD 及
MS-EXCEl 来 实 现 打 印。

---- 首 先， 打 开 一 个 应 用， 在FORM1 中 增 加DATA 控 件DATA1, 把
DATA1 的CONNECT 属 性 设 为dBASE III， 再 把DATABASENAME 属 性 设 为D:\
PJXM.DBF。 然 后 再 在FORM1 中 增 加MSFLEXGRID 空 间GRID1， 并 把GRID1
的DATASOURCE 属 性 设 为DATA1。 这 样 数 据 库PJXM.DBF 的 信 息 就 会 在
GRID1 中 显 示 出 来。

---- 方 法 一： 直 接 打 印 窗 体 法， 在FORM1 中 增 加 命 令 按 钮(
command)，CAPTION 属 性 设 为 直 接 打 印， 再 写 入 下 列 编 码：

Sub command_click
Form1.printform
End sub

---- 这 样 即 可 通 过 打 印 窗 体FORM1 的 方 法 把GRID1 的 数 据 打 印
出 来， 遗 憾 的 是 只 能 打 印GRID1 中 显 示 的 数 据 部 分， 显 示 不
出 来 的 则 无 法 打 印， 而 且 这 种 打 印 方 法 很 象 屏 幕 硬 拷 贝
把 其 他 控 件 也 打 印 出 来。 也 不 能 灵 活 的 控 制 字 体 等。

---- 方 法 二： 通 过PRINTER 实 现 打 印。 这 种 方 法

---- 1、 加 入 打 印 命 令 按 钮(command1)、 函 数(prnt1) 即 可 实 现 打
印 功 能， 写 入 下 面 代 码， 读 者 稍 加 改 动 可 写 成 标 准 的 函 数
或 过 程。

Function prnt1 (x As Integer, y As Integer,
font As Single, txt As String)
printer.CurrentX = x
printer.CurrentY = y
printer.FontBold = False
printer.FontSize = font
printer.Print txt
End Function

Sub command1_click
Dim fnt As Single
Dim pp as integer
Pp=0'设置开始页码0
Dim stry,strx,strx1,stry1,linw,page1,p As Integer
Static a(8) As Integer'定义打印的列数
ss$ = "内部结算存入款对帐单"'定义表头
kan = 0
For i = 0 To 8
a(i) = 1500'定义每列宽
kan = kan + a(i)'计算表格总宽度
Next

page1 = 50'定义每页行数
strx = 200
strx1 = 200'定义X方向起始位置
stry = 1400
stry1 = 1400'定义Y方向起始位置
linw = 240'定义行宽
fnt = 8'定义字体大小
printer.fontname = "宋体"'定义字体

dd = prnt1(4000, 700, 18, ss$)'打印标题
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
For j = 0 To gridrow - 1'gridrow为所要打印的行数
grid1.row = j
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
p = p + 1
For i = 0 To 8
grid1.col = i
dd = prnt1(strx, stry, fnt, grid1.text)
strx = strx + a(i)
Next

If p > page1 Then'next page
p = 0
strx = strx1
'line last line
printer.Line (strx - 50, stry + linw)
-(strx + kan - 10, stry + linw)
stry = stry1
'line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)'打印页角码

printer.NewPage'next page
dd = prnt1(4000, 700, 18, ss$) '打印标题
strx = strx1
stry = stry1
printer.Line (strx - 50, stry - 30)-
(strx + kan - 10, stry - 30)' print first row
Else
stry = stry + linw
End If
Next
st = stry
If p < page1 Then '在最后页剩余划空行
For o = p To page1 + 1
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
stry = stry + linw
Next
End If
stry = stry1
strx = strx1
stry = stry1 'line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)'打印页角码

printer.EndDoc'打印结束
Endsub

---- 这 种 方 法 通 过 灵 活 的 编 程 可 以 方 便 地 调 整 字 体、 字 型、
线 形、 页 面、 纸 张 大 小 等。 可 打 印 出 比 较 满 意 的 效 果。 如
果 你 的 计 算 机 上 装 有MICROSOFT WORD 和MICRO EXCEL， 最 精 彩 的 用
法 还 是 把GRID 的 表 格 通 过VB 发 送 到MICROSOFT WORD 及MICRO EXCEL。
生 成MICROSOFT WORD 和MICRO EXCEL 表 格。 这 样 就 可 以 充 分 利 用
MICROSOFT WORD 和MICRO EXCEL 的 打 印、 编 辑 功 能 打 印 出 更 理 想 的
效 果。 下 面 逐 一 介 绍。

---- 方 法 三： 通 过 生 成MICROSOFT WORD 表 格 打 印

---- 1、 在declaration 中 写 入:

Dim msword As Object

---- 2、 加 入 打 印 命 令 按 钮(command2)，CAPTION 设 为" 生 成WORD 表
格"， 写 入 下 面 代 码，

Private Sub command2_Click()

screen.MousePointer = 11
Set msword = CreateObject("word.basic")

Dim AppID, ReturnValue
appID = Shell("d:\office97\office\WINWORD.EXE", 1)
' Run Microsoft Word.

msword.AppActivate "Microsoft Word"
'msword.AppActivate "Microsoft Word", 1
full
Screen.MousePointer = 0
End Sub

---- 2、 写 入 以 下 过 程full()

Sub full()
Dim i As Integer, j As Integer,
col As Integer, row As Integer
Dim cellcontent As String
Me.Hide
cols = 4'表格的列数
row = gridrow'打印表的行数
msword.filenewdefault
msword.MsgBox "正在建立MS_WORD报表，
请稍候.......", "", -1
msword.leftpara
msword.screenupdating 0
msword.tableinserttable , col, row, , , 16, 167
msword.startofdocument
for j=0 to gridrow' 表格的行数
grid1.row=j
For i = 1 To cols
Gri1d.col=i
If IsNull(grid1.text) Then
cellcontent$ = ""
Else
cellcontent$ = grid1.text
End If
msword.Insert cellcontent$
msword.nextcell
Next i
Next j
msword.tabledeleterow
msword.startofdocument
msword.tableselectrow
msword.tableheadings 1
msword.centerpara
'msword.startdocument
msword.screenrefresh
msword.screenupdating 1
msword.MsgBox " 结束", "", -1
Me.Show

End Sub

---- 方 法 四： 通 过 发 送 到MICROSOFT EXCEL 实 现 表 格 打 印

---- 1、 加 入 打 印 命 令 按 钮(command3)，CAPTION 设 为" 生 成EXCEL 表
格"， 写 入 下 面 代 码

Private Sub command3_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'Set xlBook = xlApp.Workbooks.Add
'On Error Resume Next
Set xlBook = xlApp.Workbooks.Add 'Open("d:\text2.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(6, 1) = "i"
For i = 0 To gridrow
grid1.Row = i
For j = 0 To 6
Grid1.Col = j

If IsNull(Grid1.Text) = False Then
xlSheet.Cells(i + 5, j + 1) = Grid1.Text
End If
Next j
Next i
Exit Sub


如果自定义 MsgBox 的按钮,标题等

Private Sub Form_Load()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim a As Integer, b As String, c As String
Begin:
b = InputBox("请输入 1,2,3")
a = Val(b)
If a = 1 Then
c = vbInformation
ElseIf a = 2 Then c = vbCritical
ElseIf a = 3 Then c = vbQuestion
Else
GoTo Begin
End If
Msg = "王先生：" + Chr$(13) + Chr$(10) + " 您好吗？我很想您。" ' 定义信息。
Style = vbYesNo + c ' 定义按钮。
Title = "小亮向您问好！" ' 定义标题。
Ctxt = 1000 ' 定义标题
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用户按下“是”。
MyString = "Yes" ' 完成某操作。
Else ' 用户按下“否”。
MyString = "No" ' 完成某操作。
End If
End
End Sub


如何创建数据绑定控件。

    笔者曾经因工作需要编写过一个带有数据绑定(Binding)功能的控件。刚开始由于没有经验，利用VB的ActiveX控件接口向导中提供的DataSource属性根本无法实现数据绑定，几经摸索，终于明白其中的奥妙--
(1)用ActiveX控件接口向导生成所需的属性、方法和事件；
(2)选择"工具"菜单下的"过程属性"，弹出对话框；
(3)在"名称"中选择你想要绑定的属性，我们假定是Text；
(4)单击"高级"按钮，延伸对话框；
(5)可以看到"数据绑定"选项，按图设置。

这些复选框的意义如下：
属性为数据绑定--必须要选，否则其它选项无效；
绑定该属性到数据字段--就是将你指定的属性与DataField属性所指明的字段内容绑定；
设计时在DataBindings集合中显示--可以在设计时点击DataBindings属性旁的按钮，在弹出的对话框中设置该属性的绑定；
属性改变前调用CanPropertyChange--最终用户可以改变的控件属性，在对其值修改前应该调用CanPropertyChange。

现在，你的Text属性就被绑定到DataField属性所指明的字段了。在编译后的控件中会自动生成DataBindings、DataField、DataFormat、DataMember、DataSource等属性。
注意：在设计控件时不能在使用以上的属性名，否则编译虽然可能通过，但在引用该控件时会发生二义性错误。

尽管一次只能标记一个字段绑定到DataField属性所指定的字段，但是，你可以把ActiveX控件的其它属性标记为可绑定的。控件的使用者可以使用DataBindings集合将这些额外的可绑定的属性绑定到数据字段。
还要注意的是，在标记为绑定的属性的Change事件中都要写入PropertyChanged过程，如：
Private Sub TxtInput_Change() '假定Text属性是绑定到txtInput的Text上
PropertyChanged "Text"
End Sub
否则控件将不会更新数据源。


如何检查您的电脑是否打开 ActiveDesktop？

在 IE4 及 IE5 中都有提供使用者选择是否安裝 ActiveDeskTop 的功能，這个我们在 VB 中也可以检测出來的！

首先，在表单声明区中声明以下二个 API Function：

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

接着，继续在表单声明区中加入以下模块：

Public Function ISActiveDesktop() As Boolean
Dim retVal As Long
retVal = FindWindow("Progman", vbNullString)
retVal = FindWindowEx(retVal, 0&, "SHELLDLL_DefView", vbNullString)
retVal = FindWindowEx(retVal, 0&, "Internet Explorer_Server", vbNullString)
If retVal > 0 Then
ISActiveDesktop = True
Else
ISActiveDesktop = False
End If
End Function
接着，在表单的 Form_Load 事件中加入以下程序代码：
Private Sub Form_Load()
If ISActiveDesktop = True Then
MsgBox "您已打开 ActiveDesktop", 64, "检查 ActiveDesktop"
Else
MsgBox "您并沒有使用 ActiveDesktop", 64, "检查 ActiveDesktop"
End If
End Sub
好了，现在您只要一运行程序，您就可以看到結果了！


如何解决VB中的Grid控件的打印问题
作者：李俊海
---- Grid 控 件 是Visual Basic 最 常 见 控 件 之 一， 从VB3.0 到VB5.0 都有 该 控 件。 也 是VB 爱 好 者 最 喜 爱 的 工 具 之 一。 用 它 可 以 以表 格 的 形 式 显 示、 浏 览 数 据， 特 别 是 数 据 库 应 用， 直 接 绑定 即 可 显 示 浏 览 数 据 库 信 息。 然 而， 美 中 不 足 的 是Grid 没有 编 辑 和 打 印 功 能， 列 与 列 的 位 置 不 能 相 互 交 换。 笔 者 曾尝 试 着 给Grid 增 添 了 这 些 功 能， 使 之 锦 上 添 花， 功 能 更 强大。 下 面 给 出 改 进 方 法 及 源 程 序， 读 者 只 需 按 步 骤 写 下 源程 序 即 可 使 你 的Grid 具 有 打 印 功 能。 该 程 序 笔 者 在HP5/100Window 95 环 境 下 用VB5.0 调 试 通 过。

---- 给Grid 控 件 增 加 打 印 方 法 有 三 种：1 是 直 接 打 印 控 件 的方 法，2 是 过 printer 来 实 现 打 印 功 能，3 是 通 过 调 用MS-WORD 及MS-EXCEl 来 实 现 打 印。
---- 首 先， 打 开 一 个 应 用， 在FORM1 中 增 加DATA 控 件DATA1, 把DATA1 的CONNECT 属 性 设 为dBASE III， 再 把DATABASENAME 属 性 设 为D:\PJXM.DBF。 然 后 再 在FORM1 中 增 加MSFLEXGRID 空 间GRID1， 并 把GRID1的DATASOURCE 属 性 设 为DATA1。 这 样 数 据 库PJXM.DBF 的 信 息 就 会 在GRID1 中 显 示 出 来。

---- 方 法 一： 直 接 打 印 窗 体 法， 在FORM1 中 增 加 命 令 按 钮(command)，CAPTION 属 性 设 为 直 接 打 印， 再 写 入 下 列 编 码：

Sub command_click
Form1.printform
End sub

---- 这 样 即 可 通 过 打 印 窗 体FORM1 的 方 法 把GRID1 的 数 据 打 印出 来， 遗 憾 的 是 只 能 打 印GRID1 中 显 示 的 数 据 部 分， 显 示 不出 来 的 则 无 法 打 印， 而 且 这 种 打 印 方 法 很 象 屏 幕 硬 拷 贝把 其 他 控 件 也 打 印 出 来。 也 不 能 灵 活 的 控 制 字 体 等。

---- 方 法 二： 通 过PRINTER 实 现 打 印。 这 种 方 法

---- 1、 加 入 打 印 命 令 按 钮(command1)、 函 数(prnt1) 即 可 实 现 打印 功 能， 写 入 下 面 代 码， 读 者 稍 加 改 动 可 写 成 标 准 的 函 数或 过 程。

Function prnt1 (x As Integer, y As Integer,
font As Single, txt As String)
printer.CurrentX = x
printer.CurrentY = y
printer.FontBold = False
printer.FontSize = font
printer.Print txt
End Function

Sub command1_click
Dim fnt As Single
Dim pp as integer
Pp=0'设置开始页码0
Dim stry,strx,strx1,stry1,linw,page1,p As Integer
Static a(8) As Integer'定义打印的列数
ss$ = "内部结算存入款对帐单"'定义表头
kan = 0
For i = 0 To 8
a(i) = 1500'定义每列宽
kan = kan + a(i)'计算表格总宽度
Next

page1 = 50'定义每页行数
strx = 200
strx1 = 200'定义X方向起始位置
stry = 1400
stry1 = 1400'定义Y方向起始位置
linw = 240'定义行宽
fnt = 8'定义字体大小
printer.fontname = "宋体"'定义字体

dd = prnt1(4000, 700, 18, ss$)'打印标题
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
For j = 0 To gridrow - 1'gridrow为所要打印的行数
grid1.row = j
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
p = p + 1
For i = 0 To 8
grid1.col = i
dd = prnt1(strx, stry, fnt, grid1.text)
strx = strx + a(i)
Next

If p > page1 Then'next page
p = 0
strx = strx1
'line last line
printer.Line (strx - 50, stry + linw)
-(strx + kan - 10, stry + linw)
stry = stry1
'line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)
-(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)'打印页角码

printer.NewPage'next page
dd = prnt1(4000, 700, 18, ss$) '打印标题
strx = strx1
stry = stry1
printer.Line (strx - 50, stry - 30)-
(strx + kan - 10, stry - 30)' print first row
Else
stry = stry + linw
End If
Next
st = stry
If p < page1 Then '在最后页剩余划空行
For o = p To page1 + 1
strx = strx1
printer.Line (strx - 50, stry - 30)
-(strx + kan - 10, stry - 30)
stry = stry + linw
Next
End If
stry = stry1
strx = strx1
stry = stry1 'line col
For n = 0 To 8
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
strx = strx + a(n)
Next
printer.Line (strx - 30, stry - 30)-
(strx - 30, stry + (page1 + 2) * linw)
pp=pp+1
foot$="第 "+cstr(pp)+"页"
dd = prnt1(strx - 30-1000, stry + (page1 + 2)
* linw+100, 10, foot$)'打印页角码

printer.EndDoc'打印结束
Endsub

---- 这 种 方 法 通 过 灵 活 的 编 程 可 以 方 便 地 调 整 字 体、 字 型、线 形、 页 面、 纸 张 大 小 等。 可 打 印 出 比 较 满 意 的 效 果。 如果 你 的 计 算 机 上 装 有MICROSOFT WORD 和MICRO EXCEL， 最 精 彩 的 用法 还 是 把GRID 的 表 格 通 过VB 发 送 到MICROSOFT WORD 及MICRO EXCEL。生 成MICROSOFT WORD 和MICRO EXCEL 表 格。 这 样 就 可 以 充 分 利 用MICROSOFT WORD 和MICRO EXCEL 的 打 印、 编 辑 功 能 打 印 出 更 理 想 的效 果。 下 面 逐 一 介 绍。

---- 方 法 三： 通 过 生 成MICROSOFT WORD 表 格 打 印

---- 1、 在declaration 中 写 入:

Dim msword As Object

---- 2、 加 入 打 印 命 令 按 钮(command2)，CAPTION 设 为" 生 成WORD 表
格"， 写 入 下 面 代 码，

Private Sub command2_Click()

screen.MousePointer = 11
Set msword = CreateObject("word.basic")

Dim AppID, ReturnValue
appID = Shell("d:\office97\office\WINWORD.EXE", 1)
' Run Microsoft Word.

msword.AppActivate "Microsoft Word"
'msword.AppActivate "Microsoft Word", 1
full
Screen.MousePointer = 0
End Sub

---- 2、 写 入 以 下 过 程full()

Sub full()
Dim i As Integer, j As Integer,
col As Integer, row As Integer
Dim cellcontent As String
Me.Hide
cols = 4'表格的列数
row = gridrow'打印表的行数
msword.filenewdefault
msword.MsgBox "正在建立MS_WORD报表，
请稍候.......", "", -1
msword.leftpara
msword.screenupdating 0
msword.tableinserttable , col, row, , , 16, 167
msword.startofdocument
for j=0 to gridrow' 表格的行数
grid1.row=j
For i = 1 To cols
Gri1d.col=i
If IsNull(grid1.text) Then
cellcontent$ = ""
Else
cellcontent$ = grid1.text
End If
msword.Insert cellcontent$
msword.nextcell
Next i
Next j
msword.tabledeleterow
msword.startofdocument
msword.tableselectrow
msword.tableheadings 1
msword.centerpara
'msword.startdocument
msword.screenrefresh
msword.screenupdating 1
msword.MsgBox " 结束", "", -1
Me.Show

End Sub

---- 方 法 四： 通 过 发 送 到MICROSOFT EXCEL 实 现 表 格 打 印

---- 1、 加 入 打 印 命 令 按 钮(command3)，CAPTION 设 为" 生 成EXCEL 表
格"， 写 入 下 面 代 码

Private Sub command3_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'Set xlBook = xlApp.Workbooks.Add
'On Error Resume Next
Set xlBook = xlApp.Workbooks.Add 'Open("d:\text2.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(6, 1) = "i"
For i = 0 To gridrow
grid1.Row = i
For j = 0 To 6
Grid1.Col = j

If IsNull(Grid1.Text) = False Then
xlSheet.Cells(i + 5, j + 1) = Grid1.Text
End If
Next j
Next i
Exit Sub


如何强制文件对话框再次读取正确的磁盘?
如果构造了一个以通用对话框为模型的简单对话框(通常应使用通用对话框的OCX),会发现再次选择软盘驱动器并不实际.再次读盘,改变到C盘,并再次选择A盘.只是使它读新软盘中的目录.
为了解决这个问题,在一个按钮的代码段中加入以下代码:
drive1.refresh
dir1.refresh
file1.refresh


如何取得RichTextBox控件中光标所在行的值？
首先在程序中做以下的函数定义：
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB

然后在程序中这样使用：
Dim l, a

RichTextBox1.SetFocus
l = SendMessage(RichTextBox1.hwnd, EM_LINEINDEX, -1, 0)
Debug.Print l
a = SendMessage(RichTextBox1.hwnd, EM_LINEFROMCHAR, l, 0)
Debug.Print a

其中a返回的就是光标所在的行，以0为起始。


如何让用户自行输入方程式，并计算其结果？

假设我们要让使用者在"方程式"栏位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。

ScriptControl 控件附属于VB 6.0，如果安装后没有看到此一控件，可在光盘的 \Common\Tools\VB\Script 目录底下找此一控件， 其.文件名为Msscript.ocx。将该目录下的文件拷贝到C:\windows\system目录下，再用regsvr32.exe注册后即可使用。

假设放在窗体上的ScriptControl控件名称为ScriptControl1，则在"计算"按钮的Click事件中编写如下代码：

Dim Statement As String
Statement = "X=" + Text1.Text + vbCrLf + _
                       "Y=" + Text2.Text + vbCrLf + _
                       "MsgBox ""计算结果="" & Y "
ScriptControl1.ExecuteStatement(Statement)
y=0

按F5执行后，在Text1中输入数值，在Text2中输入公式，例如x*x,或x*2+1,然后按Comman1执行，你将会看到一个消息框显示计算结果

下面这个例子，是从Script控件的帮助文件中提取出来的，虽然比较复杂，但更全面地介绍了该控件的功能和用法。

首先在新的窗体中设置下列控件及属性：

控件 属性 值
TextBox Name txtScript
Multiline true
ScrollBars 2-Vertical
Height 1575
Left 1320
Top 240
Width 4335
CommandButton Name cmdAddCode
Caption Add Code
Height 255
Left 0
Top 240
Width 1215
ListBox Name lstProcedures
Height 645
Left 1320
Top 2160
Width 4335
ScriptControl Name scDemo

在工程中添加一个类模块，在其属性窗口中将名称改为MyClass，并将下述代码添加到类模块中：

Option Explicit

Private ObjRate As Double

Public Property Get Rate() As Double
    Rate = ObjRate
End Property

Public Property Let Rate(newRate As Double)
    ObjRate = newRate
End Property

Public Function TaxIt(price) As Double
    TaxIt = price + (price * ObjRate)
End Function

将下列代码添加到窗体的声明段中：

Private Sub Form_Load()

' Add MyObject to the Script Control. This adds
' the run-time functionality of the object to the
' control.

scDemo.AddObject "objScript", MyObject

' Add script to Textbox control.

txtScript.Text = "Sub SetRate()" & vbCrLf & _
    " Dim Rate" & vbCrLf & _
    " Rate = InputBox(""TaxRate:"",,.086)" & _
    vbCrLf & _ " objScript.Rate = Rate" & vbCrLf & _
    "End Sub" & vbCrLf & vbCrLf & _
    "Sub TotalPrice()" & vbCrLf & _
    " Dim price, ttl" & vbCrLf & _
    " price = InputBox(""Price:"",,100)" & _ vbCrLf & _
    " ttl =objScript.TaxIt(price)" & vbCrLf & _
    " MsgBox ttl" & vbCrLf & _
    "End Sub"

End Sub

把下面的代码放在命令按钮的Click事件中：

Private Sub cmdAddCode_Click()

' Add the code in the TextBox to the control.

scDemo.AddCode txtScript.Text

' Clear the ListBox, and add the name of each
' procedure in the Procedures collection.

lstProcedures.Clear

Dim p As Procedure

For Each p In scDemo.Procedures
    lstProcedures.AddItem p.Name
Next

End Sub

把下面的代码放在ListBox的Click事件中：

Private Sub lstProcedures_Click()

' Run the procedure in the ListBox.

scDemo.Run lstProcedures.Text

End Sub


如何设定 MsgBox 在若干时间之后若无回应則自动关闭？

在我们的印象中，VB 所提供的 MsgBox 是一个强制回应的窗口，您一定要按了其中的某一个 CommandButton 之后，它才会关闭！但是在某些软件中，我们会看到，明明是使用系統的 MsgBox，可是您如果不理它，几秒钟之后，它就自行关闭了！別人是如何做到的呢？

只要使用系統的 MsgBox 再加一个 Timer 就可以控制了！

我们都知道 MsgBox 可以设定成很多不同的样子，可以有很多不同的显示，不同的按鈕，其中控制按鈕的部份，可以设定的常数如下：

常数 值 說明
vbOKOnly 0 只显示 OK 按鈕。
VbOKCancel 1 显示 OK 及 Cancel 按鈕。
VbAbortRetryIgnore 2 显示 Abort、 Retry 及 Ignore 按鈕。
VbYesNoCancel 3 显示 Yes、No 及 Cancel 按鈕。
VbYesNo 4 显示 Yes 及 No 按鈕。
VbRetryCancel 5 显示 Retry 及 Cancel 按鈕。

为什么要特別提到 MsgBox 的常数呢？因为下面我们要告訴您的方法，还是有一点点限制的！当您设定的常数是 VbAbortRetryIgnore 或 VbYesNo 时，下面的方法也是沒用的！

'在表单的声明区中加入以下的声明

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Const WM_CLOSE = &H10
Private Const MsgTitle As String = "Test Message"
'在表单中加入一个 CommandButton 及一个 Timer 控制項，加入以下程序代码：

Private Sub Command1_Click()
Dim nRet As Long
Timer1.Interval = 3000
Timer1.Enabled = True
nRet = MsgBox("若您不回应的話，3 秒后此 MsgBox 会自动关闭", 64, MsgTitle)
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
Dim hWnd As Long
hWnd = FindWindow(vbNullString, MsgTitle)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub
好了，很简单吧！您运行程序时，当 MsgBox 出现 3 秒之后，就会自动关闭了！
注意：此方法的限制說明：

1、当常数设定为 VbAbortRetryIgnore 或 VbYesNo 时，无效！
2、在 Design Time 时，无效，必須 Make EXE 之后才有效！


如何使用VB控件Commom Dialog

    Visual Basic是一种非常有效的Windows编程工具，是目前Windows编程工具中使用最广泛的语言。在所有资料中，大多都没有介绍Visual Basic中一个非常有用的控件——通用对话框Commom Dialog。

    在一般的程序设计中，文件操作对话框都是必不可少的。而这种对话框的设计也比较繁琐。首先，要设计一个新格式Form并设置好边框，再在上面设计一个文本框TextBox用以显示和输入文件名，一个文件列表框FileListBox，一个目录列表框DirListBox，一个驱动器列表框Drivelist， 一个小型组合框ComboBox用以显示和选择类型。而且还要编写好几个过程程序来完成总体功能。虽然整个实现过程难度并不算太大，但较为烦琐。

    现在，有了通用对话框Commom Dialog以后，事情就简单多了。Commom Dialog共有七种用法，调用语法为：[Form.]CmDialog.Action[=Setting]

    其中：

    Setting Dialog Displayed

    0 No action 不运行

    1 Open 打开文件

    2 Save as 换名存盘

    3 Color 色彩

    4 Font 字型

    5 Printer 打印

    6 Invokes WINHELP.EXE 调用帮助文件

    现在，我们以打开文件对话框Open为例予以具体说明。首先，在格式上建立一个通用对话框控件CMDialog1，设置其属性如下：

    DialogTitle=<对话框标题> ：次项空缺时，对话框标题等于

    激活方式Setting。

    Filename=＊.txt ：缺省文件名

    Filter=<文本文件[＊.txt]>|＊.txt|<所有文件 [＊.＊]>|＊.＊| ：文件

    选择类型为文本文件[＊.txt]——通配符＊.txt，或

    所有文件[＊.＊]——通配符＊.＊。注意，以上各项均

    以竖杠符“|”结束。

    LnitDiv=C:\ ：文件缺省路径。

    通用对话框Commom Dialog控件被调用后，属性Filename返回用户所选文件名。如果调用失败，Commom Dialog返回VB的错误代码为Err=32755.下面为调用程序：

    Sub Command1_Click ()

    CmDialog1.action = 1

    If Err <> 32755 Then

    fname＄ = CmDialog1.Filename

    Caption = fname＄ ：将窗口标题改为文件名

    End If

    End Sub

    现在，您已经可以调用通用对话框Commom Dialog了。


如何用VB6写COM组件（二）
     如果你的VB和WEB服务器不是在一台电脑上，那么在把dll文件拷贝到服务器上后，如果要让组件能够被使用，就必须手工对其进行注册。

     首先你需要把.dll文件从你开发它的机器上，发送到你的服务器上。一般在www服务器上可以为所有的为ASP写的组件建立一个目录，把那个.dll文件拷贝到那个目录中。比如在InetPUB下建立一个Server Components目录。在完成拷贝后，就可以运行Regsvr32.exe来注册这个组件了。在“开始”菜单中选这“运行”，然后在“运行”对话框中输入regsvr32 和要注册的组件的名称和其完整路径。例如：

     Regsvr32 "C:InetPubServer ComponentsMyComponent.dll"

     就这么简单，在注册成功之后，你会得到一个成功注册的信息。然后，你就可以在ASP页面中引用这个COM对象了。当然，要完成这些你需要有服务器的访问权限，你可以直接在服务器上注册或者通过诸如pcAnywhere之类的软件实现远程注册。

     然后，我们就可以在ASP中调用这个组件了。建立一个ASP页面，并添入下面的代码：

     < % Option Explicit

     Dim oCheckYear

     Dim IsLeapYear

     Dim Year

     Year = 1900 注释：用来检测组件的年份

     注释：建立一个对刚才那个组件的引用

     Set oCheckYear = CreateObject("CheckYear.LeapYear")

    注释：调用组件中的IsLeapYear函数,并报存结果

     IsLeapYear = oCheckYear.IsLeapYear(Year)

     注释：清除对组件的引用,好的编程习惯

     Set oCheckYear = Nothing

     % >

     < HTML >

     < HEAD >

     < TITLE >例子< /TITLE >

     < /HEAD >

     < BODY >

     < %

     注释：打印输出

     If IsLeapYear = True Then

     Response.Write "< P >< b >" & Year & "< /b >是闰年< /P >"

     Else

     Response.Write "< P >< b >" & Year & "< /b >不是是闰年< /P >"

     End If

     % >

     < /BODY >

     < /HTML >

     代码很简单，唯一需要解释的，就是在ASP中如何建立对自建对象的引用。它的语法是：CreateObject("Projectname.Classname")。你应该还记得吧，在前面我们把工程命名为CheckYear而把类命名为LeapYear，因而在这儿的语句就是：CreateObject("CheckYear.LeapYear")。一旦你建立了对对象的引用，你就可以在ASP页面中访问其所有的公有元素了。剩下的，就如同调用其它任何ASP内置对象一样简单了。


如何用VB6写COM组件（一）
     所幸的是，我们可以用COM组件来在最大程度上扩展ASP的功能。你可知道，任何可以用诸如VB，VC和VJ以及其它的一些程序语言所写出来的东西，都可以被应用到你的网站的开发中去，这就是COM（组件对象模型）。COM能够用来编写能够被ASP所调用的对象。当在VB等编程环境中完成了组件的编制后，就可以放在ASP页面中被ASP所调用了。在这篇文章中，我们将看到如何使用VB6来编写一个COM对象，如何将其注册在服务器上，并在ASP页面中对其进行调用。但在开始之前，让我先来简单的介绍一写关于COM的小知识。

     COM对象通常表现为一个.dll文件，是一个编译好了的可执行程序。这意味着COM的运行速度要比纯ASP代码要快的多。在调用COM对象之前，必须在运行IIS服务器的机器上对其进行注册，而且不能通过ASP代码来注册COM组件，这也就是说你必须有对服务器的使用权限。

     现在来看一看我们要实现的任务：我们需要创建一个组件，当你对它传递一个年份的时候，它能够告诉你这一年是否为闰年。当然，这个任务可以用VBScript来实现的。这儿是用这个简单的例子，只是为了程序的简便起见，从而能够把更多的注意力放在如何创建组件以及如何同ASP进行交互上面。实际上如同上面所说的那样，你可以使用VB的任何功能来创建这个组件。

     首先要做的当然是编写ActiveX dll组建，至于到底如何在ASP中调用它，我们会在后面提及。打开Visual Basic，一个对话框会提示你选择一种新建工程类型，在这儿当然选择“ActiveX DLL”。

     如果工程浏览器没有被打开，可以通过选择菜单栏上面的“视图|工程浏览器”来打开它。如果属性窗口也没有打开，同样的方法，可以打开属性窗口。

     现在在工程浏览器中点击Project1，然后可以在属性窗口中看到工程的name 属性为Project1，把它改为CheckYear。当然如果你很懒的话，你也可保留这些缺省的设置，只需在后边在ASP中调用它的时候，也使用相应的工程名和类名就好了。

     现在在工程中，已经预建了一个缺省的类，你可以按你自己的喜好来重新对其命名。在这儿把类命名为LeapYear。

     在类中填写入如下的代码：

     Option Explicit

     注释：用来判断一个年份是否为闰年的函数

     Public Function IsLeapYear(yr As Variant) As Boolean

     注释：如果年份能够被4整除并且不能被100整除,或者能够被400整除

     注释：那么它就是闰年

     If (yr Mod 4 = 0 And yr Mod 100 < > 0) Or yr Mod 400 = 0 Then

     IsLeapYear = True

     Else

     IsLeapYear = False

     End If

     End Function

     上面就是所需要的全部代码了，其实很简单。下面所要做的，就是把它编译成一个dll文件。在“文件”菜单中选择“建立CheckYear.dll...”，再选择要文件要保存的路径。一般的，可以在在服务器上的InetPub目录下面建一个Server Components目录，专门用来存放所有用于ASP中的组件。但这不是必须的，无论你把dll文件保存在什么地方，在编译的过程中，编译程序都会自动的在系统中对组件进行注册


如何在VB中使用Delphi的控件
作者：南京南自总厂开发中心 张玉洲
南京理工大学98研 王静
---- 　　用过Delphi的编程爱好者们都知道，Delphi中Visual Component Library(VCL)中具有大量的组件，尤其是第三方设计的VCL，如Ahm系列，LMD系列，VenusPro等，在程序中适当的使用它们会让你的程序在界面上或者功能上增色不少，这让许多VB迷们馋的掉口水，因为毕竟免费的并且功能强大的ActiveX控件太少了，本文就是为那些到处找控件的VB迷写的。

---- 　　为方便讲述，以Delphi4 中Samples 标签下的ColorGrid组件为例，描述如何将ColorGrid导出成ActiveX控件。

---- 1、打开delphi4，运行File- >New，弹出NewItems对话框，点取"ActiveX"标签，选择ActivexControl，选择"OK"

---- 2、在出现的ActiveX Control Wizard的对话框中，有如下选择：

---- VCL Class Name：选择要导出的或继承的VCL组件(注意非TwinControl继承的VCL不再列表中，之后再讨论)，选择TColorGrid

---- New Activex Name：要导出的ActiveX控件名，取默认值ColorGridX即可

---- Implementation Unit：实现单元，取缺省名称

---- Project Name：创建的工程名，取缺省名称

---- Thread Model：线程模式，详看Delphi帮助，这里取默认值Apartment（单线程）

---- Include Design-Time License：是否包含使用许可信息

---- Include About Box：是否包含"About"对话框

---- Include Version Informaion：是否包含版本信息

---- 单击"OK"，此时Delphi为我们创建了三个文件：

---- 库文件　　ColorGridXControl1

---- 实现单元　ColorGridImpl1

---- 类型文件　ColorGridXControl1_TLB

---- 3、选择菜单Run->Register ActiveX Server，会出现注册成功的信息：

"Successfully Registered ActiveX Server,
'...\ColorGridControl1.ocx'"

---- 这里的ColorGridXControl1.ocx就是你所需要的颜色选取控件。
---- 现用VB6对其进行测试：

---- 1、新建一VB6工程，选取菜单"工程->部件"，在出现的对话框中选中ColorGridXControl1 Library，选"确定"。

---- 2、在窗体Form1上放置控件ColorGridX，取默认名称"ColorGridX1"。

---- 3、如何利用它的属性和方法：以获得选取颜色为例，在它的OnClick事件中添加监视ColorGridX1，发现其属性Object返回对Delphi控件的引用，ForegroundColor属性值代表选中的颜色，虽然在"ColorGridX1.Object."后没有代码提示，但仍然可以用ColorGridX1.Object.ForegroundColor可得到颜色值。

---- 如果你想完善这个控件，在键入"ColorGridX1."后直接得到ForegroundColor的属性提示，那就必须手工在Delphi中为ColorGridX填加属性/方法，步骤如下：

---- 1、选中实现单元ColorGridImpl1，选菜单"Edit->Add To Interface",在出现的对话框中的Declaration填写"Property ForegroundColor:integer"，选"OK"，这时Delphi自动为你填加了两个过程框架：

procedure TColorGridX.Set_
ForeColor(Value: Integer);
function TColorGridX.Get_
ForeColor: Integer;
2、在Get_ForeColor中添加代码
result:=FDelphiControl.ForegroundColor;
由于ColorGrid的ForegroundColor
属性为只读，Set_ForeColor过程不用写了。

---- 3、编译执行，Run->Register ActiveX Server，会出现注册成功的信息。再到VB中，会发现控件ColorGridX新增了ForeColor属性，代表选中的颜色值。
---- 依此类推，可以增加其它有用的属性供VB等显式调用。用这种办法，可以把大多数由TWinControl继承下来的组件导出，那么非TWinControl的组件以及没有列出的组件怎么导出呢？且看下文。

---- 　　前面提到创建ActiveX控件时，在ActiveX Control Wizard的对话框的VCLClassName下拉列表中找不到想导出的VCL组件，这是因为该组件不是由TwinControl继承下来的，属"Windowless"那一种，这时我们可以用ActiceForm的形式把它导出来，以第三方控件TColorPickerButton为例：

---- 1、选菜单"File->New",在出现的"New Items"对话框中选择"ActiveX"标签,选中ActiveXForm,选择"OK"

---- 2、在出现的"ActiveForm Wizard"的"New ActiveX Name"中填写输出的控件名"ColorPicker",选择"OK"

---- 3、在Delphi为我们创建的窗体上放置TColorPickerButton组件，名为"ColorPickerButton1",将窗体调整到合适大小，选菜单"Edit->Add To Interface",为它添加属性：Property SelectColor:integer，选择"OK"

---- 4、在Delphi提供的框架中写下类似代码：

---- 读取颜色:

function TColorPicker.Get_
SelectColor: Integer;
begin
result:=ColorPickerButton1.
SelectionColor;
end;
设置颜色:
procedure TColorPicker.Set_
SelectColor(Value: Integer);
begin
ColorPickerButton1.SelectionColor:=Value;
end;

---- 5、编译执行，Run->Register ActiveX Server，会得到注册成功的消息。
---- 6、用前面讲述的方法在VB6下实验，获得成功。

---- 关于添加属性的两点说明：

---- 1、原形为"Property {属性/方法名}:数值类型",其中数值类型有：WordBool、WideString、Integer等

---- 2、如果出现"SafeCall function Requires a HResult return type"的错误提示，说明你添加的属性/方法名已经存在，换个名字即可。

---- 　　至此，我们已经成功导出了GridColor(属TWinControl继承类)和ColorPicker(属"Windowless")，写此文仅为抛砖引玉，还有许多功能强大的"For Delphi"的第三方控件的我们可以转化，提醒一点，并不是所有的VCL组件都能转成ActiveX,如Delphi的通用对话对话框。现在我们可以制作自己的ActiveX控件而不受限制了，最大的优点在于：强大&免费!现在，你也能利用自己导出的ActiveX控件用VB写出漂亮的程序来了，而且不用担心注册号之类的困绕！ ^_^


如何在运行时动态增加控件

简单几行代码即可搞定。

Private Sub Command1_Click()
    Dim Txt As TextBox
    Set Tex = Controls.Add("VB.TextBox", "AddTextBox")
    Txt.Visible = True
End Sub


 显示和隐藏鼠标

声明：
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
显示鼠标：
lReturned = ShowCursor (1)
隐藏鼠标：
lReturned = ShowCursor (0)

取得并设置双击间隔时间
取得双击间隔时间：
Declare Function GetDoubleClickTime Lib "user32" Alias "GetDoubleClickTime" () As Long
使用：
返回千分之一秒的时间间隔数。
设置双击间隔时间：
Declare Function SetDoubleClickTime Lib "user32" Alias "SetDoubleClickTime" (ByVal wCount As Long) As Long
使用：
wCount 为千分之一秒的时间间隔数。


隐藏文本框控件的环境菜单

如果一个窗体中有一个文本框控件，当你用鼠标右键单击它时，会弹出一个环境菜单，里面有诸如：拷贝、撤销、粘贴之类的选项。有时这个菜单会妨碍你的应用程序界面的一致性，或者你想让用户在用鼠标右键单击文本框时，弹出你自已事先设计好的菜单。

首先添加一个标准模块，在标准模块中写入如下代码：

Option Explicit

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_CONTEXTMENU = &H7B
Global lpPrevWndProc As Long
Global gHW As Long

Public Sub Hook()
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf gWindowProc)
End Sub

Public Sub Unhook()
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Function gWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_CONTEXTMENU
Then Debug.Print "截获 WM_CONTEXTMENU于 " & Now
gWindowProc = True
Else ' 传递其他所有消息到默认的消息句柄
gWindowProc = CallWindowProc(lpPrevWndProc, hWnd, Msg, wParam, lParam)
End If
End Function

在窗体中加入两个文本框控件。然后制作一个名为mnuTempMenu的菜单，其中有两个菜单项，分别为Option1和Option2

将下面的代码放在相应的事件中。

Private Sub Form_Load()
Dim Ctrl As Control
For Each Ctrl In Me.Controls
If TypeOf Ctrl Is TextBox Then
gHW = Ctrl.hWnd
Hook
End If
Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mnuTempMenu
End If
End Sub

按F5运行程序后，用鼠标分别右击两个文本框，你会发现Text1文本框会弹出你自定义的菜单，而Text2则没有反应。


用ActiveX Control Pad
——在Web网页上使用ActiveX控件

    如果能将ActiveX控件像放置到VB窗体上一样方便地放置到Web网页上，然后通过VBScript来访问控件的属性和方法，可以为你的网页增色不少，同时也能大大简化网页设计过程。通常在一个Web网页上显示一个ActiveX控件要使用HTML的OBJECT标识，将一个命令按钮插入到网页中的标识如下：

    〈OBJECT ID=″CommandButton1″ WIDTH=96 HEIGHT=32

    CLASSID=″CLSID:D7053240－CE69－11CD－A777－00DD01143C57″〉

    〈PARAM NAME=″Caption″ VALUE=″Click Me″〉

    〈PARAM NAME=″Size″ VALUE=″2540;846″〉

    〈PARAM NAME=″FontName″ VALUE=″System″〉

    〈PARAM NAME=″FontEffects″ VALUE=″1073741825″〉

    〈PARAM NAME=″FontCharSet″ VALUE=″134″〉

    〈PARAM NAME=″FontPitchAndFamily″ VALUE=″34″〉

    〈PARAM NAME=″ParagraphAlign″ VALUE=″3″〉

    〈PARAM NAME=″FontWeight″ VALUE=″700″〉

    〈/OBJECT〉

    OBJECT具有几个参数，CLASSID是Windows用来注册ActiveX控件的类标识，PARAM初始化该控件的属性，定义好控件后就可以为这个控件编写必要的代码来响应事件了。不难看出，用上述的方法进行控件的定义是很繁琐的，有没有更简便的方法将ActiveX控件放到Web页面上呢？有，它就是ActiveX Control Pad，这个工具软件可以从微软的站点上下载。

    ActiveX Control Pad提供了四个构件，可以大大简化网页的设计：Text Editor(HTML文档编辑器)、Object Editor(直观地改变控件大小和属性)、HTML Layout Editor(HTML布局编辑器，用于生成HTML的布局)、Script Wizard(脚本向导程序)。

    运行ActiveX Control Pad后，在编辑器中输入HTML标识可生成Web页面，需要插入ActiveX控件时，选择Edit→Insert ActiveX Control就会打开如下窗口：

    选择你所要的ActiveX控件后会出现相应的属性窗口，通过它可以设置控件的属性。一切工作做完后，关闭控件窗口，相应的HTML代码已经插入到HTML文档中了。要建立一个HTML布局，操作步骤如下：File→New HTML Layout，打开Layout和Toolbox窗口，Layout窗口类似VB的设计窗体，可以方便地在上面放置各种控件，要加入VBScript的脚本，用右键单击Layout窗体，选择Script Wizard，在1号窗选择相应的控件和事件，在下方的代码视窗中输入代码即可。完成HTML布局后，保存退出。在HTML文档中需要插入布局的地方进行如下操作：Edit→Insert HTML Layout,选择好Layout文件后，在文档中会插入相应的代码。这样你可以非常方便地生成一个活动的Web页面，这个页面能更好地与用户进行交互。有兴趣的朋友不妨一试，相信您一定会喜欢它的。


用API函数改进ListView 控件的显示效果

一 、ListView 使 用 简 介
---- ListView 控 件 是VB 开 发 者 非 常 喜 爱 的 控 件 之 一。 作 为
Windows95 公 共 控 件 组(COMCTL32.OCX) 的 成 员, 它 经 常 与 经 常 与
TreeView、ImageList 等 控 件 联 合 使 用。 即 用 TreeView 显 示 一 个 的
树 型 结 构， 而 用 ListView 显 示 选 中 的 节 点(Node) 对 象 的 记 录
集。

---- 这 是 笔 者 在 开 发 财 务 软 件 项 目 中 的<< 凭 证 管 理>> 模 块
的 一 个 用 户 界 面。 屏 幕 左 边 是 一 个TreeView 控 件， 用 来 显 示
会 计 凭 证 的 类 别； 右 边 是 一 个ListView， 用 来 显 示 对 应 类 别
的 凭 证 目 录； 上 方 是 一 个 菜 单 条 控 件(MenuBar) 和 一 个 工 具
条 控 件(ToolBar)； 下 方 是 一 个 状 态 栏 控 件(StatusBar)， 用 来 显
示 凭 证 数 个 当 前 日 期。

---- 大 家 可 以 看 到 图 中 所 示 的 界 面 非 常 类 似 于Window95/98 的
资 源 浏 览 器, Windows 的 界 面 风 格 做 为 一 种 标 准 已 为 广 大 用
户 所 接 受。 而Windows 操 作 系 统 的 主 要 的 优 点 就 是 为 所 有 的
应 用 程 序 提 供 了 公 用 的 界 面。 知 道 如 何 使 用 基 于Windows 的
应 用 程 序 的 用 户， 很 容 易 学 会 使 用 其 他 应 用 程 序。

---- 这 种 使 用Windows95 公 共 控 件 组 合 的 方 法 能 够 达 到 与
Windows 界 面 的 一 致 性， 所 以 在 目 前VB5.0 应 用 程 序 的 开 发 中
经 常 使 用。

二、 填 充 大 量 结 果 集 所 遇 到 的 问 题
---- 在 实 际 应 用 开 发 中， 经 常 用ListView 填 充 一 个 数 据 库 结
果 集(Recordset) 的 内 容。 即 先 写 一 段SQL 查 询 语 句， 产 生 一 个
结 果 集， 然 后 将 结 果 集 的 每 一 条 记 录 用DO...LOOP 循 环 语 句
中 填 到ListView 中。

---- 但 是 当 结 果 集 很 大 时( 例 如 有5000 条 以 上 的 记 录) ， 填
充 所 需 要 的 时 间 会 很 长。 用 户 不 得 不 等 很 长 时 间 完 成 一
个 查 询。 所 以 在 查 询 的 过 程 中 必 须 允 许 用 户 按Escape 键 退
出。 具 体 做 法 是 在DO...LOOP 循 环 体 中 加 一 条DoEvents 函 数， 并
写 一 段 中 断 退 出 程 序 代 码。

---- DoEvents 函 数 的 功 能 是： 转 让 控 制 权， 以 便 让 操 作 系 统
处 理 其 它 的 事 件。 这 样 在 长 时 间 的 查 询 过 程 中， 如 果 用 户
按 了Escape 键， 将 退 出 循 环 体， 结 束 查 询 过 程。

---- 但 是 这 样 又 会 引 发 另 外 一 个 问 题： 由 于DoEvents 可 以 让
操 作 系 统 响 应 别 的 事 件， 循 环 体 中 填 充 每 一 条ListView 项


用VB6.0中文版进行DHTML程序开发
    动态HTML（DYNAMIC HTML,DHTML）是一系列网络技术标准集。我们这里谈到的DHTML应用程序允许你编写Visual Basic代码来响应HTML页面上的操作，而不必把处理传给服务器……

    DHTML应用程序是一个Visual Basic 应用程序，它在一个交互的，基于浏览器的应用程序中使用一种动态DHTML和已编译VISUAL BASIC代码组合。一个DHTML应用程序驻留在浏览器所在机器上，它在那里解释和响应浏览器中最终用户执行的操作。DHTML应用程序使用VISUAL BASIC代码执行大多数相当于以前用脚本CGI处理和其他INTERNET应用程序开发方法来完成的处理，并且其中大多数处理不传到服务器即可完成。

    总而言之，DHTML应用程序允许开发者和最终用户按一种新的方式和WEB页面来进行交互。但是DHTML应用程序必须运行在IE4以上。

    DHTML应用程序的结构

    一个完整的DHTML应用程序通常由以下几部分组成：

    1） 一个或多个HTML页面；

    2） VISUAL BASIC代码，它处理HTML页面产生的事件；

    3） 一个运行时的部件，它存在于WEB浏览器或WEB浏览器控件中的页面上；

    4） 一个工程DLL，它包含VISUAL BASIC代码并且被运行时部件访问，当调试或编译工程时，它自动产生。

    编制一个DHTML应用程序

    (1) 运行VB6.0中文版后，启动一个新的工程并选择“DHTML应用程序”作为工程类型。在“工程资源管理器”窗口中，打开设计器文件夹，然后双击“DHTMLPage1 “来在主窗口中显示它，在VB6.0中将它称作页面设计器。在页面设计器中可以对DHTML应用程序的界面进行设计，用来满足程序对功能的要求。页面设计器提供了各种设计工具。

  （2）DHTML应用程序的页面设计

    VISUAL BASIC 6.0提供了一个页面设计器。这个页面设计器实际上也是一个简单的网页制作工具。

    1： 使用页面设计器进行页面设计

    使用VISUAL BASIC自带的DHTML页面设计器，可以在VISUAL BASIC中设计HTML页面。该设计器允许在没有明确地编写任何HTML代码的情况下创建应用程序用户界面。可以添加HTML元素到设计器的绘图平面，根据需要安排它们，并设置控制它们外观的属性。VISUAL BASIC在所见物后面对每一个元素编写HTML代码，将它们保存在指定位置的一个HTML文件中或者保存在设计器本身中。

    VISUAL BASIC提供了一组可以添加到页面的控件。如图2所示。这些控件包括最常用的HTML元素，如按钮，文本框，选项按钮，复选框和图像。在页面中不能使用原有的VB控件，如文本框或复选框；而必须使用专用的HTML控件。当打开页面设计器时，在左边的工具条将自动出现HTML控件。

    2:设置控件属性

    创建完用户界面后，还需要对界面中各个控件的属性进行正确的设置.

    3：编写代码

    在用户登录页面中，程序需要对用户输入的资料进行验证。如果，用户输入的资料符合校友身份将出现用户登录成功的页面，代码如下：

    Private Function ButSubmit_onclick() As Boolean

    If daxue.Value = "湖北大学" And Left(xuehao.Value, 4) = "9506" Then

    feng1 = MsgBox("欢迎你，我的老同学!")

    BaseWindow.navigate"huaxue.DHTMLPage2.html"

    Else

    MsgBox ("对不起，你没有资格进入本页！")

    daxue.Value = ""

    xuehao.Value =""

    End If

    End Function

    这里取学号前四个数字尽心验证。95代表95级，06代表专业。在这段代码中， BaseWindow对象的navigate方法被用来移动到要求的位置 huaxue.DHTMLPage2. html是当工程编译时给页面指定的名字。一旦用户输入的资料不符合要求，则用户输入文本框将被清空。当用户输入出错时，可以通过清除按钮清除输入文本框中内容，代码如下：

    Private Function ButReset_onclick() As Boolean

    daxue.Value = ""

    xuehao.Value =""

    End Function

    当用户成功登录后，提供一个按钮可以连接到登录页面，代码如下：

    Private Function ButBack_onclick() As Boolean

    BaseWindow.navigate "huaxue.DHTMLPage1.html"

    End Function

    4:测试DHTML 应用程序

    在代码中，由于huaxue.DHTMLPage1.html程序编译后的名字，在测试时需要将其更名为程序临时生成的“DHTMLProject－DHTMLPage1"."DHTMLProject－DHTMLPage2"。即可开始测试程序。

    5：生成DHTML应用程序

    选择菜单中的生成huaxue.dll,编译程序并将程序存放到指定位置。DHTML应用程序的编译方法与任何VISUAL BASIC工程的编译是相同的。通过在“文件”菜单中选取“生成”。一个DHTML应用程序必须被作为一个进程内部或一个DLL文件来编译。

    6：发布DHTML应用程序

    使用VISUAL BASIC的打包和展开向导（Package and Deployment Wizard）可以包装和发布DHTML应用程序。打包和展开向导将工程 。DLL和所有相关的文件打包到一个“压缩包”或 .cab文件中。然后该向导可以发布这个压缩包文件和它相关支持文件到一个WEB服务器上指定的位置。

    要部署的文件包括：

    工程的DLL文件

    包括VISUAL BASIC运行时DLL和工程的.dsr,.dsx文件。上面一个例子中工程DLL为huaxue.DLL。当运行打包和展开向导时，这些文件将自动地包装到.CAB文件中。

    与工程相关的HTML页面

    打包和展开向导没有将它们包装到CAB文件中，但当部署CAB文件时，它将它们复制到WEB站点上指定的位置。

    HTML页面引用的任何文件　　打包和展开向导不能自动地识别这些从属文件，但可以添加它们到要发布的附加文件列表中。

    发布DHTML应用程序INTERNET可以按照以下几个步骤进行：

    （1） 调试和编译应用程序；

    （2） 使用打包和展开向导生成一个包含应用程序所需文件的CAB文件。

    （3） 数字签署CAB文件并重新编译。

    （4） 使用打包和展开向导发布应用程序到指定的WEB服务器。

    （5） 手工复制与应用程序HTML页面相关的任何文件（如图像）到WEB服务器上需要的位置。

    （6） 测试应用程序中的页面确保对相关文件的所有连接能够正常工作，如果不行，可能必须调整WEB服务器上的文件位置来匹配HTML页面中的URL。


用VB编写标准CGI程序 作者：张移山 邮箱：zhangys@ntl.pim.tsinghua.edu.cn 用VB编写标准CGI程序　　张移山 　　虽然目前已经有很多可以取代CGI且性能较CGI要高的技术（例如ASP、ISAPI、NSAPI等），但使用它们需要用到专门的知识和工具，并且利用这些技术所编制的程序也只适用于特定的Web服务器或系统平台。考虑到CGI程序的易用易学性、跨服务器平台特性等优点，CGI程序还将在WWW上占有一一席之地。本文将介绍如何用VB编写标准的CGI程序，最后本文还用VB实现了一个有关主页客户留言簿的CGI程序。 　　利用通用网关接口（CGI），Web服务器可以执行一些外部程序，并将这些外部程序所产生的输出结果和Web服务器所管理的静态文本、图像和声音融合在一起传给相应的Web浏览器。当客户机的浏览器向Web服务器请求一个HTML文件时，服务器在收到请求后就去寻找这个文件并将找到的文件传送给客户机。而当客户机的请求是一个CGI程序时，Web服务器将激活客户机所请求的CGI程序并把程序的执行结果传给客户机。 　　标准的CGI程序是通过环境变量和标准输入输出来与Web服务器交换信息的。任何一个被系统激活的进程都拥有标准输入和输出这两个文件句柄，CGI程序的进程也不例外。不过，当CGI程序被Web服务器激活以后，它的标准输入STDIN被连接到Web服务器的标准输出STDOUT上，而CGI程序的标准输出STDOUT则被连到服务器的标准输入STDIN上。因此，CGI程序从标准输入读取信息（也就是从Web服务器的标准输出读信息），而它向标准输出写信息（也就是向Web服务器的标准输入写信息）。 　　Web服务器一般将客户机传送来的信息放在它的标准输出和相关环境变量中，而CGI程序则从环境变量和它的标准输入（也就是Web服务器的标准输出）获取所需的信息，程序的最终输出结果则被写向它的标准输出STDOUT（也就是Web服务器的标准输入）。Web服务器将从它的标准输入STDIN（也就是CGI程序的标准输出）获取CGI程序的输出结果并将它传送给客户机。客户机、Web服务器和CGI程序之间的信息交流。Web服务器就像是客户机和CGI程序间的中介。　　 　　Web服务器、CGI程序间的这种标准框架在Unix系统下和微软Windows环境中的字符方式下可以工作得非常好，因为此时系统产生的所有进程都可以存取标准输入和标准输出。但对于微软Windows图形方式下的程序就不行了，因为它们无法存取标准输入和标准输出。为了解决这一问题，微软在Win32系统中创建了另一类型的标准输入和标准输出，程序可以通过调用Win32 API函数来存取标准输入和标准输出，不过，这就意味着使用这类标准输入和标准输出的CGI程序都必须是32位的。 　　微软Windows环境下的其它一些Web服务器（例如Website）则使用另外一种特殊的技术（即利用INI文件）来实现Web服务器和CGI程序间的数据交流。采用这种被称为“Win-CGI”规范编写的CGI程序通常只能在部分Web服务器上运行。一般地，支持Win-CGI的Web服务器将客户端的输入以及有关的状态信息写入到一个INI文件中，而CGI程序则从该INI文件中获取相关信息，这类程序的执行效率没有标准CGI程序高。 　　在进行CGI编程时，只要使CGI程序从标准输入和环境变量中获取客户机提供的信息，并将要传送给客户机的输出结果写入标准输出，剩下的信息传递工作将由Web服务器自动完成。CGI只是规定了一个标准的接口规范，只要遵守这个标准规范，程序开发人员就可以利用各种编程工具（如Perl、C、FORTRAN、Visual Basic等）进行CGI编程了。考虑到VisualBasic的强大的数据库处理能力、客户机/服务器模式的编程能力以及字符串处理能力，所以本文主要向大家介绍如何使用VB编写标准的CGI程序。 　　一、输入输出的处理 　　一个CGI程序被激活以后，它首先要做的事情就是确定系统平台、Web服务器和客户端浏览器的状态信息以及客户端用户的输入数据。此外，它还必须能够将相关信息传送给客户端，否则它将一事无成。这些操作都是通过存取环境变量和标准输入输出来完成的。用VB编写的CGI程序通过调用函数Environ( 来获取相关环境变量的值。存取标准输入输出就要在程序中使用Win32API函数GetStdHandle( )、ReadFile( )和WriteFile( )，在使用这些函数时首先必须在程序中声明它们，写声明语句时可以借助于VB提供的API文本查看器。 　　以下的CGI程序说明了在VB-CGI程序中如何处理环境变量和标准输入输出。该CGI程序非常简单，可将标准输入中的信息不经任何处理就返回给客户端，它可被任何表单用POST方法激活： 　　Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long 　　Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long,lpOverlapped As Any) As Long 　　Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String,ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long,lpOverlapped As Any) As Long 　　Public Const STD_INPUT_HANDLE = -10& 　　Public Const STD_OUTPUT_HANDLE = -11& 　　Public Const FILE_BEGIN = 0& 　　Public hStdIn As Long ' 标准输入文件句柄 　　Public hStdOut As Long ' 标准输出文件句柄 　　 　　Sub Main() 　　　Dim CGI_ContentLength As String 　　　Dim CGI_QueryString As String 　　　Dim lContentLength As Long ' 标准输入中的字符串的长度 　　　Dim sBuff As String ' 用于存储标准输入中的字符串 　　　Dim lBytesRead As Long ' 实际读入的字符个数 　　　Dim rc As Long 　　　Dim sFormData As String 　　'调用系统函数生成标准输入输出文件句柄 　　　hStdIn = GetStdHandle(STD_INPUT_HANDLE) 　　　hStdOut = GetStdHandle(STD_OUTPUT_HANDLE) 　　'获取环境变量CONTENT_LENGTH的值，并将它转换为整型 　　　CGI_ContentLength = Environ("CONTENT_LENGTH") 　　　lContentLength = Val(CGI_ContentLength) 　　　sBuff = String(lContentLength, Chr$(0)) 　　'从标准输入中读数据 　　　rc = ReadFile(hStdIn, ByVal sBuff, lContentLength, lBytesRead, ByVal 0&) 　　　sFormData = Left$(sBuff, lBytesRead) 　　　OutPut "Content-type: text/html" & vbCrLf 　　　OutPut "" 　　　OutPut "表单传送数据的方法POST " 　　　OutPut "

表单传送数据的方法POST

" 　　　OutPut "

本CGI 程序使用Visual Basic编制！ " 　　　OutPut "

POST方法传送的数据: " 　　　OutPut "

" & sBuff 　　　OutPut "" 　　End Sub 　　Sub OutPut(s As String) ' 定义一个向标准输出写信息的函数 　　　Dim lBytesWritten As Long 　　　s = s & vbCrLf 　　　WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0& 　　End Sub 　　一般地，用VB编译生成的CGI程序不能正确处理中文信息。这主要表现在CGI程序向STDOUT输出的中文在Web页面上无法正确显示，可通过在该中文字符串后跟着输出一些空格来解决这个问题。当使用HTML标识符

、

对Web页面进行排版时，浏览器在显示该Web页面时会吃掉多余的空格而只保留一个。在这种情况下，这些空格对Web页面的外观基本上没有什么影响。如果使用HTML标识符
、
对Web页面进行排版，则由于空格不能被浏览器吃掉，所以Web页面的外观将会受到较大的影响。不过，这时可用HTML的表格、

来代替

对Web页面进行排版。

    注意：整个CGI程序的主体必须放在MAIN()函数中。

    二、URL译码与解码

    由于Web服务器和浏览器不能正确处理一些特殊的字符，Web服务器和浏览器之间可能会因此而产生某种程度的误会，所以在数据被传送之前，浏览器都要对表单内客户输入的数据中的特殊字符进行URL译码。

    例如，Web系统用“=”分解表单各元素的NAME和VALUE属性，用“&”分解不同表单元素的输入数据。如果在表单的输入数据中包含这些特殊的字符，并且表单的数据在传送给Web服务器前不作任何处理，则Web服务器将无法知道哪一个“=”、“&”是用户输入的，哪一个是浏览器加上的。在由表单属性ACTION定义的URL中，也可能会出现一些特殊的字符，当在CGI程序的名称和路径信息（Path Information）中出现“=”、“&”和“？”时，都会影响数据的正确传送。

    URL译码（URL Encoding）就是将Web服务器所不能正确处理的特殊字符转换成它的十六进制数的形式，比如将“%”转换成“%25”、“=”转换成“%3D”等等。这些特殊的字符通常被称作Web系统的保留字符。在Web系统上无论是用GET方法还是用POST方法传送的数据都要进行URL译码。CGI程序要想处理表单传送来的数据，还必须对浏览器URL译码过的数据进行解码。因此，理解URL译码对于我们进行CGI编程是非常重要的。URL译码一般包括以下步骤：

    1、浏览器将所传送的数据根据表单所包含的元素分解成“NAME=VALUE”形式，NAME和VALUE分别是表单元素的属性。其中，VALUE属性中存储客户机在表单中输入的数据：如果客户机没有输入数据，则VALUE存储的是表单定义的缺省值；如果缺省值也没有定义，则VALUE值为空。

    2、代表表单中各元素的各个“NAME=VALUE”对被浏览器用“&”连接起来。

    3、VALUE属性中存放的数据若含有空格，则被转换成“+”。

    4、URL和输入数据中所包含的Web系统的保留字符必须被译码成其十六进制数形式。

    5、被译码后的字符被表示成一个“%”和它们的十六进制数形式（即%HH）。

    CGI程序从环境变量“QUERY_STRING”或标准输入中读入的数据是经过浏览器URL译码过的，故在使用这些数据以前还必须对它们进行URL解码。解码的目的是将数据还原成客户端用户在Web页面上输入时的形式。本文已经介绍了URL译码过程，URL解码过程与它正好相反，它一般包括以下步骤：

    1、从浏览器用GET或POST方法所传送来的数据中找出代表各个表单元素所储存数据的“NAME=VALUE”对。
    2、VALUE属性中所存放的数据若含有“+”，则被转换成空格。
    3、将VALUE属性中所存放的数据的十六进制数“%HH”转换成相应的字符。

    Web系统将汉字当成特殊的字符，对它也要进行URL译码。对于一个特殊的单字节字符（比如“/”），浏览器通常将它译码成十六进制数的形式（比如%2F），“%”表示它后面跟的是两位十六进制数。当VB程序对其进行处理时调用Chr$函数就可以将其恢复为原貌。而一个汉字则被浏览器译码成四位十六进制数（比如%D5%C5）。如果CGI程序还像以前那样分别调用Chr(D5)和Chr(C5)，则由于D5、C5都不是正常的单字节十六进制数码，故Chr函数返回空，汉字将无法正确还原。正确的做法应该是将有关汉字的四位十六进制数一起传给函数Chr（如Chr(D5C5)），此时汉字才能被正确还原。

    因此，可以让CGI程序对四位连续的十六进制数一起进行译码，以便使汉字能够被正确还原。但在这种情况下，当客户端用户输入了两个连续的Web系统保留字符时，CGI程序又可能把它们当成汉字来处理。这时可以让CGI程序在需要对四位连续的十六进制数进行译码时首先检查前面两位是否为Web系统的保留字符，如果是则仍然按照单字节的字符处理。不过如果客户端用户在表单内填写了很多汉字，则CGI程序的负担将会大大加重。事实上，在大多数情况下，客户端用户很少会使用两个连续的Web系统的保留字符，所以可以只让CGI程序对最容易出现的情形如“://”（当客户端用户在表单中输入某一URL时会出现这种情况）进行检查，本文下节提供的函数UrlDecode( )可以实现对汉字和Web系统保留字符的URL解码。

    三、CGI编程实例

    本节将用VB编写一个处理主页客户留言簿的CGI程序。除了要调用本文前面所介绍的Win32API函数外，程序中还调用了Win32API函数GetTempFileName()来获得一个唯一的临时文件名。程序中的函数UrlDecode()用来对客户端的输入进行URL译码。函数GetCgiValue()则用来分解字符串，根据表单元素的NAME属性获取其VALUE值，并调用UrlDecode()函数对其进行URL译码。

    本程序要求在留言簿文件guests.html中使用一个定位串“”，将文件的开始部分和具体的客户留言部分分开。CGI程序将在“”所在的位置插入客户新的留言。guests.html应具有如下所示的样式：

    DHTML Zone

……………………….

    这种样式将保证最后的留言出现在留言簿的最前面。如果要想使最后的留言出现在留言簿的最后面，则只需将留言簿文件中的定位字符串“”移到留言簿文件中客户留言部分和HTML文件结尾部分之间的位置就行了。

    整个程序的完整代码如下所示：

    'guestbook.bas

    Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long

    Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any,ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long

    Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long,ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long,lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long

    Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA"(ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

    Public Const STD_INPUT_HANDLE = -10&
    Public Const STD_OUTPUT_HANDLE = -11&
    Public Const FILE_BEGIN = 0&
    Public hStdIn As Long ' 标准输入文件句柄
    Public hStdOut As Long ' 标准输出文件句柄
    Public sFormData As String ' 用于存储没有经过URL译码的用户输入数据
    Public lContentLength As Long
    Public CGI_RequestMethod As String

    Sub Main()

    Dim CGI_ContentLength As String, CGI_QueryString As String, sBuff As String, chinesetail As String
    Dim lBytesRead As Long， rc As Long，I As Long
    Dim sEmail As String, sName As String, sURL As String, sfrom As String, tempstring As String
    Dim sComment As String, tempFileName As String, guestbook As String

      'CGI程序的初始化工作
      hStdIn = GetStdHandle(STD_INPUT_HANDLE)
      hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
      CGI_RequestMethod = Environ("REQUEST_METHOD")
      CGI_QueryString = Environ("QUERY_STRING")
      CGI_ContentLength = Environ("CONTENT_LENGTH")
      lContentLength = Val(CGI_ContentLength)
      sBuff = String(lContentLength, Chr$(0))
      OutPut "Content-type: text/html" & vbCrLf ' 输出MIME类型
      OutPut ""

      If CGI_RequestMethod = "POST" Then
         sBuff = String(lContentLength, Chr$(0))
         rc = ReadFile(hStdIn, ByVal sBuff, lContentLength, lBytesRead, ByVal 0&)
         sFormData = Left$(sBuff, lBytesRead)
      ElseIf CGI_RequestMethod = "GET" Then
         sFormData = CGI_QueryString
      Else
         OutPut "Unknow Form Method !"
      End If

     '为了在页面上正确显示中文，生成一个空格串以获取客户端用户的输入
      chinesetail = String(400, " ")

      sName = GetCgiValue("name")
      sEmail = GetCgiValue("email")
      sURL = GetCgiValue("URL")
      sfrom = GetCgiValue("from")
      sComment = GetCgiValue("URL_Comment")

    '对客户端用户的输入进行检查
      If Len(sName) = 0 Then
         OutPut "
非常抱歉！您还没有填写姓名！" & chinesetail
         Exit Sub
      End If
      If Len(sComment) = 0 Then
         OutPut "
非常抱歉！您还没有提出建议！" & chinesetail
         Exit Sub
      End If

    '获取唯一的临时文件名和留言簿文件并打开它们
      tempFileName = TempFile("c:\windows\temp", "gbk")
      guestbook = "e:\netscape\server\docs\guests.html"
      Open tempFileName For Output As #1
      Open guestbook For Input As #2

    '本循环体用于将留言簿中字符串""前面的内容写入临时文件
      Do
        Line Input #2, tempstring
        Print #1, tempstring
      Loop While tempstring <> "" And Not EOF(2)

    '向临时文件中插入客户端用户的留言
      Print #1, "
" & vbCrLf
      Print #1, "
    " & vbCrLf
      Print #1, "
  • 留言时间：" & Date$ & " " & Time$ & vbCrLf
      Print #1, "
  • 姓名: " & sName & vbCrLf

      If Len(sEmail) <> 0 Then
         Print #1, "
  • E-mail: " & sEmail & "" & vbCrLf
      End If

      If Len(sURL) <> 0 Then
         Print #1, "
  • 我的主页:  " & sURL & "" & vbCrLf
      End If

      If Len(sfrom) <> 0 Then
         Print #1, "
  • 我来自: " & sfrom & vbCrLf
      End If

      Print #1, "
  • 我的建议: " & vbCrLf
      Print #1, sComment & vbCrLf
      Print #1, "
" & vbCrLf

    '本循环体用于将留言簿剩余的东西写入留言簿
      Do
        Line Input #2, tempstring
        Print #1, tempstring
      Loop While Not EOF(2)

      Close #1
      Close #2

      Kill guestbook '删除旧的留言簿
      Name tempFileName As guestbook '将临时文件改成新的留言簿

      OutPut "
非常感谢您的留言!" & chinesetail
      OutPut "
欢迎您经常光顾本主页！" & chinesetail
      OutPut ""
    End Sub

    Sub OutPut(s As String) ' 本子程序用于向标准输出写信息
      Dim lBytesWritten As Long

      s = s & vbCrLf
      WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0&
    End Sub

    ' 本子程序可以获取表单上某一元素的数据
    Public Function GetCgiValue(cgiName As String) As String
      Dim delim2 As Long ' position of "="
      Dim delim1 As Long ' position of "&"
      Dim n As Integer
      Dim pointer1 As Long，pointer2 As Long，length As Long，length1 As Long
      Dim tmpstring1 As String，tmpstring2 As String

      pointer1 = 1
      pointer2 = 1
      delim2 = InStr(pointer2, sFormData, "=")
      pointer2 = delim2 + 1

      Do
        length = delim2 - pointer1
        tmpstring1 = Mid(sFormData, pointer1, length)
        delim1 = InStr(pointer1, sFormData, "&")
        pointer1 = delim1 + 1
        length1 = delim1 - pointer2

        If delim1 = 0 Then length1 = lContentLength + 1 - pointer2
        If tmpstring1 = cgiName Then
           tmpstring2 = Mid$(sFormData, pointer2, length1)
           GetCgiValue = UrlDecode(tmpstring2)
           Exit Do
        End If

        If delim1 = 0 Then
           Exit Do
        End If

        delim2 = InStr(pointer2, sFormData, "=")
        pointer2 = delim2 + 1
      Loop

    End Function

    ' 本函数可以对用户输入的数据进行URL解码
    Public Function UrlDecode(ByVal sEncoded As String) As String
      Dim pointer As Long　'sEncoded position pointer
      Dim pos As Long　　　'position of InStr target
      Dim temp As String

      If sEncoded = "" Then Exit Function
      pointer = 1
    '本循环体用于将"+"转换成空格
      Do
        pos = InStr(pointer, sEncoded, "+")
        If pos = 0 Then Exit Do
        Mid$(sEncoded, pos, 1) = " "
        pointer = pos + 1
      Loop

      pointer = 1

    '本循环体用于将%XX转换成字符。对于两个连续的%XX，如果第一个%XX 不是某些特指的Web系统保留字符，将把它们转换成汉字
      Do
        pos = InStr(pointer, sEncoded, "%")
        If pos = 0 Then Exit Do
        temp = Chr$("&H" & (Mid$(sEncoded, pos + 1, 2)))
        If Mid(sEncoded, pos + 3, 1) = "%" And (temp <> ":") And (temp <> "/") _
             And (temp <> "(") And (temp <> ")") And (temp <> ".") And (temp <> ",") _
             And (temp <> ";") And (temp <> "%") Then

           Mid$(sEncoded, pos, 2) = Chr$("&H" & (Mid$(sEncoded, pos + 1, 2)) _
             & (Mid$(sEncoded, pos + 4, 2)))
           sEncoded = Left$(sEncoded, pos) & Mid$(sEncoded, pos + 6)
           pointer = pos + 1
        Else
           Mid$(sEncoded, pos, 1) = temp
           sEncoded = Left$(sEncoded, pos) & Mid$(sEncoded, pos + 3)
           pointer = pos + 1
        End If
      Loop

      UrlDecode = sEncoded
      Exit Function

    End Function

   '本函数可以获得一个唯一的临时文件名
    Public Function TempFile(sPath As String, sPrefix As String) As String
      Dim x As Long，rc As Long

      TempFile = String(127, Chr$(0))
      rc = GetTempFileName(sPath, sPrefix, ByVal 0&, TempFile)
      x = InStr(TempFile, Chr$(0))
      If x > 0 Then TempFile = Left$(TempFile, x - 1)
    End Function

    CGI程序guestbook.bas所要处理的表单如下所示：

    贵宾留言簿

贵宾留言簿测试

      您的姓名:

      您的Email信箱:

      您的主页的URL:

      您的建议:

      您来自:

* 联系地址 清华大学22#楼603房 张移山 邮编 100084
  电子邮件 zhangys@ntl.pim.tsinghua.edu.cn 电话 62782064


留言板

用VB编写留言板 黑龙江省牡丹江市儿童医院内科 张建华 随着网络的普及，越来越多的网站增设了各种实时交互功能，如网上调查、时事论坛、聊天室、留言板等。下面介绍一个使用VB编写CGI脚本程序的实例，使你轻松拥有自己的留言板。 一、基本概念 1．什么是CGI CGI是Common Gate Interface（通用网关接口）的缩写，它运行在Web服务器上，提供同客户端浏览器界面的接口。通过CGI可以使Web服务器执行一些外部程序，并将外部程序所产生的结果返回给Web浏览器。 CGI程序由两部分组成，一部分是超文本页面（html），就是客户端在浏览器中看到的交互式的表单（如调查表和留言板的界面）；另一部分是运行在服务器上的程序（通过点击页面上的“提交”按钮激活）。其基本的交互过程如下： 1） Web浏览器在接到客户端对CGI程序的请求后，首先把要传送的数据（客户输入）进行编码，然后提交给服务器； 2） 服务器调用CGI程序，对输入数据进行相关的解码处理，并把处理后的结果写入指定的输出文件； 3） 服务器读取输出文件并把最终数据发送到客户端，使用户可以在浏览器中看到程序执行的结果。 2．数据的提交方式 如果从客户端向服务器传送的数据量不是很多，即小于1024字节，则可以使用“GET”传输方式，命令的使用方法为：在客户端浏览器的交互式表单的源码中加入如下一行代码
当使用这种方法时，CGI程序从环境变量QUERY_STRING中获取数据（即URL的问号“？”之后的那一部分数据）。 如果要通过CGI程序传送的数据超过了1024字节（URL的最大长度限制），例如论坛中的“帖子”，则要使用“POST”的传输方法。 3．浏览器的编码方式 Web浏览器对客户端的输入信息有统一的编码格式： 1） 用“=”连接提交表单中各元素的Name和Value属性，即以“名称=值”的形式进行编码； 2） 用“&”连接表单中不同的输入项目，例如：“Name＝王哲＆Email＝wangzhes@netease.com”； 3） 若Value属性中存放的数据含有空格，则空格被转换成“+”，如“王 哲”被转换为“王＋哲”； 4） 对URL和Web系统的保留字符编码成十六进制数形式，即%HH。 CGI程序在使用这些数据前必须对它们进行解码，即将数据还原成用户在Web页面上输入时的形式。由于Web系统将汉字当作特殊字符对待，一个汉字被浏览器编码成四位十六进制数（例如%D5%C5），因此在CGI程序中还要对汉字进行一些特殊的解码处理。 二、编制CGI程序 了解了上述CGI的一些基本特征后，我们就可以着手编制自己的留言板脚本程序了。 1．页面设置 首先要新建两个超文本（html）文档，可分别命名为guestbook.htm和databook.htm，其中的guestbook.htm为客户在浏览器中看到的交互式表单页面，其源代码如下： 留言板

请留下您的建议

您的名字:
您的Email:
您的主页地址:
您所在的城市:

留言内容:

在databook.htm文档中存储的是各位来宾的留言，特殊之处是在文件中要使用一个定位字符串“”将文件的开始部分和具体的客户留言部分分开。CGI程序将在“”所在的位置之后插入客户的留言。databook.htm的源文件为： 看留言

查看留言

<留言插入位置> 这样，最新的留言出现在页面的最上端；如果要把最新的留言放在页面的下端，则只需将其中的定位字符串“”移到客户留言部分和HTML文件结尾部分之间的位置就行了。 需注意的是：字符串一定要单独占一行。 2．CGI程序 用VB编写的CGI程序的完整代码附后。 三．程序调试 程序编写完成后，要进行调试排错处理。CGI脚本不同于其他VB程序之处在于，CGI程序不能在个人计算机上进行测试，而要放到服务器上的特定目录下才能执行（一般放在Cgi-Bin目录下）。要实现这一点，对网络管理员来说不成什么问题（因为其具有对服务器的读写操作权限），但对于大多数个人计算机爱好者来说却是一个很大的难题。 因此，要对CGI脚本进行测试，首先要在个人PC机上设置一个Web服务器的调试环境，即先在个人PC上运行Web Server软件来模拟服务器。 由于Windows操作平台的局限性，可在Windows下运行的Server软件并不是很多，比较简单且易于实现的一个方法是使用Windows98光盘中自带的Server工具——Personal Web Server（个人网络服务器）。 1．设置个人Web服务器 在Windws98光盘中的“＼add-one\pws”目录中，点击“Setup.exe”进行安装。整个安装过程比较简单，按屏幕提示操作即可。 安装完成后，在其主画面左侧点击“高级”图标，在虚拟目录列表框内选择“home”目录，点击“添加”按钮，选择“浏览”，选中c:\Inetpub\wwwroot\cgi-bin（其中的盘符视执行安装时的路径而定），在“新虚拟目录”栏内输入“cgi-bin”，然后在访问权限的设置中把“读取”、“执行”、“脚本”各项全选上，点击“确定”按钮。即成功地设置了个人Web服务器。 2． 测试操作 首先，把我们在前面所新建的两个超文本文档guestbook.htm和databook.htm拷贝到c:\Inetpub\webpub子目录内，把编译完的CGI程序guest.exe拷入c:\Inetpub\wwwroot\cgi-bin子目录内；然后，打开浏览器，在地址栏内输入http://127.0.0.1/guestbook.htm，回车；就可以对CGI脚本程序进行测试操作了。 如果在回车后出现请求“拨号连接”的画面，则先点击“取消”按钮，然后在浏览器的“查看->Internet选项->连接”标签中（以IE为例），选择“通过局域网连接到Internet”一项，再点击“确定”即可。 经测试确认无误后，便可以与自己放置主页站点的网络管理员联系，把编制好的留言板脚本程序上传到服务器上了。 需注意一点，如果网络管理员把你的文档放在与前述目录不同的目录中，则要在脚本中做出相应的修改，并重新编译生成EXE执行文件。 附：guest .bas ' 声明部分 Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer _ As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten _ As Long, lpOverlapped As Any) As Long Option Explicit Public StrData(5) As String ' 用于存储表单内各项目的用户输入数据 Public CGI_QueryString As String ' 定义环境变量 Public Const STD_INPUT_HANDLE = -10& Public Const STD_OUTPUT_HANDLE = -11& Public hStdIn As Long ' 标准输入文件句柄 Public hStdOut As Long ' 标准输出文件句柄 Public Ent As String ' 主函数 Sub Main() Dim UrlString As String, Databook As String Dim TempFileName As String, TempString As String Dim Number As Single, I As Integer Ent = vbCrLf hStdIn = GetStdHandle(STD_INPUT_HANDLE) hStdOut = GetStdHandle(STD_OUTPUT_HANDLE) CGI_QueryString = Environ("QUERY_STRING") ' 读取返回字符 TempString = TempString + CGI_QueryString + vbCrLf UrlString = UrlDecode(TempString) TempString = FenGe(UrlString) ' 获得一个随机数作为临时文件名 Randomize Number = Int(10000 * Rnd + 100) ' 随机得到100到10000之间的整数 TempFileName = "YourWebSitePath1 \" & Number ' 注① ' 取得留言簿文件名 Databook = "YourWebSitePath2 \databook.htm" ' 注② Open TempFileName for Output As #1 Open Databook For Input As #2 ' 将留言簿中字符串""前面的内容写入临时文件 Do Line Input #2, TempString Print #1, TempString Loop While TempString <> "" ' 检查客户端用户的输入项 If StrData(1) < " " Then Send "Content-type:text/html" & Ent Send "不要着急，您忘记填写名字了! " Exit Sub End If If StrData(5) < " " Then Send "Content-type:text/html" & Ent Send "对不起，您还没有填写留言的内容。" Exit Sub End If ' 向临时文件中写入客户端用户的留言 Print #1, "
    " & vbCrLf Print #1, "
  • 时间:" & Date & " " & Time Print #1, "
  • 姓名:" & StrData(1) ' 如果不填写以下各项则不显示该项的名称 If StrData(2) > " " Then Print #1, "
  • E-mail:" & StrData(2) & "" If StrData(3) > "http:// " Then Print #1, "
  • 主页:" & StrData(3) & "" If StrData(4) > " " Then Print #1, "
  • 来自:" & StrData(4)

    ' 以下循环查找留言内容中的回车符，将其替换为浏览器能够

    ' 识别的换行符

   Do

       I = InStr(StrData(5), Chr(13))

         If I = 0 Then Exit Do

       UrlString = Mid(StrData(5), 1, I - 1)

       StrData(5) = UrlString + "
" + Mid(StrData(5), I + 1)

   Loop

       Print #1, "
  • 内容:" & StrData(5) & vbCrLf; "
" ' 将留言簿中以前的留言内容写入临时文件 Do Line Input #2, TempString Print #1, TempString Loop While Not EOF(2) ' 关闭打开的文件并将临时文件更名 Close #1 Close #2 Kill Databook Name TempFileName As Databook ' 在客户端显示处理结果 Send "Content-type:text/html" & Ent Send "

您的建议已成功提交
" Send "
" ' 注③ Send "点这里查看结果
" End Sub ' 该子程序用于处理向客户端返回的数据 Sub Send(s As String) Dim lBytesWritten As Long s = s & Ent WriteFile hStdOut, s, LenB(StrConv(s, vbFromUnicode)), lBytesWritten, ByVal 0& End Sub ' 本函数用于对用户输入的数据进行解码 Public Function UrlDecode(ByVal sEncoded As String) As String Dim pointer As Long, pos As Long Dim temp As String If sEncoded = "" Then Exit Function pointer = 1 Do ' 该循环对系统保留字和汉字进行处理 pos = InStr(pointer, sEncoded, "%") If pos = 0 Then Exit Do temp = Chr("&H" & (Mid(sEncoded, pos + 1, 2))) If Mid(sEncoded, pos + 3, 1) = "%" And (temp <> ":") _ And (temp <> "\") And (temp <> "/") Then Mid(sEncoded, pos, 2) = Chr("&H" & (Mid(sEncoded, pos + 1, 2)) _ & (Mid(sEncoded, pos + 4, 2))) sEncoded = Left(sEncoded, pos) & Mid(sEncoded, pos + 6) pointer = pos + 1 Else Mid(sEncoded, pos, 1) = temp sEncoded = Left(sEncoded, pos) & Mid(sEncoded, pos + 3) pointer = pos + 1 End If Loop UrlDecode = sEncoded End Function ' 本函数用于对输入的“Name = Value”数据对进行分解 Public Function FenGe(Cstring As String) As String Dim I As Integer, j As Integer, add As Integer j = 1 Do While InStr(Cstring, "&") <> 0 I = InStr(Cstring, "&") StrData(j) = Mid(Mid(Cstring, 1, I - 1), InStr(Mid(Cstring, 1, I - 1), "=") + 1) j = j + 1 Cstring = Mid(Cstring, I + 1) Loop StrData(j) = Mid(Cstring, InStr(Cstring, "=") + 1) For I = 1 To j ' 该循环用于把字符串内的“+”还原为空格 Do add = InStr(StrData(I), "+") If add = 0 Then Exit Do Mid(StrData(I), add, 1) = " " Loop Next I End Function 注①：“TempFileName = "YourWebSitePath1\" & Number”中的YourWebSitePath1是由网络管理员指定的Web服务器上的绝对路径，用于存放临时文件。若是在自己计算机上进行测试，可以先设定为“c:\windows\temp\”。 注②：本句中的YourWebSitePath2亦是由网络管理员分配的服务器路径，用于存放超文本文档。自己测试时，可以先设定为“c:\inetpub\webpub\”。 注③：在上传时，“webpub”目录要随注②中YourWebSitePath2的改变而改变，不要遗忘，否则要出错。


用VB播放FLASH动画

FLASH是一种矢量格式的动画文件，可以包含动画、声音、超文本链接，而文件的体积却很小。在网页上使用FLASH可以做出很漂亮的动画和动态菜单条。

你想在VB程序里作出类似的效果吗？在VB中使用FLASH自带的Swflash.ocx控件就可以了。方法如下：

首先，打开VB，新建一个工程，在工具箱上单击鼠标右键，选择部件，在部件窗口的控件列表中选择Shockwave flash，然后确定， Flash控件就被加到工具箱上了。

然后将Flash控件放到窗体上，并调整至适当的大小，然后在属性窗口中设置movie属性为Flash动画所在的路。双击窗体在窗体的Load事件中加入下面的代码：

shockwaveflash1.playing=true

按F5就可以看到播放的Flash动画了。（注意，编译后的可执行文件不包含动画文件）如果动画里加上动态按钮，就可以作成动态工具条或动态菜单了。

FLASH控件主要属性列表

属性 值 含义
Scale Model 0 全部显示
1 随控件大小变化
2 缩放至控件大小
Quality 0 低分辨率
1 高分辨率
2 自动降低分辨率
3 自动升高分辨率
Loop True 循环播放
False 不循环播放
Playing True 播放
False 停止
Movie   要播放的动画文件路径
Menue True 显示快捷菜单（运行时在动画上点右键）
False 不显示快捷菜单（实际上还是要显示一个About Flash...)


用VB开发进程管理软件

     进程管理在Windows中是一个比较重要的内容，由于每一个正在运行的程序（包括Windows的后台程序和动态链接库）都对应有各自的进程，通过对进程的管理可以防止一些非法程序（如特洛伊木马程序）的运行，但是Windows的任务管理器（就是按ALT＋CTRL＋DEL后出现的那个东东）虽然能够中止进程，不过它的进程列表里面已经屏蔽了某些与系统有关的进程，现在有的特洛伊木马（如冰河）在编程时将自己注册为系统服务，因此通过Windows的任务管理器并不能中止它的进程；而Windows的系统信息工具msinfo32.exe虽然能够列出系统中所有的进程，但是并不能中止进程，所以也是于事无补。
为此我们可以自己编写一个进程管理软件，首先，它要能够列出系统中的所有进程，其次也要能够中止系统中任意一个进程（当然有些进程中止后将有可能导致死机）。
编程思路：列出系统进程一般的方法是通过调用一组ToolHelp32函数，该组函数存在于kernel32.dll链接库中，它有许多功能，而枚举系统中的进程只是它众多功能中的一项。下面是要用到的几个关于进程的API函数：CreateToolHelpSnapshot()、ProcessFirst()、ProcessNext()。不知道是什么原因，这么重要的函数微软居然并没有将其录入到VB的API文本浏览器中，因此我们只好手工将其录入了，下面是声明：
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long,ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long,uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long,uProcess As PROCESSENTRY32) As Long
此外还需要定义一个PROCESSENTRY32结构，这个结构中包含有有关系统中进程的某些信息，同样在VB中的API文本浏览器里也没有录入。
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
(上接三十三版)th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String＊MAX_PATH
End Type
下面是列出系统进程的步骤：
1.用CreateToolHelpSnapshot()函数来创建系统中进程信息的“快照”，该函数返回一个句柄（该句柄将在下面的函数中得到应用）；
2.用ProcessFirst()函数从以上“快照”中获取进程，该函数有两个参数，第一个是第一步中函数返回的句柄，第二个是指向PROCESSENTRY32结构的指针，当系统中还有其它进程时，该函数返回true；
3.用ProcessNext()函数从“快照”中不断获取进程，直到它返回false为止；
4.用CloseHandle()函数关闭第一步中的句柄。
关闭进程也是一个值得讨论的问题，传统的方法是用GetWindow来查找窗口句柄，再利用GetWindowText来获得窗口的标题，然后利用SendMessage函数发送WM_CLOSE消息来关闭该程序。不过这种方法有很大的缺陷：首先是有的窗口是没有标题栏的，这样的程序是无法通过该方法关闭的；其次，这种方法对动态链接库也是无法关闭的。在这里我们可以充分利用PROCESSENTRY32结构，它里面有一个th32ProcessID成员，通过TerminateProcess()函数就可以关闭进程。
    下面是编程的具体步骤：
    1.新建一工程，在窗体Form1中添加一个ListView控件，二个CommandButton；
2.按如下设置控件：Command1.Caption="查看进程"；Command2.Caption="中止进程"；lvw.width=5400
3.在“工程”中选择“添加模块”，加入上面的函数和结构声明及以下内容：
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long,ByVal uExitCode As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long,ByVal bInheritHandle As Long,ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const TH32CS_SNAPPROCESS=＆H2
Public Const TH32CS_SNAPheaplist=＆H1
Public Const TH32CS_SNAPthread=＆H4
Public Const TH32CS_SNAPmodule=＆H8Public Const TH32CS_SNAPall=TH32CS_SNAPPROCESS＋TH32CS_SNAPheaplist＋TH32CS_SNAPthread＋TH32CS_SNAPmodule
Public Const MAX_PATH As Integer=260
4.添加代码：
Private Sub command1_Click()
Dim i As Long
Dim proc As PROCESSENTRY32
Dim snap As Long
Dim exename As String
lvw.ListItems.Clear         注释：清空所有内容
snap=Create Toolhelp Snapshot(TH32CS－SNAPall,0)    注释：获得进程“快照”的句柄
proc.dwSize=Len(proc)
theloop=ProcessFirst(snap,proc)          注释：获取第一个进程，并得到其返回值
i=0
While theloop<>0        注释：当返回值非零时继续获取下一个进程
exename=proc.szExeFile
ret=lvw.ListItems.Add(,"first" ＆ CStr(i),exename)   注释：将进程名添加到第一项中
lvw.ListItems("first" ＆ CStr(i)).SubItems(1)=proc.th32ProcessID  注释：将进程ID添加到第二项中
i=i＋1
theloop=ProcessNext(snap,proc)
Wend
CloseHandle snap       注释：关闭进程“快照”句柄
End Sub
Private Sub Command2_Click()
Dim i As Long
hand=OpenProcess(process_terminate,True,CLng(lvw.SelectedItem.SubItems(1)))   注释：获取进程句柄
TerminateProcess hand,0       注释：关闭进程
Call command1_Click         注释：调用查看进程来刷新进程列表
End Sub
Private Sub Form_Load()
Dim header As ColumnHeader
lvw.View = lvwReport
lvw.ColumnHeaders.Clear
Set header=lvw.ColumnHeaders.Add(,"first","进程",4000)    注释：设置ListView中项目的宽度，读者也可自行设置
Set header=lvw.ColumnHeaders.Add(,"second","ID",1400)
lvw.Refresh
End Sub
程序的运行界面如图所示。
程序在Windows98中文版、VB6.0中文企业版下运行通过。需要说明的是由于Windows95/98与WinNT中列出系统进程的Windows API函数不同，所以以上程序只能在Win95/98中运行，不能在WinNT及Win2000下运行。（四川 虞东海）


用VB设计聚焦框程序

    什么是聚焦框？在Windows中是这样解释的：当某个按钮被按下或某个控件正在使用时，由一个长方形的虚线框聚焦在此按钮或控件上来提示用户它正起作用。但是并非所有的控件在任何时候都能得到焦点（即得到聚焦框），有时我们在日常的编程中也许会用到它，用来提示用户一些必要的信息。这时你可以这样做：
    说明: 在以下程序中可以使Picture控件得到聚焦框，且程序调用API函数来完成。
    首先，在FORM1上新建一个Picture1和一个Command1，然后输入以下代码：
    Private Declare Function DrawFocusRect Lib ″user32″ (ByVal hdc As Long, lpRect As RECT) As Long
    Private Type RECT
    X1 As Long
    Y1 As Long
    X2 As Long
    Y2 As Long
    End Type
    Dim lpRect As RECT ′在通用中声明调用API函数
    Private Sub Form_Load()
    Form1.WindowState = 2 ′最大化窗口
    Picture1.Picture = LoadPicture(″C:\BMP\1.BMP″) ′请读者根据自己选择图片
    Command1.Caption =″设置聚焦框″
    End Sub
    Private Sub Form_Activate()
    Picture1.Move (Form1.ScaleWidth － Picture1.ScaleWidth) ／ 2, (Form1.ScaleHeight － Picture1.ScaleHeight) ／2′使Picture1居中显示
    End Sub
    Private Sub Command1_Click()
    Dim DENG As Long
    lpRect.X1 = Picture1.Left － 10
    lpRect.Y1 = Picture1.Top － 10
    lpRect.X2 = lpRect.X1 ＋ Picture1.Width ＋ 20
    lpRect.Y2 = lpRect.Y1 ＋ Picture1.Height ＋ 20
    DENG = DrawFocusRect(hdc, lpRect)
    End Sub
    OK，大功告成，按F5运行，通过单击按钮Command1就可以实现Picture1控件被聚焦！ 当然你也可以作适当调整，使它符合你个人的需要。
（上海　季昭君）


用WinSock设计Chat程序
摘要:随着Internet的蓬勃发展，网络界面的交流使我们能够即时收到各地所发生的各项信息。我们在使用各种Browser浏览各网点时，只要Server能提供Chat（闲聊）的服务项目，我们就可以通过Browser所提供的Chat程序与网络上的其他使用者即时对谈及交流心得。本篇文章通过Visual Basic 5.0所提供的WInSock control，设计一个 Chat应用程序。我们通过Client及Server之间的文件传输，可以了解Chat程序的工作原理。

WinSock control简介

WinSock是windows系统提供的一种网络文件传输协议。以往我们使用WinSock设计程序时，必须调用系统提供的API来完成；但是在Visual Basic中调用API，因涉及参数传递类型，用起来并不方便。Visual Basic 5.0 提供WinSock control简化我们的设计流程。它可以利用User Datagram Protocol(UDP)或Transmission Control Protocol(TCP)，来设计网络的Client-Server 程序。

TCP是一种Connection base的Protocol，在文件传输时会先行建立Link，通过Link 可确保文件传输的正确性；UDP则是一种Connectionless的Protocol，它在传输文件时不会确保传输端的文件能够正确无误的传送到接收端，所以当我们使用UDP protocol时，我们通常要自己作接收确认的工作。

UDP protocol看起来好像比较没效率，其实不然！UDP protocol有一个好处：当文件很小，或我们要做网络boardcast （广播）时，会比较有效率。 所以了！ 当我们利用WinSock设计程序时，首先要依自己的需要，决定使用那一种protocol。本文将分别教您使用TCP及UDP Protocol来设计Chat程序。

以TCP设计Chat程序

Step 1：找出Domain name及IP address

在“我的电脑”中选择“控制面板”。Double click“网络”选项，选择“标识” ，您将会发觉您的计算机名称、工作组名等信息。将它记录起来，我们稍后会用到。

Step 2：设计TCP Server程序

在File选项中选New Project建立一个新的工程，在屏幕上会看到许多选项，如 ActiveX Document.EXE、ActiveX Document.DLL、ActiveX.EXE、ActiveXControl等，选Standard.EXE。

接着在Project下选择Property属性选项，在General选项下将ProjectName改为TCP-Server，并将Form名称及Caption更改为Server。在屏幕的Form上加入一个 WinSock control，取名为Tcps；加入两个TextBox control(Outtext、Intext)，并在两个TextBox前加入两个label，分别将caption改为Outtext、Intext。
〈TextBox〉

Name

------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

〈Label〉

Caption

----------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

在Form_Load()中加入以下程序代码，这个动作是设置好我们Local的传输端口，并到接收的状态：

Tcps.protocol=0-scktcp protocol

Tcps.LocalPort = 1002

Tcps.Listen

双击Tcps，在Tcps_ConnectionRequest(ByVal requestID As Long) 中加入以下程序代码，这表示winsock接受了连接请求：

Tcps.Accept requestID

双击Outtext到Outtext_change()，加入以下程序代码，当Outtext内容改变后，文件就会自动送出：

Tcps.SendData Outtext.text

在Tcps_DataArrival(ByVal bytesTotal As Long)中加入以下程序代码，这是用来把所接收的文件显示在Intext这个TextBox中。

Dim S As StrIng

Tcps.GetData S

InText.Text = S

这样我们就完成了Server端的设计。

Step 3：设计TCP Client程序

在File选项中选择New Project建立一个新的工程，在屏幕上看到许多选项，如 ActiveX Document.EXE、ActiveX Document.DLL、ActiveX.EXE、ActiveX Control 等。选Standard.EXE。接着在 Project下，选择Property属性选项，在General选项下，将Project Name改为TCP-Client，并将FORM名称及Caption更改为Client。

在屏幕的Form上加入一个WinSock control，取名为 Tcpc，将protocol property设置成 0-scktcp protocol，加入两个TextBox control(Outtext、Intext)，并在两个TextBox前加入两个Label，分别将其Caption改为Outtext、Intext。接着放入一个Button(button1)并将Caption 改为Connect。

(TextBox)

Name

-----------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

(Label)

Caption

--------------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

〈Button〉

Name Caption

--------------------------------------------------------

Button1(执行建立session命令) Connect

在Form_Load()中加入以下程序代码，这个动作是设置好我们Remote所要连接的传输端口及其网络名称。我们要连接的计算机网络名称为DAVID：

Tcpc.RemoteHost ="David"

Tcpc.RemotePort=1002

双击Outtext到Outtext_change()加入以下程序代码，当Outtext内容改变后，文件会自动送出：

Tcpc.SendData Outtext.text

在Tcpc_DataArrival(ByVal bytesTotal As Long)中加入以下程序代码，这是用来把所接收的文件显示在Intext这个TextBox 中。

Dim S As StrIng

Tcpc.GetData S

InText.Text = S

这样就完成了Client端的设计。

Step 4：测试TCP Chat程序

分别执行Server及Client程序，这时在Client的屏幕上显示In及Out TextBox及一个Connect Button；在Server屏幕上显示In及Out TextBox。

我们按Client程序Connect button建立连接，连接建立成功后，我们可尝试在Client的Outbox 中输入一些字符串：Hello nice to meet you！我们将在Server端的Inbox看到这些字串。 接着我们在Server的Outbox也输入一些字符串：Nice to meet you, too！　我们将在Client 端的Inbox看到这些字符串。结果证明我们成功了！

用UDP设计Chat程序

Step 1：设计第一个UDP(UDP1)程序

在File选项中选择New Project建立一个新的工程，屏幕上会看到许多选项，如ActiveX Document.EXE、ActiveX Document.DLL、ActiveX.EXE、ActiveX Control 等，这时选Standard.EXE。接着在Project下选择Property属性选项，在General选项下将Project Name改为UDP1，将protocol property设置成0-udptcp protocol，并将Form名称及Caption更改为UDP1。

在屏幕的Form上加入一个WinSock control，取名为UDP1；加入两个TextBox control ( Outtext、Intext)，并于两个TextBox前加入两个Label control，分别将Caption改为 Outtext、　Intext。

(TextBox)

Name

-----------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

(Label)

Caption

-------------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

在Form_Load()中加入以下程序代码，这个动作是设置好我们要连接的远端输入端口为 1001，并将输入端口设为1002。

UDP1.RemoteHost = "DAVID"

UDP1.RemotePort = 1001

UDP1.Bind 1002

双击Outtext到Outtext_change()，加入以下程序代码，当Outtext 内容改变，文件会自动送出：

UDP1.SendData Outtext.text

在UDP1_DataArrival(ByVal bytesTotal As Long)中加入以下程序代码，这是用来把所接收的文件显示在Intext这个TextBox 中。

Dim S As String

UDP1.GetData S

InText.Text = S

这样我们就完成了UDP1的设计。

Step 2：设计第二个UDP(UDP2)程序

在File选项中选New Project建立一个新的工程，屏幕上会看到许多选项，如ActiveX Document.EXE、 ActiveX Document.DLL、ActiveX.EXE、ActiveX Control等，这时要选Standard.EXE。接着在 Project下，选择Property属性选项，在 General选项下，将Project Name改为UDP2，将protocol property设置成0-udptcp protocol，并将Form名称及Caption更改为UDP2 。

在屏幕的Form上加入一个WinSock control取名为UDP2 ，加入两个TextBox control ( Outtext、Intext)，并在两个TextBox control前加入两个Label control，分别将Caption改为Outtext、Intext。
(TextBox)

Name

-----------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

(Label)

Caption

--------------------------------------------------------

Outtext(输出文件)

Intext(输入文件)

在Form_Load()中加入以下程序代码，这个动作是设置好我们要连接的远端输入端口，设置为1002，并将输入端口设置为1001。

UDP2.RemoteHost = "MARY"

UDP2.RemotePort = 1002

UDP2.Bind 1001

双击Outtext到Outtext_change()加入以下程序代码，当Outtext内容改变，文件就会自动送出：

UDP2.SendData Outtext.text

在UDP2_DataArrival(ByVal bytesTotal As Long) 中加入以下程序代码，这是用来把所接收的文件显示在Intext这个TextBox 中。

Dim S As StrIng

UDP2.GetData S

InText.Text = S

这样我们就完成了UDP2的设计。

Step 3：测试UDP Chat程序

分别执行UDP1及UDP2程序。这时UDP1的屏幕上显示In及Out
TextBox；UDP2屏幕也显示In及Out两个TextBox。我们在UDP1的Outbox中输入一些字符串 I want talk to Mary，我们将在UDP2端的Inbox看到这些字符串。接着我们在UDP2的Outbox也输入一些字符串This is Mary speaking!，我们将在UDP1端的Inbox看到这些字串。结果证明我们成功了！


用两分法搜索列表框或组合框中的数据

下面的函数能让你在一个已作升序排列的列表框或组合框中查找符合条件的数据。你可以实现精确查找或模糊查找。对这个程序稍微变一下，你就可以在一组已排好序的数组中查找符合条件的数据。该方法的主要好处是对于大量的数据的查找，速度非常之快。例如，一个列表框中有1024条数据，用此法查找只须重复十次，而用传统的方法则要重复512次；如果数据量翻倍，用此法的重复次数为11次，而传统的方法重复的次数也会翻倍。

Windows API提供了四个消息来实现上述的功能。对于列表框是：LB_FINDSTRING和LB_FINDSTRINGEXACT；对于组合框是：CB_FINDSTRING和CB_FINDSTRINGEXACT。但下面的程序则不分列表框和组合框，只要事先对其中的数据排序即可。 代码如下：

?
Function FindExact(Control As Control, Searched As String, _
    Optional StartingIndex As Variant)

Dim I As Long, j As Long, k As Long

FindExact = -1
I = Iif(IsMissing(StartingIndex), 0, StartingIndex)
j = Control.ListCount - 1
Do

    If I > j Then Exit Function

    k = (I + j) / 2

    Select Case StrComp(Control.List(k), Searched)
         Case 0: Exit Do
         Case -1: I = k + 1
         Case 1: j = k - 1
    End Select
Loop

Do While k > 0
    If StrComp(Control.List(k - 1), Searched) Then
        Exit Do
    End If
    k = k - 1
Loop
FindExact = k

End Function

Function FindPartial(Control As Control, Searched As String, _
    Optional StartingIndex As Variant)
Dim I As Long, j As Long, k As Long, lun As Long

FindPartial = -1
I = Iif(IsMissing(StartingIndex), 0, StartingIndex)
j = Control.ListCount - 1
lun = Len(Searched)
Do

    If I > j Then Exit Function

    k = (I + j) / 2

    Select Case StrComp(Left(Control.List(k), lun), Searched)
        Case 0: Exit Do
        Case -1: I = k + 1
        Case 1: j = k - 1
    End Select
Loop

Do While k > 0
    If StrComp(Left(Control.List(k - 1), lun), Searched) Then
     Exit Do
    End If
    k = k - 1
Loop
FindPartial = k

End Function
程序用法如下：

Index = FindExact(Control, Searched[, StartingIndex])
Index = FindPartial(Control, Searched[, StartingIndex])

其中Control代表列表框或组合框的名称，Searched表示搜索条件，StartingIndex为可选参数，表示从哪里开始搜索。函数的返回值为符合条件的数据的索引值。如果未找到符合条件的数据，则返回值为-1.


运用MSChart，生成统计图形

在VB5中生成统计图形

在用VB5进行数据库编程时，经常要生成统计图形。生成的方法有很多种，最
简单的是利用VB5提供的MSChart控件。具体操作方法如下：
    1.首先在VB5“工程”→“部件”中找到“Microsoft Chart Control5.0”项，
选中并应用，此时在工具面板中出现MSChart控件图标。选中它并在新工程的Form1
中画一矩形，生成MSChart1,即出现缺省状态的直方图。设其ColumnCount属性为1。
    2.利用Access或VB5的可视化数据管理器生成一个example.mdb的数据库，在其
中建一名为temp的数据表，包含“日期”和“数据”两个字段，并在表中输入一些
记录。
    3.在Form1中生成一个Command1按钮，然后在Private Sub Command1_click()
中写入以下代码：
    dim i as integer
   dim NewDyn as recordset
    dim OpenWs as Workspace
    dim OpenDB as DataBase
    set OpenWs=DBengine.Workspaces(0)
    set OpenDB=OpenWs.Opendatabase(app.path ＆ ″\example.mdb″)
    set NetDyn=OpenDB.Openrecordset(″select ＊ from temp″,dbOpenSnapShot)
    NewDyn.MoveLast
    NewDyn.Movefirst
    If NewDyn.RecordCount=0 then
    Msgbox″请在数据库中输入数据!″，vbCritical
    Exit sub
    End if
    With MSChart1
    .TitleText=″直方图示例″
    .RowCount=NewDyn.ReordCount
    For i=1 to NewDyn.RecordCount
    .Row=i
    .Data=NewDyn.Fields(″数据″)
    .Rowlabel=NewDyn.Fields(″日期″)
    NewDyn.MoveNext
    Next i
    End With
    NewDyn.Close
    4.运行时按Command1键即可生成统计图表了。
    如果想生成其他类型的图形，修改MSChart1的属性即可定制成其他各种二维或三维
图表。


向文本框等等控件的系统右键菜单里追加自己定义的菜单
 方法是这样的：
     If Button = vbRightButton Then
     ' Make VB discard the mouse capture.
     Text1.Enabled = False
     Text1.Enabled = True

     ' Display the custom menu.
     PopupMenu Menu1
     End If

     其中Menu1是你建立的菜单的名称。


在VB中用定时控件实现长定时操作

Timer控件可用来在一定时间间隔执行操作，然而，一个Timer控件的时间间隔
取值最大为64.767毫秒，这意味着即使最长的时间间隔也不比一分钟长多少（大约
64.8秒），也就是说一个Timer控件只能响应大约一分钟之内的事件。如果要响应
长时间的事件，例如，要开发一个学习系统的自我测试或考试过程，需要限制一个
考试时间，一般都在１０～１５０分钟，开始自动计时，时间到报警考试结束。则
需多个Timer控件配合使用，这样做显得既繁琐又不实用。其实，可以只用一个
Timer控件，在其Timer过程中使用一个计数器，从而响应任意长时间间隔的事件。
下面是一个定时实例的部分代码：

控 件 属 性　　　　 设置的值
Label1 Caption ″请输入限定时间（分钟）：
″
Text1 Text ″″
Command1 Caption ″确认″
Timer1 Interval ６００００
Enabled False
在窗体通用模块General里声明Ｎ、Ｔ两个变量，Ｎ作为计数器，Ｔ用来存放
限定时间。
DIM　Ｎ　AS　Integer
DIM　Ｔ　AS　String
Command1－　Click　（　　）
Ｔ＝Text1.Text
Timer1.Enabled＝True……
    End Sub
Timer1－　Timer（　　）
Ｎ＝Ｎ＋１
if 　n＝val(T)　Then
    Beep
     Timer１.Enabled＝False
     End if
End Sub
将定时器的Interval属性值设为６００００，使得计数器每分钟加１，当然也
可以设置为其他的值，如１０００，这样就使得计数器每秒钟加１，但这样要浪费
较多的系统时间。


在Visual Basic中，在GotFocus事件中快速选定文本
在使用数据输入控件的时，控件中的当前值常常当需要控件获得焦点时进行更新。这就允许用户马上输入一个新值覆盖掉原来的值。下面是完成这个工作的一个过程。

Public Sub FocusMe(ctlName As Control)
注释：
With ctlName
.SelStart = 0
.SelLength = Len(ctlName)
End With
注释：
End Sub

下面在输入控件的GotFocus事件中增加对这个过程的调用：

Private Sub txtFocusMe_GotFocus()
Call FocusMe(txtFocusMe)
End Sub
（完）


在程序中注册和注销 OCX 控件

声明（在本例子里使用的是 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


在文本框中快速增加一串字符
有一种笨方法，可以让你将串字符插入文本框中文本的指定位置，那就是在插入点处将文本分割成两部分，再将要插入的字符同这两部分的文本拼接起来。这种方法费时且不好控制。本文要介绍的就是一种方便而快捷的方法。下面的代码另起一行并将一串字符插入文本的结尾（文本框的MultiLine属性为真)。

Dim temp As String
temp = "Updated: " & Date
With Text1
.SelStart = Len(.Text)
.SelText = vbNewLine & temp
End With
如果你将上面的vbNewLine去掉，再将SelStart属性的值换成你想插入文本的位置，就可以在文本的任意地方插入文本了。


在文本框中实现由加减号输入数据
下面的例子以输入日期为例，向你演示如何用加号或减号来向文本框中输入数据。

本例的关键是使用VB的DateAdd()函数。该函数允许你加减日期、月份及年。

代码

创建一个新工程
在窗体中添加一个文本框控件。
将下面的代码粘贴到窗体的声明段中
运行程序
按加号或减号看看程序运行结果

Option Explicit

Dim TestDate As Date

Private Sub Form_Load()

'获取当前日期
TestDate = Date

'在文本框中显示日期
Text1 = Format(TestDate, "mm/dd/yy")

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 43 Then   ' 43是加号的ASCII代码

    ' 增加一天
    TestDate = DateAdd("d", 1, TestDate)

    ' 使加号不在文本框中显示
    KeyAscii = 0

    ' 显示修改后的日期
    Text1 = Format(TestDate, "mm/dd/yy")

End If

If KeyAscii = 45 Then   ' 45 是减号的ASCII代码

    ' 减去一天
    TestDate = DateAdd("d", -1, TestDate)

    ' 使减号不在文本框中显示
    KeyAscii = 0

    ' 显示修改后的日期
    Text1 = Format(TestDate, "mm/dd/yy")

End If

End Sub


在运行时维护DBGRID的栏位宽度

如果你在运行时改变了DBGRID栏位的宽度，下次用DBGRID时，VB还会使用以前的设
置。下面的程序可以帮你解决这个问题。

Sub DBGridLayout(Operation As String)

'保存DBGrid栏位的宽度

Dim lWidth As Long
Dim clm As Column
Dim lDefWidth As Long

lDefWidth = DBGrid1.DefColWidth

For Each clm In DBGrid1.Columns

With clm

Select Case LCase(Operation)

Case "save"
lWidth = .Width
SaveSetting App.Title, "Cols", CStr(.ColIndex),lWidth

Case "load"
lWidth = GetSetting(App.Title, "Cols",CStr(.ColIndex), lDefWidth)
.Width = lWidth

End Select

End With

Next clm

End Sub

如你所见，本程序用SaveSetting和GetSetting两个函数来保存DBGRIDR的栏位宽度
到注册表中。在窗体的Load和Unload事件中使用这个子程序就可以达到你的目的了。
如：

Private Sub Form_Load()
DBGridLayout "Load"
End Sub

Private Sub Form_Unload(Cancel As Integer)
DBGridLayout "Save"
End Sub


怎样使用VB开发基于Sybase的C/S软件

    Sybase数据库是Sybase公司开发的大型数据库产品，一向以高性能和高可靠性而闻名于市场，在我国的应用已是十分广泛。另外，因为Sybase的存储过程可以按行返回记录，对于复杂的查询，可编写存储过程，因为存储过程是预编译了的（除非你要求调用时编译），所以返回结果非常快，而其它有的数据库存储过程是不能返回记录集的（如Oracle,除非采用Oracle提供的OLE Automation方法）

    在微软Windows大行其道的今天，友好直观的Windows界面成为用户需要，Sybase的PowerBuilder是提供给开发人员的一个方便快捷的开发工具，但从性能上讲它不是最优的,下面我谈谈怎样利用VB5.0和VB6.0在Sybase For NT数据库上进行开发，VB是MicroSoft公司提供的功能强大的开发工具，它在开发C/S数据库软件方面从综合开发周期和性能上来讲较之其它的开发工具有其优势。

    1、配置数据库服务器

    ①、在NT上安装Sybase数据库，直接运行Setup安装程序，在Windows NT Product Selection Screen对话框中，复选language Moudles,并点击Custom，在弹出对话框中US.English和Chinese一定要选取，这样可很好支持中文。

    ②、在接口文件配置中，可稍后配置。

    2、安装Win9x客户端或Win3x客户端

    和服务器安装类似，在Product Set Select 对话框中选取相应产品，即客户端是Win9x选取Windows 95 Products(32-bit versions),客户端是Win3x则选取Windows Products(16-bit versions)。在用SQLEDIT生成接口文件时，注意选取正确的网络协议

    3、安装ODBC驱动程序，微软没有为Sybase提供ODBC驱动程序，你可向经销商索取或到网上去“D”。

    4、以上工作完成后，下面分别就VB5.0和VB6.0同Sybase服务器的连接和操作作一简单介绍。

    在VB5.0中，访问远程数据库的较好方法是通过RDO（当然你也可以用DAO或直接使用ODBC）

    两种：DSN连接和无DSN连接，下示列程序均有说明

    此处打开的是master数据库，数据库服务器名为WIND,SQL Server 11,ODBC驱动程序是Sybase System 11,如用DSN连接，用控制面板ODBC驱动程序管理器，建立的DSN名是SybDSN

    新建工程，在工程菜单中引用Microsoft Remote Data Object 2.0

    Public enTest As rdoEnvironment　　　　 注释：声明rdo环境对象，为工程级全局变量

    Public cnTest As rdoConnection　　 注释：声明rdo连接对象，为工程级全局变量

        注释：最好不设为局部，否则即使断开连接，也将在数据库服务器端中保存连接的缓冲区，将会

        注释：占用服务器资源，甚至可能造成服务器的性能降低甚至死锁。

        注释：定义记录集变量

     Dim rsTest As rdoResultset

     注释：连接子程序

     Public Function connectSybase() As Boolean

         On Error GoTo ErrHandle

         Dim strConnect As String

         Set enTest = rdoEngine.rdoEnvironments(0)

         enTest.UserName = "sa" 注释：用户名

         enTest.Password = "password" 注释：口令

         注释：通过下句与ODBC数据源进行连接，不需用户选择数据源

         Set cnTest = enTest.OpenConnection(dsName:="SybDSN", _

         Prompt:=rdDriverCompleteRequired)

    注释：注意：如果你不想建立DSN,可采取无DSN连接方法如下：

    注释：将上句改为　　　　Set cnTest = enTest.OpenConnection(dsName:="", _

         注释：　　 Prompt:=rdDriverNoPrompt, _

    注释：　　　　　　 Connect:="driver={Sybase System 11};" _

    注释：　　　　 & "srvr=WIND;database=master;")

         connectSybase = True

         Exit Function

    ErrHandle:

         connectSybase = False

    End Function

    Private Sub Form_Load()

     Dim strSQL As String

    if connectSybase then

    strSQL="Select * from sysusers" 注释：strSQL可以是SQL语句（块），存储过程

    Set rsTest = cnTest.OpenResultset(strSQL, rdOpenDynamic)

    else

    msgbox "打开数据库失败"

    Exit sub

    end if

    Do Until rsTest.EOF

    Debug.print rstest.fields(0),rstest.field(1)

    rsTest.MoveNext

    Loop

    End Sub

    VB6.0的在数据库方面的新特性，使用ADO对象，和OLE DB。微软建议新的数据库工程采用ADO。此处先将ADO，OLE DB作一简介:

    ADO使得客户端应用程序能够通过任何OLE DB提供者来访问和操作数据库服务器中的数据。ADO最主要的优点是易于使用、速度快、内存支出少 和磁盘遗迹小。

    OLE DB是新的底层接口。它定义了一种通用的数据访问范例。也就是说，OLE DB并不局限于ISAM、Jet甚至关系数据源，但是它能够处理任何 类型的数据，而不考虑它们的格式和存储方法。由于接口比较复杂，不能在Visual Basic中直接访问OLE DB。ADO封装并且实现了OLE DB的所有功能。 VB 6.0对ADO有完整的支持，可以通过ADO、OLE DB的接口，调整OLE DB的灵活性。甚至可以在VB中创建自己的OLE DB提供程序。

    ADO的另一个功能是远程数据访问(RDS)，能够通过一个往返传输将数据从服务器移动到客户端应用程序或Web页中，然后在客户端对数据进行操作，最后将更新数据返回服务器。RDS现在的版本是RDS 1.5。RDS已与ADO编程模块合并以简化客户端数据的远程调用。

    有关ADO的更详细信息，读者可查阅MSDN中的相关文档。

    VB6.0也可通过RDO和Sybase数据库进行连接，连接方法和VB5.0一样,但ADO较RDO有更大的优越性。

    VB6.0用ADO连接Sybase数据库采用OLE DB For ODBC Driver

    新建工程，在工程菜单中引用Microsoft ActiveX Data Object 2.0 Library

    Public cnTest As New ADODB.Connection　　　　 注释：声明ADO连接对象，为工程级全局变量

        注释：连接子程序

    Public Function connectSybase() As Boolean

     On Error GoTo ErrHandle

     Dim strConnect As String

     注释：通过下句与ODBC数据源进行连接，不需用户选择数据源

     strConnect = "Provider=MSDASQL.1;Persist Security Info=False;" _

             & " Extended Properties=注释：DSN=chs;SRVR=WIND;DB=master;UID=sa;PWD=注释："

     cnTest.Open strConnect

             注释：注意：如果你不想建立DSN,可采取无DSN连接方法如下：

             注释：将上句改为 strConnect="Provider=MSDASQL.1;DRIVER={Sybase System 11}; " _

             注释：　　 & " Persist Security Info=False;DSN=;" _

     & " SRVR=WIND;DB=master;UID=sa;PWD=password"

     注释：Persist Security是否采用集成安全机制

     connectSybase = True

     Exit Function

    ErrHandle:

    connectSybase = False

    End Function

    Private Sub Form_Load()

     Dim rsTest As New ADODB.Recordset

     Dim strSQL As String

     If connectSybase Then

         strSQL = "Select * from sysusers" 注释：strSQL可以是SQL语句（块），存储过程

         rsTest.CursorLocation = adUseClient

         rsTest.Open strSQL, cnTest　　　　 注释：cnTest为打开的活动的连接

     Else

         MsgBox "打开数据库失败"

         Exit Sub

     End If

     Do Until rsTest.EOF

         Debug.Print rsTest.Fields(0), rsTest.Fields(1)

         rsTest.MoveNext

     Loop

    End Sub

    以上只谈了和Sybase数据库的连接及简单的查询，其它操作对程序员来讲和其它数据库的编写大致相同，读者可自行编写复杂的SQL语句对数据库进行增、删、改等操作。


怎样在运行时动态生成多个相同的控件

窗体上放一个COMMAND按钮，假定命名为cmd，将index设置成0,visible=False
控制的核心的代码是：
For i = 1 to 按钮总数
Load cmd(i)
cmd(i).Caption = 你指定的按钮名称
cmd(i).visible = True
Next i
特别的，在循环结束以后，你的程序应该自动根据你的要求对cmd的TOP,LEFT属性
进行重排


直接编辑VB中网格控制项的两种方法

网格控制项是VB For Windows提供的一个强有力的自定义控制项,它以网格的形式提供给用户,使用户可以快速直观地显示或编辑数据库、图片库、数组等大型数据集合。

网格中行和列的每一个交点称为单元格,单元格中可以放入文字或图片,用户可以对其中的内容进行读写操作。网格控制项的属性Col和Row指定了当前单元格在网格中的位置,这是对网格进行操作的前提条件。我们可以通过下面三种方法来指定当前单元格:

(1) 利用程序代码来指定;

(2) 运行期间用方向键的移动来指定;

(3) 运行期间用鼠标左键单击单元格来指定。

用Text属性可以引用或设置当前单元格的内容。

网格控制项共有49个属性(Property),14个事件(Event)和7个方法(Method),上文只介绍了和本文有关的属性,其它内容读者可参阅有关书籍。另需说明一点,在应用程序中使用网格控制项之前,必须用File菜单中的AddFile命令在工具箱中加入Grid.VBX文件。

网格控制项的功能非常强大,但令人遗憾的是,它未提供对单元格的编辑功能。用户只能通过对当前单元格的Text属性编程来读写单元格内容,而且这种方法是对静态数据的读写 ,毫无编辑功能可言。

针对上述问题,笔者提出了两种解决方法,取得了较好的应用效果,现分别介绍如下。

一、间接法
间接法的思路是,利用VB提供的可编辑的文本控制项作为中介,通过文本控制项的Change事件触发,实时地将文本控制项的内容传送给网格控制项。也就是说,通过文本控制项的编辑达到间接编辑网格控制项的目的。其程序代码如下:

Private Sub Form__Load()
Grid1.Row=0
For i=1 To 4
Grid1.Col=i
Grid1.Text=i
Next i
Grid1.Col=0
For i =1 To 3
Grid1.Row=i
Grid1.Text=i
Next i
End Sub

Private Sub Grid1__Click()
Text1.Text=""
Text1.SetFocus
End Sub

Private Sub Text1__Change()
Colnum=Grid1.SelStartCol
Rownum=Grid1.SelStartRow
Grid1.Col=Colnum
Grid1.Row=Rownum
Grid1.Text=Text1.Text
End Sub

由于间接法采用了文本框进行编辑,不但支持常规的文字编辑,而且还支持标记、剪贴等各种高级编辑,所以它具有很强的编辑功能。但其缺点也是显然的:为了编辑网格,必须加入一个文本框,这势必会影响屏幕布局;加之含义不清,容易引起误解。

二、直接法
直接法的思路是,利用网格控制项的KeyDown和KeyPress事件检测用户的按键操作,通过对不同按键的分析,采取相应的字符串处理方法直接处理Text内容(也就是说自己编制处理字符串的程序),从而达到直接编辑单元格的目的。其程序代码如下:

Sub Grid1__KeyDown(KeyCode As Integer,Shift As Integer)
If KeyCode=46 Then grid1.Text=""
’Del键将清除当前网格单元格的内容
End Sub

Sub Grid1__keyPress(keyasciiAslnteger)
Select Case keyascii
Case 8
’处理退格键
If Len(grid1.Text)=0 Then Exit Sub
grid1.Text=Left$(grid1.Text,Len(grid1.Text)-1)
Exit Sub
Case 46
’处理小数点
grid1.Text=grid1.Text+"."
Exit Sub
Case 45
’处理负号
grid1.Text=grid1.Text+"-"
Exit Sub
Case 43
’处理正号
grid1.Text=grid1.Text+"+"
Exit Sub
End Select
If(keyascii＜48 Or keyascii＞58) Then
’处理非数字
Beep:Exit Sub
End lf
grid1.Text=grid1.Text+Right(Str(keyascii-48),1)
End Sub


自制IE风格按纽控件
刘清涛
---- 网上的IE风格按纽控件不可谓少，然而天下的免费午餐总不会让你轻轻松松到吃下去， 其中个味众人自知。其实，在VB6.0中，IE风格按纽很容易制作，真正的核心代码只需 调用两个API函数。

---- 按常规，IE风格按纽的制作原理是，放置四条边线在Image和Label控件四周，在 Image和Label控件的MouseMove事件中，改变左，上，右，下线的Visible 和 BorderColor属性,按纽呈现浮起效果，同时改变Image控件的Picture 属性，调入盘旋 （Hover）图片；在Image和Label的MouseDown事件中通过改变Image和Label控件的位置 （右下移）按纽呈现按下效果；鼠标离开按纽，按纽恢复平坦（Flat）状态。

---- 如果你正在这样做，将会发现一个致命的问题。那就是，MouseMove事件只能检测到 鼠标在Image和Label两个控件本身范围内的移动，你没有办法检测鼠标的离开。 “计算机世界”曾经登载过一个解决的办法，利用SetCapture和ReleaseCapture API函数。经SetCapture设定的控件可以强制性地捕捉鼠标在整个屏幕上的移动。 这样，不管鼠标是不是在控件界面范围内移动，控件都可以捕捉得到。经过 实践发现这个解决方案仍然存在一个问题，那就是，SetCapture所设定控件在 ReleaseCapture前，自动提示(ToolTipText)功能被抑制。这意味着这样编制的按纽没 有自动提示功能，对很多人来说，这难以忍受。

---- WIN32 API函数集是个不折不扣的庞大宝藏，你总能从里面找到你需要的工具。 GetCursorPos和WindowFromPoint两个函数可以完美地解决这个问题。 GetCursorPos可以返回鼠标指针相对整个屏幕的坐标，WindowFromPoint 则根据鼠标指针的坐标，返回指针所处的控件的句柄。在这里，还需要引入一个定时器 (Timer)控件。

---- 整个编程原理是，在UserControl_Show事件中，先将定时器置为无效。 在Image和Label的MouseMove事件中，执行使按纽浮起的代码，然后将定时器置为有效， 这时定时器开始倒计时，在计时器的Timer事件中，用上述API函数检测鼠标指针是否 已经离开了按纽，如果离开，则使按纽恢复平坦状态并立即使计时器无效，否则继续 检测。我们看到，计时器的真正用途是用来触发事件，以检测鼠标的离开。 将计时器置为无效是为了在不必要的时间，降低计时器对CPU的占用。

---- 以下是函数和所需数据类型声明。

Private Type POINTAPI
     X As Long
     Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32"  _
(lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, ByVal yPoint As Long) As Long

---- 在VB6.0中新建一个ActiveX Control项目。添加LineLeft,LineTop,LineRight, LineBottom四条边线，一个Image控件Image1,一个Label标签控件Label1,一个定时器 控件Timer1。关于用VB创建ActiveX控件的步骤这里不作描述（可以参考本文所附 完整源代码）。与按纽制作有关的主要代码如下：

Private Sub UserControl_Show()
Timer1.Interval = 1   '1/1000 秒
Timer1.Enabled=False  '关闭定时器
'将UserControl的提示信息引入Image1,Label1控件，
If UserControl.Ambient.UserMode = True Then
     '在RunTime
   Image1.ToolTipText = UserControl.Extender.ToolTipText
   Label1.ToolTipText = UserControl.Extender.ToolTipText
End If

......'此处添加其它代码
End Sub

Private Sub Image1_MouseMove
(Button As Integer, Shift As Integer,  _
 X As Single, Y As Single)
    .......  '此处添加使按纽呈现浮起效果的代码
    Timer1.Enabled = True  '打开定时器
End Sub

Private Sub Timer1_Timer()  '定时器触发
Dim MousePosition As POINTAPI
Dim ReturnValue As Long
Dim HwndHoverWindow As Long

ReturnValue = GetCursorPos(MousePosition)
   '返回鼠标指针坐标
'返回指针所指位置的控件句柄
HwndHoverWindow = WindowFromPoint
(MousePosition.X, MousePosition.Y)
If HwndHoverWindow < > UserControl.hWnd Then
'如果鼠标离开了按纽区域
   ......  '此处添加使按纽恢复平坦状态的代码
   Timer1.Enabled = False   '将定时器关闭，
以释放资源
End If
End Sub

Private Sub Image1_MouseDown
(Button As Integer, Shift As Integer,  _
 X As Single, Y As Single)
    If Button = 1 Then
 .......  '此处添加使按纽呈现按下状态的代码
    End If
End Sub


自制控件方面的有关知识

在程序中注册和注销 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

2.
建立可下拉选择的属性
例如在 BorderStyle 中有以下的四个选择：
0 - None
1 - Dashed
2 - Single Line
3 - Double Line
4 - 3D
首先在控件中定义以下的集合：
Enum BorderType
None
Dashed
[Single Line]
[Double Line]
[3D]
End Enum
然后就可以把属性的类型设置好：
Public Property Get BorderStyle() As BorderType
Border = m_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As BorderType)
m_BorderStyle = New_BorderStyle
PropertyChanged "BorderStyle"
End Property

3.
缺省值和可选参数
VB5 加强了函数参数方面，可用以下的代码实现参数缺省：

Property Get Value(Optional index As Long = 1)
...
End Property
也可使用另一个方法（慢）：

Property Get Value(Optional index As Long)
If IsMissing(index) Then index = 1
...
End Property

4.
多个参数的属性
在自制的控件中，可能需要对某个属性传递多个值：

Property Let Test (arg1 As String, arg2 As String, arg3 As Integer)
End Property

'用以下的方法传递参数：
Test(arg1,arg2) = arg3

5.
使用数组做属性
定义一个 variant 类型的属性，即可用它来做数组。
下面定义了一个 CArray 类。

Private m_MyArray As Variant

Public Property Get MyArray() As Variant
MyArray = m_MyArray
End Property

Public Property Let MyArray(a As Variant)
m_MyArray = a
End Property

可用以下的方法使用：

Private m_Array As CArray
Private mArr(3) As String

Private Sub Form_Load()
Set m_Array = New CArray
mArr(1) = "One"
mArr(2) = "Two"
mArr(3) = "Three"
m_Array.MyArray = mArr()
'或者
'm_Array.MyArray = Array("One", "Two", "Three")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = 1 To UBound(m_Array.MyArray)
MsgBox m_Array.MyArray(i)
Next
End Sub


01            ,             01.txt
《 VB6.0中通过MSChart控件调用数据库 》<END>
02            ,             02.txt
《 用VB6实现动态增减控件 》<END>
03            ,             03.txt
ActiveX控件的创建<END>
04            ,             04.txt
ADO控件和DATA控件的冲突（不能共存）的解决方法<END>
05            ,             05.txt
Combo的自动查询技术<END>
06            ,             06.txt
DirectX7.0使用心得（1）<END>
07            ,             07.txt
DirectX7.0使用心得（2）<END>
08            ,             08.txt
DirectX7.0使用心得（3）<END>
09            ,             09.txt
FSO对象模型在VB中的应用<END>
10            ,             10.txt
MsComm 控件的文字传输范例<END>
11            ,             11.txt
Office或IE4风格的ToolBar<END>
12            ,             12.txt
Regsvr32.exe注册控件的具体用法<END>
13            ,             13.txt
TextBox的自动调节<END>
14            ,             14.txt
TextBox实现打印机效果<END>
15            ,             15.txt
TreeView的基本操作<END>
16            ,             16.txt
VB5中DBGRID控件在VB6中使用<END>
17            ,             17.txt
VB6.0动态加载ActiveX控件漫谈<END>
18            ,             18.txt
VB与MS-Draw开发通用作图软件<END>
19            ,             19.txt
VB中APP对象及其应用<END>
20            ,             20.txt
VB中list控件的功能扩充<END>
21            ,             21.txt
VB中防止将重复项目添加到列表框控件中<END>
22            ,             22.txt
VB中用Multimedia MCI控件开发多媒体应用<END>
23            ,             23.txt
Win Api在VB中的妙用<END>
24            ,             24.txt
WINDOWS SCRIPT HOST对象在VB中的使用<END>
25            ,             25.txt
安装向导生成程序组并建立多个程序项<END>
26            ,             26.txt
保存复选框选项<END>
27            ,             27.txt
不用OCX来创建自己的控件（一）<END>
28            ,             28.txt
成组更新控件属性<END>
29            ,             29.txt
创建数据驱动窗体<END>
30            ,             30.txt
得到鼠标位置<END>
31            ,             31.txt
调整 Combo 下拉部分的宽度<END>
32            ,             32.txt
动态加入控件到VB控件数组中<END>
33            ,             33.txt
对ListView中的列排序<END>
34            ,             34.txt
放一个Combo到Toolbar中<END>
35            ,             35.txt
改变 ListIndex而不发生 Click 事件<END>
36            ,             36.txt
改变 TreeView 的背景<END>
37            ,             37.txt
改进ＶＢ的驱动器列表框<END>
38            ,             38.txt
给TreeView控件添加弹式菜单<END>
39            ,             39.txt
功能强大的增强列表框 ――VB6控件LISTVIEW使用指南<END>
40            ,             40.txt
计算从开机到现在用了多少秒<END>
41            ,             41.txt
将立体的ListView标题栏转换成平面式的标题栏<END>
42            ,             42.txt
禁用窗体上所有控件<END>
43            ,             43.txt
拷贝或移动列表框或组合框中的内容<END>
44            ,             44.txt
利用VB5开发ActiveX控件<END>
45            ,             45.txt
利用VB三维面板控件设计流动条<END>
46            ,             46.txt
浅谈用VB6.0编写BO程序<END>
47            ,             47.txt
巧用Visual Basic的TIMER控件<END>
48            ,             48.txt
取得控件绝对Top值<END>
49            ,             49.txt
如 何 解 决VB 中 的Grid 控 件 的 打 印 问 题<END>
50            ,             50.txt
如果自定义 MsgBox 的按钮,标题等<END>
51            ,             51.txt
如何创建数据绑定控件<END>
52            ,             52.txt
如何检查您的电脑是否打开 ActiveDesktop？<END>
53            ,             53.txt
如何解决VB中的Grid控件的打印问题<END>
54            ,             54.txt
如何强制文件对话框再次读取正确的磁盘<END>
55            ,             55.txt
如何取得RichTextBox控件中光标所在行的值？<END>
56            ,             56.txt
如何让用户自行输入方程式，并计算其结果？<END>
57            ,             57.txt
如何设定 MsgBox 在若干时间之后若无回应則自动关闭？<END>
58            ,             58.txt
如何使用VB控件Commom Dialog<END>
59            ,             59.txt
如何用VB6写COM组件（二）<END>
60            ,             60.txt
如何用VB6写COM组件（一）<END>
61            ,             61.txt
如何在VB中使用Delphi的控件<END>
62            ,             62.txt
如何在运行时动态增加控件<END>
63            ,             63.txt
显示和隐藏鼠标<END>
64            ,             64.txt
隐藏文本框控件的环境菜单<END>
65            ,             65.txt
用ActiveX Control Pad<END>
66            ,             66.txt
用API函数改进ListView 控件的显示效果<END>
67            ,             67.txt
用VB6.0中文版进行DHTML程序开发<END>
68            ,             68.txt
用VB编写标准CGI程序<END>
69            ,             69.txt
用VB编写留言板<END>
70            ,             70.txt
用VB播放FLASH动画<END>
71            ,             71.txt
用VB开发进程管理软件<END>
72            ,             72.txt
用VB设计聚焦框程序<END>
73            ,             73.txt
用WinSock设计Chat程序<END>
74            ,             74.txt
用两分法搜索列表框或组合框中的数据<END>
75            ,             75.txt
运用MSChart，生成统计图形<END>
76            ,             76.txt
在vb的文本框等等控件的系统右键菜单里追加自己定义的菜单。<END>
77            ,             77.txt
在VB中用定时控件实现长定时操作<END>
78            ,             78.txt
在Visual Basic中，在GotFocus事件中快速选定文本<END>
79            ,             79.txt
在程序中注册和注销 OCX 控件<END>
80            ,             80.txt
在文本框中快速增加一串字符<END>
81            ,             81.txt
在文本框中实现由加减号输入数据<END>
82            ,             82.txt
在运行时维护DBGRID的栏位宽度<END>
83            ,             83.txt
怎样使用VB开发基于Sybase的软件<END>
84            ,             84.txt
怎样在运行时动态生成多个相同的控件<END>
85            ,             85.txt
直接编辑VB中网格控制项的两种方法<END>
86            ,             86.txt
自制IE风格按纽控件<END>
87            ,             87.txt
自制控件方面的有关知识<END>