form1.frm

远程访问sql server 的源码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "位图菜单"
   ClientHeight    =   5115
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6300
   LinkTopic       =   "Form1"
   ScaleHeight     =   5115
   ScaleWidth      =   6300
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Pictures 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   1
      Left            =   4320
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   1
      Top             =   120
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox Pictures 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   0
      Left            =   3600
      Picture         =   "Form1.frx":0442
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Menu mnuFile 
      Caption         =   "File"
      Begin VB.Menu mnuExit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu mnuPic 
      Caption         =   "Pic"
      Begin VB.Menu mnuSetPic 
         Caption         =   "SetPic1"
         Index           =   0
      End
      Begin VB.Menu mnuSetPic 
         Caption         =   "SetPic2"
         Index           =   1
      End
   End
   Begin VB.Menu mnuPopUp 
      Caption         =   "PopUp"
      Visible         =   0   'False
      Begin VB.Menu mnuPopUp1 
         Caption         =   "Pop1"
      End
      Begin VB.Menu mnuPopUp2 
         Caption         =   "Pop2"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
    Dim nLoopCtr As Integer
    Dim lResult As Long
    Dim hTempDC As Long
    Dim nWidth As Integer
    Dim nHeight As Integer
    Dim lTempID As Long
    Dim hMenuID As Long
    Dim lItemCount As Long
    Dim hBitmap As Long
    
    '设定菜单显现的高度和宽度
    nWidth = Pictures(0).Width \ Screen.TwipsPerPixelX
    nHeight = Pictures(0).Height \ Screen.TwipsPerPixelY
    '获取子菜单句柄
    hMenuID = GetSubMenu(GetMenu((Me.hwnd)), 1)
    '创建绘图设备环境
    hTempDC = CreateCompatibleDC(Pictures(0).hdc)
    
    For nLoopCtr = 0 To 1
        '获取相应的位图，并且将选定的位图选入设备环境中去
        hBitmap = CreateCompatibleBitmap(Pictures(nLoopCtr).hdc, _
            nWidth, nHeight)
        lTempID = SelectObject(hTempDC, hBitmap)
        lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight, _
            (Pictures(nLoopCtr).hdc), 0, 0, SRCCOPY)
        lTempID = SelectObject(hTempDC, lTempID)
        mnuSetPic(nLoopCtr).Caption = vbNullString
        
        '修改菜单，将位图真正的绘制到菜单上去
        lResult = ModifyMenu(hMenuID, nLoopCtr, _
            MF_BYPOSITION Or MF_BITMAP, _
            GetMenuItemID(hMenuID, nLoopCtr), hBitmap)
    Next nLoopCtr
    
    lResult = DeleteDC(hTempDC)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        PopupMenu mnuPopUp
    End If
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub