BarTender ActiveX 在Delphi和VB下调用数据库的实例

i = GetMenuCheckMarkDimensions '取得SetMenuItemBitmaps 所需Bitmap大小 dstWidth = i Mod 2 ^ 16 dstHeight = i / 2 ^ 16

'建一个大小为dstWidh * dstHeight大小的Bitmap

hBitmap = CreateCompatibleBitmap(TheForm.hdc, dstWidth, dstHeight) hDstDc = CreateCompatibleDC(TheForm.hdc) '建memory dc

'设该memory dc的绘图区大小=该bitmap大小，且在该memory dc上的绘图便是在 '该bitmap图上画图 SelectObject hDstDc, hBitmap

srcHeight = 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 = hBitmap Call DeleteDC(hDc5) Call DeleteDC(hDstDc) End Function

'以下在Form Option Explicit Private hMenu As Long Private hSubMenu As Long Private MenuId As Long Private pic1 As New StdPicture Private pic2 As New StdPicture Dim hBitmap As Long

Private Sub Form_Load() Set TheForm = Me

Set pic1 = LoadPicture(\hMenu = GetMenu(Me.hwnd) hSubMenu = GetSubMenu(hMenu, 1) MenuId = GetMenuItemID(hSubMenu, 1)

ModifyMenu hSubMenu, 0, MF_BITMAP Or MF_BYPOSITION, MenuId, pic1.Handle hBitmap = GetBitMapHandle(\

Call SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, hBitmap, hBitmap) End Sub

Private Sub Form_Unload(Cancel As Integer) DeleteObject hBitmap

End Sub 返回

怎样限制鼠标移动

本文介绍如何限制鼠标在窗口的指定范围内移动。这个技术在需要防止用户鼠标在指定区域内活动时非常 有用。例如在一个射击游戏中，需要限制鼠标在射击区内移动。 操作步骤

1、建立一个新工程项目，缺省建立窗体FORM1 2、添加一个新模体 3、粘贴下面代码到新模体

Option ExplicitDeclare Function ClipCursor Lib \

Declare Function ClipCursorClear Lib \Declare Function ClientToScreen Lib \Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type POINTAPI X As Long Y As Long End Type

Public RetValue As Long Public ClipMode As Boolean

Public Sub SetCursor(ClipObject As Object, Setting As Boolean) ' used to clip the cursor into the viewport and ' turn off the default windows cursor

Dim CurrentPoint As POINTAPI Dim ClipRect As RECT

If Setting = False Then ' set clip state back to normal RetValue = ClipCursorClear(0) Exit Sub End If

' set current position With CurrentPoint .X = 0 .Y = 0 End With

' find position on the screen (not the window)

RetValue = ClientToScreen(ClipObject.hwnd, CurrentPoint) ' designate clip area With ClipRect .Top = CurrentPoint.Y .Left = CurrentPoint.X

.Right = .Left + ClipObject.ScaleWidth .Bottom = .Top + ClipObject.ScaleHeight End With ' clip it

RetValue = ClipCursor(ClipRect) End Sub

4、添加一个图片框控件（PICTURE1）到窗体（FORM1） 5、设置PICTURE1的尺寸和FORM1的一样大 6、在PICTURE1的CLICK事件中添加以下代码：

Private Sub Picture1_Click() ClipMode = Not ClipMode SetCursor Picture1, ClipMode End Sub

7、保存工程项目

8、运行程序。在图片框单击鼠标，鼠标将被包含在图片框控件的区域内。要释放限制状态只需再次单击鼠标。

注意：如果释放限制状态失败，鼠标将被永久限制，只能用重新启动机器来解决。 另一个限制鼠标活动范围的方法是关闭鼠标，用其他图象代替光标，例如手枪。 返回

自己编程模拟 MouseEnter,MouseExit 事件

很多第三方的控件都提供的 MouseEnter 和 MouseExit 事件来补充 MouseMove 事件的不足（MouseMove 事件不能有效的捕获鼠标是否已在控件外），但是这些控件或要注册，或集合了其他实际没有什么作用控件，另外在程序中加入太多的控件也会影响程序的性能，利用 Windows 的 API 函数，我们可以在 MouseMove 中模拟 MouseEnter 和 MouseExit，虽然我提供的源代码中没有真正的这两个事件，但的确提供了这两个事件所具备的功能。好了！让我们实现吧。

首先加载一个模块，在模块中声明以下两个 API 函数：

Public Declare Function SetCapture Lib \(ByVal hwnd As Long) As Long

Public Declare Function ReleaseCapture Lib \

SetCapture 的功能是：设置鼠标捕获指定的窗口（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 < 0) Or _ (X > .Width) Or (Y > .Height)) Then

'鼠标指针在按钮外时，让其他控件也收到标事件 ReleaseCapture

'为了不让 MouseMove 事件反复触发 If .Caption <> \.Caption = \End If

'鼠标指针在按钮上，捕获他但鼠标移出是我们将收到鼠标事件 SetCapture .hwnd Else

.Caption = \End If End With