openclosecd.frm

光驱开关器

VERSION 5.00
Begin VB.Form OpenCloseCD 
   BackColor       =   &H80000000&
   Caption         =   "光驱开关器 Ver 1.2"
   ClientHeight    =   1680
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   2940
   Icon            =   "OpenCloseCD.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1680
   ScaleWidth      =   2940
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton HideCMD 
      Height          =   495
      Left            =   2280
      Picture         =   "OpenCloseCD.frx":030A
      Style           =   1  'Graphical
      TabIndex        =   1
      ToolTipText     =   "缩小到托盘中"
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton CDcmd 
      BackColor       =   &H00FFC0C0&
      Caption         =   "弹出光驱"
      Height          =   975
      Left            =   960
      Picture         =   "OpenCloseCD.frx":0614
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "古鑫软件工作室"
      ForeColor       =   &H00008000&
      Height          =   255
      Left            =   1560
      TabIndex        =   3
      Top             =   1320
      Width           =   1335
   End
   Begin VB.Image Image2 
      Height          =   480
      Left            =   480
      Picture         =   "OpenCloseCD.frx":091E
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   0
      Picture         =   "OpenCloseCD.frx":0C28
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Label MyWeb 
      BackColor       =   &H00400040&
      BackStyle       =   0  'Transparent
      Caption         =   "http://www.cnstockstar.com"
      BeginProperty Font 
         Name            =   "Arial Black"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF8080&
      Height          =   255
      Left            =   120
      MouseIcon       =   "OpenCloseCD.frx":0F32
      MousePointer    =   99  'Custom
      TabIndex        =   2
      ToolTipText     =   "股票之星网站"
      Top             =   1440
      Width           =   2895
   End
   Begin VB.Menu mMani 
      Caption         =   "功能"
      Begin VB.Menu mItem 
         Caption         =   "弹出"
         Index           =   0
      End
      Begin VB.Menu mItem 
         Caption         =   "退出"
         Index           =   1
      End
   End
End
Attribute VB_Name = "OpenCloseCD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpoperation As String, ByVal lpfile As String, ByVal lpparaments As String, ByVal lpdirectory As String, ByVal nshowcmd As Long) As Long
 
 '-------------------------------------------
 '　　利用API函数控制光驱的开和关
 '-------------------------------------------
 '程序说明：
 '   本例使用API函数 CDdoor 来控制光驱门的开和关程序十分简单，由于 CDdoor 函数自身包含了对异常错误的处理机制，因此这个程序的通用性很高，你可以把这段代码移植到你的程序中，实现某些多媒体播放器所常用的开关光驱的功能。
 '-------------------------------------------
 '说明：CDdoor函数是安装WINDOWS时所自带的winmm.dll文件中包含的函数

Private Declare Function CDdoor Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long


'CDOpen用来标示光驱开与关的状态
Dim CDOpen As Boolean

Private Sub CDcmd_Click()
On Error Resume Next
'如果关闭则打开，并且按钮做相应变化
If CDOpen = False Then
    Call CDdoor("set CDAudio door open", 0, 0, 0)
    CDOpen = True
    CDcmd.Caption = "关闭光驱"
    mItem(0).Caption = "关闭"
    CDcmd.Picture = Image2.Picture
    CDcmd.BackColor = &HFF&
Else
'否则关闭
    Call CDdoor("set CDAudio door closed", 0, 0, 0)
    CDOpen = False
    CDcmd.Caption = "弹出光驱"
    mItem(0).Caption = "弹出"
    CDcmd.Picture = Image1.Picture
    CDcmd.BackColor = &HFFC0C0
End If
End Sub

Private Sub Form_Load()
    CDOpen = False
    Call CDdoor("set CDAudio door closed", 0, 0, 0)
End Sub

Private Sub HideCMD_Click()
  Dim l As Long
  If (Icon_Add(Form2.hwnd, OpenCloseCD.Icon)) Then
    xb = CMenu()      '添加弹出菜单
    OpenCloseCD.Hide
    '将DialogProc函数设置为Form2的窗口处理函数并且保存原来窗口处理函数句柄
    lproc = SetWindowLong(Form2.hwnd, GWL_WNDPROC, AddressOf DialogProc)
  End If
End Sub

Private Sub mItem_Click(Index As Integer)
  If Index = 0 Then CDcmd_Click
  If Index = 1 Then End
End Sub

Private Sub MyWeb_Click()
MyWeb.ForeColor = QBColor(5)
Dim Hyprjump
HyperJump = ShellExecute(0&, vbNullString, "http://www.cnstockstar.com", vbNullString, vbNullString, vbNormalFoucus)

End Sub