sf_flash.pas

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

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       SmartFlash                                                  }
{       Version 1.50                                                }
{                                                                   }
{       Copyright (c) 2000-2007 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit sf_flash;

interface

{$R-,T-,H+,X+}
{$I sf_define.inc}
//{$DEFINE FlashTrial}


uses {$IFDEF AL_COMPILER6_UP} Variants, {$ENDIF} Windows, Messages, ActiveX, SysUtils, Classes, Controls, Forms,
  Menus, Graphics, ComObj, AxCtrls, sf_bitmap, sf_utils{$IFDEF AL_COMPILER7_UP},OLECtrls{$ENDIF};

const
  DVASPECT_TRANSPARENT = 32;
  DVASPECT_OPAQUE = 16;
  
type

//============================================================================
  LongWord = Integer;

  IDropTarget = interface;
  IViewObject = interface;
  IEnumUnknown = interface;
  IBindCtx = interface;
  IOleContainer_Flash = interface;
  IOleClientSite_Flash = interface;
  IParseDisplayName = interface;
  IMoniker_Flash = interface;
  IRunningObjectTable = interface;
  IEnumMoniker = interface;
  IEnumString = interface;
  IOleInPlaceSiteEx = interface;

//============================================================================
// interface IOleInPlaceSiteEx

  IOleInPlaceSiteEx = interface(IOleInPlaceSite)
    ['{9C2CAD80-3424-11CF-B670-00AA004CD6D8}']
    function OnInPlaceActivateEx(fNoRedraw: PBOOL;
       dwFlags: DWORD): HResult; stdcall;
    function OnInPlaceDeActivateEx(fNoRedraw: BOOL): HResult; stdcall;
    function RequestUIActivate: HResult; stdcall;
  end;

//============================================================================

//  IOleInPlaceActiveObject = interface;

  IEnumString = interface(IUnknown)
    ['{00000101-0000-0000-C000-000000000046}']
    function Next(celt: Longint; out elt;
      pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out enm: IEnumString): HResult; stdcall;
  end;

  PIMoniker_Flash = ^IMoniker_Flash;
  IEnumMoniker = interface(IUnknown)
    ['{00000102-0000-0000-C000-000000000046}']
    function Next(celt: Longint; out elt;
      pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out enm: IEnumMoniker): HResult; stdcall;
  end;

  IRunningObjectTable = interface(IUnknown)
    ['{00000010-0000-0000-C000-000000000046}']
    function Register(grfFlags: Longint; const unkObject: IUnknown;
      const mkObjectName: IMoniker_Flash; out dwRegister: Longint): HResult; stdcall;
    function Revoke(dwRegister: Longint): HResult; stdcall;
    function IsRunning(const mkObjectName: IMoniker_Flash): HResult; stdcall;
    function GetObject(const mkObjectName: IMoniker_Flash;
      out unkObject: IUnknown): HResult; stdcall;
    function NoteChangeTime(dwRegister: Longint;
      const filetime: TFileTime): HResult; stdcall;
    function GetTimeOfLastChange(const mkObjectName: IMoniker_Flash;
      out filetime: TFileTime): HResult; stdcall;
    function EnumRunning(out enumMoniker: IEnumMoniker): HResult; stdcall;
  end;

  IOleObject_Flash = interface(IUnknown)
    ['{00000112-0000-0000-C000-000000000046}']
    function SetClientSite(const clientSite: IOleClientSite_Flash): HResult;
      stdcall;
    function GetClientSite(out clientSite: IOleClientSite_Flash): HResult;
      stdcall;
    function SetHostNames(szContainerApp: POleStr;
      szContainerObj: POleStr): HResult; stdcall;
    function Close(dwSaveOption: Longint): HResult; stdcall;
    function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker_Flash): HResult;
      stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
      out mk: IMoniker_Flash): HResult; stdcall;
    function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
      dwReserved: Longint): HResult; stdcall;
    function GetClipboardData(dwReserved: Longint;
      out dataObject: IDataObject): HResult; stdcall;
    function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite_Flash;
      lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
      stdcall;
    function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
    function Update: HResult; stdcall;
    function IsUpToDate: HResult; stdcall;
    function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
    function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
      stdcall;
    function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
      stdcall;
    function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
      stdcall;
    function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
      stdcall;
    function Unadvise(dwConnection: Longint): HResult; stdcall;
    function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
    function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
      stdcall;
    function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
  end;

//============================================================================
// interface IDropTarget

  IDropTarget = interface(IUnknown)
    ['{00000122-0000-0000-C000-000000000046}']
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
  end;

//============================================================================

