Author Topic: Script BASIC - VB6 OCX Forms  (Read 2985 times)

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #15 on: August 30, 2018, 10:37:31 PM »
I was able to get my OLD (On Line Dictionary) OCX to do the following.

  • Compile
  • Register
  • Create instance
  • Show the On Line Dictionary form
  • Process a Fetch button callback to Script BASIC - (passing no arguments with no return value to VB)
  • Process an About button callback to Script BASIC - (passing 3 arguments and returning a string back to VB)


      

Code: Script BASIC
  1. IMPORT COM.sbi
  2. IMPORT DYC.sbi
  3.  
  4. FUNCTION Fetch_Clicked
  5.   DYC::dyc("ms,i,USER32.DLL,MessageBox,PZZL",0,"Fetch Clicked" & CHR(0),"On Line Dictionary",0)
  6.   Fetch_Clicked = TRUE
  7. END FUNCTION
  8.  
  9. FUNCTION About_Clicked(arg0,arg1,arg2)
  10.   DYC::dyc("ms,i,USER32.DLL,MessageBox,PZZL",0,"About Clicked\nAbout Me: " & arg0 & "\n" & _
  11.                                                 arg1 & " " & arg2 & CHR(0), _
  12.                                                 "On Line Dictionary",0)
  13.   About_Clicked = "Return from About click"
  14. END FUNCTION
  15.  
  16.  
  17. obj = COM::CREATE(:SET, "OLD.OLDict")
  18. oCollection = COM::CBN(obj, "CallBackHandlers", :GET)
  19. COM::CBN oCollection, "Add", :CALL, ADDRESS(Fetch_Clicked()), "win.btnFetch_Click"
  20. COM::CBN oCollection, "Add", :CALL, ADDRESS(About_Clicked()), "win.btnAbout_Click"
  21. COM::CBN obj, "ShowOLD"
  22. COM::RELEASE obj
  23.  

OLD.cls
Code: Visual Basic
  1. Public CallBackHandlers As New Collection
  2.  
  3. Public Function ShowOLD() As Long
  4.     ShowOLD = win.ShowMain(Me)
  5. End Function
  6.  

Main.frm (win)
Code: Visual Basic
  1. Private Declare Function ext_SBCallBack Lib "COM.dll" Alias "SBCallBack" (ByVal EntryPoint As Long, ByVal arg As Long) As Long
  2. Private Declare Function ext_SBCallBackEx Lib "COM.dll" Alias "SBCallBackEx" (ByVal EntryPoint As Long, ByRef v As Variant) As Variant
  3.  
  4. Private m_owner As OLDict
  5.  
  6. Function ShowMain(owner As OLDict) As Long
  7.     On Error Resume Next
  8.     Set m_owner = owner
  9.     Me.Show 1
  10.     Set m_owner = Nothing
  11.     ShowMain = 0
  12.     Unload Me
  13. End Function
  14.  
  15. Private Function TriggerCallBack(nodeID As Long, argValue As Long)
  16.     TriggerCallBack = ext_SBCallBack(nodeID, argValue)
  17. End Function
  18. Private Function TriggerCallBackEx(nodeID As Long, v() As Variant)
  19.     TriggerCallBackEx = ext_SBCallBackEx(nodeID, v)
  20. End Function
  21.  
  22. Private Sub btnFetch_Click()
  23.     Dim nodeID As Long
  24.     Dim arg As Long
  25.     Dim rtnVal As Long
  26.    
  27.     nodeID = m_owner.CallBackHandlers("win.btnFetch_Click")
  28.     arg = False
  29.     rtnVal = TriggerCallBack(nodeID, arg)
  30. End Sub
  31.  
  32. Private Sub btnAbout_Click()
  33.     Dim nodeID As Long
  34.     Dim args(3)
  35.     Dim rtnVal As String
  36.    
  37.     nodeID = m_owner.CallBackHandlers("win.btnAbout_Click")
  38.     Set args(0) = Me
  39.     args(1) = 99
  40.     args(2) = "Bottles of beer."
  41.     rtnVal = TriggerCallBackEx(nodeID, args)
  42.     MsgBox rtnVal, vbExclamation
  43. End Sub
  44.  
« Last Edit: September 02, 2018, 12:07:55 AM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #16 on: September 01, 2018, 11:37:30 PM »
I just wanted to mention I couln't be happier how well this is working even if no one else cares.

I see this saving me a tons of time building modern GUI applications that are easy to create and support.

Lets hope MS keeps COM/OLE automation around for awhile.




