Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_2/TK_BAR/TKBAR.BAS

BASIC Source File | 1993-12-07 | 19.2 KB | 655 lines

Option Explicit

Const MAXITEMS = 30       'max valid program items
Const MAXITEMPTRS = 50    'max program item file pointers

Type POINTAPI
   x As Integer
   y As Integer
End Type

Type RECT
   Left As Integer
   Top As Integer
   right As Integer
   bottom As Integer
End Type


Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal w%, ByVal h%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
Declare Function CreateBitmap% Lib "GDI" (ByVal w%, ByVal h%, ByVal Planes%, ByVal BitCnt%, ByVal Bits As Any)
Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%)
Declare Function CreateDC% Lib "GDI" (ByVal Driver$, ByVal DeviceName$, ByVal lpOutput$, ByVal InitData$)
Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
Declare Function GetPrivateProfileString% Lib "kernel" (ByVal ApplName$, ByVal KeyName As Any, ByVal lpDefault$, ByVal ReturnString$, ByVal nSize%, ByVal Filename$)
Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function RestoreDC% Lib "GDI" (ByVal hDC%, ByVal SavedDC%)
Declare Function SaveDC% Lib "GDI" (ByVal hDC%)
Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
Declare Function SetBitmapBitsByString& Lib "GDI" Alias "SetBitmapBits" (ByVal hBmp%, ByVal Count&, ByVal lpBits$)
Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
Declare Function ShellExecute% Lib "shell.dll" (ByVal hWnd%, ByVal Op$, ByVal File$, ByVal Parms$, ByVal RunDir$, ByVal ShowCmd%)
Declare Function WritePrivateProfileString% Lib "kernel" (ByVal ApplName$, ByVal KeyName As Any, ByVal lpString$, ByVal Filename$)

'BitBlt constants
Global Const SRCCOPY = &HCC0020
Global Const SRCAND = &H8800C6
Global Const SRCINVERT = &H660046

' SetWindowPos Flags
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2
Global Const SWP_NOSIZE = &H1
Global Const SWP_NOMOVE = &H2

' GetSystemMetric item
Global Const SM_CYCAPTION = 4

' MsgBox parameters
Global Const MB_OK = 0                 ' OK button only
Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
Global Const MB_YESNO = 4              ' Yes and No buttons
Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
Global Const MB_ICONSTOP = 16          ' Critical message
Global Const MB_ICONQUESTION = 32      ' Warning query
Global Const MB_ICONEXCLAMATION = 48   ' Warning message
Global Const MB_ICONINFORMATION = 64   ' Information message
Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
Global Const MB_DEFBUTTON1 = 0         ' First button is default
Global Const MB_DEFBUTTON2 = 256       ' Second button is default
Global Const MB_DEFBUTTON3 = 512       ' Third button is default
Global Const MB_SYSTEMMODAL = 4096      'System Modal

' ShowWindow() and ShellExecute() commands
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_NORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Global Const SW_MAXIMIZE = 3
Global Const SW_SHOWNOACTIVATE = 4
Global Const SW_SHOW = 5
Global Const SW_MINIMIZE = 6
Global Const SW_SHOWMINNOACTIVE = 7
Global Const SW_SHOWNA = 8
Global Const SW_RESTORE = 9

Type GroupHeaderType
  Id As String * 4
  CheckSum As Integer
  OffsetTag As Integer
  CmdShow As Integer
  Normal As RECT
  Min As POINTAPI
  OffsetName As Integer
  LogPixelsx As Integer
  LogPixelsy As Integer
  BitsPerPixel As String * 1
  Planes As String * 1
  Reserved As Integer
  NumItems As Integer
End Type

Type GroupItemType
  pt As POINTAPI             'coords of item in grp window
  IconIndex As Integer
  ResourceBytes As Integer
  ANDPlaneBytes As Integer
  XORPlaneBytes As Integer
  OffsetResource As Integer
  OffsetANDPlane As Integer
  OffsetXORPlane As Integer
  OffsetName As Integer
  OffsetExeName As Integer
  OffsetIconPath As Integer
End Type

Type TagDataType
  Id As Integer
  Item As Integer
  NextPtr As Integer
  Dunno As String * 1
End Type

Type MyItemInfoType        'to store the stuff after parsing
  ExeName As String * 80
  WorkingDir As String * 80
  Arguments As String * 80