//============================================================================
// interface IViewObject

  IViewObject = interface(IUnknown)
    ['{0000010D-0000-0000-C000-000000000046}']
    function Draw(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
      ptd: PDVTargetDevice; hicTargetDev: HDC; hdcDraw: HDC;
      prcBounds: PRect; prcWBounds: PRect; fnContinue: TContinueFunc;
      dwContinue: Longint): HResult; stdcall;
    function GetColorSet(dwDrawAspect: Longint; lindex: Longint;
      pvAspect: Pointer; ptd: PDVTargetDevice; hicTargetDev: HDC;
      out colorSet: PLogPalette): HResult; stdcall;
    function Freeze(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
      out dwFreeze: Longint): HResult; stdcall;
    function Unfreeze(dwFreeze: Longint): HResult; stdcall;
    function SetAdvise(aspects: Longint; advf: Longint;
      const advSink: IAdviseSink): HResult; stdcall;
    function GetAdvise(pAspects: PLongint; pAdvf: PLongint;
      out advSink: IAdviseSink): HResult; stdcall;
  end;
//============================================================================

//============================================================================
// interface IEnumUnknown

  IEnumUnknown = interface(IUnknown)
    ['{00000100-0000-0000-C000-000000000046}']
    function Next(celt: Longint; out elt;
      pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out enm: IEnumUnknown): HResult; stdcall;
  end;
//============================================================================

//============================================================================
// interface IBindCtx

  PBindOpts = ^TBindOpts;
  TBindOpts = record
    cbStruct: Longint;
    grfFlags: Longint;
    grfMode: Longint;
    dwTickCountDeadline: Longint;
  end;

  IBindCtx = interface(IUnknown)
    ['{0000000E-0000-0000-C000-000000000046}']
    function RegisterObjectBound(const unk: IUnknown): HResult; stdcall;
    function RevokeObjectBound(const unk: IUnknown): HResult; stdcall;
    function ReleaseBoundObjects: HResult; stdcall;
    function SetBindOptions(const bindopts: TBindOpts): HResult; stdcall;
    function GetBindOptions(var bindopts: TBindOpts): HResult; stdcall;
    function GetRunningObjectTable(out rot: IRunningObjectTable): HResult;
      stdcall;
    function RegisterObjectParam(pszKey: POleStr; const unk: IUnknown): HResult;
      stdcall;
    function GetObjectParam(pszKey: POleStr; out unk: IUnknown): HResult;
      stdcall;
    function EnumObjectParam(out pEnumString: IEnumString): HResult; stdcall;
    function RevokeObjectParam(pszKey: POleStr): HResult; stdcall;
  end;
//============================================================================

  IParseDisplayName = interface(IUnknown)
    ['{0000011A-0000-0000-C000-000000000046}']
    function ParseDisplayName(const bc: IBindCtx; pszDisplayName: POleStr;
      out chEaten: Longint; out mkOut: IMoniker_Flash): HResult; stdcall;
  end;

  IOleContainer_Flash = interface(IParseDisplayName)
    ['{0000011B-0000-0000-C000-000000000046}']
    function EnumObjects(grfFlags: Longint; out pEnumUnknown: IEnumUnknown): HResult;
      stdcall;
    function LockContainer(fLock: BOOL): HResult; stdcall;
  end;

  IOleClientSite_Flash = interface(IUnknown)
    ['{00000118-0000-0000-C000-000000000046}']
    function SaveObject: HResult; stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
      out mk: IMoniker_Flash): HResult; stdcall;
    function GetContainer(out container: IOleContainer_Flash): HResult; stdcall;
    function ShowObject: HResult; stdcall;
    function OnShowWindow(fShow: BOOL): HResult; stdcall;
    function RequestNewObjectLayout: HResult; stdcall;
  end;

  IMoniker_Flash = interface(IPersistStream)
    ['{0000000F-0000-0000-C000-000000000046}']
    function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker_Flash;
      const iidResult: TIID; out vResult): HResult; stdcall;
    function BindToStorage(const bc: IBindCtx; const mkToLeft: IMoniker_Flash;
      const iid: TIID; out vObj): HResult; stdcall;
    function Reduce(const bc: IBindCtx; dwReduceHowFar: Longint;
      mkToLeft: PIMoniker_Flash; out mkReduced: IMoniker_Flash): HResult; stdcall;
    function ComposeWith(const mkRight: IMoniker_Flash; fOnlyIfNotGeneric: BOOL;
      out mkComposite: IMoniker_Flash): HResult; stdcall;
    function Enum(fForward: BOOL; out enumMoniker: IEnumMoniker): HResult;
      stdcall;
    function IsEqual(const mkOtherMoniker: IMoniker_Flash): HResult; stdcall;
    function Hash(out dwHash: Longint): HResult; stdcall;
    function IsRunning(const bc: IBindCtx; const mkToLeft: IMoniker_Flash;
      const mkNewlyRunning: IMoniker_Flash): HResult; stdcall;
    function GetTimeOfLastChange(const bc: IBindCtx; const mkToLeft: IMoniker_Flash;
      out filetime: TFileTime): HResult; stdcall;
    function Inverse(out mk: IMoniker_Flash): HResult; stdcall;
    function CommonPrefixWith(const mkOther: IMoniker_Flash;
      out mkPrefix: IMoniker_Flash): HResult; stdcall;
    function RelativePathTo(const mkOther: IMoniker_Flash;
      out mkRelPath: IMoniker_Flash): HResult; stdcall;
    function GetDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker_Flash;
      out pszDisplayName: POleStr): HResult; stdcall;
    function ParseDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker_Flash;
      pszDisplayName: POleStr; out chEaten: Longint;
      out mkOut: IMoniker_Flash): HResult; stdcall;
    function IsSystemMoniker(out dwMksys: Longint): HResult; stdcall;
  end;