Offline AlyssonR

  • Advocate
  • Posts: 125
Re: Script BASIC - VB6 OCX Forms
« Reply #17 on: September 02, 2018, 01:24:24 AM »
I can't see COM/OLE disappearing in the near future - it is too deeply embedded into the current generation of applications.

Mind you, even if it does get cut, I'm sure the Open Source community (fingers crossed here) will end up producing a COM/OLE to whatever's new bridge (driver).

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #18 on: September 02, 2018, 10:03:00 AM »
If Microsoft wants to keep the developers they have, taking things away isn't the way to do it.
« Last Edit: September 02, 2018, 10:19:46 AM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #19 on: September 02, 2018, 03:16:50 PM »
I had forgotten about the MsgBox function in the NT extension module. Much easier to use than the DYC FFI call to the Windows MessageBox API function.

NT MsgBox Documentation

Code: Script BASIC
  1. IMPORT COM.sbi
  2. IMPORT NT.sbi
  3.  
  4. FUNCTION Fetch_Clicked
  5.   NT::MsgBox "Fetch Clicked", "On Line Dictionary", "OK","Info", 1
  6.   Fetch_Clicked = TRUE
  7. END FUNCTION
  8.  
  9. FUNCTION About_Clicked(arg0,arg1,arg2)
  10.   NT::MsgBox "About Clicked\nAbout Me: " & arg0 & "\n" & _
  11.               arg1 & " " & arg2, "On Line Dictionary", "OK","Info", 1
  12.   About_Clicked = "Return from About click"
  13. END FUNCTION
  14.  
  15.  
  16. obj = COM::CREATE(:SET, "OLD.OLDict")
  17. oCollection = COM::CBN(obj, "CallBackHandlers", :GET)
  18. COM::CBN oCollection, "Add", :CALL, ADDRESS(Fetch_Clicked()), "win.btnFetch_Click"
  19. COM::CBN oCollection, "Add", :CALL, ADDRESS(About_Clicked()), "win.btnAbout_Click"
  20. COM::CBN obj, "ShowOLD"
  21. COM::RELEASE obj
  22.  

     
« Last Edit: September 02, 2018, 03:19:44 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #20 on: September 02, 2018, 06:01:31 PM »
For those wondering if this runs on the current version of Windows 10.




      




Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #21 on: September 02, 2018, 10:24:33 PM »
The author of the VBCCR (Common Controls Replacement) OCX also wrote a MSFlexGrid Replacement OCX. It supports Unicode among other enhancements.


Offline AlyssonR

  • Advocate
  • Posts: 125
Re: Script BASIC - VB6 OCX Forms
« Reply #22 on: September 03, 2018, 10:31:28 AM »
░░░░░░░░░░░░▄▄░░░░░░░░░
░░░░░░░░░░░█░░█░░░░░░░░
░░░░░░░░░░░█░░█░░░░░░░░
░░░░░░░░░░█░░░█░░░░░░░░
░░░░░░░░░█░░░░█░░░░░░░░
███████▄▄█░░░░░██████▄░░
▓▓▓▓▓▓█░░░░░░░░░░░░░░█░
▓▓▓▓▓▓█░░░░░░░░░░░░░░█░
▓▓▓▓▓▓█░░░░░░░░░░░░░░█░
▓▓▓▓▓▓█░░░░░░░░░░░░░░█░
▓▓▓▓▓▓█░░░░░░░░░░░░░░█░
▓▓▓▓▓▓█████░░░░░░░░░█░░
██████▀░░░░▀▀██████▀░░░░

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #23 on: September 04, 2018, 11:56:28 PM »
Here is the VB6 OCX version of the On Line Dictionary example. Compare it to the IUP version in post #12 of this thread.



