sf_flashplayer.pas

smartflash ,delphi vcl组件 ,可以实现透明flash窗体

  if not (csDesigning in ComponentState) and FVolumeControl
  then
    begin
      InitVolumeControl;
    end;
end;

function TsfFlashPlayer.IsFlashAviable: Boolean;
begin
  Result := not FFlashNotExists;
end;

procedure TsfFlashPlayer.InitControlData;
const
  CEventDispIDs: array [0..3] of DWORD = (
    $FFFFFD9F, $000007A6, $00000096, $000000C5);
  CControlData: TControlData2 = (
    ClassID: '{D27CDB6E-AE6D-11CF-96B8-444553540000}';
    EventIID: '{D27CDB6D-AE6D-11CF-96B8-444553540000}';
    EventCount: 4;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil (*HR:$80004002*);
    Flags: $00000000;
    Version: 401);
begin
  ControlData := @CControlData;
  TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnReadyStateChange) - Cardinal(Self);
end;

procedure TsfFlashPlayer.CreateControl;

  procedure DoCreate;
  begin
    FIntf := IUnknown(OleObject) as IShockwaveFlash;
  end;

begin
  if FIntf = nil then DoCreate;
end;

function TsfFlashPlayer.GetControlInterface: IShockwaveFlash;
begin
  CreateControl;
  Result := FIntf;
end;

function TsfFlashPlayer.Get_InlineData: IUnknown;
begin
  Result := DefaultInterface.InlineData;
end;

procedure TsfFlashPlayer.Set_InlineData(const ppIUnknown: IUnknown);
begin
  if not FFlashNotExists  then DefaultInterface.Set_InlineData(ppIUnknown);
end;

procedure TsfFlashPlayer.SetZoomRect(left: Integer; top: Integer; right: Integer; bottom: Integer);
begin
  if not FFlashNotExists  then DefaultInterface.SetZoomRect(left, top, right, bottom);
end;

procedure TsfFlashPlayer.Zoom(factor: SYSINT);
begin
  if not FFlashNotExists  then DefaultInterface.Zoom(factor);
end;

procedure TsfFlashPlayer.Pan(x: Integer; y: Integer; mode: SYSINT);
begin
  if not FFlashNotExists  then DefaultInterface.Pan(x, y, mode);
end;

procedure TsfFlashPlayer.Play;
begin
  if not FFlashNotExists  then DefaultInterface.Play;
end;

procedure TsfFlashPlayer.Stop;
begin
  if not FFlashNotExists  then DefaultInterface.Stop;
end;

procedure TsfFlashPlayer.Back;
begin
  if not FFlashNotExists  then DefaultInterface.Back;
end;

procedure TsfFlashPlayer.Forward;
begin
  if not FFlashNotExists  then DefaultInterface.Forward;
end;

procedure TsfFlashPlayer.Rewind;
begin
  if not FFlashNotExists  then DefaultInterface.Rewind;
end;

procedure TsfFlashPlayer.StopPlay;
begin
  if not FFlashNotExists  then DefaultInterface.StopPlay;
end;

procedure TsfFlashPlayer.GotoFrame(FrameNum: Integer);
begin
  if not FFlashNotExists  then DefaultInterface.GotoFrame(FrameNum);
end;

function TsfFlashPlayer.CurrentFrame: Integer;
begin
  Result := DefaultInterface.CurrentFrame;
end;

function TsfFlashPlayer.IsPlaying: WordBool;
begin
  Result := DefaultInterface.IsPlaying;
end;

function TsfFlashPlayer.PercentLoaded: Integer;
begin
  Result := DefaultInterface.PercentLoaded;
end;

function TsfFlashPlayer.FrameLoaded(FrameNum: Integer): WordBool;
begin
  Result := DefaultInterface.FrameLoaded(FrameNum);
end;

function TsfFlashPlayer.FlashVersion: Integer;
begin
  Result := DefaultInterface.FlashVersion;
end;

