感谢CSDN的版主允许我重新回到这里来,一年来我以平均81分的成绩考取了北京某高校的博士,并因博士英语考试前10名而免修免考,所有博士课程学完并每门课程达到80分以上,同世界500强打了一场官司(已获胜),参加了12年未见面的大学同学聚会,编写了应用程序2套,培训了两个VB培训班,最近就要进行开题报告了,所以可能很忙,不过有时间我会同大家在这里交流的,下面是我以前写的一些小文章,希望大家能喜欢,真诚地希望同大家成为朋友,尽管我很菜,但我是无私的。下面还需要帮我,否则这里不允许我发贴超过3次。用VB制作软键盘                    青岛德固萨化学有限公司  杜运庆 看见微软智能拼音输入法的小键盘了吗?那东东可以在输入的时候用代替键盘。 
当不希望操作员使用键盘的时候,那么你就要考虑为她或他提供软键盘了。下面我们就用VB来做这 
个软键盘。 
准备工作: 
先画两个窗体Form1和Form2,Form2是作为接收按键测试用的,在上面放一个文本框Text1,把 
Text1的MultiLine属性设为True,ScrollBars设为3-Both,然后写入如下代码: 
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal  
fEnable As Long) As Long 
Private Sub Form_Load() 
'调整大小 
Me.Width = Screen.Width * 0.9 
Me.Height = Screen.Height * 0.9 
Form1.Show 
'禁止鼠标和键盘输入 
EnableWindow Text1.hwnd, False 
End Sub 
Private Sub Form_Resize() 
'调整文本框大小 
Text1.Top = 0 
Text1.Left = 0 
Text1.Width = Me.ScaleWidth 
Text1.Height = Me.ScaleHeight 
End Sub 
Private Sub Form_Unload(Cancel As Integer) 
End 
End Sub 
Form1作为小键盘用,把它的BorderStyle设为3-Fixed Dialog,把ControlBox属性设 
为False,这样小键盘就没有标题栏了。Form1得跟微软智能拼音输入法的小键盘完全一样的大小 
的窗体,经笔者的计算长×高是5310×2130。然后放上10个按扭,其中九个的Caption分别是 
Tab、Caps、↑Shift、Ins、Del、(空格)、Esc、Enter和←(退格)。它们的位置和大小如下设 
置: Caption Top Left Height Width Name ↑Shift 1230 0 400 840 Command1 
Caps 828 0 400 560 Command2 
Tab 410 0 400 480 Command3 
Ins 1640 0 400 570 Command4 
Del 1640 870 400 550 Command5 
(空格) 1640 1400 400 2565 Command6 
Esc 1640 4670 400 550 Command7 
Enter 820 4590 400 630 Command9 
←(退格) 820 4590 400 630 Command10 接下来做一个Height为400、Width为360的按扭Command8,Caption为A  a(注意中间是两个空 
格,这一点非常重要!),由于按扭太小,系统会自动换行,看上去A在a的上面。复制该按扭,然 
后在窗体上粘贴,程序会提示你是否产生控件数组,选择是,Command8变成了Command8(0),新产 
生的按扭为Command8(1),一直粘贴,直到Command8(46),修改它们的Caption使之与键盘上的其 
它键一样。这里要注意几点: 
1、按扭的字体为“小五”,有几个键显示的结果是纵向并排,可把字体设为“六号”,使之横向 
并排,字体使用宋体,否则↑和←显示的不漂亮。 
2、&符号要使用两个,即 && 7(&&与7之间只有一个空格),确保每个按扭的Caption的长度为四 
个字母。 
3、把窗体的MousePointer设为15 - Size All,以便在运行的时候移动小键盘。 
4、把所有按键的MousePointer都设为99 - Custom,而MouseIcon设为手形指针。 
5、由于要指示Shift是否按下,Command1的Style属性设置为1-Graphical。 
6、Form2的StartUpPosition属性设置为2-屏幕中心。 
我们把Command8(x)的这些键暂时叫做“普通键”。由于前面已经定位了9个特殊键,所以可以通 
过菜单栏的“格式”里面的“顶端对齐”、“相同水平间距”等选项很容易地把47个普通键放到与 
键盘对应的位置上。另外,为了显示CAPS LOCK的状态,我们在窗体上加一个标签Label1,把它的 
AutoSize属性设为True,Caption属性设为●,它的Top、Left、Height和With分别为1340、 
4800、180和180。 
接下来是写代码了,这里主要用了SendMessage发送消息的API函数,由于按扭CAPTION设置的巧 
妙,所以47个普通键的代码就用的很少。所有代码如下: 
'API声明 
Private Declare Function ReleaseCapture Lib "user32" () As Long 
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 SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal  
hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long,  
ByVal cy As Long, ByVal wFlags As Long) 
Private Declare Sub GetKeyboardStateByString Lib "user32"  
Alias "GetKeyboardState" (ByVal pbKeyState As String) 
Private Declare Sub SetKeyboardStateByString Lib "user32"  
Alias "SetKeyboardState" (ByVal lppbKeyState As String) 
'常数 
Const VK_CAPITAL = &H14 
Const WM_CHAR = &H102 
Const HTCAPTION = 2 
Const WM_NCLBUTTONDOWN = &HA1 
Const WM_KEYDOWN = &H100 
Const VK_DELETE = &H2E 
Const VK_INSERT = &H2D 
'定义变量 
Dim rc as Long Private Sub Command1_Click() 
'Shift键 
If Command1.BackColor = &H8000000B Then 
Command1.BackColor = &H80000005 
Else 
Command1.BackColor = &H8000000B 
End If 
End Sub '退格键 
Private Sub Command10_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_CHAR, 8, 1) 
End Sub '大小写转换键 
Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As  
Single, Y As Single) 
Dim CAPITALKey As String * 256 
CAPITALKey = Space$(256) 
GetKeyboardStateByString (CAPITALKey) 
If Label1.ForeColor = vbBlack Then 
Label1.ForeColor = vbGreen 
Mid$(CAPITALKey, VK_CAPITAL + 1, 1) = Chr$(1) 
Else 
Label1.ForeColor = vbBlack 
Mid$(CAPITALKey, VK_CAPITAL + 1, 1) = Chr$(0) 
End If 
Call SetKeyboardStateByString(CAPITALKey) 
End Sub 'TAB键 
Private Sub Command3_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_CHAR, 9, 1) 
End Sub 'Ins键 
Private Sub Command4_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_KEYDOWN, VK_INSERT, &H510001) 
End Sub 'Del键 
Private Sub Command5_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_KEYDOWN, VK_DELETE, 1) 
End Sub '空格键 
Private Sub Command6_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_CHAR, 32, 1) 
End Sub 'Esc键 
Private Sub Command7_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_CHAR, 27, 1) 
End Sub '普通键 
Private Sub Command8_Click(Index As Integer) 
Dim keyx As Integer 
If Command1.BackColor = &H80000005 Xor Label1.ForeColor = vbGreen Then 
keyx = Asc(Mid(Command8(Index).Caption, 1, 1)) 
Else 
keyx = Asc(Mid(Command8(Index).Caption, 4, 1)) 
End If 
rc = SendMessage(Form2.Text1.hwnd, WM_CHAR, keyx, 1) 
Command1.BackColor = &H8000000B 
End Sub '回车键 
Private Sub Command9_Click() 
rc = SendMessage(Form2.Text1.hwnd, WM_CHAR, 13, 1) 
End Sub '让小键盘在最前面 
Private Sub Form_Load() 
   rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) 
