Results 1 to 27 of 27

Thread: [VB6] VBTixyLand Control

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,092

    [VB6] VBTixyLand Control

    https://github.com/wqweto/VBTixyLand

    This is a remake of https://tixy.land/



    This is using IActiveScript without typelib to host the expressions evaluator in Chakra JS engine.

    I plan on using smaller 8x8 ones as progress indicators, changing shape on each operation as a bit of entertainment (or inspiration) for the mostly bored end-users of our products.

    Enjoy!
    </wqw>
    p.s. Note that JScript does not implement exponentiation operator so you have to use Math.pow (or pow only) instead.

  2. #2
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    This technology is so great. Let's applaud.

  3. #3
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    https://github.com/wqweto/VBTixyLand...TixyScript.bas

    Private Function IActiveScriptSite_GetItemInfo(This A

    Private Function IActiveScriptSite_OnStateChange
    I also see dozens of sentences that implement all the interfaces as if they were reference replacements. These are all private functions. Why do we need them.

  4. #4
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Maybe you can support Vbscript in this way too.?js5.8,javascript9.dll(version 11)

    IActive Script, oletlb, if the specified script engine is javaacript, version 2.0 needs to be specified in a parameter. If he starts with the Chakra engine GUID, he doesn't need this setup.

    It would be better if both VBS and JS script engines could be supported.

    IActive Script, oletlb, when I use it, I implement all three ways.
    js5.8,vbs5.8,js11.0
    I mainly want to compare the old and new versions of JS. What is the difference in running speed? Maybe some functions can only be implemented on the new version. After all, it is the new generation of JS syntax standard.

    At the same time, if we want this code to run on XP or Windows 7 system. If IE11 is not installed, it can only use the old version of JS.
    I wonder if you can also implement these three script engines?
    Last edited by xiaoyao; Sep 30th, 2023 at 05:01 PM.

  5. #5
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Virtual tables and structures are sometimes really omnipotent. We can also directly operate webview2load.dll.

    You should also use this technology to achieve this, right?

    Please forgive my poor English, I mostly use the language translation function on the input method.

    Although this finding is not very effective, it can still reach some level of communication.Although the translation is not very good.

    python,js,.net core
    I will also learn some of these techniques.
    I am not young, and I hope I can learn the technology of VB6 better.
    In fact, many of these functions can be done with python

    But Microsoft's small IDE compiles only a few hundred kilobytes of exe, which is really perfect.
    Last edited by xiaoyao; Sep 30th, 2023 at 05:08 PM.

  6. #6
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Rc6.dll, why can he parse the structure of the PSD file format, I do not know what technology this uses?

    I don't know if there is such a day that VB script runs successfully on Linux operating system. Like freebasic, twinbasic.

    I have done a calculation of a billion times to find the remainder. VBScript (5.8)takes 130 seconds, JS It takes 120 seconds.

    But with JS 11.0 (jacascript9.dll), scriptcontrol, it takes only 6 seconds.I am quite satisfied with this speed.Maybe Microsoft will never update again.

    The speed has been increased by 20 times.

    chrome v8 js,It only takes about 1.5 seconds to run.
    After all, Microsoft uses scripts, parsing and running. Google compiles and runs on a completely different principle.

    But he didn't upgrade the VBS script engine.Microsoft should be able to do it. It's just that he has completely abandoned the language.

    Perhaps it is to pursue a higher speed of operation, which can only be achieved by js(v8.dll)

    It also supports compile-bit Linux dll,so file.
    Last edited by xiaoyao; Sep 30th, 2023 at 05:04 PM.

  7. #7
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    HOW TO USE EVAL?

    Code:
    Function Eval(Code As String) As Variant
        Eval = ActiveScriptRunCode(m_uScript, Code)
    End Function

  8. #8
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    i update some function:

    Code:
    Private Const SCRIPTTEXT_ISEXPRESSION = 32&
    Private Const SCRIPTTEXT_ISVISIBLE = 2&
    
    Public Function ActiveScriptEval(uData As UcsActiveScriptData, sCode As String) As Variant
        Dim hResult         As Long
        Dim uException      As EXCEPINFO
        
        If uData.pParse Is Nothing Then
            Exit Function
        End If
        hResult = DispCallByVtbl(ObjPtr(uData.pParse), IDX_ParseScriptText, StrPtr(sCode), 0&, 0&, 0&, 0&, 0&, SCRIPTTEXT_ISEXPRESSION Or SCRIPTTEXT_ISVISIBLE, VarPtr(ActiveScriptEval), VarPtr(uException))
        If hResult < 0 Then
            'Err.Raise hResult,  "IActiveScriptParse.ParseScriptText"
            Debug.Print "ERR-ActiveScriptRunCode-" & hResult
        End If
    End Function
    Last edited by xiaoyao; Oct 1st, 2023 at 04:57 PM.

  9. #9
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    how to get errinfo? it's wrong

    Code:
    Private Declare Function GetLastError Lib "kernel32" () As Long
    
    Function GetLastDllErr(ByVal lErr As Long) As String
        Dim sReturn As String
        sReturn = String$(256, 32)
        FormatMessage FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_InsertS, 0&, lErr, 0&, sReturn, Len(sReturn), ByVal 0
        sReturn = Trim(sReturn)
        GetLastDllErr = sReturn
    End Function
    v = Script.Eval("var a=3;" & vbCrLf & "var b=4;" & vbCrLf & "var c=44;sum2(33,44)")

    ((lLine * 45 + lPos) - 45) maybe err

    sDescription & " at position " & ((lLine * 45 + lPos) - 45)
    Last edited by xiaoyao; Oct 1st, 2023 at 04:56 PM.

  10. #10
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    'vArgs = Args
    By converting an indefinite number of arguments directly to a variant array, no data can be returned from the arguments.

    I tried something else

    Code:
    Dim Code As String
    Code = "function sum(a,b):sum=a+b:b=b*2:end function"
    Script.AddCode Code
    
    Dim a As Long, b    As Variant, c     As Long, oldb As Long
    a = 11
    b = 22
    oldb = b
    c = Script.CallByName("sum", a, b)
    'msgbox Script.CallByName("sum", 33, 44)
    MsgBox c & ",oldb=" & oldb & "," & b
    
    a = 11
    b = 22
    oldb = b
    
    c = ActiveScriptCallFunction2(publicScript, StrPtr("sum"), a, b)
    MsgBox c & ",oldb=" & oldb & "," & b

    Code:
    Public Function ActiveScriptCallFunction2(uData As UcsActiveScriptData, ByVal StrPtrProcName As Long, ParamArray Args() As Variant) As Variant
    'abcd
        Dim hResult         As Long
        Dim pDisp           As Object
        Dim vArgs           As Variant
        
        If uData.pScript Is Nothing Then
            Exit Function
        End If
        hResult = DispCallByVtbl(ObjPtr(uData.pScript), IDX_GetScriptDispatch, 0&, VarPtr(pDisp))
        If hResult < 0 Then
            ErrRaise hResult, "IActiveScript.GetScriptDispatch"
        End If
    
        'vArgs = Args:ActiveScriptCallFunction = DispInvoke(pDisp, ProcName, VbMethod Or VbGet, vArgs)
        
    Dim pVarg   As Long, hr As Long
    ' This code works fine
    GetMem4 ByVal VarPtr(StrPtrProcName) + 4, pVarg
    hr = Vb6CallByName(ActiveScriptCallFunction2, pDisp, StrPtrProcName, VbMethod Or VbGet, ByVal pVarg, &H409)
    End Function
    how to get args point by VarPtr(ProcName) ?

    Code:
    Private Declare Function Vb6CallByName Lib "msvbvm60" Alias "rtcCallByName" ( _
            ByRef vRet As Variant, _
            ByVal cObj As Object, _
            ByVal sMethod As Long, _
            ByVal eCallType As VbCallType, _
            ByRef pArgs As Any, _
            ByVal lcid As Long) As Long
    
    Public Function ActiveScriptCallFunction(uData As UcsActiveScriptData, ByVal ProcName As String, ParamArray Args() As Variant) As Variant
    'abcd
        Dim hResult         As Long
        Dim pDisp           As Object
        Dim vArgs           As Variant
        
        If uData.pScript Is Nothing Then
            Exit Function
        End If
        hResult = DispCallByVtbl(ObjPtr(uData.pScript), IDX_GetScriptDispatch, 0&, VarPtr(pDisp))
        If hResult < 0 Then
            ErrRaise hResult, "IActiveScript.GetScriptDispatch"
        End If
        vArgs = Args
         ActiveScriptCallFunction = DispInvoke(pDisp, ProcName, VbMethod Or VbGet, vArgs)
        
    Dim pVarg   As Long, hr As Long
        GetMem4 ByVal VarPtr(ProcName) + 4, pVarg
     
        
        hr = Vb6CallByName(ActiveScriptCallFunction, pDisp, StrPtr(ProcName), VbMethod Or VbGet, ByVal pVarg, &H409)
        
    End Function
    Last edited by xiaoyao; Oct 1st, 2023 at 06:22 PM.

  11. #11
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    The third method, which works fine, returns the modified data in the parameters

    Code:
    Private Declare Sub BindArray Lib "kernel32" Alias "RtlMoveMemory" (PArr() As Any, pSrc&, Optional ByVal CB& = 4)
    Private Declare Sub ReleaseArray Lib "kernel32" Alias "RtlMoveMemory" (PArr() As Any, Optional pSrc& = 0, Optional ByVal CB& = 4)
    
    Private Type SAFEARRAY1D
      cDims As Integer
      fFeatures As Integer
      cbElements As Long
      cLocks As Long
      pvData As Long
      cElements1D As Long
      lLbound1D As Long
    End Type
    
    Public Function ActiveScriptCallFunction(uData As UcsActiveScriptData, ProcName As String, ParamArray Args() As Variant) As Variant
    'abcd
        Dim hResult         As Long
        Dim pDisp           As Object
     
        
        If uData.pScript Is Nothing Then
            Exit Function
        End If
        hResult = DispCallByVtbl(ObjPtr(uData.pScript), IDX_GetScriptDispatch, 0&, VarPtr(pDisp))
        If hResult < 0 Then
            ErrRaise hResult, "IActiveScript.GetScriptDispatch"
        End If
    
            Dim Args2() As Variant
            Dim ub As Long
            ub = UBound(Args)
            
            If ub <> -1 Then
                ReDim Args2(ub)
                Dim saP As SAFEARRAY1D
                
                saP.cDims = 1
                saP.cbElements = 16 'VARIANT 结构本身固定长 16 个字节
                saP.cElements1D = ub + 1
                saP.pvData = VarPtr(Args(0))
                BindArray Args2, VarPtr(saP)
            Else
                Args2 = Args
            End If
          
          ActiveScriptCallFunction = DispInvoke(pDisp, ProcName, VbMethod Or VbGet, Args2)
          If ub <> -1 Then ReleaseArray Args2
          
    End Function

  12. #12
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    how to checkfunction is exits?
    Is there a way not to trigger this error? OnActiveScriptError

    Code:
    <script>
    function sum(a,b){return a+b;}
    
    function isExitsFunction2(obj){
    if (typeof obj === 'function') {
     return true;
    } else {
      return false;
    }
    }
    
    function isExitsFunction(funname){
    if (funname in window) {//not support scriptcontrol
     return true;
    } else {
      return false;
    }
    }
    
    //alert(isExitsFunction2(sum2));
    //alert(isExitsFunction2(sum));
    
    
    
    
    alert(isExitsFunction("sum2"));
    alert(isExitsFunction("sum"));
    
    </script>

  13. #13
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    You can retrieve the object directly after initializing the script, so that you do not need to reextract the object every time you execute the JS code.

    Code:
     Public pDisp           As Object
    
    
    '--- success
        ActiveScriptInit = True
        
     
        
    
        hResult = DispCallByVtbl(ObjPtr(uData.pScript), IDX_GetScriptDispatch, 0&, VarPtr(pDisp))
        If hResult < 0 Then
            ErrRaise hResult, "IActiveScript.GetScriptDispatch"
        End If

  14. #14
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    IF NO ARGS,,result is error
    Code:
    Script.AddCode "function ABC(){return 3.14;}"
    
    v=ActiveScriptCallFunction("ABC")
    
    ActiveScriptCallFunction(functionname, ParamArray Args() As Variant) As Variant
    vArgs = Args
        ActiveScriptCallFunction_old = DispInvoke(pDisp, ProcName, VbMethod Or VbGet, vArgs)

  15. #15
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] VBTixyLand Control

    Hadn't seen this before. Was interested in an implementation of those interfaces, they were such a pain to create oleexp and especially tbShellLib interface versions for on account of ByVal types and different GUIDs for x64, going to use this to verify them. Very nice.

  16. #16
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    64 BIT VBA CAN'T USE oleexp.tlb?

    so this Vbtixland can run in x64 vba?
    but need change some code to do this,linke longptr

  17. #17
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] VBTixyLand Control

    64bit VBA can't use oleexp no, and I can't compile a 64bit version. You could make a type library yourself, if you avoid re-implementing low level COM stuff or get just the right version of midl with just the right setup.

    twinBASIC has planned support for exporting type libraries. When that support is available, I'll be exporting tbShellLib as a type library for VBx. 64bit for VBA64, and 32bit for VBA32 and to replace oleexp for VB6.

    VBTixyLand could be modified for VBA64 (or tB 64), but yes there's a lot of pointer definitions and calculations you'd have to change. Further, IActiveScriptParse has a different GUID for x64, {C7EF7658-E1EE-480E-97EA-D52CB4D76D17}, so you'd need different IID_IActiveScriptParse values.


    --
    @wqweto, I'm having a little trouble following how the timer is being used through the MST... want to replace it with a regular TimerProc for use in tB, but I'm not seeing how things are translating to SetTimer call with standard TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal TimerID As LongPtr, ByVal Tick As Long). It looks like it's killing and recreating the timer every tick?

  18. #18
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Quote Originally Posted by fafalone View Post
    64bit VBA can't use oleexp no, and I can't compile a 64bit version. You could make a type library
    @wqweto, I'm having a little trouble following how the timer is being used through the MST... want to replace it with a regular TimerProc for use in tB, but I'm not seeing how things are translating to SetTimer call with standard TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal TimerID As LongPtr, ByVal Tick As Long). It looks like it's killing and recreating the timer every tick?
    try this https://www.vbforums.com/showthread....ass&highlight=

    SetTimer to addressof 0( to set enable timer=false)
    Code:
    Private TimerEnable As Collection
    Public TimerIdByKey As Collection
    Public TimerTick As Collection
    
      TimerId = SetTimer(0, 0, DurationInMs, AddressOf TimerProc)
    key="Timer1"
      Debug.Print "new timerid=" & TimerId
    
    TimerEnable.Add True, Key
    TimerIdByKey .Add Handler, CStr(TimerId)
    TimerTick.Add DurationInMs, TimerId & ""

    Code:
    Public Property Get EnableTimer(Key As String) As Boolean
        EnableTimer= TimerEnable(Key)
    End Property
    
    Public Property Let EnableTimer(Key As String, ByVal vNewValue As Boolean)
        If EnableTimer(Key) <> vNewValue Then
            TimerEnable.Remove Key
            TimerEnable.Add vNewValue, Key
            Dim TimerID As LongPtr, v As LongPtr
            TimerID = TimerIdByKey .Item(Key)
            If vNewValue Then
               v = SetTimer(0, TimerID, TimerTick(TimerId & ""), AddressOf TimerProc)
            Else
               v = SetTimer(0, TimerID, -1, 0&)
            End If
            Debug.Print "Change Timer State Enable To:" & vNewValue & ",TimerID=" & TimerID & ",NewTimerID=" & v
        End If
    End Property

    Code:
    Public Property Get TimerTick(Key As String) As Long
        TimerTick = TimerTickList(Key)
    End Property
    
    Public Property Let TimerTick(Key As String, ByVal vNewValue As Long)
           
            Dim TimerId As LongPtr, v As LongPtr
            Dim OldTick As Long
            TimerId = TimerIdByKey(Key)
            OldTick = TimerTick(TimerId & "")
             If OldTick <> vNewValue Then
                TimerTickList.Remove TimerId & ""
                TimerTickList.Add vNewValue, TimerId & ""
                If EnableTimer(Key) Then
                   v = SetTimer(0, TimerId, vNewValue, AddressOf TimerProc)
                Else
                   v = SetTimer(0, TimerId, -1, 0&)
                End If
                Debug.Print "Change Timer Tick " & OldTick & " To:" & vNewValue & ",TimerID=" & TimerId & ",NewTimerID=" & v
            End If
    End Property


    Code:
    EnableTimer("Timer1")=false
    EnableTimer("Timer1")=true
    msgbox EnableTimer("Timer1")
    Last edited by xiaoyao; Oct 2nd, 2023 at 01:59 PM.

  19. #19

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,092

    Re: [VB6] VBTixyLand Control

    Quote Originally Posted by fafalone View Post
    It looks like it's killing and recreating the timer every tick?
    Yes, it's a fire-once timer from MST so it's a bit cumbersome.

    Quote Originally Posted by xiaoyao View Post
    'vArgs = Args
    By converting an indefinite number of arguments directly to a variant array, no data can be returned from the arguments.
    Yes it does this, but how do you declare ByRef parameters in JavaScript?

    You could use VariantCopy to populate vArgs here while preserving VT_BYREF flags but what's the point when JavaScript functions cannot inherently return anything through VT_BYREF Variants.

    cheers,
    </wqw>

  20. #20
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Code:
    Declare Function Vb6CallByName2 Lib "msvbvm60" Alias "rtcCallByName" ( _
            ByRef vRet As Variant, _
            ByVal cObj As Object, _
            ByVal sMethod As Long, _
            ByVal eCallType As VbCallType, _
            ByRef Args() As Any, _
            Optional ByVal lcid As Long) As Long
    
    Function CallByName(ProcName As String, ParamArray Args() As Variant) As Variant
            
           
    function CallByName3_Speed(funname as string)
    	Dim saP As SAFEARRAY1D
    	'or use VariantCopy(a,b)
    	saP.cDims = 1
    	saP.cbElements = 16 'VARIANT 结构本身固定长 16 个字节
    	saP.cElements1D = ub + 1
    	saP.pvData = VarPtr(Args(0))
    	BindArray Args2, VarPtr(saP)
    		
     hResult = Vb6CallByName2(CallByName, pDisp, StrPtr(ProcName), VbMethod, Args2())
     		
    end function     
                
    function CallByName3_Speed2(**)
    Dim Args2() As Variant
     Args2 = ParamArray args()
    
    
     end function
     
    
    Public Function CallByNamePtr(ByVal StrPtrProcName As Long, ParamArray Args2() As Variant) As Variant
        Dim hResult         As Long
        'Dim pVarg   As Long
        GetMem4 ByVal VarPtr(StrPtrProcName) + 4, hResult
        hResult = Vb6CallByName3(CallByNamePtr, pDisp, StrPtrProcName, VbMethod, hResult, &H409)
    End Function
    usedtime:
    '0.0092ms CallByName3_Speed (55% slower than speed2)
    '0.0041ms CallByName3_Speed2
    '0.0029ms CallByNamePtr (This method is the fastest, 41% faster than speed2)


    rtcCallByName api can use for (ParamArray args()) or array data( dim args() as variant)
    When calling VBS scripts, unless a large number of automated office automatic operation scripts, such as AHK3.EXE, such as high-frequency call, the return value may be used, running speed and efficiency is also important.

    rtcCallByName runs faster and with less code than DispInvoke(pDisp, ProcName, VbMethod).
    It is mainly used for COM object operations elsewhere, instead of DispCallFunc, to improve the running speed.

    Does Microsoft have a CallByDisp method that can be called in one sentence? Maybe this is it
    Params As olelib.DISPPARAMS
    Object.Invoke(DISPID, IID_NULL, 0, CallType, Params, _
    VarPtr(Result), tEXCEPINFO, lArgErr)
    Last edited by xiaoyao; Oct 2nd, 2023 at 08:42 AM.

  21. #21
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Code:
    Function GetDISPID(ByVal Object As olelib.IDispatch, Name As String) As Long
        Dim IID_NULL As olelib.UUID
        Object.GetIDsOfNames IID_NULL, CStr(Name), 1, 0, GetDISPID
    End Function
    
        hResult = DispCallByVtbl(Ptr_pDisp, 5, VarPtr(IID_NULL(0)), VarPtr(StrPtr(ProcName)), 1&, 0&, VarPtr(lDISPID))

    use GetIDsOfNames is quickly than DispCallByVtbl
    0.0009 ms ole.tlb GetIDsOfNames
    0.0078 ms DispCallByVtbl

  22. #22
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] VBTixyLand Control

    So I replaced TimerProc with

    Code:
        Public Function TimerProc(ByVal hWnd As TixyLand, ByVal uMsg As Long, ByVal TimerID As LongPtr, ByVal Tick As Long) As Long
       ' Attribute TimerProc.VB_MemberFlags = "40"
            TixyLand.Repaint
            'Set m_pTimer = InitFireOnceTimerThunk(Me, pvAddressOfTimerProc.TimerProc(), Delay:=15)
            'KillTimer ObjPtr(Me), &H401
            'SetTimer ObjPtr(Me), &H401, 17, AddressOf TimerProc
        End Function
    and replaced this in pvResetMatrix:

    Code:
                'Set m_pTimer = InitFireOnceTimerThunk(Me, pvAddressOfTimerProc.TimerProc(), Delay:=17)
                SetTimer ObjPtr(Me), &H401, 17, AddressOf TimerProc
    And put a KillTimer in UC_Terminate.

    Is that correct and are there any other changes to look into? Tried just leaving the timer in place by omitting kill/set in timerproc; no crash but no repaint.

    This is in VB6 still; the TimerProc is in a standard bas. The ticks are firing but it just doesn't repaint.

    Edit: It seems it just doesn't like me passing an ObjPtr pointer. Can't pass it as an hwnd, can't pass it as a timer id, but if I just use a hard reference instead it works, which is probably fine for now.
    Last edited by fafalone; Oct 2nd, 2023 at 07:39 PM.

  23. #23
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Quote Originally Posted by fafalone View Post
    So I replaced TimerProc with

    Code:
        Public Function TimerProc(ByVal hWnd As TixyLand, ByVal uMsg As Long, ByVal TimerID As LongPtr, ByVal Tick As Long) As Long
       ' Attribute TimerProc.VB_MemberFlags = "40"
            TixyLand.Repaint
            'Set m_pTimer = InitFireOnceTimerThunk(Me, pvAddressOfTimerProc.TimerProc(), Delay:=15)
            'KillTimer ObjPtr(Me), &H401
            'SetTimer ObjPtr(Me), &H401, 17, AddressOf TimerProc
        End Function
    and replaced this in pvResetMatrix:

    Code:
                'Set m_pTimer = InitFireOnceTimerThunk(Me, pvAddressOfTimerProc.TimerProc(), Delay:=17)
                SetTimer ObjPtr(Me), &H401, 17, AddressOf TimerProc
    And put a KillTimer in UC_Terminate.

    Is that correct and are there any other changes to look into? Tried just leaving the timer in place by omitting kill/set in timerproc; no crash but no repaint.

    This is in VB6 still; the TimerProc is in a standard bas. The ticks are firing but it just doesn't repaint.

    Edit: It seems it just doesn't like me passing an ObjPtr pointer. Can't pass it as an hwnd, can't pass it as a timer id, but if I just use a hard reference instead it works, which is probably fine for now.
    don't use objptr,why?
    In a 32-bit excel, I saw someone directly put objptr (Class1), and then directly put idevent in the parameter in the test paper to get this object.
    In this way, the transfer object is successful.
    But I found that it is not available in 64-bit.
    Code:
    settimer(0,objptr(class1),1000)
    
    Public Function TimerProc(ByVal hWnd As TixyLand, ByVal uMsg As Long, ByVal Timeid as class1, ByVal Tick As Long) As Long
    
    class1.FireTimerTick()
    
    end function
    Last edited by xiaoyao; Oct 2nd, 2023 at 09:22 PM.

  24. #24
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] VBTixyLand Control

    Need ObjPtr to pass a reference to the class instance outside of the class, without relying on hard-coded references like Form1.TixyLand1 like I'm using now. But it was just to get it working in VB6, in tB AddressOf can be used within the UC for the callback.
    ---

    @wqweto, what would it take to make this work as a windowed control? Right now setting Windowless = False causes control to just be black and never update; autoredraw no change.

  25. #25

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,092

    Re: [VB6] VBTixyLand Control

    Quote Originally Posted by fafalone View Post
    @wqweto, what would it take to make this work as a windowed control? Right now setting Windowless = False causes control to just be black and never update; autoredraw no change.
    Windowless = False and BackStyle = Opaque works here but repaint flickers and (obviously) the control is not transparent.

    Flicker can be fixed in pvRefresh by instead of calling UserControl.Refresh directly executing UserControl_Paint event handler.

    There is still a problem with AlphaBlend drawing next frame transprently over the previous one which can be fixed by FillRect call in pvCreateDib.

    cheers,
    </wqw>

  26. #26
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] VBTixyLand Control

    Code:
    MsgBox Script.AddCode("var test = Object.create(null); // Check ES5 features ")
    MsgBox Script.AddCode("var promise = new Promise(function(resolve, reject) {}); // Check ES6 features ")
    javascript9.dll not support es5,es6?
    i test in chakra.dll,support es5,es6


    ErrNumber:-2147352319[IActiveScriptParse.ParseScriptText]
    JavaScript runtime error, object does not support "create" property or method

    ErrNumber:-2147352319[IActiveScriptParse.ParseScriptText]

  27. #27
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] VBTixyLand Control

    Quote Originally Posted by wqweto View Post
    Windowless = False and BackStyle = Opaque works here but repaint flickers and (obviously) the control is not transparent.

    Flicker can be fixed in pvRefresh by instead of calling UserControl.Refresh directly executing UserControl_Paint event handler.

    There is still a problem with AlphaBlend drawing next frame transprently over the previous one which can be fixed by FillRect call in pvCreateDib.

    cheers,
    </wqw>
    Very close now, but..

    It's still looking like it's drawing over the previous one... in the default setting, the white circles never shrink and are just filled it by the red...

    This happens with the Refresh->Paint change; without that there's heavy flickering but it is drawing correctly.

    I had set bk = opaque, bk color=black, and in pvCreateDib

    Code:
            Dim rc As RECT
            rc.Right = lWidth
            rc.Bottom = lHeight
            Static hbr As LongPtr
            If hbr = 0 Then hbr = GetStockObject(BLACK_BRUSH)
            FillRect hMemDC, rc, hbr
    tried both before and after CreateDIBSection.
    Last edited by fafalone; Oct 3rd, 2023 at 11:27 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width