-
Nov 9th, 2020, 02:39 PM
#1
[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.
Last edited by wqweto; Nov 9th, 2020 at 04:51 PM.
-
Sep 30th, 2023, 04:11 PM
#2
Re: [VB6] VBTixyLand Control
This technology is so great. Let's applaud.
-
Sep 30th, 2023, 04:38 PM
#3
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.
-
Sep 30th, 2023, 04:42 PM
#4
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.
-
Sep 30th, 2023, 04:44 PM
#5
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.
-
Sep 30th, 2023, 04:45 PM
#6
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.
-
Oct 1st, 2023, 03:51 PM
#7
Re: [VB6] VBTixyLand Control
HOW TO USE EVAL?
Code:
Function Eval(Code As String) As Variant
Eval = ActiveScriptRunCode(m_uScript, Code)
End Function
-
Oct 1st, 2023, 04:12 PM
#8
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.
-
Oct 1st, 2023, 04:30 PM
#9
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.
-
Oct 1st, 2023, 05:51 PM
#10
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.
-
Oct 1st, 2023, 06:20 PM
#11
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
-
Oct 1st, 2023, 07:01 PM
#12
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>
-
Oct 1st, 2023, 07:37 PM
#13
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
-
Oct 1st, 2023, 10:01 PM
#14
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)
-
Oct 2nd, 2023, 12:04 AM
#15
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.
-
Oct 2nd, 2023, 01:21 AM
#16
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
-
Oct 2nd, 2023, 02:10 AM
#17
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?
-
Oct 2nd, 2023, 03:27 AM
#18
Re: [VB6] VBTixyLand Control
Originally Posted by fafalone
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.
-
Oct 2nd, 2023, 06:17 AM
#19
Re: [VB6] VBTixyLand Control
Originally Posted by fafalone
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.
Originally Posted by xiaoyao
'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>
-
Oct 2nd, 2023, 08:34 AM
#20
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.
-
Oct 2nd, 2023, 08:40 AM
#21
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
-
Oct 2nd, 2023, 07:01 PM
#22
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.
-
Oct 2nd, 2023, 09:13 PM
#23
Re: [VB6] VBTixyLand Control
Originally Posted by fafalone
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.
-
Oct 3rd, 2023, 02:33 AM
#24
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.
-
Oct 3rd, 2023, 07:34 AM
#25
Re: [VB6] VBTixyLand Control
Originally Posted by fafalone
@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>
-
Oct 3rd, 2023, 07:55 AM
#26
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]
-
Oct 3rd, 2023, 11:04 AM
#27
Re: [VB6] VBTixyLand Control
Originally Posted by wqweto
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|