博文
使窗体保持最前(2006-03-24 22:20:00)
摘要：悬挂窗体（使窗体保持最前）1、在窗体上建立一个复选框，名称：Check1，属性Caption改为“启用悬挂式窗体”写入下面代码Private Sub Check1_Click() Dim res As Long If Check1.Value = 1 Then res = SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flags) Else res = SetWindowPos(Me.hwnd, HWND_NOTOPMOST, _ 0, 0, 0, 0, Flags)
End IfEnd Sub2、加入一个模块文件，写入下面代码Public 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) As Long '以上为API函数声明Public Const HWND_TOPMOST = -1Public Const SWP_NOMOVE = &H2Public Const SWP_NOSIZE = &H1Public Const SWP_FRAMECHANGED = &H20'The frame changed: send WM_NCCALCSIZEPublic Const SWP_DRAWFRAME = SWP_FRAMECHANGED'以上为程序中用到的常量
Public Const HWND_BOTTOM = 1Public Const HWND_BROADCAST = &am......
快速导出数据库为EXCEL文档(2006-03-24 22:19:00)
摘要：在网上的导出为 EXCEL文档的方法大概是这样的 Dim i As Integer, j As Integer Dim myexcel As New Excel.Application Dim mybook As New Excel.Workbook Dim mysheet As New Excel.Worksheet Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK Set mysheet = mybook.Worksheets.Add '添加一个新的SHEET ' For i = 1 To myres.RecordCount ' For j = 1 To myres.Fields.Count ' mysheet.Cells(i, j) = myres.Fields.Item(j - 1).Value ' If (i * j) Mod 500 = 0 Then ' DoEvents ' End If ' Next j ' myres.MoveNext ' Next i myexcel.Visible = True mybook.SaveAs (m_ExcelName) '保存文件
这中方法没什么错误,但是如果数据量很大的话,麻烦就来了,出现程序长时间不响应 关键是循环,下给出我的代码 假设定义的记录名为myres Dim myexcel As New Excel.Application Dim mybook As New Excel.Workbook Dim mysheet As New Excel.Worksheet Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK Set mysheet = mybook.Worksheets.Add '添加一个新的SHEET myexcel.visible=true mysheet.Cells.CopyFromRecordset myres mybook.SaveAs (m_ExcelName) '保存文件
利用这个代码可以大大的缩短导出时间,8000多个纪录用第一种方法大概需要2分多 而用第二种方法只大概要4秒,可以亲......
编程集锦(绝对值)(2006-03-24 22:17:00)
摘要：驱动器操作
Private Sub Dir1_Change()File1.Path = Dir1.PathEnd Sub
Private Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd Sub--------------------------------判断光驱/软驱中是否有磁盘Private Sub Drive1_Change()'当驱动器发生改变时使Dir1与其保持一致On Error GoTo IFerr '拦截错误Dir1.Path = Drive1.DriveExit SubIFerr: '如果磁盘错误 MsgBox "请确认驱动器是否准备好或者磁盘已经不可用!", _ vbOKOnly + vbExclamation Drive1.Drive = Dir1.Path '忽略驱动器改变 Exit SubEnd Sub----------------------------------------------------------打开URL：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 Sub Command1_Click()ShellExecute hwnd, "open", "ht......
把我的收集贡献给大家(2006-03-24 21:24:00)
摘要：把我的收集贡献给大家：http://ftp.why100000.comhttp://ftp1.why100000.comhttp://ftp2.why100000.comhttp://why100000.com ......
袖珍数据库连接方式查询手册(2006-02-17 04:34:00)
摘要：下面的资料是平时使用到的一些数据库连接方式，可能不太全，但是可以用来当做资料查询，希望能够帮上大家的忙。 下面将简单介绍一下几种ADO连接方式：ODBC DSN,ODBC DSN-Less, OLE DB Provider,和"MS Remote" Provider. I.DSN oConn.Open "DSN=AdvWorks; UID=Admin; PWD=;" 注意：从MDAC2.1开始就不能够在使用这样的方式了，就是只把DSN文件名放在ConnectString中。你必须同时使用DSN，UID，PWD标志。例如下面的方式在MDAC 2.1中将会出错：oConn.Open "AdvWorks" II.File DSN oConn.Open "FILEDSN=\somepath\mydb.dsn; UID=Admin; PWD=;" III.ODBC DSN-Less Connections a)ODBC Text Driver oConn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)}; Dbq=\somepath\;" & _ "Extensions=asc,csv,tab,txt; Persist Security Info=False" 注意：需要在SQL语句中指定使用到的文件名。例如： oRs.Open "Select * From customer.csv", oConn, adOpenStatic, adLockReadOnly, adCmdText b)ODBC Driver for Access i)普通安全模式： oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=\somepath\mydb.mdb; Uid=Admin; Pwd=;" ii)如果使用了System database: oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=\somepath\mydb.mdb; SystemDB=\somepath\mydb.mdw;", "adm......
提高VB访问数据库的效率(2006-02-17 04:28:00)
摘要： 1.尽量使用事务处理更新数据库 VB的事务处理包括以BeginTrans开始，以CommitTrans或Rollback结尾的多条数据库操作指令。事务处理除了能很好的保证数据库的完整性以外。同时能大大提高数据库批量更新的效率。这是因为如果数据库更新操作没有使用事务处理，则每次Update操作都会引起数据库写盘一次。使用事务处理后，更新只在内存缓冲区内进行，执行CommitTrans时才将所有修改一次写回到磁盘中。 使用事务处理要注意一下几点： (1)事务处理要有很完善的错误检查机制； (2)因为VB在事务处理结束前对数据库使用了页面锁，所以在多用户环境中,如果事务被挂起,则其他用户将无法访问上锁的数据。 2.尽量使用代码分解Select检索操作 使用Select进行数据库操作固然简单易用，但如果将一些检索操作分解为等价的手工检索代码，则对数据库的检索速度将大大加快。分解的基本方法是对检索关键字段进行索引，利用Seek方法定位后，根据索引的数据库已经排序的特点，进行遍历查找。对于遍历范围不是很宽时，这种方法能几十倍的提高数据库的访问速度。 例如：Select * from person where vol= '123' and birth= #11-02-73# 分解成下面的操作后，访问速度可大大提高： Table.Index= "vol" Table.Seek "=","123" if not table.nomatch then while not table.eof if table("vol")="123" then table.movelast else if table("Birth")= #11-02-73# then '找到记录 end if table.movenext wend end if 3.使用attach绑定数据库表 当使用ODBC连接MS SQL Server，Oracle和Sysbase之类的数据库服务器时，我们可以通过MS Acess的attach功能将服务器上的表绑定到MS Acess数据库中，因为MS Acess数据库能缓存数据库服务器上表的结构，当我们访问ODBC数据源时能提高系统的访问性能。 4.使用dbSQLPassThrough选项 连接M......
使任务栏成为透明窗体(2006-02-17 04:27:00)
摘要：Option ExplicitPrivate Const GWL_EXSTYLE = (-20)Private Const WS_EX_LAYERED = &H80000Private Const WS_EX_TRANSPARENT = &H20&Private Const LWA_ALPHA = &H2&Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Const ERROR_SUCCESS = 0&Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebootedPrivate Const SYNCHRONIZE = &H100000Private Const STANDARD_RIGHTS_ALL = &H1F0000Private Const KEY_QUERY_VALUE = &H1Private......
会自动隐藏的菜单(2006-02-17 04:24:00)
摘要：Disclaimer This example program is provided "as is" with no warranty of any kind. It is intended for demonstration purposes only. In particular, it does no error handling. You can use the example in any form, but please mention www.vb-helper.com.----- How to create a menu with a pixturebox, some labels, and a few lines to make it look good. I lot more flexibilty with this menu but unforutnately a lot more work and typing. You can make some very cool effects with bold, italics, underlining, colors, etc. etc. If you like the menu and use it for anything put a small link to my web site if you want, or just put my e-mail address since the URL is very long. Hopefully this address will change soon.http://www.geocities.com/SiliconValley/Ridge/6656/index.htmlE-Mail: S.S.Software@iName.comSami SamhuriPresident & C.E.O.S.S. Software-----以下是窗体中的代码：'------------------------------------------------------'' Create a menu with a picturebox and some labels, ''The lines give it a nice effect tht y......
淡入淡出和半透明显示窗体 (2006-02-17 04:22:00)
摘要：演示如何使用Win2000新增的透明窗体样式，和载入与卸载窗体时的动态效果。Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As LongConst AW_HOR_POSITIVE = &H1 '从左到右Const AW_HOR_NEGATIVE = &H2 '从右到左Const AW_VER_POSITIVE = &H4 '从上到下Const AW_VER_NEGATIVE = &H8 '从下到上Const AW_CENTER = &H10 '从中间开始Const AW_HIDE = &H10000 '卸载时使用Const AW_ACTIVATE = &H20000 '打开时使用Const AW_SLIDE = &H40000 '与前四种组合拉出样式Const AW_BLEND = &H80000 '淡入淡出Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Const WS_EX_LAYERED = &H8000......
利用VB产生屏幕变暗的效果(2006-02-15 22:10:00)
摘要：想利用VB编程实现屏幕变暗的效果（向关闭Win95时的效果），只要按下面的步骤来做1、在Form1中加入两个CommandButton和一个PictureBox.2、在Form1的代码窗口中添加以下代码：Private Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypePrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPrivate Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As LongPrivate Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate Declare Function InvalidateRect Lib "user32......