BarTenderActiveX在Delphi和VB下调用数据库的实例.doc

BarTender ActiveX 在Delphi和VB下调用数据库的实例(转贴) BarTender ActiveX封装了大量的函数和属性，其中包括对数据库的调用。下面通过在Delphi和VB下的实例给出其调用方法。先看Delphi的例子。1. 首先打开BarTender生成一个标签，并正确添加数据库，设置其子串共享名为domain1。2. 打开Delphi，创建一个工程。3. 声明全局变量btapp，btformat，btdb。4. 在FormCreate过程中引用BarTender。btapp:=createoleobject(Bartender.application.7);btapp.visible:=false;向窗体中加入一个button，设置其Caption值为“打印”，其name为“print”，为其click过程添加代码：btformat:=btapp.formats.open(d:bartenderformat1.btw, true, );btdb:= btformat.databases.item(1);btformat.printout(0,0);btformat.close(1);6. 向FormCloseQuery中加入代码：trybtapp.quit(1)exceptapplication.terminateend;保存并运行。源代码如下:usesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, DB, OleCtrls, DBOleCtl, BARCODELib_TLB, ComObj,OleCtnrs,ExtCtrls, ComCtrls, DBCtrls;typeTForm1 = class(TForm)print: TButton;Label1: TLabel;procedure FormCreate(Sender: TObject);procedure printClick(Sender: TObject);private Private declarations public Public declarations btapp:variant;btformat:variant;btdb:variant;end;varForm1: TForm1;implementation$R *.dfmprocedure TForm1.FormCreate(Sender: TObject);beginbtapp:=createoleobject(Bartender.application.7);btapp.visible:=false;end;procedure TForm1.printClick(Sender: TObject);beginbtformat:=btapp.formats.open(d:bartenderformat1.btw, true, );btdb:= btformat.databases.item(1);btformat.printout(0,0);btformat.close(1);end;procedure TForm1.FormCloseQuery(Sender: Tobject; CanClose: Boolean);begintrybtapp.quit(1)exceptapplication.terminateend; end;end.下面我们再通过一个简单的例子说明BarTender ActiveX在VB下如何调用数据库，因此在此例中我们直接为format1.btw指定了数据库域，并指定了文件存放的路径。1. 首先打开BarTender生成一个标签，并正确添加数据库，设置其子串共享名为domain1。2. 在VB中新建一个工程，保存。“工程|引用”中选中BarTender7.0，然后打开代码窗口，选择“通用/声明”，添加下列声明：Dim btapp As BarTender.ApplicationDim btformat As BarTender.FormatDim btdb As BarTender.Database3. 在“Form/Load”中加入代码：Private Sub Form_Load()Set btapp = CreateObject(bartender.application)btapp.Visible = FalseEnd Sub4. 在对象窗口向Form中放入一个Command按钮，其Caption属性赋为“打印”，name属性为“print”，双击为其添加代码：Private Sub print_Click()Set btformat = btapp.Formats.Open(d:bartenderformat1.btw)Set btdb = btformat.Databases(1)Set btdb = btformat.Databases.Item(1)Set btdb = btformat.Databases(domain1)btformat.PrintOutEnd Sub5. 在“Form/Unload”中添加：btapp.Quit按F5运行，单击打印按钮，通过连接的打印机即可打印所需的标签。VB 中的文本框输入完后按ENTER键就触发下一事件那个叫什么过程? Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then MsgBox OK! End If End SubKeyAsciiKeyAscii是键盘输入后传递给程序的ASCII码，关于ASCII码，各种电脑书籍一般都有附录，网络上搜索也很多。 常规ASCII码是0127，一般可以显示的是32127 关于KeyAscii的使用，主要是拦截判断键盘输入的键值，比如，只允许输入数字，就可以在文本框的KeyPress中输入： If KeyAscii 57 Then KeyAscii = 0 KeyAscii键码 常数 值 描述 vbKeyLButton 1 鼠标左键 vbKeyRButton 2 鼠标右键 vbKeyCancel 3 CANCEL 键 vbKeyMButton 4 鼠标中键 vbKeyBack 8 BACKSPACE 键 vbKeyTab 9 TAB 键 vbKeyClear 12 CLEAR 键 vbKeyReturn 13 ENTER 键 vbKeyShift 16 SHIFT 键 vbKeyControl 17 CTRL 键 vbKeyMenu 18 菜单键 vbKeyPause 19 PAUSE 键 vbKeyCapital 20 CAPS LOCK 键 vbKeyEscape 27 ESC 键 vbKeySpace 32 SPACEBAR 键 vbKeyPageUp 33 PAGEUP 键 vbKeyPageDown 34 PAGEDOWN 键 vbKeyEnd 35 END 键 vbKeyHome 36 HOME 键 vbKeyLeft 37 LEFT ARROW 键 vbKeyUp 38 UP ARROW 键 vbKeyRight 39 RIGHT ARROW 键 vbKeyDown 40 DOWN ARROW 键 vbKeySelect 41 SELECT 键 vbKeyPrint 42 PRINT SCREEN 键 vbKeyExecute 43 EXECUTE 键 vbKeySnapshot 44 SNAP SHOT 键 vbKeyInser 45 INS 键 vbKeyDelete 46 DEL 键 vbKeyHelp 47 HELP 键 vbKeyNumlock 144 NUM LOCK 键 A 键到 Z 键与其 ASCII 码的相应值A 到 Z 是一致的 常数 值 描述 vbKeyA 65 A 键 vbKeyB 66 B 键 vbKeyC 67 C 键 vbKeyD 68 D 键 vbKeyE 69 E 键 vbKeyF 70 F 键 vbKeyG 71 G 键 vbKeyH 72 H 键 vbKeyI 73 I 键 vbKeyJ 74 J 键 vbKeyK 75 K 键 vbKeyL 76 L 键 vbKeyM 77 M 键 vbKeyN 78 N 键 vbKeyO 79 O 键 vbKeyP 80 P 键 vbKeyQ 81 Q 键 vbKeyR 82 R 键 vbKeyS 83 S 键 vbKeyT 84 T 键 vbKeyU 85 U 键 vbKeyV 86 V 键 vbKeyW 87 W 键 vbKeyX 88 X 键 vbKeyY 89 Y 键 vbKeyZ 90 Z 键 0 键到 9 键与其 ASCII 码的相应值 0 到 9 是一致的 常数 值 描述 vbKey0 48 0 键 vbKey1 49 1 键 vbKey2 50 2 键 vbKey3 51 3 键 vbKey4 52 4 键 vbKey5 53 5 键 vbKey6 54 6 键 vbKey7 55 7 键 vbKey8 56 8 键 vbKey9 57 9 键 数字小键盘上的键 常数 值 描述 vbKeyNumpad0 96 0 键 vbKeyNumpad1 97 1 键 vbKeyNumpad2 98 2 键 vbKeyNumpad3 99 3 键 vbKeyNumpad4 100 4 键 vbKeyNumpad5 101 5 键 vbKeyNumpad6 102 6 键 vbKeyNumpad7 103 7 键 vbKeyNumpad8 104 8 键 vbKeyNumpad9 105 9 键 vbKeyMultiply 106 乘号 (*) 键 vbKeyAdd 107 加号 (+) 键 vbKeySeparator 108 ENTER 键（在数字小键盘上） vbKeySubtract 109 减号 (-) 键 vbKeyDecimal 110 小数点 (.) 键 vbKeyDivide 111 除号 (/) 键 功能键 常数 值 描述 vbKeyF1 112 F1 键 vbKeyF2 113 F2 键 vbKeyF3 114 F3 键 vbKeyF4 115 F4 键 vbKeyF5 116 F5 键 vbKeyF6 117 F6 键 vbKeyF7 118 F7 键 vbKeyF8 119 F8 键 vbKeyF9 120 F9 键 vbKeyF10 121 F10 键 vbKeyF11 122 F11 键 vbKeyF12 123 F12 键 vbKeyF13 124 F13 键 vbKeyF14 125 F14 键 vbKeyF15 126 F15 键 vbKeyF16 127 F16 键VB中防止将重复项目添加到列表框控件中2000-09-04 谭翁VB编程乐园isualBasic的列表框控件中包含项目的列表，本文介绍如何检查列表中项目是否已 经存在，以及如何将新的项目添加到列表框控件中。 使用SendMessage函数搜寻重复的项目在VisualBasic中开发应用程序时，可以使用列表框控件来创建一个项目的列表。要将 新的项目添加到列表中，可以使用AddItem方法，该方法不能自动地报告在列表框控件中是否 有重复的信息存在，所以必须在将新项目添加到列表之前首先检查一下。可以通 过使用Windows应用程序编程接口（API）的SendMessage函数来在列表框控件中搜寻指定的项 目，它函数允许向操作系统中发送消息。在本文的例子里，我们让SendMessage函数往列表框 控件中执行一个LB_FINDSTRING消息。LB_FINDSTRING消息允许在一个列表框控 件中搜索同目标字符串相匹配的项目。该消息的第一个参数是希望进行的搜索类型，须将该 值设为0，表示从列表框控件中的第一个项目开始搜索。第二个参数是一个NULL结束的字符串， 它是实际希望搜索的项目。如果该LB_FINDSTRING消息返回值-1，则表明在列表 框控件中没有找到目标字符串，此时可以使用AddItem方法来将新的项目添加到列表框控件 中。如果该项目已经在列表中存在，则可以简单地显示一个信息框或是执行一些其它的过程， 来通知用户一个重复的项目已经在列表框控件中存在。样例程序该程序显示了如何确定在一个列表框控件中是否已经包含了一个要添加到控件中的项 目。1.在VisualBasic中开始一个新的工程，采用缺省的方法建立Form1。2.将如下常量和声明语句添加到Form1的通用声明部分中（注意该声明语句需要被书 写在一行内）：PrivateDeclareFunctionSendMessageFindLibuser32AliasSendMessageA (ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsInteger,ByVallParam AsString)AsLongConstWM_USER=&H400ConstLB_ERR=(-1)ConstLB_FINDSTRING=&H18F3.将如下代码添加到Form1的Form_Load 事件中：PrivateSubForm_Load()List1.AddItemItem#1List1.AddItemItem#2List1.AddItemItem#3List1.AddItemItem#4EndSub4.在Form1上添加一个文本框控件，采用缺省的方法建立Text1。5.在Form1上添加一个列表框控件，采用缺? 方法建立List1。6.在Form1上添加一个命令按钮控件，采用缺省的方法建立Command1，将起Caption属 性设置为“重复”。7.将如下代码添加到Command1的单击事件中：PrivateSubCommand1_Click()CheckForDupesEndSub8.创建一个新的名为CheckForDupes的函数，将如下代码添加到该函 数中：SubCheckForDupes()DimRetAsLongDimAAsStringA=Text1.TEXTRet=SendMessageFind(List1.hwnd,LB_FINDSTRING,0,(A)IfRet=LB_ERRThenList1.AddItemText1.TEXTElseList1.ListIndex=RetMsgBox重复项目不能被添加到列表框中,16,错误EndIfEndSub按下F5键来执行本程序。在列表框控件中有5个项目。在文本框控件中 键入一个新的项目，单击重复命令按钮。程序将在列表框控件中搜索刚刚键入到文本框控件 中的项目。如果该项目未被找到，则程序将把该项目添加到列表框控件中。相反，如果该项目 已经在列表框中存在了，则将显示出一个信息框以通知项目已经存在。使整个屏幕变暗，如同关机画面 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 (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As LongPrivate bybits(1 To 16) As BytePrivate hBitmap As Long, hBrush As LongPrivate hDesktopWnd As Long将图变暗，如同待关机一般Private Sub Command1_Click()Dim rop As Long, res As LongDim hdc5 As Long, width5 As Long, height5 As Long如果只要让Picture1有效果将底下叁行unMark取代 hdc5, width5, height5叁个值hdc5 = Picture1.hdcwidth5 = Picture1.ScaleWidthheight5 = Picture1.ScaleHeight底下叁行设定整个萤幕都暗下来hdc5 = GetDC(0)width5 = Screen.Width Screen.TwipsPerPixelXheight5 = Screen.Height Screen.TwipsPerPixelYrop = &HA000C9 与原图做and运算Call SelectObject(hdc5, hBrush)res = PatBlt(hdc5, 0, 0, width5, height5, rop)Call DeleteObject(hBrush)如果只暗picture1则底下这一行要mark起来res = ReleaseDC(0, hdc5)End Sub回复原本的画面Private Sub Command2_Click()Dim aa As Long如果只暗picture1则底下这一行要unMark起来Picture1.Refresh如果只暗picture1则底下这一行要mark起来aa = InvalidateRect(0, 0, 1)End SubPrivate Sub Form_Load()Dim aryDim i As Longary = Array(&H55, &H0, &HAA, &H0, _&H55, &H0, &HAA, &H0, _&H55, &H0, &HAA, &H0, _&H55, &H0, &HAA, &H0)For i = 1 To 16bybits(i) = ary(i - 1)Next ihBitmap = CreateBitmap(8, 8, 1, 1, bybits(1)hBrush = CreatePatternBrush(hBitmap)Picture1.ForeColor = RGB(0, 0, 0)Picture1.BackColor = RGB(255, 255, 255)Picture1.ScaleMode = 3End Sub返回有 BitMap 之Menu 在Window API中，有一些名词要先清楚，假设有一功能表如下：档案 编辑 选项 - hMenu (功能表)+-+|复制 |- hSubMenu (子功能表)|贴上 |减下 - MenuID (功能表项目)| |+-+如果，我们使用vb的功能表编辑器做出上面的Menu，那 hMenu的取得使用GetMenu() API，而hSubMenu 的取得是 GetSubMenu，而GetSubMenu()的第二个参数指的是功能表的第几个子功能表，以上例来说，编辑子功能表是第1个子功能表(以0为基准)，所以编辑子功能表的取得应用以下的呼叫 ：hMenu = GetMenu(Me.hwnd)hSubMenu = GetSubMenu(hMenu, 1) 取得编辑子功能表的hSubMenu而功能表项目则由以下的呼叫取得，第二参数指的是该子功能表的第几个项目(以0开始)，故复制 功能表项目 = 0 减下 = 2MenuId = GetMenuItemID(hSubMenu, 0) 取得复制 的hMenuId接着便是以ModifyMenu来更动MenuId成BitMap的方式Set Pic1 = LoadPicture(E:cli.bmp)ModifyMenu hSubMenu, 0, MF_BITMAP Or MF_BYPOSITION, MenuId, pic1.HandleModifyMenu 第二个参数 表示更动hSubMenu所指的子功能表中第几个功能表项目第叁个参数 MF_BITMAP 表示用BitMap的方式显示MF_STRING 表示用字串方式显示MF_BYPOSITION 表示第二个参数的值代表是依位置来算第四个参数 MenuId第五个参数 显示图的hBitMap另外，如何做到MenuItem的左方有一小Bitmap，右方仍是字串呢，使用以下的APISetMenuItemBitmaps(hSubMenu as Long , / handle of 子功能表uItem as Long , / 更动第几个Menu ItemfuFlags as Long, / menu item flagshbmUnchecked as Long, / handle of unchecked bitmaphbmChecked as Long / handle of checked bitmap)Set Pic2 = LoadPicture(e:cli2.BitMap)Call SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION,pic2.Handle, Pic2.Handle)这里有一个地方要特别注意，到底hbmUnchecked/hbmchecked 所指的BitMap图有多大呢，如果pic2所放入的BitMap太大，那不会出现我们想要的图，那得自己想办法缩图；而使用以下的API可以取得Menu Item左边Bitmap图的大小(By Pixels)i = GetMenuCheckMarkDimensionswd5 = i Mod 2 16 宽hi5 = i / 2 16 高而我们Load进来的图之宽 Me.ScaleX(pic2.Width, vbHimetric, vbPixels)高 Me.ScaleY(pic2.Height, vbHimetric, vbPixels)於是呢，我写了一个GetBitMapHandle 来取得hbmUnchecked/hbmchecked所需的BitMapHandle，而且该hBitMap所指的图，大小刚好是系统内定的大小，而不必在乎原始的图有多大，当然了，一定要使用BitMap图，不可使用icon/gif等之类的图，这是什麽原因呢，这是因为我使用StdPicture物件来开启图形档，如果图形档是BitMap图，那麽，stdPicture物件的Handle属性便是hBitmap。以下在.basOption ExplicitPublic Const MF_BYCOMMAND = &H0&Public Const MF_BYPOSITION = &H400&Public Const MF_BITMAP = &H4&Public Const MF_STRING = &H0&Declare Function GetMenu Lib user32 (ByVal hwnd As Long) As LongDeclare Function GetSubMenu Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function DeleteDC Lib gdi32 (ByVal hdc As Long) As LongDeclare Function GetMenuItemID Lib user32 (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function ModifyMenu Lib user32 Alias ModifyMenuA (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As LongDeclare Function SetMenuItemBitmaps Lib user32 (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As LongDeclare Function GetMenuCheckMarkDimensions Lib user32 () As LongDeclare Function CreateCompatibleBitmap Lib gdi32 (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongDeclare Function CreateCompatibleDC Lib gdi32 (ByVal hdc As Long) As LongDeclare Function SelectObject Lib gdi32 (ByVal hdc As Long, ByVal hObject As Long) As LongDeclare Function DeleteObject Lib gdi32 (ByVal hObject As Long) As LongDeclare Function StretchBlt Lib gdi32 (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As LongConst SRCCOPY = &HCC0020Public TheForm As FormPublic Function GetBitMapHandle(ByVal FileName As String)Dim dstWidth As Long, dstHeight As LongDim srcWidth As Long, srcHeight As LongDim x As Long, y As LongDim pic As New StdPictureDim hDc5 As Long, i As LongDim hBitmap As LongDim hDstDc As LongSet pic = LoadPicture(FileName) 读取图形档hDc5 = CreateCompatibleDC(0) 建立Memory DCi = SelectObject(hDc5, pic.Handle) 在该memoryDC上放上bitmap图i = GetMenuCheckMarkDimensions 取得SetMenuItemBitmaps 所需Bitmap大小dstWidth = i Mod 2 16dstHeight = i / 2 16建一个大小为dstWidh * dstHeight大小的BitmaphBitmap = CreateCompatibleBitmap(TheForm.hdc, dstWidth, dstHeight)hDstDc = CreateCompatibleDC(TheForm.hdc) 建memory dc设该memory dc的绘图区大小=该bitmap大小，且在该memory dc上的绘图便是在该bitmap图上画图SelectObject hDstDc, hBitmapsrcHeight = TheForm.ScaleY(pic.Height, vbHimetric, vbPixels)srcWidth = TheForm.ScaleX(pic.Width, vbHimetric, vbPixels)Call StretchBlt(hDstDc, 0, 0, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)GetBitMapHandle = hBitmapCall DeleteDC(hDc5)Call DeleteDC(hDstDc)End Function以下在FormOption ExplicitPrivate hMenu As LongPrivate hSubMenu As LongPrivate MenuId As LongPrivate pic1 As New StdPicturePrivate pic2 As New StdPictureDim hBitmap As LongPrivate Sub Form_Load()Set TheForm = MeSet pic1 = LoadPicture(e:cli.bmp)hMenu = GetMenu(Me.hwnd)hSubMenu = GetSubMenu(hMenu, 1)MenuId = GetMenuItemID(hSubMenu, 1)ModifyMenu hSubMenu, 0, MF_BITMAP Or MF_BYPOSITION, MenuId, pic1.HandlehBitmap = GetBitMapHandle(e:cli.bmp)Call SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, hBitmap, hBitmap)End SubPrivate Sub Form_Unload(Cancel As Integer)DeleteObject hBitmapEnd Sub返回怎样限制鼠标移动 本文介绍如何限制鼠标在窗口的指定范围内移动。这个技术在需要防止用户鼠标在指定区域内活动时非常有用。例如在一个射击游戏中，需要限制鼠标在射击区内移动。操作步骤1、建立一个新工程项目，缺省建立窗体FORM12、添加一个新模体3、粘贴下面代码到新模体 Option ExplicitDeclare Function ClipCursor Lib user32 (lpRect As Any) As LongDeclare Function ClipCursorClear Lib user32 Alias ClipCursor (ByVal lpRect As Long) As LongDeclare Function ClientToScreen Lib user32 (ByVal hwnd As Long, lpPoint As POINTAPI) As LongType RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypeType POINTAPIX As LongY As LongEnd TypePublic RetValue As LongPublic ClipMode As BooleanPublic Sub SetCursor(ClipObject As Object, Setting As Boolean) used to clip the cursor into the viewport and turn off the default windows cursorDim CurrentPoint As POINTAPIDim ClipRect As RECTIf Setting = False Then set clip state back to normalRetValue = ClipCursorClear(0)Exit SubEnd If set current positionWith CurrentPoint.X = 0.Y = 0End With find position on the screen (not the window)RetValue = ClientToScreen(ClipObject.hwnd, CurrentPoint) designate clip areaWith ClipRect.Top = CurrentPoint.Y.Left = CurrentPoint.X.Right = .Left + ClipObject.ScaleWidth.Bottom = .Top + ClipObject.ScaleHeightEnd With clip itRetValue = ClipCursor(ClipRect)End Sub4、添加一个图片框控件（PICTURE1）到窗体（FORM1）5、设置PICTURE1的尺寸和FORM1的一样大6、在PICTURE1的CLICK事件中添加以下代码：Private Sub Picture1_Click()ClipMode = Not ClipModeSetCursor Picture1, ClipModeEnd Sub7、保存工程项目8、运行程序。在图片框单击鼠标，鼠标将被包含在图片框控件的区域内。要释放限制状态只需再次单击鼠标。注意：如果释放限制状态失败，鼠标将被永久限制，只能用重新启动机器来解决。另一个限制鼠标活动范围的方法是关闭鼠标，用其他图象代替光标，例如手枪。返回自己编程模拟 MouseEnter,MouseExit 事件 很多第三方的控件都提供的 MouseEnter 和 MouseExit 事件来补充 MouseMove 事件的不足（MouseMove 事件不能有效的捕获鼠标是否已在控件外），但是这些控件或要注册，或集合了其他实际没有什么作用控件，另外在程序中加入太多的控件也会影响程序的性能，利用 Windows 的 API 函数，我们可以在 MouseMove 中模拟 MouseEnter 和 MouseExit，虽然我提供的源代码中没有真正的这两个事件，但的确提供了这两个事件所具备的功能。好了！让我们实现吧。 首先加载一个模块，在模块中声明以下两个 API 函数：Public Declare Function SetCapture Lib user32 _(ByVal hwnd As Long) As LongPublic Declare Function ReleaseCapture Lib user32 () As LongSetCapture 的功能是：设置鼠标捕获指定的窗口（Windows 每个控件都是一个窗口。比如桌面上显示的图标就是一个窗口，其实是两个，另一个显示描述这个图标的文本），系统将收到这个窗口所有的鼠标移动或击按的所有信息。ReleaseCapture 的功能是：取消捕获鼠标信息。Windows 系统就是一个消息系统，系统一直在等待用户的消息，并加一相应，但处理完一个消息后，系统有处以下一轮的等待。消息传递是 Windows 的核心。让我们在 Form1 中放置一个按钮或其他控件，但此控件必须具有窗口句柄（hWnd），比如 VB 提供的 Image 控件是一个次图形控件，没有窗口句柄，而 Picture，Command Button 等控件就有窗口句柄，我们就拿 Command Button 来作示范，在 Form1 上放置一个 Command Button，在 Command1_MouseMove()事件内加入以下代码：Private Sub Command1_MouseMove(Button As Integer, _Shift As Integer, X As Single, Y As Single)With Command1当鼠标在越出控件外If Not (X 0) Or (Y .Width) Or (Y .Height) Then鼠标指针在按钮外时，让其他控件也收到标事件ReleaseCapture为了不让 MouseMove 事件反复触发If .Caption outside Then.Caption = outsideEnd If鼠标指针在按钮上，捕获他但鼠标移出是我们将收到鼠标事件SetCapture .hwndElse.Caption = insideEnd IfEnd WithEnd Sub返回移动没有标题栏的窗口 我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口： 在 BAS 文件中声明： Declare Function ReleaseCapture Lib user32 () As Long Declare Function SendMessage Lib user32