End Sub '移动没有标题的小键盘 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y  
As Single) 
If Button = 1 Then 
     Dim ReturnVal As Long 
     X = ReleaseCapture() 
     ReturnVal = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0) 
End If 
End Sub 
最后要提醒您的是:如果你要用于多个Text要做如下两步: 
1、把FORM2中的EnableWindow Text1.hwnd, False去掉。 
2、把软键盘代码中所有的Form2.Text1.Hwnd换成如下代码:Form2.ActiveControl.hwnd 
瞧,超酷的小键盘就这样做成了!该程序在VB6+WIN98下运行通过,如果你需要本事例的源代码, 
请在本文见报后到第一VB论坛的首页下载吧!网址是http://www.vbgood.com 

解决方案 »

  1.   

    用EXCEL2000作为VB的资源文件报表 
                           青岛 杜运庆 
        许多朋友把EXCEL作为报表的工具,把数据写入EXCEL并不困难,但存在一些问题,如:客户 
    修改了报表的格式,或者把设计好的报表文件删除了,如何解决这些问题呢?搜遍了国内外的站 
    点,亦未发现有什么好的办法。 
        有的朋友给EXCEL文件加密码,这种办法只防止了客户修改报表格式,如果客户移动或删除了 
    这个报表文件,仍然会出问题。现在我们来手绝的:把设计好的空白报表加到资源文件里面,每次 
    报表的时候先把资源文件里面的EXCEL报表写到当前目录下,然后由程序填写数据,或显示或打 
    印! 
        开始吧!先做一些准备工作,在这里假设已准备了以下东东: 
    在当前目录下有一access2000数据库db1.mdb,打开密码是7281322,内有一张表MonRep存放着 
    要报表的数据;设计好的空白EXCEL2000报表rp.xls,打开密码也是7281322。 
    打开VB,新建一个工程,在"工程"→"引用"里面选取Microsoft ActiveX Data Object 2.1  
    Library和Microsoft Excel 9.0 Object Library; 
    在"外接程序"→"外接程序管理器"里面加载"VB 6 资源编辑器",在"工程资源管理器"里面点击鼠 
    标右键,选取"添加资源文件",随便给资源文件起个名字,出现"VB资源编辑器"后,点"添加自定 
    义资源"按钮,选取你设计好的报表rp.xls,点击"保存"按钮,注意:这里使用了默认的类 
    型"CUSTOM"和默认的标识号101,实际应用中你可做修改。 
    按下Ctrl-t,选取Microsoft DataGrid Control 6.0(OLEDB)在默认窗体Form1上画一个 
    DataGrid,默认名称DataGrid1。 
    在窗体里添加如下代码: 
    Private Sub Form_Load() 
        Dim rst As Recordset 
        Set Cnn1 = New ADODB.Connection 
        CnnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path  
    & "\db1.mdb" _ 
    & ";Mode=Read|Write;Persist Security Info=False;Jet OLEDB:Database  
    Password=7281322" 
    Cnn1.Open CnnStr 
        Sql = "SELECT * FROM MonRep" 
        Set rst = New ADODB.Recordset 
        rst.CursorLocation = adUseClient 
        rst.Open Sql, Cnn1, adOpenKeyset, adLockOptimistic, adCmdText 
      Set DataGrid1.DataSource = rst 
    End Sub 
    Private Sub Form_Resize() 
    DataGrid1.Width = 0.95 * Me.Width 
    DataGrid1.Height = 0.75 * Me.Height 
    End Sub 
    在窗体的"通用"里面添加以下代码:(注意API函数的声明一定要写在一行里) 
    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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal  
    lpClassName As String, ByVal lpWindowName As String) As Long 
    Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long,  
    lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As  
    Long, ByVal lpOverlapped As Any) As Long 
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal  
    lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long,  
    ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal  
    dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long 
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As  
    Long 
    Const WM_CLOSE = &H10 
    Const GENERIC_WRITE = &H40000000 
    Const CREATE_ALWAYS = 2 
    Const FILE_ATTRIBUTE_NORMAL = &H80 
    Public Sub CopyExcel() 
        Dim hNewFile As Long, bBytes() As Byte 
        Dim nSize As Long 
        Dim hwnd 
        hwnd = FindWindow("XLMAIN", "Microsoft Excel - rp.xls") 
        If hwnd <> 0 Then 
            SendMessage hwnd, WM_CLOSE, 0, 0'如果客户没有关闭该报表,提示他关闭它 
            Exit Sub 
        End If 
        If Dir(App.Path & "\rp.xls") = "rp.xls" Then 
        Kill App.Path & "\rp.xls" 
        End If 
        bBytes = LoadResData(101, "CUSTOM") 
        hNewFile = CreateFile(App.Path & "\rp.xls", GENERIC_WRITE, 0, 0,  
    CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) 
    nSize = UBound(bBytes) - LBound(bBytes) + 1 
        WriteFile hNewFile, bBytes(0), nSize, nSize, ByVal 0& 
        CloseHandle hNewFile 
    End Sub 
        在窗体上画一按钮,添加以下代码: 
    Private Sub Command1_Click() 
    Me.MousePointer = 11 
    CopyExcel 
        Dim ex As Object 
        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.Open(App.Path & "\rp.xls", , , , 7281322) 
        Set xlSheet = xlBook.Worksheets(1) 
        Dim rst As Recordset 
        Set Cnn1 = New ADODB.Connection 
        CnnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path  
    & "\db1.mdb" _ 
        & ";Mode=Read|Write;Persist Security Info=False;Jet OLEDB:Database  
    Password=7281322" 
        Cnn1.Open CnnStr 
        Sql = "SELECT * FROM MonRep" 
        Set rst = New ADODB.Recordset 
        rst.CursorLocation = adUseClient 
        rst.Open Sql, Cnn1, adOpenKeyset, adLockOptimistic, adCmdText 
        rst.MoveFirst 
        For j = 0 To rst.RecordCount - 1 
        For i = 3 To rst.Fields.Count 
        xlSheet.Cells(i + 2, j + 3) = rst.Fields(i - 1).Value 
        Next i 
        rst.MoveNext 
        Next j 
        For i = 3 To rst.Fields.Count 
        zzz = 0 
        For j = 0 To rst.RecordCount - 1 
        zzz = zzz + xlSheet.Cells(i + 2, j + 3) 
        Next j 
         xlSheet.Cells(i + 2, 16) = zzz 
        Next i 
        xlSheet.Cells(3, 15) = Date 
    ' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 
    ' xlBook.Close 
    ' XlApp.Quit 
    Me.MousePointer = 0 
    End Sub
      

  2.   

    如果你不想显示而是想直接打印报表,可以把XlApp.Visible = True去掉,而启用最后加注 
    释的三行命令。 
    搞定了!按下F5运行后点击按钮,你会看到生成的报表。利用这种方法,你再也不用担心客户破坏 
    你的报表了,爽吗?如果你懒得自己做一遍,到第一VB论坛http://www.vbgood.com去下载我的示 
    例源代码看看吧。该示例代码在以下环境下通过: 
            Win98+VB6SP3+Excl2000+Access2000 
      

  3.   

    优化程序速度 
                       杜运庆 
    速度是程序的命,如果您的软件再好,但运行速度很慢,那么您将失去用户耐心。VB6在操纵数据 
    库方面做的很出色,但操纵表的还是用SQL语句快,好在VB6的DAO对象、ADO对象和数据环境、ADO 
    控件都可以使用SQL语句,但怎么提高数据操纵速度呢?建立索引当然是最基本的要求,除此之外 
    呢?有没有其他的方法?第一VB论坛(http://www.d1vb.com)的网友经常提出这个问题,这里我 
    告诉您几种优化的方法: 
    一、表的设计 
    当在表中添加字段的时候,应该选择长度最小的数据类型,这样表在内存中每页可以存储更多的记 
    录。如:“姓名”字段一般设置为TEXT类型,长度为10一般就够用,则比默认的255要好的多。整 
    型Integer的长度是2,在使用整型Integer就可以解决问题的地方不要使用Single、Long、 
    Double、Currency,因为它们的长度分别为4、4、8、8,都比2大。在建立表后一定要建立 
    索引,这可以大大提高查询速度,是提高速度最基本的要求。 
    二、压缩数据库 
    JET数据库的查询优化是有代价的,随着数据库的不断扩大,优化将不再起作用。压缩数据库会改 
    变数据库的状态,并重新优化所有查询。同时,随着数据库的增大,会产生很多碎片。而压缩数据 
    库可以把一个表中的数据数据写到硬盘中连续的页里,提高了顺序搜索的速度。 
    压缩数据库使用CompactDatabase命令,下面的语句压缩数据库并产生一个数据库备份: 
    DBEngine.CompactDatabase “C:\VB\BIBLIO.MDB”, “C:\VB\BIBLIO2.MDB” 
       Kill “C:\VB\BIBLIO.BAK”   Name “C:\VB\BIBLIO.MDB” As “C:\VB\BIBLIO.BAK” 
       Name “C:\VB\BIBLIO2.MDB” As “C:\VB\BIBLIO.MDB” 
    注意,如果数据库很大的话,可能需要整夜的时间来压缩数据库。 
    三、避免查询输出里面多余的计算 
    当查询的结果作为另外一个查询的数据源的时候,可能引起查询优化问题。在这个时候第一次查询 
    里面尽量避免大量的计算。在如下示例中,Query1是第一个查询的结果,然后它作为第二个查询 
    的数据源。 
    Dim DB As Database 
    Dim RS As RecordSet 
       Set DB = DBEngine.Workspaces(0).Opendatabase(“Biblio.MDB”) 
       DB.CreateQueryDef(“Query1”, _ 
          “SELECT IIF(Au_ID=1,’Hello’,’Goodbye’) AS X FROM Authors”) 
       Set RS = DB.OpenRecordSet(“SELECT * FROM Query1 WHERE X=’Hello’”) 
    由于在第一个查询Query1中的IIF()表达式不能被优化,,所以在第二个查询中的WHERE子句也不 
    能被优化。如果一个表达式在一个查询树中埋藏的很深的话,则这个查询不可被使用,它是不可优 
    化的。 
    如果可能的话,把这个SQL语句合并为一个没有嵌套的SQL语句: 
    Set RS = DB.OpenRecordSet(“SELECT * FROM Authors WHERE Au_ID=1”) 
    对于更灵活的嵌套查询,尽量在SQL语句中使用字段名,如: 
    DB.CreateQueryDef(“Query1”, _ 
          “SELECT IIF(Au_ID=1,’Hello’,’Goodbye’) AS X, Au_ID, FROM Authors”) 
       Set RS = DB.OpenRecordSet(“SELECT * FROM Query1 WHERE Au_ID=1”) 
    如果在查询输出中实在无法避免计算式的话,尽量把计算式放在最外层,不要放在最内层。 
    四、只输出需要的字段 
    在建立查询的时候,仅返回需要的字段,这样可以节省不必要的开支。如果某个字段不是你需要 
    的,不要在查询语句中出现。上面的事例正说明了这个问题。 
    五、分组、合并及汇总 
    这里要说明的主要是合并,当你需要把两个表合并,就是说:当你要根据“Customer Name”对两 
    个表进行合并,要肯定GROUP BY field (Customer Name)和汇总(Sum, Count, and 等)的字段 
    是来自同一张表。 
    例如:下列语句优化性较差,因为SUM子句来自Ord表,而GROUP BY子句来自Cust表: 
    SELECT Cust.CustID, 
              FIRST(Cust.CustName) AS CustName, 
              SUM(Ord.Price) AS Total 
       FROM Cust INNER JOIN Ord ON Cust.CustID = Ord.CustID 
       GROUP BY Cust.CustID 
    如果按照Ord.CustID分组,查询性能就好的多了: 
    SELECT Ord.CustID, 
              FIRST(Cust.CustName) AS CustName, 
              SUM(Ord.Price) AS Total 
       FROM Cust INNER JOIN Ord ON Cust.CustID = Ord.CustID 
       GROUP BY Ord.CustID 
    六、尽量减少分组的字段 
    SQL语句中分组(GROUP BY)的字段越多,执行查询的时间越长。在GROUP BY子句中尽量用 
    aggregate函数来减少字段的数量。 
    如: 
    GROUP BY As Few Fields As Possible 
       SELECT Cust.CustID, 
              Cust.CustName, 
              Cust.Phone, 
              SUM(Ord.Price) AS Total 
       FROM Cust INNER JOIN Ord ON Cust.CustID = Ord.CustID 
       GROUP BY Cust.CustID, Cust.CustName, Cust.Phone 
    可以改为::  
       SELECT Ord.CustID, 
              FIRST(Cust.CustName) AS CustName, 
              FIRST(Cust.Phone) AS Phone, 
              SUM(Ord.Price) AS Total 
       FROM Cust INNER JOIN Ord ON Cust.CustID = Ord.CustID 
       GROUP BY Ord.CustID 
    七、在合并之前嵌套GROUP BY子句 
    如果要合并两张表,而且只在一张表中分组,把查询分为两个SELECT语句要快的多。 
    如:  
       SELECT Ord.CustID, 
              FIRST(Cust.CustName) AS CustName, 
              FIRST(Cust.Phone) AS Phone, 
              SUM(Ord.Price) AS Total 
       FROM Cust INNER JOIN Ord ON Cust.CustID = Ord.CustID 
       GROUP BY Ord.CustID 
    可改为:  
    查询1: 
       SELECT CustID, SUM(Price) AS Total 
       FROM Ord 
       GROUP BY CustID 
    查询2: 
       SELECT Query1.CustID, Cust.CustName, Cust.Phone, Query1.Total 
       FROM Cust INNER JOIN Ord ON Cust.CustID = Ord.CustID 
    八、在合并的时候两边的字段都设置索引 
    在合并表的时候,尽量使两边的字段都设置索引。这在执行查询的时候查询优化器可以更多的使用 
    sophisticated 内部合并策略。 
    当然,在关系型数据库中,表要设计的尽量小,(最好1-2K页),这样删除表的索引的时候要快 
    的多,这是因为内存中读入了很少的页。这需要根据实际情况多次测试。 
    九、添加索引来提高查询和排序的速度 
    为合并或查询条件中的所有使用字段建立索引。Microsoft Jet 2.0极其以后版本的数据库引擎 
    使用使用了Rushmore查询优化技术,因此支持一张表的复合索引。 
    要尽量避免在查询条件中进行计算或在查询条件中使用未索引的字段。排序更是如此,绝对要避免 
    计算或使用未索引的字段。 
    十、使用可优化的表达式 
    重新构造查询语句,以便于Rushmore技术可以对其进行优化。Rushmore是一种数据访问技术,使 
    用它可以提高记录集的查询速度。使用Rushmore的时候,若在查询条件中使用具体类型的表达 
    式,查询速度将非常快。Rushmore不会自动为你的查询提高速度,你必须按照具体的方法修改查 
    询语句,以便于Rushmore可以优化它们。 
    十一、用COUNT(*)代替 COUNT([Column Name]) 
    Microsoft Jet数据库引擎有特别的优化方法,它在使用COUNT(*)要比用COUNT([Column Name]) 
    快得多。 
    注意,这两个运算符是有差别的: 
    Count(*) 计算所有的行。  
    Count([Column Name])计算所有Column Name非空的行。 
    十二、在变量中避免使用LIKE 
    由于在查询完成的时候变量的值不确定,所以无法使用索引,这样,建立的索引就失去了意义,这 
    就严重制约着查询速度。 
    十三、避免LIKE和统配符同时使用 
    如果要把LIKE运算符同统配符一起使用,为了使用索引,必须把统配符放在后面。 
    如,下列语句利用了索引。 
       Like "Smith" 
       Like "Sm*" 
    而下列语句根本没有使用索引:  
       Like "*sen" 
       Like "*sen*" 
    十四、测试合并约束 
    如果要在合并中使用表达式约束一个字段的数值,需要测试表达式放在合并的一侧,还是其他地 
    方,看哪种查询的速度较快。在一些查询中,表达式放在合并关键词join一侧反而比较快。 
    十五、使用中间结果表 
    用SELECT INTO建立工作表,尤其是结果集用于几个查询的时候,尽量使用中间结果表。在查询前 
    做的准备工作越多,查询速度越快。 
    十六、避免子SELECT语句和NOT IN同时使用 
    子SELECT语句和NOT IN同时使用很难优化,取反嵌套的查询或OUTER JOINs影响很大。 
    下列事例查询不在orders表中的用户: 
    优化前: 
          SELECT Customers.* 
          FROM Customers 
          WHERE Customers.[Customer ID] 
                NOT IN (SELECT [Customer ID] FROM Orders); 
    优化后:  
          SELECT Customers.* 
          FROM Customers LEFT JOIN Orders 
               ON Customers.[Customer ID] = Orders.[Customer ID] 
          WHERE ((Orders.[Customer ID] Is Null)); 
     
      

  4.   

    用VB更换桌面墙纸DIY  
                          杜运庆   
      在客户运行您的应用程序的时候自动更换墙纸,显然是广告宣传的一个好机会。但无论是 
    MSDN还是网络上的免费资源代码,更换墙纸几乎都是同一个API函数SystemParametersInfo和同 
    一段代码,国外站点提供的免费代码也是如此。从VB4.0开始就这样。这段代码是: Private 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 
    Const SPI_SETDESKWALLPAPER = 20 
    Const SPIF_SENDWININICHANGE = &H2 
    Const SPIF_UPDATEINIFILE = &H1 Private Sub Form_Load() 
      ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER,  
             0, "Path+BmpFile", 0) 
    End Sub    使用这个例程确实能够切换墙纸,但存在以下问题:   1、用鼠标右键点击桌面,会看到【背景】→【墙纸】里面的文件名是空的。   2、重新启动后桌面墙纸消失。   3、没告诉您怎么切换"居中"或"平铺"。   怎么解决这些问题呢?   1、Windows的墙纸必须以BMP格式的文件存放在Windows目录下面,如果您的图片不在该目录 
    或不是BMP文件,那么就会出现第一个问题。因此必须把您的图片转换成BMP文件并复制到Windows 
    目录下面。   2、要使重新启动后需要在注册表里面修改相应的键值,具体位置是  
    HKEY_CURRENT_USER\Control Panel\desktop中的Wallpaper键,让它的键值等于您的全路径文 
    件名。   3、在更换墙纸以前首先设置是否"居中",需要修改注册表中HKEY_CURRENT_USER\Control  
    Panel\desktop中的TileWallpaper键,键值"0"表示"居中","1"表示"平铺"。   本例把一个JPG格式的图片成功地设置为墙纸,全部代码如下: Private Declare Function GetWindowsDirectory Lib "kernel32"  
    Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As  
    Long Private 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 Const SPI_SETDESKWALLPAPER = 20 
    Const SPIF_SENDWININICHANGE = &H2 
    Const SPIF_UPDATEINIFILE = &H1 
    Const REG_SZ As Long = 1 
    Const HKEY_CURRENT_USER = &H80000001 Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As  
    Long Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA"  
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal  
    samDesired As Long, phkResult As Long) As Long Private Declare Function RegSetValueExString Lib "advapi32.dll"  
    Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal  
    Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData  
    As Long) As Long Private Declare Function RegSetValueExLong Lib "advapi32.dll"  
    Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal  
    Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long)  
    As Long Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting  
    As Variant, lValueType As Long, lPredefinedKey As Long)  lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0,  
                 KEY_ALL_ACCESS, hKey) 
     lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting) 
     RegCloseKey (hKey) 
    End Sub Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As  
    Long, vValue As Variant) As Long 
     Dim lValue As Long 
     Dim sValue As String 
     Select Case lType 
      Case REG_SZ 
         sValue = vValue & Chr$(0) 
         SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType,  
                sValue, Len(sValue)) 
      Case REG_DWORD, REG_BINARY 
         lValue = vValue 
         SetValueEx = RegSetValueExLong(hKey, sValueName, 0&,  
                lType, lValue, 4) 
     End Select 
    End Function Private Sub Form_Load() 
    '取得windows目录 
     Dim Path As String, strSave As String 
     strSave = String(50, Chr$(0)) 
     Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) 
     '转换图片并保存到Windows目录下面 
     Image1.Picture = LoadPicture(App.Path & "\MyFlower.Jpg") 
     SavePicture Image1, Path & "\MyFlower.bmp" 
     Dim aa As String 
     '写入注册表 
     '设定居中 
     SetKeyValue "Control Panel\desktop", "TileWallpaper",  
            "0", REG_SZ, HKEY_CURRENT_USER 
     '设定平铺 
     ' SetKeyValue "Control Panel\desktop",  
             "TileWallpaper", "1", REG_SZ, HKEY_CURRENT_USER 
     '更换墙纸 
     aa = Path & "\MyFlower.bmp" 
     ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, aa, 0) 
     '在注册表中记录图片位置 
     SetKeyValue "Control Panel\desktop", "Wallpaper", aa,  
            REG_SZ, HKEY_CURRENT_USER 
    End Sub    使用本例要注意:必须先设置是否"居中",然后再更换墙纸。本例在Windows95+VB6下调试通 
    过。 
      

  5.   

    用VB设计更换屏幕保护的程序 
                            杜运庆 
       制作一个本企业的屏幕保护,在客户运行本企业的应用软件的时候,为客户更改屏幕保护,是个 
    广告宣传的好办法。在第一VB论坛(http://www.vbgood.com)上有很多朋友提出这个问题,现解答如 
    下:   要更换屏幕保护,首先得做好一个屏幕保护(scr文件),本例以 工程1.scr 这个文件为例。 
    由于windows是把屏幕保护文件存放在system下,但记录屏幕保护文件位置的文件却是windows目 
    录下的system.ini,所以,首先需要找出系统的windows和system目录的确切安装位置。因此, 
    可以分如下几步进行:   1、找到windows和system目录的安装位置   2、把屏幕保护文件复制到system目录下   3、在system.ini中的[boot]中写入:     SCRNSAVE.EXE=C:\WINDOWS\SYSTEM\工程1.SCR   4、告诉系统切换屏幕保护。 下面的例子成功地改变了屏幕保护,全部源代码如下: '得到windows目录 Private Declare Function GetWindowsDirectory Lib "kernel32"  
    Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As  
    Long '修改system.ini 
    Private Declare Function WritePrivateProfileString Lib "kernel32"  
    Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal  
    lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long '得到system目录 
    Private Declare Function GetSystemDirectory Lib "kernel32"  
    Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As  
    Long '设置屏幕保护 
    Private Const SPI_SETSCREENSAVETIMEOUT = 15 
    Private Const SPI_SETSCREENSAVEACTIVE = 17 
    Private Const SPIF_UPDATEINIFILE = &H1 
    Private Const SPIF_SENDWININICHANGE = &H2 Private Declare Function SystemParametersInfo Lib "user32"  
    Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long,  
    ByVal lpvParam As Long, ByVal fuWinIni 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 WM_SYSCOMMAND = &H112 
    Private Const SC_SCREENSAVE = &HF140 Private Sub Form_Load() 
     '得到system目录 
     Dim sSave As String, Ret As Long 
     sSave = Space(255) 
     Ret = GetSystemDirectory(sSave, 255) 
     sSave = Left$(sSave, Ret) 
     '把屏保复制到系统目录 
     FileCopy App.Path & "\工程1.scr", sSave & "\工程1.SCR" 
     '得到windows目录 
     Dim Path As String, strSave As String 
     strSave = String(250, Chr$(0)) 
     Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) 
     '修改system.ini 
     Dim r As Long 
     Dim iniPath As String 
     iniPath$ = Path + "\system.ini" 
     r = WritePrivateProfileString("boot", "SCRNSAVE.EXE", sSave & "\工程1.SCR",  
    iniPath) 
     '设置时间间隔为1分钟=60秒 
     lRet = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, 60, ByVal 0&,   
         SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE) 
     '设置屏幕保护 
     retval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, True, 0, 0) 
     '启动屏幕保护 
     Dim result As Long 
    result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&) 
    End Sub    本例在vb6.0+win95下运行通过。