扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
名称 |
组件类型 |
组件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领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。
现场直击|2021世界人工智能大会
直击5G创新地带,就在2021MWC上海
5G已至 转型当时——服务提供商如何把握转型的绝佳时机
寻找自己的Flag
华为开发者大会2020(Cloud)- 科技行者