User control of a circular progress with which you can achieve various styles of those that haunt the web, it contains a properties page which allows you to form a degraded palette for the progress line. base on GDI+
Has the test been used for long database queries? For example, click the query button to start ShowAnimation, and stop the animation after the query ends。
Has the test been used for long database queries? For example, click the query button to start ShowAnimation, and stop the animation after the query ends。
no control will be repainted if something freezes the application, if this happens then it is your responsibility to make smaller queries, paginate data etc, it is another matter.
no control will be repainted if something freezes the application, if this happens then it is your responsibility to make smaller queries, paginate data etc, it is another matter.
I those DB-queries are based on ADO (and not DAO), they could be made in an asynchronous fashion (in ADO-async-mode).
This would allow GUI-Progress-Refreshs.
Besides, there are easy to use threading-tools on could use alternatively...
Has the test been used for long database queries? For example, click the query button to start ShowAnimation, and stop the animation after the query ends。
While VB6 use only one thread, the controls inside an OCX are running on a different thread. So, if you test the project or add the uc to yours, it will freeze. But compiled as a separated OCX should not freeze.
While VB6 use only one thread, the controls inside an OCX are running on a different thread. So, if you test the project or add the uc to yours, it will freeze. But compiled as a separated OCX should not freeze.
Mmmm no, the DC is the same, if app is freezes the form not repaint.
Mmmm no, the DC is the same, if app is freezes the form not repaint.
There is a propery called "hasDC" wich I think it allow to work on a separate DC (in theory)
I'm not sure what happen if the app really freeze. but I used this technique for a text scroller. When the UC was inside the project the scrolling behave erratic, non fluid... so I put in a OCX and no matter what happened on the EXE the scroll was flawless smooth.
Private Sub CmdDelete_Click()
Dim i As Long
If PF_ColorsCount = 1 Then Exit Sub
For i = m_Index To UBound(m_PF_Colors) - 1
m_PF_Colors(i) = m_PF_Colors(i + 1)
Next
PF_ColorsCount = PF_ColorsCount - 1
If m_Index > PF_ColorsCount - 1 Then m_Index = PF_ColorsCount - 1
ReDim Preserve m_PF_Colors(PF_ColorsCount - 1)
oPC.AddPaletteColors m_PF_Colors
DrawPalette
UpdateColor
Changed = True
End Sub
I have often wanted a simple progress bar without having to add all the Common Controls. LeandroA has done a fantastic job with these Progress Bars, but there is far too much code for just a single circular progress bar. So I picked one that I liked (Index #6), and set out to create an OCX (called CircProg.ocx) for just that one.
The first task was to refresh my knowledge of how User Controls work. When a UC is added to a form, the Initialize, InitProperties, Resize, Show, & Paint events will fire. When you close the form and reactivate it, all but the InitProperties will fire. The InitProperties event is used to establish the starting properties for the control as it is added to the form. Thereafter, the stored properties are recovered by the ReadProperties event and saved by the WriteProperties event.
The properties are displayed in the Properties Window for the UC only if there is a Get and Let function listed for the property. It doesn't necessarily have to have any code attached to the function, unless you want the ability to make changes to the property. This I learned the hard way, after I deleted all the functions that I could not see being used.
Then I adjusted all the InitProperties code to get the default conditions that I was after. After that, it was a laborious effort to eliminate all the unnecessary code that wasn't used for this particular UC. I am sure there are a few things that I missed. One thing that I am not sure of is the function ManageGDIToken. I don't know what it actually does, but I do know that it is necessary.
To use the OCX, compile and save it in it's working directory. Before utilizing it, copy it to the \Windows\SysWow64\ directory (\windows\System32\ on 32 bit systems). This will allow you to access it from anywhere on the disk, and it is where all the other OCX files are. An OCX is accessed via it's CLSID. Load the TestOCX.vbp program. Now add the CircProg.OCX component. To add this OCX to your VB Components, use the Browse button to select the CircProg.OCX from the \Windows\Syswow64\ directory. This process will register the OCX and a new icon should appear in the Components window. Double Click it to add the default UC to frmOCX. Make any changes that you want (eg. PF/PB Colors, Value), and change the name to CPB1. Save the result. Now run the program. Click and hold the right Scroll arrow, and the new circular scroll bar should advance from 0% to 100%.
@couttsj, Keep in mind that my main idea is to make a control with which I can make many designs as I show in the image.
I understand that you want to reduce the code is something that we do by nature, but keep in mind that a shorter code is not more effective or better, in fact I have seen some that consume more cpu , on the other hand many try to shorten the code then use a 1MG bitmap at the bottom of your window which is consuming more Ram than the code you were cleaning.
The sample code I use is as follows:
I want the progress to be in animation mode from before checking the connection with the host until returning the result of the connection with the host
i not checked about use ocx version because i dont need use ocx i just need use user control version.
the animation does not work, The progress bar animation is laggy, how can I solve this problem? If I want to ask better, how can I make the progress bar animation work properly while another process is waiting (without ocx version) ?
Code:
Private Sub Form_Load()
label1.Caption = "[...]"
Me.Show
ucp.ShowAnimation = True ' uc progress bar cant not run show animation normally bcs of post data
DoEvents
Dim rs As String
rs = PostData(Me, "aaa")
If rs = "1" Then
' do something
else
' do something
end if
end sub
Public Function PostData(ByVal frm As Form, ByVal act As String, Optional SQL As String = "") As String
On Error Resume Next
Dim url As String
Dim i As Currency
url = "url path ..."
Dim ht As New WinHttpRequest
ht.Open "POST", url, False
ht.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
'ht.SetRequestHeader "accept", "application/json; charset=UTF-8, text/plain; charset=UTF-8, text/html; charset=UTF-8, */*; charset=UTF-8"
ht.SetRequestHeader "accept", "text/plain; charset=UTF-8, */*; charset=UTF-8"
'ht.SetRequestHeader "Content-type", "application/json; charset=utf-8"
ht.SetRequestHeader "Content-Type", "text/plain; charset=utf-8"
ht.SetRequestHeader "Accept-Charset", "utf-8"
ht.SetRequestHeader "accept-encoding", "deflate"
ht.SetRequestHeader "accept-language", "en-US,en;q=0.9,fr;q=0.8,fa;q=0.7"
ht.SetRequestHeader "cache-control", "max-age=0"
ht.SetRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.2; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/109.0.0.0 Safari/537.36 Edg/109.0.1518.100"
frm.MousePointer = vbHourglass
DoEvents
Sleep 100
If SQL <> "" Then
ht.Send "act=" & act & "&sqlstr=" & SQL
Else
ht.Send "act=" & act
End If
ht.WaitForResponse
DoEvents
frm.MousePointer = vbNormal
PostData = ht.ResponseText
ht.Abort
Set ht = Nothing
End Function
Last edited by Black_Storm; Jun 14th, 2023 at 04:18 PM.
[ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]
I temporarily solved the problem in the following way that there will be less lag, but there is still a lag when checking the connection.
Code:
Private Sub Form_Load()
.
.
.
ucp.Value = 100
Me.Show
ucp.ShowAnimation = True
tmrdelay.Enabled = True ' 2 sec
End Sub
Private Sub tmrdelay_Timer()
tmrdelay.Enabled = False
Dim rs As String
rs = PostData(Me, "aaa")
If rs = "1" Then
Else
ucp.Value = 100
ucp.ShowAnimation = False
lbl(1).Caption = "not connected"
DoEvents
Sleep 2000
Unload Me
End
End If
'downloadfile
End Sub
[ ... active on skype and discord ... ] ,[always strive to achieve your dreams] , [always try,dont stop,never say never]