如何控制多光驱的弹出与关闭(先前问过,但答案不对,再问一次)(50分)

  • 主题发起人 主题发起人 惊天动地
  • 开始时间 开始时间

惊天动地

Unregistered / Unconfirmed
GUEST, unregistred user!
[?]如何控制多光驱的弹出与关闭,先前问了,有人回答当时没试就接受了,后来一试不行。请高手告诉我一个保证能行的。给段源码吧!谢谢!!
 
我给你一个我写的例程,包你满意。
//*******************************************************//
//soft name: 'Soft CDRom Switch',
//author: ywf,
//time: 2002.3.14.night,
//last modify: 2002.3.30.
//*******************************************************//
unit MainUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellApi,
Menus, MMsystem, Registry;

type
TMainFrm = class(TForm)
LeftPop: TPopupMenu;
Eject: TMenuItem;
CloseCd: TMenuItem;
RightPop: TPopupMenu;
EnabledOrNo: TMenuItem;
ExitPro: TMenuItem;
About: TMenuItem;
Cancel1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure EjectClick(Sender: TObject);
procedure CloseCdClick(Sender: TObject);
procedure ExitProClick(Sender: TObject);
procedure EnabledOrNoClick(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure Cancel1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconData;
useOrNo: Boolean;
procedure InstallIcon;
procedure UnInstallIcon;
Procedure UnEnabledIcon( Yes: boolean);
//respond the Message on the "CurrentIcon".
procedure OnIconclick( Var Message: TMessage);
Message WM_User+1;
public
{ Public declarations }
end;

var
MainFrm: TMainFrm;

implementation
uses AboutUnit;

{$R *.DFM}
{$R MyIcon.Res}

{ TMainFrm }

procedure TMainFrm.InstallIcon;
begin

IconData.hIcon:= LoadIcon(HInstance, 'Rose');

IconData.szTip:= 'Soft CDRom Switch 欢迎您!';
Shell_NotifyIcon(NIM_Add, @IconData);
//Mark the status of Icon for the popMenu operation.
UseOrNo:= True;
end;


procedure TMainFrm.UnInstallIcon;
begin

Shell_NotifyIcon( NIM_Delete, @IconData);
end;


procedure TMainFrm.UnEnabledIcon(Yes: Boolean);
begin

if Yes then
//install a UnEnabled Icon.
begin

IconData.hIcon := LoadIcon(hInstance, 'Rose');
end
else
//Install a enabled Icon.
begin

IconData.hIcon := LoadIcon(hInstance, 'ERose');
end;

UseOrNo:= Not UseOrNo;
Shell_NotifyIcon( NIM_Modify, @IconData);
end;



procedure TMainFrm.FormCreate(Sender: TObject);
var
Reg: TRegistry;
AppName: Pchar;
begin

//Set the program auto run when the window running.
Reg:= TRegistry.Create;
AppName:= Pchar(Application.ExeName);
try
Reg.RootKey:= Hkey_Local_Machine;
if Reg.OpenKey('SoftWare/Microsoft/Windows/CurrentVersion/Run', False) then

//add data to registry.
Reg.WriteString('RunSoftCDRomSwitch', AppName)
else

Application.MessageBox('open registry failed!','Warning', Mb_IconInformation+Mb_Ok);
finally
Reg.CloseKey;
Reg.Free;
end;

//Registry operation end.


IconData.cbSize:= SizeOf( IconData);
IconData.Wnd:= handle;
IconData.uFlags:= NIF_Message or NIF_Tip or NIF_Icon;
IconData.uID:= 1;
IconData.uCallbackMessage:= WM_User+1;
//Install Icon;
InstallIcon;
//hide Mainfrm;
SetWindowLong( Application.Handle, GWL_ExStyle, WS_EX_ToolWindow);
ShowWindow( MainFrm.Handle, SW_Hide);
end;


procedure TMainFrm.OnIconclick(var Message: TMessage);
var
Position: TPoint;
begin

GetCursorPos( Position);
if message.LParam= WM_LButtonDown then

begin

LeftPop.Popup( Position.x, Position.y);
end;

if Message.LParam= WM_RButtonDown then

begin

RightPop.Popup( Position.x, Position.y);
// exit;
end;

end;


procedure TMainFrm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin

UnInstallIcon;
end;


procedure TMainFrm.FormActivate(Sender: TObject);
begin

//hide MainFrm.
Height:= 0;
Width:= 0;
ShowWindow(Handle, SW_Hide);
end;


procedure TMainFrm.EjectClick(Sender: TObject);
begin

MciSendString('Set CdAudiodo
or open wait', nil, 0, handle);

end;


procedure TMainFrm.CloseCdClick(Sender: TObject);
begin

MciSendString('Set CdAudiodo
or closed wait', nil , 0, handle);
end;


procedure TMainFrm.ExitProClick(Sender: TObject);
begin

MainFrm.Close;

end;


procedure TMainFrm.EnabledOrNoClick(Sender: TObject);
begin

if UseOrNo then

begin

UnEnabledIcon(False);
Eject.Enabled:= False;
CloseCd.Enabled:= False;
EnabledOrNo.Caption:= 'Enabled Program';
end
else

begin

UnEnabledIcon(True);
Eject.Enabled:= True;
CloseCd.Enabled:= True;
EnabledOrNo.Caption:= 'UnEnalbed Program';
end;


end;


procedure TMainFrm.AboutClick(Sender: TObject);
begin

AboutFrm:= TAboutFrm.Create(Self);
AboutFrm.ShowModal;
end;


procedure TMainFrm.Cancel1Click(Sender: TObject);
begin

exit;
end;


procedure TMainFrm.FormShow(Sender: TObject);
begin

ShowWindow(handle, SW_Hide);
end;


end.

//*****************************************************
//about窗体,你可以不要
//*****************************************************
unit AboutUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TAboutFrm = class(TForm)
Bevel1: TBevel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormDblClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
AboutFrm: TAboutFrm;

implementation

{$R *.DFM}

procedure TAboutFrm.FormDblClick(Sender: TObject);
begin

close
end;


procedure TAboutFrm.FormShow(Sender: TObject);
begin

EnableMenuItem(GetSystemMenu(Handle, FALSE), SC_CLOSE, MF_BYCOMMAND or MF_GRAYED);
end;


end.

//注意图标我用资源文件封装起来了,你可以把{$R MyIcon.Res}注掉。
 
//其实你用到的就下面两句。
MciSendString('Set CdAudiodo
or open wait', nil, 0, handle);

MciSendString('Set CdAudiodo
or closed wait', nil , 0, handle);

 
这个支持多光驱吗?如果我有3个光驱我可以灵活的随意的控制其中的某一个弹出或关闭吗?
 
前面的人讲了一堆没有必要嘛。
事实上,以下方法可用于Delphi的任何一个版本,也可用于其他程序语言中。
弹出光盘 To open the CD-ROM:
mciSendString('Set cdaudiodo
or open wait', nil, 0, handle);
关闭光盘 To close the CD-ROM:

mciSendString('Set cdaudiodo
or closed wait', nil, 0, handle);
请注意在uses语句中增加MMSYSTEM单元。
 
以下程序已通过,可以随意关闭任意光驱

uses ...,mmSystem;

function CloseOpenCDRom(c:String;bOpen:Boolean):string;
const N=127;
var
err:array[0..N] of char;
s:string
begin

s:='open '+c+': type CDAudio alias finch';
mciSendString(pchar(s),err, N, 0);
if bOpen then
mciSendString('set finchdo
or open',err,N, 0)
else
mciSendString('set finchdo
or closed',err,N, 0);
Result:=err;
end;


function OpenCDRom(c:string):string;
begin

result:=CloseOpenCDRom(c,true);
end;


function CloseCDRom(c:string):string;
begin

result:=CloseOpenCDRom(c,false);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin

openCDROM('F');
end;


procedure TForm1.Button2Click(Sender: TObject);
begin

CloseCDROM('F');
end;


procedure TForm1.Button3Click(Sender: TObject);
begin

openCDROM('G');
end;


procedure TForm1.Button4Click(Sender: TObject);
begin

CloseCDROM('G');
end;

 
代码没错只不过少说了一句
在use里加入MMSystem
就是
use ...,mmsystem
 
靠!闹饥荒啦,这么多人抢分并且还有人攻击我。
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部