BDG Scenario 3

Module 1 (Module1.bas)

Attribute VB_Name = "Module1"
Option Explicit

' === GLOBALS:
Public g_Options As Options

' === Status Bar syntax, which i can never remember...

Public Sub UpdateUser(Message$)
    Main.StatusBar1.Panels(1).text = Message
End Sub

' === Center form over MAIN window

Public Sub CenterForm(frm As Form)
   Dim width As Long, height As Long
   width = Main.width / 2 - frm.width / 2
   height = Main.height / 2 - frm.height / 2
   frm.Move Max(Max(Main.Left, 0) + width, 0), _
            Max(Max(Main.Top, 0) + height, 0)
End Sub

Public Function Max(a As Long, b As Long) As Long
   Max = IIf(a > b, a, b)
End Function

' === HELPER FUNCTIONS ===
' used by "Properties" and "Convert" forms

Public Function SizeVal(ByVal val As String) As String
If val = 0 Then MsgBox ""

   If Right(val, 2) = "10" Then
      SizeVal = CStr(Left(val, Len(val) - 2) / 16) & "%"
   Else
      SizeVal = (val - 9) / 16
   End If
End Function

Public Function ColorVal(ByVal val As String) As String
   ColorVal = "#" & Right(Hex(val), 6)
End Function

Public Function FontSizeVal(ByVal val As String) As String
   FontSizeVal = (val - 9) / 20
End Function

Public Function URLVal(ByVal val As String, Optional bCompleteURL As Boolean = False) As String
   Dim prefix As String, x As Integer, szURL As String
   
   If Not bCompleteURL Then
      ' do nothing but return the original value
      URLVal = val
      Exit Function
   End If
   
   ' look for "XXXX://" part, ie. http://, file://, etc
   x = InStr(val, ":")
   If x = 0 Or Mid(val, x + 1, 3) <> "//" Then
      ' If none found, then we add the current domain prefix to this one.
      ' Get offset of first '/' after the domain name of our current location.
      
      szURL = g_Options.GetRecentURL(1) ' current base url
      x = InStr(8, szURL, "/")          ' NOTE: assume "http://" or "file://" prefix
      
      If Left(val, 1) = "/" Then
         ' value is relative to root of domain ('/path/myfile')
         If x > 0 Then
            prefix = Left(szURL, x - 1)
         Else
            prefix = szURL
         End If
      ElseIf Left(val, 3) = "../" Then
         ' value is parent of current directory ('../path/myfile')
         prefix = Left(szURL, InStrRev(szURL, "/"))
         Do While Left(val, 3) = "../"
            val = Mid(val, 4)
            If InStr(8, prefix, "/") > 0 Then
               prefix = Left(prefix, InStrRev(prefix, "/", Len(prefix) - 1))
            End If
         Loop
      Else
         ' value may refer to current directory ('./path/myfile')
         If Left(val, 2) = "./" Then val = Mid(val, 3)
         ' value is descendant of current directory ('path/myfile')
         If x > 0 Then
            prefix = Left(szURL, InStrRev(szURL, "/"))
         Else
            prefix = szURL & "/"
         End If
      End If
   Else
      ' otherwise, add no prefix
      prefix = ""
   End If
   URLVal = prefix & val
End Function

Public Sub ParseError(perror As MSXML.IXMLDOMParseError)
   Dim sMsg$
   sMsg = perror.URL & " (" & perror.Line & "," & perror.linepos & ")" & vbCrLf & _
          perror.reason
   MsgBox sMsg, vbCritical, "XML Parse Error " & Hex(perror.errorCode)
End Sub