This is an extension of my Reusable Progress Indicator post. I realised that I needed to add additional compiler constants for compatibility of the Windows API functions used in the HideTitleBar
sub which is called on the Userform_Initialize
event; however, I am unsure if they are correct for all cases. I have tested the code on Windows 64-Bit for both 32-Bit Excel and 64-Bit Excel and it worked without issue, but because I have no access to Win 32-Bit OS, I can't really test if my declarations have the correct keywords and data types for that case.
So with that I ask, are my declarations correct and is the setup of the API declarations the most general/comprehensive method?
#If Win64 And VBA7 Then '64-Bit Windows and 64-Bit Excel
Private Declare PtrSafe Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As LongPtr, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetTickCount _
Lib "kernel32.dll" () As LongPtr
#ElseIf Win64 And Not VBA7 Then '64-Bit Windows and 32-Bit Excel
Private Declare PtrSafe Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare PtrSafe Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetTickCount _
Lib "kernel32.dll" () As Long
#Else '32-Bit Windows and 32-Bit Excel
Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetTickCount _
Lib "kernel32.dll" () As Long
#End If
Private Sub HideTitleBar()
Dim lngWindow As LongPtr, lngFrmHdl As LongPtr
lngFrmHdl = FindWindowA(vbNullString, Me.Caption)
lngWindow = GetWindowLong(lngFrmHdl, GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
SetWindowLong lngFrmHdl, GWL_STYLE, lngWindow
DrawMenuBar lngFrmHdl
End Sub
Example (Please See the Reusable Progress Indicator post for more details):
In frm Code:
Private Sub IProgressIndicator_LoadProgIndicator(Optional ByVal HasParentProccess As Boolean, _
Optional ByVal CanCancel As Boolean, _
Optional ByVal CalculateExecutionTime As Boolean)
this.CalculateExecutionTime = CalculateExecutionTime
If CalculateExecutionTime Then this.StartTime = GetTickCount()
'CALLED HERE
HideTitleBar
this.HasParentProccess = HasParentProccess: this.CanCancel = CanCancel
With Me
If this.HasParentProccess Then
.Height = PROGINDICATOR_MAXHEIGHT
.ParentProcedureStatus.Height = PARENTPROCSTATUS_MAXHEIGHT
.ProcedureStatus.Top = PROCSTATUS_MAXTOP
.frameProgressBar.Top = PROGRESSBAR_MAXTOP
.lblElapsedTime.Top = ELAPSEDTIME_MAXTOP
.ElapsedTime.Top = ELAPSEDTIME_MAXTOP
.lblTimeRemaining.Top = TIMEREMAINING_MAXTOP
.TimeRemaining.Top = TIMEREMAINING_MAXTOP
End If
.ProgressBar.Width = 0
.StartUpPosition = 0
.Left = Application.Left + (STARTPOS_LEFT_OFFSET * Application.Width) - (STARTPOS_LEFT_OFFSET * .Width)
.Top = Application.Top + (STARTPOS_RIGHT_OFFSET * Application.Height) - (STARTPOS_RIGHT_OFFSET * .Height)
.Show
End With
End Sub
In regular Module:
Public Sub TestingOrphanProccess()
Dim i As Long
Dim ProgressBar As IProgressIndicator
On Error GoTo ErrHandle
Set ProgressBar = New ProgressIndicator
ProgressBar.LoadProgIndicator CanCancel:=True, CalculateExecutionTime:=True
For i = 1 To 10000
'only have to specify this property if boolCanCancel:=True
If ProgressBar.ShouldCancel Then Exit Sub
StaticSheet_Sht1.Cells(1, 1) = i
ProgressBar.UpdateOrphanProgress "Proccessing", i, 10000
Next
Exit Sub
ErrHandle:
Debug.Print Err.Number
End Sub
Long
withLongPtr
? Usually, you only change pointers and handles toLongPtr
everything else staysLong
I use Windows API Viewer for MS Excel to create Win-API declarations. \$\endgroup\$