Code: Script BASIC
  1. IMPORT COM.sbi
  2. IMPORT NT.sbi
  3.  
  4. servers[0]="dict.org"
  5. servers[1]="dict1.us.dict.org"
  6. servers[2]="all.dict.org"
  7.  
  8. FUNCTION btnFetch_Clicked
  9.   LOCAL dat, total, count
  10.   ON ERROR GOTO G_NetError
  11.   server_selection = COM::CBN(obj, "CurrentServer")
  12.   OPEN server_selection & ":2628" FOR SOCKET AS #1
  13.   PRINT#1,"SHOW DB\n"
  14.   LINE INPUT#1, dat
  15.   LINE INPUT#1, dat
  16.   count = 0
  17.   WHILE LEFT(dat, 1) <> "."
  18.     LINE INPUT#1, dat
  19.     IF LEFT(dat, 1) <> "." THEN total[count] = TRIM(dat)
  20.     count+=1
  21.   WEND
  22.   PRINT#1,"QUIT\n"
  23.   CLOSE(#1)
  24.   FOR cnt = 0 TO count - 2
  25.     COM::CBN obj, "AddDictionaries", :CALL, total[cnt]
  26.   NEXT
  27.   COM::CBN obj, "DefaultDictionary"
  28.   btnFetch_Clicked = TRUE
  29.   EXIT FUNCTION
  30.  
  31.   G_NetError:
  32.   NT::MsgBox "Server " & server_selection & " not available. (" & ERROR & ")", "OLD Error", "OK","Info", 1
  33. END FUNCTION
  34.  
  35. FUNCTION btnSearch_clicked
  36.   LOCAL dict, dat, total, info
  37.   ON ERROR GOTO L_NetError
  38.   whichDictionary = COM::CBN(obj, "CurrentDictionary")
  39.   searchword = COM::CBN(obj, "SearchWord", :GET)
  40.   dict = LEFT(whichDictionary, INSTR(whichDictionary, " "))
  41.   OPEN COM::CBN(obj, "CurrentServer") & ":2628" FOR SOCKET AS 1
  42.   IF COM::CBN(obj, "AllDict", :GET) THEN
  43.     PRINT#1,"DEFINE * " & searchword & "\n"
  44.   ELSE
  45.     PRINT#1,"DEFINE " & dict & " " & searchword & "\n"
  46.   END IF
  47.   REPEAT
  48.     LINE INPUT#1, dat
  49.     IF LEFT(dat, 3) = "151" THEN
  50.       total$ &= "------------------------------\r\n"
  51.       total$ &= RIGHT(dat, LEN(dat) - LEN(searchword) - LEN(dict))
  52.       total$ &= "------------------------------\r\n"
  53.       REPEAT
  54.         LINE INPUT#1, info
  55.         info = REPLACE(info, CHR(34), CHR(92) & CHR(34))
  56.         IF LEFT(info, 1) <> "." THEN total &= TRIM(info) & "\r\n"
  57.       UNTIL LEFT(info, 1) = "."
  58.       total &= "\r\n"
  59.     END IF
  60.   UNTIL LEFT(dat, 3) = "250" OR VAL(LEFT(dat, 3)) > 499
  61.   PRINT#1,"QUIT\n"
  62.   CLOSE(#1)
  63.   IF LEFT(dat, 3) = "552" THEN
  64.     total = "No match found."
  65.   ELSE IF LEFT(dat, 3) = "501" THEN
  66.     total = "Select a dictionary first!"
  67.   ELSE IF LEFT(dat, 3) = "550" THEN
  68.     total = "Invalid database!"
  69.   END IF
  70.   COM::CBN(obj, "SetTranslation", :CALL, total)
  71.   btnSearch_Clicked = TRUE
  72. EXIT FUNCTION
  73.  
  74. L_NetError:
  75.   dat[0] = "Could not lookup word! (" & ERROR & ")"
  76.   COM::CBN(obj, "SetTranslation", :CALL, dat)
  77. END FUNCTION
  78.  
  79. ' MAIN
  80.  
  81. obj = COM::CREATE(:SET, "OLD.OLDict")
  82. oCollection = COM::CBN(obj, "CallBackHandlers", :GET)
  83. COM::CBN oCollection, "Add", :CALL, ADDRESS(btnFetch_Clicked()), "win.btnFetch_Click"
  84. COM::CBN oCollection, "Add", :CALL, ADDRESS(btnSearch_Clicked()), "win.btnSearch_Click"
  85. FOR idx = 0 TO UBOUND(servers)
  86.   COM::CBN obj, "AddServer", :CALL, servers[idx]
  87. NEXT  
  88. COM::CBN obj, "DefaultServer"
  89. COM::CBN obj, "ShowOLD"
  90. COM::RELEASE obj
  91.  

FORM
Code: Visual Basic
  1. Private Declare Function ext_SBCallBack Lib "COM.dll" Alias "SBCallBack" (ByVal EntryPoint As Long, ByVal arg As Long) As Long
  2. Private Declare Function ext_SBCallBackEx Lib "COM.dll" Alias "SBCallBackEx" (ByVal EntryPoint As Long, ByRef v As Variant) As Variant
  3.  
  4. Private m_owner As OLDict
  5. Private Type ControlPositionType
  6.     Left As Single
  7.     Top As Single
  8.     Width As Single
  9.     Height As Single
  10.     FontSize As Single
  11. End Type
  12.  
  13. Private m_ControlPositions() As ControlPositionType
  14. Private m_FormWid As Single
  15. Private m_FormHgt As Single
  16.  
  17.  
  18. Function ShowMain(owner As OLDict) As Long
  19.     On Error Resume Next
  20.     Set m_owner = owner
  21.     Me.Show 1
  22.     Set m_owner = Nothing
  23.     ShowMain = 0
  24.     Unload Me
  25. End Function
  26.  
  27. Private Function TriggerCallBack(nodeID As Long, argValue As Long) As Long
  28.     TriggerCallBack = ext_SBCallBack(nodeID, argValue)
  29. End Function
  30.  
  31. Private Function TriggerCallBackEx(nodeID As Long, v() As Variant)
  32.     TriggerCallBackEx = ext_SBCallBackEx(nodeID, v)
  33. End Function
  34.  
  35. Public Sub btnClear_Click()
  36.     win.serverList.Clear
  37.     win.dictTB.Text = ""
  38.     win.entry.Text = ""
  39.     win.btnFetch.SetFocus
  40.     End Sub
  41.  
  42. Private Sub btnExit_Click()
  43.     Set m_owner = Nothing
  44.     btnExit = 0
  45.     Unload Me
  46. End Sub
  47.  
  48. Private Sub btnFetch_Click()
  49.     Dim nodeID As Long
  50.     Dim arg As Long
  51.     Dim rtnVal As Long
  52.    
  53.     win.serverList.Clear
  54.     nodeID = m_owner.CallBackHandlers("win.btnFetch_Click")
  55.     arg = False
  56.     rtnVal = TriggerCallBack(nodeID, arg)
  57. End Sub
  58.  
  59. Private Sub btnSearch_Click()
  60.     Dim nodeID As Long
  61.     Dim arg As Long
  62.     Dim rtnVal As Long
  63.    
  64.     nodeID = m_owner.CallBackHandlers("win.btnSearch_Click")
  65.     arg = False
  66.     rtnVal = TriggerCallBack(nodeID, arg)
  67. End Sub
  68.  
  69. Private Sub btnAbout_Click()
  70.     MsgBox "Script BASIC VB6" & vbCrLf & "On Line Dictionary", vbInformation, "About"
  71. End Sub
  72.  
  73.  
  74. ' Save the form's and controls' dimensions.
  75. Private Sub SaveSizes()
  76. Dim i As Integer
  77. Dim ctl As Control
  78.  
  79.     ' Save the controls' positions and sizes.
  80.    ReDim m_ControlPositions(1 To Controls.Count)
  81.     i = 1
  82.     For Each ctl In Controls
  83.         With m_ControlPositions(i)
  84.             If TypeOf ctl Is Line Then
  85.                 .Left = ctl.X1
  86.                 .Top = ctl.Y1
  87.                 .Width = ctl.X2 - ctl.X1
  88.                 .Height = ctl.Y2 - ctl.Y1
  89.             Else
  90.                 .Left = ctl.Left
  91.                 .Top = ctl.Top
  92.                 .Width = ctl.Width
  93.                 .Height = ctl.Height
  94.                 On Error Resume Next
  95.                 .FontSize = ctl.Font.Size
  96.                 On Error GoTo 0
  97.             End If
  98.         End With
  99.         i = i + 1
  100.     Next ctl
  101.  
  102.     ' Save the form's size.
  103.    m_FormWid = ScaleWidth
  104.     m_FormHgt = ScaleHeight
  105. End Sub
  106.  
  107. Private Sub Form_Load()
  108.     SaveSizes
  109. End Sub
  110.  
  111. Private Sub Form_Resize()
  112.     ResizeControls
  113. End Sub
  114.  
  115. ' Arrange the controls for the new size.
  116. Private Sub ResizeControls()
  117. Dim i As Integer
  118. Dim ctl As Control
  119. Dim x_scale As Single
  120. Dim y_scale As Single
  121.  
  122.     ' Don't bother if we are minimized.
  123.    If WindowState = vbMinimized Then Exit Sub
  124.  
  125.     ' Get the form's current scale factors.
  126.    x_scale = ScaleWidth / m_FormWid
  127.     y_scale = ScaleHeight / m_FormHgt
  128.  
  129.     ' Position the controls.
  130.    i = 1
  131.     For Each ctl In Controls
  132.         With m_ControlPositions(i)
  133.             If TypeOf ctl Is Line Then
  134.                 ctl.X1 = x_scale * .Left
  135.                 ctl.Y1 = y_scale * .Top
  136.                 ctl.X2 = ctl.X1 + x_scale * .Width
  137.                 ctl.Y2 = ctl.Y1 + y_scale * .Height
  138.             Else
  139.                 ctl.Left = x_scale * .Left
  140.                 ctl.Top = y_scale * .Top
  141.                 ctl.Width = x_scale * .Width
  142.                 If Not (TypeOf ctl Is ComboBox) Then
  143.                     ' Cannot change height of ComboBoxes.
  144.                    ctl.Height = y_scale * .Height
  145.                 End If
  146.                 On Error Resume Next
  147.                 ctl.Font.Size = y_scale * .FontSize
  148.                 On Error GoTo 0
  149.             End If
  150.         End With
  151.         i = i + 1
  152.     Next ctl
  153. End Sub
  154.  

CLASS
Code: Visual Basic
  1. Public CallBackHandlers As New Collection
  2.  
  3. Public Function ShowOLD() As Long
  4.     ShowOLD = win.ShowMain(Me)
  5. End Function
  6.  
  7. Public Sub AddServer(server_url As String)
  8.     win.serverCombo.AddItem server_url
  9. End Sub
  10.  
  11. Public Sub DefaultServer()
  12.     win.serverCombo.ListIndex = 0
  13. End Sub
  14.  
  15. Public Function CurrentServer() As String
  16.     CurrentServer = win.serverCombo.List(win.serverCombo.ListIndex)
  17. End Function
  18.  
  19. Public Sub AddDictionaries(dictionary As String)
  20.     win.serverList.AddItem dictionary
  21. End Sub
  22.  
  23. Public Function CurrentDictionary() As String
  24.     CurrentDictionary = win.serverList.List(win.serverList.ListIndex)
  25. End Function
  26.  
  27. Public Sub DefaultDictionary()
  28.     win.serverList.ListIndex = 0
  29. End Sub
  30.  
  31. Public Sub SetTranslation(translation_text As String)
  32.     win.dictTB.Text = translation_text
  33. End Sub
  34.  
  35. Public Property Get SearchWord() As String
  36.     win.dictTB.SetFocus
  37.     SearchWord = win.entry.Text
  38. End Property
  39.  
  40. Public Property Get AllDict() As Long
  41.     AllDict = win.chkAll.Value
  42. End Property
  43.  




« Last Edit: September 07, 2018, 11:01:55 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #24 on: September 05, 2018, 11:19:02 PM »
I've changed the GetALL and GetEntry methods to AllDict and SearchWord properties. The Script BASIC and VB CLASS code in the previous post has been updated with the GET property changes.

Here is how the Script BASIC COM interface browser sees the OCX DLL.


« Last Edit: September 07, 2018, 08:10:14 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #25 on: September 07, 2018, 10:58:58 PM »
I've added resize ability to to On Line Dictionary form. The routines are simple to use and also handles resizing the fonts.  Code updated in post #23.

« Last Edit: September 07, 2018, 11:02:47 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #26 on: September 08, 2018, 08:05:42 AM »
At this point, the VB6 based On Line Dictionary is functionally equivalent to the IUP version shown earlier in this thread. Other than not being cross platform, I like the VB6 direction more.

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #27 on: September 08, 2018, 07:28:05 PM »
I have provided my proof of concept of using an OCX control to provide an intelligent GUI as a COM object.

I would be interested in how others feel about the concept and would you use it?

Offline AlyssonR

  • Advocate
  • Posts: 125
Re: Script BASIC - VB6 OCX Forms
« Reply #28 on: September 10, 2018, 01:37:26 AM »
Once I am back into development, I'll certainly take a long, hard look.

It is certainly an area that interests me to no end.

Offline John

  • Forum Support / SB Dev
  • Posts: 2191
    • ScriptBasic Open Source Project
Re: Script BASIC - VB6 OCX Forms
« Reply #29 on: September 10, 2018, 08:30:26 AM »
+1

Any others?

I'm trying to get Charles Pegge (Oxygen Basic author) to create a similar CallByName interface as what we have working with Script BASIC. It would be great to have a BASIC compiler support OCX forms (created with VB Classic or VB.NET) as well as having an interpretive solution.

I never did get a response to what BASIC languages support COM/OLE automation.  :(

« Last Edit: September 10, 2018, 09:42:06 PM by John »