sf_flashplayer.pas

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

  if (FFlashList <> nil) and (FFlashList.Flashs.Count > 0) and (FFlashIndex >= 0)
  then
    begin
     if FFlashIndex < 0 then FFlashIndex := 0;
     if FFlashIndex >= FFlashList.Flashs.Count - 1 then
       FFlashIndex := FFlashList.Flashs.Count - 1;

     if FFlashList.Flashs.Items[FFlashIndex].Flash <> nil
     then
       begin
         Flash := FFlashList.Flashs.Items[FFlashIndex].Flash;
         if Flash <> nil then
         begin
           LoadMovieFromStream(0, Flash);
        end;
     end;
  end
end;

procedure TsfFlashPlayer.TGotoFrame(const target: WideString; FrameNum: Integer);
begin
  if not FFlashNotExists  then DefaultInterface.TGotoFrame(target, FrameNum);
end;

procedure TsfFlashPlayer.TGotoLabel(const target: WideString; const label_: WideString);
begin
  if not FFlashNotExists  then DefaultInterface.TGotoLabel(target, label_);
end;

function TsfFlashPlayer.TCurrentFrame(const target: WideString): Integer;
begin
  Result := DefaultInterface.TCurrentFrame(target);
end;

function TsfFlashPlayer.TCurrentLabel(const target: WideString): WideString;
begin
  Result := DefaultInterface.TCurrentLabel(target);
end;

procedure TsfFlashPlayer.TPlay(const target: WideString);
begin
  if not FFlashNotExists  then DefaultInterface.TPlay(target);
end;

procedure TsfFlashPlayer.TStopPlay(const target: WideString);
begin
  if not FFlashNotExists  then DefaultInterface.TStopPlay(target);
end;

procedure TsfFlashPlayer.SetVariable(const name: WideString; const value: WideString);
begin
  if not FFlashNotExists  then DefaultInterface.SetVariable(name, value);
end;

function TsfFlashPlayer.GetVariable(const name: WideString): WideString;
begin
  Result := DefaultInterface.GetVariable(name);
end;

procedure TsfFlashPlayer.TSetProperty(const target: WideString; property_: SYSINT;
                                       const value: WideString);
begin
  if not FFlashNotExists  then DefaultInterface.TSetProperty(target, property_, value);
end;

function TsfFlashPlayer.TGetProperty(const target: WideString; property_: SYSINT): WideString;
begin
  Result := DefaultInterface.TGetProperty(target, property_);
end;

procedure TsfFlashPlayer.TCallFrame(const target: WideString; FrameNum: SYSINT);
begin
  if not FFlashNotExists  then DefaultInterface.TCallFrame(target, FrameNum);
end;

procedure TsfFlashPlayer.TCallLabel(const target: WideString; const label_: WideString);
begin
  if not FFlashNotExists  then DefaultInterface.TCallLabel(target, label_);
end;

procedure TsfFlashPlayer.TSetPropertyNum(const target: WideString; property_: SYSINT; value: Double);
begin
  if not FFlashNotExists  then DefaultInterface.TSetPropertyNum(target, property_, value);
end;

function TsfFlashPlayer.TGetPropertyNum(const target: WideString; property_: SYSINT): Double;
begin
  Result := DefaultInterface.TGetPropertyNum(target, property_);
end;

function TsfFlashPlayer.TGetPropertyAsNumber(const target: WideString; property_: SYSINT): Double;
begin
  Result := DefaultInterface.TGetPropertyAsNumber(target, property_);
end;

class function CoFlashProp.Create: IUnknown;
begin
  Result := CreateComObject(CLASS_FlashProp) as IUnknown;
end;

class function CoFlashProp.CreateRemote(const MachineName: string): IUnknown;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_FlashProp) as IUnknown;
end;

class function CoFlashObjectInterface.Create: IFlashObjectInterface;
begin
  Result := CreateComObject(CLASS_FlashObjectInterface) as IFlashObjectInterface;
end;

class function CoFlashObjectInterface.CreateRemote(const MachineName: string): IFlashObjectInterface;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_FlashObjectInterface) as IFlashObjectInterface;
end;

type
  TParentForm = class(TForm);

constructor TsfLayeredFlashForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FApplyRegions := False;
  FMouseDown := False;
  FIsDragging := False;
  FDragable := True;
  FFirstShow := True;
  FAlphaBlendValue := 200;
  FFlashPlayer := nil;
  FForm := nil;
  try
   FForm := (Owner as TForm);
  except
   if Owner is TCustomForm then FForm := TForm(Owner) else raise;
  end;
  if FForm <> nil
  then
    with FForm do
    begin
      AutoSize := False;
      AutoScroll := False;
      BorderStyle := bsNone;
      if not (csDesigning in ComponentState)
      then
        begin
          OldWindowProc := WindowProc;
          WindowProc := NewWndProc;
        end;
    end;
end;

destructor TsfLayeredFlashForm.Destroy;
begin
  inherited;
  if not (csDesigning in ComponentState) and (FForm <> nil)
  then
    FForm.WindowProc := OldWindowProc;
end;

procedure TsfLayeredFlashForm.Loaded;
begin
  inherited;
end;

procedure TsfLayeredFlashForm.Notification(AComponent: TComponent;
            Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FFlashPlayer)
  then  FFlashPlayer := nil;
end;

procedure TsfLayeredFlashForm.NewWndProc(var Message: TMessage);
var
  FCallOldWndProc: Boolean;
  P, CPos: TPoint;
  DC: Cardinal;
  Bmp: TsfBitmap;
