Printable View
I have a question about how to convert vbrichclient5.cRecordset into ADODB.Recordset in RC5. Because all the output of my perfect partial function is ADODB.Recordset, I need RC5 to process DB data without changing the original program structure. Otherwise, it will be too heavy. Thank you for your help.
What's your goal in the end?Quote:
Originally Posted by yinxiaodan
For the moment, I assume you just want to switch from a JET-mdb to an SQLite-db?
Well, there is a built-in method on a cRecordset, which will produce a copy of its content in an ADO-Rs:
Set RsADO = cRecordset.GetADORsFromContent
Though, what's now contained in RsADO is a disconnected (free standing) ADO-Rs, which has no underlying Connection to any DB.
In a well-designed, larger DB-App (which took "scaleability" into account from the beginning),
one usually does not mind about such "true disconnected ADO-Rs" with no underlying connection
(because these are the norm, when the Rs could come also from a Web- or other Application-Server).
So, when you now hand out such freestanding, connectionless ADO-Rs to your Application (from your "partial function", which I guess is not related to the math-term),
you will have to check, what methods of the ADO-Rs you are using later on, "down in the depths of your App-Code".
Because with connectionless Rs - all the Methods for the "write-direction" (AdoRs.Update/UpdateBatch - just make a scan for them in your App via Find-Dialogue)
would have to be replaced by appropriate alternatives in a *.bas Module - for example: UpdateBatch(Rs As Ado.Recordset)
Olaf
Because we need to use translation tools, so the expression is not clear, the actual function I want is GetADORs FromContent, has been tested successfully, thank you very much. In order to achieve this function, I have written a silly conversion code, as follows:
Code:Public Function ConvertRC5Rst_TO_ADORst(tCRst_RC5 As vbrichclient5.cRecordset) As ADODB.Recordset
Dim i As Long, tRst As New ADODB.Recordset
If ObjPtr(tCRst_RC5) > 0 Then
If tCRst_RC5.Fields.Count = 0 Then Set ConvertRC5Rst_TO_ADORst = Nothing: Exit Function
'tCRst_RC5.Fields(0).n
For i = 0 To tCRst_RC5.Fields.Count - 1
tRst.Fields.Append tCRst_RC5.Fields(i).OriginalColumnName, adVariant ' ', tCRst_RC5.Fields(I).OriginalTableName '添加记录字段和属性
Next
tRst.Open '打开记录集
Do Until tCRst_RC5.EOF
tRst.AddNew
For i = 0 To tCRst_RC5.Fields.Count - 1
tRst.Fields(i).VALUE = tCRst_RC5.Fields(i).VALUE
Next i
tCRst_RC5.MoveNext
Loop
Set ConvertRC5Rst_TO_ADORst = tRst
' tRst.Close
Else
Set ConvertRC5Rst_TO_ADORst = Nothing
End If
End Function
Hi yinxiaodan, welcome to ask questions in this thread. In most cases, it's very convenient to convert RC5 Sqlite Recordset to AdoDB.RecordSet using "Set adoRs = rc5Rs.GetADORsFromContent".
However, in some special cases, you still need to manually write code to achieve conversion between different databases, such as converting some SQL Server DBs with a large amount of data into SqliteDBs. In this case, you may need a process bar, or you may need to perform some special conversion functions. So your code is still useful in some special cases.
When I perform code parsing, I need to simulate stack operations (Push and Pop) frequently. I tried the following method:
But "Set m_CurToken = m_ArrayList.Pop" seems to be invalid.Code:Private m_CurToken As cToken
Private m_ArrayList As cArrayList
Private Sub Init()
Set m_ArrayList = New_c.ArrayList(vbDataObject)
End Sub
Private Sub StackPush()
m_ArrayList.Push m_CurToken
End Sub
Private Sub StackPop()
Set m_CurToken = m_ArrayList.Pop()
End Sub
Public Sub Test()
Dim i As Long, k As Long
Set m_CurToken = New cToken
m_CurToken.Name = "ABCDEFHIJKLMN"
m_CurToken.Priority = 1
m_CurToken.TokenType = 3
New_c.Timing True
For i = 1 To 3000000
StackPush
If m_ArrayList.Count > 10000 Then
For k = 10000 To 1 Step -1
StackPop
Next k
End If
Next
MsgBox New_c.Timing
End Sub
I tried your code and it seems to work for me (at least when I change the ArrayList variable type to vbObject instead of vbDataObject, which I had to do because I don't have a vbDataObject class type hanging around). What error are you getting?
Yes, after changing vbDataObject to vbObject, the code is OK. I'll write a test program to compare the efficiency of RC5.ArrayList, RC5.Collection, VB.Collection, VB.Array in performing Push and Pop operations. Thank you very much, jpbro.Quote:
Originally Posted by jpbro
Hi jpbro, I posted the test results in the following links:
http://www.vbforums.com/showthread.p...(Push-and-Pop)
Oddly, in the VB6 IDE (in design mode) RC5.ArrayList and RC5.Collection have better performance than VB.Collection. But in EXE (in binary mode), the result is the opposite.
There's several things wrong in your benchmark-code.Quote:
Originally Posted by dreammanor
(what concretly, I've described in the thread you linked to).
Olaf
Yes, there are a few very low-level naive errors in my test program, I'll upload a new test program. Thank you for pointing out the errors.Quote:
Originally Posted by Schmidt
In additon, I'm having some problems with ArrayList when dealing with variant item:
When the program runs to "Set oItem = oArrayList.Pop", the system prompts "Object does not support this property or method" (error: 438)Code:Private Sub Command1_Click()
Dim oArrayList As cArrayList
Set oArrayList = New_c.ArrayList(vbVariant)
oArrayList.Init vbVariant
Dim arr1() As String
ReDim arr1(10) As String
oArrayList.Push arr1
Dim oToken As cToken
Set oToken = New cToken
oToken.Name = "ABCDEFG"
oArrayList.Push oToken
Dim oItem As cItem
Set oItem = New cItem
oItem.Name = "Hello, world !"
oArrayList.Push oItem
Set oItem = oArrayList.Pop
Set oToken = oArrayList.Pop
arr1 = oArrayList.Pop
End Sub
Just uploaded a new version, where this is fixed now (together with a few other small things)...Quote:
Originally Posted by dreammanor
SQLite (vb_cairo_sqlite.dll) was upgraded from 3.24 to 3.28 at this occasion as well.
Did not stumble over that in cArrayList so far, because I rarely use it in "Variant-Mode"
(where each added Item will then take up at least 16Bytes).
For Object-Items - I'm using cArrayList in vbObject-Mode (where each added Item-Ref takes up only the 4Bytes for the ObjPtr).
That's one of the reasons, to choose cArrayList over a cCollection or a cSortedDictionary (where Items are always stored as Variant) -
it can be forced to a certain type - and will then usually take up less memory (compared to Collection-usage in the same scenario).
Olaf
After using the new version of RC5, now the ArrayList can pop variant-items normally. Thank you very much, Olaf.Quote:
Originally Posted by Schmidt
The reason I wrote some of the above weird code is because I'm translating some JavaScript code into VB6 code. JS is too flexible, it's cumbersome to translate it into VB6.
hi，Schmidt and dreammanor and other:
For multithreading, the ThreadHandler in RC5c that I use is great overall, but there are still the following problems. For example, thread Dll debugging is difficult, and sometimes it crashes for no reason to find out exactly where it is.And during the run, I found that memory was gradually increasing.
In addition, how to actively uninstall loaded threads? (th = regfree. ThreadObjectCreate (cThreadKey, ThreadLibPath, cThreadClass)) is set directly to set th = nothing?
TH. JobQueueCount ‘represents the task currently executed (including the number of functions or processes being executed?)
TH. CancelExecution ‘Is to cancel the task being performed? If multiple tasks are cancelled altogether?
TH. TimeoutSecondsToHardTerminate 'What does this do?
thank you
An RC5.cThreadHandler instance is only a "RemoteObject for your real ThreadClass-instance", so the ThreadHandler runs in your normal Main-Thread.Quote:
Originally Posted by yinxiaodan
The "Remoted-Thread-STA" (with your regfree created Thread-Class-instance in it), will terminate when you set the clientside ThreadHandler to Nothing.
The TH.TimeoutSecondsToHardTerminate setting is the time in seconds, which the ThreadHandler waits
(in its own Class-Terminate-Event) - before it will terminate the "remoted Thread-STA the hard way" (via the TerminateThread-API).
So, your own thread-class-implementation has to play-along nicely (in case it sits in a longrunning-job which takes several seconds) -
to allow for "early exiting" in such longer running loops, so that the outer cThreadHandler-instance can terminate this thread gracefully -
not resorting to the "hard terminate" it will do otherwise (after a few adjustable seconds).
That "graceful-early-exit-handling" (if not done properly) is the main-reason for potential crashes
(because a hard terminated STA will introduce instabilities into the whole App - and can be done only a few times in my experience - so it needs to be avoided).
The ThreadHandler can signalize such an early-exit-request via TH.CancelExecution (which will cancel the current - but also clear the JobQueue of still waiting Jobs)
As for debugging - only "well-behaving and well-tested Classes" (e.g. in isolated Test-Projects which use the Class in question unthreaded),
should be moved into their own "Threading-Dlls" (at a later point).
As for TH.JobQueueCount...
Multiple async Jobs can be triggered "in advance" (for the Thread-internal-ClassInstance to process them from its Queue).
Here is a small example, which is specifying an internal RC5-Class as the "ThreadObject which runs on the STA" -
and which demonstrates, what the JobQueueCount means (please paste directly into an empty Form):
HTHCode:Option Explicit
Private WithEvents TH As cThreadHandler, CC As Long
Private Sub Form_Load()
'one can use RC5-internal Objects on their own thread,
'by specifying "New_c" as the Dll-FileName and the Classname without the 'c'-Prefix
'(instead of New_c.Collection we just pass the two parts around the '.' in their own String-Argument)
Set TH = New_c.RegFree.ThreadObjectCreate("Col", "New_c", "Collection")
End Sub
Private Sub Form_Click()
TH.CallAsync "Add", 1, "Key1"
TH.CallAsync "Add", 2, "Key2"
TH.CallAsync "Add", 3, "Key3"
Debug.Print "3 async Add-Method-Calls were triggered, JobQueueCount=" & TH.JobQueueCount
End Sub
Private Sub TH_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
CC = CC + 1: Debug.Print MethodName, CC, TH.JobQueueCount, ErrString
If TH.JobQueueCount = 0 Then
Debug.Print "The Async Job-sequence is finished"
Debug.Print "Col.Count:"; TH.CallSynchronous("Count")
Debug.Print "Value behind Key3:"; TH.CallSynchronous("Item", "Key3")
CC = 0
' TH.CallSynchronous "RemoveAll" 'comment this in, to avoid the Error-Reports whilst clicking the Form multiple times
End If
End Sub
Olaf
Olaf will can add more details/correct me on any errors, but here's my understanding of your questions:
In my code I'm waiting for an empty job queue before setting the thread object to Nothing. Not sure if this is necessary though. Something like this:Quote:
Originally Posted by yinxiaodan
Code:Private Sub Class_Terminate()
With mo_MyThread
.WaitForEmptyJobQueue
.CancelExecution
.WaitForEmptyJobQueue
End With
Set mo_MyThread = Nothing
End Sub
This is the number of async jobs that are queued up for running on the thread. Everytime you call the CallAsync method, the job is either passed to the thread (if no jobs are running), or added to the end of the FIFO queue (if a job is already running).Quote:
Originally Posted by yinxiaodan
This will disconnect/reconnect the thread and remove any jobs from the queue so no new job processing will occur. I think if a job is currently running it will finish, but you won't get any events/results from it since the class gets disconnected from the thread pipe. Not sure about this though, Olaf will have to clarify.Quote:
Originally Posted by yinxiaodan
This is the number of seconds that must elapse before the thread handler considers the thread "lost" and will then force it to terminate...This is only relevant when the cThreadHandler class is terminating (e.g. when setting the last reference to it to Nothing). I don't think you will need this unless there's a bug in your threaded code that causes it to lock up (infinite loop for example).Quote:
Originally Posted by yinxiaodan
Hope that helps!
Yes, one can of course also wait "manually" (instead of relying on the stuff the ThreadHandler will do in its own Class_Terminate regarding the remote-thread).Quote:
Originally Posted by jpbro
A thread can be terminated gracefully, when it currently "idles" (having a JobQueueCount of Zero, which is what the WairForEmptyJobKey-Function checks for).
I'd make just a slight change in the above routine, since WaitForEmptyJobQueue will return immediately, when the JobQueueCount is zero, which CancelExecution will ensure
(so the second call to .WaitForEmptyJobQueue is not really needed).
Code:Private Sub Class_Terminate()
'wait for max. 3secs, until the JobQueue is cleared the hard way via .CancelExecution
'in case it returns within the 3secs with True - then the JobQueueCount reached zero - and the Thread is idling (needs no Cancelling)
If Not mo_MyThread.WaitForEmptyJobQueue(3) Then mo_MyThread.CancelExecution
Set mo_MyThread = Nothing
End Sub
CancelExecution does what you describe above - and it is also correct,Quote:
Originally Posted by jpbro
that a currently running job (the methodcall the ThreadClass-instance is currently processing) will have to "run to its end" -
and then will not cause a MethodFinished-Event - because the Pipe-instance was renewed by the CancelExecution-call.
Unless...: ;)
Such an outside cancelling is detectable from within any ThreadClass-instance-method (e.g. in case of a very longrunning loop) -
by cyclically checking via the following mechanism (which one has to implement in the ThreadClass "by convention" as shown below):
HTHCode:'define an Event in the declaration-section of your ThreadClass
Event CancelCheck(ByRef Cancelled As Boolean)
'one can accompany that Event with a Private Function somewhere in the ThreadClass for more convenient usage
'(which includes a mechanism, to not stress the underlying, hidden cThreadProxy-instance with too many Event-Requests per second)
Private Function CancelRequestFromOutside() As Boolean
Static LastT#, CurT#: CurT = New_c.HPTimer
If CurT - LastT > 0.1 Then LastT = CurT: RaiseEvent CancelCheck(CancelRequestFromOutside) 'we only need to perform this any 0.1sec or so
End Function
'With the above two additions to the Class, one can now perform a check for "gracefull, early exit" in longrunning Public methods:
Public Sub SomeLongRunningMethod(P1, P2, ..., Pn)
Do
'some partial action within the long-running loop
If CancelRequestFromOutside Then Exit Sub 'leave early, since we were required to do so from outside the thread
Loop Until SomeNormalCondition
End Sub
Olaf
Dear Schmidt and jpbro, thank you for your kind help and patient and meticulous answers. According to your method, I modified the code. After a day of testing, it really solved the problem of innocent memory increase and crash. Thank you again! This solves the big problem I've been plagued with. RC5, Great Creation.
HI, Schmidt and jpbro,
If Not TH. WaitForEmpty JobQueue (15) = True Then'over 15S automatically clears all
TH. Cancel Execution
Else
End If
If the thread executes for a long time, is the main program hung up and waited for 15S to execute again? If so, it is equivalent to blocking mode, which will affect the mouse click interface response. I used to use the following methods, there is no difference between the two methods, thank you.
Dim tAddTickCount As Long, tTickCount As Long
TAddTickCount = 15
TTickCount = New_c.HPTimer
Do
New_c.SleepEx 10
DoEvents
If TH.WaitForEmpty JobQueue = True Then Exit Do
If New_c.HPTimer - tTickCount > tAddTickCount Then
TH. Cancel Execution
Endif
End If
Loop Until TH.JobQueueCount < 1
Since we are at the threading-topic ...
My little example in post #74 was showing, how to use an instance of a built-in RC5-Class on its own thread
( a cCollection, to show async method queueing )
I've so far not used that feature for something serious (because of missing flexibility with just a single Object-Instance on a thread) -
but thinking about it, a cActiveScript-instance on its own thread could offer that needed flexibility (avoiding the compilation of ones own thread-dll).
So, below comes a first example which tries to use cActiveScript on its own thread -
the passed and added ScriptCode currently written, to perform an async, threaded FileScan,
to find "all image-files within a given Start-Directory recursively".
I'd like some feedback from you, whether that works well also on your machines and systems...
First a little "Project-Private" Helper-Class, which hides aways some of the Initializing- and -Cleanup-stuff with the ThreadHandler -
so that the Form-Code remains relatively "lean and clean"...
Into a Private Helper-Class, named cScriptThread:
And this into a normal Std-Exe-Project-Form for testing (please adjust the Scan-Path if needed in Form_Click, which is currently "c:\temp"):Code:Option Explicit
Event ThreadStateChanged(ByVal NewState As String)
Event MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
Private WithEvents TH As cThreadHandler, WithEvents tmrState As cTimer
Private ThreadState32K As String, CancelFlag As Variant
Private Sub Class_Initialize()
Set TH = New_c.RegFree.ThreadObjectCreate("T" & ObjPtr(Me) & App.hInstance, "New_c", "ActiveScript")
ThreadState32K = String$(32768 + 1, vbNullChar)
With New_c.ArrayList(vbString) 'ensure a few helper-routines on the threaded Script-instance
.Add "Dim pState32K: pState32K=" & StrPtr(ThreadState32K)
.Add "Dim pCancelFlag: pCancelFlag=" & VarPtr(CancelFlag)
.Add "Sub SetNewState(S)" 'to be used from within the thread, e.g. for Progress-Notifications
.Add " S = Left(S, 32768)"
.Add " If pState32K Then New_c.MemCopy pState32K, StrPtr(S), LenB(S) + 2"
.Add "End Sub"
.Add "Function Cancelled()" 'to detect cancelling from outside (from our Main-Thread)
.Add " New_c.MemCopy VarPtr(Cancelled), pCancelFlag, 16"
.Add "End Function"
.Add "Sub Cleanup()" 'needed and called shortly before Thread-Termination
.Add " On Error Resume Next"
.Add " New_c.CleanupRichClientDll"
.Add " If Err Then Err.Clear"
.Add "End Sub"
AddCode .Join(vbCrLf) 'add a few default-Vars and -Routines which are needed for communication
End With
Set tmrState = New_c.Timer(100, True)
End Sub
Public Sub CancelExecution()
CancelFlag = True
End Sub
Public Sub AddCode(Code As String, Optional ByVal ReplaceSingleQuotes As Boolean = True)
If TH.JobQueueCount Then Err.Raise vbObjectError, , "The thread is not in Idle-Mode, try again later"
If ReplaceSingleQuotes Then TH.CallSynchronous "AddCode", Replace(Code, "'", """") Else TH.CallSynchronous "AddCode", Code
End Sub
Public Function RunAsync(ProcedureName As String, ParamArray P())
CancelFlag = Empty
Select Case UBound(P)
Case -1: TH.CallAsync "Run", ProcedureName
Case 0: TH.CallAsync "Run", ProcedureName, P(0)
Case 1: TH.CallAsync "Run", ProcedureName, P(0), P(1)
Case 2: TH.CallAsync "Run", ProcedureName, P(0), P(1), P(2)
Case 3: TH.CallAsync "Run", ProcedureName, P(0), P(1), P(2), P(3)
Case 4: TH.CallAsync "Run", ProcedureName, P(0), P(1), P(2), P(3), P(4)
Case 5: TH.CallAsync "Run", ProcedureName, P(0), P(1), P(2), P(3), P(4), P(5)
End Select
End Function
Public Function RunSynchronous(ProcedureName As String, ParamArray P())
If TH.JobQueueCount Then Err.Raise vbObjectError, , "The thread is not in Idle-Mode, try again later"
CancelFlag = Empty
Select Case UBound(P)
Case -1: RunSynchronous = TH.CallSynchronous("Run", ProcedureName)
Case 0: RunSynchronous = TH.CallSynchronous("Run", ProcedureName, P(0))
Case 1: RunSynchronous = TH.CallSynchronous("Run", ProcedureName, P(0), P(1))
Case 2: RunSynchronous = TH.CallSynchronous("Run", ProcedureName, P(0), P(1), P(2))
Case 3: RunSynchronous = TH.CallSynchronous("Run", ProcedureName, P(0), P(1), P(2), P(3))
Case 4: RunSynchronous = TH.CallSynchronous("Run", ProcedureName, P(0), P(1), P(2), P(3), P(4))
Case 5: RunSynchronous = TH.CallSynchronous("Run", ProcedureName, P(0), P(1), P(2), P(3), P(4), P(5))
End Select
End Function
Private Sub TH_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
RaiseEvent MethodFinished(MethodName, Result, ErrString, ErrSource, ErrNumber)
End Sub
Private Sub tmrState_Timer()
Static LastS As String, CurS As String
CurS = Left$(ThreadState32K, InStr(ThreadState32K, vbNullChar) - 1)
If LastS <> CurS Then LastS = CurS: RaiseEvent ThreadStateChanged(CurS)
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Set tmrState = Nothing
CancelFlag = True
If Not TH.WaitForEmptyJobQueue(10) Then TH.CancelExecution
TH.CallSynchronous "Run", "Cleanup"
Set TH = Nothing
On Error GoTo 0
End Sub
HTHCode:Option Explicit
Private WithEvents ST As cScriptThread
Private Sub Form_Load()
Caption = "Click Me to scan C:\Temp\... for Image-Files"
Dim L As cArrayList
Set L = New_c.ArrayList(vbString)
L.Add "Function FindFilesRecursiveIn(DirPath, Filter)"
L.Add " Dim Col: Set Col = New_c.Collection(False)"
L.Add " DirScanRecursive DirPath, Col, Filter"
L.Add " SetNewState vbNullString"
L.Add " FindFilesRecursiveIn = Array(Col.Content, DirPath, Filter)"
L.Add "End Function"
L.Add "Private Sub DirScanRecursive(DirPath, ResultCol, Filter)"
L.Add " If Cancelled Then Exit Sub" '<- ensure an early exit in case of an outside cancel-request
L.Add " On Error Resume Next"
L.Add " Dim i, DL: Set DL = New_c.FSO.GetDirList(CStr(DirPath), , CStr(Filter))"
L.Add " If Err Then Err.Clear: Exit Sub"
L.Add ""
L.Add " For i = 0 To DL.FilesCount - 1"
L.Add " ResultCol.Add DL.Path & DL.FileName(i)"
L.Add " Next"
L.Add " SetNewState 'Files found so far: ' & ResultCol.Count"
L.Add " For i = 0 To DL.SubDirsCount - 1"
L.Add " DirScanRecursive DL.Path & DL.SubDirName(i), ResultCol, Filter"
L.Add " Next"
L.Add "End Sub"
Set ST = New cScriptThread
ST.AddCode L.Join(vbCrLf)
End Sub
Private Sub Form_Click() 'check for image-files recursively from a given start-directory
ST.RunAsync "FindFilesRecursiveIn", "C:\temp", "*.svg; *.png; *.jpg"
End Sub
Private Sub ST_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
If ErrNumber Then Debug.Print ErrString: Exit Sub
Dim Col As cCollection
Set Col = New_c.Collection(, , , Result(0))
Debug.Print "Async recursive DirScan finished on "; Result(1); " ("; Col.Count; Result(2); " Files )"
End Sub
Private Sub ST_ThreadStateChanged(ByVal NewState As String)
Caption = IIf(Len(NewState), NewState, "Async DirScan finished")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set ST = Nothing 'terminate the ScriptThread
End Sub
Olaf
Olaf - thank you very much for the clarifications re: cThreadHandler, very informative.
I just tried your threaded cActiveScript approach on Windows 10.1809 and it worked flawlessly when compiled, but I get the following error on Terminate in the IDE (maybe this is normal in the IDE?):
Code:Run-time error '453':
Error Calling: Run()
ThreadError: Can't find DLL entry point AtlAxWinTerm in atl
Ah - did receive that error as well yesterday, and fixed it in the RC5-sources already ...Quote:
Originally Posted by jpbro
(AtlAxWinTerm is an inline-function and not a public export in the atl.dll)
What if you replace (in cScriptThread Class_Initialize) a new Cleanup-Script:
Does that help in IDE-mode?Code:.Add "Sub Cleanup()" 'needed and called shortly before Thread-Termination
.Add " On Error Resume Next"
.Add " New_c.CleanupRichClientDll"
.Add " If Err Then Err.Clear"
.Add "End Sub"
Olaf
If Not TH. WaitForEmpty JobQueue (15) = True Then'over 15S automatically clears all
TH. Cancel Execution
Else
End If
If the thread executes for a long time, is the main program hung up and waited for 15S to execute again? If so, it is equivalent to blocking mode, which will affect the mouse click interface response. I used to use the following methods, there is no difference between the two methods, thank you.
Dim tAddTickCount As Long, tTickCount As Long
TAddTickCount = 15
TTickCount = New_c.HPTimer
Do
New_c.SleepEx 10
DoEvents
If TH.WaitForEmpty JobQueue = True Then Exit Do
If New_c.HPTimer - tTickCount > tAddTickCount Then
TH. Cancel Execution
Endif
End If
Loop Until TH.JobQueueCount < 1
Unfortunately that change did not seem to help in IDE mode - not a big deal if it's fixed in RC5 already for the next update though.Quote:
Originally Posted by Schmidt
Just restored my older RC5-Binary from last week...Quote:
Originally Posted by jpbro
and with the changed Class_Terminate below it works for me now in the IDE...
(suppressing the unwanted error-bubbling from the TH.Cleanup-call)
The above should work with all older RC5-versions.Code:Private Sub Class_Terminate()
On Error Resume Next
Set tmrState = Nothing
CancelFlag = True
If Not TH.WaitForEmptyJobQueue(10) Then TH.CancelExecution
TH.CallSynchronous "Run", "Cleanup"
Set TH = Nothing
On Error GoTo 0
End Sub
Nevertheless I've uploaded a new RC5-Binary now to the usual place...
Olaf
You can also write the above this way:Quote:
Originally Posted by yinxiaodan
And when written that way - it will do basically the same thing, you've tried to implement by hand in your follow-up code-snippet.Code:'wait for max 15 seconds, then cancel the Job-Execution in case the wait-procedure was not successful (returned False)
If TH.WaitForEmptyJobQueue(15) = False Then TH.CancelExecution
The Function-Signature for cThreadHandler.WaitForEmptyJobQueue is this one:
(as e.g. Intellisense will show you - but also the VB6-IDE-ObjectExplorer):
Note, that the above contains an Optional Param which is named WaitMaxSeconds (with a default at 3seconds).Code:Public Function WaitForEmptyJobQueue(Optional ByVal WaitMaxSeconds As Double = 3) As Boolean
The Max-part should tell you, that only in case the JobQueue will not fall back to zero within that time, it will wait "to the max".
If the JobQueueCount reaches zero earlier than in the given WaitMaxSeconds-Param, the Function will return earlier of course (with True).
As for "blocking the main-thread" - I'm not sure where you see a problem...
Because normally you want your already running thread, to finish its job.
And a Job is finished, when you receive the TH_MethodFinished-Event.
Normally the WaitForEmptyJobQueue-call only comes into play, when you want to shutdown your App (with a potentially still running thread-job).
HTH
Olaf
Qustion 020: Does RC5 support RegExp?
I'd to know if RC5 supports RegExp? Thanks!
Qustion 021: Can cActiveScript execute JavaScript code?
I'd to know if cActiveScript can execute JavaScript code, such as parseInt, ParseFloat, String.Replace and so on.
In addition, what advantages does cActiveScript have over VBScript? Thanks.
Q#20: No ... (but via JScript + cActiveScript there's a workaround - see below)
Q#21:
- JavaScript is supported in two modes (first Lang-String-param of the New_c.ActiveScript-constructor)
1) "JScript" (the old classic MS-JScript-interpreter, which works also on older systems)
2) "JScript9" (the much faster JS-engine, which came on systems with IE9 and higher)
cActiveScript implements the IActiveScripting interfaces directly - it is in many parts compatible to the MS-ScriptControl,
but implements a few extra-things like EventBinding and others...
New_c.ActiveScript() with no optional Params given will use the defaults and return a "VBScript"-Scripting-instance:
- with the RC5 cConstructor and cCairo instances available directly within ScriptCode as usual via New_c and Cairo
- with all VbRuntime Consts and Enums available in ScriptCode
- with all RC5-Consts and Enums available in ScriptCode
New_c.ActiveScript("JScript") does the same as the above (New_c and Cairo available in JScript-Code)
New_c.ActiveScript("JScript9") ... dito - but with the JScript9 engine
If one does not need RC5-Objects or VBRuntime+RC5-constants in JScript- or JScript9- mode (which is usually the case),
the instancing lines should be: New_c.ActiveScript("JScript", False, False) or New_c.ActiveScript("JScript9", False, False) respectively...
Here an example, which does RegEx-stuff using the JScript(9) engines:
HTHCode:Option Explicit
Private WithEvents SC As cActiveScript, CO As Object
Private Sub Form_Load()
Set SC = New_c.ActiveScript("JScript", False, False)
' Set SC = New_c.ActiveScript("JScript9", False, False) '<- this should work on Vista+-machines as well
SC.AddCode "function RegExReplace(s, pat, srepl) {" & vbCrLf & _
" var re = new RegExp(pat, 'g')" & vbCrLf & _
" return s.replace(re, srepl)" & vbCrLf & _
"}"
SC.AddCode "function RegExMatch(s, pat) {" & vbCrLf & _
" var re = new RegExp(pat, 'g')" & vbCrLf & _
" return s.match(re)" & vbCrLf & _
"}"
Set CO = SC.CodeObject 'calls work fastest, when we use the CodeObject
End Sub
'convenience-wrappers around (latebound) calls of the CodeObject
Function RegExReplace(S As String, Pat As String, sRepl As String) As String
RegExReplace = CO.RegExReplace(S, Pat, sRepl)
End Function
Function RegExMatch(S As String, Pat As String) As String
RegExMatch = CO.RegExMatch(S, Pat)
End Function
Private Sub Form_Click()
On Error Resume Next
'replace all "special chars" and "all Number-Digits"
Debug.Print RegExReplace("abc._*_+_?_^_$_{_}_(_)_|_[_\123xyz", "[.*+?^${}|()\\\[\]]|[0-9]", "")
'switch words
Debug.Print RegExReplace("John Doe", "(\w+)\s(\w+)", "$2, $1")
Dim Match 'simple Word-Matcher
For Each Match In Split(RegExMatch("John Doe", "(\w+)"), ",")
Debug.Print Match
Next
If Err Then Debug.Print Err.Description
End Sub
Private Sub SC_error(Description As String, ByVal LineNr As Long, ByVal CharPos As Long)
If Len(Description) Then Debug.Print "Error in Line: " & LineNr & "-Pos: " & CharPos & " -> " & Description
End Sub
Olaf
Hi Olaf. I tested your code and RC5.ActiveScript implements the RegExp operation very well, thank you very much.
But JScript doesn't seem to support some JavaScript functions, for example: String.fromCodePoint
I executed the following JavaScript code with ActiveScript but it didn't work:
JavaScript Code:
RC5.ActiveScript prompts the following error message:
Error in Line: 3-Pos: 9 -> Object does not support the "fromCodePoint" property or method
Method 'escapeVal' of object 'JScriptTypeInfo' failed
The test code is as follows:
Code:Option Explicit
Private WithEvents SC As cActiveScript, CO As Object
Private Sub Form_Load()
'Set SC = New_c.ActiveScript("JScript", False, False)
Set SC = New_c.ActiveScript("JScript9", False, False) '<- this should work on Vista+-machines as well
SC.AddCode GetCode_EscapeVal()
Set CO = SC.CodeObject 'calls work fastest, when we use the CodeObject
End Sub
'convenience-wrappers around (latebound) calls of the CodeObject
Private Function RegExEscapeVal(S As String) As String
RegExEscapeVal = CO.escapeVal(S)
End Function
Private Function GetCode_EscapeVal() As String
With New_c.StringBuilder
.AppendNL "function escapeVal(str) {"
.AppendNL " return str.replace(/&#([0-9]+);/g, function (_, m0) {"
.AppendNL " return String.fromCodePoint(parseInt(m0, 10));"
.AppendNL " }).replace(/&#x([0-9a-f]+);/g, function (_, m0) {"
.AppendNL " return String.fromCodePoint(parseInt(m0, 16));"
.AppendNL " }).replace(/&|<|>|"|'/g, function (_) {"
.AppendNL " switch (_) {"
.AppendNL " case '&': return '&';"
.AppendNL " case '<': return '<';"
.AppendNL " case '>': return '>';"
.AppendNL " case '"': return '" & Chr(34) & "';"
.AppendNL " case ''': return '\'';"
.AppendNL " }"
.AppendNL " return _;"
.AppendNL " });"
.AppendNL "}"
GetCode_EscapeVal = .ToString
End With
End Function
Private Sub Form_Click()
Const TEST_STRING = "&#" & "72" & ";" & "&#" & "101" & ";" & "&#" & "108" & ";" & "&#" & "108" & ";" & "&#" & "111" & ";" & "&#" & "20320" & ";" & "&#" & "22909" & ";"
On Error Resume Next
MsgBox RegExEscapeVal(TEST_STRING)
If Err Then Debug.Print Err.Description
End Sub
Private Sub SC_error(Description As String, ByVal LineNr As Long, ByVal CharPos As Long)
If Len(Description) Then Debug.Print "Error in Line: " & LineNr & "-Pos: " & CharPos & " -> " & Description
End Sub
Well, that's why so called PolyFills (just google the term) exists, which beam the js-Versions of older Browsers into the "new age"...Quote:
Originally Posted by dreammanor
Please make no mistake - even the newer (and quite fast) JScript9-engine is old (in comparison to V12 or Mozillas-JSengine).
Though for the isolated case above, you can do manually, what Polyfills ensure on a "grander scale" within older Browsers...
just add the missing Method to the global String-Object of the js-engine beforehand:
HTHCode:With New_c.StringBuilder
.AppendNL "String.fromCodePoint = function(x){"
.AppendNL " var code, elements = [];"
.AppendNL " for (var i = 0; i < arguments.length; i++){"
.AppendNL " code = +arguments[i];"
.AppendNL " elements.push(code < 0x10000"
.AppendNL " ? String.fromCharCode(code)"
.AppendNL " : String.fromCharCode(((code -= 0x10000) >> 10) + 0xD800, code % 0x400 + 0xDC00)"
.AppendNL " );"
.AppendNL " } return elements.join('')"
.AppendNL "}"
SC.AddCode .ToString
End With
Olaf
Excellent solution !
I used to be reluctant to use VBScript and JScript because they don't support the latest JS functions and syntax. Now I can boldly use VBScript (JScript) and RC5.ActiveScript. Thank you very much, Olaf.
Qustion 022: Can RC5.ActiveScript implement JavaScript debugging?
Currently JavaScript debugging is mainly done in the browser, which is very inconvenient. Can RC5.ActiveScript add some features to debug JavaScript? E.g: AddBreakpoint, ClearBreakpoints, and debugging related events. Thanks.
Question 023: cWidgets.LoadFromXML cannot load custom control cwShape
In my FormDesigner, if the name of the custom control is cwTextBox, cWidgets.LoadFromXML can load the control. If the control name is cwShape, cWidgets.LoadFromXML cannot load this control. What is the reason for this? Thanks.
Note:
I didn't use vbWidgets.dll
Question 024: Looking for advice: Develop a simple HtmlEditor with RC5
I need to develop a simple HtmlEditor (or RichTextBox) with RC5, which only needs to handle font styles (FontSize, FontBold, FontColor, FontUnderline, FontItalic, line-spacing), no need to process images and tables.
I'd like to get some helpful suggestions, thank you!
As it is currently, neither of your two (Project-Private cw-Classes) is loaded from XML (albeit the saving worked correctly)...Quote:
Originally Posted by dreammanor
What you see as "loaded cwTextBox" is indeed a cwTextBox, but the Class-instance was "drawn" from your registered vbWidgets.dll (check it out, you can type in it)...
Whereas cwShape is not a known ClassName in vbWidgets.dll - hence no loading from there...
To influence the XML-Loading-behaviour (which by default looks for Widget-ClassNames only in vbWidgets.dll),
you will have to use the IWidgetLoader-interface, which the RC5 exports.
I've seen, that you attempted to instantiate IWidgetLoader - but since it's prefixed with an "I" and not a "c", it wants to be implemented instead.
Here the adapted cfMain-Code from your zipped Sources (note the additional Lines, I've marked in blue)
So, if you want to get serious with a Form-Designer, a proper implementation of IWidgetLoader is mandatory.Code:Option Explicit
Public WithEvents Form As cWidgetForm, WithEvents Page As cWidgetForm
Public PageWidthInch As Double, PageHeightInch As Double
Public WithEvents BtnLoad As cwButton, WithEvents BtnSave As cwButton
Implements IWidgetLoader
Private Function IWidgetLoader_CreateWidget(TypeName As String) As Object
Select Case LCase$(TypeName)
Case "cwtextbox": Set IWidgetLoader_CreateWidget = New cwTextBox
Case "cwshape": Set IWidgetLoader_CreateWidget = New cwShape
End Select
End Function
Private Sub BtnLoad_Click()
Dim sFile As String: sFile = App.Path & "\Page1.xml"
If New_c.FSO.FileExists(sFile) Then
Page.Widgets.RemoveAll
Page.Widgets.LoadFromXML New_c.FSO.ReadByteContent(sFile), Me
Page.Refresh
End If
End Sub
Private Sub BtnSave_Click()
Dim sFile As String: sFile = App.Path & "\Page1.xml"
New_c.FSO.WriteByteContent sFile, Page.Widgets.SerializeToXML(True)
End Sub
Private Sub Class_Initialize()
Set Form = Cairo.WidgetForms.Create(vbSizable, "Shape-Handling at constant 96dpi (Page=8.5x11 inch)", True, 1024, 768)
Form.SetMinMaxDimensions 720, 560
Form.IconImageKey = "frmIco" 'ensure a Form-Icon per ImageList-Key (Icon was loaded in Sub Main)
Form.WidgetRoot.BackColor = &H888888
PageWidthInch = 8.5: PageHeightInch = 11 'let's define an absolute Page-Size
Set Page = Cairo.WidgetForms.CreateChild(Form.hWnd)
Page.WidgetRoot.BackColor = vbWhite
Page.WidgetRoot.DesignMode = True
Page.WidgetRoot.DesignModeGridWidth = 4
End Sub
Private Sub Form_Load() 'shape-coords are absolute inches
AddNewShape "S1", 0.5, 0.5, 2, 1
AddNewShape "S2", 2, 2, 2, 1
AddNewShape "S3", 3.5, 3.5, 2, 1
AddNewTextBox "T1", 0.5, 5, 2, 1
AddNewTextBox "T2", 2, 6.5, 2, 1
AddNewTextBox "T3", 3.5, 8, 2, 1
Set BtnSave = Form.Widgets.Add(New cwButton, "BtnSave", 16, 8, 160, 24)
BtnSave.Caption = "Save to XML"
Set BtnLoad = Form.Widgets.Add(New cwButton, "BtnLoad", 16, 40, 160, 24)
BtnLoad.Caption = "Load From XML"
End Sub
Private Sub Form_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
Dim x, y, dx, dy
Cairo.CalcAspectFit PageWidthInch / PageHeightInch, NewWidth, NewHeight, x, y, dx, dy, 20
Page.Move x, y, dx, dy
End Sub
Private Sub Page_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
Page.WidgetRoot.Zoom = NewWidth / (PageWidthInch * 96)
End Sub
Private Sub AddNewShape(Name As String, x, y, dx, dy) 'coords in inches
Dim NewWidget As cwShape
Set NewWidget = Page.Widgets.Add(New cwShape, Name, x * 96, y * 96, dx * 96, dy * 96)
End Sub
Private Sub AddNewTextBox(Name As String, x, y, dx, dy) 'coords in inches
Dim NewWidget As cwTextBox
Set NewWidget = Page.Widgets.Add(New cwTextBox, Name, x * 96, y * 96, dx * 96, dy * 96)
End Sub
I'd also suggest to implement IWidgetLoader in its own Loader-Class(es)... since this will allow you later,
to pass different ones to the XML-Loading-Routine (dependent on context).
These different Loaders could be named e.g. cLoadWidgetsRuntime, cLoadWidgetsDesignTime, cLoadWidgetsDeployedRegfree).
You get the idea, I think...
Olaf
I thought I've given advice in this regard already (several times).Quote:
Originally Posted by dreammanor
Use one of the larger JS-frameworks, stick with it - and learn how to use it...
(my recommendation is still the same: OpenUI5, sine it is the most VB6-like usable, compared to the alternatives).
And if you do that (working with one of the larger JS-frameworks), HTML-editing is not in the picture anymore -
you do not see (or need) any HTML-code at all - all you need to work with, is the JS-code, which addresses the Framework in question.
And in case of OpenUI5, these JS-code-lines (which "address the Framework") are really quite similar to "loading Widgets" (or Controls).
You can write a (very very simple) "translator", which is putting these Control-adding JS-Lines out with ease (e.g. from a DB, which stored a certain arrangement of those Control-defs)
There is no complex syntax-parser needed for that.
Please look again at the fiddle I've posted some time ago in #261 of this thread:
http://www.vbforums.com/showthread.p...=1#post5349003
And then really *play-around-with-it* - there's really only a handful of codelines to understand.
Roughly a year before that, you've participated in this thread here too (see my post #15 for Grid-Output):
http://www.vbforums.com/showthread.p...=1#post5164423
OpenUI5 is really nice and relatively easy (compared to the alternatives) - it is open-sourced, but actively maintained by SAP-developers -
about 100 Controls to choose from - most of them working on both - Desktop- and Mobile-Browsers (usually those in the sap.m Namespace).
HTH
Olaf
Hi Olaf, after using IWidgetLoader-interface, everything is OK now, thank you very much.Quote:
Originally Posted by Schmidt
Yes, I'm going to use OpenUI5 in my next development project (converting my old VB6 enterprise apps to SPAs).Quote:
Originally Posted by Schmidt
Now I'm still developing my WebBuilder. My FormDesigner is actually a Web-Page-Builder, which allows users to drag web page components with mouse to complete the design of a web page. I don't know if OpenUI5 could do this kind of work.
I'm not sure, whether you *want* to design WebPages this way ...Quote:
Originally Posted by dreammanor
(by dragging components or Dom-Nodes around using "free, absolute Pixel-Positioning").
A modern web-page (no matter if SinglePage-App or "just a normal one"),
needs to work on "all screens, all sizes" (plus support for the horizontal or vertical flip-modes, mobile devices allow).
Classic "VB6-like" Form-Design is not really working for these highly dynamic GUI-scenarios
(it can be achieved of course, when you introduce Layout-Classes - but as soon as you
introduce such classes, your "pixel-exact Form-Designer" will not be needed anymore -
and has to be re-written around those Layout-Classes (with a completely different Designer-approach).
But to answer your question...
Yes, OpenUI5 contains a HTML-Control, which integrates into a given SPA-layout as a rectangle you can influence (size-wise).
And within that "small or midsized" HTML-container-rect, you can then still support databinding,
but have more "freedom of movement" inside that Client-Rect (with your "normal HTML-nodes").
HTH
Olaf
Yes, what you said is very reasonable. Currently, my WebBuilder provides three designers: WebForm-Designer, FlexBox-Designer, and CssGrid-Designer, where WebForm-Designer uses "free, absolute Pixel-Positioning". I want to make WebForm-Designer as a complement to the other two designers.Quote:
Originally Posted by Schmidt
The knowledge you provide is very important to me. My WebBuilder will be ready for a few weeks. After I complete the WebBuilder, I'll delve into OpenUI5, thank you very much, Olaf.Quote:
Originally Posted by Schmidt
Question 025: Does cWebKit.Document support ExecCommand like VB.WebBrowser?
VB.WebBrowser supports ExecCommand, QueryCommandSupported, QueryCommandValue and other commands. I'd like to know if cWebKit.Document supports those commands? Thanks.
Question 026: Using ClEditor in cWebKit
The VB.WebBrowser.ExecCommand does not support the useCSS and styleWidthCSS commands, so I want to try ClEditor in cWebKit. Now the ClEditor editing window can be successfully displayed in the cwBrowser window, but the ToolStrip is not displayed and the font styles cannot be set.
My WebApp directory is as follows:
\WebApp\WebRoot\images
\WebApp\WebRoot\index.html
\WebApp\WebRoot\jquery.cleditor.css
\WebApp\WebRoot\jquery.cleditor.js
\WebApp\WebRoot\jquery.cleditor.min.js
Index.html
Code:<html>
<head>
<link rel="stylesheet" href="jquery.cleditor.css" />
<script src="jquery.min.js"></script>
<script src="jquery.cleditor.min.js"></script>
<script>
$(document).ready(function () { $("#input").cleditor(); });
</script>
</head>
<body>
<textarea id="input" name="input"></textarea>
</body>
</html>
You don't need the WebServer-instance, to make that work.
Here some code, which will work on an empty (normal) VB-Form -
only a reference to vbWidgets and vbRichClient5 is required:
The magenta-colored part is the important one...Code:Option Explicit
Private WithEvents Panel As cWidgetForm, WithEvents WB As cwBrowser
Private Sub Form_Load()
Set Panel = Cairo.WidgetForms.CreateChild(hWnd)
Set WB = Panel.Widgets.Add(New cwBrowser, "WB")
WB.WebKit.Navigate2 "file:///" & Replace(App.Path & "\CLEditor\index.html", "\", "/")
End Sub
Private Sub Form_Resize()
ScaleMode = vbPixels
Panel.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub Panel_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
WB.Widget.Move -1, -1, NewWidth + 3, NewHeight
End Sub
(a SubFolder, named \CLEditor sits below the App-Path, and contains the unzipped CLEditor-package).
Here is my (slightly adjusted) index.html:
Code:<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="jquery.cleditor.css" />
<script src="jquery-3.1.1.min.js"></script>
<script src="jquery.cleditor.min.js"></script>
<script>
$(document).ready(function () { cleditor($("#input"),{height:"100%"}); });
</script>
</head>
<body style="margin:0; padding:0; border:0; overflow:hidden;">
<div style="position:absolute; left:0px; right:0px; width:100%; top:0px; bottom:0px; height:100%;">
<textarea id="input" name="input"></textarea>
</div>
</body>
</html>
HTH
Olaf
Wonderful. Much appreciate.Quote:
Originally Posted by Schmidt
Question 027: cWidgets.LoadFromXML cannot load custom properties after compiling into exe
In VB6-IDE, cWidgets.LoadFromXML can successfully load the custom property MyCaption from the XML file. But when the source code is compiled into an exe, cWidgets.LoadFromXML cannot load the custom property MyCaption from the XML file. I don't know why?
Has anyone else encountered a similar situation?
I tried your demo (looking pretty nice if I may add) and all I can say so far is that I have reproduced the problem when the app is compiled, not sure why it is happening though. I put a MsgBox in the cwShape.MyCaption Property Let method and the property doesn't get set at all when compiled.
I'm not at the bottom of it yet, but I see your MyCaption property has a "DT_" prefix in the XML file, which indicates it is a "design-time" property. That might explain why it doesn't load in the compiled version, but I'm not yet familiar enough with the RC5 widgets to know how to change the property to a run-time available one yet. I'm investigating...
I see the RC5 WidgetBase object has a RuntimePropertiesCommaSeparated property. I've tried setting this in the cwShape.Class_Initialize event as follows:
But now the MyCaption property isn't serialized at all. I'm too inexperienced with the RC5 Widget engine TBH, so perhaps Olaf is your best bet here, but I will continue experimenting.Code:w.RuntimePropertiesCommaSeparated "MyCaption"
The reason it does not work compiled is, that Project-Private WidgetClasses (currently!) cannot be enumerated
(Property-wise, via the RC5.cProps/cProp stuff which uses TypelibInformation-APIs),
when the VB6-IDE "is not around" (to provide those for Project-Private COM-Classes).
So, if one wants to use the builtin "Auto-Property XML-serialization" (where your own Props are prefixed with "DT_" in the XML-stream), one has to implement his own Widget-Classes in his own ActiveX-Dll - these would work in IDE-mode, but also compiled.
I'd think, that despite this little flaw, the Auto-XML-serialization is still a nice feature,
since it does not require any explicit "ReadProperties/WriteProperties"-fiddling, as seen with VB6 old UserControls.
This should make it easier (implementation-wise) for future contributors to the Widget-Control-Stack.
As for the W.RuntimePropertiesCommaSeparated ...
This gives a Developer the chance, to ease the burden of the XML-AutoSerializer
(by providing a Name-List of Public Props, which are either too complex to be serialized,
or don't make any sense to be serialized, because they are only useful to set at runtime).
HTH
Olaf
Quote:
Originally Posted by jpbro
Quote:
Originally Posted by jpbro
Hi jpbro, glad to see you, thanks for investigation and experiment. I'm trying to handwrite an XMLPropertyBag to store RC5 Widgets properties.Quote:
Originally Posted by jpbro
Understand. I'm trying to handwrite an XMLPropertyBag to store RC5 Widgets properties. Thank you, Olaf.Quote:
Originally Posted by Schmidt
Edit:
If LoadFromXML can read some of the preset properties (for example: Tag, XmlTag, JsonTag, BinaryTag, etc.), it will be extremely convenient for RC5 developers. If so, I can save the custom attribute in XmlTag, JsonTag or BinaryTag.
Below is how to use the RC5 subclasser, taken from another thread. I thought it good to place here as well.
The following simple example (MouseEnter/MouseLeave) shows its usage ...
Code:Option Explicit
Private Declare Function TrackMouseEvent& Lib "user32" (lpTrack As Any)
Private WithEvents SC As cSubClass, PB As VB.PictureBox
Private Sub Form_Load()
Set PB = Controls.Add("VB.PictureBox", "PB"): PB.Visible = True
Set SC = New_c.SubClass: SC.Hook PB.hWnd
End Sub
Private Sub SC_WindowProc(Result As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Const WM_MOUSEMOVE = &H200, WM_MOUSELEAVE = &H2A3
Select Case Msg
Case WM_MOUSEMOVE: HandleMouseEnterOn PB 'handle the mouse move with our own code
Case WM_MOUSELEAVE: HandleMouseLeaveOn PB 'handle the mouse leave with our own code
End Select
Result = SC.CallWindowProc(Msg, wParam, lParam) 'allow the default message handling. if you don't want this to happen, Exit Sub before this.
End Sub
Private Sub HandleMouseEnterOn(Ctl As Object)
Dim T&(0 To 3): T(0) = 16: T(1) = 2: T(2) = Ctl.hWnd
TrackMouseEvent T(0)
Ctl.BackColor = vbGreen
End Sub
Private Sub HandleMouseLeaveOn(Ctl As Object)
Ctl.BackColor = vbRed
End Sub
Question 028: CC.GetTextExtents cannot calculate the width of Chinese characters
If the font is "Arial", CC.GetTextExtents can correctly calculate the width of the Chinese character.
However, if the font is "MS Sans Serif", CC.GetTextExtents cannot correctly calculate the width of Chinese characters.
Debug window:Code:Option Explicit
Public Function GetTextExtends(ByVal Text As String, ByRef FontHeight As Double, _
FontName As String, FontSize As Double, _
Optional Bold As Boolean, Optional Italic As Boolean, _
Optional Underline As Boolean, Optional StrikeThrough As Boolean) As Double
Dim Srf As cCairoSurface
Dim CC As cCairoContext
Set Srf = Cairo.CreateSurface(1, 1)
Set CC = Srf.CreateContext()
If FontName <> vbNullString And FontSize > 0 Then
CC.SelectFont FontName, FontSize, , Bold, Italic, Underline, StrikeThrough
End If
'GetTextExtends = CC.GetTextExtentPtr(StrPtr(Text), Len(Text))
GetTextExtends = CC.GetTextExtents(Text, FontHeight)
End Function
Code:?GetTextExtends("Hello world",0, "Arial", 9)
62
?GetTextExtends("Hello world",0, "MS Sans Serif", 9)
52
?GetTextExtends("你好，世界",0, "Arial", 9)
60
?GetTextExtends("你好，世界",0, "MS Sans Serif", 9)
15
Don't use the old "MS Sans Serif" (it's not a TrueType-Font).Quote:
Originally Posted by dreammanor
The Font "Microsoft Sans Serif" can be used as an alternative (TrueType)-Font instead.
Yes, I know "MS Sans Serif" is the default-font in the VB6-Form- and UserControl-engine - but it can't be helped.
In the RC5-WidgetEngine the Default-Fontname (e.g. in cWidgetBase) is "Arial" for a reason.
Olaf
OK, thank you, Olaf.
hi dreammanor
do you think other people can add questions about vbRichClient here? (or you prefer to keep it some kind of your?)
because I wanted to ask for a fairly simple one.
[If you prefer me not do it here anymore (or that I do it using some particular manner/format) let me know]
Ok, my question:
Wich is the best/fastest way to draw on a cCairoSurface an OutLine text ? (maybe using DrawText)
I'm not sure if this is the best/fastest way, but you can call DrawText with the PathOnly parameter = True, then call Stroke to draw the outline. E.g. (where "c" is a CCairoContext object):
Code:c.SelectFont "Arial", 72
c.DrawText 0, 0, 1000, 1000, "TEST", , , , , , , True ' True here = Draw Path Only
c.SetSourceColor vbRed
c.SetLineWidth 2
c.Stroke
Thank you!Quote:
Originally Posted by jpbro
I just came to same solution. First tried pathonly=true, but nothing appeared so then I used "stroke" and it worked.
... but to me seems not well Antialiased... maybe I'm wrong.
Hmm...it looks decently antialiased to me, but you (being a graphics expert) would have a better idea of what is "well" antialiased than I do. Maybe you could try setting the CairoContext.AntiAlias property to CAIRO_ANTIALIAS_SUBPIXEL to see if that looks better?Quote:
Originally Posted by reexre