Attribute VB_Name = "modPublic"
Option Explicit

Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_CLIENTEDGE = &H200
Private Const WS_EX_STATICEDGE = &H20000
Private Const WS_CHILDWINDOW = (WS_CHILD)
Private Const WS_EX_TOOLWINDOW = &H80&
Private Const WS_EX_NOACTIVATE = &H8000000

'Private Const WS_CHILDWINDOW = (WS_CHILD)
Public Const WS_CLIPSIBLINGS As Long = &H4000000
Private Const WS_ACTIVECAPTION As Long = &H1
Private Const WS_EX_ACCEPTFILES As Long = &H10&
Private Const WS_OVERLAPPED As Long = &H0&
Private Const WS_EX_LEFT As Long = &H0&
'Private Const WS_EX_LTRREADING = &H&
'Private Const WS_EX_RIGHTSCROLLBAR = &H&
Private Const WS_EX_OVERLAPPEDWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)

'Private Const WS_EX_ACCEPTFILES = &H10&
Private Const WS_CLIPCHILDREN = &H2000000


Private Const CS_DROPSHADOW = &H20000
Private Const GCL_STYLE = (-26)

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 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

Public Const vbRelFolder As Long = 99
Public Const vbRelNone As Long = 0

Public m_Scheme As New IScheme     ' The perspective color scheme
Public m_Views As New List         ' This list stores all registered views
Public m_Editors As New List       ' This list stores all registered editors
Public m_Windows As New List       ' This list stores all floating windows
Public m_Placeholders As New List  ' View placeholders of a folder
Public m_CursorPos As PointAPI

Public Sub PrintText(ByVal Text As String, _
                     ByVal hDc As Long, _
                     ByVal x As Long, _
                     ByVal y As Long, _
            Optional ByVal Winkel As Long = 0, _
            Optional ByVal FontSize As Long = 12, _
            Optional ByVal FontWidth As VbFontWidth = fwStandard, _
            Optional ByVal Color As OLE_COLOR = vbWhite, _
            Optional ByVal Italic As Long = 0, _
            Optional ByVal FontName As String = "Arial", _
            Optional ByVal Underline As Long = 0)

   Dim hFont As Long
   Dim FontMem As Long
   Dim Result As Long

   hFont = CreateFont(-FontSize, 0, Winkel * 10, Winkel * 10, FontWidth, Italic, _
                      Underline, 0, 1, 7, 0, 0, 0, FontName)

   SetTextColor hDc, Color
   FontMem = SelectObject(hDc, hFont)
   Result = TextOut(hDc, x, y, Text, Len(Text))
   Result = SelectObject(hDc, FontMem)
   Result = DeleteObject(hFont)
   
End Sub




' Checks the syntax of an id.
'
' Supported characters are: "a" - "z", "A" - "Z", "0" - "9" and  "-"
'
'
' @Id The id to check
'
' @Throws Returns false if the syntax of the id is unsupported; true otherwise.
Public Sub CheckId(ByVal Id As String)
   
   Dim i As Long
   Dim l_IdLength As Long
   Dim l_IdChar As String
   Dim l_IdAsc As Integer
   
   l_IdLength = Len(Id)
   
   For i = 1 To l_IdLength
      l_IdChar = Mid$(Id, i, 1)
      l_IdAsc = Asc(l_IdChar)
      Asc ("-")
      
      If Not (l_IdAsc >= 97 And l_IdAsc <= 122) And _
         Not (l_IdAsc >= 65 And l_IdAsc <= 90) And _
         Not (l_IdAsc >= 48 And l_IdAsc <= 57) And _
         Not (l_IdAsc = 45 Or l_IdAsc = 95) Then
        
        ' Character is unsupported for Id !!!
         Err.Raise 3735, , "Unsupported character '" & l_IdChar & "' in id '" & Id & "'!"
         
      End If
   Next i
   
'   If InStr(1, Id, ".", vbBinaryCompare) > 0 Or _
'      InStr(1, Id, "%", vbBinaryCompare) > 0 Or _
'      InStr(1, Id, "&", vbBinaryCompare) > 0 Or _
'      InStr(1, Id, "/", vbBinaryCompare) > 0 Or _
'      InStr(1, Id, "\", vbBinaryCompare) > 0 Or _
'      InStr(1, Id, "*", vbBinaryCompare) > 0 Or _
'      InStr(1, Id, "?", vbBinaryCompare) > 0 Then
'
'   End If
      
End Sub

