4
\$\begingroup\$

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
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Your VBA7 declarations are wrong. Seems like you just replacedLongwithLongPtr? Usually, you only change pointers and handles toLongPtreverything else staysLong I use Windows API Viewer for MS Excel to create Win-API declarations. \$\endgroup\$ Commented Jul 13, 2019 at 21:20

1 Answer 1

3
\$\begingroup\$

IMO, you're overcomplicating it. For 99% of the cases, you only need something similar to this:

#If VBA7 Then
  'VBA7 declaration style
    Private Declare PtrSafe Function GetWindowLong _
                           Lib "user32" Alias "GetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As Long) As Long
#Else
  'VBA6 declaration style
    Private Declare Function GetWindowLong _
                            Lib "user32" Alias "GetWindowLongA" ( _
                            ByVal hwnd As Long, _
                            ByVal nIndex As Long) As Long
#End If

You don't really need to check Win64 constant solely for API compatibility. As a matter of fact, you want to prefer using VBA7 API declarations whenever possible because they align much more closely to the actual C++ declarations that the API declarations are based on.

The only reason to use Win641 is to do something that can be done exclusively in 64-bit Office (which is very rare and I have trouble thinking of a good example beyond simply just checking whether the Office itself is 64-bit. The single anomaly is a certain API function - SetWindowsLongPtr which for some reasons, doesn't have the same declarations between 32-bit Windows and 64-bit Windows OS, in which case, you do have to use Win64 for that particular API declaration. But others, just VBA7 is sufficient and using VBA7 declaration style means you get more information from reading the declarations than you would have had from VBA6. hWnd As LongPtr is abundantly obvious that it's a pointer, not just an integer like say, nIndex As Long.

Props to @computerversteher:

My original post was a blind copy'n'paste from OP to illustrate the correct situation. However, he pointed out that the declarations themselves were incorrect, in particular, the nIndex parameter which was originally a LongPtr but that is not correct since it's just an integer, not a true pointer. Only pointer data types should be assigned LongPtr. As per the comment:

How to convert Windows API declarations in VBA for 64-bit provides an example for WIN64 (When to use the WIN64 compiler constant in the last third of article (sorry no anchors), that provides basic knowledge).

Thanks, @computerversteher!


  1. Note that Win64 is something of a misnomer. It'll be only True when the Office is a 64-bit install, but will be False even on a 64-bit Windows running 32-bit Office. For sanity's sake, pretend that various WinXX constants are actually named OfficeXX.
\$\endgroup\$
15
  • \$\begingroup\$ Interesting. So just to clarify, my last Else directive is unneeded, because my second 'Else' directive, (which is a VBA6 declaration), also covers 32-bit Windows and 32-bit Excel? \$\endgroup\$ Commented Jul 8, 2019 at 13:21
  • 1
    \$\begingroup\$ Additionally Win64 evaluates to True on Mac OS 64-bit office, False on 32 bit (same behaviour as Windows, just even weirder thet Win... evaluates to true ever on a Mac). \$\endgroup\$
    – Greedo
    Commented Jul 8, 2019 at 13:39
  • 1
    \$\begingroup\$ @Greedo Yep, That's why Win... is a bad name - It would have been much more clearer if it was Office... instead. Life's a bowl of cherries. \$\endgroup\$
    – this
    Commented Jul 8, 2019 at 13:41
  • 2
    \$\begingroup\$ @rickmanalexander (@)this FWIW I've tried to collect my thoughts on the whole OS vs Office bitness confusion with this question \$\endgroup\$
    – Greedo
    Commented Jul 8, 2019 at 14:59
  • 1
    \$\begingroup\$ Memo to myself: Actually read OP's code. You're actually correct; my post was focusing on the question about structuring the declarations, not the declarations. I've updated the post accordingly. :) \$\endgroup\$
    – this
    Commented Jul 14, 2019 at 19:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.