征集大家开发过程中用到的公共函数，子程序(续四)

Question

感谢众高手捧场，我等获益非浅！再开一贴
好的东西共同分享,减少重复劳动
满5个结贴，另开新贴

Answer 1

SHELL语句用法心得一. 调用系统“创建快捷方式”向导
　　是否为VB不支持创建快捷方式而于着急呢？虽然您可以调用vb5stkit.dll中的fCreateShellLink函数，但它是为安装程序设计的，快捷方式的默认路径总是从当前用户的“\Start Menu\Programs”开始，也就是说，如果您的Windows95装在C盘上，您无法通过 fCreateShellLink 函数把快捷方式创建到D盘上去。
　　现在，给大家介绍一种极为方便、巧妙的方法： 用Shell语句调用系统“创建快捷方式”向导。 
　　新建一个项目，在窗体上放一个按钮，双击此按钮，加入以下代码： Private Sub Command1_Click() 
　　Open App.Path & "\temp.lnk" For Output As #1 
　　Close #1 '以上两句在程序所在目录建立一个临时文件 
　　Shell "Rundll32.exe AppWiz.Cpl，NewLinkHere "& App.Path & "\temp.lnk" 
End Sub 　　（注意：Shell语句中NewLinkHere后面跟着一个空格才是引号，否则将出错。） 
　　运行程序，按一下命令按钮，怎么样？“创建快捷方式”向导出现了，如果创建成功，快捷方式将取 代临时文件temp.lnk的位置，如果选取消，temp.lnk 也会自动消失。当然，您可以在硬盘的任意位置建立 temp.lnk。好，现在又可以为您的程序增添一项新功能了。Enjoy！ 二. Rundll32.exe的用途 
　　我们知道，用Shell语句只能调用可执行文件，即 exe、com、bat 和 pif 文件，有时我们想要调用其他一 些系统功能该怎么办呢？此时，Windows提供的 Rundll32.exe可大显身手了。下面我们来认识一下这些用法，也许会给您带来一点惊喜。
　　1．要打开设置系统时间的控制面板文件 (Timedate.cpl),只需运行如下代码：
　　Shell "Rundll32.exe
　　Shell32.dll,Control_RunDLL Timedate.cpl" 
　　至于打开其他控制面板文件，相信您一定能够举一反三，尝试一下，换个文件名就成了。
　　2．要运行某一快捷方式（*.lnk）则可以用以下代码：
　　She11 "Rundll32.exe url.dll, FileProtocolHandler X" 
　　(X代表要运行的文件，包括路径，下同。)
　　3. 也可以这样写来打开ActiveMovie控制：
　　Shell "RUNDLL32.EXE amovie.ocx，Rundll",1
　　而用Shell "RUNDLL32.EXE amovie.ocx，Rundll /play X",1 将直接播放媒体文件。
　　4. Shell "rundll32.exe desk.cpl，InstallScreenSaver X”当然是安装屏幕保护啦，如果你写了一个屏幕保护程序，那么可以在安装程序中写上它，而不一定要装到system目录下。顺便提一下，VB不是自捞一个“Application Setup Wizard”么？它的VB源代码都在安装目录下的 “\setupkit\setup1”中放着呢，好好把它研究一下。 你完全能做出富有个性的安装程序来。 
　　5.按住shift键，右击某一文件，菜单中会出现 “打开方式”选项，这也许已不是什么秘密。但现在， 用shell "rundll32.exe shell32.dll OpenAs_RunDLL X" 便能直接调用“打开方式”框。 
　　6. 甚至能用这样一句来打印文件(包括HTML所 支持的所有文本与图像格式): 
　　Shell "rundll32.exe MSHTML.DLL，PrintHTML X”, 1

Answer 2

