sf_flashplayer.pas

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

// Control Name     : TsfFlashPlayer
// Help String      : Shockwave Flash
// Default Interface: IShockwaveFlash
// Def. Intf. DISP? : No
// Event   Interface: _IShockwaveFlashEvents
// TypeFlags        : (2) CanCreate
// *********************************************************************//
  TsfFlashPlayerOnReadyStateChange = procedure(ASender: TObject; newState: Integer) of object;
  TsfFlashPlayerOnProgress = procedure(ASender: TObject; percentDone: Integer) of object;
  TsfFlashPlayerFSCommand = procedure(ASender: TObject; const command: WideString;
                                                         const args: WideString) of object;
  TsfFlashFlashCall = procedure(ASender: TObject; const request: WideString) of object;

  TsfFlashPlayer = class(TsfOleControl)
  private
    FVolume: Integer;
    FVolumeControl: Boolean;
    FVolumeControlFile: String;
    FOnReadyStateChange: TsfFlashPlayerOnReadyStateChange;
    FOnProgress: TsfFlashPlayerOnProgress;
    FOnFSCommand: TsfFlashPlayerFSCommand;
    FOnFlashCall: TsfFlashFlashCall;
    FOnHandleFSCommand: TsfFlashPlayerFSCommand;
    FIntf: IShockwaveFlash;
    FFlashList: TsfFlashList;
    FFlashIndex: integer;
    FFScommand, FFSargs: WideString;
    procedure SoundSetVolume(Value: Integer);
    procedure SetVolume(Value: Integer);
    procedure SetVolumeControl(Value: Boolean);
    function  GetControlInterface: IShockwaveFlash;
    procedure SetFlashList(const Value: TsfFlashList);
    procedure SetFlashIndex(const Value: integer);
    procedure DoFSCommand(ASender: TObject; const command, args: WideString);
  protected
    FStream: TMemoryStream;
    FTmpFileName, FTmpFileName2: String;
    procedure InitVolumeControl;
    procedure CreateControl;
    procedure InitControlData; override;
    function InitFlash(AFLV: Boolean): Boolean;
    procedure DoneFlash;
    function Get_InlineData: IUnknown;
    procedure Set_InlineData(const ppIUnknown: IUnknown);
    property WMode: WideString index 133 read GetWideStringProp write SetWideStringProp stored False;
    property OnFSCommand: TsfFlashPlayerFSCommand read FOnFSCommand write FOnFSCommand;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetZoomRect(left: Integer; top: Integer; right: Integer; bottom: Integer);
    procedure Zoom(factor: SYSINT);
    procedure DisableFlashSounds(Value: Boolean);
    function IsFlashAviable: Boolean;
    function  CallFunction(const request: WideString): WideString;
    procedure Pan(x: Integer; y: Integer; mode: SYSINT);
    procedure Play;
    procedure Stop;
    procedure Back;
    procedure Forward;
    procedure Rewind;
    procedure StopPlay;
    procedure GotoFrame(FrameNum: Integer);
    function CurrentFrame: Integer;
    function IsPlaying: WordBool;
    function PercentLoaded: Integer;
    function FrameLoaded(FrameNum: Integer): WordBool;
    function FlashVersion: Integer;
    procedure LoadMovie(layer: SYSINT; const url: WideString);
    procedure LoadMovieFromStream(layer: SYSINT; const Stream: TStream);
    procedure LoadMovieFromResource(layer: SYSINT; const ResName: WideString);
    procedure TGotoFrame(const target: WideString; FrameNum: Integer);
    procedure TGotoLabel(const target: WideString; const label_: WideString);
    function TCurrentFrame(const target: WideString): Integer;
    function TCurrentLabel(const target: WideString): WideString;
    procedure TPlay(const target: WideString);
    procedure TStopPlay(const target: WideString);
    procedure SetVariable(const name: WideString; const value: WideString);
    function GetVariable(const name: WideString): WideString;
    procedure TSetProperty(const target: WideString; property_: SYSINT; const value: WideString);
    function TGetProperty(const target: WideString; property_: SYSINT): WideString;
    procedure TCallFrame(const target: WideString; FrameNum: SYSINT);
    procedure TCallLabel(const target: WideString; const label_: WideString);
    procedure TSetPropertyNum(const target: WideString; property_: SYSINT; value: Double);
    function TGetPropertyNum(const target: WideString; property_: SYSINT): Double;
    function TGetPropertyAsNumber(const target: WideString; property_: SYSINT): Double;
    property  ControlInterface: IShockwaveFlash read GetControlInterface;
    property  DefaultInterface: IShockwaveFlash read GetControlInterface;
    property ReadyState: Integer index -525 read GetIntegerProp;
    property TotalFrames: Integer index 124 read GetIntegerProp;
    property InlineData: IUnknown index 191 read GetIUnknownProp write SetIUnknownProp;
  published
    property Anchors;
    property  Align;
    property  DragCursor;
    property  DragMode;
    property  ParentShowHint;
    property  PopupMenu;
    property  ShowHint;
    property  Visible;
    property  OnDragDrop;
    property  OnDragOver;
    property  OnEndDrag;
    property  OnStartDrag;
    property Volume: Integer read FVolume write SetVolume;
    property VolumeControl: Boolean read FVolumeControl write SetVolumeControl;
    property Playing: WordBool index 125 read GetWordBoolProp write SetWordBoolProp stored False;
    property Quality: Integer index 105 read GetIntegerProp write SetIntegerProp stored False;
    property ScaleMode: Integer index 120 read GetIntegerProp write SetIntegerProp stored False;
    property AlignMode: Integer index 121 read GetIntegerProp write SetIntegerProp stored False;
    property BackgroundColor: Integer index 123 read GetIntegerProp write SetIntegerProp stored False;
    property Loop: WordBool index 106 read GetWordBoolProp write SetWordBoolProp stored False;
    property Movie: WideString index 102 read GetWideStringProp write SetWideStringProp stored False;
    property FrameNum: Integer index 107 read GetIntegerProp write SetIntegerProp stored False;
    property SAlign: WideString index 134 read GetWideStringProp write SetWideStringProp stored False;
    property Menu: WordBool index 135 read GetWordBoolProp write SetWordBoolProp stored False;
    property Base: WideString index 136 read GetWideStringProp write SetWideStringProp stored False;
    property Scale: WideString index 137 read GetWideStringProp write SetWideStringProp stored False;
    property DeviceFont: WordBool index 138 read GetWordBoolProp write SetWordBoolProp stored False;
    property EmbedMovie: WordBool index 139 read GetWordBoolProp write SetWordBoolProp stored False;
    property BGColor: WideString index 140 read GetWideStringProp write SetWideStringProp stored False;
    property Quality2: WideString index 141 read GetWideStringProp write SetWideStringProp stored False;
    property SWRemote: WideString index 159 read GetWideStringProp write SetWideStringProp stored False;
    property FlashVars: WideString index 170 read GetWideStringProp write SetWideStringProp stored False;
    property AllowScriptAccess: WideString index 171 read GetWideStringProp write SetWideStringProp stored False;
    property MovieData: WideString index 190 read GetWideStringProp write SetWideStringProp stored False;
    property SeamlessTabbing: WordBool index 192 read GetWordBoolProp write SetWordBoolProp stored False;
    property OnReadyStateChange: TsfFlashPlayerOnReadyStateChange read FOnReadyStateChange write FOnReadyStateChange;
    property OnProgress: TsfFlashPlayerOnProgress read FOnProgress write FOnProgress;
    property OnHandleFSCommand: TsfFlashPlayerFSCommand read FOnHandleFSCommand write FOnHandleFSCommand;
    property OnFlashCall: TsfFlashFlashCall read FOnFlashCall write FOnFlashCall;
    { list }
    property FlashList: TsfFlashList read FFlashList write SetFlashList;
    property FlashIndex: integer read FFlashIndex write SetFlashIndex default -1;
  end;

