unit_frmmain.pas

局域网VCD影院 用DELPHI 编写的 局域网VCD影院

unit Unit_FrmMain;

interface

uses
  Windows, Messages, Shellapi, MyDef, SysUtils, internet, FileCtrl, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SendStreamThread, CommonUnit, Mpeg1DataFormat, ComCtrls, Mousebar, ExtCtrls,
  ScktComp, Menus, AppEvnts, Buttons;

type
  TFrmMain = class(TForm)
    Image1: TImage;
    DbgMemo: TMemo;
    Mousebar1: TMousebar;
    Mousebar2: TMousebar;
    btSound: TButton;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    ApplicationEvents1: TApplicationEvents;
    btStop: TButton;
    btFile: TButton;
    btExit: TButton;
    Image2: TImage;
    btAbout: TButton;
    Label_HomePage: TLabel;
    Label_Info: TLabel;
    btVcd: TButton;
    btLoop: TSpeedButton;
    btFull: TSpeedButton;
    procedure btStopClick(Sender: TObject);
    procedure btFileClick(Sender: TObject);
    procedure btSoundClick(Sender: TObject);
    procedure Mousebar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure Mousebar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Mousebar2Change(Sender: TObject);
    procedure ApplicationEvents1ActionExecute(Action: TBasicAction;
      var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btExitClick(Sender: TObject);
    procedure Label_HomePageClick(Sender: TObject);
    procedure btAboutClick(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure btVcdClick(Sender: TObject);
    procedure btFullClick(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    //---下面是窗口粘贴函数--
    m_nOldTop: integer;
    m_nOldLeft: integer;
    m_bMouseDown: Boolean;
    m_bOnScroll: Boolean;
    m_nOldMouseX: integer;
    m_nOldMouseY: integer;
    //--------------------
    procedure ThreadDone(var Message: TMessage); message WM_ThreadMsg;
     { Private declarations }
  public
    m_bCombined: Boolean; //拼合在一起
    m_bVLinked: Boolean; //垂直方向连在一起
    m_bHLinked: Boolean; //水平方向连在一起
    iMulticastGroup: integer; //组播组序号
    ThreadActive: Boolean; //线程是否在运行中
    { Public declarations }
  end;
const WSPAN = 15;
var
  FrmMain: TFrmMain;
  VideoThread: TSendStreamThread;
  t: boolean = False;
implementation
uses
  Unit_FrmVideo, Mpeg1DecodeDll, SendMsgSock,
{$IFDEF Language_GB32}
  Language_GB32
{$ENDIF}
{$IFDEF Language_BIG5}
  Language_BIG5
{$ENDIF}
{$IFDEF Language_English}
  Language_English
{$ENDIF};
{$R *.dfm}

procedure TFrmMain.ThreadDone(var Message: TMessage);
begin
  if Message.WParam = Msg_ThreadDone then
  begin
   //showmessage('ok');
    if not (t) then
    begin // showmessage('ok');
      t := True;
      btStopClick(Self);
    end;
  end;
end;

procedure TFrmMain.btStopClick(Sender: TObject);
begin
  SendMsg_Stop(iMulticastGroup);
  SendMsg_Stop(iMulticastGroup);
  SendMsg_Stop(iMulticastGroup);
  MySleepMs(300);
//UdpBroadSender.BroadStr(ResultTState);
  Timer1.Enabled := False;
  if ThreadActive then
  begin

    Mpeg1Decode_StopVideo;
    if VideoThread <> nil then
    begin
      VideoThread.Suspend;
      VideoThread.Terminate;
    end;
    Mpeg1Decode_CloseVideo;
    Mpeg1Decode_UnInit;
  end;
  FrmMain.Mousebar1.Position := 0;
  FrmMain.Mousebar1.Enabled := False;
  btFile.Enabled := True;
  btVcd.Enabled := btFile.Enabled;
  SendMsg_Stop(iMulticastGroup);
end;

procedure TFrmMain.btFileClick(Sender: TObject);
begin
  if ConnectedToInternet <> ctNone then
    if Application.MessageBox(Msg_Intenet, Pchar(Application.Title), MB_ICONQUESTION + MB_YESNO) = IDNO
      then Exit;

  t := False;
  if OpenDialog1.Execute then
  begin
    if not (Mpeg1Decode_CheckIsMpegFile(Pchar(OpenDialog1.FileName))) then
    begin
      Application.MessageBox(Msg_NotMpeg1File, Pchar(Application.Title), MB_ICONINFORMATION);
      Exit;
    end;
    iMulticastGroup := GetFreeGroup;
    if iMulticastGroup = -1 then
    begin
      Application.MessageBox(Msg_FreeChannelNotFound, Pchar(Application.Title), MB_ICONINFORMATION);
      Exit;
    end;
    Mpeg1Decode_CloseVideo;
    Mpeg1Decode_UnInit;

    btFile.Enabled := False;
    btVcd.Enabled := btFile.Enabled;
    sleep(30);
    Mpeg1Decode_Init();
    VideoThread := TSendStreamThread.Create(OpenDialog1.FileName, 0, True, True, iMulticastGroup);
    Mousebar1.Max := VideoThread.iMaxFram;
    VideoThread.Resume;
  end;
end;

procedure TFrmMain.btSoundClick(Sender: TObject);
begin
  Mpeg1Decode_PopupAudioPropDlg(Handle);
end;

procedure TFrmMain.Mousebar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//--------------------------
  SendMsg_Refresh(iMulticastGroup);
  Timer1.Enabled := False;
  if ThreadActive then
  begin
    Mpeg1Decode_StopVideo;
    if VideoThread <> nil then
    begin
      VideoThread.Suspend;
      VideoThread.Terminate;
    end;
    Mpeg1Decode_CloseVideo;
    Mpeg1Decode_UnInit;
  end;
//--------------------------
  MySleepMs(500);
  Mpeg1Decode_Init();
  VideoThread := TSendStreamThread.Create(OpenDialog1.FileName, Mousebar1.Position, True, False, iMulticastGroup);
  VideoThread.Resume;
  Timer1.Enabled := True;
  Mousebar2.SetFocus;
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
  if VideoThread.iStartPos < Mousebar1.Max then
  begin
    if Mousebar1.Enabled then Mousebar1.Position := VideoThread.iStartPos;
  end;
end;

procedure TFrmMain.Mousebar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Timer1.Enabled := False;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  m_bMouseDown := FALSE;
  m_bCombined := True;
  m_bHLinked := FALSE;
  m_bVLinked := FALSE;
  m_bOnScroll := FALSE;
//------------界面初试化-------------------------
  Self.Left := (Screen.Width div 2) - (VideoFormWidth div 2) - ((Self.Width - VideoFormWidth) div 2);
  Self.Top := (Screen.Height div 2) + (VideoFormHeight div 2);
  Application.Title := MpgServerName;
  Self.Font.Name := StrFontName;
  Self.Font.Charset := Charset;
  Self.Font.Size := FontSize;

  btFile.Caption := MainForm_BtFile;
  btVcd.Caption := MainForm_BtVcd;
  btStop.Caption := MainForm_BtStop;
  BtSound.Caption := MainForm_BtSound;
  btAbout.Caption := MainForm_BtAbout;
  btExit.Caption := MainForm_BtExit;

  btLoop.Caption := MainForm_BtLoop;
  btLoop.AllowAllUp := True;
  btLoop.GroupIndex := 1;
  btFull.Caption := MainForm_BtFull;
  btFull.AllowAllUp := True;
  btFull.GroupIndex := 2;
  Mousebar1.ShowHint := True;
  Mousebar1.Hint := MainForm_PostionHint;
  Mousebar2.ShowHint := True;
  Mousebar2.Hint := MainForm_VolumeHint;
  Label_HomePage.ShowHint := True;
  Label_HomePage.Hint := MainForm_HomePage;

  Mousebar2.Min := Mpeg1Decode_GetMinimalVolume;
  Mousebar2.Max := Mpeg1Decode_GetMaximalVolume;
  Mousebar2.Position := Mpeg1Decode_GetCurrentVolume;
//------------变量初试化-------------------------
  ThreadActive := False; //线程是否在运行中
  iMulticastGroup := 1;
end;


procedure TFrmMain.Mousebar2Change(Sender: TObject);
begin
  Mpeg1Decode_SetCurrentVolume(Mousebar2.Position);
end;

procedure TFrmMain.ApplicationEvents1ActionExecute(Action: TBasicAction;
  var Handled: Boolean);
begin
//
end;


procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);