起因：我家那台XX 唱壞掉，但 320G 硬碟還可用。
捨棄重買太可惜了。

加上 有剩下一台破電腦花了 1200 買了 黑色橫躺式機殼（很像）再加一個 IRCtrl 遙控按鍵 759。
客廳螢幕是液晶所以直接用 VGA 。

軟體部分打算自己寫。試用了很多免費這類軟體。不是很好用。有些必須要雙螢幕、插歌方式對我這種懶人很難 ....
不滿意空空就自己寫著玩吧。
資料庫暫時用 ACCESS 方便改。

感謝 japhenchen 的支援，不然會寫的很慘的

聽起來很棒 (超期待！)
不知道我家那台p3 450還能不能透過這個機會回生 XD

RootKit 大要用ACCESS當資料庫哦，沒有考慮使用Firebird embedeed來當後台嗎？

===================引 用 RootKit 文 章===================
起因：我家那台XX 唱壞掉，但 320G 硬碟還可用。
捨棄重買太可惜了。

加上 有剩下一台破電腦花了 1200 買了 黑色橫躺式機殼（很像）再加一個 IRCtrl 遙控按鍵 759。
客廳螢幕是液晶所以直接用 VGA 。

軟體部分打算自己寫。試用了很多免費這類軟體。不是很好用。有些必須要雙螢幕、插歌方式對我這種懶人很難 ....
不滿意空空就自己寫著玩吧。
資料庫暫時用 ACCESS 方便改。

感謝 japhenchen 的支援，不然會寫的很慘的

這種 diy 的精神真的配服 !  目前我都沒有耐心寫完一個完整的專案，不過研發比較有興趣。

期待你的作品~

------


蕭沖
--All ideas are worthless unless implemented--

C++ Builder Delphi Taiwan G+ 社群
http://bit.ly/cbtaiwan

噗噗~~~，看到這段話，似乎也是在說明我現實生活的寫照~~   Rootkit 大加油~!

===================引 用 aftcast 文 章===================
這種 diy 的精神真的配服 ! 目前我都沒有耐心寫完一個完整的專案，不過研發比較有興趣。

期待你的作品~

------
價值的展現，來自於你用哪一個角度來看待它!!

哈哈！我終於寫完了（上班偷寫了一下）。
在此感到使用 DSPACK 實在太便利了。畫面連閃都不會閃爍，顯示文字太好勒。
當然功能很陽春，只能透過歌簿點歌（輸入編號）。
有插播，聲道、音量儲存。查詢待播歌曲。

對於懶人的我算是夠用了。
正準備摩拳擦掌等不及禮拜六大唱一番，DIY好挖！

流程：
1. 卡拉OK壞掉了 只剩下 320G 硬碟。
2. 剛好有一台破電腦。但客廳擺一個破舊的電腦不是很好看。
因此敗了一個很像主機殼。這裡有一張圖
http://rp1.monday.vip.tw1.yahoo.net/res/gdsale/st_pic/1123/st-1123469-s200.jpg
3. 花了一點時間，把破電腦換新裝。
4. 買了一把老人專用遙控器。
圖片 http://www.ir-pc.com/images/product_ktv.jpg
5. 歷時三日終於寫完。

R大大可不可以教學一下, 一直很難理解電腦可以用遙控器去遙控?
是像無線mouse一樣, 有個接收器插在電腦的usb上, 另一個是萬用遙控器嗎?
若是的話, 輸入數字還能理解, 但音量, 一些有的沒的特殊功能是怎麼寫的咧 = =a


到google查查就知道了IR ctrl是什麼東西了 = =|||
原來和我想像中的差不多啊 ^ ^;

編輯記錄

畫面擷取：
查詢已點歌列表，顯示外框字。




功能如下：
DELETE 鍵：跳至下一首。
F4 ：儲存目前這首歌的音量大小及聲道。
F5 ：開始／暫停
F7 ：查詢待播歌曲列表。
F10：結束
ENTER ：輸入歌曲編號完畢。
INSERT：插播所輸入的歌曲編號
BACKSPACE：更改目前已輸入編號。
HOME ：重唱
PAGEUP：待播列表 上一頁
PAGEDN：待播列表 下一頁
＊ ：聲道切換 原版 伴唱左聲道 伴唱右聲道。
＋ － ：音量大小

唱的結果：
用"爽"來形容，點歌順暢太順暢了，順便對親友臭屁一下。DIY 好勒...

試論坊間其他免費卡拉OK程式優劣：
1. 大放頌（仿好樂迪介面），適合雙螢幕一個點歌用。單螢幕功能較缺不能插播。
2. K 歌情人，各方面都不錯。比較重大缺失，播下一首時有一點慢會卡歌而且會切回桌面再播。另外插播只能針對已點入歌曲，不能直接插播麻煩。
顯示目錄上一頁下一頁，會導致畫面停頓感到不舒服。另外是半免費軟體，結束程式會強制打開該作者網站。
3. HomeKaraok 介面俗，我就沒測了。
4 JK KTV 同上。....

程式碼：
因為趕著唱所以程式碼有亂寫的嫌疑。呵呵.....

[code delphi]
{

簡 單 Ｋ 歌

「轉載請註明來源」 --- 20008/11/26 RootKit


注意事項：

＃使用 DSPACK 當Designtime FilterGraphic Active 為True ，在 Delphi 結束專案時會觸發 ACC V.... Runtime216 災難。
＃安裝 DSPACK 若避免每次啟動Delphi均需重新安裝，出現找不到 Bpl？
解決方式可在 Windows 環境變數中的 Path 加入這個 Packages 路徑(D5)， D7 下在 Options中 。



OSD 畫面定義


ＤＩＳＰＬＡＹ１
DISPLAY3 DISPLAY2
---------------------
| 歌 |
| 曲 |
| 列 DISPLAY4 |
| 表 |
---------------------

}
unit MainVedio;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,StdCtrls,DirectShow9, DSPack,DSUtil,
EvMasterVolume, Db, ADODB, ExtCtrls;

Type
TPlayMode = (pmRandom,pmNormal,pmIntercut); {隨機 正常 插播 }
Const

DELAY_2 = 5000; { 顯示次要資訊如音量 停留時間 }
DELAY_3 = 10000; { 點播停留 }

PADDING_TOP = 10;
{ 主訊息 選歌，顯示歌曲名稱 }
DISPLAY1_FONTSIZE = 26;
DISPLAY1_FONTNAME = '超研澤粗楷';
{ 次要訊息 音量聲道}
DISPLAY2_FONTCOLOR = clYellow;
DISPLAY2_FONTSIZE = 18;
DISPLAY2_FONTNAME = '超研澤中黑';
{ 點播輸入欄 及 點播輸入欄 }
DISPLAY3_FONTCOLOR = clLime;
DISPLAY3_FONTSIZE = 20;
DISPLAY3_FONTNAME = '細明體';
{ 查詢 }
SONGLIST_FONTCOLOR = $000080FF;
SONGLIST_FONTSIZE = 22;
SONGLIST_LINESPACE = 4;
SONGLIST_FONTNAME = '細明體';

PLAYTITLES : array[TPlayMode] of String = ('隨機：','點播：','插播：');
PLAYFONTCOLORS : array[TPlayMode] of TColor = ($00FFB9B9,clWhite,$00FFFF84);

BIG5_NUMBER = '０１２３４５６７８９';

type
TPlaySong = Record
SSID : String;
Song : String;
SFile : String;
Mode : TPlayMode;
AudioVol : Integer;
AudioChannel : Integer;
end;
PPlaySong = ^TPlaySong;

