sf_flash.pas

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

    if not Result then Exit;
  end;
  OleCheck(TypeInfo.GetDocumentation(MemberID, nil, nil, @HelpCtx, @HlpFile));
  HelpFile := OleStrToString(HlpFile);
  SysFreeString(HlpFile);
  Result := True;
end;

function TsfOleControl.GetIDispatchProp(Index: Integer): IDispatch;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := IDispatch(Temp.VDispatch);
end;

function TsfOleControl.GetIntegerProp(Index: Integer): Integer;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VInteger;
end;

function TsfOleControl.GetIUnknownProp(Index: Integer): IUnknown;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := IUnknown(Temp.VUnknown);
end;

function TsfOleControl.GetMainMenu: TMainMenu;
var
  Form: TCustomForm;
begin
  Result := nil;
  Form := GetParentForm(Self);
  if Form <> nil then
    if (Form is TForm) and (TForm(Form).FormStyle <> fsMDIChild) then
      Result := Form.Menu
    else
      if Application.MainForm <> nil then
        Result := Application.MainForm.Menu;
end;

procedure TsfOleControl.GetObjectVerbs(List: TStrings);
var
  EnumOleVerb: IEnumOleVerb;
  OleVerb: TOleVerb;
  Code: HResult;
begin
  CreateControl;
  List.Clear;
  Code := FOleObject.EnumVerbs(EnumOleVerb);
  if Code = OLE_S_USEREG then
    Code := OleRegEnumVerbs(FControlData.ClassID, EnumOleVerb);
  if Code = 0 then
    while (EnumOleVerb.Next(1, OleVerb, nil) = 0) do
      if (OleVerb.grfAttribs and OLEVERBATTRIB_ONCONTAINERMENU <> 0) then
      begin
        List.AddObject(StripHotkey(OleVerb.lpszVerbName), TObject(OleVerb.lVerb));
      end;
end;

function TsfOleControl.GetWordBoolProp(Index: Integer): WordBool;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VBoolean;
end;

function TsfOleControl.GetTDateTimeProp(Index: Integer): TDateTime;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VDate;
end;

function TsfOleControl.GetTFontProp(Index: Integer): TFont;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FFonts.Count-1 do
    if FControlData^.FontIDs^[I] = Index then
    begin
      Result := TFont(FFonts[I]);
      if Result.FontAdapter = nil then
        SetOleFont(Result, GetIDispatchProp(Index) as IFontDisp);
    end;
end;

function TsfOleControl.GetOleBoolProp(Index: Integer): TOleBool;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VBoolean;
end;

function TsfOleControl.GetOleDateProp(Index: Integer): TOleDate;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VDate;
end;

function TsfOleControl.GetOleEnumProp(Index: Integer): TOleEnum;
begin
  Result := GetIntegerProp(Index);
end;

function TsfOleControl.GetTOleEnumProp(Index: Integer): TOleEnum;
begin
  Result := GetIntegerProp(Index);
end;

function TsfOleControl.GetOleObject: Variant;
begin
  CreateControl;
  Result := Variant(FOleObject as IDispatch);
end;

function TsfOleControl.GetDefaultDispatch: IDispatch;
begin
  CreateControl;
  Result := FOleObject as IDispatch;
end;

function TsfOleControl.GetOleVariantProp(Index: Integer): OleVariant;
begin
  VarClear(Result);
  GetProperty(Index, TVarData(Result));
end;

function TsfOleControl.GetTPictureProp(Index: Integer): TPicture;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FPictures.Count-1 do
    if FControlData^.PictureIDs^[I] = Index then
    begin
      Result := TPicture(FPictures[I]);
      if Result.PictureAdapter = nil then
        SetOlePicture(Result, GetIDispatchProp(Index) as IPictureDisp);
    end;
end;


function TsfOleControl.GetPropDisplayString(DispID: Integer): string;
var
  S: WideString;
begin
  CreateControl;
  if (FPropBrowsing <> nil) and
    (FPropBrowsing.GetDisplayString(DispID, S) = 0) then
    Result := S else
    Result := GetStringProp(DispID);
end;

procedure TsfOleControl.GetPropDisplayStrings(DispID: Integer; List: TStrings);
var
  Strings: TCAPOleStr;
  Cookies: TCALongint;
  I: Integer;
begin
  CreateControl;
  List.Clear;
  if (FPropBrowsing <> nil) and
    (FPropBrowsing.GetPredefinedStrings(DispID, Strings, Cookies) = 0) then
    try
      for I := 0 to Strings.cElems - 1 do
        List.AddObject(Strings.pElems^[I], TObject(Cookies.pElems^[I]));
    finally
      for I := 0 to Strings.cElems - 1 do
        CoTaskMemFree(Strings.pElems^[I]);
      CoTaskMemFree(Strings.pElems);
      CoTaskMemFree(Cookies.pElems);
    end;
end;

var  // init to zero, never written to
  DispParams: TDispParams = ();

procedure TsfOleControl.GetProperty(Index: Integer; var Value: TVarData);
var
  Status: HResult;
  ExcepInfo: TExcepInfo;
begin
  CreateControl;
  Value.VType := varEmpty;
  Status := FControlDispatch.Invoke(Index, GUID_NULL, 0,
    DISPATCH_PROPERTYGET, DispParams, @Value, @ExcepInfo, nil);
  if Status <> 0 then DispatchInvokeError(Status, ExcepInfo);
end;

function TsfOleControl.GetShortIntProp(Index: Integer): ShortInt;
begin
  Result := GetIntegerProp(Index);
end;