根据窗口界面的大小，图像大小和图形方式下的文字的大小的相应调整，则是一个图形应用软件要做到的基本要求之一。利用VB中的IMAGE控件可以实现图像缩放、相应调整，可以使软件界面更清晰、友好。 具体编程如下： Option Explicit Private mydb As Database 
Private myrs As Recordset 
Private mystate As Byte 
Private sql As String 
Public z 
（定义 z 为公共变量） Private Sub a_Click() 
Form2.Show 
Form3.Hide 
End Sub 
（不同的按钮，触发不同事件） 
Private Sub f_Click() 
End 
End Sub 
Private Sub b_Click() 
Form4.Show 
End Sub 
Private Sub g_Click() 
z = 1 
End Sub Private Sub h_click() 
z = 2 
End Sub Private Sub im1_Click() 
Dim zh, fan As Integer 
（定义 zh 和fan 为整形变量） If Im1.Width < Pi1.Width Then 
HS1.Visible = False 
Else 
HS1.Visible = True 
End If 
If Im1.Height < Pi1.Height Then 
vs1.Visible = False 
Else 
vs1.Visible = True 
End If If z = 1 Then 
（放大图象按钮被触发的时候，执行以下程序） 
Im1.Width = 1.1 * Im1.Width 
Im1.Height = 1.1 * Im1.Height 
For zh = 0 To 13 
Image1(zh).Left = 
-480 + 1.1123 * (Image1(zh).Left + 480) 
Image1(zh).Top = 1.111 * (Image1(zh).Top) 
Next zh End If 
If z = 2 Then 
（缩小图象按钮被触发的时候，执行以下程序） 
Im1.Width = 0.9 * Im1.Width 
Im1.Height = 0.9 * Im1.Height 
For zh = 0 To 13 
Image1(zh).Left = 
-480 + 0.89 * (Image1(zh).Left + 480) 
Image1(zh).Top = 0.89 * (Image1(zh).Top) 
Next zh End If 
Text1.Visible = False 
HS1.Max = Im1.Width 
vs1.Max = Im1.Height 
End Sub Private Sub hs1_change() 
Im1.Left = -HS1.Value 
End Sub Private Sub vs1_change() 
Im1.Top = -vs1.Value 
End Sub Private Sub im1_mousedown 
(button As Integer, shift As 
Integer, x As Single, y As Single) 
If button = vbRightButton Then 
（鼠标按下后触发其它的弹出式菜单） 
PopupMenu popup 
End If 
End Sub Private Sub Image1_Click(Index As Integer) 
Dim v As Long 
Text1.Visible = True v = Index 
Set mydb = OpenDatabase("c:\p\kuang.mdb") 
sql = "select tong.编码,tong.内容 from tong" 
Set myrs = mydb.OpenRecordset(sql, dbOpenSnapshot) 
myrs.Move v （根据当前坐标点的位置进行调整） 
Text1.Text = myrs.Fields("内容") 
End Sub 

Answer 3

用Access做后台数据库，在局域网内访问数据库中的内容的示例：
你首先要在VB菜单中：
“工程”－－＞“引用”－－＞“Microsoft AxtiveX Data Objects 2.X Library”
注：2.X为版本号，如果你机子上有高版本的就用高版本的，如：2.5或2.6的。
　　"工程"－－＞“部件”－－＞“MicroSoft DataGrid Control 6.0”
示例：
Private Sub ComOK_Click()
   Dim SQLstr As String,cnstr AS String
　 Dim cn AS New ADODB.Connection'连接对象
   Dim rs As New ADODB.Recordset'记录集对象
   cnstr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=\\myServer\c:\inetpub\wwwroot\yourdb.mdb" '连接字符串
   cn.open' 打开数据库连接
   rs.CursorLocation =adUseClient
   sqlstr="slect * from XXX表"
   rs.open sqlstr,cn,3,3'执行SQL语句，并返回记录
   set datagrid1.datasource=rs
   datagrid1.refresh
   rs.close'关闭记录集对象
   set rs=nothing
End Sub
本示例是将数据库中的一张表的记录显示在datagrid的控件中。
注：myserver为服务器名可以为IP地址。

Answer 4

用ADO访问foxpro的自由表、foxpro数据库中的表的及早期Dbase格式的表的记录的示例：
你首先要在VB菜单中：
“工程”－－＞“引用”－－＞“Microsoft AxtiveX Data Objects 2.1 Library”
"工程"－－＞“部件”－－＞“MicroSoft DataGrid Control 6.0”数据类型：自由表
示例：Private Sub cmddisp_click()
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim cnstr As String
  cnstr = "Driver={Microsoft Visual FoxPro Driver};" & _
           "SourceType=DBF;" & _
           "SourceDB=" & app.path & "\data" & _
           "Exclusive=No"
  cn.Open cnstr
  rs.CursorLocation = adUseClient
  rs.Open "select * from XXX.DBF", cn, adOpenKeyset, adLockBatchOptimistic
  Set DataGrid1.DataSource = rs
  DataGrid1.Refresh
  rs.close
  set rs=nothing