TPanel = Class(ExtCtrls.TPanel)
Private
fDrawOutLine : Boolean;
fOnPaint : TNotifyEvent;
protected
procedure Paint; override;
PubLic
Property DrawOutLine : Boolean read fDrawOutLine write fDrawOutLine;
Property OnPaint : TNotifyEvent read fOnPaint write fOnPaint;
end;

TfMainVedio = class(TForm)
FilterGraph1: TFilterGraph;
Filter1: TFilter;
VideoWindow1: TDSVideoWindowEx2;
MasterVol: TEvMasterVolume;
TXT1: TPanel;
TXT3: TPanel;
TXT2: TPanel;
TXT4: TPanel;
TXT5: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FilterGraph1GraphComplete(sender: TObject; Result: HRESULT;Renderer: IBaseFilter);
procedure FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormActivate(Sender: TObject);
procedure VideoWindow1OverlayVisible(Sender: TObject;Visible: Boolean);
procedure VideoWindow1ColorKeyChanged(Sender: TObject);
private
MAduio : IMpegaudiodecoder;
MAduio_Enabled : Boolean;

ListVisibleRows :Integer; { 計算幾行 }
LineHeight :Integer;
FPageID :Integer;
{ 私有處理 }
FKeyinNo : String; { 目前輸入的歌曲編號 }
SongList : TStringList; { 待播歌曲 SSID Object = TPlaySong}

CurDualMode : LongWord; { 目前伴奏模式 }
CurPlaySong : TPlaySong; { 目前正在播放所點播歌曲 }

Procedure ShowDisply1(Const Text : String;Const FontColor : TColor = $00EFEFEF);
Procedure ShowDisply2(Const Text : String);
Procedure ShowDisply3(Const Text : String;Const ErrMsg:Boolean = False;Const DelayTime:Word=DELAY_3);

procedure TXT4Paint(Sender: TObject);
Procedure OnChange(Sender:TObject);
procedure PlayFile(PlaySong:TPlaySong);
procedure PlayNext;
procedure StopandPlayNext;
procedure Replay;
Procedure CleanbyTimerID(Const TimerID:Integer);
procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
Protected
procedure DestroyWnd;Override;
public
end;

Function InitProgram:Boolean;

var
fMainVedio: TfMainVedio;
ProPath : String = '';

implementation

uses Activex,mmSystem,DataModule,About,PhBasic,SDKConsts;

{$R *.DFM}

Type
TShutDownActType = (atPowerOff, atShutdown, atReboot, atLogOff,atSuspend,atHibernate);

function WinShutDown(ACT_Type:TShutDownActType;Const Force : Boolean = False):Boolean;
var
hToken, hProcess: THandle;
tp, prev_tp: TTokenPrivileges;
Len, Flags: DWORD;
begin
Result := False;
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID);
try
if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then Exit;
finally
CloseHandle(hProcess);
end;
try
if not LookupPrivilegeValue('', 'SeShutdownPrivilege',tp.Privileges[0].Luid) then Exit;
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp),
prev_tp, Len) then Exit;
finally
CloseHandle(hToken);
end;
end;
if Force then Flags := EWX_FORCE else Flags := 0;
case ACT_Type of
atPowerOff: Result := ExitWindowsEx(Flags or EWX_SHUTDOWN or EWX_POWEROFF, 0);
atShutdown: Result := ExitWindowsEx(Flags or EWX_SHUTDOWN, 0);
atReboot: Result := ExitWindowsEx(Flags or EWX_REBOOT, 0);
atLogoff: Result := ExitWindowsEx(Flags or EWX_LOGOFF, 0);
atSuspend: Result := SetSystemPowerState(True, Force);
atHibernate: Result := SetSystemPowerState(False, Force);
end;
end;

procedure FileAddLine(Const FileName,Text:String;Const RewriteFile:Boolean=False);
var
FS : TextFile;
Appd : Boolean;
begin
Appd := FileExists(FileName) and (RewriteFile=False);
AssignFile(FS,FileName);
try
Try
if Appd then Append(FS) else Rewrite(FS);
Writeln(fS,Text);
except
Exit;
end;
Flush(FS);
finally
CloseFile(FS);
end;
end;

Procedure AddError(Const Err:String);
begin
FileAddLine(ProPath 'Error.Log',DateTimetoStr(Now) ': ' ERR);
end;

Function InitProgram:Boolean;
begin
Result := False;
ShowAbout('進行初始化資料 ...');
Try
ShowAbout('開啟資料庫 ....');
if Not ConnecttoDB(DM1.ADO1,ProPath 'Songs.mdb') then Exit;
ShowAbout('讀取資料中 ....');
Q_open(DM1.Query1,'Select * from Songs Order by CreateDate DESC');
if DM1.Query1.IsEmpty then Exit;
DM1.Query1.Last;
DM1.Query1.First;
ShowAbout('完成，載入畫面。....');
Result :=True;
Finally
FreeAbout;
end;
end;

{ 畫外框字 }
Procedure DrawBorderText(Canvas:TCanvas;Const S:String;TextRect:TRect;FontColor:TColor;Flags:Integer);
Const
OutLineWidth = 1;
var
ARect,BRect : TRect;
I,J : Integer;
begin
Canvas.Font.Color := $00393939; {外框顏色}
Canvas.Brush.Style := bsClear;
BRect := TextRect;
OffsetRect(BRect,-OutLineWidth,-OutLineWidth);
For I := 0 to (OutLineWidth*2 ) do
For J := 0 to (OutLineWidth*2 ) do
begin
With BRect do ARect := Classes.Rect(Left I,Top J,Right I,Bottom J);
DrawText(Canvas.Handle, PChar(S), Length(S), ARect, Flags);
end;
BRect := TextRect;
Canvas.Font.Color := FontColor;
DrawText(Canvas.Handle, PChar(S), Length(S), BRect, Flags);
end;

procedure TPanel.Paint;
Const
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
ARect : TRect;
FontH : Integer;
begin
if fDrawOutLine and (Caption<>'') then
begin
ARect := GetClientRect;
With Canvas do
begin
Brush.Color := Color;
FillRect(ARect);
Brush.Style := bsClear;
Font := Self.Font;
FontH := TextHeight('W');
with ARect do
begin
Top := ((Bottom Top) - FontH) div 2;
Bottom := Top FontH;
end;
DrawBorderText(Canvas,Caption,ARect,Font.Color,Alignments[Alignment]);
end;
end else inherited;
if Assigned(fOnPaint) then fOnPaint(Self);
end;

procedure TfMainVedio.FormCreate(Sender: TObject);
Function SetPosition(AControl:TWinControl;ALeft,ATop,ARight,ABottom : Integer):Integer;
begin
AControl.SetBounds(ALeft,ATop,ARight - ALeft,ABottom - ATop);
Result := ABottom;
end;
var
I: Integer;
begin
ShowCursor(False);
SetBounds(0,0,Screen.Width,Screen.Height);
SongList := TStringList.Create;
{ 初始化 }
ListVisibleRows := 0;
LineHeight := 0;
FPageID := 0;
ProPath := Slash(ExtractFilePath(ParamStr(0)));
CurPlaySong.Song := '';
CurPlaySong.SFile := '';
CurPlaySong.Mode := pmNormal;
CurPlaySong.AudioVol := 0;
CurPlaySong.AudioChannel := 0;