' Sets a new window style.
'
' @hWnd The window handle.
' @BorderStyle The new borderstyle.
Public Sub setWindowStyle(ByVal Hwnd As Long, ByVal BorderStyle As VbWindowStyle)
     
   Dim l_FormStyle As Long
   Dim l_Style As Long
  
   'If l_FormStyle = 0 Then
      l_FormStyle = GetWindowLong(Hwnd, GWL_STYLE)
   'End If
   
   ' set new window style
   If BorderStyle = vbNone Then
      
      l_Style = l_FormStyle And Not WS_DLGFRAME And Not WS_EX_APPWINDOW _
                            And Not WS_BORDER And Not WS_EX_WINDOWEDGE Or _
                            WS_EX_MDICHILD 'Or WS_CHILDWINDOW 'And Not WS_EX_NOPARENTNOTIFY ' Or WS_CHILDWINDOW

                               
      SetWindowLong Hwnd, GWL_STYLE, l_Style
        
      ' tell the nonclient area of the form to redraw itself
      SetWindowPos Hwnd, 0&, 0&, 0&, 0&, 0&, SWP_FRAMECHANGED
   
   Else
   
      l_Style = GetWindowLong(Hwnd, GWL_STYLE) ' Get current style
      l_Style = l_Style And Not WS_CAPTION Or WS_EX_NOPARENTNOTIFY
   
      SetWindowLong Hwnd, GWL_STYLE, l_Style
    
      ' tell the nonclient area of the form to redraw itself
      SetWindowPos Hwnd, 0&, -100, -100, 10, 10, SWP_FRAMECHANGED
               
   End If

End Sub

Public Sub DropShadow(Hwnd As Long)
    SetClassLong Hwnd, GCL_STYLE, GetClassLong(Hwnd, GCL_STYLE) Or CS_DROPSHADOW
End Sub

' Returns the style of the selected theme scheme.
'
' @Scheme A constant of the VbWindowScheme enumeration.
Public Function scheme() As VbWindowsScheme
   
   On Error GoTo ERROR_HANDLE
   
   Dim SchemeName As String
   Dim RegKeyTheme As String
   
   RegKeyTheme = "Software\Microsoft\Windows\CurrentVersion\ThemeManager"
   
   SchemeName = GetKeyValue(VbHKEY_CURRENT_USER, RegKeyTheme, "ColorName")
   
   Select Case SchemeName
      Case "NormalColor":    scheme = VbNormalColor
      Case "HomeStead":      scheme = VbHomeStead
      Case "Metallic":       scheme = VbMetallic
      Case Else:             scheme = VbClassic
   End Select
  
Finally:
      
   Exit Function
   
ERROR_HANDLE:

   scheme = VbClassic
   
   GoTo Finally

End Function

Public Sub DrawDragRect(Rc As RECT, Optional ByVal Size As Long = 2)
        
   Dim DrawRect As RECT
   Dim hDc As Long
   Dim i As Long
        
   hDc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)

   For i = 0 To Size
           
      With DrawRect
         .Top = Rc.Top + i
         .Bottom = Rc.Bottom - i
         .Left = Rc.Left + i
         .Right = Rc.Right - i
      End With
           
      DrawFocusRect hDc, DrawRect
           
   Next i
        
   DeleteDC hDc
        
End Sub

Public Sub BorderStyleSunken(ByVal Hwnd As Long, _
 Optional ByVal Undo As Boolean)

  Dim nStyle As Long
  
  Const GWL_EXSTYLE = (-20)
  Const WS_EX_CLIENTEDGE = &H200&
  Const WS_EX_STATICEDGE = &H20000
  
  nStyle = GetWindowLong(Hwnd, GWL_EXSTYLE)
  If Undo Then
    nStyle = nStyle And Not WS_EX_STATICEDGE
  Else
    nStyle = (nStyle Or WS_EX_STATICEDGE) And Not WS_EX_CLIENTEDGE
  End If
  SetWindowLong Hwnd, GWL_EXSTYLE, nStyle
  SetWindowPos Hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
End Sub

Public Sub BorderStyleRaised(ByVal Hwnd As Long, _
 Optional ByVal Undo As Boolean)

  Dim nStyle As Long
  
  Const GWL_STYLE = (-16)
  Const WS_DLGFRAME = &H400000
  
  nStyle = GetWindowLong(Hwnd, GWL_STYLE)
  If Undo Then
    nStyle = nStyle And Not WS_DLGFRAME
  Else
    nStyle = nStyle Or WS_DLGFRAME
  End If
  
  SetWindowLong Hwnd, GWL_STYLE, nStyle
  SetWindowPos Hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
  
End Sub

Public Sub BorderStyleSunkenSoft(ByVal Hwnd As Long)

   Dim lngRetVal As Long
   
   'Retrieve the current border style
   lngRetVal = GetWindowLong(Hwnd, GWL_EXSTYLE)
   
   'Calculate border style to use
   lngRetVal = lngRetVal Or WS_EX_STATICEDGE And Not WS_EX_CLIENTEDGE
    
   'Apply the changes
   SetWindowLong Hwnd, GWL_EXSTYLE, lngRetVal
   SetWindowPos Hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED

End Sub