End Sub以上示例程序的作用是将XXX.dbf表中的数据显示在datagrid1控件中。数据类型：数据库
示例：Private Sub cmddisp_click()
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim cnstr As String
  cnstr ="Driver={Microsoft Visual FoxPro Driver};" & _
           "SourceType=DBC;" & _
           "SourceDB=" & app.path & "\data\yourdbname.dbc;" & _
           "Exclusive=No" 
  cn.Open cnstr
  rs.CursorLocation = adUseClient
  rs.Open "select * from XXX.DBF", cn, adOpenKeyset, adLockBatchOptimistic
  Set DataGrid1.DataSource = rs
  DataGrid1.Refresh
  rs.close
  set rs=nothing
End Sub数据类型：早期Dbase格式的dbf文件
示例：Private Sub command1_click()
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim cnstr As String
  cnstr = oConn.Open "Driver={Microsoft dBASE Driver (*.dbf)};" & _
           "DriverID=277;" & _
           "Dbq=" & app.path & "\data"
  cn.Open cnstr
  rs.CursorLocation = adUseClient
  rs.Open "select * from XXX.DBF", cn, adOpenKeyset, adLockBatchOptimistic
  set datagrid1.datasource=rs
  datagrid1.refresh
  rs.colse
  set rs=nothing
End Sub

Answer 5

1、为树状浏览器控件添加节点和子节点 　　用ADD方法添加一个新节点到树状浏览器的NODES集合时，可以声明它是和已
存在的节点所联系起来的。通常使用ADD方法，其语法如下： 　　　Nodes.Add(relative,[relationship][,key][,text][,image][,selectedimage]) 　　各个参数的意义如下：　　　relationship 参数是通过关系节点参数与新节点连接的另一个节点；
　　　relationship 参数可能是以下情况： 
　　　　　tvwlast--1；该节点置于所有其他的在relative中被命名的同一级别
的节点的后面 
　　　　　tvwNext--2；该节点置于在relative中被命名节点的后面 
　　　　　tvwPrevius--3；该节点置于在relative中被命名的节点的前面 
　　　　　tvwChild--4；该节点成为在relative中被命名的节点的的子节点 　　下面是一个例子：　　　Dim node1,node2,node3,node4 as Node 
　　　set Node1=TreeView1.Nodes.Add 
　　　TreeView1.Nodes(1).text="node1" 
　　　TreeView1.Nodes(1).key="node1" 
　　　Set node2=treeview.nodes.add("node1",tvwChild,"node2") 
　　　TreeView1.Nodes(2).text="node2" 
　　　TreeView1.Nodes(2).key="node2" 　　依次插入节点即可。 2、为节点插入图象 　　　treeview1.node(3).image="leaf" 　　注意我们一般从imagelist中指定图象 3、处理节点的点击，怎样才能知道树状浏览器的哪一个节点被点击了呢？可以用
NodeClick 事件:　　　public sub treeview1_nodeclick(byval node as comctllib.node) 
　　　text1.text="you click"&node.text 
　　　end sub 

Answer 6

在VB中调用CHM 帮助的几种方法 一个应用程序不论编制得如何完美，在很多情况下用户还是会对如何使用它提出问题。 Visual Basic 提供了对两种不同帮助系统的支持：传统的 Windows 帮助系统 (WinHelp)和新的 HTML 帮助（CHM帮助）。当我们制作好帮助文件后，就需要在程序的适当位置编写代码进行调用，本文将讨论几种在程序中调用CHM帮助文件的方法。 
方法一　使用F1键：
这种方法最简单，只需如下代码即可：
Private Sub Form_Load() 
App.HelpFile = app.path & "\help.chm" '调用与主程序同目录下的help.chm帮助文件，按F1键调用
End Sub方法二 使用SendKeys方法：
Private Sub Form_Load() 
App.HelpFile = app.path & "\help.chm" 
End Sub 
private Sub CmdHelp_Click() 
SendKeys "{F1}" '发送击键到活动窗口 
End Sub方法三 使用Shell函数：
private Sub CmdHelp_Click()
Shell "hh.exe help.chm", vbNormalFocus 'help.chm为指定的帮助文件，可包含路径。
End Sub方法四 使用HtmlHelp函数：
先声明如下API：
Option Explicit
Private Declare Function HtmlHelpA Lib "hhctrl.ocx" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long 
'hwndCaller指定调用者的窗口，pszFile指定要调用的文件，uCommand是发送给 HtmlHelp的命令，dwData是uCommand的参数。 
然后在过程中调用：
private Sub CmdHelp_Click()
dim i as string
i = app.path & "\help.chm" '用变量i记录与主程序同目录下的help.chm帮助文件
HtmlHelpA Form1.hWnd, i, 0, 0
End Sub方法五 使用ShellExecute函数：
先声明如下API：
Option Explicit
'声明API函数用于异步打开一个文档
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
然后在过程中调用：
private Sub CmdHelp_Click()
dim a as long
Dim b As String
b = App.Path & "\help.chm" '用变量b记录与主程序同目录下的help.chm帮助文件
a = ShellExecute (0, "open", b, "", "", SW_SHOWNORMAL)
End Sub
以上五种方法各有优缺点，从代码的简单上讲，建议使用第二种方法。从功能上讲，建议使用第五种方法，因其不只用于打开CHM帮助文件，还可用同样的格式打开、打印或查找一个文件或文档（参见该API的说明资料）。 

