请问各位大侠怎样实现vcd全屏?(0分)

  • 主题发起人 主题发起人 loveflying
  • 开始时间 开始时间
L

loveflying

Unregistered / Unconfirmed
GUEST, unregistred user!
请问各位大侠怎样实现vcd全屏?
 
用超级解霸2001
 
那要看你用什么方法播放
 
用mediaplayer实现!
 
Add a MediaPlayer(MediaPlayer1) to a form (named Form1), and also create a new
Form( as Form2, without border,and set to MAX Size ).
MediaPlayer1.FileName:='';
MediaPlayer.DisplayRect:=Form2.ClientRect;
......
....................
..
 
建议你使用Windows所提供的TActiveMovie控件实现,很容易
 
{ 本程序用一个巧妙的方法实现局部网视频文件播放,
原理是利用Windows的隐形共享.
程序未作错误处理,请根据需要作相应修改.
作者:陈经韬.2001.
Home:http://Lovejingtao.126.com
Email:Lovejingtao@21cn.com
}
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ComCtrls, StdCtrls, Shellapi, MPlayer, Registry, MmSystem, ExtCtrls, ScktComp;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
NFile: TMenuItem;
N_OpenFile: TMenuItem;
N_Receive: TMenuItem;
N_CloseFile: TMenuItem;
N2: TMenuItem;
N_EjOpen: TMenuItem;
N_EjClose: TMenuItem;
N3: TMenuItem;
N_Exit: TMenuItem;
Contrl1: TMenuItem;
N_Play: TMenuItem;
N_Repeat: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
Help1: TMenuItem;
N_About: TMenuItem;
StatusBar1: TStatusBar;
ProgressBar1: TProgressBar;
TrackBar1: TTrackBar;
BtnPlay: TButton;
BtnPause: TButton;
BtnStop: TButton;
BtnSetp: TButton;
BtnBack: TButton;
OpenDialog1: TOpenDialog;
N_Pause: TMenuItem;
N_Stop: TMenuItem;
N_Step: TMenuItem;
N_Back: TMenuItem;
N10: TMenuItem;
N_Send: TMenuItem;
MediaPlayer1: TMediaPlayer;
Timer1: TTimer;
N_44100: TMenuItem;
N_22050: TMenuItem;
N12: TMenuItem;
N_Stereo: TMenuItem;
N_Left: TMenuItem;
N_Right: TMenuItem;
N_Maxinzim: TMenuItem;
N_Normal: TMenuItem;
ServerSocket1: TServerSocket;
ClientSocket1: TClientSocket;
PopupMenu1: TPopupMenu;
Full1: TMenuItem;
Window1: TMenuItem;
CheckBox1: TCheckBox;
N4: TMenuItem;
Play1: TMenuItem;
Pause1: TMenuItem;
Stop1: TMenuItem;
Step1: TMenuItem;
Back1: TMenuItem;
procedure ProgressBar1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure ProgressBar1MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure ProgressBar1MouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure N_OpenFileClick(Sender: TObject);
procedure BtnSetpClick(Sender: TObject);
procedure BtnBackClick(Sender: TObject);
procedure BtnPlayClick(Sender: TObject);
procedure BtnPauseClick(Sender: TObject);
procedure BtnStopClick(Sender: TObject);
procedure N_EjOpenClick(Sender: TObject);
procedure N_EjCloseClick(Sender: TObject);
procedure N_ExitClick(Sender: TObject);
procedure N_44100Click(Sender: TObject);
procedure N_22050Click(Sender: TObject);
procedure N_RepeatClick(Sender: TObject);
procedure N_MaxinzimClick(Sender: TObject);
procedure N_NormalClick(Sender: TObject);
procedure N_StereoClick(Sender: TObject);
procedure N_LeftClick(Sender: TObject);
procedure N_RightClick(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure N_SendClick(Sender: TObject);
procedure N_ReceiveClick(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
procedure N_PlayClick(Sender: TObject);
procedure N_PauseClick(Sender: TObject);
procedure N_StopClick(Sender: TObject);
procedure N_StepClick(Sender: TObject);
procedure N_BackClick(Sender: TObject);
procedure N_CloseFileClick(Sender: TObject);
procedure N_AboutClick(Sender: TObject);
procedure Full1Click(Sender: TObject);
procedure Window1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure Play1Click(Sender: TObject);
procedure Pause1Click(Sender: TObject);
procedure Stop1Click(Sender: TObject);
procedure Step1Click(Sender: TObject);
procedure Back1Click(Sender: TObject);
private
Scrolling: Boolean;
{滚动条}
Form2Height, Form2Width: integer;
{保存Form2的位置,否则Form2会越来越小}
procedure DisplayMaximize;
procedure DisplayNormal;
function My_ComputerName: string;
procedure WriteMciConfig;
procedure My_ShareNetFile;
procedure WMDropFiles(var Msg: TWMDropFiles);
message WM_DROPFILES;
//文件拖放
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;
ShareFile: string;
{网络共享播放文件路径名称}
implementation

uses Unit2, My_Share;

{$R *.DFM}

procedure TForm1.ProgressBar1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin

Scrolling := True;
Progressbar1.Position := Round((progressbar1.max / progressbar1.Width) * x);
end;


procedure TForm1.ProgressBar1MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin

if Scrolling then

progressbar1.Position := Round((progressbar1.max / progressbar1.Width) * x);
end;


procedure TForm1.ProgressBar1MouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
var
ProBarVal, SoundVal: longint;
begin

// remote.Songpos:=round((remote.SongLength/progressbar1.Width)*x)*1000;
Scrolling := False;
ProBarVal := ProgressBar1.Position;
SoundVal := (ProBarVal shl 8) or (ProBarVal shl 24);
waveoutsetvolume(0, SoundVal);
end;


procedure TForm1.WriteMciConfig;
{定义一个过程,向ini文件写一些配置信息,
以便系统能调用相应驱动程序来播放文件,
注意:如果不这样做Mediaplay控件打开某
些扩展名的文件时会发生什么MCI初始化
错误,很多人相信已经吃过这个苦头}
begin

WritePrivateProfileString('mci extensions', 'mpg', 'MPEGVideo', 'win.ini');
WritePrivateProfileString('mci extensions', 'dat', 'MPEGVideo', 'win.ini');
WritePrivateProfileString('mci extensions', 'mpv', 'MPEGVideo', 'win.ini');
WritePrivateProfileString('mci extensions', 'mpeg', 'MPEGVideo', 'win.ini');
WritePrivateProfileString('mci extensions', 'cjt', 'MPEGVideo', 'win.ini');
WritePrivateProfileString('mci extensions', 'avi', 'AVIVideo', 'win.ini');
WritePrivateProfileString('mci', 'MPEGVideo', 'mciqtz.drv', 'system.ini');
WritePrivateProfileString('网络多媒体播放器', '作者', '陈经韬', 'netplay.ini');
WritePrivateProfileString('网络多媒体播放器', '版本', '演示版', 'netplay.ini');
end;


procedure TForm1.FormCreate(Sender: TObject);
var
SoundPostion: Longint;
begin

Application.Title := '网络多媒体播放器';
StatusBar1.SimplePanel := True;
N_Repeat.Checked := False;
N_Send.
Checked := True;
ServerSocket1.Port := 8888;
ServerSocket1.Active := True;
N_44100.Checked := True;
N_Stereo.Checked := True;
Form2Height := 248;
Form2Width := 388;
Timer1.Enabled := False;
TrackBar1.Enabled := False;


WaveOutGetVolume(0, @SoundPostion);
{取当前音量状态发给音量控制}
ProgressBar1.Min := 0;
ProgressBar1.Max := 255;
ProgressBar1.Position := Hi(SoundPostion);
MediaPlayer1.Visible := False;
WriteMciConfig;
DragAcceptFiles(Handle, True);
{接收文件拖放}
if ParamCount > 0 then

begin
{ 有执行参数传入 }
MediaPlayer1.FileName := ParamStr(1);
MediaPlayer1.Open;
MediaPlayer1.Play;
My_ShareNetFile;
end;

end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin

// Caption := TimeToStr(now);
if MediaPlayer1.Mode = MpPlaying then

begin

MediaPlayer1.TimeFormat := TFmilliSeconds;
TrackBar1.Max := MediaPlayer1.Length div 1000;
TrackBar1.Position := MediaPlayer1.Position div 1000;
if Form2.WindowState = wsMaximized then

Screen.Cursor := crNone {全屏幕播放时隐藏鼠标}
else

Screen.Cursor := crArrow;
end;

end;


procedure TForm1.TrackBar1Change(Sender: TObject);
begin

case MediaPlayer1.Mode of
mpplaying:
begin

MediaPlayer1.position := TrackBar1.Position * 1000;
MediaPlayer1.play;
end;

mppaused:
begin

MediaPlayer1.Position := TrackBar1.Position * 1000;
MediaPlayer1.Play;
MediaPlayer1.Pause;
end;

mpstopped:
begin

MediaPlayer1.Position := TrackBar1.Position * 1000;
MediaPlayer1.Play;
MediaPlayer1.Stop;
end;

end;

end;


procedure TForm1.N_OpenFileClick(Sender: TObject);
begin

OpenDialog1.Title := '请选择视频文件';
OpenDialog1.Filter := '视频文件(*.mpg;*.mpeg;*.dat;*.avi)|*.mpg;*.mpeg;*.dat;*.avi|所有文件[*.*]|*.*';
if OpenDialog1.Execute then

begin

MediaPlayer1.FileName := OpenDialog1.FileName;
MediaPlayer1.Display := Form2.Panel1;
MediaPlayer1.Shareable := True;
MediaPlayer1.Open;
MediaPlayer1.DisplayRect := Form2.Panel1.ClientRect;
Form2.Show;
MediaPlayer1.Play;
My_ShareNetFile;
end;

end;


procedure TForm1.BtnSetpClick(Sender: TObject);
begin

try
{如果正处于播放状态则跳进后继续播放,否则跳进后不播放 }
if MediaPlayer1.Mode = mpPlaying then

begin

MediaPlayer1.Step;
MediaPlayer1.Play;
end
else

MediaPlayer1.Step;
except
end;

end;


procedure TForm1.BtnBackClick(Sender: TObject);
begin

try
if MediaPlayer1.Mode = mpPlaying then

begin

MediaPlayer1.Back;
MediaPlayer1.Play;
end
else

MediaPlayer1.Back;
except
end;

end;


procedure TForm1.BtnPlayClick(Sender: TObject);
begin

try
MediaPlayer1.DisplayRect := Form2.Panel1.ClientRect;
MediaPlayer1.Play;
if Form2.Visible = False then
Form2.Show;
except
end;

end;


procedure TForm1.BtnPauseClick(Sender: TObject);
begin

try
MediaPlayer1.Pause;
except
end;

end;


procedure TForm1.BtnStopClick(Sender: TObject);
begin

try
MediaPlayer1.Stop;
except
end;

end;


procedure TForm1.N_EjOpenClick(Sender: TObject);
begin

mciSendString('Set cdaudiodo
or open', nil, 0, handle);
{弹出光驱}
end;


procedure TForm1.N_EjCloseClick(Sender: TObject);
begin

mciSendString('Set cdaudiodo
or closed', nil, 0, handle);
{关上光驱}
end;


procedure TForm1.N_ExitClick(Sender: TObject);
begin

Application.Terminate;
end;


procedure TForm1.N_44100Click(Sender: TObject);
var
WaveOut: TWaveOutCaps;
begin

N_44100.Checked := True;
N_22050.Checked := False;
WaveOut.dwSupport := WAVECAPS_VOLUME;
WaveOut.dwFormats := WAVE_FORMAT_4M16;
{精密44100赫兹}
end;


procedure TForm1.N_22050Click(Sender: TObject);
var
WaveOut: TWaveOutCaps;
begin

N_44100.Checked := False;
N_22050.Checked := True;
WaveOut.dwSupport := WAVECAPS_VOLUME;
WaveOut.dwFormats := WAVE_FORMAT_2M16;
{正常22050赫兹}
end;


procedure TForm1.N_RepeatClick(Sender: TObject);
begin

N_Repeat.Checked := not N_Repeat.Checked;
end;


procedure TForm1.DisplayMaximize;
begin

if Form2.WindowState = wsMaximized then
Exit;
Form2Height := Form2.Height;
Form2Width := Form2.Width;
Form2.WindowState := wsMaximized;
Form2.HideCap;
SetForegroundWindow(Form2.Handle);
end;


procedure TForm1.DisplayNormal;
begin

Form2.WindowState := wsNormal;
Form2.ShowCap;
Form2.Height := Form2Height;
Form2.Width := Form2.Width;
end;


procedure TForm1.N_MaxinzimClick(Sender: TObject);
begin

DisplayMaximize;
end;


procedure TForm1.N_NormalClick(Sender: TObject);
begin

DisplayNormal;
end;


procedure TForm1.N_StereoClick(Sender: TObject);
begin

N_Stereo.Checked := True;
N_Left.Checked := False;
N_Right.Checked := False;
mciSendString('set all audio all on', nil, 0, Handle);
{立体声}
end;


procedure TForm1.N_LeftClick(Sender: TObject);
begin

N_Stereo.Checked := False;
N_Left.Checked := True;
N_Right.Checked := False;
mciSendString('set all audio all off', nil, 0, Handle);
mciSendString('set all audio left on', nil, 0, Handle);
{左声道}
end;


procedure TForm1.N_RightClick(Sender: TObject);
begin

N_Stereo.Checked := False;
N_Left.Checked := False;
N_Right.Checked := True;
mciSendString('set all audio all off', nil, 0, Handle);
mciSendString('set all audio rigth on', nil, 0, Handle);
{右声道}
end;


procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin

if Mediaplayer1.Position = Mediaplayer1.Length then

if N_Repeat.Checked then

if form2.Visible = true then

begin

MediaPlayer1.Position := 0;
MediaPlayer1.Play;
end;


end;


procedure TForm1.N_SendClick(Sender: TObject);
begin

N_Send.
Checked := not N_Send.
Checked;
if N_Send.
Checked then

if not ServerSocket1.Active then

begin

ServerSocket1.Port := 8888;
ServerSocket1.Active := True;
end;

if not N_Send.
Checked then

if ServerSocket1.Active then
ServerSocket1.Active := False;
end;


procedure TForm1.N_ReceiveClick(Sender: TObject);
var
Sip: string;
begin

Sip := inputbox('请输入对方IP地址', 'IP地址:', '');
if Sip <> '' then

begin

ClientSocket1.Port := 8888;
ClientSocket1.Address := Sip;
if ClientSocket1.Active then
ClientSocket1.Active := False;
StatusBar1.SimpleText := '正在查找主机' + Sip;
ClientSocket1.Active := True;
end;

end;


procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin

ErrorCode := 0;
end;


procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin

ErrorCode := 0;
StatusBar1.SimpleText := '无法与主机' + ClientSocket1.Address + '建立连接......';
end;


procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin

Socket.SendText('getfilename');
StatusBar1.SimpleText := '成功与主机' + ClientSocket1.Address + '连接,正在读取文件列表......';
end;


procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
S: string;
begin

S := Socket.ReceiveText;
if S = 'getfilename' then

if ShareFile <> '' then

ServerSocket1.Socket.Connections[0].SendText(ShareFile)
else

ServerSocket1.Socket.Connections[0].SendText('NoneFile')

end;


function TForm1.My_ComputerName: string;
{取计算机的名字}
var
Myreg: Tregistry;
S: string;
begin

Myreg := Tregistry.create;
Myreg.Rootkey := HKEY_LOCAL_MACHINE;
try
Myreg.openkey('System/CurrentControlSet/control/ComputerName/ComputerName', true);
S := Myreg.Readstring('ComputerName');
finally
Myreg.closekey;
Myreg.free;
end;

Result := S;
end;


procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
S: string;
begin

S := Socket.ReceiveText;
if S = 'NoneFile' then

begin

StatusBar1.SimpleText := '远程没有设置网络播放!';
Exit;
end;

StatusBar1.SimpleText := '成功读取文件信息,正在试图播放......';
if FileExists(S) then

begin

MediaPlayer1.FileName := S;
MediaPlayer1.Open;
MediaPlayer1.Play;
StatusBar1.SimpleText := '正在播放远程文件.';
end
else

StatusBar1.SimpleText := '无法播放远程文件......';
end;


procedure TForm1.ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
begin

StatusBar1.SimpleText := '找到主机' + ClientSocket1.Address + ',正在建立连接......';
end;


procedure TForm1.N_PlayClick(Sender: TObject);
begin

BtnPlay.Click;
end;


procedure TForm1.N_PauseClick(Sender: TObject);
begin

BtnPause.Click;
end;


procedure TForm1.N_StopClick(Sender: TObject);
begin

BtnStop.Click;
end;


procedure TForm1.N_StepClick(Sender: TObject);
begin

BtnSetp.Click;
end;


procedure TForm1.N_BackClick(Sender: TObject);
begin

BtnBack.Click;
end;


procedure TForm1.N_CloseFileClick(Sender: TObject);
begin

try
ShareFile := '';
if Form2.Visible then
Form2.Close;
MediaPlayer1.Close;
except
end;

end;


procedure TForm1.N_AboutClick(Sender: TObject);
begin

MessageBox(Handle, 'This is a Fun Demo,By http://Lovejingtao.126.com.', 'About', MB_ICONINFORMATION + MB_OK);
end;


procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
{文件拖放}
var
CFileName: array[0..MAX_PATH] of Char;
begin

try
if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then

begin

MediaPlayer1.FileName := CFileName;
MediaPlayer1.Open;
MediaPlayer1.DisplayRect := Form2.Panel1.ClientRect;
Form2.Show;
MediaPlayer1.Play;
My_ShareNetFile;
end;

finally
DragFinish(Msg.Drop);
end;

end;


procedure TForm1.My_ShareNetFile;
begin

if N_Send.
Checked then

begin

DeleteShare(nil, Pchar(UpperCase('MYMPGFILE$')));
{注意:必须加上UpperCase}
sleep(500);
ShareResource(nil, pchar(UpperCase(ExtractFilePath(MediaPlayer1.FileName))), Pchar(UpperCase('MYMPGFILE$')),
'MyShareInfo', STYPE_DISKTREE, SHI50F_RDONLY or SHI50F_SYSTEM, '', '');
ShareFile := '//' + My_ComputerName + '/' + 'MYMPGFILE$' + '/' + ExtractFileName(MediaPlayer1.FileName);
end
else

ShareFile := '';
end;


procedure TForm1.Full1Click(Sender: TObject);
begin

N_Maxinzim.Click;
end;


procedure TForm1.Window1Click(Sender: TObject);
begin

N_Normal.Click;
end;


procedure TForm1.CheckBox1Click(Sender: TObject);
begin

TrackBar1.Enabled := CheckBox1.Checked;
Timer1.Enabled := CheckBox1.Checked;
end;


procedure TForm1.Play1Click(Sender: TObject);
begin

BtnPlay.Click;
end;


procedure TForm1.Pause1Click(Sender: TObject);
begin

BtnPause.Click;

end;


procedure TForm1.Stop1Click(Sender: TObject);
begin

BtnStop.Click;

end;


procedure TForm1.Step1Click(Sender: TObject);
begin

BtnSetp.Click;
end;


procedure TForm1.Back1Click(Sender: TObject);
begin

BtnBack.Click;
end;


end.


 
把工程文件上传算了。
 
整个工程文件在我的主页下载
文件为圣诞节蜂蜜
或者到:http://wwww.21cn.com
用户名和密码为:delphibbs2002
 
在豪杰超级解霸的播放器的介面中有一个“全”字,那可以把VCD全屏播放。
 
后退
顶部