| VB 源码 | VC 源码 | ASP源码 | JSP源码 | PHP源码 | CGI源码 | FLASH源码 | 素材模板 | C 源程序 | 站长工具 | 站长教程 |

VB技术

ASP技术
PHP技术
JSP技术
VB技术
.NET技术

本类阅读TOP10

·利用shell编程实现DOS风格的Linux命令行
·新手必学:windows网络编程经典入门
·通过连接实例解读TCP/IP协议
·JAVA生成JPG缩略图
·一组VB实用小程序
·VB解决Unicode文本转换的问题
·用VB制作屏幕保护程序
·Visual Basic开发应用程序答疑
·用VB6实现中英文文本的私钥加密
·用VB学做“黑客”程序

站内搜索

API在VB中应用之技巧集锦
  API函数在VB中得到了充分的运用,同时也让无数VB爱好者沉溺于其中。以下是笔者几年来收集整理的几十个API函数在VB中应用的实例,现在写出来与大伙分享,希望能对大伙有所帮助。
  
  1、如何让窗体总在最前面?
  
  *API函数声明
  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
  注释:常量声明
  Private Const SWP_NOSIZE = &H1
  Private Const SWP_NOMOVE = &H2
  Private Const HWND_TOPMOST = -1
  Private Const HWND_NOTOPMOST = -2
  注释: 在某个form里写:
  SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOMOVE 注释:或下面
  SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOSIZE
  
  2、使用API函数sendmessage,获得光标所在行和列。
  
  Sub getcaretpos(byval  TextHwnd&,LineNo&,ColNo&)
   注释:TextHwnd为TextBox的hWnd属性值,  LineNo为所在行数,ColNo为列数
    dim i&,j&,k& 注释:获取起始位置到光标所在位置字节数         i=SendMessage(TextHwnd,&HB0&,0,0) j=i/2^16 注释:确定所在行      LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1
    注释:确定所在列
    k=SendMessage(TextHwnd,&HBB&,-1,0)
    ColNo=j-k+1
  End sub
  
  3、如何以某种颜色填充某区域?
  
  *API函数声明
  Private Declare Sub FloodFill Lib "gdi32" _ (ByVal hDC As Long, ByVal X As Long, ByVal Y As _ Long, ByVal crColor As Long
  注释:设(fillx,filly)为此区域内任一点
  注释:Color为某种颜色
  FloodFill Picture1.hDC, fillx, filly,Color
  
  4、如何关闭计算机?
  *API函数声明
  Declare Function ExitWindows Lib "User" (ByVal dwReturnCode As Long, ByVal wReserved As Integer) As Integer
  注释:执行
  Dim DUMMY
  DUMMY=ExitWindows(0,0)
  
  5、如何获取Windows目录和System目录?
  
  注释:复制以下代码到一模块中
  Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  注释:在程序中调用
  Dim WindowsDirectory As String, SystemDirectory As String, x As Long
  WindowsDirectory = Space(255)
  SystemDirectory = Space(255)
  x = GetWindowsDirectory(WindowsDirectory, 255)
  x = GetSystemDirectory(SystemDirectory, 255)
  MsgBox "Windows的安装目录是:" + WindowsDirectory+",系统目录是:" + SystemDirectory
  
  6、如何建立简单的超级连接?
  
  *API函数声明
  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecute A" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd A s Long) As Long
  注释:打开某个网址
  ShellExecute 0, "open", "http://tyvb.126.com"/, vbNullString, vbNullString, 3
  注释:给某个信箱发电子邮件
  ShellExecute hwnd, "open", "mailto:sst95@21cn.com", vbNullString, vbNullString, 0
  
  7、如何得知TextBox中文字所有的行数?
  
  *API函数声明
  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 EM_GETLINECOUNT = &HBA
  注释:在程序中调用
  LineCnt = SendMessage(ctl.hwnd, EM_GETLINECOUNT, 0, 0)
  注释:LineCnt即为此TextBox的行数。
  
  8、如何设置ListBox的水平卷动轴的宽度?
  
  *API函数声明
  Const LB_SETHORIZONTALEXTENT = &H194
  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
  注释:调用
  Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&)
  注释:注意400是以象素为单位,你可以根据情况自行设定。
  
  9、如何交换鼠标按键?
  
  *API函数声明
  Declare Function SwapMouseButton& Lib "user32" _ (ByVal bSwap as long)
  要交换鼠标按键,将bSwap参数设置为True。要恢复正常设置,将bSwap设置为False。 然后调用函数就可以交换和恢复鼠标按键了。
  
  10、如何让窗体的标题条闪烁以引起用户注意?
  
  在窗体中放一个Timer控件Timer1,设置其Inteval=200
  *API函数声明
  Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
  注释:在窗体中写下如下代码:
  Private Sub Timer1_Timer()
   FlashWindow Me.hwnd, True
  End Sub
  
  11、怎样找到鼠标指针的XY坐标?
  
  *API函数声明
  Type POINTAPI
  x As Long
  y As Long
  End Type
  Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  调用:
  GetCursorPos z
  print z.x
  print z.y
  
  
  12、怎样获得和改变双击鼠标的时间间隔?
  
  获得鼠标双击间隔时间:
  Public Declare Function GetDoubleClickTime Lib "user32" Alias _ "GetDoubleClickTime" () As Long
  
  获得鼠标双击间隔时间:
  Declare Function SetDoubleClickTime Lib "user32" Alias "SetDoubleClickTime" (ByVal wCount As Long) As Long
  注释:注意:这种改变将影响到整个操作系统
  
  以上两个函数都可精确到毫秒级。
  
  
  13、在程序中如何打开和关闭光驱门?
  
  *API函数声明如下:
  Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
  注释:调用时的代码如下
  Dim Ret As Long
  Dim RetStr As String
  注释:打开光驱门
  Ret = mciSendString("set CDAudio door open", RetStr, 0, 0)
  注释:关闭光驱门
  Ret = mciSendString("set CDAudio door closed", RetStr, 0, 0)
  
  
  14、如何获得Windows启动方式?
  
  在Form1中加入一个CommandButton、一个Label并加入如下代码:
  Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  Const SM_CLEANBOOT = 67
  
  Private Sub Command1_Click()
   Select Case GetSystemMetrics(SM_CLEANBOOT)
   Case 1
    Label1 = "安全模式."
   Case 2
    Label1 = "支持网络的安全模式."
   Case Else
    Label1 = "Windows运行在普通模式."
   End Select
  End Sub
  
  
  15、怎样使Ctrl-Alt-Delete无效?
  
  *API函数声明
  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
  编写如下函数:
  Sub DisableCtrlAltDelete(bDisabled As Boolean)
  Dim X As Long
  X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
  End Sub
  使Ctrl-Alt-Delete无效 :
  Call DisableCtrlAltDelete(True)
  恢复Ctrl-Alt-Delete :
  Call DisableCtrlAltDelete(False)
  
  
  16、如何移动没有标题栏的窗口?
  
  我们一般是用鼠标按住窗口的标题栏,然后移动窗口,当窗口没有标题栏时,我们可以用下面的方法来移动窗口:
  
  *API函数声明:
  Declare Function ReleaseCapture Lib "user32" () As Long 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 HTCAPTION = 2
  Public Const WM_NCLBUTTONDOWN = &HA1
  在 Form_MouseDown 事件中:
  Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION,0&
  End Sub
  
  
  17、VB中如何使用延时函数?
  
  *API函数声明:
  Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  调用:
  注释:延时1秒
  Call Sleep(1000)
  
  
  18、调用修改屏幕保护口令的窗口:
  
  Private Declare Function PwdChangePassword Lib "mpr" Alias "PwdChangePasswordA" (ByVal lpcRegkeyname As String, ByVal hwnd As Long, ByVal uiReserved1 As Long, ByVal uiReserved2 As Long) As Long
  调用:
  Call PwdChangePassword("SCRSAVE", Me.hwnd, 0, 0)
  
  19、使Windows开始屏幕保护:
  *API函数声明
  Private Declare Function SendMessage Lib "user32"
  Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg
  As Long, ByVal wParam As Long, ByVal lParam As Long)
  As Long
  Const WM_SYSCOMMAND = &H112&
  Const SC_SCREENSAVE = &HF140&
  注释:调用
  Dim result As Long
  result = SendMessage(Form1.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
  
  
  20、如何改变Windows桌面背景?
  *API函数声明
  Const SPI_SETDESKWALLPAPER = 20
  Const SPIF_UPDATEINIFILE = &H1
  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
  注释:调用
  Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "C:windowsClouds.bmp", SPIF_UPDATEINIFILE)
  
  
  21、怎样确定系统是否安装了声卡?
  
  *API函数声明:
  Declare Function waveOutGetNumDevs Lib "winmm.dll" Alias "waveOutGetNumDevs" () As Long
  代码如下:
  Dim i As Integer
  i = waveOutGetNumDevs()
  If i > 0 Then MsgBox "你的系统可以播放声音。", vbInformation, "声卡检测"
  Else
  MsgBox "你的系统不能播放声音。", vbInformation, "声卡检测"
  End If
  
  
  22、如何找到CD-ROM驱动器的盘号?
  下面的函数将检查你计算机所有的驱动器看是否是 CD-ROM,如果是就返回驱动器号,如果没有就返回空字符
  Public Function GetCDROMDrive() As String
   Dim lType As Long,i As Integer,tmpDrive as String,found as Boolean
   On Error GoTo errL
   For i = 0 To 25
    tmpDrive = Chr(65 + i) & ":"
    lType = GetDriveType(tmpDrive) 注释:Win32 API 函数
    If (lType = DRIVE_CDROM) Then 注释:Win32 API 常数
     found = True
     Exit For
    End If
   Next
   If Not found Then tmpDrive = ""
   BI_GetCDROMDrive = tmpDrive
   exit Function
   errL: msgbox error$
  End Function
  
  
  23、如何将文件放入回收站?
  
  **API函数声明
  Public Type SHFILEOPSTRUCT
  hwnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Long
  hNameMappings As Long
  lpszProgressTitle As Long
  End Type
  Public Declare Function SHFileOperation Lib _ "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
  Public Const FO_DELETE = &H3
  Public Const FOF_ALLOWUNDO = &H40
  注释:调用
  Dim SHop As SHFILEOPSTRUCT, strFile as string
  With SHop
  .wFunc = FO_DELETE
  .pFrom = strFile + Chr(0)
  .fFlags = FOF_ALLOWUNDO
  End With
  
  
  24、VB中如何使用未安装的字体?
  Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
  Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
  增加字体:
  Dim lResult As Long
  lResult = AddFontResource("c:myAppmyFont.ttf")
  删除字体:
  Dim lResult As Long
  lResult = RemoveFontResource("c:myAppmyFont.ttf")



