扫一扫
分享文章到微信

扫一扫
关注官方公众号
至顶头条
| 名称 | 组件类型 | 组件CAPTION | 主要过程及事件 | 说明 | 
| mMenuTitle | TMenuItem | ==光驱控制== | 无 | 弹出菜单标签 | 
| mOpenCDROM | TMenuItem | 打开CDROM盒 | 生成子菜单( | 打开光驱子菜单 | 
| mCloseCDROM | TMenuItem | 关闭CDROM盒 | 生成子菜单 | 关闭光驱子菜单 | 
| mAutoRun | TMenuItem | 置启动时执行 | mAutoRunClick | 开机运行 | 
| mNotAutoRun | TMenuItem | 自动执行无效 | SetCDAutoRun(False) | 取消开机运行 | 
| mCloseApp | TMenuItem | 关闭控制程序 | Application.Terminate; | 关闭控制程序 | 

图1 弹出菜单效果图
| … … procedure mCloseAppClick(Sender: TObject); procedure mAutorunClick(Sender: TObject); procedure mNotautorunClick(Sender: TObject); procedure PopmenuCDctrlPopup(Sender: TObject); private { Private declarations } procedure MenuOpenCdrom(Sender : TObject); procedure MenuCloseCdrom(Sender : TObject); var Form1: TForm1; MYDRIVE:char; Mycdrom:pchar; tmppopmenu1,tmpPopmenu2:TMenuItem; function OpenCDROM(Drive:pChar):Boolean; function CloseCDROM(Drive:pChar):Boolean; implementation … … | 
| procedure TForm1.PopupMenu1Popup(Sender: TObject); var Drive :char; begin; mOpenCdrom.Clear; //清除打开光驱子菜单项 mCloseCdrom.Clear; //清除打开光驱子菜单项 //列出光驱数目和生成子菜单 for Drive:='a' to 'z' do begin Case GetDriveType(Pchar(Drive+':\')) of DRIVE_REMOVABLE: MyDrive:=Drive; DRIVE_FIXED: MyDrive:=Drive; DRIVE_CDROM: begin MyDrive:=Drive; tmppopmenu1:=TMenuItem.Create(Self); tmppopmenu1.AutoHotkeys:=maManual; tmppopmenu1.OnClick := menuOpenCdrom; mOpenCDROM.Add(tmppopmenu1); tmppopmenu1.Caption :=UpperCase(mydrive)+':'; tmppopmenu2:=TMenuItem.Create(Self); tmppopmenu2.AutoHotkeys:=maManual; tmppopmenu2.OnClick := menuCloseCdrom; mCloseCDROM.Add(tmppopmenu2); tmppopmenu2.Caption :=UpperCase(mydrive)+':'; end; DRIVE_RAMDISK: MyDrive:=Drive; DRIVE_REMOTE: MyDrive:=Drive; end; end; //当光驱多于1个生成“所有光驱”控制菜单项 if mOpenCDROM.Count > 1 then begin tmppopmenu1:=TMenuItem.Create(Self); tmppopmenu1.Caption:='所有光驱'; tmppopmenu1.OnClick := menuOpenCdrom; mOpenCDROM.Add(tmppopmenu1); tmppopmenu2:=TMenuItem.Create(Self); tmppopmenu2.Caption:='所有光驱'; tmppopmenu2.OnClick := menuCloseCdrom; mCloseCDROM.Add(tmppopmenu2); end; end; | 
| function OpenCDROM(Drive:pChar):Boolean; // 打开CDROM var Res:MciError; OpenParm:TMCI_OPEN_Parms; Flags:Dword; s:string; DeviceID:Word; begin Result:=false; s:=Drive+':'; flags:=mci_Open_Type or mci_Open_Element; With OpenParm do begin dwCallBack:=0; lpstrDeviceType:='CDAudio'; lpstrElementName:=PChar(s); end; Res:=mciSendCommand(0,mci_Open,Flags,Longint(@OpenParm)); If Res<>0 then exit; DeviceID:=OpenParm.wDeviceID ; try Res:=mciSendCommand(DeviceID,MCI_SET,MCI_SET_DOOR_OPEN,0); If Res=0 then exit; Result:=True; finally mciSendCommand(DeviceID,mci_Close,Flags,Longint(@OpenParm)); end; end; | 
如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。