PureDispHelper UserLib - Update with Includefile for Unicode

[ts-soft]

Small Update for Disphelper_Include:

added directives to disable some features and/or reduce exe size )

you should add the directive before you include the disphelper includefile

available directives in the moment:

Code: Select all

Define DISPHELPER_NO_FOR_EACH
Define DISPHELPER_NO_OCX_CreateGadget 

// edit:

New Update:
added support for dhExceptions and DH_EXCEPTION_CALLBACK

[ts-soft]

Small bugfix for Disphelper_Include.pb

The FOR_EACH macro fixed and example by Kiffi added!

Code: Select all

; Example by Kiffi

EnableExplicit

XIncludeFile "DispHelper_Include.pb"

Define.s XML

XML = "<addresses>"
XML + " <address>"
XML + "  <forename>Peter</forename>"
XML + "  <surname>Parker</surname>"
XML + " </address>"
XML + " <address>"
XML + "  <forename>Bruce</forename>"
XML + "  <surname>Wayne</surname>"
XML + " </address>"
XML + " <address>"
XML + "  <forename>Clark</forename>"
XML + "  <surname>Kent</surname>"
XML + " </address>"
XML + "</addresses>"

dhInitializeImp()

dhToggleExceptions(#True)

Define.l oDom
Define.l oNode

Define.l szResponse

oDom = dhCreateObject("MSXML.DOMDocument")

If oDom

 dhCallMethod(oDom, "LoadXml(%T)", @XML)

 FOR_EACH(oNode, oDom, "SelectNodes(%T)",  @"addresses/address")

   dhGetValue("%T", @szResponse, oNode, "Xml")

   If szResponse
     MessageRequester("XML", PeekS(szResponse))
     dhFreeString(szResponse) : szResponse = 0
   EndIf

 NEXT_(oNode)

 dhReleaseObject(oDom) : oDom = 0

EndIf

dhUninitialize()

[ts-soft]

Update Disphelper_Include.pb

Added WITH_ - END_WITH macros

Example:

Code: Select all

; example based on c-source "dexplore.c" in the "samples_c" folder of disphelper_081.zip

; changed to PB by ts-soft

EnableExplicit

XIncludeFile "DispHelper_Include.pb"

; Demonstrates controlling Microsoft's new help system for developers, dexplore.
; This is also known As MS Help 2 And ships With Visual Studio And the platform SDK.


; /* **************************************************************************
;  * ShowHelpTopic:
;  *   Function To show a Platform SDK help topic in dExplore(MS Help 2).
;  *
;  ============================================================================ */

Procedure ShowHelpTopic(szKeyword.s)
;   if you have another version, please change the namespace!
;   some example namespaces:
;   borland.bds3            = Borland Help
;   borland.bds4
;   MS.Dexplore             = Microsoft Dexplore Collection
;   MS.Dexplore.v80.en      = Microsoft Document Explorer Help ENU
;   MS.ENTSERV.v10.en       = Enterprise development And servers except For SQL Server And Exchange
;   MS.KB.v10.en            = Knowledge Base English
;   MS.PSDKSVR2003SP1.1033  = Platform SDK Collection For Windows Server 2003 SP1
;   MS.MSDNQTR.v80.en       = MSDN Library For Visual Studio 2005
;   MS.NETDEV.v10.en        = .NET Development content, ADO.NET, ASP.NET, .NET Fwrk, And MapPoint
;   MS.NETDEVFX.v20.en      = Net Development Framework 2.0
;   MS.SQL.v2005.en         = SDK documentation For SQL Server 2005
;   MS.VisualStudio.v80.en  = Visual Studio 2005
;   MS.WIN32COM.v10.en      = Win32- und COM-Entwicklung

  Protected Namespace.s = "ms-help://MS.PSDKSVR2003SP1.1033"
  
  Protected dExplore.l = dhCreateObject("DExplore.AppObj")
  Protected helpHost.l
  
  If dExplore <> 0
    WITH_(helpHost, dExplore, ".Help")
      dhCallMethod(helpHost, ".SetCollection(%T,%T)", @Namespace, @"Platform SDK")
      dhCallMethod(helpHost, ".SyncIndex(%T,%d)", @szKeyword, 1)
      dhCallMethod(helpHost, ".DisplayTopicFromKeyword(%T)", @szKeyword)
    END_WITH(helpHost)
  EndIf
  ; dexplore 'may' exit when we release the object so we wait
  MessageRequester("dExplore", "Press Ok to close")
  If dExplore <> 0 : dhReleaseObject(dExplore) : EndIf
EndProcedure

dhInitializeImp()
dhToggleExceptions(#True)

ShowHelpTopic("RegCreateKeyEx")

dhUninitialize()
End

[ts-soft]

Big Update to Version 1.3

The userlib is no more supported, only the Disphelper_Include File

Changed the c-source for more compatible with PureBasic.
libgcc.lib removed, new version of disphelper.lib is compiled with PellesC
(SourcePackage included)

New Identifier added (thanks to mk-soft)
Float, Double, Word, Long ... full supported! (please read the PDF-Docu.)

New Varianthelper with support of Variant-Arrays!
PureBasic specific documentation in pdf-format added

Many Bugs fixed

greetings
Thomas

[mk-soft]

Example with Excel for new version

Code: Select all

; example by Kiffi
; enhanced by mk-soft

EnableExplicit

Define DISPHELPER_NO_FOR_EACH
Define DISPHELPER_NO_OCX_CreateGadget

XIncludeFile "DispHelper_Include.pb"
XIncludeFile "VariantHelper_Include.pb"

Define.l ExcelApp, Workbook

dhInitializeImp()
dhToggleExceptions(#True)

ExcelApp = dhCreateObject("Excel.Application")

Define.variant result
Define.d value1, value2, value3, date, retval
Define.w short_value

value1 = 100.5
value2 = 10.1
value3 = 99.9
date = T_DATE(Date())
short_value = 32767

If ExcelApp
 
  dhPutValue(ExcelApp, ".Visible = %b", #True)
 
  dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Add")
 
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 1, @"Feel")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 2, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 3, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 1, 4, @"Power")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 2, 1, @"Value1")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 3, 1, @"Value2")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 4, 1, @"Value3")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 5, 1, @"Now")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %T", 6, 1, @"Short")
  
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %e", 2, 2, @value1)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %e", 3, 2, @value2)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %e", 4, 2, @value3)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %D", 5, 2, @date)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %i", 6, 2, short_value)

  dhGetValue("%e", @retval, ExcelApp, "Cells(%d, %d).Value", 4, 2)
  dhGetValue("%v", @result, ExcelApp, "Cells(%d, %d).Value", 5, 2)
  
  MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(4,2) (Value 3): " + StrD(retval))
  MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(5,2) (Date): " + VT_STR(result))
  
  MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Excel")
  
  dhCallMethod(ExcelApp, ".Quit")
  
  dhReleaseObject(Workbook) : Workbook = 0
  dhReleaseObject(ExcelApp) : ExcelApp = 0
  