相关文章
  • 精通PHP的十大要点
  • VB解决Unicode文本转换的问题
  • 一个基于WEB的QQ程序
  • 使用xmlhttp查询域名是否被注的小程序
  • 用VB6实现中英文文本的私钥加密
  • 一组VB实用小程序
  • 用VB编写异步多线程下载程序
  • 屏保程序模板化完整源代码
  • VB中实现窗体自动隐藏
  • 用VB编写网络监控软件
  • VB到底为我们做了什么?
  • 键盘幽灵VB版
  • 用VB编写定时关闭计算机的程序
  • 用MCI命令做一个播放器
  • 使用VB在WIN2000下截获IP数据包
  • VB中字符串中文的问题
  • 用VB制作屏幕保护程序
  • VB枚举主机IP
  • 用VB编写一个弹出菜单类
  • 自己的IE——用VB制作浏览器
  • 相关软件

  • VBScript编辑器源码  
  • 字体观察器FontViewer源码  
  • 自动壁纸更换器源码[第二部分]  
  • 自动壁纸更换器源码[第一部分]  
  • WINDOWS 3.0终端程序的C源码  
  • 一个取得 CPU 信息的程序源码  
  • 广告窗口终结者源码  
  • 下载整个网站程序ssnag与源码  
  • CGI邮件程序源码  
  • ISAPI留言簿源码  



  • 月光软件源码下载编程文档电脑教程网站优化网址导航网络文学游戏天地生活休闲写作范文安妮宝贝站内搜索
    电脑技术编程开发网络专区谈天说地情感世界游戏元素分类游戏热门游戏体育运动手机专区业余爱好影视沙龙
    音乐天地数码广场教育园地科学大观古今纵横谈股论金人文艺术医学保健动漫图酷二手专区地方风情各行各业

    月光软件站·版权所有