function TsfOleControl.GetSingleProp(Index: Integer): Single;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VSingle;
end;

function TsfOleControl.GetSmallintProp(Index: Integer): Smallint;
var
  Temp: TVarData;
begin
  GetProperty(Index, Temp);
  Result := Temp.VSmallint;
end;

function TsfOleControl.GetStringProp(Index: Integer): string;
begin
  Result := GetVariantProp(Index);
end;

function TsfOleControl.GetVariantProp(Index: Integer): Variant;
begin
  Result := GetOleVariantProp(Index);
end;

function TsfOleControl.GetWideStringProp(Index: Integer): WideString;
var
  Temp: TVarData;
begin
  Result := '';
  GetProperty(Index, Temp);
  Pointer(Result) := Temp.VOleStr;
end;

function TsfOleControl.GetWordProp(Index: Integer): Word;
begin
  Result := GetIntegerProp(Index);
end;

procedure TsfOleControl.HookControlWndProc;
var
  WndHandle: HWnd;
begin
{  if (FOleInPlaceObject <> nil) and (WindowHandle = 0) then
  begin
    WndHandle := 0;
    FOleInPlaceObject.GetWindow(WndHandle);
    if WndHandle = 0 then raise EOleError.CreateRes(@SNoWindowHandle);
    WindowHandle := WndHandle;
    DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
    CreationControl := Self;
    SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));
    SendMessage(WindowHandle, WM_NULL, 0, 0);
  end;}
end;

procedure CallEventMethod(const EventInfo: TEventInfo);
asm
        PUSH    EBX
        PUSH    ESI
        PUSH    EBP
        MOV     EBP,ESP
        MOV     EBX,EAX
        MOV     EDX,[EBX].TEventInfo.ArgCount
        TEST    EDX,EDX
        JE      @@5
        XOR     EAX,EAX
        LEA     ESI,[EBX].TEventInfo.Args
@@1:    MOV     AL,[ESI].TEventArg.Kind
        CMP     AL,1
        JA      @@2
        JE      @@3
        TEST    AH,AH
        JNE     @@3
        MOV     ECX,[ESI].Integer[4]
        MOV     AH,1
        JMP     @@4
@@2:    PUSH    [ESI].Integer[8]
@@3:    PUSH    [ESI].Integer[4]
@@4:    ADD     ESI,12
        DEC     EDX
        JNE     @@1
@@5:    MOV     EDX,[EBX].TEventInfo.Sender
        MOV     EAX,[EBX].TEventInfo.Method.Data
        CALL    [EBX].TEventInfo.Method.Code
        MOV     ESP,EBP
        POP     EBP
        POP     ESI
        POP     EBX
end;

type
  PVarArg = ^TVarArg;
  TVarArg = array[0..3] of DWORD;

procedure TsfOleControl.D2InvokeEvent(DispID: TDispID; var Params: TDispParams);
type
  TStringDesc = record
    PStr: Pointer;
    BStr: PBStr;
  end;
var
  I, J, K, ArgType, ArgCount, StrCount: Integer;
  ArgPtr: PEventArg;
  ParamPtr: PVarArg;
  Strings: array[0..MaxDispArgs - 1] of TStringDesc;
  EventInfo: TEventInfo;
begin
  GetEventMethod(DispID, EventInfo.Method);
  if Integer(EventInfo.Method.Code) >= $10000 then
  begin
    StrCount := 0;
    try
      ArgCount := Params.cArgs;
      EventInfo.Sender := Self;
      EventInfo.ArgCount := ArgCount;
      if ArgCount <> 0 then
      begin
        ParamPtr := @Params.rgvarg^[EventInfo.ArgCount];
        ArgPtr := @EventInfo.Args;
        I := 0;
        repeat
          Dec(Integer(ParamPtr), SizeOf(TVarArg));
          ArgType := ParamPtr^[0] and $0000FFFF;
          if ArgType and varTypeMask = varOleStr then
          begin
            ArgPtr^.Kind := akDWord;
            with Strings[StrCount] do
            begin
              PStr := nil;
              if ArgType and varByRef <> 0 then
              begin
                OleStrToStrVar(PBStr(ParamPtr^[2])^, string(PStr));
                BStr := PBStr(ParamPtr^[2]);
                ArgPtr^.Data[0] := Integer(@PStr);
              end else
              begin
                OleStrToStrVar(TBStr(ParamPtr^[2]), string(PStr));
                BStr := nil;
                ArgPtr^.Data[0] := Integer(PStr);
              end;
            end;
            Inc(StrCount);
          end else
          begin
            case ArgType of
              varSingle:
                begin
                  ArgPtr^.Kind := akSingle;
                  ArgPtr^.Data[0] := ParamPtr^[2];
                end;
              varDouble..varDate:
                begin
                  ArgPtr^.Kind := akDouble;
                  ArgPtr^.Data[0] := ParamPtr^[2];
                  ArgPtr^.Data[1] := ParamPtr^[3];
                end;
              varDispatch:
                begin
                  ArgPtr^.Kind := akDWord;
                  ArgPtr^.Data[0] := Integer(ParamPtr)
                end;
            else
              ArgPtr^.Kind := akDWord;
              if (ArgType and varArray) <> 0 then
                ArgPtr^.Data[0] := Integer(ParamPtr)
              else
                ArgPtr^.Data[0] := ParamPtr^[2];
            end;
          end;
          Inc(Integer(ArgPtr), SizeOf(TEventArg));
          Inc(I);
        until I = EventInfo.ArgCount;
      end;
      CallEventMethod(EventInfo);
      J := StrCount;
      while J <> 0 do