檢查聲卡是否安裝 uses mmsystem; ... function Soundkarte:Boolean; begin Result := WaveOutGetNumDevs >0; end; 檢測聲卡存在 如果你是做一些多媒體播放器之類的程序時,為了完善系統的容錯性,就必須用到一些檢測系統的功能,其中檢測聲卡是否存在就是一個問題,下列程序幫你忙,首先需要在uses部分加入mmsystem ,接著在窗體創建時檢測聲卡: procedure TForm1.FormCreate(Sender: TObject); var i:Integer; begin i := auxGetNumDevs(); if i<= then label1.Caption :='系統沒有發現聲卡'; end; 控制聲音音量 當你做一個多媒體播放器時,難免少不了控制音量的大小和左右聲道的播放,下面就介紹一種控制Wave波形輸出設備音量的方法,該方法不是設置主音量。先在窗體上放兩個TTrackBar,分別命名為TrackBar1,TrackBar2,屬性Max都設置為65535,如果覺得刻度太密了,可以把Frequency屬性值設置大一些,然后在Uses段加入MMSystem,并在TrackBar1和TrackBar2的OnChange事件都寫上下列語句: procedure TForm1.TrackBar1Change(Sender: TObject); var Wave:string; begin Wave:='$'+inttohex(TrackBar1.Position 4)+inttohex(TrackBar2.Position 4); waveoutsetvolume(0 strtoint(Wave)); end; 獲得和控制音量 unit uMain; interface uses Windows Messages SysUtils Classes Controls Forms Dialogs ExtCtrls StdCtrls mmsystem; //You must add this in the uses line type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public myvolume: array[0..10] of longint; { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); var Count i: integer; begin Count := auxGetNumDevs; for i := 0 to Count do begin//The i is the device: I.E. 0=Wav Volume auxgetvolume(i addr(myvolume[i])); //Gets the values that the user has set auxsetvolume(i longint(9000)*65536+longint(9000)); //Sets the volume very very low end; //The reason for the 9000*65536 + 9000 is if you wanted to do left and right channels end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var Count i: integer; begin Count := auxGetNumDevs; for i := 0 to Count do begin auxsetvolume(i myvolume[i]); //Sets the volume back to the users old settings end; end;
|