DELPHI 包装.NET COM组件

       Delphi 可以很容易的将.NET COM组件包装成简单的ActiveX控件，任意调用，但是有一些由于DELPHI不包含.NET 属性可能造成ACTIVEX控件会报错，通常是颜色等。详细的属性详见Winapi.ActiveX.pas核心代码。

  修改方法1：直接修改源代码再编译。

{ Standard dispatch ID constants }
<pre name="code" class="delphi">procedure TOleControl.CreateControl;
var
  Stream: IStream;
  CS: IOleClientSite;
  X: Integer;
begin
  if FOleControl = nil then
    try
      try  // work around ATL bug
        X := FOleObject.GetClientSite(CS);
      except
        X := -1;
      end;
      if (X <> 0) or (CS = nil) then
        OleCheck(FOleObject.SetClientSite(Self));
      if FObjectData = 0 then OleCheck(FPersistStream.InitNew) else
      begin
        OleCheck(CreateStreamOnHGlobal(FObjectData, False, Stream));
        OleCheck(FPersistStream.Load(Stream));
        DestroyStorage;
      end;
      OleCheck(FOleObject.QueryInterface(IOleControl, FOleControl));
      OleCheck(FOleObject.QueryInterface(IDispatch, FControlDispatch));
      FOleObject.QueryInterface(IPerPropertyBrowsing, FPropBrowsing);
      InterfaceConnect(FOleObject, IPropertyNotifySink,
        Self, FPropConnection);
      InterfaceConnect(FOleObject, FControlData^.EventIID,
        FEventDispatch, FEventsConnection);
      //
//      if FControlData^.Flags and cfBackColor <> 0 then
//        OnChanged(DISPID_BACKCOLOR);

      if FControlData^.Flags and cfEnabled <> 0 then
        OnChanged(DISPID_ENABLED);
      if FControlData^.Flags and cfFont <> 0 then
        OnChanged(DISPID_FONT);
      if FControlData^.Flags and cfForeColor <> 0 then
        OnChanged(DISPID_FORECOLOR);
      FOleControl.OnAmbientPropertyChange(DISPID_UNKNOWN);
      RequestNewObjectLayout;
    except
      DestroyControl;
      raise;
    end;
end;

{$EXTERNALSYM DISPID_AUTOSIZE} DISPID_AUTOSIZE = -500; {$EXTERNALSYM DISPID_BACKCOLOR} <span style="color:#ff0000;"> DISPID_BACKCOLOR = -501; {$EXTERNALSYM DISPID_BACKSTYLE}</span> DISPID_BACKSTYLE = -502; {$EXTERNALSYM DISPID_BORDERCOLOR} DISPID_BORDERCOLOR = -503; {$EXTERNALSYM DISPID_BORDERSTYLE} DISPID_BORDERSTYLE = -504; {$EXTERNALSYM DISPID_BORDERWIDTH} DISPID_BORDERWIDTH = -505; {$EXTERNALSYM DISPID_DRAWMODE} DISPID_DRAWMODE = -507; {$EXTERNALSYM DISPID_DRAWSTYLE} DISPID_DRAWSTYLE = -508; {$EXTERNALSYM DISPID_DRAWWIDTH} DISPID_DRAWWIDTH = -509; {$EXTERNALSYM DISPID_FILLCOLOR} DISPID_FILLCOLOR = -510; {$EXTERNALSYM DISPID_FILLSTYLE} DISPID_FILLSTYLE = -511; {$EXTERNALSYM DISPID_FONT} DISPID_FONT = -512; {$EXTERNALSYM DISPID_FORECOLOR} DISPID_FORECOLOR = -513;<span style="color:#ff0000;"> {$EXTERNALSYM DISPID_ENABLED} DISPID_ENABLED = -514;</span> {$EXTERNALSYM DISPID_HWND} DISPID_HWND = -515; {$EXTERNALSYM DISPID_TABSTOP} DISPID_TABSTOP = -516; {$EXTERNALSYM DISPID_TEXT} DISPID_TEXT = -517; {$EXTERNALSYM DISPID_CAPTION} DISPID_CAPTION = -518; {$EXTERNALSYM DISPID_BORDERVISIBLE} DISPID_BORDERVISIBLE = -519; {$EXTERNALSYM DISPID_APPEARANCE} DISPID_APPEARANCE = -520; {$EXTERNALSYM DISPID_MOUSEPOINTER} DISPID_MOUSEPOINTER = -521; {$EXTERNALSYM DISPID_MOUSEICON} DISPID_MOUSEICON = -522; {$EXTERNALSYM DISPID_PICTURE} DISPID_PICTURE = -523; {$EXTERNALSYM DISPID_VALID} DISPID_VALID = -524; {$EXTERNALSYM DISPID_READYSTATE} DISPID_READYSTATE = -525; {$EXTERNALSYM DISPID_REFRESH} DISPID_REFRESH = -550; {$EXTERNALSYM DISPID_DOCLICK} DISPID_DOCLICK = -551; {$EXTERNALSYM DISPID_ABOUTBOX} DISPID_ABOUTBOX = -552;

