Стартовый пул

ActiveX/LazActiveX.lpk

@@ -0,0 +1,57 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="LazActiveX"/>
+    <Author Value="Ludo Brands"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Other>
+        <CompilerMessages>
+          <UseMsgFile Value="True"/>
+        </CompilerMessages>
+        <CustomOptions Value="-Ur"/>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="Type Library importer and visual ActiveX container"/>
+    <License Value="modified LGPL-2"/>
+    <Version Minor="1"/>
+    <Files Count="4">
+      <Item1>
+        <Filename Value="activexcontainer.pas"/>
+        <UnitName Value="activexcontainer"/>
+      </Item1>
+      <Item2>
+        <Filename Value="lazactivexreg.pas"/>
+        <HasRegisterProc Value="True"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="lazactivexreg"/>
+      </Item2>
+      <Item3>
+        <Filename Value="importtypelib.lfm"/>
+        <Type Value="LFM"/>
+      </Item3>
+      <Item4>
+        <Filename Value="importtypelib.pas"/>
+        <UnitName Value="ImportTypelib"/>
+      </Item4>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="1">
+      <Item1>
+        <PackageName Value="IDEIntf"/>
+      </Item1>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

ActiveX/LazActiveX.pas

@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit LazActiveX;
+
+interface
+
+uses
+  activexcontainer, lazactivexreg, ImportTypelib, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+  RegisterUnit('lazactivexreg', @lazactivexreg.Register);
+end;
+
+initialization
+  RegisterPackage('LazActiveX', @Register);
+end.

ActiveX/Makefile.fpc

