Tweet
Can PowerBasic 9 Create ActiveX Controls (.OCX)?
FUNCTION DllGetClassObject ALIAS "DllGetClassObject" _
( _
rclsid AS GUID, _
riid AS GUID, _
ppv AS DWORD _
) EXPORT AS LONG
LOCAL hr AS LONG
ppv = %NULL
SELECT CASE rclsid
CASE $CLSID_TREECONTROL
IF g_pClassFactoryTree = %NULL THEN
g_pClassFactoryTree = treeIClassFactory_Create()
END IF
IF g_pClassFactoryTree = %NULL THEN
FUNCTION = %E_OUTOFMEMORY
EXIT FUNCTION
END IF
hr = treeIClassFactory_QueryInterface(g_pClassFactoryTree, riid, ppv)
treeIClassFactory_Release g_pClassFactoryTree
InitTree2D 0
CASE ELSE
hr = %CLASS_E_CLASSNOTAVAILABLE
END SELECT
FUNCTION = hr
END FUNCTION
MSDN Library Visual Studio 6.0\Visual C++ Documentation\Reference\Microsoft Foundation Class Library And Templates\Active Template Library\Atl Tutorial
#Compile Exe
#Include "Win32api.inc"
#Include Once "Atl.inc"
Global pPolyCtl As IPolyCtl
Global pPolyEvents As IPolyCtlEventsImpl
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Interface IPolyCtl Guid$("{873F0176-C037-4613-9A8F-A0BCD2EF5B2E}") : Inherit IDispatch
Property Set FillColor <-510> (Byval Dword) ' IID = {873F0176-C037-4613-9A8F-A0BCD2EF5B2E}
Property Get FillColor <-510> () As Dword ' IPolyCtl Interface
Property Get Sides <1> () As Integer ' Attributes = 4160 [&H1040] [Dual] [Dispatchable]
Property Set Sides <1> (Byval Integer) ' Inherited interface = IDispatch
End Interface
Class CIPolyCtlEvents Guid$("{C22266B9-EFB0-45D6-98D8-066734F7BA0B}") As Event
Interface IPolyCtlEventsImpl Guid$("{FF786299-5C0A-4D47-B753-44C8892838DC}") As Event
Inherit IDispatch ' Class CIPolyCtlEvents
Method ClickIn<1>(Byval x As Long, Byval y As Long) ' Interface name = _IPolyCtlEvents
MsgBox("You Clicked In The Colored Triangle") ' IID = {FF786299-5C0A-4D47-B753-44C8892838DC}
End Method ' _IPolyCtlEvents Interface
Method ClickOut<2>(Byval x As Long, Byval y As Long) ' Attributes = 4096 [&H1000] [Dispatchable]
MsgBox("You Clicked Outside The Colored Triangle") ' Code generated by the TypeLib Browser 4.0.11 (c) 2008 by José Roca
End Method ' Date: 09 Nov 2008 Time: 18:02:43
End Interface
End Class
Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long
Local pStream,ppUnkContainer As IUnknown
Local oPolyCtl As Dispatch
Local strCtrl As String
Local vVnt As Variant
Local hCtrl As Long
Call AtlAxWinInit()
strCtrl=UCode$("Polygon.PolyCtl") 'Program ID
hCtrl=AtlAxCreateControl(Strptr(strCtrl),Wea.hWnd,pStream,ppUnkContainer)
pPolyEvents=Class "CIPolyCtlEvents"
pPolyCtl=AtlAxGetDispatch(Wea.hWnd)
If IsObject(pPolyCtl) Then
oPolyCtl=pPolyCtl 'Probably QueryInterfaces() For IID_IDISPATCH
vVnt=5 : Object Let oPolyCtl.Sides=vVnt
vVnt=RGB(&H255,&H0,&H0) : Object Let oPolyCtl.FillColor=vVnt
Events From pPolyCtl Call pPolyEvents
Set oPolyCtl=Nothing
End If
fnWndProc_OnCreate=0
End Function
Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
If IsObject(pPolyCtl) And IsObject(pPolyEvents) Then
Events End pPolyEvents
Set pPolyEvents=Nothing : Set pPolyCtl=Nothing
End If
Call PostQuitMessage(0)
fnWndProc_OnDestroy=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Local Wea As WndEventArgs
Select Case As Long wMsg
Case %WM_CREATE
Wea.hWnd=hWnd : Wea.wParam=wParam : Wea.lParam=lParam
fnWndProc=fnWndProc_OnCreate(Wea)
Exit Function
Case %WM_DESTROY
Call PostQuitMessage(0)
fnWndProc=fnWndProc_OnDestroy(Wea)
Exit Function
End Select
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
Local winclass As WndClassEx
Local szAppName As Asciiz*16
Local Msg As tagMsg
Local hWnd As Dword
szAppName="PolyCtrl" : winclass.cbSize=SizeOf(winclass)
winclass.style=%CS_HREDRAW Or %CS_VREDRAW : winclass.lpfnWndProc=CodePtr(fnWndProc)
winclass.cbClsExtra=0 : winclass.cbWndExtra=0
winclass.hInstance=hIns : winclass.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
winclass.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW) : winclass.hbrBackground=%COLOR_BTNFACE+1
winclass.lpszMenuName=%NULL : winclass.lpszClassName=VarPtr(szAppName)
Call RegisterClassEx(winclass)
hWnd=CreateWindow(szAppName,"PolyCtrl",%WS_OVERLAPPEDWINDOW Xor %WS_MAXIMIZEBOX,350,300,425,325,0,0,hIns,ByVal 0)
Call ShowWindow(hWnd,iShow)
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
Function=msg.wParam
End Function
Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long Local pStream,ppUnkContainer,ppUnkControl As IUnknown Local lpCreateStruct As CREATESTRUCT Ptr Local hCtl,hContainer As Dword Local hCtrl,iNull As Long Local dwPtr As DWord Ptr Local blnReturn As Long Local strCtrl As String Local fp As Integer fp=Freefile Open "Output.txt" For Output As #fp lpCreateStruct=Wea.lParam 'Can use GetModuleHandle() here instead, or, use Global (Hate Globals!) [email protected] Call AtlAxWinInit() hContainer= _ CreateWindowEx _ ( _ %WS_EX_OVERLAPPEDWINDOW,"static","",%WS_CHILD OR %WS_VISIBLE, _ 10,10,400,250,Wea.hWnd,%ID_CONTAINER,Wea.hInst,Byval %NULL _ ) strCtrl=UCode$("Polygon.PolyCtl") dwPtr=Varptr(ppUnkContainer) Print #fp,"@dwPtr = "@dwPtr hCtrl=AtlAxCreateControl(Strptr(strCtrl),hContainer,pStream,ppUnkContainer) pPolyEvents=Class "CIPolyCtlEvents" 'Call AtlAxGetControl(hContainer,pPoly) 'neither works 'Global pPoly As IPolyCtl pPolyCtl=AtlAxGetDispatch(hContainer) '------------- 'Global pPolyEvents As IPolyCtlEventsImpl If IsObject(pPolyCtl) Then MsgBox("pPolyCtl Is An Object") Events From pPolyCtl Call pPolyEvents Else MsgBox("pPolyCtl Ain't Nothin") End If Print #fp, "hContainer = " hContainer Print #fp,"@dwPtr = "@dwPtr Close #fp fnWndProc_OnCreate=0 End Function
// PolyCtl.h : Declaration of the CPolyCtl
#ifndef __POLYCTL_H_
#define __POLYCTL_H_
#include <math.h>
#include "resource.h" // main symbols
#include <atlctl.h>
#include "PolygonCP.h"
/////////////////////////////////////////////////////////////////////////////
// CPolyCtl
class ATL_NO_VTABLE CPolyCtl : //these 19 objects below are publically inherited template classes
public CComObjectRootEx<CComSingleThreadModel>,
public CStockPropImpl<CPolyCtl, IPolyCtl, &IID_IPolyCtl, &LIBID_POLYGONLib>,
public CComControl<CPolyCtl>,
public IPersistStreamInitImpl<CPolyCtl>,
public IOleControlImpl<CPolyCtl>,
public IOleObjectImpl<CPolyCtl>,
public IOleInPlaceActiveObjectImpl<CPolyCtl>,
public IViewObjectExImpl<CPolyCtl>,
public IOleInPlaceObjectWindowlessImpl<CPolyCtl>,
public ISupportErrorInfo,
public IConnectionPointContainerImpl<CPolyCtl>,
public IPersistStorageImpl<CPolyCtl>,
public ISpecifyPropertyPagesImpl<CPolyCtl>,
public IQuickActivateImpl<CPolyCtl>,
public IDataObjectImpl<CPolyCtl>,
public IProvideClassInfo2Impl<&CLSID_PolyCtl, &DIID__IPolyCtlEvents, &LIBID_POLYGONLib>,
public IPropertyNotifySinkCP<CPolyCtl>,
public CComCoClass<CPolyCtl, &CLSID_PolyCtl>,
public CProxy_IPolyCtlEvents< CPolyCtl >
{
public:
CPolyCtl() //Constructor
{
m_nSides = 3;
m_clrFillColor = RGB(0, 0xFF, 0);
}
DECLARE_REGISTRY_RESOURCEID(IDR_POLYCTL) //these are all the interfaces ActiveX
DECLARE_PROTECT_FINAL_CONSTRUCT() //controls typically implement. I expect
BEGIN_COM_MAP(CPolyCtl) //for this trivial control many of them
COM_INTERFACE_ENTRY(IPolyCtl) //amount to little more than stubs
COM_INTERFACE_ENTRY(IDispatch)
COM_INTERFACE_ENTRY(IViewObjectEx)
COM_INTERFACE_ENTRY(IViewObject2)
COM_INTERFACE_ENTRY(IViewObject)
COM_INTERFACE_ENTRY(IOleInPlaceObjectWindowless)
COM_INTERFACE_ENTRY(IOleInPlaceObject)
COM_INTERFACE_ENTRY2(IOleWindow, IOleInPlaceObjectWindowless)
COM_INTERFACE_ENTRY(IOleInPlaceActiveObject)
COM_INTERFACE_ENTRY(IOleControl)
COM_INTERFACE_ENTRY(IOleObject)
COM_INTERFACE_ENTRY(IPersistStreamInit)
COM_INTERFACE_ENTRY2(IPersist, IPersistStreamInit)
COM_INTERFACE_ENTRY(ISupportErrorInfo)
COM_INTERFACE_ENTRY(IConnectionPointContainer)
COM_INTERFACE_ENTRY(ISpecifyPropertyPages)
COM_INTERFACE_ENTRY(IQuickActivate)
COM_INTERFACE_ENTRY(IPersistStorage)
COM_INTERFACE_ENTRY(IDataObject)
COM_INTERFACE_ENTRY(IProvideClassInfo)
COM_INTERFACE_ENTRY(IProvideClassInfo2)
COM_INTERFACE_ENTRY_IMPL(IConnectionPointContainer)
END_COM_MAP()
BEGIN_PROP_MAP(CPolyCtl)
PROP_DATA_ENTRY("_cx", m_sizeExtent.cx, VT_UI4)
PROP_DATA_ENTRY("_cy", m_sizeExtent.cy, VT_UI4)
PROP_ENTRY("FillColor", DISPID_FILLCOLOR, CLSID_StockColorPage)
// Example entries
// PROP_ENTRY("Property Description", dispid, clsid)
// PROP_PAGE(CLSID_StockColorPage)
END_PROP_MAP()
BEGIN_CONNECTION_POINT_MAP(CPolyCtl)
CONNECTION_POINT_ENTRY(IID_IPropertyNotifySink)
CONNECTION_POINT_ENTRY(DIID__IPolyCtlEvents)
END_CONNECTION_POINT_MAP()
BEGIN_MSG_MAP(CPolyCtl)
CHAIN_MSG_MAP(CComControl<CPolyCtl>)
DEFAULT_REFLECTION_HANDLER()
MESSAGE_HANDLER(WM_LBUTTONDOWN, OnLButtonDown)
END_MSG_MAP()
// Handler prototypes:
// LRESULT MessageHandler(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled);
// LRESULT CommandHandler(WORD wNotifyCode, WORD wID, HWND hWndCtl, BOOL& bHandled);
// LRESULT NotifyHandler(int idCtrl, LPNMHDR pnmh, BOOL& bHandled);
// ISupportsErrorInfo
STDMETHOD(InterfaceSupportsErrorInfo)(REFIID riid)
{
static const IID* arr[] = { &IID_IPolyCtl,};
for(int i=0; i<sizeof(arr)/sizeof(arr[0]); i++)
{
if(InlineIsEqualGUID(*arr[i], riid))
return S_OK;
}
return S_FALSE;
}
// IViewObjectEx
DECLARE_VIEW_STATUS(VIEWSTATUS_SOLIDBKGND | VIEWSTATUS_OPAQUE)
// IPolyCtl
public:
STDMETHOD(get_Sides)(/*[out, retval]*/ short *pVal);
STDMETHOD(put_Sides)(/*[in]*/ short newVal);
void CalcPoints(const RECT& rc);
HRESULT OnDraw(ATL_DRAWINFO& di)
{
RECT& rc = *(RECT*)di.prcBounds;
HDC hdc = di.hdcDraw;
COLORREF colFore;
HBRUSH hOldBrush, hBrush;
HPEN hOldPen, hPen;
// Translate m_colFore into a COLORREF type
OleTranslateColor(m_clrFillColor, NULL, &colFore);
// Create and select the colors to draw the circle
hPen = (HPEN)GetStockObject(BLACK_PEN);
hOldPen = (HPEN)SelectObject(hdc, hPen);
hBrush = (HBRUSH)GetStockObject(WHITE_BRUSH);
hOldBrush = (HBRUSH)SelectObject(hdc, hBrush);
Ellipse(hdc, rc.left, rc.top, rc.right, rc.bottom);
// Create and select the brush that will be used to fill the polygon
hBrush = CreateSolidBrush(colFore);
SelectObject(hdc, hBrush);
CalcPoints(rc);
Polygon(hdc, &m_arrPoint[0], m_nSides);
// Select back the old pen and brush and delete the brush we created
SelectObject(hdc, hOldPen);
SelectObject(hdc, hOldBrush);
DeleteObject(hBrush);
return S_OK;
}
OLE_COLOR m_clrFillColor;
short m_nSides;
POINT m_arrPoint[100];
LRESULT OnLButtonDown(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled)
{
HRGN hRgn;
WORD xPos = LOWORD(lParam); // horizontal position of cursor
WORD yPos = HIWORD(lParam); // vertical position of cursor
CalcPoints(m_rcPos);
// Create a region from our list of points
hRgn = CreatePolygonRgn(&m_arrPoint[0], m_nSides, WINDING);
// If the clicked point is in our polygon then fire the ClickIn
// event otherwise we fire the ClickOut event
if(PtInRegion(hRgn, xPos, yPos))
Fire_ClickIn(xPos, yPos);
else
Fire_ClickOut(xPos, yPos);
// Delete the region that we created
DeleteObject(hRgn);
return 0;
}
};
#endif //__POLYCTL_H_
pointer to
CoCreateInstance -> CoGetClassObject -> DllGetClassObject -> IClassFactory:::CreateInstance -> interface
/|\ /|\ on object
|_________________________________________________________________________|
|
Hidden from programmer
Comment