ModShellAPI

Option Explicit

Public Declare Function GetDiskFreeSpace Lib "kernel32.dll" _
                    Alias "GetDiskFreeSpaceA" _
                    (ByVal lpRootPathName As String, _
                     lpSectorsPerCluster As Long, _
                     lpBytesPerSector As Long, _
                     lpNumberOfFreeClusters As Long, _
                     lpTotalNumberOfClusters As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" _
                    Alias "ShellExecuteA" _
                    (ByVal hWnd As Long, _
                     ByVal lpOperation As String, _
                     ByVal lpFile As String, _
                     ByVal lpParameters As String, _
                     ByVal lpDirectory As String, _
                     ByVal nShowCmd As Long) As Long
Private Declare Function OSGetPrivateProfileString Lib "kernel32.dll" _
                    Alias "GetPrivateProfileStringA" _
                    (ByVal Section As String, _
                     ByVal Entry As Any, _
                     ByVal Default As String, _
                     ByVal Buffer As String, _
                     ByVal BufSize As Long, _
                     ByVal Filename As String) As Long
Public Declare Function SetWindowPos Lib "user32" _
                    (ByVal hWnd As Long, _
                     ByVal hWndInsertAfter As Long, _
                     ByVal X As Long, ByVal Y As Long, _
                     ByVal cx As Long, ByVal cy As Long, _
                     ByVal wFlags As Long) As Long
                     
' Sets the cursor position.
' parameters:   x   - X position for the cursor in screen pixel coordinates
'               y   - Y position for the cursor in screen pixel coordinates
' returns:  Nonzero on success, zero on failure.
'           Sets GetLastError.
' Platform: Windows 95, Windows NT, Win16
Private Declare Function SetCursorPos Lib "User32.dll" _
                    (ByVal X As Long, ByVal Y As Long) As Long
                    
' Determines the screen coordinates for a point given in the client coordinates of a window.
' parameters:   hWnd    - Handle of the window that determines the client coordinates to use
'               lpPoint - Point in client coordinates of hWnd.
'                         On return this parameter will contain the same position in screen
'                         coordinates
' returns:  Nonzero on success, zero on failure.
' Platform: Windows 95, Windows NT, Win16
Private Declare Function ClientToScreen Lib "User32.dll" _
                    (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

' Determines the clientcoordinates for a given point on the screen.
' parameters:   hWnd    - Handle of the window defining the client coordinate system to use
'               lpPoint - Structure containing the point on the screen in screen coordinates.
'                         This function loads the structure with the corresponding client
'                         coordinates based on hWnd
' returns:  Nonzero on success, zero on failure.
' Platform: Windows 95, Windows NT, Win16
Private Declare Function ScreenToClient Lib "User32.dll" _
                    (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Const SW_SHOWNORMAL = 1
Private Const mcBufSz = 1024
Private Const mcBufSzAll = 4096

Private mfrmSmallBubble As Form
Private mfrmLargeBubble As Form

Public Function ReadIniFile(ByVal vEntry As Variant, _
                    Optional sDefault As String = "")
    ReadIniFile = GetPrivateProfileString(gsMyName, vEntry, sDefault, gsIniPfad)
End Function

Public Function GetPrivateProfileString(ByVal Section As String, _
                ByVal Entry As Variant, _
                ByVal Default As String, _
                ByVal Filename As String) As String
    Dim sBuffer As String
    
    If IsNull(Entry) Then
        sBuffer = String$(mcBufSzAll, 0)
        glRet = OSGetPrivateProfileString(Section, 0&, Default, sBuffer, mcBufSzAll, Filename)
    Else
        sBuffer = String$(mcBufSz, 0)
        glRet = OSGetPrivateProfileString(Section, CStr(Entry), Default, sBuffer, mcBufSz, Filename)
    End If
    GetPrivateProfileString = Left$(sBuffer, glRet)
End Function

Public Sub CenterCursorOn(ThisForm As Form, ThisControl As Object)
    On Error Resume Next
    
    Dim lX As Long
    Dim lY As Long
        
    lX = CLng(ThisControl.Left + ThisControl.Width / 2!)
    lY = CLng(ThisControl.Top + ThisControl.Height / 2!)
    If PointToPixel(ThisForm, lX, lY) Then
        SetCursorPos lX, lY
    End If
End Sub

Public Sub ShowBubbleOn(sMsg As String, _
            ThisForm As Form, _
            ThisControl As Object, _
            Optional bLarge As Boolean)
    On Error Resume Next
    Dim lX As Long
    Dim lY As Long
    Dim lBubbleWidth As Long
    Dim lBubbleHeight As Long
    Dim lBubbleTop As Long
    Dim lBubbleLeft As Long
    Dim fBubble As Form
    
    If bLarge Then
        If Not (mfrmSmallBubble Is Nothing) Then mfrmSmallBubble.Hide
        If mfrmLargeBubble Is Nothing Then Load frmBubble_L
        Set mfrmLargeBubble = frmBubble_L
        Set fBubble = mfrmLargeBubble
    Else
        If Not (mfrmLargeBubble Is Nothing) Then mfrmLargeBubble.Hide
        If mfrmSmallBubble Is Nothing Then Load frmBubble
        Set mfrmSmallBubble = frmBubble
        Set fBubble = mfrmSmallBubble
    End If
    
    With fBubble
        ' 1. frmBubble-Gr��e holen (TWIPS)
        lBubbleWidth = .asBFrmMsg.Width
        lBubbleHeight = .asBFrmMsg.Height
            
        ' 2. Control-Position auf Form in TWIPS-Pixel ausrechnen
        '    und Position des Bubble-Forms in TWIPS-Pixel bestimmen
        lX = ThisControl.Left
        lY = ThisControl.Top
        If PointToPixel(ThisForm, lX, lY) Then
            lBubbleLeft = (lX * Screen.TwipsPerPixelX)
            lBubbleTop = (lY * Screen.TwipsPerPixelY) - lBubbleHeight
        End If
                
        .lblMsg.Caption = sMsg
        .Move lBubbleLeft, lBubbleTop
        .Show
    End With
End Sub

Public Sub HideBubbles()
    If Not (mfrmSmallBubble Is Nothing) Then mfrmSmallBubble.Hide
    If Not (mfrmLargeBubble Is Nothing) Then mfrmLargeBubble.Hide
End Sub

Private Function PointToPixel(ThisForm As Form, ByRef lX As Long, ByRef lY As Long) As Boolean
    On Error Resume Next
    
    Dim tPoint As POINTAPI
    
    Select Case ThisForm.ScaleMode
        Case vbUser
            tPoint.X = lX
            tPoint.Y = lY
            glRet = ClientToScreen(ThisForm.hWnd, tPoint)
            If glRet <> 0 Then
                lX = tPoint.X
                lY = tPoint.Y
                PointToPixel = True
            End If
            
        Case vbTwips
            tPoint.X = lX \ CLng(Screen.TwipsPerPixelX)
            tPoint.Y = lY \ CLng(Screen.TwipsPerPixelY)
            glRet = ClientToScreen(ThisForm.hWnd, tPoint)
            If glRet <> 0 Then
                lX = tPoint.X
                lY = tPoint.Y
                PointToPixel = True
            End If
            
        Case vbPoints
            ' noch keine L�sung
            
        Case vbPixels
            tPoint.X = lX
            tPoint.Y = lY
            glRet = ClientToScreen(ThisForm.hWnd, tPoint)
            If glRet <> 0 Then
                lX = tPoint.X
                lY = tPoint.Y
                PointToPixel = True
            End If
            
        Case vbCharacters
            ' noch keine L�sung
        Case vbInches
            ' noch keine L�sung
        Case vbMillimeters
            ' noch keine L�sung
        Case vbCentimeters
            ' noch keine L�sung
    End Select
End Function

#If NOT_USED Then

Private Function PixelToPoint(ThisForm As Form, ByRef lX As Long, ByRef lY As Long) As Boolean
    On Error Resume Next
    
    Dim tPoint As POINTAPI
    
    Select Case ThisForm.ScaleMode
        Case vbUser
            tPoint.X = lX
            tPoint.Y = lY
            glRet = ScreenToClient(ThisForm.hWnd, tPoint)
            If glRet <> 0 Then
                lX = tPoint.X
                lY = tPoint.Y
                PixelToPoint = True
            End If
            
        Case vbTwips
            tPoint.X = lX * CLng(Screen.TwipsPerPixelX)
            tPoint.Y = lY * CLng(Screen.TwipsPerPixelY)
            glRet = ScreenToClient(ThisForm.hWnd, tPoint)
            If glRet <> 0 Then
                lX = tPoint.X
                lY = tPoint.Y
                PixelToPoint = True
            End If
            
        Case vbPoints
            ' noch keine L�sung
            
        Case vbPixels
            tPoint.X = lX
            tPoint.Y = lY
            glRet = ScreenToClient(ThisForm.hWnd, tPoint)
            If glRet <> 0 Then
                lX = tPoint.X
                lY = tPoint.Y
                PixelToPoint = True
            End If
            
        Case vbCharacters
            ' noch keine L�sung
        Case vbInches
            ' noch keine L�sung
        Case vbMillimeters
            ' noch keine L�sung
        Case vbCentimeters
            ' noch keine L�sung
    End Select
End Function
#End If

Option Explicit

Public Declare Function GetDiskFreeSpace Lib "kernel32.dll" _
Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, _
lpTotalNumberOfClusters As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Function OSGetPrivateProfileString Lib "kernel32.dll" _
Alias "GetPrivateProfileStringA" _
(ByVal Section As String, _
ByVal Entry As Any, _
ByVal Default As String, _
ByVal Buffer As String, _
ByVal BufSize As Long, _
ByVal Filename As String) As Long
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long

' Sets the cursor position.

' parameters: x - X position for the cursor in screen pixel coordinates

' y - Y position for the cursor in screen pixel coordinates

' returns: Nonzero on success, zero on failure.

' Sets GetLastError.

' Platform: Windows 95, Windows NT, Win16

Private Declare Function SetCursorPos Lib "User32.dll" _
(ByVal X As Long, ByVal Y As Long) As Long

' Determines the screen coordinates for a point given in the client coordinates of a window.

' parameters: hWnd - Handle of the window that determines the client coordinates to use

' lpPoint - Point in client coordinates of hWnd.

' On return this parameter will contain the same position in screen

' coordinates

' returns: Nonzero on success, zero on failure.

' Platform: Windows 95, Windows NT, Win16

Private Declare Function ClientToScreen Lib "User32.dll" _
(ByVal hWnd As Long, lpPoint As POINTAPI) As Long

' Determines the clientcoordinates for a given point on the screen.

' parameters: hWnd - Handle of the window defining the client coordinate system to use

' lpPoint - Structure containing the point on the screen in screen coordinates.

' This function loads the structure with the corresponding client

' coordinates based on hWnd

' returns: Nonzero on success, zero on failure.

' Platform: Windows 95, Windows NT, Win16

Private Declare Function ScreenToClient Lib "User32.dll" _
(ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Const SW_SHOWNORMAL = 1
Private Const mcBufSz = 1024
Private Const mcBufSzAll = 4096

Private mfrmSmallBubble As Form
Private mfrmLargeBubble As Form

Public Function ReadIniFile(ByVal vEntry As Variant, _
Optional sDefault As String = "")
ReadIniFile = GetPrivateProfileString(gsMyName, vEntry, sDefault, gsIniPfad)
End Function

Public Function GetPrivateProfileString(ByVal Section As String, _
ByVal Entry As Variant, _
ByVal Default As String, _
ByVal Filename As String) As String
Dim sBuffer As String

If IsNull(Entry) Then
sBuffer = String$(mcBufSzAll, 0)
glRet = OSGetPrivateProfileString(Section, 0&, Default, sBuffer, mcBufSzAll, Filename)
Else
sBuffer = String$(mcBufSz, 0)
glRet = OSGetPrivateProfileString(Section, CStr(Entry), Default, sBuffer, mcBufSz, Filename)
End If
GetPrivateProfileString = Left$(sBuffer, glRet)
End Function

Public Sub CenterCursorOn(ThisForm As Form, ThisControl As Object)
On Error Resume Next

Dim lX As Long
Dim lY As Long

lX = CLng(ThisControl.Left + ThisControl.Width / 2!)
lY = CLng(ThisControl.Top + ThisControl.Height / 2!)
If PointToPixel(ThisForm, lX, lY) Then
SetCursorPos lX, lY
End If
End Sub

Public Sub ShowBubbleOn(sMsg As String, _
ThisForm As Form, _
ThisControl As Object, _
Optional bLarge As Boolean)
On Error Resume Next
Dim lX As Long
Dim lY As Long
Dim lBubbleWidth As Long
Dim lBubbleHeight As Long
Dim lBubbleTop As Long
Dim lBubbleLeft As Long
Dim fBubble As Form

If bLarge Then
If Not (mfrmSmallBubble Is Nothing) Then mfrmSmallBubble.Hide
If mfrmLargeBubble Is Nothing Then Load frmBubble_L
Set mfrmLargeBubble = frmBubble_L
Set fBubble = mfrmLargeBubble
Else
If Not (mfrmLargeBubble Is Nothing) Then mfrmLargeBubble.Hide
If mfrmSmallBubble Is Nothing Then Load frmBubble
Set mfrmSmallBubble = frmBubble
Set fBubble = mfrmSmallBubble
End If

With fBubble
' 1. frmBubble-Gr��e holen (TWIPS)

lBubbleWidth = .asBFrmMsg.Width
lBubbleHeight = .asBFrmMsg.Height

' 2. Control-Position auf Form in TWIPS-Pixel ausrechnen

' und Position des Bubble-Forms in TWIPS-Pixel bestimmen

lX = ThisControl.Left
lY = ThisControl.Top
If PointToPixel(ThisForm, lX, lY) Then
lBubbleLeft = (lX * Screen.TwipsPerPixelX)
lBubbleTop = (lY * Screen.TwipsPerPixelY) - lBubbleHeight
End If

.lblMsg.Caption = sMsg
.Move lBubbleLeft, lBubbleTop
.Show
End With
End Sub

Public Sub HideBubbles()
If Not (mfrmSmallBubble Is Nothing) Then mfrmSmallBubble.Hide
If Not (mfrmLargeBubble Is Nothing) Then mfrmLargeBubble.Hide
End Sub

Private Function PointToPixel(ThisForm As Form, ByRef lX As Long, ByRef lY As Long) As Boolean
On Error Resume Next

Dim tPoint As POINTAPI

Select Case ThisForm.ScaleMode
Case vbUser
tPoint.X = lX
tPoint.Y = lY
glRet = ClientToScreen(ThisForm.hWnd, tPoint)
If glRet <> 0 Then
lX = tPoint.X
lY = tPoint.Y
PointToPixel = True
End If

Case vbTwips
tPoint.X = lX \ CLng(Screen.TwipsPerPixelX)
tPoint.Y = lY \ CLng(Screen.TwipsPerPixelY)
glRet = ClientToScreen(ThisForm.hWnd, tPoint)
If glRet <> 0 Then
lX = tPoint.X
lY = tPoint.Y
PointToPixel = True
End If

Case vbPoints
' noch keine L�sung

Case vbPixels
tPoint.X = lX
tPoint.Y = lY
glRet = ClientToScreen(ThisForm.hWnd, tPoint)
If glRet <> 0 Then
lX = tPoint.X
lY = tPoint.Y
PointToPixel = True
End If

Case vbCharacters
' noch keine L�sung

Case vbInches
' noch keine L�sung

Case vbMillimeters
' noch keine L�sung

Case vbCentimeters
' noch keine L�sung

End Select
End Function

#If NOT_USED Then

Private Function PixelToPoint(ThisForm As Form, ByRef lX As Long, ByRef lY As Long) As Boolean
On Error Resume Next

Dim tPoint As POINTAPI

Select Case ThisForm.ScaleMode
Case vbUser
tPoint.X = lX
tPoint.Y = lY
glRet = ScreenToClient(ThisForm.hWnd, tPoint)
If glRet <> 0 Then
lX = tPoint.X
lY = tPoint.Y
PixelToPoint = True
End If

Case vbTwips
tPoint.X = lX * CLng(Screen.TwipsPerPixelX)
tPoint.Y = lY * CLng(Screen.TwipsPerPixelY)
glRet = ScreenToClient(ThisForm.hWnd, tPoint)
If glRet <> 0 Then
lX = tPoint.X
lY = tPoint.Y
PixelToPoint = True
End If

Case vbPoints
' noch keine L�sung

Case vbPixels
tPoint.X = lX
tPoint.Y = lY
glRet = ScreenToClient(ThisForm.hWnd, tPoint)
If glRet <> 0 Then
lX = tPoint.X
lY = tPoint.Y
PixelToPoint = True
End If

Case vbCharacters
' noch keine L�sung

Case vbInches
' noch keine L�sung

Case vbMillimeters
' noch keine L�sung

Case vbCentimeters
' noch keine L�sung

End Select
End Function
#End If