红色表示是不支持，不知道如何转换成DELPHI对象。暂时不知道，不过暂时不需要知道。

unit Vcl.OleCtrls;

procedure TOleControl.CreateControl;
var
  Stream: IStream;
  CS: IOleClientSite;
  X: Integer;
begin
  if FOleControl = nil then
    try
      try  // work around ATL bug
        X := FOleObject.GetClientSite(CS);
      except
        X := -1;
      end;
      if (X <> 0) or (CS = nil) then
        OleCheck(FOleObject.SetClientSite(Self));
      if FObjectData = 0 then OleCheck(FPersistStream.InitNew) else
      begin
        OleCheck(CreateStreamOnHGlobal(FObjectData, False, Stream));
        OleCheck(FPersistStream.Load(Stream));
        DestroyStorage;
      end;
      OleCheck(FOleObject.QueryInterface(IOleControl, FOleControl));
      OleCheck(FOleObject.QueryInterface(IDispatch, FControlDispatch));
      FOleObject.QueryInterface(IPerPropertyBrowsing, FPropBrowsing);
      InterfaceConnect(FOleObject, IPropertyNotifySink,
        Self, FPropConnection);
      InterfaceConnect(FOleObject, FControlData^.EventIID,
        FEventDispatch, FEventsConnection);
      //
//      if FControlData^.Flags and cfBackColor <> 0 then
//        OnChanged(DISPID_BACKCOLOR);

      if FControlData^.Flags and cfEnabled <> 0 then
        OnChanged(DISPID_ENABLED);
      if FControlData^.Flags and cfFont <> 0 then
        OnChanged(DISPID_FONT);
      if FControlData^.Flags and cfForeColor <> 0 then
        OnChanged(DISPID_FORECOLOR);
      FOleControl.OnAmbientPropertyChange(DISPID_UNKNOWN);
      RequestNewObjectLayout;
    except
      DestroyControl;
      raise;
    end;
end;

删除如上代码或者，直接覆盖OnChange方法。

修改方法2：在构造方法中，修改传递参数

是

procedure TExFxCtrl.InitControlData;
const
  CEventDispIDs: array [0..7] of DWORD = (
    $000000C9, $000000CA, $000000CB, $000000CC, $000000CD, $000000CE,
    $000000CF, $000000D0);
  CTFontIDs: array [0..0] of DWORD = (
    $FFFFFE00);
  CControlData: TControlData2 = (
     ClassID:      '{4B9D6684-D466-4C72-8BE1-88FA1E9E0B2F}';
     EventIID:     '{B9DF5E90-AB92-4D7C-84D1-4AC98D0ED682}';
    EventCount:   0;
    EventDispIDs: nil;
    LicenseKey:   nil (*HR:$00000000*);
    <span style="color:#ff0000;">Flags:        $00000000;//修改这里就行了。</span>
    Version:      500;
    FontCount:    1;
    FontIDs:      @CTFontIDs);
begin
  ControlData := @CControlData;
  TControlData2(CControlData).FirstEventOfs := UIntPtr(@@FOnActivate) - UIntPtr(Self);
end;

============================

另外在DELPHI XE原来的简单使用PCHAR要注意，默认的PCHAR是PWideChar，很多WINDOWS API的底层的都是LPCSTR都要修改为PAnsiChar!

procedure WindowExec(AFileName:String;args:String;uCmdShow: UINT);
var
  sDir:String;
  sCmd:String;
begin
  sDir:=ExtractFilePath(AFileName);
  GetWindowsDirectory(PChar(SDir),Sizeof(sDir));
  sCmd:= AFileName+' '+args;
  //--------------------------------------------
  WinExec(PAnsiChar(sCmd),  uCmdShow);
end;

阿斯