For I := 0 to VideoWindow1.ControlCount - 1 do
if (VideoWindow1.Controls[I] is TPanel) and (VideoWindow1.Controls[I] <> TXT5) then
With TPanel(VideoWindow1.Controls[I]) do
begin
DrawOutLine := True;
Caption := '';
Color := VideoWindow1.ColorKey;
end;
TXT4.OnPaint := TXT4Paint;
{ 計算畫面 }
TXT5.SetBounds((VideoWindow1.Width - TXT5.Width) Div 2,
(VideoWindow1.Height - TXT5.Height) Div 2,TXT5.Width,TXT5.Height);

I := PADDING_TOP;
TXT1.Font.Name := DISPLAY1_FONTNAME;
TXT1.Font.Size := DISPLAY1_FONTSIZE;
TXT1.Canvas.Font := TXT1.Font;
I := SetPosition(TXT1,15,I,VideoWindow1.Width-15,I TXT1.Canvas.TextHeight('F') 4);
{ 音量或聲道最多七個字 }
TXT2.Font.Name := DISPLAY2_FONTNAME;
TXT2.Font.Size := DISPLAY2_FONTSIZE;
TXT2.Font.Color := DISPLAY2_FONTCOLOR;
TXT2.Canvas.Font := TXT2.Font;
With TXT2.Canvas.TextExtent(' 原版立體聲 ') do
SetPosition(TXT2,VideoWindow1.Width - cX - 10,I 6,VideoWindow1.Width,I cY 6);
{ 點播輸入欄 }
TXT3.Font.Name := DISPLAY3_FONTNAME;
TXT3.Font.Size := DISPLAY3_FONTSIZE;
TXT3.Font.Color := DISPLAY3_FONTCOLOR;
TXT3.Canvas.Font := TXT3.Font;
SetPosition(TXT3,15,I 6, TXT2.Left,I TXT3.Canvas.TextHeight('F') 6);
I := Max(TXT2.Top TXT2.Height,TXT3.Top TXT3.Height);
{ 待播顯示列 }
TXT4.Font.Name := SONGLIST_FONTNAME;
TXT4.Font.Size := SONGLIST_FONTSIZE;
TXT4.Font.Color := SONGLIST_FONTCOLOR;
TXT4.Canvas.Font := TXT4.Font;
LineHeight := TXT4.Canvas.TextHeight('F') SONGLIST_LINESPACE;
ListVisibleRows := (VideoWindow1.Height - I - 10 - 10) Div LineHeight;
TXT4.SetBounds(15,I 10,VideoWindow1.Width - 15,I 10 (ListVisibleRows * LineHeight ));
{..目錄功能 暫未寫 }

if Not FilterGraph1.Active then FilterGraph1.Active := True;
MAduio_Enabled := Succeeded(filter1.QueryInterface(IMpegAudioDecoder,MAduio));
if MAduio_Enabled then MAduio.get_DualMode(CurDualMode);

SongList.OnChange := OnChange;
end;

procedure TfMainVedio.FormActivate(Sender: TObject);
begin
Application.HandleMessage;
PlayNext;
end;

procedure TfMainVedio.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
begin
// 是否這是沒唱完的部分，下一次 繼續唱(還沒寫)
// if SongList.Count > 0
end;

procedure TfMainVedio.DestroyWnd;
begin
KillTimer(Handle,2); { DISPLAY2 音量及聲道 }
KillTimer(Handle,3); { DISPLAY3 }
KillTimer(Handle,5); { 系統訊息 }

inherited DestroyWnd;
end;

procedure TfMainVedio.FormDestroy(Sender: TObject);
var
I :Integer;
begin
DM1.ADO1.Connected := False;

For I := 0 to SongList.Count -1 do Dispose(PPlaySong(SongList.Objects[I]));
SongList.Clear;
SongList.Free;
FilterGraph1.ClearGraph;
FilterGraph1.Active := False;
ShowCursor(True);
end;

Procedure TfMainVedio.OnChange(Sender:TObject);
begin
if TXT4.Visible then
begin
TXT4.Invalidate;
end;
end;

procedure TfMainVedio.PlayFile(PlaySong:TPlaySong);
begin
With PlaySong do
if FileExists(SFile) then
begin
if Not FilterGraph1.Active then FilterGraph1.Active := True;
{ 開始播放 }
FilterGraph1.RenderFile(SFile);
{ 調整聲道 }
if MAduio_Enabled then
if AudioChannel > 0 then
begin
MAduio.put_DualMode(AudioChannel - 1 );
end else MAduio.put_DualMode(CurDualMode);