Answer 7

将listview中显示出来的记录拖到treeview中去
Option Explicit
Private Sub Form_Load()
TreeView1.Nodes.Add , , "aa", "aa"
TreeView1.Nodes.Add , , "bb", "bb"
ListView1.ListItems.Add , , "cc"
ListView1.ListItems.Add , , "dd"
ListView1.OLEDragMode = ccOLEDragAutomatic
ListView1.LabelEdit = lvwManual
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
  ListView1.DragIcon = ListView1.SelectedItem.CreateDragImage
  ListView1.Drag vbBeginDrag
End If
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
If Not TreeView1.DropHighlight Is Nothing Then
  TreeView1.Nodes.Add TreeView1.DropHighlight.Key, tvwChild, GetNextKey() & ListView1.SelectedItem.Text, ListView1.SelectedItem.Text
  TreeView1.DropHighlight.Expanded = True
End If
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End Sub
Private Function GetNextKey() As String
Dim sNewKey As String
Dim iHold As Integer
Dim i As Integer
On Error GoTo myerr
iHold = Val(TreeView1.Nodes(1).Key)
For i = 1 To TreeView1.Nodes.Count
    If Val(TreeView1.Nodes(i).Key) > iHold Then
      iHold = Val(TreeView1.Nodes(i).Key)
    End If
Next
iHold = iHold + 1
sNewKey = CStr(iHold) & "_"
GetNextKey = sNewKey
Exit Function
myerr:
GetNextKey = "1_"
End Function

Answer 8

应用心得　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　1)mshflexgrid控件　与　msflexgrid控件　的异同　mshflexgrid控件与adodc控件绑定，msflexgrid控件与data控件绑定。2)mshflexgrid控件的应用如果记录集已经在程序中产生，则可以不与adodc控件绑定，直接在mshflexgrid控件中显示数据，并且可以根据需要设置控件中行的颜色，如下例：   public function datagrid_update() as boolean
    on error goto datagrid_update_err
    dim orarsrecordset as object
    dim adorsrecordset as new adodb.recordset
    dim lngdatediff as long
    
    call getdata(const_generaltable_timeout_info, orarsrecordset)
    if not ado_databaseopen(dskattr, 1) then
        datagrid_update = false
        exit function
    end if    adorsrecordset.cursorlocation = aduseclient
    call adorsrecordset.open(const_vehicletable_recordset_queried, _
                            mobjdatasource.connectionstring, , , adcmdtext)
    frmshownewdata.grdsaishin.colwidth(0) = 800
    frmshownewdata.grdsaishin.colwidth(1) = 2000
    frmshownewdata.grdsaishin.allowuserresizing = flexresizecolumns
    set frmshownewdata.grdsaishin.recordset= adorsrecordset
    
    dim intCnt as integer
    intCnt = 0
    intCnt = intCnt + 1
    while not adorsrecordset.eof
        lngdatediff = datediff("n", adorsrecordset.fields("測位日時"), now)
        if lngdatediff > orarsrecordset.fields("gen_v_num").value then
            frmshownewdata.grdsaishin.row = intCnt
            dim j as integer
            for j = 0 to frmshownewdata.grdsaishin.cols - 1
                frmshownewdata.grdsaishin.col = j
                frmshownewdata.grdsaishin.cellbackcolor = &h80ffff
            next
        end if
        intCnt = intCnt + 1
        call adorsrecordset.movenext
    wend
    call ado_databaseclose
    datagrid_update = true
    exit function
datagrid_update_err:
    call ado_databaseclose
    datagrid_update = false
end function

Answer 9

多谢捧场，我等获益非浅！再开一贴，请继续
http://expert.csdn.net/Expert/topic/1727/1727285.xml?temp=.496731