procedure TsfFlashPlayer.DoFSCommand(ASender: TObject; const command, args: WideString);
begin
  FFScommand := command;
  FFSargs := args;
  PostMessage(CommandHandler.FHandle, WM_COMMANDEVENT, Cardinal(Self), 0);
end;

function TsfFlashPlayer.InitFlash;
var
  FStrm: TFileStream;
  ResStrm: TResourceStream;
  SFileName: string;
  FTempFName, FTempFName2: string;
  s, s1, i: Integer;
begin
  FTmpFileName2 := '';

  Result := False;
  try
    if AFLV then
    begin
      SetLength(FTmpFileName, 1000);
      s := GetTempPath(1000, PChar(FTmpFileName));
      SetLength(FTmpFileName, s);
      if (Length(FTmpFileName)>0) and (FTmpFileName[Length(FTmpFileName)]<>'\') then
        FTmpFileName := FTmpFileName+'\';
      s := Random(10000);
      s1 := Random(10000);
      while FileExists(FTmpFileName+IntToStr(s)+IntToStr(s1) + '.swf') do Inc(s);
      FTmpFileName := FTmpFileName+IntToStr(s)+IntToStr(s1)+'.swf';
      FStrm := TFileStream.Create(FTmpFileName, fmCreate);
      ResStrm := TResourceStream.Create(HInstance, 'FLVPLAY', RT_RCDATA);
      ResStrm.Position := 0;
      FStrm.CopyFrom(ResStrm, ResStrm.Size);
      ResStrm.Free;
      FStrm.Free;

      SFileName := FTmpFileName;

      SetLength(FTmpFileName, 1000);
      s := GetTempPath(1000, PChar(FTmpFileName));
      SetLength(FTmpFileName, s);
      if (Length(FTmpFileName)>0) and (FTmpFileName[Length(FTmpFileName)]<>'\') then
        FTmpFileName := FTmpFileName+'\';
      s := Random(10000);
      s1 := Random(10000);
      while FileExists(FTmpFileName+IntToStr(s)+IntToStr(s1) +'.flv') do
        inc(s);
      FTmpFileName := FTmpFileName+IntToStr(s)+IntToStr(s1)+'.flv';
      FStrm := TFileStream.Create(FTmpFileName, fmCreate);
      FStream.Position := 0;
      FStrm.CopyFrom(FStream, FStream.Size);
      FStrm.Free;

      FTmpFileName2 := SFileName;

      FTempFName := FTmpFileName;
      FTempFName2 := FTmpFileName2;

      for i := 1 to Length(FTempFName) do
        if FTempFName[i] = '\'
        then
          FTempFName[i] := '/';

      for i := 1 to Length(FTempFName2) do
        if FTempFName2[i] = '\'
        then
          FTempFName2[i] := '/';

      Movie := FTempFName2 + '?' + 'filename=' + FTempFName;
    end
    else
    begin
      SetLength(FTmpFileName, 1000);
      s := GetTempPath(1000, PChar(FTmpFileName));
      SetLength(FTmpFileName, s);
      if (Length(FTmpFileName)>0) and (FTmpFileName[Length(FTmpFileName)]<>'\')
      then
        FTmpFileName := FTmpFileName +'\';
      s := Random(10000);
      s1 := Random(10000);
      while FileExists(FTmpFileName + IntToStr(s) + IntToStr(s1) + '.swf') do Inc(s);
      FTmpFileName := FTmpFileName + IntToStr(s) + IntToStr(s1) + '.swf';
      FStrm := TFileStream.Create(FTmpFileName, fmCreate);
      FStream.Position := 0;
      FStrm.CopyFrom(FStream, FStream.Size);
      FStrm.Free;
      Movie := FTmpFileName;
    end;
    Result := True;
  except;
  end;
end;

procedure TsfFlashPlayer.DoneFlash;
begin
  Stop;
  DeleteFile(FTmpFileName);
  if FTmpFileName2 <> '' then
    DeleteFile(FTmpFileName2);
  FTmpFileName := '';
  FTmpFileName2 := '';
end;

function  TsfFlashPlayer.CallFunction(const request: WideString): WideString;
begin
  if IsFlashAviable and (HiWord(DefaultInterface.FlashVersion) >= 8) then
    Result := DefaultInterface.CallFunction(request)
  else
    Result := '';
end;


procedure TsfFlashPlayer.LoadMovie(layer: SYSINT; const url: WideString);
var
  RStrm: TResourceStream;
  FStrm: TFileStream;
  PlayFileName, FLVFileName: string;
  i, s, s1: integer;
begin
  if FFlashNotExists then Exit;

  if not FFlashNotExists then
  begin
    if Pos('.flv', url) > 0 then
    begin
       RStrm := TResourceStream.Create(HInstance, 'FLVPLAY', RT_RCDATA);
      try
        RStrm.Position := 0;
        SetLength(PlayFileName, 1000);
        s := GetTempPath(1000, PChar(PlayFileName));
        SetLength(PlayFileName, s);
        if (Length(PlayFileName) > 0) and (PlayFileName[Length(PlayFileName)]<>'\') then
          PlayFileName := PlayFileName + '\';
        s := Random(10000);
        s1 := Random(10000);
        while FileExists(PlayFileName + IntToStr(s) + IntToStr(s1) + '.swf') do Inc(s);
        PlayFileName := PlayFileName + IntToStr(s) + IntToStr(s1) + '.swf';
        FStrm := TFileStream.Create(PlayFileName, fmCreate);
        FStrm.CopyFrom(RStrm, RStrm.Size);
        FStrm.Free;

        for i := 1 to Length(PlayFileName) do
          if PlayFileName[i] = '\' then PlayFileName[i] := '/';
        FLVFileName := url;
        for i := 1 to Length(FLVFileName) do
          if FLVFileName[i] = '\' then FLVFileName[i] := '/';

        DefaultInterface.LoadMovie(layer, PlayFileName + '?filename=' + FLVFileName);

        DeleteFile(PlayFileName);
      finally
        RStrm.Free;
      end;
    end
    else
    begin
      DefaultInterface.LoadMovie(layer, url);
    end;
    SetBounds(Left, Top, Width, Height);
  end;
end;     

procedure TsfFlashPlayer.LoadMovieFromStream(layer: SYSINT; const Stream: TStream);
var
  FLVSign: array [1..3] of char;
begin
  Stream.Position := 0;
  Stream.Read(FLVSign, 3);
  Stream.Position := 0;
  if (FLVSign[1] = 'F') and (FLVSign[2] = 'L') and (FLVSign[3] = 'V')
  then
    begin
      FStream.SetSize(0);
      Stream.Position := 0;
      FStream.CopyFrom(Stream, Stream.Size);
      FStream.Position := 0;
      if FStream.Size > 0
      then
        begin
         InitFlash(True);
         SetBounds(Left, Top, Width, Height);
       end;
    end
  else
    begin
      FStream.SetSize(0);
      Stream.Position := 0;
      FStream.CopyFrom(Stream, Stream.Size);
      if FStream.Size > 0
      then
        begin
         InitFlash(False);
         SetBounds(Left, Top, Width, Height);
        end;
     end;
end;

procedure TsfFlashPlayer.LoadMovieFromResource(layer: SYSINT; const ResName: WideString);
var
  R: TResourceStream;
begin
  R := TResourceStream.Create(0, ResName, RT_RCDATA);
  if R <> nil then
    LoadMovieFromStream(layer, R);
  R.Free;
end;

procedure TsfFlashPlayer.SetFlashList(const Value: TsfFlashList);
begin
  FFlashList := Value;
  if FFlashList = nil then FFlashIndex := -1;
end;

procedure TsfFlashPlayer.SetFlashIndex(const Value: integer);
var
  Flash: TMemoryStream;
begin
  FFlashIndex := Value;