//============================================================================
// interface DShockwaveFlashEvents

  DShockwaveFlashEvents = interface(IDispatch)
    ['{d27cdb6d-ae6d-11cf-96b8-444553540000}']
  end;

// interface IOleInPlaceSiteWindowless

  IOleInPlaceSiteWindowless = interface(IOleInPlaceSiteEx)
    ['{922EADA0-3424-11CF-B670-00AA004CD6D8}']
    function CanWindowlessActivate: HResult; stdcall;
    function GetCapture: HResult; stdcall;
    function SetCapture(fCapture: BOOL): HResult; stdcall;
    function GetFocus: HResult; stdcall;
    function SetFocus(fFocus: BOOL): HResult; stdcall;
    function GetDC(var Rect: TRect; qrfFlags: DWORD;
       var hDC: HDC): HResult; stdcall;
    function ReleaseDC(hDC: HDC): HResult; stdcall;
    function InvalidateRect(Rect: PRect; fErase: BOOL): HResult; stdcall;
    function InvalidateRgn(hRGN: HRGN; fErase: BOOL): HResult; stdcall;
    function ScrollRect(dx, dy: Integer; var RectScroll: TRect;
       var RectClip: TRect): HResult; stdcall;
    function AdjustRect(var rc: TRect): HResult; stdcall;
    function OnDefWindowMessage(msg: LongWord; wParam: WPARAM;
       lParam: LPARAM; var LResult: LRESULT): HResult; stdcall;
  end;

// interface IOleInPlaceObjectWindowless

  IOleInPlaceObjectWindowless = interface(IOleInPlaceObject)
    ['{1C2056CC-5EF4-101B-8BC8-00AA003E3B29}']
    function OnWindowMessage(msg: LongWord; wParam: WPARAM; lParam: LPARAM;
        var lResult: LRESULT): HResult; stdcall;
    function OnDropTarget(var pDropTarget: IDropTarget):HResult ; stdcall;
  end;

  TsfOleControl = class;

  TEventDispatch = class(TObject, IUnknown, IDispatch)
  private
    FControl: TsfOleControl;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
    property Control: TsfOleControl read FControl;
  public
    constructor Create(Control: TsfOleControl);
  end;

  TEnumValue = record
    Value: Longint;
    Ident: string;
  end;

  PEnumValueList = ^TEnumValueList;
  TEnumValueList = array[0..32767] of TEnumValue;

  TEnumPropDesc = class
  private
    FDispID: Integer;
    FValueCount: Integer;
    FValues: PEnumValueList;
  public
    constructor Create(DispID, ValueCount: Integer;
      const TypeInfo: ITypeInfo);
    destructor Destroy; override;
    procedure GetStrings(Proc: TGetStrProc);
    function StringToValue(const S: string): Integer;
    function ValueToString(V: Integer): string;
  end;

  PControlData = ^TControlData;
  TControlData = record
    ClassID: TGUID;
    EventIID: TGUID;
    EventCount: Longint;
    EventDispIDs: Pointer;
    LicenseKey: Pointer;
    Flags: DWORD;
    Version: Integer;
    FontCount: Integer;
    FontIDs: PDispIDList;
    PictureCount: Integer;
    PictureIDs: PDispIDList;
    Reserved: Integer;
    InstanceCount: Integer;
    EnumPropDescs: TList;
  end;

  PControlData2 = ^TControlData2;
  TControlData2 = record
    ClassID: TGUID;
    EventIID: TGUID;
    EventCount: Longint;
    EventDispIDs: Pointer;
    LicenseKey: Pointer;
    Flags: DWORD;
    Version: Integer;
    FontCount: Integer;
    FontIDs: PDispIDList;
    PictureCount: Integer;
    PictureIDs: PDispIDList;
    Reserved: Integer;
    InstanceCount: Integer;
    EnumPropDescs: TList;
    FirstEventOfs: Cardinal;
  end;