PowerBASIC Peer Support Forums
 

Go Back   PowerBASIC Peer Support Forums > Jose's Corner > Source Code

Source Code Source code related to Jose's work. Posts and uploads may be made by any forum member.

Reply
 
Thread Tools Display Modes
  #1  
Old Apr 6th, 2012, 12:55 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Assorted COM examples

Microsoft COM (Component Object Model) technology in the Microsoft Windows-family of Operating Systems enables software components to communicate. COM is used by developers to create re-usable software components, link components together to build applications, and take advantage of Windows services. COM objects can be created with a variety of programming languages. Object-oriented languages, such as C++, provide programming mechanisms that simplify the implementation of COM objects. The family of COM technologies includes COM+, Distributed COM (DCOM) and ActiveXģ Controls.

Microsoft provides COM interfaces for many Windows application programming interfaces such as Direct Show, Media Foundation, Packaging API, Windows Animation Manager, Windows Portable Devices, and Microsoft Active Directory (AD).

COM is used in applications such as the Microsoft Office Family of products. For example COM OLE technology allows Word documents to dynamically link to data in Excel spreadsheets and COM Automation allows users to build scripts in their applications to perform repetitive tasks or control one application from another.
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #2  
Old Apr 6th, 2012, 12:56 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
How to enumerate the Running Object Table (ROT)

The IRunningObjectTable interface manages access to the Running Object Table (ROT), a globally accessible look-up table on each workstation. A workstation's ROT keeps track of those objects that can be identified by a moniker and that are currently running on the workstation. When a client tries to bind a moniker to an object, the moniker checks the ROT to see if the object is already running; this allows the moniker to bind to the current instance instead of loading a new one.

The ROT contains entries of the form:

(pmkObjectName, pUnkObject)

The pmkObjectName element is a pointer to the moniker that identifies the running object. The pUnkObject element is a pointer to the running object itself. During the binding process, monikers consult the pmkObjectName entries in the Running Object Table to see if an object is already running.

Objects that can be named by monikers must be registered with the ROT when they are loaded and their registration must be revoked when they are no longer running.

The following example shows the display names of all the objects currently registered in the Running Object Table (ROT).

Code:
' ########################################################################################
' The following example shows the display names of all the objects currently registered in
' the Running Object Table (ROT).
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"
#INCLUDE "objidl.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL pbc AS IBindCtx
   LOCAL pRot AS IRunningObjectTable
   LOCAL pEnumMoniker AS IEnumMoniker
   LOCAL pMoniker AS IMoniker
   LOCAL pceltFetched AS DWORD
   LOCAL pwszDisplayName AS WSTRINGZ PTR

   ' // Get a pointer to a bind context
   hr = CreateBindCtx(0, pbc)
   IF hr <> %S_OK THEN EXIT FUNCTION

   ' // Get a reference to the Running Object Table (ROT)
   hr = pbc.GetRunningObjectTable(pRot)
   IF hr <> %S_OK THEN EXIT FUNCTION

   ' // Get a pointer to the moniker enumerator
   hr = pRot.EnumRunning(pEnumMoniker)
   IF hr <> %S_OK THEN EXIT FUNCTION

   ' // Enumerate the monikers and retrieve the display name
   DO
      ' // Fetch the next moniker
      hr = pEnumMoniker.Next(1, pMoniker, pceltFetched)
      IF hr <> %S_OK THEN EXIT DO
      ' // Get the display name
      hr = pMoniker.GetDisplayName(pbc, NOTHING, pwszDisplayName)
      IF hr <> %S_OK THEN EXIT DO
      IF pwszDisplayName THEN
         ' // Display the name
         ? @pwszDisplayName
         ' // Free the server allocated string
         CoTaskMemFree pwszDisplayName
      END IF
      ' // Release the moniker reference
      pMoniker = NOTHING
   LOOP

   #IF %DEF(%PB_CC32)
      WAITKEY$
   #ENDIF

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #3  
Old Apr 6th, 2012, 12:58 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
IFileOpenDialog Interface

The following example demonstrates the use of the IFileOpenDialog interface, introduced in Windows Vista.

Code:
#COMPILE EXE
#DIM ALL
#INCLUDE "ShObjIdl.inc"

FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG

   ' // Create an instance of the IFileOpenDialog interface
   LOCAL pofd AS IFileOpenDialog
   pofd = NEWCOM CLSID $CLSID_FileOpenDialog
   IF ISNOTHING(pofd) THEN EXIT FUNCTION

   DIM rgFileTypes(2) AS COMDLG_FILTERSPEC
   DIM pszNames(2) AS WSTRINGZ * %MAX_PATH
   DIM pszSpecs(2) AS WSTRINGZ * %MAX_PATH
   pszNames(0) = "PB code files"
   pszNames(1) = "Executable files"
   pszNames(2) = "All files"
   pszSpecs(0) = "*.bas;*.inc"
   pszSpecs(1) = "*.exe;*.dll"
   pszSpecs(2) = "*.*"
   rgFileTypes(0).pszName = VARPTR(pszNames(0)) : rgFileTypes(0).pszSpec = VARPTR(pszSpecs(0))
   rgFileTypes(1).pszName = VARPTR(pszNames(1)) : rgFileTypes(1).pszSpec = VARPTR(pszSpecs(1))
   rgFileTypes(2).pszName = VARPTR(pszNames(2)) : rgFileTypes(2).pszSpec = VARPTR(pszSpecs(2))
   hr = pofd.SetFileTypes(3, rgFileTypes(0))

   ' // Set the title of the dialog
   hr = pofd.SetTitle("A Single-Selection Dialog")

   ' // Display the dialog
   hr = pofd.Show(0)

   ' // Get the result
   LOCAL pItem AS IShellItem
   LOCAL pwszName AS WSTRINGZ PTR
   IF SUCCEEDED(hr) THEN
      hr = pofd.GetResult(pItem)
      IF SUCCEEDED(hr) THEN
         hr = pItem.GetDisplayName(%SIGDN_FILESYSPATH, pwszName)
         MSGBOX @pwszName
         CoTaskMemFree(pwszName)
      END IF
   END IF

END FUNCTION
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #4  
Old Apr 6th, 2012, 01:24 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
How to implement the IDropTarget interface

The action of using the mouse to transfer data from one place to another is called drag-and-drop.

To made an application the target of a drag-and-drop operation we need to implement the IDropTarget interface and register the application window as drop target with a call to the function RegisterDragDrop.

A drop-target application is responsible for:
  • Determining the effect of the drop on the target application.
  • Incorporating any valid dropped data when the drop occurs.
  • Communicating target feedback to the source so the source application can provide appropriate visual feedback such as setting the cursor.
  • Implementing drag scrolling.
  • Registering and revoking its application windows as drop targets.

Applications that use drag-and-drop functionality must call the API function OleInitialize before calling any other function of the COM library. Because OLE operations aren't thread safe, OleInitialize specifies the concurrency model as single-thread apartment (STA).

When your application ends, you must call the API function OleUninitialize as the last COM call to close the COM library.

Here is the WinMain function of the attached example, showing the call to OleInitialize at the beginning of the function and the call to OleUninitialize at the end:

Code:
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
'   SetProcessDPIAware

   ' Initialize the COM library
   OleInitialize %NULL

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "IDropTarget Demo", 0, 0, 0, 0, 0, %WS_EX_TOPMOST, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 400, 80
   ' // Center the window
   pWindow.CenterWindow

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

   ' Uninitialize the COM library
   OleUninitialize

END FUNCTION
' ========================================================================================
The API function RegisterDragDrop registers the specified window as one that can be the target of an OLE drag-and-drop operation and specifies the IDropTarget instance to use for drop operations.

In the example, during the processing of the WM_CREATE message in the main window callback function we add a label control, create an instance of our implemented IDropTarget interface and register the label control as a candidate target of an OLE drag-and-drop operation with a call to RegisterDragDrop.

Code:
      CASE %WM_CREATE
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         ' // Add a label
         hLabel = pWindow.AddLabel(hwnd, %IDC_LABEL, "Drop a link here...", 20, 30, 360, 20, %WS_VISIBLE OR %WS_CHILD OR %WS_BORDER)
         IF hLabel THEN
            ' Create a new instance of our implemented IDropTarget interface
            pDropTarget = CLASS "CDropTarget"
            IF ISOBJECT(pDropTarget) THEN
               ' Sets the handle of the label
               pDropTarget.SetHwnd hLabel
               ' Locks the object to ensure that it stays in memory
               hr = CoLockObjectExternal(pDropTarget, %TRUE, %FALSE)
               ' Registers the specified window as one that can be the target
               ' of an OLE drag-and-drop operation and specifies the IDropTarget
               ' instance to use for drop operations.
               hr = RegisterDragDrop(hLabel, pDropTarget)
            END IF
         END IF
         EXIT FUNCTION
RevokeDragDrop revokes the registration of the specified application window as a potential target for OLE drag-and-drop operations.

In the example, during the processing of the WM_DESTROY message we revoke the registration of the label with a call to RevokeDragDrop and release the instance of our implemented IDropTarget interface.

Code:
      CASE %WM_DESTROY
         ' // Revokes the registration of the specified application window as a
         ' // potential target for OLE drag-and-drop operations.
         IF hLabel THEN RevokeDragDrop hLabel
         IF ISOBJECT(pDropTarget) THEN
            ' // Unlocks our IDropTarget interface
            hr = CoLockObjectExternal(pDropTarget, %FALSE, %FALSE)
            ' // Frees the memory used by our IDropTarget interface
            pDropTarget = NOTHING
         END IF
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION
The DragEnter method of the IDropTarget interface determines whether a drop can be accepted and its effect if it is accepted. To determine it, we will call the QueryDataObject and DropEffect methods. QueryDataObject checks if the data object contains the kind of data wanted, and DropEffect determines the allowed effect based on the state of the keyboard.

Code:
      ' ----------------------------------------------------------------------------------
      ' Determines whether a drop can be accepted and its effect if it is accepted
      ' ----------------------------------------------------------------------------------
      METHOD DragEnter ( _                      ' VTable offset = 12
        BYVAL pDataObject AS IDataObject _      ' // Pointer to the interface of the source data object
      , BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         pdwEffect = %DROPEFFECT_NONE
         IF ISFALSE ISOBJECT(pDataObject) THEN
            METHOD = %E_FAIL
            EXIT METHOD
         END IF

         ' Check if the data object contains the data we want
         bAllowDrop = ME.QueryDataObject(pDataObject)
         IF bAllowDrop THEN
            ' Get the dropeffect based on keyboard state
            pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
            ' Bring the window to the foregroung
            IF hwnd THEN SetForegroundWindow hwnd
         END IF

         ' Return success
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------
This is our implementation of the QueryDataObject method:

Code:
      ' ----------------------------------------------------------------------------------
      ' Checks if the data object contains the data we want.
      ' In this example, asks for some CF_TEXT data, stored as a HGLOBAL in the clipboard
      ' ----------------------------------------------------------------------------------
      METHOD QueryDataObject (BYVAL pDataObject AS IDataObject) AS LONG

         LOCAL hr AS LONG
         LOCAL fmtc AS FORMATETC
         LOCAL stgmed AS STGMEDIUM

         fmtc.cfFormat = %CF_TEXT
         fmtc.ptd = %NULL
         fmtc.dwAspect = %DVASPECT_CONTENT
         fmtc.lindex = -1
         fmtc.tymed = %TYMED_HGLOBAL
         hr = pDataObject.GetData(fmtc, stgmed)
         IF hr = %S_OK THEN
            IF stgmed.hGlobal THEN METHOD = %TRUE
            ReleaseStgMedium stgmed
         END IF

      END METHOD
      ' ----------------------------------------------------------------------------------
And this is our implementation of the DropEffect method:

Code:
      ' ----------------------------------------------------------------------------------
      ' Retrieves the allowed drop effect
      ' ----------------------------------------------------------------------------------
      METHOD DropEffect (BYVAL grfKeyState AS DWORD, BYVAL pt AS POINTL, BYVAL dwAllowed AS DWORD) AS DWORD

         LOCAL dwEffect  AS DWORD

         ' 1. Check "pt" -> Is a  drop allowed at the specified coordinates?
         ' 2. Work out that the drop-effect should be based on grfKeyState
         IF (grfKeyState AND %MK_CONTROL) THEN
            dwEffect = dwAllowed AND %DROPEFFECT_COPY
         ELSEIF (grfKeyState AND %MK_SHIFT) THEN
            dwEffect = dwAllowed AND %DROPEFFECT_MOVE
         END IF

         ' 3. No key-modifiers were specified (or drop effect not allowed), so
         '    base the effect on those allowed by the dropsource
         IF dwEffect = 0 THEN
            IF (dwAllowed AND %DROPEFFECT_COPY) THEN dwEffect = %DROPEFFECT_COPY
            IF (dwAllowed AND %DROPEFFECT_MOVE) THEN dwEffect = %DROPEFFECT_MOVE
            IF (dwAllowed AND %DROPEFFECT_LINK) THEN dwEffect = %DROPEFFECT_LINK
         END IF
         METHOD = dwEffect

      END METHOD
      ' ----------------------------------------------------------------------------------
The DragOver method is called whenever the state of the keyboard modifiers change or when the mouse moves. In our example, we call the DropEffect function to determine which drop effect is allowed and communicate it to the caller though the pdwEffect parameter.

Code:
      ' ----------------------------------------------------------------------------------
      ' Provides target feedback to the user through the DoDragDrop function
      ' ----------------------------------------------------------------------------------
      METHOD DragOver ( _                       ' VTable offset = 16
        BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         IF bAllowDrop THEN
            ' Get the dropeffect based on keyboard state
            pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
         ELSE
            pdwEffect = %DROPEFFECT_NONE
         END IF
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------
The DragLeave function is called whenever the mouse cursor is moved outside of our drop-target window, or the Escape key is pressed which cancels the drag-drop operation. In our example, we will simply return %S_OK.

Code:
      ' ----------------------------------------------------------------------------------
      ' Causes the drop target to suspend its feedback actions
      ' ----------------------------------------------------------------------------------
      METHOD DragLeave ( _                      ' VTable offset = 20
      ) AS LONG                                 ' HRESULT

         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------
Finally, in the Drop method we call the GetData method of the caller implementation of the IDataObject interface through the passed pDataObject pointer to retrieve data from the clipboard. In our example, we get the text and show it in the label. The way it has been implemented allows both to drop selected text or an hyperlink.

Code:
      ' ----------------------------------------------------------------------------------
      ' Drops the data into the target window
      ' ----------------------------------------------------------------------------------
      METHOD Drop ( _                           ' VTable offset = 24
        BYVAL pDataObject AS IDataObject _      ' // Pointer to the interface of the source data object
      , BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         pdwEffect = %DROPEFFECT_NONE
         IF ISFALSE ISOBJECT(pDataObject) THEN
            METHOD = %E_FAIL
            EXIT METHOD
         END IF

         ' Get the dropeffect based on keyboard state
         pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
         '  Ask IDataObject for some CF_TEXT data, stored as a HGLOBAL in the clipboard
         IF bAllowDrop THEN
            fmtc.cfFormat = %CF_TEXT
            fmtc.ptd = %NULL
            fmtc.dwAspect = %DVASPECT_CONTENT
            fmtc.lindex = -1
            fmtc.tymed = %TYMED_HGLOBAL
            hr = pDataObject.GetData(fmtc, stgmed)
            IF hr = %S_OK THEN
               IF stgmed.hGlobal THEN
                  ' Lock the hGlobal handle just in case isn't fixed memory
                  pData = GlobalLock(stgmed.hGlobal)
                  ' Store the data in a string variable
                  strData = @pData
                  ' Show the data in the window
                  IF hwnd THEN SetWindowText hwnd, @pData
                  ' Unlock the global data
                  GlobalUnlock stgmed.hGlobal
               END IF
               ' Free the memory used by the STGMEDIUM structure
               ReleaseStgMedium stgmed
            END IF
         END IF

         ' Return success
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------
Full example code (CWindow version)

Code:
' ########################################################################################
' This example demostrates how to implement the IDropTarget interface with PowerBASIC
' and make a label the target of a drag and drop operation.
' Note: Instead of a label you can use any other kind of window.
' ########################################################################################

#COMPILE EXE
#DIM ALL

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "oleidl.inc"

' ########################################################################################
' *** Custom implementation of the IDropTarget interface.
' The IDropTarget interface is one of the interfaces you implement to provide
' drag-and-drop operations in your application. It contains methods used in any
' application that can be a target for data during a drag-and-drop operation. A
' drop-target application is responsible for:

'  * Determining the effect of the drop on the target application.
'  * Incorporating any valid dropped data when the drop occurs.
'  * Communicating target feedback to the source so the source application can provide
'    appropriate visual feedback such as setting the cursor.
'  * Implementing drag scrolling.
'  * Registering and revoking its application windows as drop targets.

' The IDropTarget interface contains methods that handle all these responsibilities except
' registering and revoking the application window as a drop target, for which you must
' call the RegisterDragDrop and the RevokeDragDrop functions.
' You do not call the methods of IDropTarget directly. The DoDragDrop function calls the
' IDropTarget methods during the drag-and-drop operation.
' ########################################################################################

$CLSID_CDropTarget = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D619}")
$IID_IDropTarget = GUID$("{00000122-0000-0000-C000-000000000046}")

' // Need to declare it as common to avoid removal of methods
CLASS CDropTarget $CLSID_CDropTarget AS COMMON

   INSTANCE hr AS LONG
   INSTANCE hwnd AS DWORD
   INSTANCE bAllowDrop AS LONG
   INSTANCE fmtc AS FORMATETC
   INSTANCE stgmed AS STGMEDIUM
   INSTANCE pData AS ASCIIZ PTR
   INSTANCE strData AS STRING

   INTERFACE IDropTargetImpl $IID_IDropTarget

      INHERIT IUnknown

      ' ----------------------------------------------------------------------------------
      ' Determines whether a drop can be accepted and its effect if it is accepted
      ' ----------------------------------------------------------------------------------
      METHOD DragEnter ( _                      ' VTable offset = 12
        BYVAL pDataObject AS IDataObject _      ' // Pointer to the interface of the source data object
      , BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         pdwEffect = %DROPEFFECT_NONE
         IF ISFALSE ISOBJECT(pDataObject) THEN
            METHOD = %E_FAIL
            EXIT METHOD
         END IF

         ' Check if the data object contains the data we want
         bAllowDrop = ME.QueryDataObject(pDataObject)
         IF bAllowDrop THEN
            ' Get the dropeffect based on keyboard state
            pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
            ' Bring the window to the foregroung
            IF hwnd THEN SetForegroundWindow hwnd
         END IF

         ' Return success
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Provides target feedback to the user through the DoDragDrop function
      ' ----------------------------------------------------------------------------------
      METHOD DragOver ( _                       ' VTable offset = 16
        BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         IF bAllowDrop THEN
            ' Get the dropeffect based on keyboard state
            pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
         ELSE
            pdwEffect = %DROPEFFECT_NONE
         END IF
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Causes the drop target to suspend its feedback actions
      ' ----------------------------------------------------------------------------------
      METHOD DragLeave ( _                      ' VTable offset = 20
      ) AS LONG                                 ' HRESULT

         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Drops the data into the target window
      ' ----------------------------------------------------------------------------------
      METHOD Drop ( _                           ' VTable offset = 24
        BYVAL pDataObject AS IDataObject _      ' // Pointer to the interface of the source data object
      , BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         pdwEffect = %DROPEFFECT_NONE
         IF ISFALSE ISOBJECT(pDataObject) THEN
            METHOD = %E_FAIL
            EXIT METHOD
         END IF

         ' Get the dropeffect based on keyboard state
         pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
         '  Ask IDataObject for some CF_TEXT data, stored as a HGLOBAL in the clipboard
         IF bAllowDrop THEN
            fmtc.cfFormat = %CF_TEXT
            fmtc.ptd = %NULL
            fmtc.dwAspect = %DVASPECT_CONTENT
            fmtc.lindex = -1
            fmtc.tymed = %TYMED_HGLOBAL
            hr = pDataObject.GetData(fmtc, stgmed)
            IF hr = %S_OK THEN
               IF stgmed.hGlobal THEN
                  ' Lock the hGlobal handle just in case isn't fixed memory
                  pData = GlobalLock(stgmed.hGlobal)
                  ' Store the data in a string variable
                  strData = @pData
                  ' Show the data in the window
                  IF hwnd THEN SetWindowText hwnd, @pData
                  ' Unlock the global data
                  GlobalUnlock stgmed.hGlobal
               END IF
               ' Free the memory used by the STGMEDIUM structure
               ReleaseStgMedium stgmed
            END IF
         END IF

         ' Return success
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ==================================================================================
      ' *** We can add custom methods and properties here ***
      ' ==================================================================================

      ' ----------------------------------------------------------------------------------
      ' Window handle of the control that has been registered for drag and drop operations
      ' ----------------------------------------------------------------------------------
      METHOD SetHwnd (BYVAL hndl AS DWORD) AS LONG
         hwnd = hndl
         METHOD = %S_OK
      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Returns an string containing the text of the dropped link or text
      ' ----------------------------------------------------------------------------------
      METHOD GetData (BYREF pstrData AS STRING) AS LONG
         pstrData = strData
         METHOD = %S_OK
      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Retrieves the allowed drop effect
      ' ----------------------------------------------------------------------------------
      METHOD DropEffect (BYVAL grfKeyState AS DWORD, BYVAL pt AS POINTL, BYVAL dwAllowed AS DWORD) AS DWORD

         LOCAL dwEffect  AS DWORD

         ' 1. Check "pt" -> Is a  drop allowed at the specified coordinates?
         ' 2. Work out that the drop-effect should be based on grfKeyState
         IF (grfKeyState AND %MK_CONTROL) THEN
            dwEffect = dwAllowed AND %DROPEFFECT_COPY
         ELSEIF (grfKeyState AND %MK_SHIFT) THEN
            dwEffect = dwAllowed AND %DROPEFFECT_MOVE
         END IF

         ' 3. No key-modifiers were specified (or drop effect not allowed), so
         '    base the effect on those allowed by the dropsource
         IF dwEffect = 0 THEN
            IF (dwAllowed AND %DROPEFFECT_COPY) THEN dwEffect = %DROPEFFECT_COPY
            IF (dwAllowed AND %DROPEFFECT_MOVE) THEN dwEffect = %DROPEFFECT_MOVE
            IF (dwAllowed AND %DROPEFFECT_LINK) THEN dwEffect = %DROPEFFECT_LINK
         END IF
         METHOD = dwEffect

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Checks if the data object contains the data we want.
      ' In this example, asks for some CF_TEXT data, stored as a HGLOBAL in the clipboard
      ' ----------------------------------------------------------------------------------
      METHOD QueryDataObject (BYVAL pDataObject AS IDataObject) AS LONG

         LOCAL hr AS LONG
         LOCAL fmtc AS FORMATETC
         LOCAL stgmed AS STGMEDIUM

         fmtc.cfFormat = %CF_TEXT
         fmtc.ptd = %NULL
         fmtc.dwAspect = %DVASPECT_CONTENT
         fmtc.lindex = -1
         fmtc.tymed = %TYMED_HGLOBAL
         hr = pDataObject.GetData(fmtc, stgmed)
         IF hr = %S_OK THEN
            IF stgmed.hGlobal THEN METHOD = %TRUE
            ReleaseStgMedium stgmed
         END IF

      END METHOD
      ' ----------------------------------------------------------------------------------

   END INTERFACE

END CLASS
' ########################################################################################


' ########################################################################################
' Testing code
' ########################################################################################

%IDC_LABEL = 1001

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
'   SetProcessDPIAware

   ' Initialize the COM library
   OleInitialize %NULL

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "IDropTarget Demo", 0, 0, 0, 0, 0, %WS_EX_TOPMOST, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 400, 80
   ' // Center the window
   pWindow.CenterWindow

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

   ' Uninitialize the COM library
   OleUninitialize

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hr AS LONG
   STATIC hLabel AS DWORD
   STATIC pDropTarget AS IDropTargetImpl
   STATIC pWindow AS IWindow

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         ' // Add a label
         hLabel = pWindow.AddLabel(hwnd, %IDC_LABEL, "Drop a link here...", 20, 30, 360, 20, %WS_VISIBLE OR %WS_CHILD OR %WS_BORDER)
         IF hLabel THEN
            ' Create a new instance of our implemented IDropTarget interface
            pDropTarget = CLASS "CDropTarget"
            IF ISOBJECT(pDropTarget) THEN
               ' Sets the handle of the label
               pDropTarget.SetHwnd hLabel
               ' Locks the object to ensure that it stays in memory
               hr = CoLockObjectExternal(pDropTarget, %TRUE, %FALSE)
               ' Registers the specified window as one that can be the target
               ' of an OLE drag-and-drop operation and specifies the IDropTarget
               ' instance to use for drop operations.
               hr = RegisterDragDrop(hLabel, pDropTarget)
            END IF
         END IF
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_DESTROY
         ' // Revokes the registration of the specified application window as a
         ' // potential target for OLE drag-and-drop operations.
         IF hLabel THEN RevokeDragDrop hLabel
         IF ISOBJECT(pDropTarget) THEN
            ' // Unlocks our IDropTarget interface
            hr = CoLockObjectExternal(pDropTarget, %FALSE, %FALSE)
            ' // Frees the memory used by our IDropTarget interface
            pDropTarget = NOTHING
         END IF
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================
Full example code (DDT version)

Code:
' ########################################################################################
' This example demostrates how to implement the IDropTarget interface with PowerBASIC
' and make a label the target of a drag and drop operation.
' Note: Instead of a label you can use any other kind of window.
' ########################################################################################

#COMPILE EXE
#DIM ALL

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "oleidl.inc"

' ########################################################################################
' *** Custom implementation of the IDropTarget interface.
' The IDropTarget interface is one of the interfaces you implement to provide
' drag-and-drop operations in your application. It contains methods used in any
' application that can be a target for data during a drag-and-drop operation. A
' drop-target application is responsible for:

'  * Determining the effect of the drop on the target application.
'  * Incorporating any valid dropped data when the drop occurs.
'  * Communicating target feedback to the source so the source application can provide
'    appropriate visual feedback such as setting the cursor.
'  * Implementing drag scrolling.
'  * Registering and revoking its application windows as drop targets.

' The IDropTarget interface contains methods that handle all these responsibilities except
' registering and revoking the application window as a drop target, for which you must
' call the RegisterDragDrop and the RevokeDragDrop functions.
' You do not call the methods of IDropTarget directly. The DoDragDrop function calls the
' IDropTarget methods during the drag-and-drop operation.
' ########################################################################################

$CLSID_CDropTarget = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D619}")
$IID_IDropTarget = GUID$("{00000122-0000-0000-C000-000000000046}")

' // Need to declare it as common to avoid removal of methods
CLASS CDropTarget $CLSID_CDropTarget AS COMMON

   INSTANCE hr AS LONG
   INSTANCE hwnd AS DWORD
   INSTANCE bAllowDrop AS LONG
   INSTANCE fmtc AS FORMATETC
   INSTANCE stgmed AS STGMEDIUM
   INSTANCE pData AS ASCIIZ PTR
   INSTANCE strData AS STRING

   INTERFACE IDropTargetImpl $IID_IDropTarget

      INHERIT IUnknown

      ' ----------------------------------------------------------------------------------
      ' Determines whether a drop can be accepted and its effect if it is accepted
      ' ----------------------------------------------------------------------------------
      METHOD DragEnter ( _                      ' VTable offset = 12
        BYVAL pDataObject AS IDataObject _      ' // Pointer to the interface of the source data object
      , BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         pdwEffect = %DROPEFFECT_NONE
         IF ISFALSE ISOBJECT(pDataObject) THEN
            METHOD = %E_FAIL
            EXIT METHOD
         END IF

         ' Check if the data object contains the data we want
         bAllowDrop = ME.QueryDataObject(pDataObject)
         IF bAllowDrop THEN
            ' Get the dropeffect based on keyboard state
            pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
            ' Bring the window to the foregroung
            IF hwnd THEN SetForegroundWindow hwnd
         END IF

         ' Return success
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Provides target feedback to the user through the DoDragDrop function
      ' ----------------------------------------------------------------------------------
      METHOD DragOver ( _                       ' VTable offset = 16
        BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         IF bAllowDrop THEN
            ' Get the dropeffect based on keyboard state
            pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
         ELSE
            pdwEffect = %DROPEFFECT_NONE
         END IF
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Causes the drop target to suspend its feedback actions
      ' ----------------------------------------------------------------------------------
      METHOD DragLeave ( _                      ' VTable offset = 20
      ) AS LONG                                 ' HRESULT

         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Drops the data into the target window
      ' ----------------------------------------------------------------------------------
      METHOD Drop ( _                           ' VTable offset = 24
        BYVAL pDataObject AS IDataObject _      ' // Pointer to the interface of the source data object
      , BYVAL grfKeyState AS DWORD _            ' // Current state of keyboard modifier keys
      , BYVAL pt AS POINTL _                    ' // Current cursor coordinates (Must be BYVAL)
      , BYREF pdwEffect AS DWORD _              ' // Pointer to the effect of the drag-and-drop operation
      ) AS LONG                                 ' HRESULT

         pdwEffect = %DROPEFFECT_NONE
         IF ISFALSE ISOBJECT(pDataObject) THEN
            METHOD = %E_FAIL
            EXIT METHOD
         END IF

         ' Get the dropeffect based on keyboard state
         pdwEffect = ME.DropEffect(grfKeyState, pt, pdwEffect)
         '  Ask IDataObject for some CF_TEXT data, stored as a HGLOBAL in the clipboard
         IF bAllowDrop THEN
            fmtc.cfFormat = %CF_TEXT
            fmtc.ptd = %NULL
            fmtc.dwAspect = %DVASPECT_CONTENT
            fmtc.lindex = -1
            fmtc.tymed = %TYMED_HGLOBAL
            hr = pDataObject.GetData(fmtc, stgmed)
            IF hr = %S_OK THEN
               IF stgmed.hGlobal THEN
                  ' Lock the hGlobal handle just in case isn't fixed memory
                  pData = GlobalLock(stgmed.hGlobal)
                  ' Store the data in a string variable
                  strData = @pData
                  ' Show the data in the window
                  IF hwnd THEN SetWindowText hwnd, @pData
                  ' Unlock the global data
                  GlobalUnlock stgmed.hGlobal
               END IF
               ' Free the memory used by the STGMEDIUM structure
               ReleaseStgMedium stgmed
            END IF
         END IF

         ' Return success
         METHOD = %S_OK

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ==================================================================================
      ' *** We can add custom methods and properties here ***
      ' ==================================================================================

      ' ----------------------------------------------------------------------------------
      ' Window handle of the control that has been registered for drag and drop operations
      ' ----------------------------------------------------------------------------------
      METHOD SetHwnd (BYVAL hndl AS DWORD) AS LONG
         hwnd = hndl
         METHOD = %S_OK
      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Returns an string containing the text of the dropped link or text
      ' ----------------------------------------------------------------------------------
      METHOD GetData (BYREF pstrData AS STRING) AS LONG
         pstrData = strData
         METHOD = %S_OK
      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Retrieves the allowed drop effect
      ' ----------------------------------------------------------------------------------
      METHOD DropEffect (BYVAL grfKeyState AS DWORD, BYVAL pt AS POINTL, BYVAL dwAllowed AS DWORD) AS DWORD

         LOCAL dwEffect  AS DWORD

         ' 1. Check "pt" -> Is a  drop allowed at the specified coordinates?
         ' 2. Work out that the drop-effect should be based on grfKeyState
         IF (grfKeyState AND %MK_CONTROL) THEN
            dwEffect = dwAllowed AND %DROPEFFECT_COPY
         ELSEIF (grfKeyState AND %MK_SHIFT) THEN
            dwEffect = dwAllowed AND %DROPEFFECT_MOVE
         END IF

         ' 3. No key-modifiers were specified (or drop effect not allowed), so
         '    base the effect on those allowed by the dropsource
         IF dwEffect = 0 THEN
            IF (dwAllowed AND %DROPEFFECT_COPY) THEN dwEffect = %DROPEFFECT_COPY
            IF (dwAllowed AND %DROPEFFECT_MOVE) THEN dwEffect = %DROPEFFECT_MOVE
            IF (dwAllowed AND %DROPEFFECT_LINK) THEN dwEffect = %DROPEFFECT_LINK
         END IF
         METHOD = dwEffect

      END METHOD
      ' ----------------------------------------------------------------------------------

      ' ----------------------------------------------------------------------------------
      ' Checks if the data object contains the data we want.
      ' In this example, asks for some CF_TEXT data, stored as a HGLOBAL in the clipboard
      ' ----------------------------------------------------------------------------------
      METHOD QueryDataObject (BYVAL pDataObject AS IDataObject) AS LONG

         LOCAL hr AS LONG
         LOCAL fmtc AS FORMATETC
         LOCAL stgmed AS STGMEDIUM

         fmtc.cfFormat = %CF_TEXT
         fmtc.ptd = %NULL
         fmtc.dwAspect = %DVASPECT_CONTENT
         fmtc.lindex = -1
         fmtc.tymed = %TYMED_HGLOBAL
         hr = pDataObject.GetData(fmtc, stgmed)
         IF hr = %S_OK THEN
            IF stgmed.hGlobal THEN METHOD = %TRUE
            ReleaseStgMedium stgmed
         END IF

      END METHOD
      ' ----------------------------------------------------------------------------------

   END INTERFACE

END CLASS
' ########################################################################################


' ########################################################################################
' Testing code
' ########################################################################################

%IDC_LABEL = 1001

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hDlg AS LONG

   ' Initialize the COM library
   OleInitialize %NULL

   DIALOG NEW PIXELS, 0, "IDropTarget Demo", , , 400, 80, %WS_OVERLAPPED OR %WS_THICKFRAME OR %WS_SYSMENU OR _
   %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR %DS_CENTER, %WS_EX_TOPMOST TO hDlg
   DIALOG SHOW MODAL hDlg, CALL DlgProc

   ' Uninitialize the COM library
   OleUninitialize

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CALLBACK FUNCTION DlgProc() AS LONG

   LOCAL hr AS LONG
   STATIC hLabel AS DWORD
   STATIC pDropTarget AS IDropTargetImpl

   SELECT CASE CBMSG

      CASE %WM_INITDIALOG
         '  Creates a label control
         CONTROL ADD LABEL, CBHNDL, %IDC_LABEL, "Drop a link here...", 20, 30, 360, 20, %WS_VISIBLE OR %WS_CHILD OR %WS_BORDER
         ' Gets the handle of the label
         CONTROL HANDLE CBHNDL, %IDC_LABEL to hLabel
         IF hLabel THEN
            ' Create a new instance of our implemented IDropTarget interface
            pDropTarget = CLASS "CDropTarget"
            IF ISOBJECT(pDropTarget) THEN
               ' Sets the handle of the label
               pDropTarget.SetHwnd hLabel
               ' Locks the object to ensure that it stays in memory
               hr = CoLockObjectExternal(pDropTarget, %TRUE, %FALSE)
               ' Registers the specified window as one that can be the target
               ' of an OLE drag-and-drop operation and specifies the IDropTarget
               ' instance to use for drop operations.
               hr = RegisterDragDrop(hLabel, pDropTarget)
            END IF
         END IF

      CASE %WM_COMMAND
         SELECT CASE CBCTL
            CASE %IDCANCEL
               IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL, 0
         END SELECT

      CASE %WM_DESTROY
         ' // Revokes the registration of the specified application window as a
         ' // potential target for OLE drag-and-drop operations.
         IF hLabel THEN RevokeDragDrop hLabel
         IF ISOBJECT(pDropTarget) THEN
            ' // Unlocks our IDropTarget interface
            hr = CoLockObjectExternal(pDropTarget, %FALSE, %FALSE)
            ' // Frees the memory used by our IDropTarget interface
            pDropTarget = NOTHING
         END IF

   END SELECT

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #5  
Old Apr 6th, 2012, 01:30 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
How to create a type library programatically

Demonstrates how to create an OLE Automation type library using the ICreateTypeLib and ICreateTypeInfo interfaces. The type library that is created is called hello.tlb and corresponds to one that would have been built by mktyplib.exe if it had compiled the following .odl file.

Code:
[
  uuid(2F6CA420-C641-101A-B826-00DD01103DE1),            // LIBID_Hello
  helpstring("Hello 1.0 Type Library"),
  lcid(0x0409),
  version(1.0)
] 
library Hello
{
#ifdef WIN32
    importlib("stdole32.tlb");
#else
    importlib("stdole.tlb");
#endif
    
    [
      uuid(2F6CA422-C641-101A-B826-00DD01103DE1),        // IID_IHello
      helpstring("Hello Interface")
    ]
    interface IHello : IUnknown
    {
        [propput] void HelloMessage([in] BSTR Message);
        [propget] BSTR HelloMessage(void);
        void SayHello(void);        
    }
    [
      uuid(2F6CA423-C641-101A-B826-00DD01103DE1),        // IID_DHello
      helpstring("Hello Dispinterface")
    ]  
    dispinterface DHello
    {
      interface IHello;
    }                                         
    
    [
       uuid(2F6CA421-C641-101A-B826-00DD01103DE1),       // CLSID_Hello
       helpstring("Hello Class")
    ]                                             
    coclass Hello
    {   
        dispinterface DHello;
        interface IHello;
    }
}
The following PowerBASIC example is based in the C program TYPEBLD, written by Microsoft Product Support Services, Windows Developer Support (c) Copyright Microsoft Corp. 1995.

http://support.microsoft.com/kb/131105/EN-US/

Code:
' ========================================================================================
' Demonstrates how to build a type library programatically.
' Based on the C program TypeBld, written by Microsoft Product Support Services, Windows
' Developer Support (c) Copyright Microsoft Corp. 1995.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "OleAuto.inc"

$LIBID_Hello = GUID$("{2F6CA420-C641-101A-B826-00DD01103DE1}")
$CLSID_Hello = GUID$("{2F6CA421-C641-101A-B826-00DD01103DE1}")
$IID_IHello = GUID$("{2F6CA422-C641-101A-B826-00DD01103DE1}")
$IID_DHello = GUID$("{2F6CA423-C641-101A-B826-00DD01103DE1}")

' ========================================================================================
' Create the type infos
' ========================================================================================
FUNCTION CreateTypeInfos (BYVAL pctlib AS ICreateTypeLib) AS LONG

   LOCAL hr AS LONG

   LOCAL wszText AS WSTRINGZ * 260            ' // General purpose variable
   LOCAL ptlibStdOle AS ITypeLib              ' // ITypeLib reference pointer
   LOCAL ptinfoIUnknown AS ITypeInfo          ' // ITypeInfo reference pointer
   LOCAL ptinfoIDispatch AS ITypeInfo         ' // ITypeInfo reference pointer
   LOCAL pctinfo AS ICreateTypeInfo           ' // ICreateTypeInfo reference pointer
   LOCAL hreftype AS DWORD                    ' // Reference type

   wszText = "stdole32.tlb"
   hr = LoadTypeLib(wszText, ptlibStdOle)
   hr = ptlibStdOle.GetTypeInfoOfGuid($IID_IUNKNOWN, ptinfoIUnknown)
   hr = ptlibStdOle.GetTypeInfoOfGuid($IID_IDISPATCH, ptinfoIDispatch)
   ptlibStdOle = NOTHING

   wszText = "IHello"
   hr = pctlib.CreateTypeInfo(wszText, %TKIND_INTERFACE, pctinfo)
   hr = pctinfo.SetGuid($IID_IHello)
   wszText = "Hello interface"
   hr = pctinfo.SetDocString(wszText)

   ' Save typeinfo of IHello for others who may refer to it.
   LOCAL ptinfoIHello AS ITypeInfo
   ptinfoIHello = pctinfo

   ' Output base interface of IHello (IUnknown)
   hr = pctinfo.AddRefTypeInfo(ptinfoIUnknown, hreftype)
   hr = pctinfo.AddImplType(0, hreftype)

   LOCAL tfuncdesc AS FUNCDESC

   ' Output [propget, id(0)] BSTR HelloMessage(void)
   DIM rgszFuncArgNamesHM(0) AS WSTRING
   rgszFuncArgNamesHM(0) = "HelloMessage"

   tfuncdesc.memid = 0
   tfuncdesc.lprgscode = %NULL
   tfuncdesc.lprgelemdescParam = %NULL
   tfuncdesc.funckind = %FUNC_PUREVIRTUAL
   tfuncdesc.invkind = %INVOKE_PROPERTYGET
   tfuncdesc.callconv = %CC_STDCALL
   tfuncdesc.cParams = 0
   tfuncdesc.cParamsOpt = 0
   tfuncdesc.oVft = 0         ' This will be assigned by ICreateTypeInfo.LayOut
   tfuncdesc.cScodes = 0
   tfuncdesc.elemdescFunc.tdesc.vt = %VT_BSTR
   tfuncdesc.elemdescFunc.idldesc.dwReserved = %NULL
   tfuncdesc.elemdescFunc.idldesc.wIDLFlags  = %IDLFLAG_NONE
   tfuncdesc.wFuncFlags = 0

   hr = pctinfo.AddFuncDesc(0, tfuncdesc)
   hr = pctinfo.SetFuncAndParamNames(0, rgszFuncArgNamesHM(0), 1)

   ' Output [propput, id(0)] void HelloMessage([in] BSTR Message)
   LOCAL telemdesc AS ELEMDESC

   telemdesc.tdesc.vt = %VT_BSTR
   telemdesc.idldesc.dwReserved = %NULL
   telemdesc.idldesc.wIDLFlags  = %IDLFLAG_FIN

   tfuncdesc.memid = 0
   tfuncdesc.lprgscode = %NULL
   tfuncdesc.lprgelemdescParam = VARPTR(telemdesc)
   tfuncdesc.funckind = %FUNC_PUREVIRTUAL
   tfuncdesc.invkind = %INVOKE_PROPERTYPUT
   tfuncdesc.callconv = %CC_STDCALL
   tfuncdesc.cParams = 1
   tfuncdesc.cParamsOpt = 0
   tfuncdesc.oVft = 0
   tfuncdesc.cScodes = 0
   tfuncdesc.elemdescFunc.tdesc.vt = %VT_VOID
   tfuncdesc.elemdescFunc.idldesc.dwReserved = %NULL
   tfuncdesc.elemdescFunc.idldesc.wIDLFlags = %IDLFLAG_NONE

   hr = pctinfo.AddFuncDesc(1, tfuncdesc)
   hr = pctinfo.SetFuncAndParamNames(1, rgszFuncArgNamesHM(0), 1)

   ' // pctinfo->SetFuncAndParamNames is supposed to be called
   ' // only once per property. However unless it is called for both
   ' // the propput and propget, an exception will occur in 32 bit when
   ' // ICreateTypeInfo::LayOut is called.
   ' // This problem doesn't exist in 16 bit.

   ' // [id(1)] void SayHello(void)
   DIM rgszFuncArgNamesSH(0) AS WSTRING
   rgszFuncArgNamesSH(0) = "SayHello"

   tfuncdesc.memid = 1
   tfuncdesc.lprgscode = %NULL
   tfuncdesc.lprgelemdescParam = %NULL
   tfuncdesc.funckind = %FUNC_PUREVIRTUAL
   tfuncdesc.invkind = %INVOKE_FUNC
   tfuncdesc.callconv = %CC_STDCALL
   tfuncdesc.cParams = 0
   tfuncdesc.cParamsOpt = 0
   tfuncdesc.oVft = 0
   tfuncdesc.cScodes = 0
   tfuncdesc.elemdescFunc.tdesc.vt = %VT_VOID
   tfuncdesc.elemdescFunc.idldesc.dwReserved = %NULL
   tfuncdesc.elemdescFunc.idldesc.wIDLFlags  = %IDLFLAG_NONE
   tfuncdesc.wFuncFlags = 0

   hr = pctinfo.AddFuncDesc(2, tfuncdesc)
   hr = pctinfo.SetFuncAndParamNames(2, rgszFuncArgNamesSH(0), 1)

   hr = pctinfo.LayOut
   pctinfo = NOTHING

'    /*
'    Generate the typeinfo for the following dispinterface

'    [
'      uuid(2F6CA423-C641-101A-B826-00DD01103DE1),        // IID_DHello
'      helpstring("Hello Dispinterface")
'    ]
'    dispinterface DHello
'    {
'      interface IHello;
'    }
'    */

   wszText = "DHello"
   hr = pctlib.CreateTypeInfo(wszText, %TKIND_DISPATCH, pctinfo)
   hr = pctinfo.SetGuid($IID_DHello)
   wszText = "Hello Dispinterface"
   hr = pctinfo.SetDocString(wszText)

   ' Save typeinfo of IHello for others who may refer to it.
   LOCAL ptinfoDHello AS ITypeInfo
   ptinfoDHello = pctinfo

   ' Output base interface of DHello (IDispatch)
   hr = pctinfo.AddRefTypeInfo(ptinfoIDispatch, hreftype)
   hr = pctinfo.AddImplType(0, hreftype)

   ' Specify interface IHello that is wrapped by DHello
   hr = pctinfo.AddRefTypeInfo(ptinfoIHello, hreftype)
   hr = pctinfo.AddImplType(1, hreftype)

   hr = pctinfo.LayOut
   pctinfo = NOTHING


'    /*
'    Generate the typeinfo for the following coclass

'    [
'       uuid(2F6CA421-C641-101A-B826-00DD01103DE1),       // CLSID_Hello
'       helpstring("Hello Class")
'    ]
'    coclass Hello
'    {
'        dispinterface DHello;
'        interface IHello;
'    }
'   */

   wszText = "Hello"
   hr = pctlib.CreateTypeInfo(wszText, %TKIND_COCLASS, pctinfo)

   hr = pctinfo.SetGuid($CLSID_Hello)
   wszText = "Hello Class"
   hr = pctinfo.SetDocString(wszText)

   ' List DHello & IHello in the coclass
   hr = pctinfo.AddRefTypeInfo(ptinfoDHello, hreftype)
   hr = pctinfo.AddImplType(0, hreftype)
   hr = pctinfo.AddRefTypeInfo(ptinfoIHello, hreftype)
   hr = pctinfo.AddImplType(1, hreftype)

   hr = pctinfo.LayOut
   pctinfo = NOTHING

   ptinfoIUnknown = NOTHING
   ptinfoIDispatch = NOTHING
   ptinfoIHello = NOTHING
   ptinfoDHello = NOTHING

   FUNCTION = %NOERROR

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG


   LOCAL hr AS LONG
   LOCAL wszText AS WSTRINGZ * 260
   LOCAL pctlib AS ICreateTypeLib

   wszText = "hello.tlb"
   hr = CreateTypeLib(%SYS_WIN32, wszText, pctlib)
   IF hr <> %S_OK THEN EXIT FUNCTION
   hr = pctlib.SetLcid(&H409)
   hr = pctlib.SetVersion(1, 0)
   wszText = "Hello"
   hr = pctlib.SetName(wszText)
   hr = pctlib.SetGUID($LIBID_Hello)
   wszText = "Hello 1.0 Type Library"
   hr = pctlib.SetDocString(wszText)
   hr = CreateTypeInfos(pctlib)
   IF hr = %NOERROR THEN hr = pctlib.SaveAllChanges
   pctlib = NOTHING

   IF hr = %S_OK THEN MSGBOX "Done" ELSE MSGBOX "Error"

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #6  
Old Apr 6th, 2012, 01:41 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
How to implement the IRichEditOleCallback interface

Implementing the IRichEditOleCallback interface allows to perform insertion, deletion, cut, copy and paste, and drag operations with objects, such images, in a rich edit control.

The following example demonstrates how to implement the IRichEditOleCallback interface.

Code:
' ########################################################################################
' RichOle demo
' ########################################################################################

#DIM ALL
#COMPILE EXE
%UNICODE = 1
%USERICHEDIT = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "RichOle.inc"

' Control identifier
%IDC_RICHEDIT = 1001

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
'   SetProcessDPIAware

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "Rich Ole Demo", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a subclassed rich edit control without coordinates (it will be resized in WM_SIZE, below)
   LOCAL hRichEdit AS DWORD
   hRichEdit = pWindow.AddRichEdit(pWindow.hwnd, %IDC_RICHEDIT, "RichEdit box", 0, 0, 0, 0, 0, 0, CODEPTR(RichEditSubclassProc))
   ' // Specify which notifications the control sends to its parent window
   RichEdit_SetEventMask hRichEdit, %ENM_CHANGE

   ' // Set the IRichEditOleCallback object.
   ' // The control calls the AddRef function for the object before returning.
   LOCAL pRichEditOleCallback AS IRichEditOleCallbackImpl
   pRichEditOleCallback = CLASS "CRichEditOleCallback"
   RichEdit_SetOleCallback hRichEdit, OBJPTR(pRichEditOleCallback)

   ' // Load the file
   RichEdit_LoadRtfFromFile hRichEdit, EXE.Path$ & "Test.rtf"

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL tlf             AS LOGFONT                  ' font attributes
   LOCAL tcf             AS CHARFORMAT               ' rich edit character formatting information
   LOCAL ptnmhdr         AS NMHDR PTR                ' information about a notification message
   LOCAL ptmmi           AS MINMAXINFO PTR           ' pointer to the maximized and tracking info
   LOCAL hwndChild       AS DWORD                    ' handle of child window
   LOCAL hFont           AS DWORD                    ' handle of font used by form
   LOCAL dwMask          AS DWORD                    ' specifies the attributes of an item to retrieve or set
   LOCAL hDC             AS DWORD                    ' handle of memory device context
   STATIC pWindow        AS IWindow                  ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE %IDC_RICHEDIT
               IF HI(WORD, wParam) = %EN_CHANGE THEN
               END IF
         END SELECT

      CASE %WM_NOTIFY
         ptnmhdr = lParam
         SELECT CASE @ptnmhdr.idFrom
         END SELECT

      CASE %WM_SETFOCUS
         ' Set the keyboard focus to the first control that is
         ' visible, not disabled, and has the WS_TABSTOP style
         SetFocus GetNextDlgTabItem(hwnd, %NULL, %FALSE)

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_RICHEDIT), 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 20, %TRUE
         END IF

   END SELECT

   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' RichEdit control subclassed procedure
' ========================================================================================
FUNCTION RichEditSubclassProc ( _
   BYVAL hwnd    AS DWORD, _ ' control handle
   BYVAL uMsg    AS DWORD, _ ' type of message
   BYVAL wParam  AS DWORD, _ ' first message parameter
   BYVAL lParam  AS LONG _   ' second message parameter
   ) AS LONG

   LOCAL lpOldWndProc AS DWORD    ' address of original window procedure

   lpOldWndProc = GetProp(hwnd, "OLDWNDPROC")

   SELECT CASE uMsg
      CASE %WM_DESTROY
         ' // Remove control subclassing
         SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")
   END SELECT

   FUNCTION = CallWindowProc(lpOldWndProc, hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


' ########################################################################################
' IRichEditOleCallback interface
' IID = 00020D03-0000-0000-C000-000000000046
' Inherited interface = IUnknown
' Custom implementation of the IRichEditOleCallback interface.
' Used by the RichEdit to get OLE-related stuff from the application using RichEdit.
' Note: Callback interfaces must be declared AS COMMON to avoid code removal.
' ########################################################################################

CLASS CRichEditOleCallback AS COMMON

INTERFACE IRichEditOleCallbackImpl $IID_IRichEditOleCallback

   INHERIT IUnknown

   ' =====================================================================================
   METHOD GetNewStorage ( _                             ' VTable offset = 12
     BYREF lplpstg AS IStorage _                        ' LPSTORAGE FAR * lplpstg
   ) AS LONG                                            ' HRESULT

     LOCAL hr AS LONG
     LOCAL pILockBytes AS ILockBytes
     hr = CreateILockBytesOnHGlobal(%NULL, %TRUE, pILockBytes)
     IF FAILED(hr) THEN METHOD = hr : EXIT METHOD
     hr = StgCreateDocfileOnILockBytes(pILockBytes, _
          %STGM_SHARE_EXCLUSIVE OR %STGM_READWRITE OR %STGM_CREATE, _
          0, lplpstg)
     METHOD = hr

   END METHOD
   ' =====================================================================================
   METHOD GetInPlaceContext ( _                         ' VTable offset = 16
     BYREF lplpFrame AS IOleInPlaceFrame _              ' LPOLEINPLACEFRAME FAR * lplpFrame
   , BYREF lplpDoc AS IOleInPlaceUIWindow _             ' LPOLEINPLACEUIWINDOW FAR * lplpDoc
   , BYREF lpFrameInfo AS OLEINPLACEFRAMEINFO _         ' LPOLEINPLACEFRAMEINFO lpFrameInfo
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================
   METHOD ShowContainerUI ( _                           ' VTable offset = 20
     BYVAL fShow AS LONG _                              ' BOOL fShow
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================
   METHOD QueryInsertObject ( _                         ' VTable offset = 24
     BYREF lpclsid As GUID _                            ' LPCLSID lpclsid
   , BYVAL lpstg AS IStorage _                          ' LPSTORAGE lpstg
   , BYVAL cp AS LONG _                                 ' LONG cp
   ) AS LONG                                            ' HRESULT

     METHOD = %S_OK

   END METHOD
   ' =====================================================================================
   METHOD DeleteObject ( _                              ' VTable offset = 28
     BYVAL lpoleobj AS IOleObject _                     ' LPOLEOBJECT lpoleobj
   ) AS LONG                                            ' HRESULT

     METHOD = %S_OK

   END METHOD
   ' =====================================================================================
   METHOD QueryAcceptData ( _                           ' VTable offset = 32
     BYVAL lpdataobj AS IOleObject _                    ' LPDATAOBJECT lpdataobj
   , BYREF lpcfFormat AS DWORD _                        ' CLIPFORMAT FAR * lpcfFormat
   , BYVAL reco AS DWORD _                              ' DWORD reco
   , BYVAL fReally AS LONG _                            ' BOOL fReally
   , BYVAL hMetaPict AS DWORD _                         ' HGLOBAL hMetaPict
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================
   METHOD ContextSensitiveHelp ( _                      ' VTable offset = 36
     BYVAL fEnterMode AS LONG _                         ' BOOL fEnterMode
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================
   METHOD GetClipboardData ( _                          ' VTable offset = 40
     BYREF lpchrg AS CHARRANGE _                        ' CHARRANGE FAR * lpchrg
   , BYVAL reco AS DWORD _                              ' DWORD reco
   , BYREF lplpdataobj AS IOleObject _                  ' LPDATAOBJECT FAR * lplpdataobj
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================
   METHOD GetDragDropEffect ( _                         ' VTable offset = 44
     BYVAL fDrag AS LONG _                              ' BOOL fDrag
   , BYVAL grfKeyState AS DWORD _                       ' DWORD grfKeyState
   , BYREF pdwEffect AS DWORD _                         ' LPDWORD pdwEffect
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================
   METHOD GetContextMenu ( _                            ' VTable offset = 48
     BYVAL seltype AS WORD _                            ' WORD seltype
   , BYVAL lpoleobj AS IOleObject _                     ' LPOLEOBJECT lpoleobj
   , BYREF lpchrg AS CHARRANGE _                        ' CHARRANGE FAR * lpchrg
   , BYREF lphmenu AS DWORD _                           ' HMENU FAR * lphmenu
   ) AS LONG                                            ' HRESULT

     METHOD = %E_NOTIMPL

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS
' ========================================================================================
Attached Images
File Type: png RichOleDemo.png (14.4 KB, 54 views)
Attached Files
File Type: zip RichOleDemo.zip (12.7 KB, 24 views)
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #7  
Old Apr 6th, 2012, 01:44 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
CCLRHost Class: Hosting the Common Language Runtime

CCLRHost is a class designed to host the .NET Common Language Runtime (CLR) in a PowerBASIC application and create and unwrap an instance of a COM visible .NET class whose methods and properties can be called using the PowerBASIC COM Automation statements.

The folliwing example hosts the .NET 4 runtime in a PowerBASIC application, creates an instance of the System.Collections.Stack collection and calls its Push and Pop methods.

Code:
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "CCLRHost.inc"

FUNCTION PBMAIN () AS LONG

   LOCAL pCLRHost AS ICLRHost
   LOCAL oStack AS DISPATCH
   LOCAL vRes AS VARIANT
   LOCAL vPrm AS VARIANT
   LOCAL bstrOutput AS WSTRING

   ' // Create an instance of the CCLRHost class
   pCLRHost = NewCLR4Host("v4.0.30319")   ' --> change version number if needed
   IF ISNOTHING(pCLRHost) THEN EXIT FUNCTION

   ' // Create an instance of the Stack collection
   oStack = pCLRHost.CreateInstance("mscorlib", "System.Collections.Stack")
   IF ISOBJECT(oStack) THEN
      ' Push and Pop some strings
      vPrm = "rocks!"
      OBJECT CALL oStack.Push(vPrm)
      vPrm = "PB"
      OBJECT CALL oStack.Push(vPrm)
      OBJECT CALL oStack.Pop TO vRes
      bstrOutput = VARIANT$$(vRes)
      OBJECT CALL oStack.Pop TO vRes
      bstrOutput += " " & VARIANT$$(vRes)
      MSGBOX bstrOutput
      oStack = NOTHING
   END IF

   pCLRHost = NOTHING

END FUNCTION
Same as above, but using the .NET 2 runtime.

Code:
#INCLUDE "CCLRHost.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL pCLRHost AS ICLRHost
   LOCAL oStack AS DISPATCH
   LOCAL vRes AS VARIANT
   LOCAL vPrm AS VARIANT
   LOCAL bstrOutput AS WSTRING

   ' // Create an instance of the CCLRHost class
   pCLRHost = NewCLRHost("v2.0.50727", "wks")
   IF ISNOTHING(pCLRHost) THEN EXIT FUNCTION

   ' // Create an instance of the Stack collection
   oStack = pCLRHost.CreateInstance("mscorlib", "System.Collections.Stack")
   IF ISOBJECT(oStack) THEN
      ' Push and Pop some strings
      vPrm = "rocks!"
      OBJECT CALL oStack.Push(vPrm)
      vPrm = "PB"
      OBJECT CALL oStack.Push(vPrm)
      OBJECT CALL oStack.Pop TO vRes
      bstrOutput = VARIANT$$(vRes)
      OBJECT CALL oStack.Pop TO vRes
      bstrOutput += " " & VARIANT$$(vRes)
      MSGBOX bstrOutput
      oStack = NOTHING
   END IF

   pCLRHost = NOTHING

END FUNCTION
' ========================================================================================
The following version allows to use your own domain, instead of the default domain.

Code:
#INCLUDE "CCLRHost.inc"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL pCLRHost AS ICLRHost
   LOCAL pDomain AS SystemAppDomain

   LOCAL oStack AS DISPATCH
   LOCAL vRes AS VARIANT
   LOCAL vPrm AS VARIANT
   LOCAL bstrOutput AS WSTRING

   ' // Create and instance of the CCLRHost class and initialize it
   pCLRHost = NewCLRHost("v2.0.50727", "wks")
   IF ISNOTHING(pCLRHost) THEN EXIT FUNCTION

   ' // Create a custom domain
   pDomain = pCLRHost.CreateDomain("MyDomain")

   ' // Create an instance of the Stack collection
   oStack = pCLRHost.CreateInstance2(pDomain, "mscorlib", "System.Collections.Stack")
   IF ISOBJECT(oStack) THEN
      ' // Push and Pop some strings
      vPrm = "rocks!"
      OBJECT CALL oStack.Push(vPrm)
      vPrm = "PB"
      OBJECT CALL oStack.Push(vPrm)
      OBJECT CALL oStack.Pop TO vRes
      bstrOutput = VARIANT$$(vRes)
      OBJECT CALL oStack.Pop TO vRes
      bstrOutput += " " & VARIANT$$(vRes)
      MSGBOX bstrOutput
      oStack = NOTHING
   END IF

   pCLRHost.UnloadDomain(pDomain)

   pDomain = NOTHING
   pCLRHost = NOTHING

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #8  
Old Apr 6th, 2012, 01:47 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Hosting VBScript in your PowerBASIC application

This example is based i the following Microsoft article:
http://support.microsoft.com/kb/223139/en-us

MSDN documentation about the IActiveScriptSite interface:
http://msdn.microsoft.com/en-us/libr...8VS.94%29.aspx

Code:
' ########################################################################################
' Hosting VBScript in your PowerBASIC application
' Copyright (c) 2012 Josť Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' ========================================================================================
' The basic work flow is as follows:
' 1. You start the VBScript engine, vbscript.dll, and obtain IActiveScript and
'    IActiveScriptParse interfaces.
' 2. You give the VBScript engine your implementation of IActiveScriptSite, which the
'    engine uses later to obtain and call to your objects.
' 3. You add the objects that you implement and want to make available to scripts by
'    calling IActiveScript.AddNamedItem().
' 4. You provide the script text to execute through IActiveScriptParse.ParseScriptText().
'    Note that this doesn't actually run the script yet.
' 5. The script engine will now call into your IActiveScriptSite.GetItemInfo() for any
'    objects it doesn't recognize, to get their interface pointers.
' 6. You call IActiveScript.SetScriptState() with SCRIPT_STATE_CONNECTED to run the script.
' 7. The VBScript engine parses the text in the script for you and when it encounters a
'    method call or property reference, it delegates the implementation to your provided
'    interfaces.
' ========================================================================================

#COMPILE EXE
#DIM ALL

'/* header files for imported files */
#INCLUDE ONCE "ActivScp.inc"

' ########################################################################################
' Class MyObject
' Note: We need to declare the class AS COMMON to avoid dead code removal because the
' methods aren't called directly by the code but by the ActiveScript engine.
' ########################################################################################

$IID_CMyObject = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D621}")
$IID_IMyObject = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D622}")

CLASS CMyObject $IID_CMyObject AS COMMON

   INTERFACE IMyObject $IID_IMyObject

   INHERIT IDispatch

   METHOD SayHi (BYVAL bstrTo AS WSTRING)
      ? "Say Hi to " & bstrTo
   END METHOD

   METHOD Sum (BYVAL a AS LONG, BYVAL b AS LONG)
      ? STR$(a) & " +" & STR$(b) & " =" & STR$(a + b) & ", isn't it?"
   END METHOD

   END INTERFACE

END CLASS
' ########################################################################################

' ########################################################################################
' Class CMyScriptSite
' Note: We need to declare the class AS COMMON to avoid dead code removal because the
' methods aren't called directly by the code but by the ActivaScript engine.
' ########################################################################################

$IID_CMyScriptSite = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D620}")

CLASS CMyScriptSite $IID_CMyScriptSite AS COMMON

   INSTANCE m_wszObjectName AS WSTRINGZ * 260
   INSTANCE m_pScriptObjectUnk AS IUnknown

   CLASS METHOD Create
      ' // Creates an instance of our object
      m_pScriptObjectUnk = CLASS "CMyObject"
      m_wszObjectName = "MyObject"
   END METHOD

   CLASS METHOD Destroy
      ' // Releases our object
      m_pScriptObjectUnk = NOTHING
   END METHOD

   ' =====================================================================================
   ' Custom implementation of the IActiveScriptSite interface
   ' =====================================================================================
   INTERFACE IActiveScriptSiteImpl $IID_IActiveScriptSite

      INHERIT IUnknown

      ' ==================================================================================
      ' Retrieves the locale identifier associated with the host's user interface.
      ' ==================================================================================
      METHOD GetLCID (BYREF plcid AS LONG) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Allows the scripting engine to obtain information about an item added with the
      ' IActiveScript.AddNamedItem method.
      ' ==================================================================================
      METHOD GetItemInfo (BYREF wszName AS WSTRINGZ, BYVAL dwReturnMask AS DWORD, BYREF ppiunkItem AS DWORD, BYREF ppti AS DWORD) AS LONG

         LOCAL IID_CMyScriptSite AS GUID

         ' // Is it expecting an ITypeInfo?
         IF VARPTR(ppti) THEN
            ' // Default to null
            ppti = %NULL
            ' // Return if asking about ITypeInfo...
            IF (dwReturnMask AND %SCRIPTINFO_ITYPEINFO) = %SCRIPTINFO_ITYPEINFO THEN
               METHOD = %TYPE_E_ELEMENTNOTFOUND
               EXIT METHOD
            END IF
         END IF

         ' // Is the engine passing an IUnknown buffer?
         IF VARPTR(ppiunkItem) THEN
            ' // Default to null
            ppiunkItem = %NULL
            ' // Is Script Engine looking for an IUnknown for our object?
            IF (dwReturnMask AND %SCRIPTINFO_IUNKNOWN) = %SCRIPTINFO_IUNKNOWN THEN
               ' // Check for our object name...
               IF wszName = m_wszObjectName THEN
                  ' // Provide our object.
                  ppiunkItem = OBJPTR(m_pScriptObjectUnk)
                  ' // AddRef our object...
                  m_pScriptObjectUnk.AddRef
               END IF
            END IF
         END IF

         METHOD = %S_OK

      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Retrieves a host-defined string that uniquely identifies the current document version.
      ' ==================================================================================
      METHOD GetDocVersionString (BYREF bstrVersion AS WSTRING) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the script has completed execution.
      ' ==================================================================================
      METHOD OnScriptTerminate (BYREF pvarResult AS VARIANT, BYREF pexcepinfo AS EXCEPINFO) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the scripting engine has changed states.
      ' ==================================================================================
      METHOD OnStateChange (BYVAL ssScriptState AS DWORD) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that an execution error occurred while the engine was running the script.
      ' ==================================================================================
      METHOD OnScriptError (BYVAL pscripterror AS IActiveScriptError) AS LONG

         LOCAL bstrSourceLine AS WSTRING
         LOCAL ei AS EXCEPINFO
         LOCAL bstrlen AS LONG

         pscripterror.GetSourceLineText bstrSourceLine
         ? "IActiveScriptSite.OnScriptError" & $CRLF & _
            "*** Source line ***" & $CRLF & bstrSourceLine

         LOCAL hr AS LONG
         LOCAL dwSourceContext AS DWORD
         LOCAL ulLineNumber AS DWORD
         LOCAL lCharacterPosition AS LONG
         hr = pscripterror.GetSourcePosition(dwSourceContext, ulLineNumber, lCharacterPosition)
         IF hr = %S_OK THEN
            IF dwSourceContext THEN ? "Source context: " & FORMAT$(dwSourceContext)
            IF ulLineNumber THEN ? "Line number " & FORMAT$(ulLineNumber)
            IF lCharacterPosition THEN ? "Character Position: " & FORMAT$(lCharacterPosition)
         END IF

         ' // Retrieve the error information from EXCEPINFO
         pscripterror.GetExceptionInfo ei
         IF ei.sCode THEN
            ? "Error code: " & FORMAT$(ei.sCode) & " <" & HEX$(ei.scode) & ">"
         END IF
         IF ei.bstrSource THEN
            ? "Error source: " & ei.@bstrSource
            SysFreeString ei.bstrSource
         END IF
         IF ei.bstrDescription THEN
            ? "Error description: " & ei.@bstrDescription
            SysFreeString ei.bstrDescription
         END IF
         IF ei.bstrHelpFile THEN
            ? "Help file: " & ei.@bstrHelpFile
            IF ei.dwHelpContext THEN ? "Help context ID: " & FORMAT$(ei.dwHelpContext)
            SysFreeString ei.bstrHelpFile
         END IF

         METHOD = %S_OK

      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the scripting engine has begun executing the script code.
      ' ==================================================================================
      METHOD OnEnterScript () AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the scripting engine has returned from executing script code.
      ' ==================================================================================
      METHOD OnLeaveScript () AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

   END INTERFACE
   ' =====================================================================================

END CLASS
' ########################################################################################


' ########################################################################################
' Main
' ########################################################################################
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL pMySite AS IActiveScriptSiteImpl
   LOCAL wszObjectName AS WSTRINGZ * 260
   LOCAL wszScript AS WSTRINGZ * 260
   LOCAL ei AS EXCEPINFO

   ' // Create an instance of our script site
   pMySite = CLASS "CMyScriptSite"
   IF ISNOTHING(pMySite) THEN EXIT FUNCTION

   ' // Start inproc script engine, VBSCRIPT.DLL
   LOCAL pIActiveScript AS IActiveScript
   pIActiveScript = NEWCOM CLSID $CLSID_VBScript
   IF ISNOTHING(pIActiveScript) THEN  EXIT FUNCTION

   ' // Get engine's IActiveScriptParse interface
   LOCAL pIActiveScriptParse AS IActiveScriptParse
   pIActiveScriptParse = pIActiveScript
   IF ISNOTHING(pIActiveScriptParse) THEN  EXIT FUNCTION

   ' // Give the engine our IActiveScriptSite interface...
   hr = pIActiveScript.SetScriptSite(pMySite)
   ' // Give the engine a chance to initialize itself...
   hr = pIActiveScriptParse.InitNew
   ' // Add a root-level item to the engine's name space...
   wszObjectName = "MyObject"
   hr = pIActiveScript.AddNamedItem(wszObjectName, %SCRIPTITEM_ISVISIBLE OR %SCRIPTITEM_ISSOURCE)
   wszScript = "Sum 2,3" & $CRLF & _
               "SayHi(" & $DQ & "Active Scripting" & $DQ & ")"
   hr = pIActiveScriptParse.ParseScriptText(wszScript, wszObjectName, _
        NOTHING, "", 0, 0, 0, BYVAL %NULL, ei)
   ' // Set the engine state. This line actually triggers the execution of the script.
   hr = pIActiveScript.SetScriptState(%SCRIPTSTATE_CONNECTED)

   ' // Close script and release interfaces...
   pIActiveScript.Close
   pIActiveScriptParse = NOTHING
   pIActiveScript = NOTHING
   pMySite = NOTHING

   #IF %DEF(%PB_CC32)
   WAITKEY$
   #ENDIF

END FUNCTION
' ########################################################################################
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #9  
Old Apr 6th, 2012, 01:50 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Internet Explorer: How to get IWebBrowser2 from a HWND

This article shows how to get the IWebBrowser2 interface from a HWND. If Microsoft Active Accessibility (MSAA) is installed, you can send the WM_HTML_GETOBJECT message to the document's window (with the window class "Internet Explorer_Server") and then pass the result from SendMessageTimeout to an MSAA function, ObjectFromLresult, to get a fully marshaled IHTMLDocument2 pointer. Then you will call the parentWindow property of the IHTMLDocument2 interface to retrieve a reference to the IHTMLWindow2 interface and call the QueryInterface method to retrieve a reference to the IServiceProvider interface. Finally, you will call the QueryService method of the IServiceProvider interface to retrieve a reference to the IWebBrowser2 interface.

Code:
' ########################################################################################
' Demonstrates how to get the IWebBrowser2 interface from a HWND. If Microsoft Active
' Accessibility (MSAA) is installed, you can send the WM_HTML_GETOBJECT message to the
' document's window (with the window class "Internet Explorer_Server") and then pass the
' result from SendMessageTimeout to an MSAA function, ObjectFromLresult, to get a fully
' marshaled IHTMLDocument2 pointer. Then you will call the parentWindow property of the
' IHTMLDocument2 interface to retrieve a reference to the IHTMLWindow2 interface and call
' the QueryInterface method to retrieve a reference to the IServiceProvider interface.
' Finally, you will call the QueryService method of the IServiceProvider interface to
' retrieve a reference to the IWebBrowser2 interface.
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "OLEACC.INC"   ' // Accessibility
#INCLUDE "EXDISP.INC"   ' // WebBrowser Control
#INCLUDE "MSHTML.INC"   ' // MSHTML

' ========================================================================================
' Callback for EnumChildWindows
' ========================================================================================
FUNCTION EnumChildProc(BYVAL hwnd AS DWORD, BYVAL lParam AS DWORD PTR) AS LONG
   LOCAL szClassName AS ASCIIZ * %MAX_PATH
   GetClassName (hwnd, szClassName, %MAX_PATH)
   IF szClassName = "Internet Explorer_Server" THEN
      IF lParam <> %NULL THEN @lParam = hWnd
      FUNCTION = %FALSE
   ELSE
      FUNCTION = %TRUE
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG                              ' // HRESULT
   LOCAL hWndExplorer AS DWORD                   ' // Internet Explorer handle
   LOCAL hWndChild AS DWORD                      ' // Child window handle
   LOCAL dwMsg AS DWORD                          ' // Message to send
   LOCAL lRes AS DWORD                           ' // Result of the message processing
   LOCAL pIWebBrowser2 AS IWebBrowser2           ' // IWebBrowser2 interface pointer
   LOCAL pIHTMLDocument2 AS IHTMLDocument2       ' // IHTMLDocument2 interface pointer
   LOCAL pIHTMLWindow2 AS IHTMLWindow2           ' // IHTMLWindow2 interface pointer
   LOCAL pIServiceProvider AS IServiceProvider   ' // IServiceProvider interface pointer

   ' Find the window handle of a running instance of Internet Explorer
   hWndExplorer = FindWindow("IEFrame", BYVAL %NULL)
   IF ISFALSE hWndExplorer THEN
      ? "Internet Explorer isn't running"
      EXIT FUNCTION
   END IF
   ' Enumerate its child windows
   EnumChildWindows hWndExplorer, CODEPTR(EnumChildProc), VARPTR(hWndChild)
   IF ISFALSE hWndChild THEN EXIT FUNCTION
   ' Register the WM_HTML_GETOBJECT message
   dwMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
   IF ISFALSE dwMsg THEN EXIT FUNCTION
   ' Send a mensage to get an LRESULT
   SendMessageTimeout hWndChild, dwMsg, 0, 0, %SMTO_ABORTIFHUNG, 1000, lRes
   IF ISFALSE lRes THEN EXIT FUNCTION
   ' Retrieve a reference to the IHTMLDocument2 interface from the LRESULT
   hr = ObjectFromLresult(lRes, $IID_IHTMLDocument2, 0, pIHTMLDocument2)
   IF ISNOTHING(pIHTMLDocument2) THEN EXIT FUNCTION
   ' Get a reference to the IHTMLWindow2 interface for the parent window
   pIHTMLWindow2 = pIHTMLDocument2.parentWindow
   IF ISNOTHING(pIHTMLWindow2) THEN EXIT FUNCTION
   ' Retrieve a reference to the IServiceProvider interface
   pIServiceProvider = pIHTMLWindow2
   IF ISNOTHING(pIServiceProvider) THEN EXIT FUNCTION
   ' Retrieve a reference to the IWebBrowser2 interface
   pIServiceProvider.QueryService($IID_IWebBrowserApp, $IID_IWebBrowser2, pIWebBrowser2)
   IF ISNOTHING(pIWebBrowser2) THEN EXIT FUNCTION
   ' ==========================================================================
   ' Now you can call the methods and properties of the IWebBrowser2 interface.
   ' ==========================================================================
   ? "pIWebBrowser2 = " & STR$(OBJPTR(pIWebBrowser2))

   #IF %DEF(%PB_CC32)
   WAITKEY$
   #ENDIF

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #10  
Old Apr 6th, 2012, 01:52 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Internet Explorer: How to get IHTMLDocument2 from a HWND

Adapted from the Microsoft Knowledge Base article of the same name: http://support.microsoft.com/kb/249232

This article shows how to get the IHTMLDocument2 interface from a HWND. If Microsoft Active Accessibility (MSAA) is installed, you can send the WM_HTML_GETOBJECT message to the document's window (with the window class "Internet Explorer_Server") and then pass the result from SendMessageTimeout to an MSAA function, ObjectFromLresult, to get a fully marshaled IHTMLDocument2 pointer.

NOTE: Before Internet Explorer 5.5, frames were implemented by hosting a new instance of Shdocvw.dll, and each frame had a separate window associated with it. Internet Explorer 5.5 implements native frames for better performance, and all frames are rendered by the same instance of Shdocvw.dll. Since there will not be a HWND for each frame for Internet Explorer 5.5 and later, the sample code described in this section will work to get to the document of the main window only. You can still get to each frame's document by using the frames collection of the main document.

Code:
' ########################################################################################
' Adapted from the following Microsoft Knowledge Base article: http://support.microsoft.com/kb/249232
' Demonstrates how to get the IHTMLDocument2 interface from a HWND. If Microsoft Active
' Accessibility (MSAA) is installed, you can send the WM_HTML_GETOBJECT message to the
' document's window (with the window class "Internet Explorer_Server") and then pass the
' result from SendMessageTimeout to an MSAA function, ObjectFromLresult, to get a fully
' marshaled IHTMLDocument2 pointer.
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "OLEACC.INC"   ' // Accessibility
#INCLUDE "EXDISP.INC"   ' // WebBrowser Control
#INCLUDE "MSHTML.INC"   ' // MSHTML

' ========================================================================================
' Callback for EnumChildWindows
' ========================================================================================
FUNCTION EnumChildProc(BYVAL hwnd AS DWORD, BYVAL lParam AS DWORD PTR) AS LONG
   LOCAL szClassName AS ASCIIZ * %MAX_PATH
   GetClassName (hwnd, szClassName, %MAX_PATH)
   IF szClassName = "Internet Explorer_Server" THEN
      IF lParam <> %NULL THEN @lParam = hWnd
      FUNCTION = %FALSE
   ELSE
      FUNCTION = %TRUE
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG                              ' // HRESULT
   LOCAL hWndExplorer AS DWORD                   ' // Internet Explorer handle
   LOCAL hWndChild AS DWORD                      ' // Child window handle
   LOCAL dwMsg AS DWORD                          ' // Message to send
   LOCAL lRes AS DWORD                           ' // Result of the message processing
   LOCAL pIHTMLDocument2 AS IHTMLDocument2       ' // IHTMLDocument2 interface pointer

   ' Find the window handle of a running instance of Internet Explorer
   hWndExplorer = FindWindow("IEFrame", BYVAL %NULL)
   IF ISFALSE hWndExplorer THEN
      ? "Internet Explorer isn't running"
      EXIT FUNCTION
   END IF
   ' Enumerate its child windows
   EnumChildWindows hWndExplorer, CODEPTR(EnumChildProc), VARPTR(hWndChild)
   IF ISFALSE hWndChild THEN EXIT FUNCTION
   ' Register the WM_HTML_GETOBJECT message
   dwMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
   IF ISFALSE dwMsg THEN EXIT FUNCTION
   ' Send a mensage to get an LRESULT
   SendMessageTimeout hWndChild, dwMsg, 0, 0, %SMTO_ABORTIFHUNG, 1000, lRes
   IF ISFALSE lRes THEN EXIT FUNCTION
   ' Retrieve a reference to the IHTMLDocument2 interface from the LRESULT
   hr = ObjectFromLresult(lRes, $IID_IHTMLDocument2, 0, pIHTMLDocument2)
   IF ISNOTHING(pIHTMLDocument2) THEN EXIT FUNCTION
   ' Change the background color of the document to red
   pIHTMLDocument2.bgColor = "red"
   ' Cleanup
   pIHTMLDocument2 = NOTHING
   ? "Web page background color changed to red"
   #IF %DEF(%PB_CC32)
   WAITKEY$
   #ENDIF

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #11  
Old Apr 6th, 2012, 02:06 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Hosting Windows Explorer in your application

Requires Vista or Windows 7.

The Explorer Browser object allows developers to host Windows Explorer in their applications.

This is a minimal example. You can also sink to an event class and receive the following events: OnNavigationPending, OnViewCreated, OnNavigationComplete, OnNavigationFailed.

You can also add a toolbar or menu and, in the %WM_COMMAND message, perform one of these actions:

Code:
CASE %IDC_PREVIOUSFOLDER
   peb.BrowseToIDList(NULL, %SBSP_PARENT)
CASE %IDC_BACK
   peb.BrowseToIDList(NULL, %SBSP_NAVIGATEBACK)
CASE %IDC_FORWARD
   peb.BrowseToIDList(NULL, %SBSP_NAVIGATEFORWARD)
There are some more options that I haven't yet explored. See:
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

The example (DDT Version):

This example fills the entire client area of the dialog with Explorer, but you can choose the area where to display it passing the wanted position and size with peb.SetRect.

Code:
#COMPILE EXE
#DIM ALL
#COMPILER PBWIN 10

' // Include files for external files
#INCLUDE ONCE "ShlObj.inc"
#INCLUDE ONCE "ShObjIdl.inc"

GLOBAL peb AS IExplorerBrowser

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   ' // Create the dialog
   LOCAL hDlg AS DWORD
   DIALOG NEW PIXELS, 0, "IExplorerBrowser interface test", , , 500, 320, %WS_SYSMENU TO hDlg

   ' // Create an instance of IExplorerBrowser
   peb = NEWCOM CLSID $CLSID_ExplorerBrowser
   IF ISOBJECT(peb) THEN
      peb.SetOptions(%EBO_SHOWFRAMES)
      LOCAL fs AS FOLDERSETTINGS
      fs.ViewMode = %FVM_DETAILS
      LOCAL rc AS RECT
      GetClientRect hDlg, rc
      peb.Initialize(hDlg, rc, fs)
      ' // Navigate to the Profile folder
      LOCAL pidlBrowse AS DWORD
      IF SUCCEEDED(SHGetFolderLocation(%NULL, %CSIDL_PROFILE, %NULL, 0, pidlBrowse)) THEN
         peb.BrowseToIDList(pidlBrowse, 0)
         ILFree(pidlBrowse)
      END IF
   END IF

   ' // Display and activate the dialog
   DIALOG SHOW MODAL hDlg, CALL DlgProc

   ' // Destroy the instance of the Explorer browser
   IF ISOBJECT(peb) THEN peb.Destroy

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main callback function.
' ========================================================================================
CALLBACK FUNCTION DlgProc() AS LONG

   ' // Process window mesages
   SELECT CASE CB.MSG

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF CB.WPARAM <> %SIZE_MINIMIZED THEN
            ' // Resize the explorer browser
            LOCAL rc AS RECT
            GetClientRect CB.HNDL, rc
            IF ISOBJECT(peb) THEN peb.SetRect(BYVAL %NULL, rc)
         END IF

   END SELECT

END FUNCTION
' ========================================================================================
The example (CWindow Version):

Code:
#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "ShlObj.inc"
#INCLUDE ONCE "ShObjIdl.inc"

GLOBAL peb AS IExplorerBrowser

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   SetProcessDPIAware

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "IExplorerBrowser interface test", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Create an instance of IExplorerBrowser
   peb = NEWCOM CLSID $CLSID_ExplorerBrowser
   IF ISOBJECT(peb) THEN
      peb.SetOptions(%EBO_SHOWFRAMES)
      LOCAL fs AS FOLDERSETTINGS
      fs.ViewMode = %FVM_DETAILS
      LOCAL rc AS RECT
      GetClientRect pWindow.hwnd, rc
      peb.Initialize(pWindow.hwnd, rc, fs)
      ' // Navigate to the Profile folder
      LOCAL pidlBrowse AS DWORD
      IF SUCCEEDED(SHGetFolderLocation(%NULL, %CSIDL_PROFILE, %NULL, 0, pidlBrowse)) THEN
         peb.BrowseToIDList(pidlBrowse, 0)
         ILFree(pidlBrowse)
      END IF
   END IF

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the explorer browser
            LOCAL rc AS RECT
            GetClientRect hwnd, rc
            IF ISOBJECT(peb) THEN peb.SetRect(BYVAL %NULL, rc)
         END IF

      CASE %WM_DESTROY
         ' // Destroy the instance of the Explorer browser
         IF ISOBJECT(peb) THEN peb.Destroy
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================
Attached Images
File Type: png ExplorerBrowser_01.PNG (83.8 KB, 40 views)
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #12  
Old Apr 6th, 2012, 02:24 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
DirectShow: Enumerating Filters

The Filter Graph Manager supports the IFilterGraph.EnumFilters method, which enumerates all the filters in the filter graph. It returns a pointer to the IEnumFilters interface. The IEnumFilters.Next method retrieves IBaseFilter interface pointers.

Code:
' ########################################################################################
' DirectShow example.
' Enumerating filters.
' ########################################################################################

' CSED_PBCC - Use the PBCC compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "dshow.inc"
#INCLUDE ONCE "ole2utils.inc"   ' For IUnknown_Release

' ========================================================================================
' The Filter Graph Manager supports the IFilterGraph.EnumFilters method, which enumerates
' all the filters in the filter graph. It returns a pointer to the IEnumFilters interface.
' The IEnumFilters.Next method retrieves IBaseFilter interface pointers.
' ========================================================================================
FUNCTION EnumFilters (BYVAL pGraph AS IGraphBuilder) AS LONG

   LOCAL hr AS LONG                    ' HRESULT
   LOCAL pEnum AS IEnumFilters         ' IEnumFilters interface
   LOCAL pFilter AS IBaseFilter        ' IBaseFilter interface
   LOCAL cFetched AS DWORD             ' Number of filters fetched
   LOCAL FilterInfo AS FILTER_INFO     ' FILTER_INFO structure

   hr = pGraph.EnumFilters(pEnum)
   IF hr <> %S_OK THEN
      FUNCTION = hr
      EXIT FUNCTION
   END IF

   DO
      hr = pEnum.Next(1, pFilter, cFetched)
      IF hr <> %S_OK OR cFetched = 0 THEN EXIT DO
      RESET FilterInfo
      hr = pFilter.QueryFilterInfo(FilterInfo)
      IF hr <> %S_OK THEN
         STDOUT "Could not get the filter info"
      ELSE
         STDOUT FilterInfo.achName
         ' The FILTER_INFO structure holds a pointer to the Filter Graph
         ' Manager, with a reference count that must be released.
         IF FilterInfo.pGraph <> %NULL THEN IUnknown_Release FilterInfo.pGraph
      END IF
      ' Release the filter
      pFilter = NOTHING
   LOOP

   ' Release the collection
   pEnum = NOTHING

   FUNCTION = %S_OK

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pGraph AS IGraphBuilder
   LOCAL wszFile AS WSTRINGZ * %MAX_PATH

   pGraph = NEWCOM CLSID $CLSID_FilterGraph
   wszFile = EXE.Path$ & "useglue.wmv"
   pGraph.RenderFile(wszFile)
   EnumFilters(pGraph)
   pGraph = NOTHING

   WAITKEY$

END FUNCTION
' ========================================================================================
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #13  
Old Apr 6th, 2012, 02:32 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
DirectShow: Play Clip

Allows to select a video clip and plays it.

CWindow version:

Code:
' ========================================================================================
' DirectShow example.
' Allows to select a video clip and plays it.
' Based on an example by Vladimir Shulakov posted in the PowerBASIC forums:
' http://www.powerbasic.com/support/pbforums/showthread.php?t=23966
' ========================================================================================

' CSED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE ONCE "CWindow.inc"
#INCLUDE ONCE "commdlg.inc"
#INCLUDE ONCE "dshow.inc"

' Menu identifiers
%ID_FILE_OPENCLIP = 40001
%ID_FILE_EXIT     = 40002

' Custom message
%WM_GRAPHNOTIFY   = %WM_USER + 13

GLOBAL bIsPlaying AS LONG

' Interface pointers
GLOBAL pIGraphBuilder AS IGraphBuilder
GLOBAL pIMediaControl AS IMediaControl
GLOBAL pIMediaEventEx AS IMediaEventEx
GLOBAL pIVideoWindow  AS IVideoWindow

' ========================================================================================
' Play the movie inside the window.
' ========================================================================================
SUB PlayMovieInWindow (BYVAL hwnd AS DWORD, BYREF wszFileName AS WSTRINGZ)

   LOCAL hr AS LONG

   ' If there is a clip loaded, stop it
   IF ISOBJECT(pIMediaControl) THEN
      pIMediaControl.Stop
      pIMediaControl = NOTHING
      pIVideoWindow = NOTHING
      pIMediaEventEx = NOTHING
      pIGraphBuilder = NOTHING
   END IF

   ' Create an instance of the IGraphBuilder object
   pIGraphBuilder = NEWCOM CLSID $CLSID_FilterGraph
   IF hr <> %S_OK OR ISNOTHING(pIGraphBuilder) THEN EXIT SUB

   ' Retrieve interafce pointers
   pIMediaControl = pIGraphBuilder
   IF ISNOTHING(pIMediaControl) THEN EXIT SUB
   pIMediaEventEx = pIGraphBuilder
   IF ISNOTHING(pIMediaEventEx) THEN EXIT SUB
   pIVideoWindow = pIGraphBuilder
   IF ISNOTHING(pIVideoWindow) THEN EXIT SUB

   ' Render the file
   hr = pIGraphBuilder.RenderFile(wszFileName)
   IF hr <> %S_OK THEN EXIT SUB

   ' Set the window owner and style
   pIVideoWindow.Visible = %OAFALSE
   pIVideoWindow.Owner = hwnd
   pIVideoWindow.WindowStyle = %WS_CHILD OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN

   ' Have the graph signal event via window callbacks for performance
   pIMediaEventEx.SetNotifyWindow(hwnd, %WM_GRAPHNOTIFY, 0)

   ' Set the window position
   LOCAL rc AS RECT
   GetClientRect hwnd, rc
   pIVideoWindow.SetWindowPosition(rc.Left, rc.Top, rc.Right, rc.Bottom)
   ' Make the window visible
   pIVideoWindow.Visible = %OATRUE

   ' Run the graph
   pIMediaControl.Run
   bIsPlaying = %TRUE

END SUB
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   SetProcessDPIAware

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "DirectShow Demo", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   LOCAL hMenu AS DWORD
   LOCAL hMenuFile AS DWORD
   hMenu = CreateMenu
   hMenuFile = CreatePopUpMenu
   AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuFile, "&File"
   AppendMenu hMenuFile, %MF_ENABLED, %ID_FILE_OPENCLIP, "&Open clip..."
   AppendMenu hMenuFile, %MF_ENABLED, %ID_FILE_EXIT, "E&xit"
   SetMenu pWindow.hwnd, hMenu

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hDC AS DWORD
   LOCAL rc AS RECT
   LOCAL strFilter AS WSTRING
   LOCAL strDefExt AS WSTRING
   LOCAL strFileName AS WSTRING

   SELECT CASE wMsg

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDCANCEL, %ID_FILE_EXIT
               IF HI(WORD, wParam) = %BN_CLICKED AND bIsPlaying = 0 THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  FUNCTION = 0
                  EXIT FUNCTION
               END IF

            CASE %ID_FILE_OPENCLIP
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  strFilter = CHR$("Video Files (*.MPG;*MPEG;*.AVI;*.MOV;*.QT;*.WMV)", 0, "*.MPG;*.MPEG;*.AVI;*.MOV;*.QT;*.WMV", 0)
                  DISPLAY OPENFILE hwnd, 0, 0, "", "", strFilter, "", "", %OFN_EXPLORER OR %OFN_FILEMUSTEXIST TO strFileName
                  IF LEN(strFileName) THEN PlayMovieInWindow(hwnd, BYCOPY strFileName)
               END IF

         END SELECT

      CASE %WM_GRAPHNOTIFY

         LOCAL lEventCode AS LONG
         LOCAL lParam1 AS LONG
         LOCAL lParam2 AS LONG

         IF ISOBJECT(pIMediaEventEx) THEN
            DO
               pIMediaEventEx.GetEvent(lEventCode, lParam1, lParam2, 0)
               IF OBJRESULT <> %S_OK THEN EXIT DO
               pIMediaEventEx.FreeEventParams(lEventCode, lParam1, lParam2)
               IF lEventCode = %EC_COMPLETE THEN
                  IF ISOBJECT(pIVideoWindow) THEN
                     pIVideoWindow.Visible = %OAFALSE
                     pIVideoWindow.Owner = %NULL
                     pIVideoWindow = NOTHING
                  END IF
                  pIMediaControl = NOTHING
                  pIMediaEventEx = NOTHING
                  pIGraphBuilder = NOTHING
                  bIsPlaying = %FALSE
                  EXIT DO
               END IF
            LOOP
         END IF

      CASE %WM_SIZE
         GetClientRect hwnd, rc
         IF ISOBJECT(pIVideoWindow) THEN
            pIVideoWindow.SetWindowPosition(rc.Left, rc.Top, rc.Right, rc.Bottom)
            RedrawWindow hwnd, rc, 0, %RDW_INVALIDATE OR %RDW_UPDATENOW
         END IF

      CASE %WM_ERASEBKGND
         IF bIsPlaying = %FALSE THEN
            hDC = wParam
            GetClientRect hwnd, rc
            FillRect hDC, rc, GetStockObject(%BLACK_BRUSH)
            FUNCTION = %TRUE
            EXIT FUNCTION
         END IF

      CASE %WM_SYSCOMMAND
         ' Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_DESTROY
         IF ISOBJECT(pIMediaControl) THEN
            pIMediaControl.Stop
            pIMediaControl = NOTHING
         END IF
         IF ISOBJECT(pIVideoWindow) THEN
            pIVideoWindow.Visible = %OAFALSE
            pIVideoWindow.Owner = %NULL
            pIVideoWindow = NOTHING
         END IF
         pIMediaEventEx = NOTHING
         pIGraphBuilder = NOTHING
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================
Attached Files
File Type: zip DSHOW_PlayClip.zip (320.9 KB, 27 views)
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #14  
Old Apr 6th, 2012, 02:40 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Macromedia Flash Player

Demonstrates how to create an instance of the ShockWaveFlash player in a DDT dialog, load and play a movie and setting properties.

Code:
' ########################################################################################
' Demonstrates how to create an instance of the ShockWaveFlash player in a DDT dialog,
' load and play a movie and setting properties.
' ########################################################################################

#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEOLECON = 1                ' // Use OLE container
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "FLASH9.INC"

%IDC_FLASH = 101

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN () AS LONG

   ' // Create the dialog
   LOCAL hDlg AS DWORD
   DIALOG NEW PIXELS, 0, "Macromedia Flash Player 9", , , 450, 250, %WS_OVERLAPPEDWINDOW TO hDlg

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Add a MS Calendar control
   LOCAL nWide, nHigh AS LONG
   DIALOG GET CLIENT hDlg TO nWide, nHigh
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddOCX(hDlg, %IDC_FLASH, "ShockwaveFlash.ShockwaveFlash", "", 0, 0, nWide, nHigh)
   CONTROL SET FOCUS hDlg, %IDC_FLASH

   ' // Get the IDispatch of the control
   LOCAL pFlash AS IShockwaveFlash
   pFlash = OC_GetDispatch(hCtl)
   IF ISOBJECT(pFlash) THEN
      ' // Load the flash video - a full qualified path must be used
      pFlash.Movie = EXE.Path$ & "choudanse7.swf"
      ' // Play the video
      pFlash.Play
      ' ---------------------------------------------------------------------
      ' Example code to set properties
      ' ---------------------------------------------------------------------
      ' // Rotate the video
'            pFlash.SetVariable("_rotation", "10")
      ' // Modify the video transparency
'            pFlash.SetVariable("_alpha", "50")
      ' // Modify the scale and position
      pFlash.SetVariable("_xscale", "50")
      pFlash.SetVariable("_yscale", "50")
      pFlash.SetVariable("_x", "80")
      pFlash.SetVariable("_y", "40")
      ' ---------------------------------------------------------------------
      ' // Release the interface
      pFlash = NOTHING
   END IF

   ' // Display and activate the dialog
   DIALOG SHOW MODAL hDlg, CALL DlgProc

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Dialog procedure
' ========================================================================================
CALLBACK FUNCTION DlgProc() AS LONG

   SELECT CASE CBMSG

      CASE %WM_COMMAND
         SELECT CASE CB.CTL
            ' ...
            ' ...
         END SELECT

      CASE %WM_SIZE
         IF CB.WPARAM <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            LOCAL nWide, nHigh AS LONG
            DIALOG GET CLIENT CB.HNDL TO nWide, nHigh
            CONTROL SET SIZE CB.HNDL, %IDC_FLASH, nWide, nHigh
         END IF

   END SELECT

END FUNCTION
' ========================================================================================
Attached Images
File Type: png EX_DDT_Flash.PNG (98.8 KB, 24 views)
Attached Files
File Type: zip EX_DDT_Flash.zip (166.0 KB, 17 views)
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
  #15  
Old Apr 6th, 2012, 02:58 PM
Josť Roca Josť Roca is online now
Moderator
 
Join Date: Mar 2004
Location: Valencia, Spain
Posts: 6,811
Windows Media Pleyer

Demonstrates how to embed the Microsoft Windows Media Player control.

Code:
' ########################################################################################
' Demonstrates how to embed the Microsoft Windows Media Player control
' ########################################################################################

#COMPILE EXE
#DIM ALL
%UNICODE = 1
%USEOLECON = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "olecon.inc"    ' // Ole Container
#INCLUDE ONCE "WMP.inc"       ' // Windows Media Player

' // Identifier
%IDC_WMP = 101

' ########################################################################################
' Main
' ########################################################################################
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Make the application High DPI aware
'   SetProcessDPIAware

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "Windows Media Player", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 400, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Display a Windows Media Player video
   LOCAL hWMP AS DWORD
   hWMP = pWindow.AddOCX(pWindow.hwnd, %IDC_WMP, "WMPlayer.OCX", "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   ' // Set the focus in the control
   SetFocus hWMP
   ' // Get a pointer to the IWMPPlayer4 interface
   LOCAL pIWMPPlayer4 AS IWMPPlayer4
   pIWMPPlayer4 = OC_GetDispatch(hWMP)
   ' // Connect events
   IF ISOBJECT(pIWMPPlayer4) THEN
      LOCAL pWMPOCXEvents AS WMPOCXEventsImpl
      pWMPOCXEvents = CLASS "CWMPOCXEvents"
      IF ISOBJECT(pWMPOCXEvents) THEN OC_Advise(hWMP, pWMPOCXEvents, GUID$("{6BF52A51-394A-11D3-B153-00C04F79FAA6}"))
      ' // Set the URL
      pIWMPPlayer4.URL = EXE.Path$ & "Secretarys_***.wmv"
      ' // Play the movie
      pIWMPPlayer4.controls.play
      ' // Release the interface
      pIWMPPlayer4 = NOTHING
   END IF

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WMP), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ########################################################################################
' Class CWMPOCXEvents
' Interface name = _WMPOCXEvents
' IID = {6BF52A51-394A-11D3-B153-00C04F79FAA6}
' _WMPOCXEvents: Public interface.
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' Code generated by the TypeLib Browser 4.0.13 (c) 2008 by Josť Roca
' Date: 17 dic 2008   Time: 04:21:06
' ########################################################################################

CLASS CWMPOCXEvents GUID$("{E0D086A3-4900-47A6-A2C9-E806B39CD878}") AS EVENT

INTERFACE WMPOCXEventsImpl GUID$("{6BF52A51-394A-11D3-B153-00C04F79FAA6}") AS EVENT

  INHERIT IDispatch

   ' =====================================================================================
   METHOD OpenStateChange <5001> ( _
     BYVAL NewState AS LONG _                           ' [in] NewState VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlayStateChange <5101> ( _
     BYVAL NewState AS LONG _                           ' [in] NewState VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD AudioLanguageChange <5102> ( _
     BYVAL LangID AS LONG _                             ' [in] LangID VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD StatusChange <5002>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD ScriptCommand <5301> ( _
     BYVAL scType AS STRING _                           ' [in] scType VT_BSTR
   , BYVAL Param AS STRING _                            ' [in] Param VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD NewStream <5403>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Disconnect <5401> ( _
     BYVAL Result AS LONG _                             ' [in] Result VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Buffering <5402> ( _
     BYVAL Start AS INTEGER _                           ' [in] Start VT_BOOL <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Error <5501>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Warning <5601> ( _
     BYVAL WarningType AS LONG _                        ' [in] WarningType VT_I4 <Long>
   , BYVAL Param AS LONG _                              ' [in] Param VT_I4 <Long>
   , BYVAL Description AS STRING _                      ' [in] Description VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD EndOfStream <5201> ( _
     BYVAL Result AS LONG _                             ' [in] Result VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PositionChange <5202> ( _
     BYVAL oldPosition AS DOUBLE _                      ' [in] oldPosition VT_R8 <Double>
   , BYVAL newPosition AS DOUBLE _                      ' [in] newPosition VT_R8 <Double>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MarkerHit <5203> ( _
     BYVAL MarkerNum AS LONG _                          ' [in] MarkerNum VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DurationUnitChange <5204> ( _
     BYVAL NewDurationUnit AS LONG _                    ' [in] NewDurationUnit VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CdromMediaChange <5701> ( _
     BYVAL CdromNum AS LONG _                           ' [in] CdromNum VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlaylistChange <5801> ( _
     BYVAL Playlist AS IDispatch _                      ' [in] *Playlist VT_DISPATCH <IDispatch>
   , BYVAL change AS LONG _                             ' [in] change WMPPlaylistChangeEventType <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CurrentPlaylistChange <5804> ( _
     BYVAL change AS LONG _                             ' [in] change WMPPlaylistChangeEventType <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CurrentPlaylistItemAvailable <5805> ( _
     BYVAL bstrItemName AS STRING _                     ' [in] bstrItemName VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaChange <5802> ( _
     BYVAL Item AS IDispatch _                          ' [in] *Item VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CurrentMediaItemAvailable <5803> ( _
     BYVAL bstrItemName AS STRING _                     ' [in] bstrItemName VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CurrentItemChange <5806> ( _
     BYVAL pdispMedia AS IDispatch _                    ' [in] *pdispMedia VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaCollectionChange <5807>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaCollectionAttributeStringAdded <5808> ( _
     BYVAL bstrAttribName AS STRING _                   ' [in] bstrAttribName VT_BSTR
   , BYVAL bstrAttribVal AS STRING _                    ' [in] bstrAttribVal VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaCollectionAttributeStringRemoved <5809> ( _
     BYVAL bstrAttribName AS STRING _                   ' [in] bstrAttribName VT_BSTR
   , BYVAL bstrAttribVal AS STRING _                    ' [in] bstrAttribVal VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaCollectionAttributeStringChanged <5820> ( _
     BYVAL bstrAttribName AS STRING _                   ' [in] bstrAttribName VT_BSTR
   , BYVAL bstrOldAttribVal AS STRING _                 ' [in] bstrOldAttribVal VT_BSTR
   , BYVAL bstrNewAttribVal AS STRING _                 ' [in] bstrNewAttribVal VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlaylistCollectionChange <5810>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlaylistCollectionPlaylistAdded <5811> ( _
     BYVAL bstrPlaylistName AS STRING _                 ' [in] bstrPlaylistName VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlaylistCollectionPlaylistRemoved <5812> ( _
     BYVAL bstrPlaylistName AS STRING _                 ' [in] bstrPlaylistName VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlaylistCollectionPlaylistSetAsDeleted <5818> ( _
     BYVAL bstrPlaylistName AS STRING _                 ' [in] bstrPlaylistName VT_BSTR
   , BYVAL varfIsDeleted AS INTEGER _                   ' [in] varfIsDeleted VT_BOOL <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD ModeChange <5819> ( _
     BYVAL ModeName AS STRING _                         ' [in] ModeName VT_BSTR
   , BYVAL NewValue AS INTEGER _                        ' [in] NewValue VT_BOOL <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaError <5821> ( _
     BYVAL pMediaObject AS IDispatch _                  ' [in] *pMediaObject VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD OpenPlaylistSwitch <5823> ( _
     BYVAL pItem AS IDispatch _                         ' [in] *pItem VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DomainChange <5822> ( _
     BYVAL strDomain AS STRING _                        ' [in] strDomain VT_BSTR
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD SwitchedToPlayerApplication <6501>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD SwitchedToControl <6502>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlayerDockedStateChange <6503>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD PlayerReconnect <6504>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD Click <6505> ( _
     BYVAL nButton AS INTEGER _                         ' [in] nButton VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   , BYVAL fX AS LONG _                                 ' [in] fX VT_I4 <Long>
   , BYVAL fY AS LONG _                                 ' [in] fY VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DoubleClick <6506> ( _
     BYVAL nButton AS INTEGER _                         ' [in] nButton VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   , BYVAL fX AS LONG _                                 ' [in] fX VT_I4 <Long>
   , BYVAL fY AS LONG _                                 ' [in] fY VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyDown <6507> ( _
     BYVAL nKeyCode AS INTEGER _                        ' [in] nKeyCode VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyPress <6508> ( _
     BYVAL nKeyAscii AS INTEGER _                       ' [in] nKeyAscii VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyUp <6509> ( _
     BYVAL nKeyCode AS INTEGER _                        ' [in] nKeyCode VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MouseDown <6510> ( _
     BYVAL nButton AS INTEGER _                         ' [in] nButton VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   , BYVAL fX AS LONG _                                 ' [in] fX VT_I4 <Long>
   , BYVAL fY AS LONG _                                 ' [in] fY VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MouseMove <6511> ( _
     BYVAL nButton AS INTEGER _                         ' [in] nButton VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   , BYVAL fX AS LONG _                                 ' [in] fX VT_I4 <Long>
   , BYVAL fY AS LONG _                                 ' [in] fY VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MouseUp <6512> ( _
     BYVAL nButton AS INTEGER _                         ' [in] nButton VT_I2 <Integer>
   , BYVAL nShiftState AS INTEGER _                     ' [in] nShiftState VT_I2 <Integer>
   , BYVAL fX AS LONG _                                 ' [in] fX VT_I4 <Long>
   , BYVAL fY AS LONG _                                 ' [in] fY VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DeviceConnect <6513> ( _
     BYVAL pDevice AS IWMPSyncDevice _                  ' [in] *pDevice IWMPSyncDevice <interface>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DeviceDisconnect <6514> ( _
     BYVAL pDevice AS IWMPSyncDevice _                  ' [in] *pDevice IWMPSyncDevice <interface>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DeviceStatusChange <6515> ( _
     BYVAL pDevice AS IWMPSyncDevice _                  ' [in] *pDevice IWMPSyncDevice <interface>
   , BYVAL NewStatus AS LONG _                          ' [in] NewStatus WMPDeviceStatus <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DeviceSyncStateChange <6516> ( _
     BYVAL pDevice AS IWMPSyncDevice _                  ' [in] *pDevice IWMPSyncDevice <interface>
   , BYVAL NewState AS LONG _                           ' [in] NewState WMPSyncState <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DeviceSyncError <6517> ( _
     BYVAL pDevice AS IWMPSyncDevice _                  ' [in] *pDevice IWMPSyncDevice <interface>
   , BYVAL pMedia AS IDispatch _                        ' [in] *pMedia VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CreatePartnershipComplete <6518> ( _
     BYVAL pDevice AS IWMPSyncDevice _                  ' [in] *pDevice IWMPSyncDevice <interface>
   , BYVAL hrResult AS LONG _                           ' [in] hrResult VT_HRESULT <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CdromRipStateChange <6519> ( _
     BYVAL pCdromRip AS IWMPCdromRip _                  ' [in] *pCdromRip IWMPCdromRip <interface>
   , BYVAL wmprs AS LONG _                              ' [in] wmprs WMPRipState <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CdromRipMediaError <6520> ( _
     BYVAL pCdromRip AS IWMPCdromRip _                  ' [in] *pCdromRip IWMPCdromRip <interface>
   , BYVAL pMedia AS IDispatch _                        ' [in] *pMedia VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CdromBurnStateChange <6521> ( _
     BYVAL pCdromBurn AS IWMPCdromBurn _                ' [in] *pCdromBurn IWMPCdromBurn <interface>
   , BYVAL wmpbs AS LONG _                              ' [in] wmpbs WMPBurnState <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CdromBurnMediaError <6522> ( _
     BYVAL pCdromBurn AS IWMPCdromBurn _                ' [in] *pCdromBurn IWMPCdromBurn <interface>
   , BYVAL pMedia AS IDispatch _                        ' [in] *pMedia VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD CdromBurnError <6523> ( _
     BYVAL pCdromBurn AS IWMPCdromBurn _                ' [in] *pCdromBurn IWMPCdromBurn <interface>
   , BYVAL hrError AS LONG _                            ' [in] hrError VT_HRESULT <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD LibraryConnect <6524> ( _
     BYVAL pLibrary AS IWMPLibrary _                    ' [in] *pLibrary IWMPLibrary <interface>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD LibraryDisconnect <6525> ( _
     BYVAL pLibrary AS IWMPLibrary _                    ' [in] *pLibrary IWMPLibrary <interface>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD FolderScanStateChange <6526> ( _
     BYVAL wmpfss AS LONG _                             ' [in] wmpfss WMPFolderScanState <enum>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD StringCollectionChange <5824> ( _
     BYVAL pdispStringCollection AS IDispatch _         ' [in] *pdispStringCollection VT_DISPATCH <IDispatch>
   , BYVAL change AS LONG _                             ' [in] change WMPStringCollectionChangeEventType <enum>
   , BYVAL lCollectionIndex AS LONG _                   ' [in] lCollectionIndex VT_I4 <Long>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaCollectionMediaAdded <5825> ( _
     BYVAL pdispMedia AS IDispatch _                    ' [in] *pdispMedia VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD MediaCollectionMediaRemoved <5826> ( _
     BYVAL pdispMedia AS IDispatch _                    ' [in] *pdispMedia VT_DISPATCH <IDispatch>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS
Attached Images
File Type: jpg EX_CW_OC_WMP.jpg (41.7 KB, 43 views)
Attached Files
File Type: zip WMP.zip (1.76 MB, 45 views)
__________________
Website: http://www.jose.it-berater.org/index.html
SED Editor, TypeLib Browser.
Forum: http://www.jose.it-berater.org/smfforum/index.php
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -4. The time now is 08:56 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Copyright © 1999-2011 PowerBASIC, Inc. All Rights Reserved.
Error in my_thread_global_end(): 1 threads didn't exit