在Delphi中动态创建ActiveX组件

分类： Delphi 2008-11-25 11:13 1200人阅读 评论(0) 收藏 举报

delphiconstructorstringactionwindowsforms

最近一个项目需要程序能动态的创建ActiveX组件，并在当前窗口显示出来，google了一下，未能找到前辈们的指点，就只能自己动手了，研究了一下Delphi中ActiveX相关单元的源码后，自己编写了一个类，可以实现动态创建ActiveX组件，放在这里自娱自乐一下，也免后来者重蹈我的覆辙。

[delphi] view plaincopy

1. unit DynamicOleControl;  
2.   
3. interface  
4.   
5. uses Windows, Classes, ActiveX, OleCtrls, ComObj;  
6.   
7. type  
8.   TDynamicOleControl = class(TOleControl)  
9.   private  
10.     FClassID: TGUID;  
11.     FIntf: IUnknown;  
12.   
13.     function  GetControlInterface: IUnknown;  
14.   protected  
15.     procedure CreateControl;  
16.     procedure InitControlData; override;  
17.   public  
18.     constructor CreateFromClassID(AOwner: TComponent; AClassID: TGUID); overload;  
19.     constructor CreateFromClassID(AOwner: TComponent; AClassID: string); overload;  
20.     constructor CreateFromProgID(AOwner: TComponent; AProgID: string);  
21.   
22.     property  ControlInterface: IUnknown read GetControlInterface;  
23.     property  DefaultInterface: IUnknown read GetControlInterface;  
24.   
25.   published  
26.     property Anchors;  
27.   end;  
28.   
29. implementation  
30.   
31. constructor TDynamicOleControl.CreateFromClassID(AOwner: TComponent;  
32.   AClassID: TGUID);  
33. begin  
34.   FClassID := AClassID;  
35.   
36.   inherited Create(AOwner);  
37. end;  
38.   
39. constructor TDynamicOleControl.CreateFromClassID(AOwner: TComponent; AClassID: string);  
40. begin  
41.   FClassID := StringToGUID(AClassID);  
42.   inherited Create(AOwner);  
43. end;  
44.   
45. constructor TDynamicOleControl.CreateFromProgID(AOwner: TComponent;  
46.   AProgID: string);  
47. begin  
48.   FClassID := ProgIDToClassID(AProgID);  
49.   inherited Create(AOwner);  
50. end;  
51.   
52. procedure TDynamicOleControl.InitControlData;  
53. const  
54.   CControlData: TControlData2 = (  
55.     ClassID: '';  
56.     EventIID: '';  
57.     EventCount: 0;  
58.     LicenseKey: nil;  
59.     Flags: $00000000; //$0000001D  
60.     Version: 401  
61.     );  
62. begin  
63.   CopyMemory(@CControlData.ClassID, @FClassID, SizeOf(TGUID));  
64.   ControlData := @CControlData;  
65. end;  
66.   
67. procedure TDynamicOleControl.CreateControl;  
68.   
69.   procedure DoCreate;  
70.   begin  
71.     FIntf := IUnknown(OleObject) as IUnknown;  
72.   end;  
73.   
74. begin  
75.   if FIntf = nil then DoCreate;  
76. end;  
77.   
78. function TDynamicOleControl.GetControlInterface: IUnknown;  
79. begin  
80.   CreateControl;  
81.   Result := FIntf;  
82. end;  
83.   
84. end.  

例子程序运行效果如下图所示：

DynamicOleControl.pas单元的使用比较简单，该例子的源码如下，大家一看就明白：

[delphi] view plaincopy

1. unit MainUnit;  
2.   
3. interface  
4.   
5. uses  
6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
7.   Dialogs, DynamicOleControl, StdCtrls, Buttons, ExtCtrls, ComObj;  
8.   
9. type  
10.   TMainForm = class(TForm)  
11.     pnl1: TPanel;  
12.     pnlContainer: TPanel;  
13.     lbl1: TLabel;  
14.     edtClassID: TEdit;  
15.     btnLoad: TBitBtn;  
16.     btnFree: TBitBtn;  
17.     Label1: TLabel;  
18.     edtProgID: TEdit;  
19.     Label2: TLabel;  
20.     procedure btnFreeClick(Sender: TObject);  
21.     procedure btnLoadClick(Sender: TObject);  
22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);  
23.     procedure FormCreate(Sender: TObject);  
24.   private  
25.     { Private declarations }  
26.     FMyOleControl: TDynamicOleControl;  
27.   
28.     procedure FreeOleControl;  
29.   public  
30.     { Public declarations }  
31.   end;  
32.   
33. var  
34.   MainForm: TMainForm;  
35.   
36. implementation  
37.   
38. {$R *.dfm}  
39.             
40. procedure TMainForm.FormCreate(Sender: TObject);  
41. begin  
42.   FMyOleControl := nil;  
43. end;  
44.   
45. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);  
46. begin  
47.   FreeOleControl;  
48. end;  
49.   
50. procedure TMainForm.FreeOleControl;  
51. begin  
52.   if Assigned(FMyOleControl) then  
53.     FreeAndNil(FMyOleControl);  
54. end;  
55.   
56. procedure TMainForm.btnFreeClick(Sender: TObject);  
57. begin  
58.   FreeOleControl;  
59. end;  
60.   
61. procedure TMainForm.btnLoadClick(Sender: TObject);  
62. begin  
63.   FreeOleControl;  
64.   
65.   try  
66.     if Trim(edtClassID.Text) <> '' then  
67.       FMyOleControl := TDynamicOleControl.CreateFromClassID(Self,  
68.         Trim(edtClassID.Text))  
69.     else if Trim(edtProgID.Text) <> '' then  
70.       FMyOleControl := TDynamicOleControl.CreateFromProgID(Self,  
71.         Trim(edtProgID.Text));  
72.   
73.     if Assigned(FMyOleControl) then  
74.     begin  
75.       pnlContainer.InsertControl(FMyOleControl);  
76.       FMyOleControl.Align := alClient;  
77.     end;  
78.   except  
79.     on e: EOleSysError do  
80.       Application.MessageBox(PChar(e.Message), '错误', MB_OK + MB_ICONERROR);  
81.   end;  
82. end;  
83.   
84. end.  

后记：

     最近忙得有点天昏地暗，以后有时间再封装一下对动态加载后的ActiveX组件的相关操作方法。