End Type
'
'  Vars prefixed with 's' are shared to one module or form
'  Vars prefixed with 'g' are global
'
Dim Shared sHdr As GroupHeaderType
Dim Shared sItems(MAXITEMS) As GroupItemType
Dim Shared sMyItemInfo(MAXITEMS) As MyItemInfoType
Dim Shared sItemPtr(MAXITEMPTRS)  As Integer
Dim Shared sCommandPath(MAXITEMS) As String
Dim Shared sCaptionHeight As Integer      'height of window title bar
Dim Shared sLastLoaded As Integer         'for button ctrl array mgmnt

Global gActualItemCt As Integer           'valid program item count
Global gGroupFilename As String
Global gWindowsDir As String
Global gGridRows As Integer               'for bar config
Global gGridCols As Integer               'for bar config
Global gOnTop As Integer                  'for bar config

Sub ButtonBarDraw ()
'
'  Configure the button bar window based on
'  gGridRows, gGridCols, gOnTop, and gActualItemCt
'
Dim i%
Dim flags%, TopPos%, LeftPos%
Dim CurrRow%, CurrCol%, CurrItem%

  'pixels are the only way to go
  frmButtonBar.ScaleMode = 3

  For CurrRow = 1 To gGridRows
     '
     '  czech if last row was enough for all the items
     '
     If ((CurrRow - 1) * gGridCols) >= gActualItemCt Then
        gGridRows = CurrRow - 1
        Exit For
     End If
     TopPos = (CurrRow - 1) * (frmButtonBar!cmdIcon(0).Height + 1)
     For CurrCol = 1 To gGridCols
        CurrItem = ((CurrRow - 1) * gGridCols + CurrCol) - 1
        '
        '  munch all you want.  we'll make more!
        '
        If CurrItem > sLastLoaded Then
           Load frmButtonBar!cmdIcon(CurrItem)
           sLastLoaded = sLastLoaded + 1
        End If
        '
        '  disable blank buttons
        '
        If CurrItem > (gActualItemCt - 1) Then
           frmButtonBar!cmdIcon(CurrItem).Picture = LoadPicture("")
           frmButtonBar!cmdIcon(CurrItem).Visible = True
           frmButtonBar!cmdIcon(CurrItem).Enabled = False
        End If
        frmButtonBar!cmdIcon(CurrItem).Top = TopPos
        LeftPos = (CurrCol - 1) * (frmButtonBar!cmdIcon(0).Width + 1)
        frmButtonBar!cmdIcon(CurrItem).Left = LeftPos
     Next
  Next
  '
  '  unload any extra controls from previous config
  '
  Do While (sLastLoaded + 1) > (gGridRows * gGridCols)
     Unload frmButtonBar!cmdIcon(sLastLoaded)
     sLastLoaded = sLastLoaded - 1
  Loop

  frmButtonBar.Width = ((gGridCols * (frmButtonBar!cmdIcon(0).Width + 1)) + 1) * screen.TwipsPerPixelX
  frmButtonBar.Height = ((gGridRows * (frmButtonBar!cmdIcon(0).Height + 1)) + sCaptionHeight) * screen.TwipsPerPixelY

  frmButtonBar.Refresh

  If gOnTop Then
     flags = SWP_NOMOVE Or SWP_NOSIZE
     Call SetWindowPos(frmButtonBar.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  Else
     flags = SWP_NOMOVE Or SWP_NOSIZE
     Call SetWindowPos(frmButtonBar.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags)
  End If

  'Debug.Print sLastLoaded
End Sub

Sub ButtonBarExecute (ByVal ItemNum)
'
'  execute the corresponding program for the button ItemNum
'
Dim temp%, RunDir$, ExeName$, Args$, Msg$

  ExeName$ = RTrim$(sMyItemInfo(ItemNum).ExeName)
  RunDir$ = RTrim$(sMyItemInfo(ItemNum).WorkingDir)
  Args$ = RTrim$(sMyItemInfo(ItemNum).Arguments)

  temp = ShellExecute(frmButtonBar.hWnd, "Open", ExeName$, Args$, RunDir$, SW_SHOWNORMAL)

  If temp < 32 Then
    Select Case temp
    Case 0:   Msg$ = "Insufficient system memory or corrupt program file."
    Case 2:   Msg$ = "File not found."
    Case 3:   Msg$ = "Invalid path."
    Case 5:   Msg$ = "Sharing or protection error."
    Case 6:   Msg$ = "Separate data segments are required for each task."
    Case 8:   Msg$ = "Insufficient memory to run program."
    Case 11:  Msg$ = "Invalid program file."
    Case 14:  Msg$ = "Unknown program file type."
    Case 16:  Msg$ = "Data segment error on loading second instance."
    Case Else:  Msg$ = "Error" + Str$(temp)
    End Select
    MsgBadNews "Couldn't launch application..." & Chr$(13) & Chr$(10) & Msg$
  End If

End Sub

Sub ButtonBarInit ()
'
'  Set up button bar...
'
Dim i%, j%
Dim ActItems%, LeastY%, LeastX%, TheOne%, CurrIndex%
Dim FoundDir%, ANDPlane$, XORPlane$, Title$, ExeName$
Dim RunDir$, Params$, TestChr$, TempStr$

Dim hAndBmp%, hXorBmp%, lTmp&, iTmp%, w%, h%, p%, bp%
Dim iconDC%, OldDc%

ReDim Taken(MAXITEMPTRS) As Integer
'
'  find actual/valid item pointers...
'
gActualItemCt = 0
sLastLoaded = 0
For i = 1 To sHdr.NumItems
  If sItemPtr(i) Then gActualItemCt = gActualItemCt + 1
Next

Select Case gActualItemCt
  Case 0
     MsgBombOut "No valid items in group file."
  Case Is > MAXITEMS
     MsgBombOut "Maximum of" & Str$(MAXITEMS) & " items allowed."
End Select

frmButtonBar!cmdIcon(0).Width = sHdr.LogPixelsx + 4
frmButtonBar!cmdIcon(0).Height = sHdr.LogPixelsy + 4

Open gGroupFilename$ For Binary As 1
CurrIndex = 0

frmButtonBar!picTempIcon.Width = sHdr.LogPixelsx + 1
frmButtonBar!picTempIcon.Height = sHdr.LogPixelsy + 1

' create a working DC to transfer icons into;
' it's compatible with the picture box we want to xfer to
iconDC = CreateCompatibleDC(frmButtonBar!picTempIcon.hDC)
If iconDC = 0 Then
   MsgBombOut "Couldn't create device context."
End If

Do Until CurrIndex > (gActualItemCt - 1)
   '
   '  Sort by group window positions.  Just keep finding
   '  the least one and tag it out...
   '
   LeastY = 32000
   LeastX = 32000
   For j = 1 To sHdr.NumItems
      If Not Taken(j) And sItemPtr(j) Then
        If (sItems(j).pt.y < LeastY) Then
           LeastX = sItems(j).pt.x
           LeastY = sItems(j).pt.y
           TheOne = j
        Else
           If (sItems(j).pt.x < LeastX) And (sItems(j).pt.y <= LeastY) Then
             LeastX = sItems(j).pt.x
             LeastY = sItems(j).pt.y
             TheOne = j
           End If
        End If
      End If
   Next

   Taken(TheOne) = True

   ' Load new button...
   If CurrIndex > 0 Then
      Load frmButtonBar!cmdIcon(CurrIndex)
      sLastLoaded = sLastLoaded + 1
   End If

   ' Get icon drawing planes...
   ANDPlane$ = Space$(sItems(TheOne).ANDPlaneBytes)
   XORPlane$ = Space$(sItems(TheOne).XORPlaneBytes)
   Seek 1, (sItems(TheOne).OffsetANDPlane + 1)
   Get 1, , ANDPlane$
   Seek 1, (sItems(TheOne).OffsetXORPlane + 1)
   Get 1, , XORPlane$
   '
   '  Load icon into button via temp pic control...
   '
   frmButtonBar!picTempIcon.Picture = LoadPicture("")
   OldDc = SaveDC(iconDC)

   w = sHdr.LogPixelsx
   h = sHdr.LogPixelsy
   p = Asc(sHdr.Planes)
   bp = Asc(sHdr.BitsPerPixel)
   hAndBmp = CreateBitmap(w, h, 1, 1, "")
   hXorBmp = CreateBitmap(w, h, p, bp, "")
   If hAndBmp = 0 Or hXorBmp = 0 Then
       MsgBombOut "Couldn't create bitmaps."
   End If

   lTmp = SetBitmapBitsByString(hAndBmp, Len(ANDPlane$), ANDPlane$)
   iTmp = SelectObject(iconDC, hAndBmp)
   iTmp = BitBlt(frmButtonBar!picTempIcon.hDC, 0, 0, w, h, iconDC, 0, 0, SRCAND)

   lTmp = SetBitmapBitsByString(hXorBmp, Len(XORPlane$), XORPlane$)
   iTmp = SelectObject(iconDC, hXorBmp)
   iTmp = BitBlt(frmButtonBar!picTempIcon.hDC, 0, 0, w, h, iconDC, 0, 0, SRCINVERT)

   ' restore DC *then* we can delete objects
   iTmp = RestoreDC(iconDC, OldDc)
   iTmp = DeleteObject(hAndBmp)
   iTmp = DeleteObject(hXorBmp)

   frmButtonBar!cmdIcon(CurrIndex).Picture = frmButtonBar!picTempIcon.Image
   frmButtonBar!cmdIcon(CurrIndex).Visible = True

   RunDir$ = ""
   Params$ = ""
   ExeName$ = ""

   '  parse out all the filenames, args, etc...
   TempStr$ = FileGetString$(1, sItems(TheOne).OffsetExeName + 1)
   iTmp = Len(TempStr$)
   FoundDir = False
   '
   '  Remember, the ExeName string is really
   '  RunPath + "\" + ExeName + " " + Command line args
   '
   iTmp = InStr(TempStr$, " ")
   If iTmp > 0 Then
      Params$ = LTrim$(Mid$(TempStr$, iTmp + 1))
      TempStr$ = Left$(TempStr$, iTmp - 1)
   End If
   iTmp = Len(TempStr$)
   For i = iTmp To 1 Step -1
      TestChr$ = Mid$(TempStr$, i, 1)
      If TestChr$ = "\" Or TestChr$ = ":" Then
        RunDir$ = Left$(TempStr$, i - 1)
        ExeName$ = RTrim$(Mid$(TempStr$, i + 1))
        FoundDir = True
        Exit For
      End If
   Next
   If Not FoundDir Then ExeName$ = TempStr$

   ' attach ExePath (retrieved earlier) to ExeName
   ExeName$ = sCommandPath$(TheOne - 1) + ExeName$

   sMyItemInfo(CurrIndex).ExeName = ExeName$
   sMyItemInfo(CurrIndex).WorkingDir = RunDir$
   sMyItemInfo(CurrIndex).Arguments = Params$

   CurrIndex = CurrIndex + 1
Loop

iTmp = DeleteDC(iconDC)
Title$ = FileGetString(1, sHdr.OffsetName + 1)
Close
'
'  Config & display button bar...
'
frmButtonBar.ScaleMode = 1
frmButtonBar.Caption = Title$
frmButtonBar.Tag = gActualItemCt
Call IniLoad
'
'  Czech configuration & reset if necessary
'  (gGridRows=0 means no previous .ini entry)
'
If (gGridRows = 0) Or (gGridRows * gGridCols < gActualItemCt) Then
   If gGridRows <> 0 Then
      MsgBox "Grid reconfigured because of new items.", MB_SYSTEMMODAL Or MB_ICONINFORMATION, "Another Button Bar"
   End If
   gOnTop = False
   frmButtonBar.Left = 0
   frmButtonBar.Top = 0
   gGridCols = 10
   gGridRows = CInt(gActualItemCt / gGridCols + .4)
   If gActualItemCt < 10 Then gGridCols = gActualItemCt
End If

Call ButtonBarDraw
frmButtonBar.Show

' get black focus border off buttons
frmButtonBar!picTempIcon.SetFocus
App.Title = Title$ & " (Buttons)"

End Sub

Sub CenterForm (Theform As Form)

  Theform.Move ((screen.Width / 2) - (Theform.Width / 2)), ((screen.Height / 2) - (Theform.Height / 2))

End Sub

Function FileGetString$ (FileNum, Offset)
'
'  Start at current position in file and get string
'  until null termination...
'
Dim Bit As String * 1, temp$

  Seek FileNum, Offset
  temp$ = ""
  Do
    Get 1, , Bit
    If Asc(Bit) Then temp$ = temp$ & Bit
  Loop While Asc(Bit)
  FileGetString$ = temp$

End Function

Sub GetGroupFilename ()

   frmLoadGroup.Show 1
   Exit Sub

End Sub

Function GetGroupName$ (Filename$)
Dim TempHdr As GroupHeaderType
Dim InFile As Integer

  InFile = FreeFile
  Open Filename$ For Binary As InFile
  Get InFile, , TempHdr
  GetGroupName$ = FileGetString$(InFile, TempHdr.OffsetName + 1)
  Close InFile

End Function

Sub GetItemInfo ()
'
'  Get item pointers and some other info from group file
'
Dim i%, Done%, TagPos%
Dim TagData As TagDataType

  Open gGroupFilename$ For Binary As 1
  '
  '  get the Group header
  '
  Get 1, , sHdr
  '
  '  get program item pointers
  '
  For i = 1 To sHdr.NumItems
    Get 1, , sItemPtr(i)
  Next
  '
  '  get valid item info
  '
  For i = 1 To sHdr.NumItems
    If sItemPtr(i) Then
      Seek 1, (sItemPtr(i) + 1)
      Get 1, , sItems(i)
    End If
  Next
  '
  '  Get "tag" data which contains window state and .exe
  '  paths if any.  This code was gleaned from PC Mag's
  '  BTNGO program in C.
  '
  TagPos = sHdr.OffsetTag + 1
  Seek 1, TagPos
  Done = False
  Do
    Get 1, , TagData
    Select Case TagData.Id
      Case &H8101
         sCommandPath$(TagData.Item) = FileGetString$(1, Loc(1))
      Case &HFFFF, 0
         Done = True
    End Select
    TagPos = TagPos + TagData.NextPtr
    Seek 1, TagPos
  Loop Until Done

  Close

End Sub

Sub IniLoad ()
'
'  Find group file's .ini data if there...
'
Dim tmp%
Dim GroupName$, IniFile$, KeyName$, Default$
Dim ReturnString As String * 40
Dim ReturnLen As Integer

  IniFile$ = "tkbar.ini"
  GroupName$ = gGroupFilename$
  '
  '  read in ini file info...
  '
  Default$ = ""
  KeyName$ = "Top"
  ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
  '
  '  was it there?
  '
  If ReturnLen <> 0 Then
     frmButtonBar.Top = Val(Left$(ReturnString$, ReturnLen))

     KeyName$ = "Left"
     ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
     frmButtonBar.Left = Val(Left$(ReturnString$, ReturnLen))

     KeyName$ = "Rows"
     ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
     gGridRows = Val(Left$(ReturnString$, ReturnLen))

     KeyName$ = "Columns"
     ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
     gGridCols = Val(Left$(ReturnString$, ReturnLen))

     KeyName$ = "AlwaysOnTop"
     ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
     If Val(Left$(ReturnString$, ReturnLen)) > 0 Then
        gOnTop = True
     Else
        gOnTop = False
     End If
  Else
     gGridRows = 0
     gGridCols = 0
  End If

End Sub

Sub IniSave ()
'
'  Save out configuration...
'
Dim tmp%
Dim GroupName$, IniFile$, KeyName$, KeyValue$

  GroupName$ = gGroupFilename$
  IniFile$ = "tkbar.ini"

  KeyName$ = "Top"
  KeyValue$ = LTrim$(Str$(frmButtonBar.Top))
  tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)

  KeyName$ = "Left"
  KeyValue$ = LTrim$(Str$(frmButtonBar.Left))
  tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)

  KeyName$ = "Rows"
  KeyValue$ = LTrim$(Str$(gGridRows))
  tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)

  KeyName$ = "Columns"
  KeyValue$ = LTrim$(Str$(gGridCols))
  tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)

  KeyName$ = "AlwaysOnTop"
  If gOnTop Then KeyValue$ = "1" Else KeyValue$ = "0"
  tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)