{ 調整音量 }
if AudioVol > 0 then
begin
MasterVol.SetMasterVolume(AudioVol,0);
end;
FilterGraph1.Play;
end else begin
AddError('找不到檔案！'#13 SFile);
ShowDisply1('找不到此歌曲檔！ ',clRed);
end;
end;

procedure TfMainVedio.PlayNext;
var
NextSong,S : String;
begin
{ 注意！只有隨機需要讀取資料庫 }
{ 取下一首歌 }
With DM1.Query1,CurPlaySong do
begin
Song := '';
SFile := '';
SSID := '';
Mode := pmNormal;
AudioVol := 0;
AudioChannel := 0;

Repeat
SSID := '';
NextSong := '';
if SongList.Count = 0 then
begin
{ 沒有歌曲隨機播放 }
Mode := pmRandom;
RecNo := Random(RecordCount) 1;

if Active and (Not EOF) then
begin
SSID := FieldByName('SSID').AsString;
Song := FieldByName('SongName').AsString;
SFile := FieldByName('MediaFile').AsString;
AudioVol := FieldByName('AudioChannel').AsInteger;
AudioChannel := FieldByName('AudioVol').AsInteger;
end;
end else begin
{ 待播放 }
CurPlaySong := PPlaySong(SongList.Objects[0])^;
SSID := SongList[0];
{ 刪除 }
Dispose(PPlaySong(SongList.Objects[0]));
SongList.Delete(0);
{ 得知下一首準備 }
if SongList.Count > 0 then
begin
NextSong := PPlaySong(SongList.Objects[0])^.Song;
end;
end;
until (Mode = pmRandom) or (CurPlaySong.SFile<>'');

{ 顯示 }
if Mode = pmRandom then S := '，請大家踴躍點歌！' else if NextSong<>'' then S := '，下一首 ' NextSong ' 請來賓準備..' else S := '，無待播歌曲趕快點歌吧！';

ShowDisply1(PLAYTITLES[Mode] Song S,PLAYFONTCOLORS[Mode]);
end;
PlayFile(CurPlaySong);
end;

procedure TfMainVedio.StopandPlayNext;
begin
FilterGraph1.ClearGraph;
FilterGraph1.Stop;
PlayNext;
end;

procedure TfMainVedio.Replay;
begin
FilterGraph1.ClearGraph;
FilterGraph1.Stop;
PlayFile(CurPlaySong);
end;

Procedure TfMainVedio.ShowDisply1(Const Text : String;Const FontColor:TColor = $00EFEFEF);
begin
TXT1.Font.Color := FontColor;
TXT1.Caption := Text;
end;

Procedure TfMainVedio.ShowDisply2(Const Text : String);
begin
KillTimer(Handle,2);
TXT2.Caption := Text;
if Text<>'' then SetTimer(Handle,2,DELAY_2,Nil);
end;

Procedure TfMainVedio.ShowDisply3(Const Text : String;Const ErrMsg:Boolean = False;Const DelayTime:Word=DELAY_3);
begin
KillTimer(Handle,3);

if ErrMsg then
begin
TXT3.Caption := Text;
FKeyinNo := '';
end else begin
TXT3.Caption := '歌曲編號：' ToBig5Currency(Text,BIG5_NUMBER);
FKeyinNo := Text;
end;
if TXT3.Caption <> '' then SetTimer(Handle,3,DelayTime,Nil);
end;

Procedure TfMainVedio.CleanbyTimerID(Const TimerID:Integer);
begin
Case TimerID of
2 :begin
KillTimer(Handle,2);
TXT2.Caption := '';
end;
3 :begin
KillTimer(Handle,3);
TXT3.Caption := '';
FKeyinNo := '';
end;
5 :begin
KillTimer(Handle,5);
TXT5.Tag := 0;
TXT5.Visible := False;
end;
end;
end;

procedure TfMainVedio.WMTimer(var Msg: TWMTimer);
begin
CleanbyTimerID(Msg.TimerID);
end;

procedure TfMainVedio.FilterGraph1GraphComplete(Sender: TObject;Result: HRESULT; Renderer: IBaseFilter);
begin
{ 播放完畢 }
StopandPlayNext;
end;

procedure TfMainVedio.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
Const
DualModeCaption : Array[0..2] of String = (' 原版立體聲 ','伴唱（左聲道）','伴唱（右聲道）');

Function AddtoSongList(DoInsert : Boolean;_SSID:String):Integer;
var
NewPlaySong : PPlaySong;
begin
Result := -1;
if DM1.Query1.Locate('SSID',_SSID,[]) then
begin
New(NewPlaySong);
With DM1.Query1,NewPlaySong^ do
begin
SSID := FieldbyName('SSID').AsString;
Song := FieldbyName('SongName').AsString;
SFile := FieldbyName('MediaFile').AsString;
AudioVol := FieldbyName('AudioVol').AsInteger;
AudioChannel := FieldbyName('AudioChannel').AsInteger;
if DoInsert then Mode := pmIntercut else Mode := pmNormal;
end;
if DoInsert then
begin
SongList.InsertObject(0,_SSID,TObject(NewPlaySong));
Result := 0;
end else Result := SongList.AddObject(_SSID,TObject(NewPlaySong));

if Result > -1 then
begin
{ 點播成功 }
With NewPlaySong^ do ShowDisply3('(' SSID ')' Song,True,3000);
if FileExists(ProPath 'ding.Wav') then MMsystem.PlaySound(Pchar(ProPath 'ding.Wav'),0,SND_FILENAME or SND_ASYNC);
end;
{ 即時異動不正確的顯示 }
if CurPlaySong.Mode <> pmRandom then
begin
if (SongList.Count = 1) or DoInsert then
begin
{ 原本沒有顯示下一首，顯示下一首 }
ShowDisply1(PLAYTITLES[CurPlaySong.Mode] CurPlaySong.Song
'，下一首 ' NewPlaySong^.Song ' 請來賓準備...',PLAYFONTCOLORS[CurPlaySong.Mode])
end;
end else begin
{ 目前若隨機播放，已點歌切歌 }
StopandPlayNext;
end;
end else ShowDisply3('無此歌曲編號！(' _SSID ')',True,4000);
end;
var
KeyChar : Char;
I,J : Integer;
begin
KeyChar := VirtualKeyToAscii(Key);
Try
{ 系統問 }
if TXT5.Visible and (TXT5.Tag = 1) then
begin
if KeyChar in ['1','3'] then
begin
{ 1 : 結束並關機 }
{ 3 : 僅結束程式 }
if KeyChar = '1' then WinShutDown(atPowerOff,True);
Application.Terminate;
Exit;
end else CleanbyTimerID(5);
Exit;
end;

Case Key of
VK_DELETE :StopandPlayNext;
VK_F4 :if (CurPlaySong.SSID<>'') and DM1.Query1.Locate('SSID',CurPlaySong.SSID,[]) then
begin
With DM1.Query1 do
begin
Edit;
FieldbyName('AudioVol').AsInteger := CurPlaySong.AudioVol;
FieldbyName('AudioChannel').AsInteger := CurPlaySong.AudioChannel;
UpdateBatch;
ShowDisply2('儲存聲道設定');
end;
end;
VK_F5 :begin
{ 暫停 }
if TXT5.Visible then
begin
TXT5.Visible := False;
TXT5.Tag := 0;
FilterGraph1.Play;
end else begin
FilterGraph1.Pause;
TXT5.Caption := '＜暫停播放＞';
TXT5.Tag := 0;
TXT5.Visible := True;
end;
end;
VK_F7 :begin
{ 顯示待播歌曲 }
TXT4.Visible := Not TXT4.Visible;
FPageID := 0;
end;
VK_F10 :begin
KillTimer(Handle,5);
TXT5.Tag := 1;
TXT5.Caption := '關閉程式？(1:是/0:否)';
TXT5.Visible := True;
SetTimer(Handle,5,5000,Nil);
end;
VK_RETURN :if FKeyinNo <> '' then
begin
{點播歌曲 }
AddtoSongList(False,FKeyinNo);
end else ShowDisply3(''); {待命 }
VK_INSERT :if FKeyinNo <> '' then
begin
{插播歌曲 }
AddtoSongList(True,FKeyinNo);
end else ShowDisply3(''); {待命 }
VK_BACK :begin
{ 輸入歌曲，退字鍵 }
if FKeyinNo <> '' then System.Delete(FKeyinNo,Length(FKeyinNo),1);
ShowDisply3(FKeyinNo);
end;
VK_HOME :begin
{ 重唱 }
Replay;
end;
VK_PRIOR :begin
{ 上一頁 }
if FPageID >0 then
begin
FPageID := FPageID - 1;
TXT4.Invalidate;
end;
end;
VK_NEXT :begin
{ 下一頁 }
if FPageID < (SongList.Count Div ListVisibleRows) then
begin
FPageID := FPageID 1;
TXT4.Invalidate;
end;
end;
else Case KeyChar of
'*' :if MAduio_Enabled then
begin
{ 聲道切換 }
MAduio.get_DualMode(CurDualMode);
Inc(CurDualMode);
if CurDualMode > 2 then CurDualMode := 0;
{ 0=聲道全開 1=只開第一聲道(通常為左) 2=只開第二聲道
大部份的台灣KTV VCD碟都是把男聲、合唱定在左聲，女生定在右聲 }
MAduio.put_DualMode(CurDualMode);
ShowDisply2(DualModeCaption[CurDualMode]);
end else ShowDisply2('沒有作用');
' ','-' :
begin
{ 音量 }
MasterVol.GetMasterVolume (I,J);
J := I Div 656;
if KeyChar = '-' then Dec(J) else Inc(J);
I := Min(Max(J * 656,0),65535);

MasterVol.SetMasterVolume (I,0);
ShowDisply2('音量 ' GetRSPC(I2S(J),3));
end;
'0'..'9' :ShowDisply3(FKeyinNo KeyChar);
end;
end;
Finally

end;
end;

procedure TfMainVedio.VideoWindow1OverlayVisible(Sender: TObject;Visible: Boolean);
var
I : Integer;
TransColor :TColor;
begin
if Visible then TransColor := VideoWindow1.ColorKey else TransColor := VideoWindow1.Color;

For I := 0 to VideoWindow1.ControlCount - 1 do
if (VideoWindow1.Controls[I] is TPanel) and (VideoWindow1.Controls[I] <> TXT5)
then TPanel(VideoWindow1.Controls[I]).Color := TransColor;
end;

procedure TfMainVedio.VideoWindow1ColorKeyChanged(Sender: TObject);
begin
VideoWindow1OverlayVisible(Nil,VideoWindow1.OverlayVisible);
end;

procedure TfMainVedio.TXT4Paint(Sender: TObject);
var
I,J :Integer;
ARect :TRect;
begin
if SongList.Count = 0 then
begin
FPageID := 0;
DrawBorderText(TXT4.Canvas,'無待播歌曲！',Rect(0,0,TXT4.Width,LineHeight),SONGLIST_FONTCOLOR,DT_LEFT);
Exit;
end;
I := FPageID * ListVisibleRows;
J := 0;
if I > SongList.Count then
begin
FPageID := (SongList.Count Div ListVisibleRows);
I := FPageID * ListVisibleRows;
end;

While (J < ListVisibleRows) and (I begin
With PPlaySong(SongList.Objects[I])^ do
begin
ARect := Rect(0,J * LineHeight,TXT4.Width,0);
ARect.Bottom := ARect.Top LineHeight;
DrawBorderText(TXT4.Canvas,i2S(I 1) ' (' SSID ')' Song,ARect,SONGLIST_FONTCOLOR,DT_LEFT);
end;
Inc(I);
Inc(J);
end;
end;

end.

[/code]

補充心得：
1. 顯示字幕不要直接畫在 TDSVideoWindowEx2 or TVideoWindow 的Canvas上或使用非 TwinControl 類的物件像是 TLabel
在下一曲播放時或偶而畫面閃一下會導致字幕直接消失。必使用 TwinControl 類物件。如：TPanel
2.調整音量並未透過 FilterGraph1 調整音量，原因認為音量間隔不夠大，況且每次播放都需設定一次。我是透過自己寫的調整主音量大小

編輯記錄

排了好幾次，還是亂掉。

前輩改用插入附件的方式如何 ^_^

電腦ktv我已用了一段時間了
您說的那幾套我都用過
不知道您寫的
介面俗
是什麼樣的意思
是畫面醜嗎??

===================引 用 RootKit 文 章===================
畫面擷取：
查詢已點歌列表，顯示外框字。




試論坊間其他免費卡拉OK程式優劣：
1. 大放頌（仿好樂迪介面），適合雙螢幕一個點歌用。單螢幕功能較缺不能插播。
2. K 歌情人，各方面都不錯。比較重大缺失，播下一首時有一點慢會卡歌而且會切回桌面再播。另外插播只能針對已點入歌曲，不能直接插播麻煩。
顯示目錄上一頁下一頁，會導致畫面停頓感到不舒服。另外是半免費軟體，結束程式會強制打開該作者網站。
3. HomeKaraok 介面俗，我就沒測了。
4 JK KTV 同上。....

很對不起 我用站內 程式碼區塊: Delphi 會有編排問題
重新寫入(尚未寫完)時就發生(按鍵錯誤)
傳送 發表出去了

編輯記錄

使用 DELPHI 6
使用 DSPACK
小弟我不材
試將 RootKit 大大 此 簡 單 Ｋ 歌程式 全部縮排了
但是無法使用
//有問題的程式片斷
ShowAbout('進行初始化資料 ...'); //出現行數 : 229
Not ConnecttoDB(DM1.ADO1, ProPath 'Songs.mdb') //出現行數 : 232
Q_open(DM1.Query1, 'Select * from Songs Order by CreateDate DESC'); //出現行數 : 235
FreeAbout; //出現行數 : 243
ProPath := Slash(ExtractFilePath(ParamStr(0))); //出現行數 : 318
Color := VideoWindow1.ColorKey; //出現行數 : 331
ToBig5Currency(Text, BIG5_NUMBER); //出現行數 : 553
GetRSPC(I2S(J), 3)) //出現行數 : 798
While (J < ListVisibleRows) and (I //出現行數 : 848
i2S(I 1) //出現行數 : 854

RecNo := Random(RecordCount) 1; <- 將全部出錯擋掉後程釋出錯地方
//有問題的元件 或是 缺少 pas 檔案和 dfm 檔案
uses
DirectShow9, DSPack, DSUtil, EvMasterVolume,
uses
About, DataModule, PhBasic, SDKConsts;

{
簡 單 Ｋ 歌
「轉載請註明來源」 --- 20008/11/26 RootKit

注意事項：
＃使用 DSPACK 當Designtime FilterGraphic Active 為True ，在 Delphi 結束專案時會觸發 ACC V.... Runtime216 災難。
＃安裝 DSPACK 若避免每次啟動Delphi均需重新安裝，出現找不到 Bpl？
解決方式可在 Windows 環境變數中的 Path 加入這個 Packages 路徑(D5)， D7 下在 Options中 。

OSD 畫面定義

ＤＩＳＰＬＡＹ１
DISPLAY3 DISPLAY2
---------------------
| 歌 |
| 曲 |
| 列 DISPLAY4 |
| 表 |
---------------------
}
unit MainVedio;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
DirectShow9, DSPack, DSUtil, EvMasterVolume, Db, ADODB, ExtCtrls, Math;
Type
TPlayMode = (pmRandom, pmNormal, pmIntercut); {隨機 正常 插播 }
Const
DELAY_2 = 5000; { 顯示次要資訊如音量 停留時間 }
DELAY_3 = 10000; { 點播停留 }
PADDING_TOP = 10;
{ 主訊息 選歌，顯示歌曲名稱 }
DISPLAY1_FONTSIZE = 26;
DISPLAY1_FONTNAME = '標楷體';//'超研澤粗楷';
{ 次要訊息 音量聲道}
DISPLAY2_FONTCOLOR = clYellow;
DISPLAY2_FONTSIZE = 18;
DISPLAY2_FONTNAME = '標楷體';//'超研澤中黑';
{ 點播輸入欄 及 點播輸入欄 }
DISPLAY3_FONTCOLOR = clLime;
DISPLAY3_FONTSIZE = 20;
DISPLAY3_FONTNAME = '細明體';
{ 查詢 }
SONGLIST_FONTCOLOR = $000080FF;
SONGLIST_FONTSIZE = 22;
SONGLIST_LINESPACE = 4;
SONGLIST_FONTNAME = '細明體';
PLAYTITLES : array[TPlayMode] of String = ('隨機：', '點播：', '插播：');
PLAYFONTCOLORS : array[TPlayMode] of TColor = ($00FFB9B9, clWhite, $00FFFF84);
BIG5_NUMBER = '０１２３４５６７８９';

type
TPlaySong = Record
SSID : String;
Song : String;
SFile : String;
Mode : TPlayMode;
AudioVol : Integer;
AudioChannel : Integer;
end;
PPlaySong = ^TPlaySong;
TPanel = Class(ExtCtrls.TPanel)
Private
fDrawOutLine : Boolean;
fOnPaint : TNotifyEvent;
protected
procedure Paint; override;
PubLic
Property DrawOutLine : Boolean read fDrawOutLine write fDrawOutLine;
Property OnPaint : TNotifyEvent read fOnPaint write fOnPaint;
end;
TfMainVedio = class(TForm)
MasterVol: TEvMasterVolume;
FilterGraph1: TFilterGraph;
Filter1: TFilter;
DSVideoWindowEx21: TDSVideoWindowEx2;
TXT1: TPanel;
TXT2: TPanel;
TXT3: TPanel;
TXT4: TPanel;
TXT5: TPanel;
VideoWindow1: TVideoWindow;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FilterGraph1GraphComplete(sender: TObject; Result: HRESULT;Renderer: IBaseFilter);
procedure FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormActivate(Sender: TObject);
procedure VideoWindow1OverlayVisible(Sender: TObject;Visible: Boolean);
procedure VideoWindow1ColorKeyChanged(Sender: TObject);
private
MAduio : IMpegaudiodecoder;
MAduio_Enabled : Boolean;
ListVisibleRows :Integer; { 計算幾行 }
LineHeight :Integer;
FPageID :Integer;
{ 私有處理 }
FKeyinNo : String; { 目前輸入的歌曲編號 }
SongList : TStringList; { 待播歌曲 SSID Object = TPlaySong}
CurDualMode : LongWord; { 目前伴奏模式 }
CurPlaySong : TPlaySong; { 目前正在播放所點播歌曲 }
Procedure ShowDisply1(Const Text : String;Const FontColor : TColor = $00EFEFEF);
Procedure ShowDisply2(Const Text : String);
Procedure ShowDisply3(Const Text : String;Const ErrMsg:Boolean = False;Const DelayTime:Word=DELAY_3);
procedure TXT4Paint(Sender: TObject);
Procedure OnChange(Sender:TObject);
procedure PlayFile(PlaySong:TPlaySong);
procedure PlayNext;
procedure StopandPlayNext;
procedure Replay;
Procedure CleanbyTimerID(Const TimerID:Integer);
procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
Protected
procedure DestroyWnd;Override;
public
end;
Function InitProgram : Boolean;
var
fMainVedio : TfMainVedio;
ProPath : String = '';
AppliCationPath : String;
implementation
uses
Activex, mmSystem, DMU, About, DataModule, PhBasic, SDKConsts;
{$R *.DFM}
Type
TShutDownActType = (atPowerOff, atShutdown, atReboot, atLogOff,atSuspend,atHibernate);
function WinShutDown(ACT_Type:TShutDownActType;Const Force : Boolean = False):Boolean;
var
hToken, hProcess : THandle;
tp, prev_tp : TTokenPrivileges;
Len, Flags : DWORD;
begin
Result := False;
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID);
try
if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then
Exit;
finally
CloseHandle(hProcess);
end;
try
if not LookupPrivilegeValue('', 'SeShutdownPrivilege', tp.Privileges[0].Luid) then
Exit;
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp),
prev_tp, Len) then
Exit;
finally
CloseHandle(hToken);
end;
end;
if Force then
Flags := EWX_FORCE
else
Flags := 0;
case ACT_Type of
atPowerOff : Result := ExitWindowsEx(Flags or EWX_SHUTDOWN or EWX_POWEROFF, 0);
atShutdown : Result := ExitWindowsEx(Flags or EWX_SHUTDOWN, 0);
atReboot : Result := ExitWindowsEx(Flags or EWX_REBOOT, 0);
atLogoff : Result := ExitWindowsEx(Flags or EWX_LOGOFF, 0);
atSuspend : Result := SetSystemPowerState(True, Force);
atHibernate : Result := SetSystemPowerState(False, Force);
end;
end;
procedure FileAddLine(Const FileName,Text:String;Const RewriteFile:Boolean=False);
var
FS : TextFile;
Appd : Boolean;
begin
Appd := FileExists(FileName) and (RewriteFile = False);
AssignFile(FS, FileName);
try
Try
if Appd then
Append(FS)
else
Rewrite(FS);
Writeln(fS,Text);
except
Exit;
end;
Flush(FS);
finally
CloseFile(FS);
end;
end;
Procedure AddError(Const Err:String);
begin
FileAddLine(ProPath 'Error.Log', DateTimetoStr(Now) ': ' ERR);
end;
Function InitProgram : Boolean;
begin
Result := False;
ShowAbout('進行初始化資料 ...');
Try
ShowAbout('開啟資料庫 ....');
if Not ConnecttoDB(DM1.ADO1, ProPath 'Songs.mdb') then
Exit;
ShowAbout('讀取資料中 ....');
Q_open(DM1.Query1, 'Select * from Songs Order by CreateDate DESC');
if DM1.Query1.IsEmpty then
Exit;
DM1.Query1.Last;
DM1.Query1.First;
ShowAbout('完成，載入畫面。....');
Result := True;
Finally
FreeAbout;
end;
end;
{ 畫外框字 }
Procedure DrawBorderText(Canvas : TCanvas; Const S : String; TextRect : TRect; FontColor : TColor; Flags : Integer);
Const
OutLineWidth = 1;
var
ARect, BRect : TRect;
I, J : Integer;
begin
Canvas.Font.Color := $00393939; {外框顏色}
Canvas.Brush.Style := bsClear;
BRect := TextRect;
OffsetRect(BRect, -OutLineWidth, -OutLineWidth);
For I := 0 to (OutLineWidth * 2 ) do
For J := 0 to (OutLineWidth * 2 ) do
begin
With BRect do
ARect := Classes.Rect(Left I, Top J, Right I, Bottom J);
DrawText(Canvas.Handle, PChar(S), Length(S), ARect, Flags);
end;
BRect := TextRect;
Canvas.Font.Color := FontColor;
DrawText(Canvas.Handle, PChar(S), Length(S), BRect, Flags);
end;
procedure TPanel.Paint;
Const
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
ARect : TRect;
FontH : Integer;
begin
if fDrawOutLine and (Caption <> '') then
begin
ARect := GetClientRect;
With Canvas do
begin
Brush.Color := Color;
FillRect(ARect);
Brush.Style := bsClear;
Font := Self.Font;
FontH := TextHeight('W');
with ARect do
begin
Top := ((Bottom Top) - FontH) div 2;
Bottom := Top FontH;
end;
DrawBorderText(Canvas,Caption,ARect,Font.Color,Alignments[Alignment]);
end;
end
else
inherited;
if Assigned(fOnPaint) then fOnPaint(Self);
end;
procedure TfMainVedio.FormCreate(Sender: TObject);
Function SetPosition(AControl:TWinControl;ALeft,ATop,ARight,ABottom : Integer):Integer;
begin
AControl.SetBounds(ALeft,ATop,ARight - ALeft,ABottom - ATop);
Result := ABottom;
end;
var
I : Integer;
begin
ShowCursor(False);
SetBounds(0, 0, Screen.Width, Screen.Height);
SongList := TStringList.Create;
{ 初始化 }
ListVisibleRows := 0;
LineHeight := 0;
FPageID := 0;
ProPath := Slash(ExtractFilePath(ParamStr(0)));
CurPlaySong.Song := '';
CurPlaySong.SFile := '';
CurPlaySong.Mode := pmNormal;
CurPlaySong.AudioVol := 0;
CurPlaySong.AudioChannel := 0;
For I := 0 to VideoWindow1.ControlCount - 1 do
if (VideoWindow1.Controls[I] is TPanel) and (VideoWindow1.Controls[I] <> TXT5) then
With TPanel(VideoWindow1.Controls[I]) do
begin
DrawOutLine := True;
Caption := '';
Color := VideoWindow1.ColorKey;
end;
TXT4.OnPaint := TXT4Paint;
{ 計算畫面 }
TXT5.SetBounds((VideoWindow1.Width - TXT5.Width) Div 2, (VideoWindow1.Height - TXT5.Height) Div 2, TXT5.Width, TXT5.Height);
I := PADDING_TOP;
TXT1.Font.Name := DISPLAY1_FONTNAME;
TXT1.Font.Size := DISPLAY1_FONTSIZE;
TXT1.Canvas.Font := TXT1.Font;
I := SetPosition(TXT1, 15, I, VideoWindow1.Width - 15, I TXT1.Canvas.TextHeight('F') 4);
{ 音量或聲道最多七個字 }
TXT2.Font.Name := DISPLAY2_FONTNAME;
TXT2.Font.Size := DISPLAY2_FONTSIZE;
TXT2.Font.Color := DISPLAY2_FONTCOLOR;
TXT2.Canvas.Font := TXT2.Font;
With TXT2.Canvas.TextExtent(' 原版立體聲 ') do
SetPosition(TXT2, VideoWindow1.Width - cX - 10, I 6, VideoWindow1.Width, I cY 6);
{ 點播輸入欄 }
TXT3.Font.Name := DISPLAY3_FONTNAME;
TXT3.Font.Size := DISPLAY3_FONTSIZE;
TXT3.Font.Color := DISPLAY3_FONTCOLOR;
TXT3.Canvas.Font := TXT3.Font;
SetPosition(TXT3, 15, I 6, TXT2.Left, I TXT3.Canvas.TextHeight('F') 6);
I := Max(TXT2.Top TXT2.Height, TXT3.Top TXT3.Height);
{ 待播顯示列 }
TXT4.Font.Name := SONGLIST_FONTNAME;
TXT4.Font.Size := SONGLIST_FONTSIZE;
TXT4.Font.Color := SONGLIST_FONTCOLOR;
TXT4.Canvas.Font := TXT4.Font;
LineHeight := TXT4.Canvas.TextHeight('F') SONGLIST_LINESPACE;
ListVisibleRows := (VideoWindow1.Height - I - 10 - 10) Div LineHeight;
TXT4.SetBounds(15, I 10, VideoWindow1.Width - 15, I 10 (ListVisibleRows * LineHeight));
{..目錄功能 暫未寫 }
if Not FilterGraph1.Active then
FilterGraph1.Active := True;
MAduio_Enabled := Succeeded(filter1.QueryInterface(IMpegAudioDecoder,MAduio));
if MAduio_Enabled then
MAduio.get_DualMode(CurDualMode);
SongList.OnChange := OnChange;
end;
procedure TfMainVedio.FormActivate(Sender: TObject);
begin
Application.HandleMessage;
PlayNext;
end;
procedure TfMainVedio.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
begin
// 是否這是沒唱完的部分，下一次 繼續唱(還沒寫)
// if SongList.Count > 0
end;
procedure TfMainVedio.DestroyWnd;
begin
KillTimer(Handle, 2); { DISPLAY2 音量及聲道 }
KillTimer(Handle, 3); { DISPLAY3 }
KillTimer(Handle, 5); { 系統訊息 }
inherited DestroyWnd;
end;
procedure TfMainVedio.FormDestroy(Sender: TObject);
var
I : Integer;
begin
DM1.ADO1.Connected := False;
For I := 0 to SongList.Count -1 do
Dispose(PPlaySong(SongList.Objects[I]));
SongList.Clear;
SongList.Free;
FilterGraph1.ClearGraph;
FilterGraph1.Active := False;
ShowCursor(True);
end;
Procedure TfMainVedio.OnChange(Sender:TObject);
begin
if TXT4.Visible then
begin
TXT4.Invalidate;
end;
end;
procedure TfMainVedio.PlayFile(PlaySong:TPlaySong);
begin
With PlaySong do
if FileExists(SFile) then
begin
if Not FilterGraph1.Active then
FilterGraph1.Active := True;
{ 開始播放 }
FilterGraph1.RenderFile(SFile);
{ 調整聲道 }
if MAduio_Enabled then
if AudioChannel > 0 then
begin
MAduio.put_DualMode(AudioChannel - 1 );
end
else
MAduio.put_DualMode(CurDualMode);
{ 調整音量 }
if AudioVol > 0 then
begin
MasterVol.SetMasterVolume(AudioVol, 0);
end;
FilterGraph1.Play;
end
else
begin
AddError('找不到檔案！ ' #13 SFile);
ShowDisply1('找不到此歌曲檔！ ', clRed);
end;
end;
procedure TfMainVedio.PlayNext;
var
NextSong, S : String;
begin
{ 注意！只有隨機需要讀取資料庫 }
{ 取下一首歌 }
With DM1.Query1, CurPlaySong do
begin
Song := '';
SFile := '';
SSID := '';
Mode := pmNormal;
AudioVol := 0;
AudioChannel := 0;
Repeat
SSID := '';
NextSong := '';
if SongList.Count = 0 then
begin
{ 沒有歌曲隨機播放 }
Mode := pmRandom;
RecNo := Random(RecordCount) 1;
if Active and (Not EOF) then
begin
SSID := FieldByName('SSID').AsString;
Song := FieldByName('SongName').AsString;
SFile := FieldByName('MediaFile').AsString;
AudioVol := FieldByName('AudioChannel').AsInteger;
AudioChannel := FieldByName('AudioVol').AsInteger;
end;
end
else
begin
{ 待播放 }
CurPlaySong := PPlaySong(SongList.Objects[0])^;
SSID := SongList[0];
{ 刪除 }
Dispose(PPlaySong(SongList.Objects[0]));
SongList.Delete(0);
{ 得知下一首準備 }
if SongList.Count > 0 then
begin
NextSong := PPlaySong(SongList.Objects[0])^.Song;
end;
end;
until (Mode = pmRandom) or (CurPlaySong.SFile <> '');
{ 顯示 }
if Mode = pmRandom then
S := '，請大家踴躍點歌！'
else
if NextSong<>'' then
S := '，下一首 ' NextSong ' 請來賓準備..'
else
S := '，無待播歌曲趕快點歌吧！';
ShowDisply1(PLAYTITLES[Mode] Song S, PLAYFONTCOLORS[Mode]);
end;
PlayFile(CurPlaySong);
end;
procedure TfMainVedio.StopandPlayNext;
begin
FilterGraph1.ClearGraph;
FilterGraph1.Stop;
PlayNext;
end;
procedure TfMainVedio.Replay;
begin
FilterGraph1.ClearGraph;
FilterGraph1.Stop;
PlayFile(CurPlaySong);
end;
Procedure TfMainVedio.ShowDisply1(Const Text : String;Const FontColor:TColor = $00EFEFEF);
begin
TXT1.Font.Color := FontColor;
TXT1.Caption := Text;
end;
Procedure TfMainVedio.ShowDisply2(Const Text : String);
begin
KillTimer(Handle, 2);
TXT2.Caption := Text;
if Text <> '' then
SetTimer(Handle, 2, DELAY_2, Nil);
end;
Procedure TfMainVedio.ShowDisply3(Const Text : String;Const ErrMsg:Boolean = False;Const DelayTime:Word=DELAY_3);
begin
KillTimer(Handle,3);
if ErrMsg then
begin
TXT3.Caption := Text;
FKeyinNo := '';
end
else
begin
TXT3.Caption := '歌曲編號：' ToBig5Currency(Text, BIG5_NUMBER);
FKeyinNo := Text;
end;
if TXT3.Caption <> '' then
SetTimer(Handle, 3, DelayTime, Nil);
end;
Procedure TfMainVedio.CleanbyTimerID(Const TimerID:Integer);
begin
Case TimerID of
2 :
begin
KillTimer(Handle, 2);
TXT2.Caption := '';
end;
3 :
begin
KillTimer(Handle, 3);
TXT3.Caption := '';
FKeyinNo := '';
end;
5 :
begin
KillTimer(Handle, 5);
TXT5.Tag := 0;
TXT5.Visible := False;
end;
end;
end;
procedure TfMainVedio.WMTimer(var Msg: TWMTimer);
begin
CleanbyTimerID(Msg.TimerID);
end;
procedure TfMainVedio.FilterGraph1GraphComplete(Sender: TObject;Result: HRESULT; Renderer: IBaseFilter);
begin
{ 播放完畢 }
StopandPlayNext;
end;
procedure TfMainVedio.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
Const
DualModeCaption : Array[0..2] of String = (' 原版立體聲 ','伴唱（左聲道）','伴唱（右聲道）');
Function AddtoSongList(DoInsert : Boolean;_SSID:String):Integer;
var
NewPlaySong : PPlaySong;
begin
Result := -1;
if DM1.Query1.Locate('SSID', _SSID, []) then
begin
New(NewPlaySong);
With DM1.Query1,NewPlaySong^ do
begin
SSID := FieldbyName('SSID').AsString;
Song := FieldbyName('SongName').AsString;
SFile := FieldbyName('MediaFile').AsString;
AudioVol := FieldbyName('AudioVol').AsInteger;
AudioChannel := FieldbyName('AudioChannel').AsInteger;
if DoInsert then
Mode := pmIntercut
else
Mode := pmNormal;
end;
if DoInsert then
begin
SongList.InsertObject(0, _SSID, TObject(NewPlaySong));
Result := 0;
end
else
Result := SongList.AddObject(_SSID, TObject(NewPlaySong));
if Result > -1 then
begin
{ 點播成功 }
With NewPlaySong^ do
ShowDisply3('(' SSID ')' Song, True, 3000);
if FileExists(ProPath 'ding.Wav') then
MMsystem.PlaySound(Pchar(ProPath 'ding.Wav'), 0, SND_FILENAME or SND_ASYNC);
end;
{ 即時異動不正確的顯示 }
if CurPlaySong.Mode <> pmRandom then
begin
if (SongList.Count = 1) or DoInsert then
begin
{ 原本沒有顯示下一首，顯示下一首 }
ShowDisply1(PLAYTITLES[CurPlaySong.Mode] CurPlaySong.Song '，下一首 ' NewPlaySong^.Song ' 請來賓準備...',
PLAYFONTCOLORS[CurPlaySong.Mode]);
end;
end
else
begin
{ 目前若隨機播放，已點歌切歌 }
StopandPlayNext;
end;
end
else
ShowDisply3('無此歌曲編號！(' _SSID ')', True, 4000);
end;
var
KeyChar : Char;
I, J : Integer;
begin
KeyChar := VirtualKeyToAscii(Key);
Try
{ 系統問 }
if TXT5.Visible and (TXT5.Tag = 1) then
begin
if KeyChar in ['1', '3'] then
begin
{ 1 : 結束並關機 }
{ 3 : 僅結束程式 }
if KeyChar = '1' then
WinShutDown(atPowerOff, True);
Application.Terminate;
Exit;
end
else
CleanbyTimerID(5);
Exit;
end;
Case Key of
VK_DELETE :
StopandPlayNext;
VK_F4 :
if (CurPlaySong.SSID <> '') and DM1.Query1.Locate('SSID', CurPlaySong.SSID, []) then
begin
With DM1.Query1 do
begin
Edit;
FieldbyName('AudioVol').AsInteger := CurPlaySong.AudioVol;
FieldbyName('AudioChannel').AsInteger := CurPlaySong.AudioChannel;
UpdateBatch;
ShowDisply2('儲存聲道設定');
end;
end;
VK_F5 :
begin
{ 暫停 }
if TXT5.Visible then
begin
TXT5.Visible := False;
TXT5.Tag := 0;
FilterGraph1.Play;
end
else
begin
FilterGraph1.Pause;
TXT5.Caption := '＜暫停播放＞';
TXT5.Tag := 0;
TXT5.Visible := True;
end;
end;
VK_F7 :
begin
{ 顯示待播歌曲 }
TXT4.Visible := Not TXT4.Visible;
FPageID := 0;
end;
VK_F10 :
begin
KillTimer(Handle, 5);
TXT5.Tag := 1;
TXT5.Caption := '關閉程式？(1:是 / 0:否)';
TXT5.Visible := True;
SetTimer(Handle, 5, 5000, Nil);
end;
VK_RETURN :
if FKeyinNo <> '' then
begin
{點播歌曲 }
AddtoSongList(False, FKeyinNo);
end
else
ShowDisply3(''); {待命 }
VK_INSERT :
if FKeyinNo <> '' then
begin
{插播歌曲 }
AddtoSongList(True, FKeyinNo);
end
else
ShowDisply3(''); {待命 }
VK_BACK :
begin
{ 輸入歌曲，退字鍵 }
if FKeyinNo <> '' then
System.Delete(FKeyinNo, Length(FKeyinNo), 1);
ShowDisply3(FKeyinNo);
end;
VK_HOME :
begin
{ 重唱 }
Replay;
end;
VK_PRIOR :
begin
{ 上一頁 }
if FPageID > 0 then
begin
FPageID := FPageID - 1;
TXT4.Invalidate;
end;
end;
VK_NEXT :
begin
{ 下一頁 }
if FPageID < (SongList.Count Div ListVisibleRows) then
begin
FPageID := FPageID 1;
TXT4.Invalidate;
end;
end;
else
Case KeyChar of
'*' :
if MAduio_Enabled then
begin
{ 聲道切換 }
MAduio.get_DualMode(CurDualMode);
Inc(CurDualMode);
if CurDualMode > 2 then
CurDualMode := 0;
{ 0=聲道全開 1=只開第一聲道(通常為左) 2=只開第二聲道
大部份的台灣KTV VCD碟都是把男聲、合唱定在左聲，女生定在右聲 }
MAduio.put_DualMode(CurDualMode);
ShowDisply2(DualModeCaption[CurDualMode]);
end
else
ShowDisply2('沒有作用');
' ','-' :
begin
{ 音量 }
MasterVol.GetMasterVolume (I, J);
J := I Div 656;
if KeyChar = '-' then
Dec(J)
else
Inc(J);
I := Min(Max(J * 656,0), 65535);
MasterVol.SetMasterVolume (I, 0);
ShowDisply2('音量 ' GetRSPC(I2S(J), 3));
end;
'0'..'9' :
ShowDisply3(FKeyinNo KeyChar);
end;
end;
Finally
//
end;
end;
procedure TfMainVedio.VideoWindow1OverlayVisible(Sender: TObject;Visible: Boolean);
var
I : Integer;
TransColor : TColor;
begin
if Visible then
TransColor := VideoWindow1.ColorKey
else
TransColor := VideoWindow1.Color;
For I := 0 to VideoWindow1.ControlCount - 1 do
if (VideoWindow1.Controls[I] is TPanel) and (VideoWindow1.Controls[I] <> TXT5) then
TPanel(VideoWindow1.Controls[I]).Color := TransColor;
end;
procedure TfMainVedio.VideoWindow1ColorKeyChanged(Sender: TObject);
begin
VideoWindow1OverlayVisible(Nil, VideoWindow1.OverlayVisible);
end;
procedure TfMainVedio.TXT4Paint(Sender: TObject);
var
I, J : Integer;
ARect : TRect;
begin
if SongList.Count = 0 then
begin
FPageID := 0;
DrawBorderText(TXT4.Canvas, '無待播歌曲！', Rect(0, 0, TXT4.Width, LineHeight), SONGLIST_FONTCOLOR, DT_LEFT);
Exit;
end;
I := FPageID * ListVisibleRows;
J := 0;
if I > SongList.Count then
begin
FPageID := (SongList.Count Div ListVisibleRows);
I := FPageID * ListVisibleRows;
end;
While (J < ListVisibleRows) and (I < ListVisibleRows) do //While (J < ListVisibleRows) and (I
begin
With PPlaySong(SongList.Objects[I])^ do
begin
ARect := Rect(0, J * LineHeight,TXT4.Width, 0);
ARect.Bottom := ARect.Top LineHeight;
DrawBorderText(TXT4.Canvas, i2S(I 1) ' (' SSID ')' Song, ARect, SONGLIST_FONTCOLOR, DT_LEFT);
end;
Inc(I);
Inc(J);
end;
end;
end.

編輯記錄