@@ -0,0 +1,55 @@
+#   File generated automatically by Lazarus Package Manager
+#
+#   Makefile.fpc for LazActiveX 0.1
+#
+#   This file was generated on 22/5/2013
+
+[package]
+name=lazactivex
+version=0.1
+
+[compiler]
+unittargetdir=lib/$(CPU_TARGET)-$(OS_TARGET)
+unitdir=../../packager/units/$(CPU_TARGET)-$(OS_TARGET) ../lazutils/lib/$(CPU_TARGET)-$(OS_TARGET) ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET) ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) ../lazcontrols/lib/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) ../ideintf/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM) .
+options= -MObjFPC -Scghi -O1 -g -gl -vewnhi -l -dLCL -dLCL$(LCL_PLATFORM) -Ur
+
+[target]
+units=LazActiveX.pas
+
+[clean]
+files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \
+      $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) \
+      $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \
+      $(wildcard $(COMPILER_UNITTARGETDIR)/*.lfm) \
+      $(wildcard $(COMPILER_UNITTARGETDIR)/*.res) \
+      $(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \
+      $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
+[prerules]
+# LCL Platform
+ifndef LCL_PLATFORM
+ifeq ($(OS_TARGET),win32)
+LCL_PLATFORM=win32
+else
+ifeq ($(OS_TARGET),win64)
+LCL_PLATFORM=win32
+else
+ifeq ($(OS_TARGET),darwin)
+LCL_PLATFORM=carbon
+else
+LCL_PLATFORM=gtk2
+endif
+endif
+endif
+endif
+export LCL_PLATFORM
+
+[rules]
+.PHONY: cleartarget compiled all
+
+cleartarget:
+        -$(DEL) $(COMPILER_UNITTARGETDIR)/lazactivex$(PPUEXT)
+
+compiled:
+        $(CPPROG) -f Makefile.compiled $(COMPILER_UNITTARGETDIR)/LazActiveX.compiled
+
+all: cleartarget $(COMPILER_UNITTARGETDIR) lazactivex$(PPUEXT) compiled

ActiveX/README.txt

@@ -0,0 +1,16 @@
+LazActiveX Package
+------------------
+The LazActiveX package contains the TActiveXContainer component and the IDE
+integration of the necessary tools to create ActiveX components from a type
+library or directly from the object (exe or dll).
+
+REQUIREMENTS:
+-------------
+Windows XP or newer
+FPC >= 2.6.1
+
+DOCUMENTATION:
+--------------
+Documentation and samples can be found at http://wiki.freepascal.org/LazActiveX
+
+

ActiveX/activexcontainer.pas

@@ -0,0 +1,639 @@
+unit activexcontainer;
+
+{$mode delphi}{$H+}
+
+{ Visual ActiveX container.
+
+  Copyright (C) 2011 Ludo Brands
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Windows, ActiveX, ComObj, Forms, Graphics;
+
+type
+  //from OCIDL.h
+  PPointF = ^TPointF;
+  tagPOINTF = record
+    x: Single;
+    y: Single;
+  end;
+  TPointF = tagPOINTF;
+  POINTF = TPointF;
+
+
+  IOleControlSite = interface
+    ['{B196B289-BAB4-101A-B69C-00AA00341D07}']
+    function OnControlInfoChanged: HResult; stdcall;
+    function LockInPlaceActive(fLock: BOOL): HResult; stdcall;
+    function GetExtendedControl(out disp: IDispatch): HResult; stdcall;
+    function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF;
+      flags: Longint): HResult; stdcall;
+    function TranslateAccelerator(msg: PMsg; grfModifiers: Longint): HResult;
+       stdcall;
+    function OnFocus(fGotFocus: BOOL): HResult; stdcall;
+    function ShowPropertyFrame: HResult; stdcall;
+  end;
+
+  IPropertyNotifySink = interface
+    ['{9BFBBC02-EFF1-101A-84ED-00AA00341D07}']
+    function OnChanged(dispid: TDispID): HResult; stdcall;
+    function OnRequestEdit(dispid: TDispID): HResult; stdcall;
+  end;
+
+  ISimpleFrameSite = interface
+    ['{742B0E01-14E6-101B-914E-00AA00300CAB}']
+    function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
+      out res: Integer; out Cookie: Longint): HResult;
+      stdcall;
+    function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
+      out res: Integer; Cookie: Longint): HResult;
+      stdcall;
+  end;
+
+
+  TStatusTextEvent = procedure(Sender: TObject; Status:string) of object;
+
+  { TActiveXContainer }
+
+  TActiveXContainer = class(TWinControl, IUnknown, IOleClientSite,
+    IOleControlSite, IOleInPlaceSite, IOleInPlaceFrame, IDispatch)
+    private
+      FActive: boolean;
+      FAttached: boolean;
+      FClassName: string;
+      FOleObject: IDispatch;
+      FOnStatusText: TStatusTextEvent;
+      FPrevWndProc:windows.WNDPROC;
+      Function GetvObject:variant;
+      //IOleClientSite
+      Function SaveObject: HResult;StdCall;
+      Function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;OUT mk: IMoniker):HResult;StdCall;
+      Function GetContainer(OUT container: IOleContainer):HResult;StdCall;
+      procedure SetActive(AValue: boolean);
+      procedure SetClassName(AValue: string);
+      procedure SetOleObject(AValue: IDispatch);
+      Function ShowObject:HResult;StdCall;
+      Function OnShowWindow(fShow: BOOL):HResult;StdCall;
+      Function RequestNewObjectLayout:HResult;StdCall;
+      //IOleControlSite
+      function OnControlInfoChanged: HResult; stdcall;
+      function LockInPlaceActive(fLock: BOOL): HResult; stdcall;
+      function GetExtendedControl(out disp: IDispatch): HResult; stdcall;
+      function TransformCoords(var ptlHimetric: TPoint; var ptfContainer: TPointF;
+        flags: Longint): HResult; stdcall;
+      function TranslateAccelerator(msg: PMsg; grfModifiers: Longint): HResult;overload;
+         stdcall;
+      function OnFocus(fGotFocus: BOOL): HResult; stdcall;
+      function ShowPropertyFrame: HResult; stdcall;
+      //IOleInPlaceSite
+      function CanInPlaceActivate : HResult;stdcall;
+      function OnInPlaceActivate : HResult;stdcall;
+      function OnUIActivate : HResult;stdcall;
+      function GetWindowContext(out ppframe:IOleInPlaceFrame;out ppdoc:IOleInPlaceUIWindow;lprcposrect:LPRECT;lprccliprect:LPRECT;lpframeinfo:LPOLEINPLACEFRAMEINFO):hresult; stdcall;
+      function Scroll(scrollExtant:TSIZE):hresult; stdcall;
+      function OnUIDeactivate(fUndoable:BOOL):hresult; stdcall;
+      function OnInPlaceDeactivate :hresult; stdcall;
+      function DiscardUndoState :hresult; stdcall;
+      function DeactivateAndUndo :hresult; stdcall;
+      function OnPosRectChange(lprcPosRect:LPRect):hresult; stdcall;
+      //IOleWindow
+      function GetWindow(out wnd: HWnd): HResult; stdcall;
+      function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
+       //IOleInPlaceFrame
+      function InsertMenus(hmenuShared: HMenu; var menuWidths: TOleMenuGroupWidths): HResult;StdCall;
+      function SetMenu(hmenuShared: HMenu; holemenu: HMenu; hwndActiveObject: HWnd): HResult;StdCall;
+      function RemoveMenus(hmenuShared: HMenu): HResult;StdCall;
+      function SetStatusText(pszStatusText: POleStr): HResult;StdCall;
+      function EnableModeless(fEnable: BOOL): HResult;StdCall;
+      function TranslateAccelerator(var msg: TMsg; wID: Word): HResult;StdCall;overload;
+      //IOleInPlaceUIWindow
+      function GetBorder(out rectBorder: TRect):HResult;StdCall;
+      function RequestBorderSpace(const borderwidths: TRect):HResult;StdCall;
+      function SetBorderSpace(const borderwidths: TRect):HResult;StdCall;
+      function SetActiveObject(const activeObject: IOleInPlaceActiveObject;pszObjName: POleStr):HResult;StdCall;
+      //IDispatch
+      function GetTypeInfoCount(out count : longint) : HResult;stdcall;
+      function GetTypeInfo(Index,LocaleID : longint;
+        out TypeInfo): HResult;stdcall;
+      function GetIDsOfNames(const iid: TGUID; names: Pointer;
+        NameCount, LocaleID: LongInt; DispIDs: Pointer) : HResult;stdcall;
+      function Invoke(DispID: LongInt;const iid : TGUID;
+            LocaleID : longint; Flags: Word;var params;
+            VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
+      //internal
+      procedure Attach;
+      procedure Detach;
+   public
+      constructor Create(TheOwner: TComponent); override;
+      destructor Destroy; override;
+      //VT_DISPATCH variant used for late binding
+      property vObject:Variant read GetvObject;
+   published
+      property Align;
+      property Anchors;
+      property AutoSize;
+      property BorderSpacing;
+      property ChildSizing;
+      //ActiveX object is automatically created from classname and destroyed when set
+      property OleClassName:string read FClassName write SetClassName;
+      property ClientHeight;
+      property ClientWidth;
+      property Constraints;
+      property DockSite;
+      property DragCursor;
+      property DragKind;
+      property DragMode;
+      property Enabled;
+      {IDispatch interface for ActiveX object. Overrides classname. Set ComServer
+      when you create and destroy the object yourself, fe. using CoClass.
+      When Active, returns the IDispatch for the object.
+      }
+      property ComServer:IDispatch read FOleObject write SetOleObject;
+      property ParentShowHint;
+      property PopupMenu;
+      property ShowHint;
+      property TabOrder;
+      property TabStop;
+      property UseDockManager default True;
+      property Visible;
+      property OnDockDrop;
+      property OnDockOver;
+      property OnDragDrop;
+      property OnDragOver;
+      property OnEndDock;
+      property OnEndDrag;
+      property OnEnter;
+      property OnExit;
+      property OnGetSiteInfo;
+      property OnGetDockCaption;
+      property OnResize;
+      property OnStartDock;
+      property OnStartDrag;
+      property OnStatusText:TStatusTextEvent read FOnStatusText write FOnStatusText;
+      property OnUnDock;
+      {When set, binds ActiveX component to control.
+      When cleared, detaches the component from the control
+      If Classname is provided the ActiveX component will also be created and destroyed
+      automatically.}
+      property Active:boolean read FActive write SetActive;
+    end;
+
+implementation
+
+{$ifdef wince}
+const
+  GWLP_USERDATA=GWL_USERDATA;
+
+function GetWindowLongPtrW(hWnd:HWND; nIndex:longint):LONG;
+begin
+  result:=GetWindowLongW(hWnd, nIndex);
+end;
+
+function SetWindowLongPtrW(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG;
+begin
+  result:=SetWindowLongW(hWnd, nIndex, dwNewLong);
+end;
+
+function SetWindowLongPtr(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG;
+begin
+  result:=SetWindowLongW(hWnd, nIndex, dwNewLong);
+end;
+{$endif wince}
+
+function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
+  lParam: LParam): LRESULT; stdcall;
+  var
+    bounds:TRect;
+    DC: HDC;
+    size:TPOINT;
+    AXC:TActiveXContainer;
+begin
+  AXC:=TActiveXContainer(GetWindowLongPtrW( Ahwnd, GWLP_USERDATA));
+  case uMsg of
+    WM_DESTROY:AXC.Detach;
+    WM_SIZE:
+      begin
+      size.x:=(LOWORD(lparam)*2540) div Screen.PixelsPerInch;
+      size.y:=(HIWORD(lparam)*2540) div Screen.PixelsPerInch;
+      AXC.Width:=LOWORD(lparam);
+      AXC.Height:=HIWORD(lparam);
+      olecheck((AXC.ComServer as IOleObject).SetExtent(DVASPECT_CONTENT,size));
+      bounds:=AXC.ClientRect;
+      olecheck((AXC.ComServer as IOleInPlaceObject).SetObjectRects(@bounds,@bounds));
+      end;
+    WM_PAINT:
+       begin
+       DC:=GetDC(AXC.handle);
+       bounds:=AXC.ClientRect;
+       olecheck((AXC.ComServer as IViewObject).Draw(DVASPECT_CONTENT,0,nil,nil,0,DC,@bounds,@bounds,nil,0));
+       ReleaseDC(AXC.handle,DC);
+      end;
+  end;
+  result:=CallWindowProc(AXC.FPrevWndProc,Ahwnd, uMsg, WParam, LParam);
+end;
+
+{ TActiveXContainer }
+
+function TActiveXContainer.GetvObject: variant;
+begin
+  result:=FOleObject;
+end;
+
+function TActiveXContainer.SaveObject: HResult; StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; out
+  mk: IMoniker): HResult; StdCall;
+begin
+  mk := nil;
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.GetContainer(out container: IOleContainer): HResult;
+  StdCall;
+begin
+  container := nil;
+  Result := E_NOINTERFACE;
+end;
+
+procedure TActiveXContainer.SetActive(AValue: boolean);
+begin
+  if FActive=AValue then Exit;
+  if AValue then
+    begin
+      if (FClassName='') and not assigned(ComServer) then
+        raise exception.Create('OleClassName and ComServer not assigned.');
+      if not assigned(FOleObject) then
+        FOleObject:=CreateOleObject(FClassName);
+      Attach;
+    end
+  else
+    begin
+    Detach;
+    if FClassName<>'' then //destroy com object
+      FOleObject:=nil;
+    end;
+  FActive:=AValue;
+end;
+
+procedure TActiveXContainer.SetClassName(AValue: string);
+begin
+  if (FClassName=AValue) or FActive then Exit;
+  FClassName:=AValue;
+end;
+
+procedure TActiveXContainer.SetOleObject(AValue: IDispatch);
+begin
+  if (FOleObject=AValue) or FActive then Exit;
+  FOleObject:=AValue;
+end;
+
+function TActiveXContainer.ShowObject: HResult; StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.OnShowWindow(fShow: BOOL): HResult; StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.RequestNewObjectLayout: HResult; StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.OnControlInfoChanged: HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.LockInPlaceActive(fLock: BOOL): HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.GetExtendedControl(out disp: IDispatch): HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.TransformCoords(var ptlHimetric: TPoint;
+  var ptfContainer: TPointF; flags: Longint): HResult; stdcall;
+begin
+  if flags and 4 <> 0 then  //XFORMCOORDS_HIMETRICTOCONTAINER=4
+    begin
+    ptfContainer.X := (ptlHimetric.X * Screen.PixelsPerInch) div 2540;
+    ptfContainer.Y := (ptlHimetric.Y * Screen.PixelsPerInch) div 2540;
+    end
+  else if assigned(@ptlHimetric) and (flags and 8 <> 0) then  //XFORMCOORDS_CONTAINERTOHIMETRIC = 8
+    begin
+    ptlHimetric.X := Integer(Round(ptfContainer.X * 2540 / Screen.PixelsPerInch));
+    ptlHimetric.Y := Integer(Round(ptfContainer.Y * 2540 / Screen.PixelsPerInch));
+    end;
+  Result := S_OK;
+end;
+
+function TActiveXContainer.TranslateAccelerator(msg: PMsg; grfModifiers: Longint
+  ): HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.OnFocus(fGotFocus: BOOL): HResult; stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.ShowPropertyFrame: HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.CanInPlaceActivate: HResult;stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.OnInPlaceActivate: HResult;stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.OnUIActivate: HResult; stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.GetWindowContext(out ppframe: IOleInPlaceFrame; out
+  ppdoc: IOleInPlaceUIWindow; lprcposrect: LPRECT; lprccliprect: LPRECT;
+  lpframeinfo: LPOLEINPLACEFRAMEINFO): hresult; stdcall;
+begin
+    if assigned (ppframe) then
+      ppframe := Self as IOleInPlaceFrame;
+    if assigned(ppdoc) then
+      ppdoc:= nil;
+    if assigned(lpframeinfo) then
+      begin
+      lpframeinfo.fMDIApp := False;
+      lpframeinfo.cAccelEntries := 0;
+      lpframeinfo.haccel := 0;
+      lpframeinfo.hwndFrame := Handle;
+      end;
+
+    if assigned (lprcPosRect) then
+      lprcPosRect^:=GetClientRect;
+    if assigned (lprcClipRect) then
+      lprcClipRect^:=GetClientRect;
+
+    Result := S_OK;
+end;
+
+function TActiveXContainer.Scroll(scrollExtant: TSIZE): hresult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.OnUIDeactivate(fUndoable: BOOL): hresult; stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.OnInPlaceDeactivate: hresult; stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.DiscardUndoState: hresult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.DeactivateAndUndo: hresult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.OnPosRectChange(lprcPosRect: LPRect): hresult; stdcall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.GetWindow(out wnd: HWnd): HResult; stdcall;
+begin
+  wnd:=Handle;
+  Result := S_OK;
+end;
+
+function TActiveXContainer.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.InsertMenus(hmenuShared: HMenu;
+  var menuWidths: TOleMenuGroupWidths): HResult; StdCall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.SetMenu(hmenuShared: HMenu; holemenu: HMenu;
+  hwndActiveObject: HWnd): HResult; StdCall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.RemoveMenus(hmenuShared: HMenu): HResult; StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.SetStatusText(pszStatusText: POleStr): HResult; StdCall;
+begin
+  if assigned(FOnStatusText) then
+    FOnStatusText(Self,utf8encode(WideString(pszStatusText)));
+  Result := S_OK;
+end;
+
+function TActiveXContainer.EnableModeless(fEnable: BOOL): HResult; StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.TranslateAccelerator(var msg: TMsg; wID: Word): HResult;
+  StdCall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.GetBorder(out rectBorder: TRect): HResult; StdCall;
+begin
+  Result := INPLACE_E_NOTOOLSPACE;
+end;
+
+function TActiveXContainer.RequestBorderSpace(const borderwidths: TRect): HResult;
+  StdCall;
+begin
+  Result := INPLACE_E_NOTOOLSPACE;
+end;
+
+function TActiveXContainer.SetBorderSpace(const borderwidths: TRect): HResult;
+  StdCall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.SetActiveObject(
+  const activeObject: IOleInPlaceActiveObject; pszObjName: POleStr): HResult;
+  StdCall;
+begin
+  Result := S_OK;
+end;
+
+function TActiveXContainer.GetTypeInfoCount(out count: longint): HResult;
+  stdcall;
+begin
+  Count := 0;
+  Result := S_OK;
+end;
+
+function TActiveXContainer.GetTypeInfo(Index, LocaleID: longint; out TypeInfo
+  ): HResult; stdcall;
+begin
+  Pointer(TypeInfo) := nil;
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.GetIDsOfNames(const iid: TGUID; names: Pointer;
+  NameCount, LocaleID: LongInt; DispIDs: Pointer): HResult; stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TActiveXContainer.Invoke(DispID: LongInt; const iid: TGUID;
+  LocaleID: longint; Flags: Word; var params; VarResult, ExcepInfo,
+  ArgErr: pointer): HResult; stdcall;
+const
+  DISPID_AMBIENT_BACKCOLOR         = -701;
+  DISPID_AMBIENT_DISPLAYNAME       = -702;
+  DISPID_AMBIENT_FONT              = -703;
+  DISPID_AMBIENT_FORECOLOR         = -704;
+  DISPID_AMBIENT_LOCALEID          = -705;
+  DISPID_AMBIENT_MESSAGEREFLECT    = -706;
+  DISPID_AMBIENT_USERMODE          = -709;
+  DISPID_AMBIENT_UIDEAD            = -710;
+  DISPID_AMBIENT_SHOWGRABHANDLES   = -711;
+  DISPID_AMBIENT_SHOWHATCHING      = -712;
+  DISPID_AMBIENT_SUPPORTSMNEMONICS = -714;
+  DISPID_AMBIENT_AUTOCLIP          = -715;
+begin
+  if (Flags and DISPATCH_PROPERTYGET <> 0) and (VarResult <> nil) then
+  begin
+    Result := S_OK;
+    case DispID of
+      DISPID_AMBIENT_BACKCOLOR:
+        PVariant(VarResult)^ := Color;
+      DISPID_AMBIENT_DISPLAYNAME:
+        PVariant(VarResult)^ := OleVariant(Name);
+      DISPID_AMBIENT_FONT:
+        PVariant(VarResult)^ :=nil;
+      DISPID_AMBIENT_FORECOLOR:
+        PVariant(VarResult)^ := Font.Color;
+      DISPID_AMBIENT_LOCALEID:
+        PVariant(VarResult)^ := Integer(GetUserDefaultLCID);
+      DISPID_AMBIENT_MESSAGEREFLECT:
+        PVariant(VarResult)^ := False;
+      DISPID_AMBIENT_USERMODE:
+        PVariant(VarResult)^ := not (csDesigning in ComponentState);
+      DISPID_AMBIENT_UIDEAD:
+        PVariant(VarResult)^ := csDesigning in ComponentState;
+      DISPID_AMBIENT_SHOWGRABHANDLES:
+        PVariant(VarResult)^ := False;
+      DISPID_AMBIENT_SHOWHATCHING:
+        PVariant(VarResult)^ := False;
+      DISPID_AMBIENT_SUPPORTSMNEMONICS:
+        PVariant(VarResult)^ := True;
+      DISPID_AMBIENT_AUTOCLIP:
+        PVariant(VarResult)^ := True;
+    else
+      Result := DISP_E_MEMBERNOTFOUND;
+    end;
+  end else
+    Result := DISP_E_MEMBERNOTFOUND;
+end;
+
+procedure TActiveXContainer.Attach;
+var
+  size:TPOINT;
+begin
+  SetWindowLongPtr(Handle,GWLP_USERDATA, PtrInt(Self));
+  FPrevWndProc:=Windows.WNDPROC(SetWindowLongPtr(Handle,GWL_WNDPROC,PtrInt(@WndCallback)));
+  FAttached:=true;
+  olecheck((FOleObject as IOleObject).SetClientSite(Self as IOleClientSite));
+  olecheck((FOleObject as IOleObject).SetHostNames(PWideChar(name),PWideChar(name)));
+  size.x:=(Width*2540) div Screen.PixelsPerInch;
+  size.y:=(Height*2540) div Screen.PixelsPerInch;
+  olecheck((FOleObject as IOleObject).SetExtent(DVASPECT_CONTENT,size));
+  olecheck((FOleObject as IOleObject).DoVerb(OLEIVERB_INPLACEACTIVATE,nil,Self as IOleClientSite,0,Handle,ClientRect));
+end;
+
+procedure TActiveXContainer.Detach;
+const
+  OLECLOSE_NOSAVE = 1;
+begin
+  if FAttached then
+    begin
+    SetWindowLongPtr(Handle,GWL_WNDPROC,PtrInt(@FPrevWndProc));
+    SetWindowLongPtr(Handle,GWLP_USERDATA, 0);
+    end;
+  if assigned(FOleObject) then
+    begin
+    olecheck((FOleObject as IOleObject).SetClientSite(nil));
+    olecheck((FOleObject as IOleObject).Close(OLECLOSE_NOSAVE));
+    end;
+end;
+
+constructor TActiveXContainer.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  parent:=TWinControl(TheOwner);
+  Width:=24;
+  Height:=24;
+end;
+
+destructor TActiveXContainer.Destroy;
+begin
+  Active:=false; //destroys com object if created by Self
+  inherited Destroy;
+end;
+
+end.
+

ActiveX/importtypelib.lfm

@@ -0,0 +1,82 @@
+object FrmTL: TFrmTL
+  Left = 251
+  Height = 186
+  Top = 189
+  Width = 341
+  Caption = 'Import Type Library'
+  ClientHeight = 186
+  ClientWidth = 341
+  LCLVersion = '1.1'
+  object FNETL: TFileNameEdit
+    Left = 12
+    Height = 21
+    Top = 40
+    Width = 292
+    DialogOptions = []
+    Filter = 'Type library files (*.tlb;*.dll;*.exe;*.ocx;*.olb)|*.tlb;*.dll;*.exe;*.ocx;*.olb|All Files (*.*)|*.*'
+    FilterIndex = 0
+    HideDirectories = False
+    ButtonWidth = 23
+    NumGlyphs = 0
+    Anchors = [akTop, akLeft, akRight]
+    MaxLength = 0
+    TabOrder = 0
+  end
+  object Label1: TLabel
+    Left = 12
+    Height = 14
+    Top = 16
+    Width = 131
+    Caption = 'File containing type library:'
+    ParentColor = False
+  end
+  object CBxTLActiveX: TCheckBox
+    Left = 12
+    Height = 17
+    Hint = 'CBxTLActiveX'
+    Top = 72
+    Width = 298
+    Caption = 'Create visual component (TActiveXContainer descendant)'
+    OnChange = CBxTLActiveXChange
+    TabOrder = 1
+  end
+  object CBxTLPackage: TCheckBox
+    Left = 12
+    Height = 17
+    Top = 96
+    Width = 96
+    Caption = 'Create package'
+    OnChange = CBxTLPackageChange
+    TabOrder = 2
+  end
+  object BtnTLOK: TButton
+    Left = 248
+    Height = 25
+    Top = 152
+    Width = 75
+    Caption = 'OK'
+    ModalResult = 1
+    TabOrder = 3
+  end
+  object BtnTLCancel: TButton
+    Left = 157
+    Height = 25
+    Top = 152
+    Width = 75
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 4
+  end
+  object CBxTLRecurse: TCheckBox
+    Left = 12
+    Height = 17
+    Top = 120
+    Width = 154
+    Caption = 'Convert dependant typelibs'
+    TabOrder = 5
+  end
+  object SelectDirectoryDialog1: TSelectDirectoryDialog
+    left = 220
+    top = 8
+  end
+end

ActiveX/importtypelib.pas

@@ -0,0 +1,147 @@
+unit ImportTypelib;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{$ifndef wince}
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
+  StdCtrls,lazideintf,projectintf,PackageIntf;
+
+type
+
+  { TFrmTL }
+
+  TFrmTL = class(TForm)
+    BtnTLOK: TButton;
+    BtnTLCancel: TButton;
+    CBxTLActiveX: TCheckBox;
+    CBxTLPackage: TCheckBox;
+    CBxTLRecurse: TCheckBox;
+    FNETL: TFileNameEdit;
+    Label1: TLabel;
+    SelectDirectoryDialog1: TSelectDirectoryDialog;
+    procedure CBxTLActiveXChange(Sender: TObject);
+    procedure CBxTLPackageChange(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  FrmTL: TFrmTL;
+
+procedure ImpTypeLib(Sender: TObject);
+{$endif wince}
+
+implementation
+
+{$ifndef wince}
+uses typelib;
+
+procedure ImpTypeLib(Sender: TObject);
+
+var TLI:TTypeLibImporter;
+  bPackage,bActiveX,bRecurse:boolean;
+  slTypelibs:TStringList; //sys charset
+  i,j:integer;
+  F:text;
+  sDir,sUnitName:string;  //utf8
+begin
+  FrmTL:= TFrmTL.create(nil);
+  try
+  if (FrmTL.ShowModal=mrOK) and (FrmTL.FNETL.Filename<>'') then
+    begin
+    slTypelibs:=TStringList.Create;
+    slTypelibs.add(UTF8ToSys(FrmTL.FNETL.Filename));
+    bActiveX:=FrmTL.CBxTLActiveX.Checked;
+    bPackage:=FrmTL.CBxTLPackage.Checked;
+    bRecurse:=FrmTL.CBxTLRecurse.Checked;
+    i:=0;
+    sDir:='';
+    repeat
+      TLI:=TTypeLibImporter.Create(nil);
+      try
+        TLI.InputFileName:=slTypelibs[i];
+        TLI.ActiveX:=bActiveX;
+        TLI.CreatePackage:=bPackage;
+        try
+          TLI.Execute;
+          sUnitName:=SysToUTF8(TLI.UnitName);
+          if bPackage then
+            begin
+            with FrmTL.SelectDirectoryDialog1 do
+              begin
+              Title:='Select directory to store package '+sUnitName+'P.lpk';
+              Execute;
+              sDir:=Filename;
+              end;
+            if (sDir<>'') and (sDir[length(sdir)]<>'\') then
+              sDir:=sDir+'\';
+            AssignFile(F,UTF8ToSys(sDir+sUnitName+'P.lpk'));
+            Rewrite(F);
+            Write(F,TLI.PackageSource.Text);
+            CloseFile(F);
+            AssignFile(F,UTF8ToSys(sDir+sUnitName+'Preg.pas'));
+            Rewrite(F);
+            Write(F,TLI.PackageRegUnitSource.Text);
+            CloseFile(F);
+            if PackageEditingInterface.FindPackageWithName(sUnitName+'P')<>nil then
+              begin
+              PackageEditingInterface.DoOpenPackageFile(sDir+sUnitName+'P.lpk',[pofRevert],false);
+              PackageEditingInterface.DoOpenPackageWithName(sUnitName+'P',[],false);
+              end
+            else
+              PackageEditingInterface.DoOpenPackageFile(sDir+sUnitName+'P.lpk',[pofAddToRecent],false);
+            end;
+          if sDir='' then  // no package, open file in editor
+            LazarusIDE.DoNewEditorFile(FileDescriptorUnit,sUnitName+'.pas',
+               TLI.UnitSource.Text,[nfIsPartOfProject,nfOpenInEditor])
+          else
+            begin //save in same dir as package
+            AssignFile(F,UTF8ToSys(sDir+sUnitName+'.pas'));
+            Rewrite(F);
+            Write(F,TLI.UnitSource.Text);
+            CloseFile(F);
+            end;
+          // don't create package or ActiveX container for dependencies
+          bPackage:=false;
+          bActiveX:=false;
+          for j:=0 to TLI.Dependencies.Count-1 do
+            if slTypelibs.IndexOf(TLI.Dependencies[j])=-1 then
+              slTypelibs.Add(TLI.Dependencies[j]);
+        except
+          on E: Exception do ShowMessage(E.Message)
+        end;
+      finally
+        TLI.destroy;
+      end;
+      i:=i+1;
+    until not bRecurse or (i=slTypelibs.Count)
+    end;
+  finally
+    FrmTL.Destroy;
+  end;
+end;
+
+{ TFrmTL }
+
+procedure TFrmTL.CBxTLActiveXChange(Sender: TObject);
+begin
+  if not CBxTLActiveX.Checked then
+    CBxTLPackage.Checked:=false;
+end;
+
+procedure TFrmTL.CBxTLPackageChange(Sender: TObject);
+begin
+  if CBxTLPackage.Checked then
+    CBxTLActiveX.Checked:=true;
+end;
+
+{$R *.lfm}
+{$endif wince}
+
+end.
+

ActiveX/lazactivexreg.pas

@@ -0,0 +1,110 @@
+unit lazactivexreg;
+
+{ ActiveX component registration unit.
+
+  Copyright (C) 2011 Ludo Brands
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+interface
+
+uses
+  activexcontainer
+  {$ifndef wince}
+  ,ImportTypelib
+  {$endif wince}
+  ;
+
+procedure Register;
+
+implementation
+
+uses  classes,LResources,MenuIntf, LCLIntf;
+
+
+procedure Register; 
+begin
+  {$ifndef wince}
+  RegisterIDEMenuCommand(itmSecondaryTools, 'ImportTL','Import Type Library',nil,@ImpTypeLib);
+  {$endif wince}
+  RegisterComponents('ActiveX', [TActiveXContainer]);
+end;
+
+initialization
+LazarusResources.Add('TActiveXContainer','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+  +#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#0#0#0#0#0#249'C'#187#127#0#0#0
+  +#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#12#29#15''''
+  +#14#229#143#252'P'#0#0#0#25'tEXtComment'#0'Created with GIMPW'#129#14#23#0#0
+  +#4')IDATH'#199#181'U{L[e'#20#255#221'{K'#233#198#128'B-'#143#14'6'#137#136
+  +#145#133'm'#248#136#178#224#20#31#141'!Y'#156#203'6'#19#163#152#12'uc2'#147
+  +#205'L'#137'qf'#3'u'#137#25'f'#226#8#198'E'#205'fDE'#156'l#'#153#147#9's'#15
+  +#31'A'#172#186'!'#8#148#142'G'#25#184#130#164#133#246#182#183#189'?'#255#168
+  +#180'tc'#19'f<'#201#151#220#243#251#206#247#157#243';'#231#220#243#129#215'!'
+  +#129#128#159#173'?[X'#177'{'#23#11#205#133'4'#153'R'#168#145't'#20'5Zfd.fI'
+  +#201's'#236#183#245#146'$'#5#146#196','#197'91'#129#143#15#30#196#254#253'5'
+  +#24#232#27#196#205#183','#193'M'#153#153'HH'#140#3'D'#21#23#251#134#241#195
+  +#175'm'#176#219#250#144#148'l'#196#201#211#223#2#179#137#216#227#245#176#186
+  +#178#154#249#249#249',+{'#137#223#159'=EY'#150'g'#180'U'#252#10#27#27#191'd'
+  +#154')'#141'E'#143#23#241'_'#29#252'x'#230#12#183'n-a'#227#209#6#250#188#222
+  +'Y'#167#209#242#203'o\'#190#252#142#171#167'H'#9'(8'#252#217#17'$.'#212#163
+  +'`'#229#253#16#4#1's'#18#2'e'#175#150#205#156'"'#167'k'#130#13#13'G'#216'?'
+  +#216#207#255'"'#173#167'N'#135#25#144#132#127'2'#128'q'#223'_'#240#184'ehU'
+  +#21'Z'#173#17'q'#198'hH'#146#8#1#151'1'#8'('#145#186' '#0#162#6#160#10#168
+  +#129'iL'#168#210#218#221#206#141#165'E\'#176#192#200' '#185#169'%'#241#6'S'#6
+  +#183'm'#127#145#206'1'#231#180'>U'#232#223#187#134'|'#6#225#245#154#153'Td'
+  +#178'n['#24'+'#141'%l'#253'Vf'#230'f]v'#241#149'k'#195#19'OF'#208#247#14'v'
+  +#146'['#226#167'9'#153'O'#182#188'On'#137#253'G'#215#145'-'#31'Q|go'#5'z,]A'
+  +#150#0#30'-|'#4#159#31':'#140'=o'#238#137#200#192#209#227'_'#195#237'q'#134
+  +'t'#173')'#11#184'm'#245'4'#11'7P['#12#200#174#160#250#192'v'#224#158'u'#16#6
+  +'G'''#233#153#184#4#199#208#5't'#245#158'G'#140'a!d'#167#11'#]N'#188#242'z)<'
+  +#158#160'}BB'#2'::~GrrJ'#248'Nk;'#240'V>'#160#140'G'#214'c'#201'z'#224#249'O'
+  +#0'A'#132'&%>'#26'g[;PUY'#141#150's'#205#24#27'v'#207#216'u'#138#162#192#225
+  +#24#141'tpc'#6#160#215#3#151#166'9'#136#210#1#143#149#3#130#8#0#16'kk'#15#161
+  +'p'#205'Z|'#209#212#136#177'a7$'#9#184'7o'#25'J7o'#130#30#209#161's'#170#170
+  +#194#231#243'Ez'#253#230#3'`l '#18#243#251#0#155'%'#172#167#153#210'#'#138'Y'
+  +#252't1='#147#19#28#31#178'S'#132#24#194#227#227#227'i'#179#217#194'U'#254
+  +#238#0'Y'#162#11#22#244'Y)'#178#163'v'#230#146#178#135'$)'#142#143'8"'#2#136
+  +'I4`'#200'1'#138#154#154'w'#161'B'#13#225#162'(A'#21#162'A'#18#242#248#16#240
+  +#225'S'#128'_'#14'n'#174#170#2#140#139#195#151#216'-'#192'O'#245#193#239#149
+  +'y'#183'G0'#144'$'#137#177#6#3#5'Q$'#180#218#16#30#27#23#199#246#206'n*'#178
+  +#151#220#183'*'#28#237#190#135#200'@'#128'<'#240'r$'#139#221#185#164#215'E'
+  +#177#170#242'=dg'#166#135#127#208'@'#0#174#137'Q'#188#176#185#8'wg'#223#25
+  +#194'eY'#134'u'#168#31#154#230'7'#128#243#199#130#160'!'#21'X'#251'6 '#138'@'
+  +#193#6'`'#158'1'#204#162#215#2#180'5B IYQ@'#191#2#18'P'#252'^Di'#162'0O7'#31
+  +#170#26'L'#145'J'#194#229'r# '#1#198#216#24'`j>N'#141#135'P'''#248#195'{@'
+  +#176#147#186';;'#175'k'#144'MNN'#178#233#228#9#246#246't]'#211'N2-J'#219#153
+  +#179'4'#7#186'h'#221#172#166#240#232#184#3#159#214#213#193#250#135#21'f'#243
+  +#131'0'#26'S'#174'}'#224#216#241#175#184'bE'#30'-mmW'#141#194#241#167#131#245
+  +#245#245#220'X'#178#137';v'#236#226#160'}`'#214'L5'#15#155#205#232#232'8'#135
+  +#251#10#10#144#150#190#8'9Ko'#133'A'#159#10#149'n'#12#219'G`'#187#208#15#189
+  +#222#128'u'#235'W'#163#188#162#28'I'#6#227#156#222#157#208'{`'#191'hG'#211
+  +#137'ft'#247#244'@U|0&&#;+'#11#203#238#202'EjR*0'#199#7#237#10#7#255#151#252
+  +#13#208#236#3#252#184#199'u'#249#0#0#0#0'IEND'#174'B`'#130
+]);
+
+end.