Else
 
  MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
  
EndIf

dhUninitialize()

GT

[byo]

ts-soft:

Can the OCX_CreateGadget() return a handle if a new window is created? The Report Generator example, everytime the procedure is called a new window with the report is opened. It creates no new process? How can I 'see' this window in the WinAPI so I can maximize it, modify its titlebar, etc.

I tried FindWindow_() but I had no success with it.

I couldn't find any mention of the procedure in the help file so maybe I missing something.

Keep up the brilliant work, btw.

[KIKI]

Here is the code which works with OpenOffice.org and allow to use com object with document
Thanks to mk-soft for the solution and modifying certain PB program

Code: Select all

EnableExplicit
Define.l  oSM, oDesk, oDoc
 ;'Les objets de base pour travailler avec OOo
Declare MakePropertyValue(cName.s, uValue.b) 
Declare MakePropertyValue1(cName.s, uValue.s)
Declare.s ConvertToUrl(strFile.s) 

XIncludeFile "DispHelper_Include.pb"
XIncludeFile "VariantHelper_Include.pb" 
Define.safearray *openpar 
Define.variant openarray 
*openpar = saCreateSafeArray(#VT_DISPATCH, 0, 3) 
SA_DISPATCH(*openpar, 0) = MakePropertyValue("ReadOnly", #True) 
SA_DISPATCH(*openpar, 1) = MakePropertyValue1("Password", "secret") 
SA_DISPATCH(*openpar, 2) = MakePropertyValue("Hidden", #False) 
V_ARRAY_DISP(openarray) = *openpar 
dhInitializeImp()
dhToggleExceptions(#True) 
    ;'Instancie OOo : ces deux lignes sont obligatoires avec VB dans tout code !
oSM = dhCreateObject("com.sun.star.ServiceManager")
dhGetValue("%o",@oDesk,oSM, ".createInstance(%T)", @"com.sun.star.frame.Desktop")
dhGetValue("%o",@oDoc, oDesk,".loadComponentFromURL(%T,%T,%d,%v",@"private:factory/swriter", @"_blank",0, openarray)

dhUninitialize()
End    


Procedure MakePropertyValue(cName.s, uValue.b) 
  Define  oStruct.l
  Define oServiceManager.l = dhCreateObject("com.sun.star.ServiceManager")
dhGetValue("%o", @oStruct, oServiceManager, ".Bridge_GetStruct(%T)", @"com.sun.star.beans.PropertyValue")
 dhPutValue(oStruct, ".Name=%T", @cName)
 dhPutValue(oStruct, ".Value=%b", @uValue)
ProcedureReturn oStruct
EndProcedure 


Procedure MakePropertyValue1(cName.s, uValue.s) 
 Define oServiceManager.l
 Define ostruct
  oServiceManager = dhCreateObject("com.sun.star.ServiceManager")
dhGetValue("%o", @oStruct, oServiceManager, ".Bridge_GetStruct(%T)", @"com.sun.star.beans.PropertyValue")
 dhPutValue(oStruct, ".Name=%T", @cName)
  dhPutValue(oStruct, ".Value=%T", @uValue)
  ProcedureReturn oStruct
EndProcedure 

Procedure.s ConvertToUrl(strFile.s) 
    strFile = ReplaceString(strFile, "\", "/")
    strFile = ReplaceString(strFile, ":", "|")
    strFile= ReplaceString(strFile, " ", "%20")
    strFile = "file:///" + strfile
    ProcedureReturn strFile
EndProcedure

[mk-soft]

Hi,

For kiki sample use a new VariantHelper_Include.pb

Download http://home.arcor.de/m_kastner/MyCodes/ ... Include.pb

New Version by ts-soft in next time

GT

[ts-soft]

New Varianthelper added, thx Michael

ts-soft:

Can the OCX_CreateGadget() return a handle if a new window is created? The Report Generator example, everytime the procedure is called a new window with the report is opened. It creates no new process? How can I 'see' this window in the WinAPI so I can maximize it, modify its titlebar, etc.

I tried FindWindow_() but I had no success with it.

I couldn't find any mention of the procedure in the help file so maybe I missing something.

Keep up the brilliant work, btw.

OCX_CreateGadget creates a normal ContainerGadget, so use

Code: Select all

OCX_CreateGadget(#GADGET, 0,0,0,0,"blub.blub")
Debug GadgetID(#GADGET)

but the reportgenerator isn't a visible control. The have no properties to
resize and so on.

[byo]

but the reportgenerator isn't a visible control. The have no properties to resize and so on.

I see. Thanks anyway. It's better then to not use it. Of course, Report Generator is freeware and it fits to some purpose but it doesn't have many options so I'll have to find another one.

[ts-soft]

but the reportgenerator isn't a visible control. The have no properties to resize and so on.

I see. Thanks anyway. It's better then to not use it. Of course, Report Generator is freeware and it fits to some purpose but it doesn't have many options so I'll have to find another one.

Please tell me, if you found a better solution

The reportgenerator isn't useful for me

[KIKI]

here is the equivalent in Open office fromexample_excel.pb

Take care because the program was written on a french computer so the name of the first sheets in the workbook is "Feuille1" and on other foreigner language "Feuil1" and that's generate a crash so in this case modify the following instruction

dhGetValue("%o",@mafeuille, odoc ,".Sheets.getByName(%T)",@"Feuille1")

by

dhGetValue("%o",@mafeuille, odoc ,".Sheets.getByName(%T)",@"Feuil1")

Code: Select all

EnableExplicit
Define.l  oSM, oDesk, oDoc,mafeuille,lesfeuille,mycell
 ;'Les objets de base pour travailler avec OOo
Declare MakePropertyValue(cName.s, uValue.b) 
Declare MakePropertyValue1(cName.s, uValue.s)
Declare.s ConvertToUrl(strFile.s) 

XIncludeFile "DispHelper_Include.pb"
XIncludeFile "VariantHelper_Include.pb" 
Define.safearray *openpar 
Define.variant openarray 
*openpar = saCreateSafeArray(#VT_DISPATCH, 0, 3) 
SA_DISPATCH(*openpar, 0) = MakePropertyValue("ReadOnly", #True) 
SA_DISPATCH(*openpar, 1) = MakePropertyValue1("Password", "secret
SA_DISPATCH(*openpar, 2) = MakePropertyValue("Hidden", #False) 
V_ARRAY_DISP(openarray) = *openpar 
dhInitializeImp()
dhToggleExceptions(#True) 

Define.variant wert1, wert2, wert3, result, text

V_DOUBLE(wert1) = 3.33333333333333
V_DOUBLE(wert2) = 4.44444444444444
V_DOUBLE(wert3) = 5.55555555555555
V_STR(text) = T_BSTR("Hallo Welt")

    ;'Instancie OOo : ces deux lignes sont obligatoires avec VB dans tout code !
oSM = dhCreateObject("com.sun.star.ServiceManager")
dhGetValue("%o",@oDesk,oSM, ".createInstance(%T)", @"com.sun.star.frame.Desktop")
dhGetValue("%o",@oDoc, oDesk,".loadComponentFromURL(%T,%T,%d,%v)",@"private:factory/scalc", @"_blank",0, openarray)
dhGetValue("%o",@mafeuille, odoc ,".Sheets.getByName(%T)",@"Feuille1")
dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"A1")
 dhPutValue(Mycell, ".String = %T", @"Feel")
 dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"B1")
 dhPutValue(Mycell, ".String = %T", @"the")
 dhGetValue("%o", @mycell, mafeuille,".getCellRangeByName(%T", @"C1")
 dhPutValue(Mycell, ".String = %T", @"pure")
 dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"D1")
  dhPutValue(Mycell, ".String = %T", @"Power")
  dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"A2")
 dhPutValue(Mycell, ".String = %T", @"The")
 dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"A3")
 dhPutValue(Mycell, ".String = %T", @"Pure")
 dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"A4")
 dhPutValue(Mycell, ".String = %T", @"Power")
  dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"B2")
  dhPutValue(Mycell, ".value = %v", wert1)
   dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"B3")
  dhPutValue(Mycell, ".value = %v", wert2)
     dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"B4")
  dhPutValue(Mycell, ".value = %v", wert3)
       dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"C2")
  dhPutValue(Mycell, ".String = %v", text)
  
   dhGetValue("%o", @mycell, mafeuille, ".getCellRangeByName(%T", @"B2")
   dhGetValue("%v", @result, Mycell, ".Value")
    MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(2,2): " + VT_STR(result))
MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Open Office")
 
dhCallMethod(odoc,".close(%b)",#True)
dhUninitialize()
End    


Procedure MakePropertyValue(cName.s, uValue.b) 
  Define  oStruct.l
  Define oServiceManager.l = dhCreateObject("com.sun.star.ServiceManager")
dhGetValue("%o", @oStruct, oServiceManager, ".Bridge_GetStruct(%T)", @"com.sun.star.beans.PropertyValue")
 dhPutValue(oStruct, ".Name=%T", @cName)
 dhPutValue(oStruct, ".Value=%b", @uValue)
ProcedureReturn oStruct
EndProcedure 


Procedure MakePropertyValue1(cName.s, uValue.s) 
 Define oServiceManager.l
 Define ostruct
  oServiceManager = dhCreateObject("com.sun.star.ServiceManager")
dhGetValue("%o", @oStruct, oServiceManager, ".Bridge_GetStruct(%T)", @"com.sun.star.beans.PropertyValue")
 dhPutValue(oStruct, ".Name=%T", @cName)
  dhPutValue(oStruct, ".Value=%T", @uValue)
  ProcedureReturn oStruct
EndProcedure 

Procedure.s ConvertToUrl(strFile.s) 
    strFile = ReplaceString(strFile, "\", "/")
    strFile = ReplaceString(strFile, ":", "|")
    strFile= ReplaceString(strFile, " ", "%20")
    strFile = "file:///" + strfile
    ProcedureReturn strFile
EndProcedure

[ts-soft]

@KIKI
Nice example, but in openoffice 2.2, doen't work. Only errors

[akj]

I know this should be easy, but I am struggling. How should this Excel COM code be converted into PureBasic?

Code: Select all

Workbooks.Open Filename:= "MySpreadsheet.xls"
Sheets("Sheet1").Select

Also, despite searching the internet, I cannot find details of the Excel Object Model with it's methods and properties. Where can it be found?

[srod]

Also, despite searching the internet, I cannot find details of the Excel Object Model with it's methods and properties. Where can it be found?

Open up Excel, press ALT/f11 to bring up the VBA window and then bring up the object browser etc. Or use f1 help.

Of course, this requires that you have a copy of Excel on your machine!