X
xsw888
Unregistered / Unconfirmed
GUEST, unregistred user!
如题,用DSPACK要连续播出多个AVI文件,中间无停顿,该如何实现,请高手指点
帮忙.
帮忙.
X
xsw888
Unregistered / Unconfirmed
GUEST, unregistred user!
怎么没人理啊,高手帮帮忙吧!
提个想法:将多个AVI文件存为内存流,再用DSPACK读出
但不知该如何实现
分不够可以再加
提个想法:将多个AVI文件存为内存流,再用DSPACK读出
但不知该如何实现
分不够可以再加
L
linchhero
Unregistered / Unconfirmed
GUEST, unregistred user!
哈哈，简单呀，网上找个代码就行了！
X
xsw888
Unregistered / Unconfirmed
GUEST, unregistred user!
用DSPACK播的时候不能有停顿，就像是播一个文件一样，
DSTrackBar是一直往前的
楼上的网上能不能找到这样的代码？
DSTrackBar是一直往前的
楼上的网上能不能找到这样的代码？
X
xingkong97
Unregistered / Unconfirmed
GUEST, unregistred user!
实现这个功能只用DSPACK所提供的控件事不行的，必须深入研究DSPACK所提供的DirectShow类库，用类库可以实现，但是需要下一些功夫，其实只是在ReceiveSample方法中写进一些内容既可，虽然我没有试过，但我确信可以的。
X
xsw888
Unregistered / Unconfirmed
GUEST, unregistred user!
to xingkong97:
我也知道可以,但不知道怎样实现,在网上查了些资料,也看了陆其明老师的教材,都是VC的
不太懂,好像要自己写一个Source Filter，再对各个文件进行DECODER，然后连续地将解码后的数据传送给Video Renderer.要有DELPHI的就好了!!!
我也知道可以,但不知道怎样实现,在网上查了些资料,也看了陆其明老师的教材,都是VC的
不太懂,好像要自己写一个Source Filter，再对各个文件进行DECODER，然后连续地将解码后的数据传送给Video Renderer.要有DELPHI的就好了!!!
X
xingkong97
Unregistered / Unconfirmed
GUEST, unregistred user!
这样吧，我可以帮你实现，只不过你要等一下，我这边比较忙。另外，其实我学习DirectShow类库也是看的陆其明的那两本书，VC没关系的，原理都一样。另外，强调一点，真正的聪明的程序员是用VC学习Delphi。
X
xsw888
Unregistered / Unconfirmed
GUEST, unregistred user!
真是太感谢xingkong97了,等问提解决了我会另外开个贴给您加分,另外,我还不是专职的
程序员,只是出于对编程的爱好想多学一点,所以水平较菜,请你不要见笑,有机会还希望您能
多帮助!谢谢
我想做个视频播放器,能播放各种视频文件及流媒体,我加入了KSCSHOW控件,可以播放KSC字幕文件,并做了些修改,但该控件的VideoFiltGraph属性限制了只能播单个AVI文件,我有多个
AVI短片,希望能在播出的时后动态组合几个AVI然后一次播出,配合KSC文件
以下是KSCSHOW单元:
unit KSCShow;
interface
{$WARN SYMBOL_DEPRECATED OFF}
uses Classes, BaseClass, ActiveX, DirectShow9, MMSystem, Messages, Consts,
Windows, DSUTil, DSPack, Graphics, SysUtils, Dialogs, Forms;
const
Name_KSCShow = 'KSC File Show 1.0 by Style.Chen';
CLSID_KSCShow: TGUID = '{81B21360-3B20-4210-B693-9866B5C17AF2}';
Song_Title = 'karaoke.songname := '+#39;
Song_Singer = 'karaoke.singer := '+#39;
LyricLineHead = 'karaoke.add(''';
LyricLineFoot = ''');';
LyricLineCompart = ''', ''';
SongerMan = '(男
';
SongerWoman = '(女';
SongerOther = '(合';
WordHead = '[';
WordFoot = ']';
FontLeft = 40;
FontRight = 40;
type
TLyricWord = record
Title: string;
StartTime: Int64;
StopTime: Int64;
CountTime: Int64;
end;
TLyricWordList = array of TLyricWord;
type
TLyricLine = record
StartTime: Int64;
EndTime: Int64;
LyricString: string;
LyricTime: string;
LyricWordList: TLyricWordList;
SongerType: Integer;
Index: Integer;
Enable: Boolean;
end;
TLyricLineList = array of TLyricLine;
type
TDrawEvent = procedure(Sender: TObject;
var Bmp: TBitmap) of object;
TKSCShowFilterGraph = class(TFilterGraph)
public
procedure InsertFilter(AFilter: IFilter);
procedure RemoveFilter(AFilter: IFilter);
end;
TKSCShowFilter = class;
TKSCFile = class(TComponent)
private
FFileName,FSongName,FSinger: string;
FFileStrings: TStrings;
FLyricLineList: TLyricLineList;
FParent: TKSCShowFilter;
FFristIndex: Integer;
FSecondIndex: Integer;
function LoadFromFile(FileName: string): Boolean;
procedure SetFileName(Value: string);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure GetCurrectLyric(var Bmp: TBitmap;
CurrectTime: Int64);
property FileName: string read FFileName write SetFileName;
property Parent: TKSCShowFilter read FParent write FParent;
end;
TKSCShow = class;
TKSCShowFilter = class(TBCTransInPlaceFilter)
FThisInstance: integer;
FPreferred: TAMMediaType;
FKSCShowLock: TBCCritSec;
private
FParent: TKSCShow;
FVideoBuffer: PByte;
FBitmap: TBitmap;
FMediaSeeking: IMediaSeeking;
FKSCFile: TKSCFile;
FWidth: Integer;
procedure SetParent(AParent: TKSCShow);
function GetFileName: string;
procedure SetFileName(Value: string);
public
function CheckInputType(mtIn: PAMMediaType): HRESULT;
override;
constructor Create(ObjName: string;
unk: IUnKnown;
out hr: HRESULT);
constructor CreateFromFactory(Factory: TBCClassFactory;
const Controller:
IUnknown);
override;
destructor Destroy;
override;
function Transform(Sample: IMediaSample): HRESULT;
override;
property Parent: TKSCShow read FParent write SetParent;
property Width: Integer read FWidth;
property FileName: string read GetFileName write SetFileName;
end;
TKSCShow = class(TComponent, IFilter)
private
FFilter: TKSCShowFilter;
FVideoFilterGraph: TFilterGraph;
FMusicFilterGraph: TFilterGraph;
FBaseFilter: IBaseFilter;
FMediaSeeking: IMediaSeeking;
FWindowHandle: HWND;
FCurrentPos, FStopPos: Cardinal;
FIntervald: Integer;
FEnabled: Boolean;
FFont: TFont;
FTransColor: TColor;
FFirstColor: TColor;
FSecondColor: TColor;
FThirdColor: TColor;
FHeight: Integer;
FDrawEvent: TDrawEvent;
function GetFilter: IBaseFilter;
function GetName: string;
procedure NotifyFilter(operation: TFilterOperation;
Param: integer = 0);
procedure SetFilterGraph(AFilterGraph: TFilterGraph);
procedure UpdateTimer(Value: Integer);
function GetIntervald: Integer;
procedure SetInterval(Value: Integer);
function GetFileName: string;
procedure SetFileName(Value: string);
procedure SetFont(Value: TFont);
procedure SetTransColor(Value: TColor);
procedure SetFirstColor(Value: TColor);
procedure SetSecondColor(Value: TColor);
procedure SetThirdColor(Value: TColor);
function GetEnabled: Boolean;
procedure SetEnabled(Value: Boolean);
procedure SetHeight(Value: Integer);
function GetWidth: Integer;
function CreateFilter: HResult;
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure GetMediaTime(var CurrentPos, StopPos: Cardinal);
procedure Timer;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
function QueryInterface(const IID: TGUID;
out Obj): HResult;
override;
stdcall;
procedure TimerWndProc(var Msg: TMessage);
property FileName: string read GetFileName write SetFileName;
published
property VideoFilterGraph: TFilterGraph read FVideoFilterGraph write
SetFilterGraph;
property MusicFilterGraph: TFilterGraph read FMusicFilterGraph write
FMusicFilterGraph;
property Interval: Integer read GetIntervald write SetInterval;
property Font: TFont read FFont write SetFont;
property TransColor: TColor read FTransColor write SetTransColor;
property FirstColor: TColor read FFirstColor write SetFirstColor;
property SecondColor: TColor read FSecondColor write SetSecondColor;
property ThirdColor: TColor read FThirdColor write SetThirdColor;
property Enabled: Boolean read GetEnabled write SetEnabled;
property Width: Integer read GetWidth;
property Height: Integer read FHeight write SetHeight;
property OnDraw: TDrawEvent read FDrawEvent write FDrawEvent;
end;
var
InstanceCount: integer = 0;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('DSPack', [TKSCShow]);
end;
procedure TKSCShowFilterGraph.InsertFilter(AFilter: IFilter);
begin
inherited InsertFilter(AFilter);
end;
procedure TKSCShowFilterGraph.RemoveFilter(AFilter: IFilter);
begin
inherited RemoveFilter(AFilter);
end;
procedure TKSCFile.GetCurrectLyric(var Bmp: TBitmap;
CurrectTime: Int64);
var
i, Count: Integer;
SongType: string;
FontWidth, FontHeight: Integer;
mFontLeft: Integer;
function GetLyricLine(LyricLine: TLyricLine): string;
var
i: Integer;
begin
Result := '';
for i := 0 to Length(LyricLine.LyricWordList) - 1do
begin
Result := Result + LyricLine.LyricWordList.Title;
end;
end;
procedure DrawText(var Bmp: TBitmap;
x, y: Integer;
S: string;
Flag: Integer);
var
BackColor, FontColor: TColor;
begin
if Bmp <> nil then
begin
BackColor := clBlack;
FontColor := clWhite;
if Flag = 1 then
begin
BackColor := clWhite;
FontColor := Parent.Parent.FirstColor;
end
else
if Flag = 2 then
begin
BackColor := clWhite;
FontColor := Parent.Parent.SecondColor;
end
else
if Flag = 3 then
begin
BackColor := clWhite;
FontColor := Parent.Parent.ThirdColor;
end;
Bmp.Canvas.Brush.Style := bsClear;
//Bmp.Canvas.Font.Size:=Parent.Parent.Font.Size +1;
Bmp.Canvas.Font.Color := BackColor;
Bmp.Canvas.TextOut(x, y - 1, S);
Bmp.Canvas.TextOut(x, y + 1, S);
Bmp.Canvas.TextOut(x - 1 , y, S);
Bmp.Canvas.TextOut(x + 1, y, S);
//Bmp.Canvas.Font.Size:=Parent.Parent.Font.Size;
Bmp.Canvas.Font.Color := FontColor;
Bmp.Canvas.TextOut(x, y, S);
end;
end;
procedure LineProgress(var Bmp: TBitmap;
LyricLine: TLyricLine;
x, y: Integer;
CurrectTime: Int64);
var
i, Count: Integer;
WordLeft, WordWidth, WordHeight: Integer;
WordBmp: TBitmap;
SongerType: Integer;
begin
Count := Length(LyricLine.LyricWordList);
WordLeft := x;
for i := 0 to Count - 1do
begin
SongerType := LyricLine.SongerType;
if SongerType = 0 then
SongerType := 1;
if LyricLine.LyricWordList.StopTime < CurrectTime then
begin
DrawText(Bmp, WordLeft, y, LyricLine.LyricWordList.Title,
SongerType);
end
else
if (LyricLine.LyricWordList.StartTime < CurrectTime) and
(LyricLine.LyricWordList.StopTime > CurrectTime) then
begin
WordHeight := Bmp.Canvas.TextHeight(LyricLine.LyricWordList.Title);
WordWidth := (CurrectTime - LyricLine.LyricWordList.StartTime) *
Bmp.Canvas.TextWidth(LyricLine.LyricWordList.Title) div
LyricLine.LyricWordList.CountTime;
WordBmp := TBitmap.Create;
WordBmp.PixelFormat := pf24bit;
WordBmp.Height := WordHeight + 1;
WordBmp.Width := WordWidth + 1;
WordBmp.Canvas.Lock;
WordBmp.Canvas.Font := Parent.Parent.Font;
WordBmp.Canvas.Brush.Color := Parent.Parent.TransColor;
WordBmp.Canvas.Rectangle(-1, -1, WordBmp.Width +1, WordBmp.Height + 1);
WordBmp.Canvas.Brush.Style := bsClear;
DrawText(WordBmp, 0, 0, LyricLine.LyricWordList.Title, SongerType);
Bmp.Canvas.Draw(WordLeft,y, WordBmp);
WordBmp.Canvas.Unlock;
WordBmp.Free;
Break;
end;
WordLeft := WordLeft +
Bmp.Canvas.TextWidth(LyricLine.LyricWordList.Title);
end;
end;
procedure bootProgress(var Bmp: TBitmap;
S:string;
x, y: Integer;
showTime,endtime,CurrectTime: Int64);
var
i: Integer;
WordWidth, WordHeight: Integer;
WordBmp: TBitmap;
begin
for i:=0 to 10do
begin
try
//WordBmp.Canvas.Font.Size:=10;
WordHeight := Bmp.Canvas.TextHeight(S);
WordWidth := (endtime - CurrectTime) * Bmp.Canvas.TextWidth(S) div showTime;
WordBmp := TBitmap.Create;
WordBmp.PixelFormat := pf24bit;
WordBmp.Height := WordHeight+1 ;
WordBmp.Width := WordWidth+1;
WordBmp.Canvas.Lock;
WordBmp.Canvas.Font := Bmp.Canvas.Font;
WordBmp.Canvas.Brush.Color := Parent.Parent.TransColor;
WordBmp.Canvas.Rectangle(-1, -1, WordBmp.Width+1 , WordBmp.Height+1 );
WordBmp.Canvas.Brush.Style := bsClear;
DrawText(WordBmp, 0, 0, S, 2);
Bmp.Canvas.Draw(x, y, WordBmp);
WordBmp.Canvas.Unlock;
WordBmp.Free;
Break;
except
end;
end;
end;
begin
try
FFristIndex := -1;
FSecondIndex := -1;
Bmp.Width := Parent.Parent.Width;
Bmp.Height := Parent.Parent.Height;
Bmp.Canvas.Brush.Color := Parent.Parent.TransColor;
Bmp.Canvas.Rectangle(-1, -1, Bmp.Width + 1, Bmp.Height + 1);
Bmp.Canvas.Font := Parent.Parent.Font;
Count := Length(FLyricLineList) - 1;
for i := 0 to Length(FLyricLineList) - 1do
begin
if (FLyricLineList.StartTime <= CurrectTime + 4000) and
(FLyricLineList.EndTime >= CurrectTime - 1000) then
begin
if FLyricLineList.Index mod 2 <> 0 then
begin
FFristIndex := i;
if i <> 0 then
begin
if FLyricLineList[i - 1].EndTime >= CurrectTime - 4000 then
FSecondIndex := i - 1;
end;
if i < Count then
begin
if FLyricLineList[i + 1].StartTime <= CurrectTime + 4000 then
FSecondIndex := i + 1;
end;
end
else
begin
FSecondIndex := i;
if i <> 0 then
begin
if FLyricLineList[i - 1].EndTime >= CurrectTime - 4000 then
FFristIndex := i - 1;
end;
if i < Count then
begin
if FLyricLineList[i + 1].StartTime <= CurrectTime + 4000 then
FFristIndex := i + 1;
end;
end;
end;
if (FFristIndex <> -1) and (FSecondIndex <> -1) then
Break;
end;
SongType := '';
FontHeight := Bmp.Canvas.TextHeight('测试');
if FFristIndex <> -1 then
begin
if FLyricLineList[FFristIndex].Enable then
begin
if FLyricLineList[FFristIndex].SongerType = 1 then
begin
SongType := '男:';
end
else
if FLyricLineList[FFristIndex].SongerType = 2 then
begin
SongType := '女:';
end
else
if FLyricLineList[FFristIndex].SongerType = 3 then
begin
SongType := '合:';
end;
end;
mFontLeft := FontLeft + Bmp.Canvas.TextWidth(SongType);
DrawText(Bmp, FontLeft, ((Parent.Parent.Height - FontHeight*2) div 3)*
2+FontHeight+5,
SongType,
FLyricLineList[FFristIndex].SongerType);
DrawText(Bmp, mFontLeft, ((Parent.Parent.Height - FontHeight*2) div 3)*
2+FontHeight+5,
GetLyricLine(FLyricLineList[FFristIndex]), 0);
LineProgress(Bmp, FLyricLineList[FFristIndex], mFontLeft,
((Parent.Parent.Height - FontHeight*2) div 3)*
2+FontHeight+5,
CurrectTime);
end;
SongType := '';
if FSecondIndex <> -1 then
begin
if FLyricLineList[FSecondIndex].Enable then
begin
if FLyricLineList[FSecondIndex].SongerType = 1 then
begin
SongType := '男:';
end
else
if FLyricLineList[FSecondIndex].SongerType = 2 then
begin
SongType := '女:';
end
else
if FLyricLineList[FSecondIndex].SongerType = 3 then
begin
SongType := '合:';
end;
end;
FontWidth := Bmp.Canvas.TextWidth(SongType +
GetLyricLine(FLyricLineList[FSecondIndex]));
mFontLeft := Bmp.Width - FontRight - FontWidth +
Bmp.Canvas.TextWidth(SongType);
DrawText(Bmp, Bmp.Width - FontRight - FontWidth, ((Parent.Parent.Height -
FontHeight *
2) div 3) * 2 + FontHeight+40, SongType,
FLyricLineList[FSecondIndex].SongerType);
DrawText(Bmp, mFontLeft, ((Parent.Parent.Height - FontHeight * 2) div 3) *
2 +
FontHeight+40, GetLyricLine(FLyricLineList[FSecondIndex]), 0);
LineProgress(Bmp, FLyricLineList[FSecondIndex], mFontLeft,
((Parent.Parent.Height -
FontHeight * 2) div 3) * 2 + FontHeight+40, CurrectTime);
end;
if (CurrectTime>100)and(CurrectTime<10000) then
begin
if FSongName<>'' then
begin
bmp.Canvas.Font.Size:=28;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSongName) div 2),
FontHeight,FSongName,2);
end;
if FSinger<>'' then
begin
bmp.Canvas.Font.Size:=18;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSinger) div 2),
FontHeight+40,FSinger,1);
end;
end;
if (CurrectTime>10050)and(CurrectTime<10100) then
begin
if FSongName<>'' then
begin
bmp.Canvas.Font.Size:=20;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSongName) div 2),
FontHeight,FSongName,2);
end;
if FSinger<>'' then
begin
bmp.Canvas.Font.Size:=13;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSinger) div 2),
FontHeight+40,FSinger,1);
end;
end;
if (FLyricLineList[0].StartTime <= CurrectTime +4000)and(FLyricLineList[0].StartTime > CurrectTime+100) then
begin
Bmp.Canvas.Font.Size:=9;
bootProgress(Bmp,'●●●',FontLeft,((Parent.Parent.Height - FontHeight*2) div 3)*
2+17,1000,FLyricLineList[0].StartTime,CurrectTime);
end;
except
end;
end;
function TKSCFile.LoadFromFile(FileName: string): Boolean;
var
i, j: Integer;
Count: Integer;
function IsLyricLine(S: string): Boolean;
begin
Result := False;
if (Pos(LyricLineHead, S) > 0) and (Pos(LyricLineFoot, S) > 0) then
begin
Result := True;
end;
end;
function IsSongname(S: string): Boolean;
begin
Result:=False;
if Pos(Song_Title,S)>0 then
Result:=true;
end;
function IsSinger(S: string): Boolean;
begin
result:=False;
if Pos(Song_Singer,S)>0 then
Result:=true;
end;
function GetSongname(S : string):String;
var
lis : string;
begin
result:='';
lis :=#39+';';
if Pos(Song_Title,S)>0 then
begin
Delete(S,1,length(Song_Title));
result:=copy(S,1,pos(lis,S)-1);
end;
end;
function GetSinger(S : string):string;
var
lis : string;
begin
result:='';
lis:=#39+';';
if Pos(Song_Singer,S)>0 then
begin
Delete(S,1,length(Song_Singer));
result:=copy(S,1,pos(lis,S)-1);
end;
end;
procedure DeleteCompart(var S: string;
Count: Integer);
var
i, j: Integer;
begin
for i := 0 to Count - 1do
begin
j := Pos(LyricLineCompart, S);
if j > 0 then
begin
Delete(S, 1, j + Length(LyricLineCompart) - 1);
end;
end;
end;
function GetStartTime(S: string): string;
var
i: Integer;
begin
i := Pos(LyricLineHead, S);
if i > 0 then
begin
Delete(S, i, Length(LyricLineHead));
i := Pos(LyricLineCompart, S);
Result := Copy(S, 1, i - 1);
end;
end;
function GetEndTime(S: string): string;
var
i: Integer;
begin
DeleteCompart(S, 1);
i := Pos(LyricLineCompart, S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
end;
end;
function GetLyricString(S: string): string;
var
i: Integer;
begin
DeleteCompart(S, 2);
i := Pos(LyricLineCompart, S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
end;
end;
function GetLyricTime(S: string): string;
var
i: Integer;
begin
DeleteCompart(S, 3);
i := Pos(LyricLineFoot, S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
end;
end;
function GetPyString(S: string): string;
var
HzStr: string;
i: Integer;
begin
HzStr := S;
while HzStr <> ''do
begin
if HzStr[1] = '[' then
begin
i := Pos(']', HzStr);
Result := Result + Copy(HzStr, 0, i);
HzStr := Copy(HzStr, i + 1, Length(HzStr) - 1);
end
else
if (ord(HzStr[1]) >= 33) and (ord(HzStr[1]) <= 126) then
begin
Result := Result + '[' + Copy(HzStr, 0, 1) + ']';
HzStr := Copy(HzStr, 2, Length(HzStr) - 1);
end
else
if Ord(HzStr[1]) > 127 then
begin
Result := Result + '[' + Copy(HzStr, 0, 2) + ']';
HzStr := Copy(HzStr, 3, Length(HzStr) - 2);
end;
end;
Result := Copy(Result, 0, Length(Result) + 1);
end;
function GetHeadFootStr(var S: string): string;
var
i, j: Integer;
begin
i := Pos(WordHead, S);
if (i > 0) then
begin
Delete(S, 1, i + Length(WordHead) - 1);
j := Pos(WordFoot, S);
if j > 0 then
begin
Result := Copy(S, 1, j - 1);
Delete(S, 1, j + Length(WordFoot) - 1);
end;
end;
end;
function GetTitleStr(var S: string): string;
var
i: Integer;
begin
i := Pos('''', S);
if (i > 0) then
begin
Delete(S, 1, i);
end;
i := Pos('''', S);
if (i > 0) then
begin
Result := Copy(S, 1, i - 1);
Delete(S, 1, i);
end;
end;
function GetTime(s: string): DWord;
var
p1, p2: Integer;
iMin, iSec, iMs: Integer;
begin
p1 := pos(':', s);
p2 := pos('.', s);
iMin := StrToIntDef(Copy(s, 1, p1 - 1), 0);
iSec := StrToIntDef(Copy(s, p1 + 1, p2 - p1 - 1), 0);
iMs := StrToIntDef(Copy(s, p2 + 1, Length(s) - p2), 0);
Result := (iMin * 60 + iSec) * 1000 + iMs;
end;
function GetMilliSecondStr(var S: string): string;
var
i: Integer;
begin
i := Pos(',', S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
Delete(S, 1, i);
end;
end;
function LoadLyricLine(S: string;
var LyricLine: TLyricLine): Boolean;
var
i, Count, CountOut: Integer;
LyricString: string;
LyricTime: string;
SongerType: Integer;
begin
Result := True;
try
if (Pos(LyricLineHead, S) > 0) and (Pos(LyricLineFoot, S) > 0) then
begin
LyricLine.LyricWordList := nil;
LyricLine.StartTime := GetTime(GetStartTime(S));
LyricLine.EndTime := GetTime(GetEndTime(S));
LyricString := GetLyricString(S);
LyricTime := GetLyricTime(S);
SongerType := 0;
i := Pos(SongerMan, LyricString);
if i > 0 then
begin
SongerType := 1;
Delete(LyricString, 1, Length(SongerMan));
end;
i := Pos(SongerWoman, LyricString);
if i > 0 then
begin
SongerType := 2;
Delete(LyricString, 1, Length(SongerWoman));
end;
i := Pos(SongerOther, LyricString);
if i > 0 then
begin
SongerType := 3;
Delete(LyricString, 1, Length(SongerOther));
end;
LyricLine.SongerType := SongerType;
if LyricLine.SongerType <> 0 then
LyricLine.Enable := True;
LyricString := GetPyString(LyricString);
Count := 0;
CountOut := 0;
while not (Length(LyricString) = 0)do
begin
Inc(CountOut);
if CountOut > 999 then
begin
Result := False;
Exit;
end;
if Pos(WordHead, LyricString) > 0 then
begin
Inc(Count);
SetLength(LyricLine.LyricWordList, Count);
LyricLine.LyricWordList[Count - 1].Title :=
GetHeadFootStr(LyricString);
if (Count - 1) = 0 then
begin
LyricLine.LyricWordList[Count - 1].StartTime :=
LyricLine.StartTime;
end
else
begin
LyricLine.LyricWordList[Count - 1].StartTime :=
LyricLine.LyricWordList[Count - 2].StopTime;
end;
LyricLine.LyricWordList[Count - 1].CountTime :=
StrToInt(GetMilliSecondStr(LyricTime));
LyricLine.LyricWordList[Count - 1].StopTime :=
LyricLine.LyricWordList[Count - 1].StartTime +
LyricLine.LyricWordList[Count - 1].CountTime;
end;
{else
if Pos('''', LyricString) > 0 then
begin
Inc(Count);
SetLength(LyricLine.LyricWordList, Count);
LyricLine.LyricWordList[Count - 1].Title := GetTitleStr(LyricString);
if (Count - 1) = 0 then
begin
LyricLine.LyricWordList[Count - 1].StartTime := LyricLine.StartTime;
end
else
begin
LyricLine.LyricWordList[Count - 1].StartTime := LyricLine.LyricWordList[Count - 2].StopTime;
end;
LyricLine.LyricWordList[Count - 1].CountTime := StrToInt(GetMilliSecondStr(LyricTime));
LyricLine.LyricWordList[Count - 1].StopTime := LyricLine.LyricWordList[Count - 1].StartTime + LyricLine.LyricWordList[Count - 1].CountTime;
end;
}
end;
end;
except
Result := False;
end;
end;
begin
Result := True;
if not FileExists(FileName) then
begin
Result := False;
Exit;
end;
// FLyricLineList := nil;
SetLength(FLyricLineList, 0);
FFileStrings.Clear;
FFileStrings.LoadFromFile(FileName);
Count := 0;
for i := 0 to FFileStrings.Count - 1do
begin
if IsSongname(FFileStrings.Strings) then
FSongName:=GetSongName(FFileStrings.Strings);
IF IsSinger(FFileStrings.Strings) then
FSinger:=GetSinger(FFileStrings.Strings);
if IsLyricLine(FFileStrings.Strings) then
begin
Inc(Count);
end;
end;
SetLength(FLyricLineList, Count);
Count := 0;
for i := 0 to FFileStrings.Count - 1do
begin
if IsLyricLine(FFileStrings.Strings) then
begin
if not LoadLyricLine(FFileStrings.Strings, FLyricLineList[Count]) then
begin
Result := False;
Exit;
end;
Inc(Count);
end;
end;
j := 0;
for i := 0 to Length(FLyricLineList) - 1do
begin
FLyricLineList.Index := i + 1;
if FLyricLineList.SongerType <> 0 then
begin
j := FLyricLineList.SongerType;
end
else
if FLyricLineList.SongerType = 0 then
begin
FLyricLineList.SongerType := j;
end;
end;
end;
constructor TKSCFile.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFileName := '';
FLyricLineList := nil;
FFileStrings := TStringList.Create;
FFristIndex := -1;
FSecondIndex := -1;
end;
destructor TKSCFile.Destroy;
begin
FreeMem(FLyricLineList);
FFileStrings.Free;
inherited Destroy;
end;
procedure TKSCFile.SetFileName(Value: string);
begin
if LoadFromFile(Value) then
begin
FFileName := Value;
end
else
begin
FFileName := '';
end;
end;
procedure TKSCShowFilter.SetParent(AParent: TKSCShow);
begin
FParent := AParent;
end;
function TKSCShowFilter.GetFileName: string;
begin
Result := FKSCFile.FileName;
end;
procedure TKSCShowFilter.SetFileName(Value: string);
begin
FKSCFile.FileName := Value;
end;
function TKSCShowFilter.CheckInputType(mtIn: PAMMediaType): HRESULT;
begin
if not IsEqualGUID(mtIn^.majortype, MEDIATYPE_Video) then
begin
Result := VFW_E_INVALIDMEDIATYPE;
Exit;
end;
if not IsEqualGUID(mtIn^.subtype, MEDIASUBTYPE_RGB24) then
begin
Result := VFW_E_INVALIDSUBTYPE;
Exit;
end;
if not IsEqualGUID(mtIn^.formattype, FORMAT_VideoInfo) then
begin
Result := VFW_E_TYPE_NOT_ACCEPTED;
Exit;
end;
Result := S_OK;
end;
constructor TKSCShowFilter.Create(ObjName: string;
unk: IUnKnown;
out hr:
HRESULT);
var
pmt: PAMMediaType;
begin
inherited Create(ObjName, unk, CLSID_KSCShow, hr);
FThisInstance := InterlockedIncrement(InstanceCount);
pmt := @FPreferred;
TBCMediaType(pmt).InitMediaType;
FKSCShowLock := TBCCritSec.Create;
FMediaSeeking := nil;
FKSCFile := TKSCFile.Create(nil);
FKSCFile.Parent := Self;
FBitmap := TBitmap.Create;
FBitmap.PixelFormat := pf24bit;
FWidth := 0;
end;
constructor TKSCShowFilter.CreateFromFactory(Factory: TBCClassFactory;
const
Controller:
IUnknown);
var
hr: HRESULT;
begin
Create(Factory.Name, Controller, hr);
end;
destructor TKSCShowFilter.Destroy;
begin
FBitmap.Free;
FKSCShowLock.Free;
inherited;
end;
function TKSCShowFilter.Transform(Sample: IMediaSample): HRESULT;
var
MlsCurrentPos, MlsStopPos: Cardinal;
i, j: Integer;
P: PByteArray;
VideoInfo: PVideoInfo;
CurrectTime: Int64;
CurrectColor: TColor;
begin
Result := S_OK;
FKSCShowLock.Lock;
if not Parent.Enabled then
begin
Exit;
end;
VideoInfo := FInput.CurrentMediaType.MediaType.pbFormat;
Sample.GetPointer(FVideoBuffer);
Parent.GetMediaTime(MlsCurrentPos, MlsStopPos);
CurrectTime := (StrToInt(FormatDateTime('nn', MlsCurrentPos / MiliSecPerDay))
* 60 +
StrToInt(FormatDateTime('ss', MlsCurrentPos / MiliSecPerDay))) * 1000 +
StrToInt(FormatDateTime('zzz', MlsCurrentPos / MiliSecPerDay));
FWidth := VideoInfo.bmiHeader.biWidth;
FBitmap.Canvas.Lock;
FKSCFile.GetCurrectLyric(FBitmap, CurrectTime);
if Assigned(Parent.FDrawEvent) then
begin
Parent.FDrawEvent(Parent, FBitmap);
end;
for j := 0 to Parent.Height - 1do
begin
P := FBitmap.ScanLine[Parent.Height - j - 1];
for i := 0 to FBitmap.Width - 1do
begin
CurrectColor := RGB(P[i * 3], P[i * 3 + 1], P[i * 3 + 2]);
if CurrectColor <> Parent.TransColor then
begin
PByte(Integer(FVideoBuffer) + j * FWidth * 3 + i * 3)^ := P[i * 3];
PByte(Integer(FVideoBuffer) + j * FWidth * 3 + i * 3 + 1)^ := P[i * 3 +
1];
PByte(Integer(FVideoBuffer) + j * FWidth * 3 + i * 3 + 2)^ := P[i * 3 +
2];
end;
end;
end;
FBitmap.Canvas.Unlock;
FKSCShowLock.UnLock;
end;
function TKSCShow.GetFilter: IBaseFilter;
begin
Result := FBaseFilter;
end;
function TKSCShow.GetName: string;
begin
Result := Name_KSCShow;
end;
procedure TKSCShow.NotifyFilter(operation: TFilterOperation;
Param: integer =
0);
begin
case operation of
foAdding:
begin
CreateFilter;
FBaseFilter := FFilter as IBaseFilter;
end;
foAdded:
begin
UpdateTimer(FIntervald);
end;
foRemoving: if FFilter <> nil then
FFilter.Stop;
foRemoved:
begin
FFilter := nil;
FBaseFilter := nil;
FMediaSeeking := nil;
end;
foRefresh: if Assigned(FVideoFilterGraph) then
begin
TKSCShowFilterGraph(FVideoFilterGraph).RemoveFilter(self);
TKSCShowFilterGraph(FVideoFilterGraph).InsertFilter(self);
end;
end;
end;
procedure TKSCShow.SetFilterGraph(AFilterGraph: TFilterGraph);
begin
if AFilterGraph = FVideoFilterGraph then
Exit;
if FVideoFilterGraph <> nil then
TKSCShowFilterGraph(FVideoFilterGraph).RemoveFilter(self);
if AFilterGraph <> nil then
TKSCShowFilterGraph(AFilterGraph).InsertFilter(self);
FVideoFilterGraph := AFilterGraph;
end;
procedure TKSCShow.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if ((AComponent = FVideoFilterGraph) and (Operation = opRemove)) then
FVideoFilterGraph := nil;
end;
procedure TKSCShow.GetMediaTime(var CurrentPos, StopPos: Cardinal);
begin
CurrentPos := FCurrentPos;
StopPos := FStopPos;
end;
procedure TKSCShow.Timer;
var
hCurrentPos, hStopPos: Int64;
begin
if FMusicFilterGraph = nil then
begin
Exit;
end;
if not FEnabled then
begin
Exit;
end;
if not assigned(FMediaSeeking) then
begin
FMusicFilterGraph.QueryInterface(IMediaSeeking, FMediaSeeking);
end;
if assigned(FMediaSeeking) then
begin
if Succeeded(FMediaSeeking.GetDuration(hStopPos)) then
if Succeeded(FMediaSeeking.GetCurrentPosition(hCurrentPos)) then
begin
FCurrentPos := RefTimeToMiliSec(hCurrentPos);
FStopPos := RefTimeToMiliSec(hStopPos);
end;
end;
end;
function TKSCShow.GetIntervald: Integer;
begin
Result := FIntervald;
end;
procedure TKSCShow.SetInterval(Value: Integer);
begin
FIntervald := Value;
UpdateTimer(FIntervald);
end;
function TKSCShow.GetFileName: string;
begin
Result := FFilter.FileName;
end;
procedure TKSCShow.SetFileName(Value: string);
begin
FFilter.FileName := Value;
end;
procedure TKSCShow.SetFont(Value: TFont);
begin
if FFont = Value then
Exit;
FFont.Assign(Value);
end;
procedure TKSCShow.SetTransColor(Value: TColor);
begin
if FTransColor = Value then
Exit;
FTransColor := Value;
end;
procedure TKSCShow.SetFirstColor(Value: TColor);
begin
if FFirstColor = Value then
Exit;
FFirstColor := Value;
end;
procedure TKSCShow.SetSecondColor(Value: TColor);
begin
if FSecondColor = Value then
Exit;
FSecondColor := Value;
end;
procedure TKSCShow.SetThirdColor(Value: TColor);
begin
if FThirdColor = Value then
Exit;
FThirdColor := Value;
end;
function TKSCShow.GetEnabled: Boolean;
begin
Result := FEnabled;
end;
procedure TKSCShow.SetEnabled(Value: Boolean);
begin
FEnabled := Value;
end;
procedure TKSCShow.SetHeight(Value: Integer);
begin
if FHeight = Value then
Exit;
FHeight := Value;
end;
function TKSCShow.GetWidth: Integer;
begin
Result := 0;
if FFilter <> nil then
Result := FFilter.Width;
end;
function TKSCShow.CreateFilter: HResult;
var
hr: HRESULT;
begin
if FFilter = nil then
begin
FFilter := TKSCShowFilter.Create(Name, nil, hr);
FFilter.Parent := Self;
end;
Result := hr;
end;
constructor TKSCShow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(TimerWndProc);
FIntervald := 25;
FEnabled := True;
UpdateTimer(FIntervald);
FTransColor := clFuchsia;
FFirstColor := clBlue;
FSecondColor := clRed;
FThirdColor := clGreen;
FFont := TFont.Create;
FFont.Size := 20;
FFont.Style := [fsBold];
FHeight := 200;
CreateFilter;
FBaseFilter := FFilter as IBaseFilter;
end;
destructor TKSCShow.Destroy;
begin
FFont.Free;
FVideoFilterGraph := nil;
FMusicFilterGraph := nil;
DeallocateHWnd(FWindowHandle);
FMediaSeeking := nil;
inherited Destroy;
end;
function TKSCShow.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
Result := inherited QueryInterface(IID, Obj);
if not Succeeded(Result) then
if Assigned(FFilter) then
begin
Result := FFilter.QueryInterface(IID, Obj);
end;
end;
procedure TKSCShow.TimerWndProc(var Msg: TMessage);
begin
with Msgdo
if Msg = WM_TIMER then
try
Timer;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TKSCShow.UpdateTimer(Value: Integer);
begin
KillTimer(FWindowHandle, 1);
if SetTimer(FWindowHandle, 1, Value, nil) = 0 then
raise EOutOfResources.Create(SNoTimers);
end;
end.
程序员,只是出于对编程的爱好想多学一点,所以水平较菜,请你不要见笑,有机会还希望您能
多帮助!谢谢
我想做个视频播放器,能播放各种视频文件及流媒体,我加入了KSCSHOW控件,可以播放KSC字幕文件,并做了些修改,但该控件的VideoFiltGraph属性限制了只能播单个AVI文件,我有多个
AVI短片,希望能在播出的时后动态组合几个AVI然后一次播出,配合KSC文件
以下是KSCSHOW单元:
unit KSCShow;
interface
{$WARN SYMBOL_DEPRECATED OFF}
uses Classes, BaseClass, ActiveX, DirectShow9, MMSystem, Messages, Consts,
Windows, DSUTil, DSPack, Graphics, SysUtils, Dialogs, Forms;
const
Name_KSCShow = 'KSC File Show 1.0 by Style.Chen';
CLSID_KSCShow: TGUID = '{81B21360-3B20-4210-B693-9866B5C17AF2}';
Song_Title = 'karaoke.songname := '+#39;
Song_Singer = 'karaoke.singer := '+#39;
LyricLineHead = 'karaoke.add(''';
LyricLineFoot = ''');';
LyricLineCompart = ''', ''';
SongerMan = '(男
';SongerWoman = '(女
';SongerOther = '(合
';WordHead = '[';
WordFoot = ']';
FontLeft = 40;
FontRight = 40;
type
TLyricWord = record
Title: string;
StartTime: Int64;
StopTime: Int64;
CountTime: Int64;
end;
TLyricWordList = array of TLyricWord;
type
TLyricLine = record
StartTime: Int64;
EndTime: Int64;
LyricString: string;
LyricTime: string;
LyricWordList: TLyricWordList;
SongerType: Integer;
Index: Integer;
Enable: Boolean;
end;
TLyricLineList = array of TLyricLine;
type
TDrawEvent = procedure(Sender: TObject;
var Bmp: TBitmap) of object;
TKSCShowFilterGraph = class(TFilterGraph)
public
procedure InsertFilter(AFilter: IFilter);
procedure RemoveFilter(AFilter: IFilter);
end;
TKSCShowFilter = class;
TKSCFile = class(TComponent)
private
FFileName,FSongName,FSinger: string;
FFileStrings: TStrings;
FLyricLineList: TLyricLineList;
FParent: TKSCShowFilter;
FFristIndex: Integer;
FSecondIndex: Integer;
function LoadFromFile(FileName: string): Boolean;
procedure SetFileName(Value: string);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure GetCurrectLyric(var Bmp: TBitmap;
CurrectTime: Int64);
property FileName: string read FFileName write SetFileName;
property Parent: TKSCShowFilter read FParent write FParent;
end;
TKSCShow = class;
TKSCShowFilter = class(TBCTransInPlaceFilter)
FThisInstance: integer;
FPreferred: TAMMediaType;
FKSCShowLock: TBCCritSec;
private
FParent: TKSCShow;
FVideoBuffer: PByte;
FBitmap: TBitmap;
FMediaSeeking: IMediaSeeking;
FKSCFile: TKSCFile;
FWidth: Integer;
procedure SetParent(AParent: TKSCShow);
function GetFileName: string;
procedure SetFileName(Value: string);
public
function CheckInputType(mtIn: PAMMediaType): HRESULT;
override;
constructor Create(ObjName: string;
unk: IUnKnown;
out hr: HRESULT);
constructor CreateFromFactory(Factory: TBCClassFactory;
const Controller:
IUnknown);
override;
destructor Destroy;
override;
function Transform(Sample: IMediaSample): HRESULT;
override;
property Parent: TKSCShow read FParent write SetParent;
property Width: Integer read FWidth;
property FileName: string read GetFileName write SetFileName;
end;
TKSCShow = class(TComponent, IFilter)
private
FFilter: TKSCShowFilter;
FVideoFilterGraph: TFilterGraph;
FMusicFilterGraph: TFilterGraph;
FBaseFilter: IBaseFilter;
FMediaSeeking: IMediaSeeking;
FWindowHandle: HWND;
FCurrentPos, FStopPos: Cardinal;
FIntervald: Integer;
FEnabled: Boolean;
FFont: TFont;
FTransColor: TColor;
FFirstColor: TColor;
FSecondColor: TColor;
FThirdColor: TColor;
FHeight: Integer;
FDrawEvent: TDrawEvent;
function GetFilter: IBaseFilter;
function GetName: string;
procedure NotifyFilter(operation: TFilterOperation;
Param: integer = 0);
procedure SetFilterGraph(AFilterGraph: TFilterGraph);
procedure UpdateTimer(Value: Integer);
function GetIntervald: Integer;
procedure SetInterval(Value: Integer);
function GetFileName: string;
procedure SetFileName(Value: string);
procedure SetFont(Value: TFont);
procedure SetTransColor(Value: TColor);
procedure SetFirstColor(Value: TColor);
procedure SetSecondColor(Value: TColor);
procedure SetThirdColor(Value: TColor);
function GetEnabled: Boolean;
procedure SetEnabled(Value: Boolean);
procedure SetHeight(Value: Integer);
function GetWidth: Integer;
function CreateFilter: HResult;
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure GetMediaTime(var CurrentPos, StopPos: Cardinal);
procedure Timer;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
function QueryInterface(const IID: TGUID;
out Obj): HResult;
override;
stdcall;
procedure TimerWndProc(var Msg: TMessage);
property FileName: string read GetFileName write SetFileName;
published
property VideoFilterGraph: TFilterGraph read FVideoFilterGraph write
SetFilterGraph;
property MusicFilterGraph: TFilterGraph read FMusicFilterGraph write
FMusicFilterGraph;
property Interval: Integer read GetIntervald write SetInterval;
property Font: TFont read FFont write SetFont;
property TransColor: TColor read FTransColor write SetTransColor;
property FirstColor: TColor read FFirstColor write SetFirstColor;
property SecondColor: TColor read FSecondColor write SetSecondColor;
property ThirdColor: TColor read FThirdColor write SetThirdColor;
property Enabled: Boolean read GetEnabled write SetEnabled;
property Width: Integer read GetWidth;
property Height: Integer read FHeight write SetHeight;
property OnDraw: TDrawEvent read FDrawEvent write FDrawEvent;
end;
var
InstanceCount: integer = 0;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('DSPack', [TKSCShow]);
end;
procedure TKSCShowFilterGraph.InsertFilter(AFilter: IFilter);
begin
inherited InsertFilter(AFilter);
end;
procedure TKSCShowFilterGraph.RemoveFilter(AFilter: IFilter);
begin
inherited RemoveFilter(AFilter);
end;
procedure TKSCFile.GetCurrectLyric(var Bmp: TBitmap;
CurrectTime: Int64);
var
i, Count: Integer;
SongType: string;
FontWidth, FontHeight: Integer;
mFontLeft: Integer;
function GetLyricLine(LyricLine: TLyricLine): string;
var
i: Integer;
begin
Result := '';
for i := 0 to Length(LyricLine.LyricWordList) - 1do
begin
Result := Result + LyricLine.LyricWordList.Title;
end;
end;
procedure DrawText(var Bmp: TBitmap;
x, y: Integer;
S: string;
Flag: Integer);
var
BackColor, FontColor: TColor;
begin
if Bmp <> nil then
begin
BackColor := clBlack;
FontColor := clWhite;
if Flag = 1 then
begin
BackColor := clWhite;
FontColor := Parent.Parent.FirstColor;
end
else
if Flag = 2 then
begin
BackColor := clWhite;
FontColor := Parent.Parent.SecondColor;
end
else
if Flag = 3 then
begin
BackColor := clWhite;
FontColor := Parent.Parent.ThirdColor;
end;
Bmp.Canvas.Brush.Style := bsClear;
//Bmp.Canvas.Font.Size:=Parent.Parent.Font.Size +1;
Bmp.Canvas.Font.Color := BackColor;
Bmp.Canvas.TextOut(x, y - 1, S);
Bmp.Canvas.TextOut(x, y + 1, S);
Bmp.Canvas.TextOut(x - 1 , y, S);
Bmp.Canvas.TextOut(x + 1, y, S);
//Bmp.Canvas.Font.Size:=Parent.Parent.Font.Size;
Bmp.Canvas.Font.Color := FontColor;
Bmp.Canvas.TextOut(x, y, S);
end;
end;
procedure LineProgress(var Bmp: TBitmap;
LyricLine: TLyricLine;
x, y: Integer;
CurrectTime: Int64);
var
i, Count: Integer;
WordLeft, WordWidth, WordHeight: Integer;
WordBmp: TBitmap;
SongerType: Integer;
begin
Count := Length(LyricLine.LyricWordList);
WordLeft := x;
for i := 0 to Count - 1do
begin
SongerType := LyricLine.SongerType;
if SongerType = 0 then
SongerType := 1;
if LyricLine.LyricWordList.StopTime < CurrectTime then
begin
DrawText(Bmp, WordLeft, y, LyricLine.LyricWordList.Title,
SongerType);
end
else
if (LyricLine.LyricWordList.StartTime < CurrectTime) and
(LyricLine.LyricWordList.StopTime > CurrectTime) then
begin
WordHeight := Bmp.Canvas.TextHeight(LyricLine.LyricWordList.Title);
WordWidth := (CurrectTime - LyricLine.LyricWordList.StartTime) *
Bmp.Canvas.TextWidth(LyricLine.LyricWordList.Title) div
LyricLine.LyricWordList.CountTime;
WordBmp := TBitmap.Create;
WordBmp.PixelFormat := pf24bit;
WordBmp.Height := WordHeight + 1;
WordBmp.Width := WordWidth + 1;
WordBmp.Canvas.Lock;
WordBmp.Canvas.Font := Parent.Parent.Font;
WordBmp.Canvas.Brush.Color := Parent.Parent.TransColor;
WordBmp.Canvas.Rectangle(-1, -1, WordBmp.Width +1, WordBmp.Height + 1);
WordBmp.Canvas.Brush.Style := bsClear;
DrawText(WordBmp, 0, 0, LyricLine.LyricWordList.Title, SongerType);
Bmp.Canvas.Draw(WordLeft,y, WordBmp);
WordBmp.Canvas.Unlock;
WordBmp.Free;
Break;
end;
WordLeft := WordLeft +
Bmp.Canvas.TextWidth(LyricLine.LyricWordList.Title);
end;
end;
procedure bootProgress(var Bmp: TBitmap;
S:string;
x, y: Integer;
showTime,endtime,CurrectTime: Int64);
var
i: Integer;
WordWidth, WordHeight: Integer;
WordBmp: TBitmap;
begin
for i:=0 to 10do
begin
try
//WordBmp.Canvas.Font.Size:=10;
WordHeight := Bmp.Canvas.TextHeight(S);
WordWidth := (endtime - CurrectTime) * Bmp.Canvas.TextWidth(S) div showTime;
WordBmp := TBitmap.Create;
WordBmp.PixelFormat := pf24bit;
WordBmp.Height := WordHeight+1 ;
WordBmp.Width := WordWidth+1;
WordBmp.Canvas.Lock;
WordBmp.Canvas.Font := Bmp.Canvas.Font;
WordBmp.Canvas.Brush.Color := Parent.Parent.TransColor;
WordBmp.Canvas.Rectangle(-1, -1, WordBmp.Width+1 , WordBmp.Height+1 );
WordBmp.Canvas.Brush.Style := bsClear;
DrawText(WordBmp, 0, 0, S, 2);
Bmp.Canvas.Draw(x, y, WordBmp);
WordBmp.Canvas.Unlock;
WordBmp.Free;
Break;
except
end;
end;
end;
begin
try
FFristIndex := -1;
FSecondIndex := -1;
Bmp.Width := Parent.Parent.Width;
Bmp.Height := Parent.Parent.Height;
Bmp.Canvas.Brush.Color := Parent.Parent.TransColor;
Bmp.Canvas.Rectangle(-1, -1, Bmp.Width + 1, Bmp.Height + 1);
Bmp.Canvas.Font := Parent.Parent.Font;
Count := Length(FLyricLineList) - 1;
for i := 0 to Length(FLyricLineList) - 1do
begin
if (FLyricLineList.StartTime <= CurrectTime + 4000) and
(FLyricLineList.EndTime >= CurrectTime - 1000) then
begin
if FLyricLineList.Index mod 2 <> 0 then
begin
FFristIndex := i;
if i <> 0 then
begin
if FLyricLineList[i - 1].EndTime >= CurrectTime - 4000 then
FSecondIndex := i - 1;
end;
if i < Count then
begin
if FLyricLineList[i + 1].StartTime <= CurrectTime + 4000 then
FSecondIndex := i + 1;
end;
end
else
begin
FSecondIndex := i;
if i <> 0 then
begin
if FLyricLineList[i - 1].EndTime >= CurrectTime - 4000 then
FFristIndex := i - 1;
end;
if i < Count then
begin
if FLyricLineList[i + 1].StartTime <= CurrectTime + 4000 then
FFristIndex := i + 1;
end;
end;
end;
if (FFristIndex <> -1) and (FSecondIndex <> -1) then
Break;
end;
SongType := '';
FontHeight := Bmp.Canvas.TextHeight('测试');
if FFristIndex <> -1 then
begin
if FLyricLineList[FFristIndex].Enable then
begin
if FLyricLineList[FFristIndex].SongerType = 1 then
begin
SongType := '男:';
end
else
if FLyricLineList[FFristIndex].SongerType = 2 then
begin
SongType := '女:';
end
else
if FLyricLineList[FFristIndex].SongerType = 3 then
begin
SongType := '合:';
end;
end;
mFontLeft := FontLeft + Bmp.Canvas.TextWidth(SongType);
DrawText(Bmp, FontLeft, ((Parent.Parent.Height - FontHeight*2) div 3)*
2+FontHeight+5,
SongType,
FLyricLineList[FFristIndex].SongerType);
DrawText(Bmp, mFontLeft, ((Parent.Parent.Height - FontHeight*2) div 3)*
2+FontHeight+5,
GetLyricLine(FLyricLineList[FFristIndex]), 0);
LineProgress(Bmp, FLyricLineList[FFristIndex], mFontLeft,
((Parent.Parent.Height - FontHeight*2) div 3)*
2+FontHeight+5,
CurrectTime);
end;
SongType := '';
if FSecondIndex <> -1 then
begin
if FLyricLineList[FSecondIndex].Enable then
begin
if FLyricLineList[FSecondIndex].SongerType = 1 then
begin
SongType := '男:';
end
else
if FLyricLineList[FSecondIndex].SongerType = 2 then
begin
SongType := '女:';
end
else
if FLyricLineList[FSecondIndex].SongerType = 3 then
begin
SongType := '合:';
end;
end;
FontWidth := Bmp.Canvas.TextWidth(SongType +
GetLyricLine(FLyricLineList[FSecondIndex]));
mFontLeft := Bmp.Width - FontRight - FontWidth +
Bmp.Canvas.TextWidth(SongType);
DrawText(Bmp, Bmp.Width - FontRight - FontWidth, ((Parent.Parent.Height -
FontHeight *
2) div 3) * 2 + FontHeight+40, SongType,
FLyricLineList[FSecondIndex].SongerType);
DrawText(Bmp, mFontLeft, ((Parent.Parent.Height - FontHeight * 2) div 3) *
2 +
FontHeight+40, GetLyricLine(FLyricLineList[FSecondIndex]), 0);
LineProgress(Bmp, FLyricLineList[FSecondIndex], mFontLeft,
((Parent.Parent.Height -
FontHeight * 2) div 3) * 2 + FontHeight+40, CurrectTime);
end;
if (CurrectTime>100)and(CurrectTime<10000) then
begin
if FSongName<>'' then
begin
bmp.Canvas.Font.Size:=28;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSongName) div 2),
FontHeight,FSongName,2);
end;
if FSinger<>'' then
begin
bmp.Canvas.Font.Size:=18;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSinger) div 2),
FontHeight+40,FSinger,1);
end;
end;
if (CurrectTime>10050)and(CurrectTime<10100) then
begin
if FSongName<>'' then
begin
bmp.Canvas.Font.Size:=20;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSongName) div 2),
FontHeight,FSongName,2);
end;
if FSinger<>'' then
begin
bmp.Canvas.Font.Size:=13;
DrawText(bmp,(Parent.Parent.Width div 2)-(bmp.Canvas.TextWidth(FSinger) div 2),
FontHeight+40,FSinger,1);
end;
end;
if (FLyricLineList[0].StartTime <= CurrectTime +4000)and(FLyricLineList[0].StartTime > CurrectTime+100) then
begin
Bmp.Canvas.Font.Size:=9;
bootProgress(Bmp,'●●●',FontLeft,((Parent.Parent.Height - FontHeight*2) div 3)*
2+17,1000,FLyricLineList[0].StartTime,CurrectTime);
end;
except
end;
end;
function TKSCFile.LoadFromFile(FileName: string): Boolean;
var
i, j: Integer;
Count: Integer;
function IsLyricLine(S: string): Boolean;
begin
Result := False;
if (Pos(LyricLineHead, S) > 0) and (Pos(LyricLineFoot, S) > 0) then
begin
Result := True;
end;
end;
function IsSongname(S: string): Boolean;
begin
Result:=False;
if Pos(Song_Title,S)>0 then
Result:=true;
end;
function IsSinger(S: string): Boolean;
begin
result:=False;
if Pos(Song_Singer,S)>0 then
Result:=true;
end;
function GetSongname(S : string):String;
var
lis : string;
begin
result:='';
lis :=#39+';';
if Pos(Song_Title,S)>0 then
begin
Delete(S,1,length(Song_Title));
result:=copy(S,1,pos(lis,S)-1);
end;
end;
function GetSinger(S : string):string;
var
lis : string;
begin
result:='';
lis:=#39+';';
if Pos(Song_Singer,S)>0 then
begin
Delete(S,1,length(Song_Singer));
result:=copy(S,1,pos(lis,S)-1);
end;
end;
procedure DeleteCompart(var S: string;
Count: Integer);
var
i, j: Integer;
begin
for i := 0 to Count - 1do
begin
j := Pos(LyricLineCompart, S);
if j > 0 then
begin
Delete(S, 1, j + Length(LyricLineCompart) - 1);
end;
end;
end;
function GetStartTime(S: string): string;
var
i: Integer;
begin
i := Pos(LyricLineHead, S);
if i > 0 then
begin
Delete(S, i, Length(LyricLineHead));
i := Pos(LyricLineCompart, S);
Result := Copy(S, 1, i - 1);
end;
end;
function GetEndTime(S: string): string;
var
i: Integer;
begin
DeleteCompart(S, 1);
i := Pos(LyricLineCompart, S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
end;
end;
function GetLyricString(S: string): string;
var
i: Integer;
begin
DeleteCompart(S, 2);
i := Pos(LyricLineCompart, S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
end;
end;
function GetLyricTime(S: string): string;
var
i: Integer;
begin
DeleteCompart(S, 3);
i := Pos(LyricLineFoot, S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
end;
end;
function GetPyString(S: string): string;
var
HzStr: string;
i: Integer;
begin
HzStr := S;
while HzStr <> ''do
begin
if HzStr[1] = '[' then
begin
i := Pos(']', HzStr);
Result := Result + Copy(HzStr, 0, i);
HzStr := Copy(HzStr, i + 1, Length(HzStr) - 1);
end
else
if (ord(HzStr[1]) >= 33) and (ord(HzStr[1]) <= 126) then
begin
Result := Result + '[' + Copy(HzStr, 0, 1) + ']';
HzStr := Copy(HzStr, 2, Length(HzStr) - 1);
end
else
if Ord(HzStr[1]) > 127 then
begin
Result := Result + '[' + Copy(HzStr, 0, 2) + ']';
HzStr := Copy(HzStr, 3, Length(HzStr) - 2);
end;
end;
Result := Copy(Result, 0, Length(Result) + 1);
end;
function GetHeadFootStr(var S: string): string;
var
i, j: Integer;
begin
i := Pos(WordHead, S);
if (i > 0) then
begin
Delete(S, 1, i + Length(WordHead) - 1);
j := Pos(WordFoot, S);
if j > 0 then
begin
Result := Copy(S, 1, j - 1);
Delete(S, 1, j + Length(WordFoot) - 1);
end;
end;
end;
function GetTitleStr(var S: string): string;
var
i: Integer;
begin
i := Pos('''', S);
if (i > 0) then
begin
Delete(S, 1, i);
end;
i := Pos('''', S);
if (i > 0) then
begin
Result := Copy(S, 1, i - 1);
Delete(S, 1, i);
end;
end;
function GetTime(s: string): DWord;
var
p1, p2: Integer;
iMin, iSec, iMs: Integer;
begin
p1 := pos(':', s);
p2 := pos('.', s);
iMin := StrToIntDef(Copy(s, 1, p1 - 1), 0);
iSec := StrToIntDef(Copy(s, p1 + 1, p2 - p1 - 1), 0);
iMs := StrToIntDef(Copy(s, p2 + 1, Length(s) - p2), 0);
Result := (iMin * 60 + iSec) * 1000 + iMs;
end;
function GetMilliSecondStr(var S: string): string;
var
i: Integer;
begin
i := Pos(',', S);
if i > 0 then
begin
Result := Copy(S, 1, i - 1);
Delete(S, 1, i);
end;
end;
function LoadLyricLine(S: string;
var LyricLine: TLyricLine): Boolean;
var
i, Count, CountOut: Integer;
LyricString: string;
LyricTime: string;
SongerType: Integer;
begin
Result := True;
try
if (Pos(LyricLineHead, S) > 0) and (Pos(LyricLineFoot, S) > 0) then
begin
LyricLine.LyricWordList := nil;
LyricLine.StartTime := GetTime(GetStartTime(S));
LyricLine.EndTime := GetTime(GetEndTime(S));
LyricString := GetLyricString(S);
LyricTime := GetLyricTime(S);
SongerType := 0;
i := Pos(SongerMan, LyricString);
if i > 0 then
begin
SongerType := 1;
Delete(LyricString, 1, Length(SongerMan));
end;
i := Pos(SongerWoman, LyricString);
if i > 0 then
begin
SongerType := 2;
Delete(LyricString, 1, Length(SongerWoman));
end;
i := Pos(SongerOther, LyricString);
if i > 0 then
begin
SongerType := 3;
Delete(LyricString, 1, Length(SongerOther));
end;
LyricLine.SongerType := SongerType;
if LyricLine.SongerType <> 0 then
LyricLine.Enable := True;
LyricString := GetPyString(LyricString);
Count := 0;
CountOut := 0;
while not (Length(LyricString) = 0)do
begin
Inc(CountOut);
if CountOut > 999 then
begin
Result := False;
Exit;
end;
if Pos(WordHead, LyricString) > 0 then
begin
Inc(Count);
SetLength(LyricLine.LyricWordList, Count);
LyricLine.LyricWordList[Count - 1].Title :=
GetHeadFootStr(LyricString);
if (Count - 1) = 0 then
begin
LyricLine.LyricWordList[Count - 1].StartTime :=
LyricLine.StartTime;
end
else
begin
LyricLine.LyricWordList[Count - 1].StartTime :=
LyricLine.LyricWordList[Count - 2].StopTime;
end;
LyricLine.LyricWordList[Count - 1].CountTime :=
StrToInt(GetMilliSecondStr(LyricTime));
LyricLine.LyricWordList[Count - 1].StopTime :=
LyricLine.LyricWordList[Count - 1].StartTime +
LyricLine.LyricWordList[Count - 1].CountTime;
end;
{else
if Pos('''', LyricString) > 0 then
begin
Inc(Count);
SetLength(LyricLine.LyricWordList, Count);
LyricLine.LyricWordList[Count - 1].Title := GetTitleStr(LyricString);
if (Count - 1) = 0 then
begin
LyricLine.LyricWordList[Count - 1].StartTime := LyricLine.StartTime;
end
else
begin
LyricLine.LyricWordList[Count - 1].StartTime := LyricLine.LyricWordList[Count - 2].StopTime;
end;
LyricLine.LyricWordList[Count - 1].CountTime := StrToInt(GetMilliSecondStr(LyricTime));
LyricLine.LyricWordList[Count - 1].StopTime := LyricLine.LyricWordList[Count - 1].StartTime + LyricLine.LyricWordList[Count - 1].CountTime;
end;
}
end;
end;
except
Result := False;
end;
end;
begin
Result := True;
if not FileExists(FileName) then
begin
Result := False;
Exit;
end;
// FLyricLineList := nil;
SetLength(FLyricLineList, 0);
FFileStrings.Clear;
FFileStrings.LoadFromFile(FileName);
Count := 0;
for i := 0 to FFileStrings.Count - 1do
begin
if IsSongname(FFileStrings.Strings) then
FSongName:=GetSongName(FFileStrings.Strings);
IF IsSinger(FFileStrings.Strings) then
FSinger:=GetSinger(FFileStrings.Strings);
if IsLyricLine(FFileStrings.Strings) then
begin
Inc(Count);
end;
end;
SetLength(FLyricLineList, Count);
Count := 0;
for i := 0 to FFileStrings.Count - 1do
begin
if IsLyricLine(FFileStrings.Strings) then
begin
if not LoadLyricLine(FFileStrings.Strings, FLyricLineList[Count]) then
begin
Result := False;
Exit;
end;
Inc(Count);
end;
end;
j := 0;
for i := 0 to Length(FLyricLineList) - 1do
begin
FLyricLineList.Index := i + 1;
if FLyricLineList.SongerType <> 0 then
begin
j := FLyricLineList.SongerType;
end
else
if FLyricLineList.SongerType = 0 then
begin
FLyricLineList.SongerType := j;
end;
end;
end;
constructor TKSCFile.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFileName := '';
FLyricLineList := nil;
FFileStrings := TStringList.Create;
FFristIndex := -1;
FSecondIndex := -1;
end;
destructor TKSCFile.Destroy;
begin
FreeMem(FLyricLineList);
FFileStrings.Free;
inherited Destroy;
end;
procedure TKSCFile.SetFileName(Value: string);
begin
if LoadFromFile(Value) then
begin
FFileName := Value;
end
else
begin
FFileName := '';
end;
end;
procedure TKSCShowFilter.SetParent(AParent: TKSCShow);
begin
FParent := AParent;
end;
function TKSCShowFilter.GetFileName: string;
begin
Result := FKSCFile.FileName;
end;
procedure TKSCShowFilter.SetFileName(Value: string);
begin
FKSCFile.FileName := Value;
end;
function TKSCShowFilter.CheckInputType(mtIn: PAMMediaType): HRESULT;
begin
if not IsEqualGUID(mtIn^.majortype, MEDIATYPE_Video) then
begin
Result := VFW_E_INVALIDMEDIATYPE;
Exit;
end;
if not IsEqualGUID(mtIn^.subtype, MEDIASUBTYPE_RGB24) then
begin
Result := VFW_E_INVALIDSUBTYPE;
Exit;
end;
if not IsEqualGUID(mtIn^.formattype, FORMAT_VideoInfo) then
begin
Result := VFW_E_TYPE_NOT_ACCEPTED;
Exit;
end;
Result := S_OK;
end;
constructor TKSCShowFilter.Create(ObjName: string;
unk: IUnKnown;
out hr:
HRESULT);
var
pmt: PAMMediaType;
begin
inherited Create(ObjName, unk, CLSID_KSCShow, hr);
FThisInstance := InterlockedIncrement(InstanceCount);
pmt := @FPreferred;
TBCMediaType(pmt).InitMediaType;
FKSCShowLock := TBCCritSec.Create;
FMediaSeeking := nil;
FKSCFile := TKSCFile.Create(nil);
FKSCFile.Parent := Self;
FBitmap := TBitmap.Create;
FBitmap.PixelFormat := pf24bit;
FWidth := 0;
end;
constructor TKSCShowFilter.CreateFromFactory(Factory: TBCClassFactory;
const
Controller:
IUnknown);
var
hr: HRESULT;
begin
Create(Factory.Name, Controller, hr);
end;
destructor TKSCShowFilter.Destroy;
begin
FBitmap.Free;
FKSCShowLock.Free;
inherited;
end;
function TKSCShowFilter.Transform(Sample: IMediaSample): HRESULT;
var
MlsCurrentPos, MlsStopPos: Cardinal;
i, j: Integer;
P: PByteArray;
VideoInfo: PVideoInfo;
CurrectTime: Int64;
CurrectColor: TColor;
begin
Result := S_OK;
FKSCShowLock.Lock;
if not Parent.Enabled then
begin
Exit;
end;
VideoInfo := FInput.CurrentMediaType.MediaType.pbFormat;
Sample.GetPointer(FVideoBuffer);
Parent.GetMediaTime(MlsCurrentPos, MlsStopPos);
CurrectTime := (StrToInt(FormatDateTime('nn', MlsCurrentPos / MiliSecPerDay))
* 60 +
StrToInt(FormatDateTime('ss', MlsCurrentPos / MiliSecPerDay))) * 1000 +
StrToInt(FormatDateTime('zzz', MlsCurrentPos / MiliSecPerDay));
FWidth := VideoInfo.bmiHeader.biWidth;
FBitmap.Canvas.Lock;
FKSCFile.GetCurrectLyric(FBitmap, CurrectTime);
if Assigned(Parent.FDrawEvent) then
begin
Parent.FDrawEvent(Parent, FBitmap);
end;
for j := 0 to Parent.Height - 1do
begin
P := FBitmap.ScanLine[Parent.Height - j - 1];
for i := 0 to FBitmap.Width - 1do
begin
CurrectColor := RGB(P[i * 3], P[i * 3 + 1], P[i * 3 + 2]);
if CurrectColor <> Parent.TransColor then
begin
PByte(Integer(FVideoBuffer) + j * FWidth * 3 + i * 3)^ := P[i * 3];
PByte(Integer(FVideoBuffer) + j * FWidth * 3 + i * 3 + 1)^ := P[i * 3 +
1];
PByte(Integer(FVideoBuffer) + j * FWidth * 3 + i * 3 + 2)^ := P[i * 3 +
2];
end;
end;
end;
FBitmap.Canvas.Unlock;
FKSCShowLock.UnLock;
end;
function TKSCShow.GetFilter: IBaseFilter;
begin
Result := FBaseFilter;
end;
function TKSCShow.GetName: string;
begin
Result := Name_KSCShow;
end;
procedure TKSCShow.NotifyFilter(operation: TFilterOperation;
Param: integer =
0);
begin
case operation of
foAdding:
begin
CreateFilter;
FBaseFilter := FFilter as IBaseFilter;
end;
foAdded:
begin
UpdateTimer(FIntervald);
end;
foRemoving: if FFilter <> nil then
FFilter.Stop;
foRemoved:
begin
FFilter := nil;
FBaseFilter := nil;
FMediaSeeking := nil;
end;
foRefresh: if Assigned(FVideoFilterGraph) then
begin
TKSCShowFilterGraph(FVideoFilterGraph).RemoveFilter(self);
TKSCShowFilterGraph(FVideoFilterGraph).InsertFilter(self);
end;
end;
end;
procedure TKSCShow.SetFilterGraph(AFilterGraph: TFilterGraph);
begin
if AFilterGraph = FVideoFilterGraph then
Exit;
if FVideoFilterGraph <> nil then
TKSCShowFilterGraph(FVideoFilterGraph).RemoveFilter(self);
if AFilterGraph <> nil then
TKSCShowFilterGraph(AFilterGraph).InsertFilter(self);
FVideoFilterGraph := AFilterGraph;
end;
procedure TKSCShow.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if ((AComponent = FVideoFilterGraph) and (Operation = opRemove)) then
FVideoFilterGraph := nil;
end;
procedure TKSCShow.GetMediaTime(var CurrentPos, StopPos: Cardinal);
begin
CurrentPos := FCurrentPos;
StopPos := FStopPos;
end;
procedure TKSCShow.Timer;
var
hCurrentPos, hStopPos: Int64;
begin
if FMusicFilterGraph = nil then
begin
Exit;
end;
if not FEnabled then
begin
Exit;
end;
if not assigned(FMediaSeeking) then
begin
FMusicFilterGraph.QueryInterface(IMediaSeeking, FMediaSeeking);
end;
if assigned(FMediaSeeking) then
begin
if Succeeded(FMediaSeeking.GetDuration(hStopPos)) then
if Succeeded(FMediaSeeking.GetCurrentPosition(hCurrentPos)) then
begin
FCurrentPos := RefTimeToMiliSec(hCurrentPos);
FStopPos := RefTimeToMiliSec(hStopPos);
end;
end;
end;
function TKSCShow.GetIntervald: Integer;
begin
Result := FIntervald;
end;
procedure TKSCShow.SetInterval(Value: Integer);
begin
FIntervald := Value;
UpdateTimer(FIntervald);
end;
function TKSCShow.GetFileName: string;
begin
Result := FFilter.FileName;
end;
procedure TKSCShow.SetFileName(Value: string);
begin
FFilter.FileName := Value;
end;
procedure TKSCShow.SetFont(Value: TFont);
begin
if FFont = Value then
Exit;
FFont.Assign(Value);
end;
procedure TKSCShow.SetTransColor(Value: TColor);
begin
if FTransColor = Value then
Exit;
FTransColor := Value;
end;
procedure TKSCShow.SetFirstColor(Value: TColor);
begin
if FFirstColor = Value then
Exit;
FFirstColor := Value;
end;
procedure TKSCShow.SetSecondColor(Value: TColor);
begin
if FSecondColor = Value then
Exit;
FSecondColor := Value;
end;
procedure TKSCShow.SetThirdColor(Value: TColor);
begin
if FThirdColor = Value then
Exit;
FThirdColor := Value;
end;
function TKSCShow.GetEnabled: Boolean;
begin
Result := FEnabled;
end;
procedure TKSCShow.SetEnabled(Value: Boolean);
begin
FEnabled := Value;
end;
procedure TKSCShow.SetHeight(Value: Integer);
begin
if FHeight = Value then
Exit;
FHeight := Value;
end;
function TKSCShow.GetWidth: Integer;
begin
Result := 0;
if FFilter <> nil then
Result := FFilter.Width;
end;
function TKSCShow.CreateFilter: HResult;
var
hr: HRESULT;
begin
if FFilter = nil then
begin
FFilter := TKSCShowFilter.Create(Name, nil, hr);
FFilter.Parent := Self;
end;
Result := hr;
end;
constructor TKSCShow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(TimerWndProc);
FIntervald := 25;
FEnabled := True;
UpdateTimer(FIntervald);
FTransColor := clFuchsia;
FFirstColor := clBlue;
FSecondColor := clRed;
FThirdColor := clGreen;
FFont := TFont.Create;
FFont.Size := 20;
FFont.Style := [fsBold];
FHeight := 200;
CreateFilter;
FBaseFilter := FFilter as IBaseFilter;
end;
destructor TKSCShow.Destroy;
begin
FFont.Free;
FVideoFilterGraph := nil;
FMusicFilterGraph := nil;
DeallocateHWnd(FWindowHandle);
FMediaSeeking := nil;
inherited Destroy;
end;
function TKSCShow.QueryInterface(const IID: TGUID;
out Obj): HResult;
begin
Result := inherited QueryInterface(IID, Obj);
if not Succeeded(Result) then
if Assigned(FFilter) then
begin
Result := FFilter.QueryInterface(IID, Obj);
end;
end;
procedure TKSCShow.TimerWndProc(var Msg: TMessage);
begin
with Msgdo
if Msg = WM_TIMER then
try
Timer;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TKSCShow.UpdateTimer(Value: Integer);
begin
KillTimer(FWindowHandle, 1);
if SetTimer(FWindowHandle, 1, Value, nil) = 0 then
raise EOutOfResources.Create(SNoTimers);
end;
end.
X
xingkong97
Unregistered / Unconfirmed
GUEST, unregistred user!
其实你已经很用功了，作为爱好者能这么下功夫确实难得，看来你确实对编程很感兴趣。
这样吧，我尽快帮你解决。不过你要等等，呵呵。。。。。。
这样吧，我尽快帮你解决。不过你要等等，呵呵。。。。。。