begin
  FCallOldWndProc := True;
  with Message do
  begin
    case Msg of
      WM_RBUTTONUP:
        begin
          P.X := Short(LoWord(lParam));
          P.Y := HiWord(lParam);
          if not FFlashPlayer.DisableFlashPopup
          then
            FFlashPlayer.Perform(WM_RBUTTONUP, 0, lParam);
        end;
      WM_RBUTTONDOWN:
        begin
          P.X := Short(LoWord(lParam));
          P.Y := HiWord(lParam);
          if not FFlashPlayer.DisableFlashPopup
          then
            FFlashPlayer.Perform(WM_RBUTTONDOWN, 0, lParam);
        end;
      WM_LBUTTONUP:
        begin
          FMouseDown := False;
          P.X := Short(LoWord(lParam));
          P.Y := HiWord(lParam);
          FFlashPlayer.Perform(WM_LBUTTONUP, 0, lParam);
          if FDragable
          then
            begin
              FIsDragging := False;
              FDragX := 0;
              FDragY := 0;
            end;
        end;
      WM_LBUTTONDOWN:
        begin
          FMouseDown := True;
          P.X := Short(LoWord(lParam));
          P.Y := HiWord(lParam);
          FFlashPlayer.Perform(WM_LBUTTONDOWN, 0, lParam);
          //
          if FDragable
          then
            begin
              GetCursorPos(CPos);
              FDragX := CPos.X;
              FDragY := CPos.Y;
              FIsDragging := True;
            end;
          //
        end;
      WM_MOUSEMOVE:
        begin
          P.X := Short(LoWord(lParam));
          P.Y := HiWord(lParam);
          if not FMouseDown
          then
            FFlashPlayer.Perform(WM_MOUSEMOVE, 0, Cardinal(SmallPoint(P.X, P.Y)));
          if FIsDragging
          then
            begin
              GetCursorPos(CPos);
              FForm.SetBounds(FForm.Left + CPos.X - FDragX, FForm.Top + CPos.Y - FDragY,
                FForm.Width, FForm.Height);
              FDragX := CPos.X;
              FDragY := CPos.Y;
            end;
        end;
      WM_SHOWWINDOW:
       begin
         if FFirstShow and not FApplyRegions
         then
           begin
             SetWindowLong(FForm.Handle,
               GWL_EXSTYLE,
               GetWindowLong(FForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
             FFirstShow := False;
           end;
       end;
      WM_ERASEBKGND:
        begin
          if FApplyRegions and (FFlashPlayer <> nil)
          then
            begin
              Bmp := FFlashPlayer.GrabCurrentFrame2;
              if Bmp <> nil
              then
                begin
                  DC := GetDC(FForm.Handle);
                  Bmp.Draw(DC, 0, 0);
                  ReleaseDC(FForm.Handle, DC);
                  Message.Result := 1;
               end;
            end;
          FCallOldWndProc := False;
        end;
     end;
   end;
  if FCallOldWndProc then OldWindowProc(Message);
end;

type
  TsfParentPlayer = class(TsfFlashPlayer);

procedure TsfLayeredFlashForm.SetFlashPlayer(Value: TsfFlashPlayer);
begin
  FFlashPlayer := Value;
  if FFlashPlayer <> nil
  then
    begin
      FFlashPlayer.Align := alClient;
      FFlashPlayer.OnPaint := DoPaint;
      FFlashPlayer.Visible := False;
      FFlashPlayer.GrabProcess := True;
      FFlashPlayer.SetBounds(FFlashPlayer.Left, FFlashPlayer.Top,
        FFlashPlayer.Width, FFlashPlayer.Height);
      TsfParentPlayer(FFlashPlayer).Paint;
    end;
end;

procedure TsfLayeredFlashForm.DoPaint(Sender: TObject);
var
  Blend: TBLENDFUNCTION;
  Origin, Size, BitmapOrigin: Windows.TPoint;
  Bmp: TsfBitmap;
  OldRgn, Rgn: Cardinal;
begin
  if (csDesigning in ComponentState) then Exit;
  if FFlashPlayer = nil then Exit;
  if FForm = nil then Exit;

  Bmp := FFlashPlayer.GrabCurrentFrame2;
  if Bmp = nil then Exit;

  if not FApplyRegions
  then
    begin
      Origin := Point(TWinControl(Owner).Left, TWinControl(Owner).Top);
      Size := Point(Bmp.Width, Bmp.Height);
      with Blend do
      begin
        BlendOp := AC_SRC_OVER;
        AlphaFormat := $01;
        BlendFlags := 0;
        SourceConstantAlpha := FAlphaBlendValue;
      end;
      BitmapOrigin := Point(0, 0);
       UpdateLayeredWindow(FForm.Handle, 0, @Origin, @Size, Bmp.DC,
         @BitmapOrigin, $00000000, @Blend, ULW_ALPHA);
    end
  else
    begin
      Rgn := CreateRegionFromBitmap_Flash(Bmp, 0, 0);
      OldRgn := SetWindowRgn(FForm.Handle, Rgn, true);
      DeleteObject(Rgn);
      if OldRgn <> 0
      then
        begin
          InvalidateRect(FForm.Handle, nil, true);
          DeleteObject(OldRgn);
        end;
    end;   
end;

initialization
  CommandHandler := TsfCommandHandler.CreateHandler;
finalization
  CommandHandler.Free;
end.