要如何直接在記憶體內播放avi檔呢? |
|
尚未結案
|
|
Chenbc
一般會員   發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
|
|
anpino
版主  發表：31 回覆：477 積分：231 註冊：2003-01-02 發送簡訊給我 |
|
|
Chenbc
一般會員 發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
anpino 您好,
有找到地方,只是程式是Delphi寫的而我用的是Builder...@_@"
是否有地方可以找到Builder6.0的範例可參考.
順便把程式列出給有興趣的人看;如果有人會改成Builder用的來分享就更好了.
---------------------------------------------
unit AVICtrl; interface { TAVIControl V 0.9b Programmed by Andrea Molino
easytarg@mbox.vol.it
} uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, CommCtrl; Type
TAVIControlState = (acsClose, acsOpen, acsPlay);
TAVIControlError = (acrOK, acrOpenFailed, acrPlayFailed, acsSeekFailed); TAVIControl = class(TWinControl)
private
FAVIState: TAVIControlState;
FAVIName: String;
FFrameFrom: SmallInt;
FFrameTo: SmallInt;
FFrameSeek: SmallInt;
FAutoSize: Boolean;
FAutoRepeat: Boolean;
FLastOpStatus: TAVIControlError;
FAux: String;
Procedure SetAVIState(Val: TAVIControlState);
Procedure SetAVIName(Val: String);
Procedure SetFrameFrom(Val: SmallInt);
Procedure SetFrameTo(Val: SmallInt);
Procedure SetFrameSeek(Val: SmallInt);
Procedure SetAutoSize(Val: Boolean);
Procedure SetAutoRepeat(Val: Boolean);
Function GetLastOpStatus: String;
protected
procedure CreateParams(var Params: TCreateParams); Override;
procedure CreateWnd; Override;
public
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Function Open(FileName: String): Boolean;
Procedure Close;
Function Play(FName: String; RepCount: SmallInt): Boolean;
Function Seek(Frame: SmallInt): Boolean;
Procedure Stop;
published
Property AVIState: TAVIControlState Read FAVIState Write SetAVIState Default acsClose;
Property AVIName: String Read FAVIName Write SetAVIName;
Property FrameFrom: SmallInt Read FFrameFrom Write SetFrameFrom Default 0;
Property FrameTo: SmallInt Read FFrameTo Write SetFrameTo Default -1;
Property FrameSeek: SmallInt Read FFrameSeek Write SetFrameSeek Default 0;
Property AutoSize: Boolean Read FAutoSize Write SetAutoSize Default False;
Property AutoRepeat: Boolean Read FAutoRepeat Write SetAutoRepeat Default True;
Property ZStatus: String Read GetLastOpStatus Write FAux;
property Align;
property Enabled;
property PopupMenu;
property ShowHint;
property Visible;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end; procedure Register; implementation Constructor TAVIControl.Create(AOwner: TComponent);
Begin
inherited Create(AOwner);
ControlStyle := ControlStyle -[csSetCaption];
FAVIState := acsClose;
FFrameFrom := 0;
FFrameTo := -1;
FAutoSize := False;
FAutoRepeat := True;
FLastOpStatus := acrOK;
Width := 30;
Height := 30;
End; Destructor TAVIControl.Destroy;
Begin
Inherited Destroy;
End; procedure TAVIControl.CreateParams(var Params: TCreateParams);
begin
{ACS_AUTOPLAY - Starts playing the animation as soon as the animation clip is opened.
ACS_CENTER - Centers the animation in the animation control's window.
ACS_TRANSPARENT - Draws the animation using a transparent background rather than
the background color specified in the animation clip.}
InitCommonControls;
Inherited CreateParams(Params);
CreateSubClass(Params, 'SysAnimate32');
With Params do
Begin
Style := Style Or ACS_TRANSPARENT;
If Not FAutoSize Then Style := Style Or ACS_CENTER;
End;
end; procedure TAVIControl.CreateWnd;
begin
Inherited CreateWnd;
If FAVIState = acsOpen Then Open(FAVIName);
If FAVIState = acsPlay Then
Begin
Open(FAVIName);
Play('', 0);
End;
end; Procedure TAVIControl.SetAVIState(Val: TAVIControlState);
Begin
If Val <> FAVIState Then
Begin
FAVIState := Val;
Case FAVIState Of
acsOpen : Begin
Open(FAVIName)
End;
acsPlay : Begin
Open(FAVIName);
Play('', 0);
End;
acsClose: Close;
End;
End;
End; Procedure TAVIControl.SetAVIName(Val: String);
Var
FTmpState: TAVIControlState;
Begin
If Val <> FAVIName Then
Begin
FAVIName := Val;
FTmpState := FAVIState;
Close;
If FTmpState = acsOpen Then Open(FAVIName);
If FTmpState = acsPlay Then Play('', 0);
End;
End; Procedure TAVIControl.SetFrameFrom(Val: SmallInt);
Begin
If Val <> FFrameFrom Then
Begin
FFrameFrom := Val;
If FAVIState = acsPlay Then Play('', 0);
End;
End; Procedure TAVIControl.SetFrameTo(Val: SmallInt);
Begin
If Val <> FFrameTo Then
Begin
FFrameTo := Val;
If FAVIState = acsPlay Then Play('', 0);
End;
End; Procedure TAVIControl.SetFrameSeek(Val: SmallInt);
Begin
If Val <> FFrameSeek Then
Begin
FFrameSeek := Val;
Seek(FrameSeek);
End;
End; Procedure TAVIControl.SetAutoSize(Val: Boolean);
Begin
If Val <> FAutoSize Then
Begin
FAutoSize := Val;
RecreateWnd;
End;
End; Procedure TAVIControl.SetAutoRepeat(Val: Boolean);
Begin
If Val <> FAutoRepeat Then
Begin
FAutoRepeat := Val;
If FAVIState = acsPlay Then Play('', 0);
End;
End; Function TAVIControl.GetLastOpStatus: String;
Begin
Case FLastOpStatus Of
acrOK : Result := 'OK';
acrOpenFailed: Result := 'Open Failed';
acrPlayFailed: Result := 'Play Failed';
End;
End; Function TAVIControl.Open(FileName: String): Boolean;
Var
Res: LongInt;
Begin
FLastOpStatus := acrOK;
If FAVIState <> acsClose Then Close;
Res := SendMessage(Handle, ACM_OPEN, 0, LongInt(PChar(FileName)));
FAVIName := FileName;
If Res <> 0 Then FAVIState := acsOpen
Else FLastOpStatus := acrOpenFailed;
Result := (Res <> 0);
End; Procedure TAVIControl.Close;
Var
Res: LongInt;
Begin
FLastOpStatus := acrOK;
Res := SendMessage(Handle, ACM_OPEN, 0, 0);
FAVIState := acsClose;
Repaint;
End; Function TAVIControl.Seek(Frame: SmallInt): Boolean;
Var
Res: LongInt;
Begin
FLastOpStatus := acrOK;
If FAVIState = acsClose Then Open(FAVIName)
Else If FAVIState = acsPlay Then Stop;
If FAVIState <> acsClose Then
Begin
Res := SendMessage(Handle, ACM_PLAY, 1, MAKELONG(Frame, Frame));
If Res = 0 Then FLastOpStatus := acsSeekFailed;
Result := (Res <> 0);
End
Else Result := False;
End; Function TAVIControl.Play(FName: String; RepCount: SmallInt): Boolean;
Var
Res: LongInt;
Rep: SmallInt;
Begin
FLastOpStatus := acrOK;
If FName = '' Then Open(FAVIName)
Else Open(FName);
If FAVIState <> acsClose Then
Begin
If FAutoRepeat And (RepCount = 0) Then Rep := -1
Else If RepCount = 0 Then Rep := 1
Else Rep := RepCount;
Res := SendMessage(Handle, ACM_PLAY, Rep, MAKELONG(FFrameFrom, FFrameTo));
If (Res <> 0) And FAutoRepeat Then FAVIState := acsPlay
Else FLastOpStatus := acrPlayFailed;
Result := (Res <> 0);
End
Else Result := False;
End; Procedure TAVIControl.Stop;
Var
Res: LongInt;
Begin
FLastOpStatus := acrOK;
If FAVIState <> acsClose Then
Begin
Res := SendMessage(Handle, ACM_PLAY, 0, MAKELONG(0, 0));
If FAVIState = acsPlay Then FAVIState := acsOpen;
End;
End; procedure Register;
begin
RegisterComponents('MyGold', [TAVIControl]);
end; end. 發表人 - chenbc 於 2004/01/10 16:57:02
|
|
anpino
版主 發表：31 回覆：477 積分：231 註冊：2003-01-02 發送簡訊給我 |
我幫你轉一部分, 剩下的只要比照原來的程式碼改就可以了。
前面有"//"的部分是原來的DELPHI語法，接著是轉成的BCB語法。
//unit AVICtrl;
#include "AVICtrl.h"
/*
interface { TAVIControl V 0.9b Programmed by Andrea Molino
easytarg@mbox.vol.it
}*/ //uses
// Windows, Messages, SysUtils, Classes, Graphics, Controls, CommCtrl;
#include |
|
Chenbc
一般會員 發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
|
|
anpino
版主 發表：31 回覆：477 積分：231 註冊：2003-01-02 發送簡訊給我 |
|
|
Chenbc
一般會員 發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
|
|
anpino
版主 發表：31 回覆：477 積分：231 註冊：2003-01-02 發送簡訊給我 |
|
|
arisaka_matsuri
高階會員 發表：25 回覆：205 積分：231 註冊：2003-10-19 發送簡訊給我 |
|
|
Chenbc
一般會員 發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
|
|
anpino
版主 發表：31 回覆：477 積分：231 註冊：2003-01-02 發送簡訊給我 |
您好, 讀到記憶體中可以用TMemoryStream。
|
|
Chenbc
一般會員 發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
|
|
anpino
版主 發表：31 回覆：477 積分：231 註冊：2003-01-02 發送簡訊給我 |
引言: Anpino您好,過年了還看到您真是高興. 這幾天還在找資料這題的得分是非您莫屬了不過尚未完美解出, 請問如何用TMemoryStream來播放avi呢? 指教指教. 新年快樂.抱歉... 因為在飆專案, 所以農曆年後一陣子沒來。 謝謝您的祝福, 其實新年非常忙碌...忙著在方城之戰廝殺...(<-- 踢飛 XD||| "如何用TMemoryStream來播放avi" 這問題...(在下真的對avi很不熟^^;;), MSDN有現成的example可參考: 1.Playing the AVI File http://msdn.microsoft.com/library/default.asp?url=/library/en-us/multimed/htm/_win32_playing_the_avi_file.asp 2.Opening Streams in an AVI File and Closing the File http://msdn.microsoft.com/library/default.asp?url=/library/en-us/multimed/htm/_win32_opening_streams_in_an_avi_file_and_closing_the_file.asp 其中所用的avi stream 可以用TMemoryStream代替。< > 也祝您今年平安順心.< > ------------------------------- 數學系是內功很強(邏輯/分析) 資工系是招式很多(程式技巧) 就像令狐沖VS東方不敗 Programmers Guide http://anpino.begin.8d8d.com |
|
Chenbc
一般會員 發表：31 回覆：33 積分：12 註冊：2004-01-06 發送簡訊給我 |
發表時間：2004-01-09 21:23:50
IP:61.59.xxx.xxx 未訂閱
系統時間：2025-02-26 5:20:05
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |