Page 2 of 2

Re: Calling a PB procedure from JavaScript?

Posted: Tue May 01, 2018 12:03 pm
by Justin
I changed some things to make it work on PB64, the first field of IID structs must be long, changed pokel to pokei, and used sizeof(IID) to compare memory.
Without enableexplicit the code is very dangerous. Should work on PB32 too.

Code: Select all


DataSection

IID_IUnkown: ; 00000000-0000-0000-C000-000000000046
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46

IID_IDispatch: ; 00020400-0000-0000-C000-000000000046
  Data.l $00020400
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46

IID_IHTMLDocument2: ; 332C4425-26CB-11D0-B483-00C04FD90119
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19

IID_ICustomDoc: ; 3050F3F0-98B5-11CF-BB82-00AA00BDCE0B
  Data.l $3050F3F0
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

IID_IDocHostUIHandler: ; BD3F23C0-D43E-11CF-893B-00AA00BDCE1A
  Data.l $BD3F23C0
  Data.w $D43E, $11CF
  Data.b $89, $3B, $00, $AA, $00, $BD, $CE, $1A


EndDataSection


#DOCHOSTUIDBLCLK_DEFAULT         = 0
#DOCHOSTUIFLAG_OPENNEWWIN        = $20
#DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $100  

Structure DOCHOSTUIINFO
  cbSize.l
  dwFlags.l
  dwDoubleClick.l
  *pchHostCss
  *pchHostNS
EndStructure

Structure IDocHostUIHandlerImpl
  *VTable
  RefCount.l
  External.IDispatch
EndStructure

Procedure.l IDocHostUIHandlerImpl_QueryInterface ( *that.IDocHostUIHandlerImpl, riid.i, ppObj.i )
  hresult.l = #E_NOINTERFACE
  TmpUnkown.IUnknown = *that
  If ppObj <> #Null And riid <> #Null
    PokeI(ppobj, 0)
    If CompareMemory(riid, ?IID_IUnkown, SizeOf(IID))
      PokeI(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    ElseIf CompareMemory(riid, ?IID_IDocHostUIHandler, SizeOf(IID))
      PokeI(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    EndIf 
  EndIf
  ProcedureReturn hresult
EndProcedure

Procedure.l IDocHostUIHandlerImpl_AddRef ( *that.IDocHostUIHandlerImpl )
  *that\RefCount = *that\RefCount + 1
  ProcedureReturn *that\RefCount
EndProcedure

Procedure.l IDocHostUIHandlerImpl_Release ( *that.IDocHostUIHandlerImpl )
  *that\RefCount = *that\RefCount - 1
  RefCount.l = *that\RefCount
  If RefCount = 0
    If *that\External <> #Null
      *that\External\Release()
    EndIf  
    FreeMemory(*that) 
  EndIf
  ProcedureReturn RefCount
EndProcedure

Procedure.l IDocHostUIHandlerImpl_ShowContextMenu ( *that.IDocHostUIHandlerImpl, dwID, ppt, pcmdTarget, pdispReserved )
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetHostInfo ( *that.IDocHostUIHandlerImpl, *pInfo.DOCHOSTUIINFO )
  *pInfo\cbSize        = 20
  *pInfo\dwDoubleClick = #DOCHOSTUIDBLCLK_DEFAULT
  *pInfo\dwFlags       = #DOCHOSTUIFLAG_DIV_BLOCKDEFAULT + #DOCHOSTUIFLAG_OPENNEWWIN
  *pInfo\pchHostCss    = #Null
  *pInfo\pchHostNS     = #Null
  ProcedureReturn #S_OK
EndProcedure

Procedure.l IDocHostUIHandlerImpl_ShowUI ( *that.IDocHostUIHandlerImpl, dwID, pActiveObject, pCommandTarget, pFrame, pDoc )
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_HideUI ( *that.IDocHostUIHandlerImpl )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_UpdateUI ( *that.IDocHostUIHandlerImpl )
  ProcedureReturn #S_OK
EndProcedure

Procedure.l IDocHostUIHandlerImpl_EnableModeless ( *that.IDocHostUIHandlerImpl, fEnable)
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_OnDocWindowActivate ( *that.IDocHostUIHandlerImpl, fActivate )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_OnFrameWindowActivate ( *that.IDocHostUIHandlerImpl, fActivate )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_ResizeBorder ( *that.IDocHostUIHandlerImpl, prcBorder, pUIWindow, fFrameWindow )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_TranslateAccelerator ( *that.IDocHostUIHandlerImpl, lpMsg, pguidCmdGroup, nCmdID )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetOptionKeyPath ( *that.IDocHostUIHandlerImpl, pchKey, dw )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetDropTarget ( *that.IDocHostUIHandlerImpl, pDropTarget, ppDropTarget )
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l IDocHostUIHandlerImpl_GetExternal ( *that.IDocHostUIHandlerImpl, ppDispatch.i )
  If ppDispatch <> #Null
    PokeI(ppDispatch, *that\External)
    If *that\External <> #Null
      *that\External\AddRef()
      ProcedureReturn #S_OK
    EndIf
  EndIf
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_TranslateUrl ( *that.IDocHostUIHandlerImpl, dwTranslate, pchURLIn, ppchURLOut )
  ProcedureReturn #S_FALSE
EndProcedure

Procedure.l IDocHostUIHandlerImpl_FilterDataObject ( *that.IDocHostUIHandlerImpl, pDO, ppDORet )
  ProcedureReturn #S_FALSE
EndProcedure


DataSection

IDocHostUIHandlerImplFunctionTable:
  Data.i @IDocHostUIHandlerImpl_QueryInterface()
  Data.i @IDocHostUIHandlerImpl_AddRef()
  Data.i @IDocHostUIHandlerImpl_Release()
  Data.i @IDocHostUIHandlerImpl_ShowContextMenu()
  Data.i @IDocHostUIHandlerImpl_GetHostInfo()
  Data.i @IDocHostUIHandlerImpl_ShowUI()
  Data.i @IDocHostUIHandlerImpl_HideUI()
  Data.i @IDocHostUIHandlerImpl_UpdateUI()
  Data.i @IDocHostUIHandlerImpl_EnableModeless()
  Data.i @IDocHostUIHandlerImpl_OnDocWindowActivate()
  Data.i @IDocHostUIHandlerImpl_OnFrameWindowActivate()
  Data.i @IDocHostUIHandlerImpl_ResizeBorder()
  Data.i @IDocHostUIHandlerImpl_TranslateAccelerator()
  Data.i @IDocHostUIHandlerImpl_GetOptionKeyPath()
  Data.i @IDocHostUIHandlerImpl_GetDropTarget()
  Data.i @IDocHostUIHandlerImpl_GetExternal()
  Data.i @IDocHostUIHandlerImpl_TranslateUrl()
  Data.i @IDocHostUIHandlerImpl_FilterDataObject()

EndDataSection


Procedure CreateDocHostUIHandler ( External.IDispatch )
  Protected *that.IDocHostUIHandlerImpl = AllocateMemory(SizeOf(IDocHostUIHandlerImpl))
  If #Null <> *that
    *that\VTable = ?IDocHostUIHandlerImplFunctionTable
    *that\RefCount = 1
    If External <> #Null
      External\AddRef()
    EndIf
    *that\External = External
  EndIf
  ProcedureReturn *that
EndProcedure






#DISPID_RAISEEVENT  = 100
#DISPID_UNKNOWN     = -1

Structure ExternalIDispatchImpl
  *VTable
  RefCount.l
  *CallbackFunction
EndStructure

Procedure.l ExternalIDispatchImpl_QueryInterface ( *that.ExternalIDispatchImpl, riid.i, ppObj.i)
  hresult.l = #E_NOINTERFACE
  TmpUnkown.IUnknown = *that
  If ppObj <> #Null And riid <> #Null
    PokeI(ppobj, 0)
    If CompareMemory(riid, ?IID_IUnkown, SizeOf(IID))
      PokeI(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    ElseIf CompareMemory(riid, ?IID_IDispatch, SizeOf(IID))
      PokeI(ppobj, *that)
      TmpUnkown\AddRef()
      hresult = #S_OK
    EndIf 
  EndIf
  ProcedureReturn hresult
EndProcedure

Procedure.l ExternalIDispatchImpl_AddRef ( *that.ExternalIDispatchImpl )
  *that\RefCount = *that\RefCount + 1
  ProcedureReturn *that\RefCount
EndProcedure

Procedure.l ExternalIDispatchImpl_Release ( *that.ExternalIDispatchImpl )
  *that\RefCount = *that\RefCount - 1
  RefCount.l = *that\RefCount
  If RefCount = 0
    FreeMemory(*that) 
  EndIf
  ProcedureReturn RefCount
EndProcedure

Procedure.l ExternalIDispatchImpl_GetTypeInfoCount ( *that.ExternalIDispatchImpl, *pcntInfo.INTEGER)
  *pcntInfo\i = 0
  ProcedureReturn #S_OK
EndProcedure

Procedure.l ExternalIDispatchImpl_GetTypeInfo ( *that.ExternalIDispatchImpl, itinfo, lcid, pptinfo ) 
  ProcedureReturn #E_NOTIMPL
EndProcedure

Procedure.l ExternalIDispatchImpl_GetIDsOfNames ( *that.ExternalIDispatchImpl, riid, ppNames.i, cntNames.l, lcid, rgdispid.i)
  hresult.l = #S_OK
  For Index = 0 To cntNames - 1
  	name.s = UCase(PeekS(PeekI(ppNames + (Index * SizeOf(INTEGER))), -1, #PB_Unicode))
  	
    If name = "RAISEEVENT"
      PokeI(rgdispid + (Index * SizeOf(INTEGER)), #DISPID_RAISEEVENT)
    Else
      PokeI(rgdispid + (Index * SizeOf(INTEGER)), #DISPID_UNKNOWN)
      hresult = #DISP_E_UNKNOWNNAME
    EndIf
  Next Index
  ProcedureReturn hresult
EndProcedure

Procedure.l ExternalIDispatchImpl_Invoke ( *that.ExternalIDispatchImpl, Dispid.l, riid, lcid, flags.w, *dispparams.DISPPARAMS, *result.VARIANT, *pexecpinfo, *puArgErr.Long)
  If Dispid <> #DISPID_RAISEEVENT
    ProcedureReturn #DISP_E_MEMBERNOTFOUND 
  EndIf  
  If 0 = #DISPATCH_METHOD & flags
    ProcedureReturn #DISP_E_MEMBERNOTFOUND 
  EndIf  
  If *dispparams\cNamedArgs > 0
    ProcedureReturn #DISP_E_NONAMEDARGS
  EndIf 
  If *dispparams\cArgs <> 2
    ProcedureReturn #DISP_E_BADPARAMCOUNT
  EndIf 
 
  hresult.l = #S_OK
  Dim argument.s(1)
  Define.VARIANT TmpArg
  For Index.l = 0 To 1
    VariantInit_(@TmpArg)
    If VariantChangeType_(@TmpArg, *dispparams\rgvarg + ((1 - Index) * SizeOf(VARIANT)), 0, #VT_BSTR) <> #S_OK 
      hresult = #DISP_E_TYPEMISMATCH
      Break
    EndIf
    argument(Index) = PeekS(TmpArg\bstrVal, -1, #PB_Unicode)
    VariantClear_(@TmpArg)
  Next Index
  If hresult <> #S_OK
    ProcedureReturn hresult
  EndIf
      
  If *that\CallbackFunction <> #Null
    CallFunctionFast(*that\CallbackFunction, @argument(0), @argument(1))
  EndIf
  
  If *result <> #Null
    VariantInit_(*result)
    *result\vt = #VT_EMPTY
  EndIf

  ProcedureReturn #S_OK
EndProcedure

DataSection
ExternalIDispatchImplFunctionTable:
  Data.i @ExternalIDispatchImpl_QueryInterface()
  Data.i @ExternalIDispatchImpl_AddRef()
  Data.i @ExternalIDispatchImpl_Release()
  Data.i @ExternalIDispatchImpl_GetTypeInfoCount()
  Data.i @ExternalIDispatchImpl_GetTypeInfo()
  Data.i @ExternalIDispatchImpl_GetIDsOfNames()
  Data.i @ExternalIDispatchImpl_Invoke()

EndDataSection

Procedure CreateExternalDispatch ( *CallbackFunction ) 
  Protected *that.ExternalIDispatchImpl = AllocateMemory(SizeOf(ExternalIDispatchImpl))
  If *that <> #Null
    *that\VTable = ?ExternalIDispatchImplFunctionTable
    *that\RefCount = 1
    *that\CallbackFunction = *CallbackFunction
  EndIf
  ProcedureReturn *that
EndProcedure



   

Procedure GetIWebBrowser2 ( Gadget )
  Browser.IWebBrowser2 =  GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA)
  If Browser <> #Null
    Browser\AddRef()
  EndIf
  ProcedureReturn Browser  
EndProcedure

Procedure GetIHTMLDocument2( Gadget )
  Result.IHTMLDocument2 = #Null 
  Browser.IWebBrowser2 = GetIWebBrowser2(Gadget)
  If Browser <> #Null
    If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @TmpDocument.IHTMLDocument2) = #S_OK
        Result = TmpDocument
      EndIf
      DocumentDispatch\Release()
    EndIf
    Browser\Release()  
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure SetIDocHostUIHandler ( Gadget, UIHandler.IDocHostUIHandler )
  Result.l = #False
  Document.IHTMLDocument2 = GetIHTMLDocument2(Gadget)
  If Document <> #Null 
    If Document\QueryInterface(?IID_ICustomDoc, @CustomDoc.ICustomDoc) = #S_OK
      CustomDoc\SetUIHandler(UIHandler)
      CustomDoc\Release()
      Result = #True
    EndIf
    Document\Release()
  EndIf
  ProcedureReturn Result
EndProcedure 






Procedure ScriptRaiseEventCallback ( EventType.s, EventParam.s )
  Text.s = "Type: " + Chr(34) + EventType + Chr(34) + Chr(10)
  Text = Text + "Parameter: " + Chr(34) + EventParam + Chr(34) + Chr(10) 
  MessageRequester("Javascript Call", Text, #PB_MessageRequester_Ok)
EndProcedure 



If OpenWindow(0, 0, 0, 600, 300, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  WebGadget(0, 10, 10, 580, 280, "")
  
  
  html.s = "<html><head><title></title>"
  html = html + "<script language=" + Chr(34) + "javascript" + Chr(34) + ">" 
  html = html + "function buttonclick() { external.raiseEvent(" + Chr(34) + "buttonclick" + Chr(34) 
  html = html + ", " + Chr(34) + "Button Arguments" + Chr(34) + "); }"
  html = html + "function linkclick() { external.raiseEvent(" + Chr(34) + "linkclick" + Chr(34) 
  html = html + ", " + Chr(34) + "Link Arguments" + Chr(34) + "); }"
  html = html + "</script>" 
  html = html + "<body><input id=" + Chr(34) + "Button1" + Chr(34) 
  html = html + " type=" + Chr(34) + "button" + Chr(34)
  html = html + " value=" + Chr(34) + "Click me!" + Chr(34)
  html = html + " name=" + Chr(34) + "Button1" + Chr(34)
  html = html + " onclick='buttonclick()'></p>"
  html = html + "<a href=" + Chr(34) + "javascript:linkclick()" + Chr(34) + ">Me too!</a></p>"
  html = html + "</body></html>"

  SetGadgetItemText(0, #PB_Web_HtmlCode, html)
  
  External.IDispatch  = CreateExternalDispatch(@ScriptRaiseEventCallback())
  UIHandler.IDocHostUIHandler = CreateDocHostUIHandler(External)
  SetIDocHostUIHandler(0, UIHandler)
  External\Release()
  UIHandler\Release()
  
  Repeat 
    Event = WaitWindowEvent();
    Select Event
    Case #PB_Event_CloseWindow
      Break
    EndSelect
  ForEver

   
EndIf



Re: Calling a PB procedure from JavaScript?

Posted: Tue May 01, 2018 11:36 pm
by Seymour Clufley
Justin: nice! Thanks very much.

Weavster: I agree. Having become accustomed to HTML, I now dread doing any UI work in PB. Showing a clickable list of items is so much easier in HTML than with a ListViewGadget, and looks so much better. A framework for creating HTML UIs within a PB program would be very, very useful.

Re: Calling a PB procedure from JavaScript?

Posted: Mon Jun 01, 2020 10:27 pm
by IdeasVacuum
I'm trying to use this method to "tell" my app which row of a table was clicked.
This is the error I get:
Image

.... which is related to the Script Callback perhaps? I'm sure it needs to be modified to work with the table.
Edit: The Callback does not get triggered
Line 26 is the function and char 36 is the open brace.

The HTML:

Code: Select all

<!DOCTYPE html>
<html>
<head>
         <meta charset='utf-8'> <meta name='viewport' content='width=device-width, initial-scale=1.0, user-scalable=no'>
</head>
<body>
         <style>
                   body {margin: 0px; width: 100%;}
                   body {background-color: #6C7592;}
                   table {table-layout: auto;}
                   table {font-family: Arial, Helvetica, sans-serif;}
                   table {border-collapse: collapse;}
                   table {width: 100%;}
                   table .absorbing-column {width: 100%;}
                   tr {border: 1px solid; border color: #828BA8;}
                   tr {Height: 38px;}
                   tr:hover {background-color: #456497;}
                   td {font-size: 14px;}
                   td {color: #FAFAFA;}
                   td {vertical-align: middle;}
                   td {padding: 6px;}
                   td {border: 1px solid;}
                   td {border-color: #828BA8;}
         </style>
<script language="javascript">
         function Clicked(result) {external.raiseEvent(result);}
</script>
<table>
<tr onclick="Clicked('0')"> <td style="text-align:left";>Browse</td></tr>
<tr onclick="Clicked('1')"> <td style="text-align:left";>20191218_N000042_201_10_28_11_1_5.stl</td></tr>
<tr onclick="Clicked('2')"> <td style="text-align:left";>20191218_N000042_201_10_28_11_2_5.stl</td></tr>
<tr onclick="Clicked('3')"> <td style="text-align:left";>20191218_N000042_201_10_28_11_3_5.stl</td></tr>
<tr onclick="Clicked('4')"> <td style="text-align:left";>20191218_N000042_201_10_28_11_4_5.stl</td></tr>
<tr onclick="Clicked('5')"> <td style="text-align:left";>20191218_N000042_201_10_28_11_5_5.stl</td></tr>
<tr onclick="Clicked('6')"> <td style="text-align:left";>Exit List</td></tr>
</table>
</body>
</html>
Edit: The current inline 'onclick' code works with DOM alert():

Code: Select all

<script language="javascript">
         function Clicked(result) {alert(result);}
</script>

Re: Calling a PB procedure from JavaScript?

Posted: Mon Jun 01, 2020 11:42 pm
by Kiffi

Code: Select all

function Clicked(result) {external.raiseEvent('Clicked', result);}

Re: Calling a PB procedure from JavaScript?

Posted: Mon Jun 01, 2020 11:48 pm
by IdeasVacuum
Thanks Kiffi - works perfectly.
You need a hug, an XXL coffee, 6 shots of vodka and 2 weeks of sleep :mrgreen:

Re: Calling a PB procedure from JavaScript?

Posted: Tue Jun 02, 2020 12:42 pm
by IdeasVacuum
Using HTML and Javascript has got some mileage in it. I now have a nice list of recent files within my app. Previously, I used a ListIcon which had to be oversized etc to look the part and as the mouse was dragged over the rows (only 7!) a lot of flicker. No such issue with an HTML Table, it just works.

Re: Calling a PB procedure from JavaScript?

Posted: Tue Jun 02, 2020 9:59 pm
by JHPJHP
Thank you to the original coders and those who have contributed:
- http://forums.purebasic.com/english/vie ... hp?t=16737
- viewtopic.php?f=13&t=29393
- viewtopic.php?t=37356

The process I use for learning scripts written by others is to look up every constant, structure, function, etc., until I at least have a basic understanding of how it all works.
With regards to this example, I can now appreciate the amount of research needed for a working solution.

Re: Calling a PB procedure from JavaScript?

Posted: Tue Jun 02, 2020 10:24 pm
by IdeasVacuum
...that's very similar to my approach, I layout the code to my own preferences, including variable naming etc, but I didn't understand most of the original code after that exercise. EnableExplicit helps :)

Re: Calling a PB procedure from JavaScript?

Posted: Fri Nov 17, 2023 5:26 am
by ricardo
Hi,

I tried to run this on PB 5.7x and 6.x and its does not compile, shows some error.

Does anybody has some code that can call raise events that compiles using 5.7x?

Thanks in advance

Re: Calling a PB procedure from JavaScript?

Posted: Fri Nov 17, 2023 7:49 am
by infratec
Works here with PB 6.03 x86 on Win 10.

Re: Calling a PB procedure from JavaScript?

Posted: Sat Nov 25, 2023 3:05 am
by ricardo
I alteady find how to do it.