将Winamp集成到Delphi中作者：陈省
在这里要来实现一个能够在IDE中拖放停靠的窗体，并集成Winamp的功能。 翻开ToolsAPI.pas文件我们找不到任何关于如何实现IDE中停靠窗体的介绍，那么该怎么办？实际上通过一些非正式的方法是可以办到的，不过需要冒兼容性的风险，因为很可能Delphi会在下一版中提供完全不同的停靠机制。不过不管如何，实现支持停靠的IDE窗体是一个非常诱人的馅饼，接下来要讲到的技术是基于某些IDE的内部特性，由于Borland不公开支持这一特性，所以很可能在今后的版本中会有所变化，本文提到的技术可能只适用于Delphi 5。 为了能够得到一个能正确工作的停靠窗体，我们必须从IDE本身使用的停靠窗体继承。在Delphi或C++ Builder的早期版本中，这类停靠窗体是隐藏在Delphi32.exe (或BCB.exe)中或是CorIdexx.bpl包中。由于在这些版本中没有对应于BPL的DCP文件，我们很难同内部的这些窗体相关联。然而从Delphi/C++Builder 5开始，这些窗体被移到了一个新设计的IDE包中DsnIdexx.bpl。同时Borland也附带了对应的DCP文件。 OTA的项目负责人Allen Bauer公开了一个IDE实现停靠窗体的接口部分，包括停靠窗体和桌面保存恢复机制的接口和DFM文件，这些文件是Borland的原始的开发文件，我们只要通过包含向导的包文件应用DsnIdexx.dcp文件并进行编译就可以欺骗IDE使我们能够使用它的可视化窗体继承特性(VFIF)。 要注意的是由于没有使用干净的OTA接口，也就无法提供OTA接口的安全继承特性。但是可停靠窗体被激活后，窗体就可以正常使用OTA提供的接口功能了。 现在让我们来看看如何利用 Allen Bauer提供的接口单元来实现可停靠的窗体： 首先打开本书所附的DummyDockProj.dpr，接着创建我们的工作项目，在Project Group上点鼠标右键菜单，选择“Add New Project...”菜单，然后在弹出的对话框中选新建一个Package(包)。 接下来要创建一个可停靠窗体TDockableForm(在DummyDockProj项目中声明的）的子类，激活 DummyDockProj项目，选File|New... 菜单，弹出新建对话框，选DummyDockProj栏，在DockableForm项上双击，这会创建一个新的继承于TDockableForm的窗体单元，然后把它保存为 TestDock.pas 和TIDETestDockForm窗体。 下面激活开头添加到Project Group中的Package项目，选Project|Add to Project...菜单，浏览并选择刚才保存的子类对应的文件（这时在DummyDockProj项目中的TestDock文件已经没用了，可以删除掉），然后选中Package Manager，再选中Requires的树节点，点击Add...，浏览并选择DsnIDE50.dcp文件 （在..\Delphi 5 \Lib目录下)。这个操作告诉编译器真正的父类窗体的所在单元。
上面这些操作原理实际上是利用了IDE查找父类的顺序特性。当初始化一个子类窗体时，IDE首先查找当前激活的项目，如果没有找到就接着查找当前打开的全部项目，由于IDE本身就使用了TDockableForm窗体，所以它将找到内部的窗体，并正确编译。 现在准备工作已经差不多了，下面由于向导只是在设计时才使用，所以调出Options选项框，选中Design time only选项及输入包的描述文字并按确定按钮。还有为了在正确的时间初始化窗体，需要添加注册代码，把下面过程添加到窗体单元中，结果如图3.10所示。 procedure Register; implementation procedure Register; begin if IDETestDockForm = nil then IDETestDockForm := TIDETestDockForm.Create(Application); IDETestDockForm.Show; end; 注意Register单元是大小写敏感的，这是因为在Win32下，所有DLL输出的函数声明都是大小写敏感的。当Delphi加载一个设计包时，它先要在包中查找编译器产生的用来描述包内容的特殊资源。这个资源列出了包中单元的名字。然后IDE开始扫描单元名称和Register过程，如果找到了就使用GetProcAddress调用对应函数名称字符串，如果函数字符串不是大小写敏感的话，就要尝试256种组合！ 最后，需要注意当包被卸载的时候（比如Rebuild时，手工添加删除包，或是关闭Delphi时），需要确保窗体被销毁，添加下列代码到单元尾部： initialization finalization IDETestDockForm.Free; end. 正像在上面看到的，巧妙利用Delphi的包可以欺骗IDE，由没有源码只有接口的声明出发，继承IDE内部的一个窗体，是不是很疯狂啊？点击编译按钮 上面做了一个可停靠的窗体，那么如何做一个类似Project Manager或Package Manager样式的窗体，支持工具条及可切换按钮标签文本显示等呢？同样在DummyDockProj中有一个窗体类TdockableToolbarForm。我们只要从这个类继承子窗体就可以了，它能提供一个工具条，一个分割条以及调整工具条按钮和切换文本标签的显示与隐藏的功能。实际上这也是IDE中内置的另一个窗体。 另外还想说些相关的话，在著名的自由软件Gexperts（网址是www.gexperts.net）里提供了一个单元文件IdeDock.pas，这个文件为使用停靠窗体提供了一个后门，其中的函数@Ideintf@BorlandIDE指向一个包含当前IDE中窗体引用的字符串列表，Gexperts提供了一个演示程序，实现了和本文类似的停靠窗体，它使用的技术是直接读取IDE中类的虚拟方法表，它实现停靠窗体比这里讲的要简单一些，这里就不详细讨论，有兴趣的朋友可以去download看看。 最后建议多花点时间看看DummyDockProj项目的接口部分，还会发现很多好东西，比如桌面设置的保存与恢复，如何控制复制、粘贴、剪切菜单并接受这些操作的消息等等，由于这些是Borland没有正式公布的，在将来的版本中可能会改变，这里就不详细讨论了。 Winamp应用程序接口 既然我们已经能够实现一个支持停靠的窗体了，下面要做的就是向里面添加功能，要想了解如何同Winamp交互，最好的办法就是到www.winamp.com上去找了，下面这个联结http://www.winamp.com/nsdn/winamp2x/dev/sdk/api.jhtml对应的就是Winamp的应用程序接口说明。 Winamp同其他程序进行交互主要是通过以下几种方式： (1) 命令行方式。 (2) 利用Windows消息机制： ① 使用WM_COMMAND消息。 ② 使用WM_USER消息。 ③ 使用WM_COPYDATA消息。 (3) 其他方式。 由于本文中的Winamp专家只实现了Winamp的最基本的功能，而Winamp的应用程序接口内容非常丰富，无法全面涉及到，并且我们研究的目的主要是如何实现专家编程，所以以下只对专家中用到的Winamp的功能进行简单讲解，对其他内容感兴趣的朋友可以自行研究。 使用命令行的方式 通过以命令行代参数运行的方式，可以对Winamp进行有限的控制，比如： 命令：C:\path\to\winamp\winamp.exe /ADD C:\mp3\whatever.mp3 如果Winamp当前正在运行，就会把C:\mp3\whatever.mp3添加到播放列表中，如果Winamp还没有开始运行，那就会打开Winamp直接播放这首歌。 命令：C:\path\to\winamp\winamp.exe C:\mp3\file.mp3 直接播放C:\mp3\file.mp3。 命令：C:\path\to\winamp\winamp.exe /NEW "C:\my mp3s\" "C:\bigplaylist.pls" "C:\download\new song.mp3" 我们还可以让Winamp播放多个文件或直接指定歌曲目录来播放。 使用Windows的消息机制来控制Winamp 要想使用Windows的消息机制，毫无疑问必须获得Winamp对应的窗口句柄，有两种途径可以获得句柄，一种是针对外部应用程序的，一种是针对插件的，这里只讨论针对外部应用程序的方式。 外部应用程序可以通过FindWindow函数来获得Winamp的窗口句柄。函数如下： function GetWinampWnd:HWnd; begin //所有版本的Winamp的窗口类名都是“Winamp v1.x” Result:=FindWindow('Winamp v1.x',nil); end; 获得窗口句柄后，就可以用sendmessage函数发出特定的Windows消息来控制Winamp了。 Winamp支持wm_command、wm_user、wm_copydata三类消息，表3.1和表3.2是消息对应的Winamp的功能列表。 表3.1 WM_COMMAND消息列表
续表
表3.2 WM_USER消息列表（只对外部应用程序有意义）
续表
至于WM_COPYDATA消息，本专家中未使用到，并且应用较少，这里不详细解释了。 其他技巧 用GetWindowText函数可以获得Winamp的窗口标题，删除得到的字符串中的 “－Winamp”就能得到当前播放的歌曲曲名。 下面这个单元是我对Winamp的主要功能进行的Delphi封装,在专家中会用得到： unit WinampIPC; interface uses windows,messages,shellapi,registry,Sysutils; const ////////////WM_COMMAND///////////// Winamp_Prev=40044; Winamp_Next=40048; Winamp_Play=40045; Winamp_TogglePause=40046; Winamp_Stop=40047; Winamp_ToggleVisible=40258; Wiamp_RaiseVolume=40058; Winamp_LowerVolume=40059; Winamp_ToggleRepeat=40022; Winamp_ToggleShuffle=40023; Winamp_Close=40001; ///////////WM_USER///////////// Winamp_ClearPlayList=101; Winamp_Status=104; Winamp_SetVolume=122;//0-255 Winamp_SetTrackPos=106; Winamp_TrackInfo=105; Winamp_TrackInfo2=126; Winamp_GetTrackTitle=212; Winamp_GetCurTrackIdx=125; Winamp_GetTrackCount=124; //////其他常数//// Track_Error=-1; type TWinampStatus=(wsPlaying,wsPaused,wsStopped); //获得Winamp的窗口句柄 function GetWinampWnd:HWnd; //上一首歌 procedure PrevSong; //下一首歌 procedure NextSong; //播放歌曲 procedure PlaySong; //停止播放 procedure StopSong; //切换暂停 procedure TogglePause; //关闭Winamp procedure CloseWinamp; //获得回放状态（播放，暂停，停止） function PlayBackStatus:TWinampStatus; //设定音量 procedure SetVolume(VolumeValue:Byte); //设定音轨位置 procedure SetTrackPos(Position:Integer); //获得音轨位置 function GetTrackPos:Integer; //获得音轨长度 function GetTrackLength:Integer; //获得取样率 function GetSampleRate:Integer; //获得比特率 function Getbitrate:Integer; //获得声道数 function GetChannelNum:Integer; //获得当前音轨索引 function GetCurTrackIdx:Integer; //获得歌曲名 function GetCurTrackTitle:string; //获得歌曲数 function GetTrackCount:Integer; //清空播放列表 procedure ClearPlayList; //获得Winamp可执行文件的路径 function GetWinampLocation:string; //最小化Winamp procedure MinimizeWinamp; //切换循环播放 procedure ToggleRepeat; //切换乱序播放 procedure ToggleShuffle; implementation function GetWinampWnd:HWnd; begin Result:=FindWindow('Winamp v1.x',nil); end; procedure PrevSong; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_Prev,0); end; procedure NextSong; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_Next,0); end; procedure PlaySong; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_Play,0); end; procedure TogglePause; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_TogglePause,0); end; procedure StopSong; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_Stop,0); end; procedure CloseWinamp; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_Close,0); end; function PlayBackStatus:TWinampStatus; begin case SendMessage(GetWinampWnd,WM_USER,0,Winamp_Status) of 1:Result:=wsPlaying; 3:Result:=wsPaused; else Result:=wsStopped; end; end; procedure SetVolume(VolumeValue:Byte); begin SendMessage(GetWinampWnd,WM_USER,VolumeValue,Winamp_SetVolume); end; procedure SetTrackPos(Position:Integer); begin SendMessage(GetWinampWnd,WM_USER,Position,Winamp_SetTrackPos); end; function GetTrackPos:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,0,Winamp_TrackInfo); end; function GetTrackLength:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,1,Winamp_TrackInfo); end; function GetSampleRate:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,0,Winamp_TrackInfo2); end; function GetBitrate:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,1,Winamp_TrackInfo2); end; function GetChannelNum:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,2,Winamp_TrackInfo2); end; function GetCurTrackIdx:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,0,Winamp_GetCurTrackIdx); end; function GetCurTrackTitle:string; var Title:array [0..128] of Char; S:string; begin GetWindowText(GetWinampWnd,Title,128); s:=string(Title); result:=Copy(s,0,Pos('- Winamp',s)-1); end; function GetTrackCount:Integer; begin Result:=SendMessage(GetWinampWnd,WM_USER,0,Winamp_GetTrackCount); end; procedure ClearPlayList; begin SendMessage(GetWinampWnd,WM_USER,0,Winamp_ClearPlayList); end; function GetWinampLocation:string; var Reg:TRegistry; S:string; begin Result:=''; Reg:=TRegistry.Create; Reg.RootKey:=HKEY_CLASSES_ROOT; if Reg.OpenKey('\Directory\shell\Winamp.Play\command',False) then begin S:=Reg.ReadString(''); Result:=Copy(S,2,Pos('.exe',s)+2); end; Reg.CloseKey; Reg.Free; end; procedure MinimizeWinamp; begin SendMessage(GetWinampWnd,WM_SYSCOMMAND,SC_MINIMIZE,0); end; procedure ToggleRepeat; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_ToggleRepeat,0); end; procedure ToggleShuffle; begin SendMessage(GetWinampWnd,WM_COMMAND,Winamp_ToggleShuffle,0); end; end. 现在主要的两个问题已经解决了，接下来我们需要创建专家了。首先，如图3.11所示的那样，按照前面讲的方法生成一个停靠窗体的框架。 接下来，就是要设计专家的主要的工作界面了，如图3.12所示的那样。 向窗体上添加工具条、按钮、轨迹条等控件，界面分成三部分，最上面显示当前播放歌曲的各项信息，包括歌曲名称、时间长度、波特率、取样率、声道数等信息，中间的部
图3.11 分是控制播放进度和音量大小的两个TrackBar，最下面的那部分是控制播放的功能按钮。 写各项功能的控制代码，如图3.13所示，这里控制功能的代码主要是通过一个ActionList来进行管理的，使用ActionList来控制事件相对于直接使用控件本身来说，可以提供OnUpdate事件（ActionList控件实际上是利用了Application.OnIdle事件提供了这项功能），这使得验证某项功能在当前条件下是否有效提供了很便利的手段。
图3.12 图3.13 比如当winamp还没启动的时候，需要让播放按钮无效，只要把播放按钮同一个Action相关联，然后在Action的OnUpdate事件中写下如下代码就可以实现有效性验证： procedure TFrmamp.ActionPlayUpdate(Sender: TObject); begin inherited; //如果Winamp已经启动了，但播放文件列表或是空的，播放按钮就是无效的 if GetWinampWnd<>0 then (Sender as TAction).Enabled:=(FileOpenDlg.Files.Count>0) or (GetTrackCount>0); //如果Winamp还没启动，但播放列表有歌曲，播放按钮是有效的 if GetWinampWnd=0 then (Sender as TAction).Enabled:=FileOpenDlg.Files.Count>0; end;
控制代码由于主要使用的是前面封装的Winamp的功能，这里就不详细讨论了，具体内容见下面的代码清单。 编写完控制代码后，Winamp专家就算大功告成了，图3.14所示就是停靠在对象编辑器上的Winamp Expert，看起来好像还不错吧。 Winamp专家的全部源代码如下： unit cxamp; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DockForm, ActnList, ToolWin, ComCtrls, Menus, StdCtrls, ImgList, winampIPC, CXAbout, AppEvnts, mmsystem, mwota, midemenuitem, Toolsapi; type TFrmamp = class(TDockableForm) TbWinamp: TToolBar; PmSet: TPopupMenu; ZoomWindow1: TMenuItem; StayonTop1: TMenuItem; Dockable1: TMenuItem; BtnLast: TToolButton; BtnPlay: TToolButton; BtnPause: TToolButton; BtnStop: TToolButton; BtnNext: TToolButton; ToolButton1: TToolButton; BtnOpen: TToolButton; VolTrackBar: TTrackBar; LblSongInfo: TLabel; BtnShuffle: TToolButton; BtnRepeat: TToolButton; WinampAction: TActionList; ActionPlay: TAction; ActionPrev: TAction; ActionNext: TAction; ActionPause: TAction; ActionStop: TAction; ActionShuffle: TAction; ActionRepeat: TAction; ActionOpen: TAction; FileOpenDlg: TOpenDialog; BtnImages: TImageList; TrackPosBar: TTrackBar; ToolButton2: TToolButton; BtnAbout: TToolButton; ActionAbout: TAction; ToolButton3: TToolButton; N1: TMenuItem; Winamp1: TMenuItem; ActionGetInfo: TAction; WinampEvents: TApplicationEvents; procedure ActionAboutExecute(Sender: TObject); procedure ActionOpenExecute(Sender: TObject); procedure ActionPlayUpdate(Sender: TObject); procedure ActionStopUpdate(Sender: TObject); procedure ActionPauseUpdate(Sender: TObject); procedure ActionPrevUpdate(Sender: TObject); procedure ActionNextUpdate(Sender: TObject); procedure VolTrackBarChange(Sender: TObject); procedure ActionPlayExecute(Sender: TObject); procedure ActionPrevExecute(Sender: TObject); procedure ActionNextExecute(Sender: TObject); procedure ActionPauseExecute(Sender: TObject); procedure ActionStopExecute(Sender: TObject); procedure ActionRepeatExecute(Sender: TObject); procedure ActionPauseHint(var HintStr: String; var CanShow: Boolean); procedure ActionShuffleUpdate(Sender: TObject); procedure ActionRepeatUpdate(Sender: TObject); procedure ActionGetInfoExecute(Sender: TObject); procedure ActionShuffleExecute(Sender: TObject); procedure WinampEventsMessage(var Msg: tagMSG; var Handled: Boolean); procedure WinampEventsIdle(Sender: TObject; var Done: Boolean); procedure TrackPosBarChange(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } protected public { Public declarations } end; procedure Register; procedure ShowWinamp; var Frmamp: TFrmamp; SysSetPos:Boolean; implementation {$R *.DFM} procedure Register; begin if not Assigned(Frmamp) then Frmamp:=TFrmamp.Create(nil); Frmamp.Hide; end; procedure TFrmamp.ActionAboutExecute(Sender: TObject); begin inherited; ShowAboutBox; end; procedure TFrmamp.ActionOpenExecute(Sender: TObject); begin inherited; if FileOpenDlg.Execute then begin ClearPlayList; ActionPlayExecute(nil); end; end; procedure TFrmamp.ActionPlayUpdate(Sender: TObject); begin inherited; if GetWinampWnd<>0 then (Sender as TAction).Enabled:=(FileOpenDlg.Files.Count>0) or (GetTrackCount>0); if GetWinampWnd=0 then (Sender as TAction).Enabled:=FileOpenDlg.Files.Count>0; end; procedure TFrmamp.ActionStopUpdate(Sender: TObject); begin inherited; (Sender as TAction).Enabled:=PlayBackStatus<>wsStopped; end; procedure TFrmamp.ActionPauseUpdate(Sender: TObject); begin inherited; (Sender as TAction).Enabled:=PlayBackStatus<>wsStopped; end; procedure TFrmamp.ActionPrevUpdate(Sender: TObject); begin inherited; //循环控制的问题 (Sender as TAction).Enabled:=GetTrackCount>1; end; procedure TFrmamp.ActionNextUpdate(Sender: TObject); begin inherited; //要考虑循环控制的问题 (Sender as TAction).Enabled:=GetTrackCount>1; end; procedure TFrmamp.VolTrackBarChange(Sender: TObject); begin inherited; SetVolume(VolTrackBar.Position); end; procedure TFrmamp.ActionPlayExecute(Sender: TObject); var Cmd:string; I:integer; begin inherited; if GetWinampWnd=0 then begin if GetWinampLocation='' then begin ShowMessage('没找到winamp'); Exit; end; Cmd:=GetWinampLocation; for I:=0 to FileOpenDlg.Files.Count-1 do Cmd:=Cmd+' '+FileOpenDlg.Files.Strings[i]; winexec(PChar(cmd),SW_SHOWMINNOACTIVE); end else PlaySong; end; procedure TFrmamp.ActionPrevExecute(Sender: TObject); begin inherited; PrevSong; end; procedure TFrmamp.ActionNextExecute(Sender: TObject); begin inherited; NextSong; end; procedure TFrmamp.ActionPauseExecute(Sender: TObject); begin inherited; TogglePause; end; procedure TFrmamp.ActionStopExecute(Sender: TObject); begin inherited; StopSong; end; procedure TFrmamp.ActionRepeatExecute(Sender: TObject); begin inherited; ToggleRepeat; end; procedure TFrmamp.ActionPauseHint(var HintStr: String; var CanShow: Boolean); begin inherited; CanShow:=True; if PlayBackStatus=wsPaused then HintStr:='继续播放' else HintStr:='暂停播放'; end; procedure TFrmamp.ActionShuffleUpdate(Sender: TObject); begin inherited; (Sender as TAction).Enabled:=GetWinampWnd<>0; end; procedure TFrmamp.ActionRepeatUpdate(Sender: TObject); begin inherited; (Sender as TAction).Enabled:=GetWinampWnd<>0; end; procedure TFrmamp.ActionGetInfoExecute(Sender: TObject); begin inherited; end; procedure TFrmamp.ActionShuffleExecute(Sender: TObject); begin inherited; ToggleShuffle; end; procedure TFrmamp.WinampEventsMessage(var Msg: tagMSG; var Handled: Boolean); var APoint:TPoint; begin inherited; if (Msg.message= WM_RBUTTONUP) and (GetActiveWindow=Self.Handle) then begin GetCursorPos(APoint); PmSet.Popup(APoint.x,APoint.y); Handled:=True; end; end; procedure TFrmamp.WinampEventsIdle(Sender: TObject; var Done: Boolean); var s:string; begin inherited; if GetTrackCount>0 then begin //TrackLenght是以秒为单位 TrackPosBar.Max:=GetTrackLength*1000; TrackPosBar.Frequency:=20000; TrackPosBar.Min:=0; TrackPosBar.SliderVisible:=True; SysSetPos:=True; //pos是以毫秒为单位的 TrackPosBar.Position:=GetTrackPos; SysSetPos:=False; s:=GetCurTrackTitle; s:=s+'取样率：'+IntToStr(GetSampleRate)+'mHz '; s:=s+'比特率:'+IntToStr(Getbitrate)+'kbps'; LblSongInfo.Caption:=S; end else begin TrackPosBar.SliderVisible:=False; LblSongInfo.Caption:=''; end; end; procedure TFrmamp.TrackPosBarChange(Sender: TObject); begin inherited; if not SysSetPos then SetTrackPos(TrackPosBar.Position); end; procedure TFrmamp.FormCreate(Sender: TObject); begin inherited; end; procedure ShowWinamp; begin if Assigned(Frmamp) then Frmamp.Show; end; initialization finalization Frmamp.Free; end.
|
，然后把编译好的包安装到系统中去，如果Delphi没有因为代码错误而崩溃，我们会看到一个空白的窗体，试着到处拖动这个窗体，你会发现原来停靠窗体就是这么简单呀。
本站原创及翻译内容保留版权，欢迎转贴，转贴时请注明转自Delphi深度探索