End Sub

Sub Main ()

Dim CrLf As String
Dim tmp As Integer

  CrLf$ = Chr$(13) & Chr$(10)

  gWindowsDir$ = Space$(255)
  tmp = GetWindowsDirectory(gWindowsDir$, 255)
  gWindowsDir$ = Left$(gWindowsDir$, tmp)
  sCaptionHeight = GetSystemMetrics(SM_CYCAPTION)
  '
  '  if no command line argument...
  '
  gGroupFilename$ = Command$
  '
  '  bring up Load Group dialog
  '
  If gGroupFilename$ = "" Then
     Call GetGroupFilename
     If gGroupFilename$ = "" Then End
  End If
  '
  '  do brief czeching on file name...
  '
  If InStr(UCase$(gGroupFilename$), ".GRP") = 0 Then
     MsgBombOut Chr$(34) & gGroupFilename$ & Chr$(34) & CrLf$ & "Invalid file name"
  End If

  If Dir$(gGroupFilename$) = "" Then
     MsgBombOut Chr$(34) & gGroupFilename$ & Chr$(34) & CrLf$ & "Invalid file name"
  End If
  '
  '  do it!
  '
  GetItemInfo
  ButtonBarInit

End Sub

Sub MsgBadNews (Message$)
' non-fatal message
MsgBox Message$, MB_ICONEXCLAMATION Or MB_SYSTEMMODAL, "Another Button Bar"

End Sub

Sub MsgBombOut (Message$)
' fatal message
MsgBox Message$, MB_ICONEXCLAMATION Or MB_SYSTEMMODAL, "Another Button Bar"
End

End Sub