// *********************************************************************//
// The Class CoFlashProp provides a Create and CreateRemote method to          
// create instances of the default interface IUnknown exposed by
// the CoClass FlashProp. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.                                            
// *********************************************************************//
  CoFlashProp = class
    class function Create: IUnknown;
    class function CreateRemote(const MachineName: string): IUnknown;
  end;

// *********************************************************************//
// The Class CoFlashObjectInterface provides a Create and CreateRemote method to          
// create instances of the default interface IFlashObjectInterface exposed by              
// the CoClass FlashObjectInterface. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
  CoFlashObjectInterface = class
    class function Create: IFlashObjectInterface;
    class function CreateRemote(const MachineName: string): IFlashObjectInterface;
  end;


  TsfLayeredFlashForm = class(TComponent)
  private
   FForm: TForm;
   FFlashPlayer: TsfFlashPlayer;
   OldWindowProc: TWndMethod;
   FAlphaBlendValue: Integer;
   FFirstShow: Boolean;
   //
   FDragable: Boolean;
   FIsDragging: Boolean;
   FDragX, FDragY: Integer;
   FMouseDown: Boolean;
   FApplyRegions: Boolean;
   procedure SetFlashPlayer(Value: TsfFlashPlayer);
   procedure NewWndProc(var Message: TMessage);
   procedure DoPaint(Sender: TObject);
 protected
   procedure Loaded; override;
   procedure Notification(AComponent: TComponent;
                          Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property FlashPlayer: TsfFlashPlayer read FFlashPlayer write SetFlashPlayer;
    property AlphaBlendValue: Integer read FAlphaBlendValue write FAlphaBlendValue;
    property Dragable: Boolean read FDragable write FDragable;
    property ApplyRegions: Boolean read FApplyRegions write FApplyRegions;
  end;

implementation

uses ComObj, sf_Bitmap, sf_winapi, sf_utils;

{$R *.res}

{ TsfCommandHandler }

const

  WM_COMMANDEVENT = WM_USER + 1220;
 
type

  TsfCommandHandler = class
  private
    FHandle: Cardinal;
    procedure WMCommandEvent(var Msg: TMessage); message WM_COMMANDEVENT;
    procedure WndProc(var Msg: TMessage);
  public
    constructor CreateHandler;
    destructor Destroy; override;
  end;

var
  CommandHandler: TsfCommandHandler;

{ TsfCommandHandler }

constructor TsfCommandHandler.CreateHandler;
begin
  inherited Create;
  FHandle := AllocatehWnd(WndProc);
end;

destructor TsfCommandHandler.Destroy;
begin
  DeallocatehWnd(FHandle);
  inherited;
end;

procedure TsfCommandHandler.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_COMMANDEVENT then
    WMCommandEvent(Msg);
end;

procedure TsfCommandHandler.WMCommandEvent(var Msg: TMessage);
begin
  if Msg.wParam = 0 then Exit;
  if Pointer(Msg.wParam) = nil then Exit;
  if not (TObject(Msg.wParam) is TsfFlashPlayer) then Exit;

  with TsfFlashPlayer(Msg.wParam) do
  begin
    if Assigned(OnHandleFSCommand) then
      OnHandleFSCommand(TsfFlashPlayer(Msg.wParam), FFScommand, FFSargs);
    FFScommand := '';
    FFSargs := '';
  end;
end;



{ TsfFlashPlayer ==============================================================}

constructor TsfFlashPlayer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStream := TMemoryStream.Create;
  FVolume := 100;
  FVolumeControl := False;
  FVolumeControlFile := '';
  FFlashIndex := -1;
  WMode := 'Transparent';
  OnFSCommand := DoFSCommand;
  CreateWnd;
end;

destructor TsfFlashPlayer.Destroy;
begin
  DoneFlash;
  FStream.Free;
  inherited;
end;

procedure TsfFlashPlayer.DisableFlashSounds;
begin
  if FVolumeControl
  then
    begin
      if Value
      then
        SoundSetVolume(0)
      else
        SoundSetVolume(FVolume);
    end;
end;

procedure TsfFlashPlayer.SoundSetVolume(Value: Integer);
begin
  if FVolumeControlFile <> ''
  then
    begin
      LoadMovie(1, FVolumeControlFile + IntToStr(Value));
    end;
end;

procedure TsfFlashPlayer.InitVolumeControl;
var
  s, s1, i: Integer;
  FStrm: TFileStream;
  ResStrm: TResourceStream;
begin
  if FVolumeControlFile = ''
  then
    begin
      SetLength(FVolumeControlFile, 1000);
      s := GetTempPath(1000, PChar(FVolumeControlFile));
      SetLength(FVolumeControlFile, s);
      if (Length(FVolumeControlFile) > 0) and
         (FVolumeControlFile[Length(FVolumeControlFile)] <> '\')
      then
        FVolumeControlFile := FVolumeControlFile + '\';
      s := Random(10000);
      s1 := Random(10000);
      while FileExists(FVolumeControlFile + IntToStr(s)+IntToStr(s1) + '.swf') do
        inc(s);
      FVolumeControlFile := FVolumeControlFile + IntToStr(s)+IntToStr(s1) + '.swf';

      FStrm := TFileStream.Create(FVolumeControlFile, fmCreate);
      ResStrm := TResourceStream.Create(HInstance, 'SETVOLUME', RT_RCDATA);
      ResStrm.Position := 0;
      FStrm.CopyFrom(ResStrm, ResStrm.Size);
      ResStrm.Free;
      FStrm.Free;

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

      FVolumeControlFile := FVolumeControlFile + '?soundvolume=';

      SoundSetVolume(FVolume);
    end;
end;

procedure TsfFlashPlayer.SetVolume(Value: Integer);
begin
  if (Value >= 0) and (Value <= 100) and (Value <> FVolume)
  then
    begin
      FVolume := Value;
      SoundSetVolume(FVolume);
    end;
end;


procedure TsfFlashPlayer.SetVolumeControl(Value: Boolean);
begin
  FVolumeControl := Value;