home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / tk_bar / tkbar.bas < prev    next >
BASIC Source File  |  1993-12-07  |  20KB  |  655 lines

  1. Option Explicit
  2.  
  3. Const MAXITEMS = 30       'max valid program items
  4. Const MAXITEMPTRS = 50    'max program item file pointers
  5.  
  6. Type POINTAPI
  7.    x As Integer
  8.    y As Integer
  9. End Type
  10.  
  11. Type RECT
  12.    Left As Integer
  13.    Top As Integer
  14.    right As Integer
  15.    bottom As Integer
  16. End Type
  17.  
  18.  
  19. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal w%, ByVal h%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  20. Declare Function CreateBitmap% Lib "GDI" (ByVal w%, ByVal h%, ByVal Planes%, ByVal BitCnt%, ByVal Bits As Any)
  21. Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%)
  22. Declare Function CreateDC% Lib "GDI" (ByVal Driver$, ByVal DeviceName$, ByVal lpOutput$, ByVal InitData$)
  23. Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
  24. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  25. Declare Function GetPrivateProfileString% Lib "kernel" (ByVal ApplName$, ByVal KeyName As Any, ByVal lpDefault$, ByVal ReturnString$, ByVal nSize%, ByVal Filename$)
  26. Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
  27. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  28. Declare Function RestoreDC% Lib "GDI" (ByVal hDC%, ByVal SavedDC%)
  29. Declare Function SaveDC% Lib "GDI" (ByVal hDC%)
  30. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  31. Declare Function SetBitmapBitsByString& Lib "GDI" Alias "SetBitmapBits" (ByVal hBmp%, ByVal Count&, ByVal lpBits$)
  32. 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)
  33. Declare Function ShellExecute% Lib "shell.dll" (ByVal hWnd%, ByVal Op$, ByVal File$, ByVal Parms$, ByVal RunDir$, ByVal ShowCmd%)
  34. Declare Function WritePrivateProfileString% Lib "kernel" (ByVal ApplName$, ByVal KeyName As Any, ByVal lpString$, ByVal Filename$)
  35.  
  36. 'BitBlt constants
  37. Global Const SRCCOPY = &HCC0020
  38. Global Const SRCAND = &H8800C6
  39. Global Const SRCINVERT = &H660046
  40.  
  41. ' SetWindowPos Flags
  42. Global Const HWND_TOPMOST = -1
  43. Global Const HWND_NOTOPMOST = -2
  44. Global Const SWP_NOSIZE = &H1
  45. Global Const SWP_NOMOVE = &H2
  46.  
  47. ' GetSystemMetric item
  48. Global Const SM_CYCAPTION = 4
  49.  
  50. ' MsgBox parameters
  51. Global Const MB_OK = 0                 ' OK button only
  52. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  53. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  54. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  55. Global Const MB_YESNO = 4              ' Yes and No buttons
  56. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  57. Global Const MB_ICONSTOP = 16          ' Critical message
  58. Global Const MB_ICONQUESTION = 32      ' Warning query
  59. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  60. Global Const MB_ICONINFORMATION = 64   ' Information message
  61. Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
  62. Global Const MB_DEFBUTTON1 = 0         ' First button is default
  63. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  64. Global Const MB_DEFBUTTON3 = 512       ' Third button is default
  65. Global Const MB_SYSTEMMODAL = 4096      'System Modal
  66.  
  67. ' ShowWindow() and ShellExecute() commands
  68. Global Const SW_HIDE = 0
  69. Global Const SW_SHOWNORMAL = 1
  70. Global Const SW_NORMAL = 1
  71. Global Const SW_SHOWMINIMIZED = 2
  72. Global Const SW_SHOWMAXIMIZED = 3
  73. Global Const SW_MAXIMIZE = 3
  74. Global Const SW_SHOWNOACTIVATE = 4
  75. Global Const SW_SHOW = 5
  76. Global Const SW_MINIMIZE = 6
  77. Global Const SW_SHOWMINNOACTIVE = 7
  78. Global Const SW_SHOWNA = 8
  79. Global Const SW_RESTORE = 9
  80.  
  81. Type GroupHeaderType
  82.   Id As String * 4
  83.   CheckSum As Integer
  84.   OffsetTag As Integer
  85.   CmdShow As Integer
  86.   Normal As RECT
  87.   Min As POINTAPI
  88.   OffsetName As Integer
  89.   LogPixelsx As Integer
  90.   LogPixelsy As Integer
  91.   BitsPerPixel As String * 1
  92.   Planes As String * 1
  93.   Reserved As Integer
  94.   NumItems As Integer
  95. End Type
  96.  
  97. Type GroupItemType
  98.   pt As POINTAPI             'coords of item in grp window
  99.   IconIndex As Integer
  100.   ResourceBytes As Integer
  101.   ANDPlaneBytes As Integer
  102.   XORPlaneBytes As Integer
  103.   OffsetResource As Integer
  104.   OffsetANDPlane As Integer
  105.   OffsetXORPlane As Integer
  106.   OffsetName As Integer
  107.   OffsetExeName As Integer
  108.   OffsetIconPath As Integer
  109. End Type
  110.  
  111. Type TagDataType
  112.   Id As Integer
  113.   Item As Integer
  114.   NextPtr As Integer
  115.   Dunno As String * 1
  116. End Type
  117.  
  118. Type MyItemInfoType        'to store the stuff after parsing
  119.   ExeName As String * 80
  120.   WorkingDir As String * 80
  121.   Arguments As String * 80
  122. End Type
  123. '
  124. '  Vars prefixed with 's' are shared to one module or form
  125. '  Vars prefixed with 'g' are global
  126. '
  127. Dim Shared sHdr As GroupHeaderType
  128. Dim Shared sItems(MAXITEMS) As GroupItemType
  129. Dim Shared sMyItemInfo(MAXITEMS) As MyItemInfoType
  130. Dim Shared sItemPtr(MAXITEMPTRS)  As Integer
  131. Dim Shared sCommandPath(MAXITEMS) As String
  132. Dim Shared sCaptionHeight As Integer      'height of window title bar
  133. Dim Shared sLastLoaded As Integer         'for button ctrl array mgmnt
  134.  
  135. Global gActualItemCt As Integer           'valid program item count
  136. Global gGroupFilename As String
  137. Global gWindowsDir As String
  138. Global gGridRows As Integer               'for bar config
  139. Global gGridCols As Integer               'for bar config
  140. Global gOnTop As Integer                  'for bar config
  141.  
  142. Sub ButtonBarDraw ()
  143. '
  144. '  Configure the button bar window based on
  145. '  gGridRows, gGridCols, gOnTop, and gActualItemCt
  146. '
  147. Dim i%
  148. Dim flags%, TopPos%, LeftPos%
  149. Dim CurrRow%, CurrCol%, CurrItem%
  150.  
  151.   'pixels are the only way to go
  152.   frmButtonBar.ScaleMode = 3
  153.  
  154.   For CurrRow = 1 To gGridRows
  155.      '
  156.      '  czech if last row was enough for all the items
  157.      '
  158.      If ((CurrRow - 1) * gGridCols) >= gActualItemCt Then
  159.         gGridRows = CurrRow - 1
  160.         Exit For
  161.      End If
  162.      TopPos = (CurrRow - 1) * (frmButtonBar!cmdIcon(0).Height + 1)
  163.      For CurrCol = 1 To gGridCols
  164.         CurrItem = ((CurrRow - 1) * gGridCols + CurrCol) - 1
  165.         '
  166.         '  munch all you want.  we'll make more!
  167.         '
  168.         If CurrItem > sLastLoaded Then
  169.            Load frmButtonBar!cmdIcon(CurrItem)
  170.            sLastLoaded = sLastLoaded + 1
  171.         End If
  172.         '
  173.         '  disable blank buttons
  174.         '
  175.         If CurrItem > (gActualItemCt - 1) Then
  176.            frmButtonBar!cmdIcon(CurrItem).Picture = LoadPicture("")
  177.            frmButtonBar!cmdIcon(CurrItem).Visible = True
  178.            frmButtonBar!cmdIcon(CurrItem).Enabled = False
  179.         End If
  180.         frmButtonBar!cmdIcon(CurrItem).Top = TopPos
  181.         LeftPos = (CurrCol - 1) * (frmButtonBar!cmdIcon(0).Width + 1)
  182.         frmButtonBar!cmdIcon(CurrItem).Left = LeftPos
  183.      Next
  184.   Next
  185.   '
  186.   '  unload any extra controls from previous config
  187.   '
  188.   Do While (sLastLoaded + 1) > (gGridRows * gGridCols)
  189.      Unload frmButtonBar!cmdIcon(sLastLoaded)
  190.      sLastLoaded = sLastLoaded - 1
  191.   Loop
  192.  
  193.   frmButtonBar.Width = ((gGridCols * (frmButtonBar!cmdIcon(0).Width + 1)) + 1) * screen.TwipsPerPixelX
  194.   frmButtonBar.Height = ((gGridRows * (frmButtonBar!cmdIcon(0).Height + 1)) + sCaptionHeight) * screen.TwipsPerPixelY
  195.  
  196.   frmButtonBar.Refresh
  197.  
  198.   If gOnTop Then
  199.      flags = SWP_NOMOVE Or SWP_NOSIZE
  200.      Call SetWindowPos(frmButtonBar.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
  201.   Else
  202.      flags = SWP_NOMOVE Or SWP_NOSIZE
  203.      Call SetWindowPos(frmButtonBar.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags)
  204.   End If
  205.  
  206.   'Debug.Print sLastLoaded
  207. End Sub
  208.  
  209. Sub ButtonBarExecute (ByVal ItemNum)
  210. '
  211. '  execute the corresponding program for the button ItemNum
  212. '
  213. Dim temp%, RunDir$, ExeName$, Args$, Msg$
  214.  
  215.   ExeName$ = RTrim$(sMyItemInfo(ItemNum).ExeName)
  216.   RunDir$ = RTrim$(sMyItemInfo(ItemNum).WorkingDir)
  217.   Args$ = RTrim$(sMyItemInfo(ItemNum).Arguments)
  218.  
  219.   temp = ShellExecute(frmButtonBar.hWnd, "Open", ExeName$, Args$, RunDir$, SW_SHOWNORMAL)
  220.  
  221.   If temp < 32 Then
  222.     Select Case temp
  223.     Case 0:   Msg$ = "Insufficient system memory or corrupt program file."
  224.     Case 2:   Msg$ = "File not found."
  225.     Case 3:   Msg$ = "Invalid path."
  226.     Case 5:   Msg$ = "Sharing or protection error."
  227.     Case 6:   Msg$ = "Separate data segments are required for each task."
  228.     Case 8:   Msg$ = "Insufficient memory to run program."
  229.     Case 11:  Msg$ = "Invalid program file."
  230.     Case 14:  Msg$ = "Unknown program file type."
  231.     Case 16:  Msg$ = "Data segment error on loading second instance."
  232.     Case Else:  Msg$ = "Error" + Str$(temp)
  233.     End Select
  234.     MsgBadNews "Couldn't launch application..." & Chr$(13) & Chr$(10) & Msg$
  235.   End If
  236.  
  237. End Sub
  238.  
  239. Sub ButtonBarInit ()
  240. '
  241. '  Set up button bar...
  242. '
  243. Dim i%, j%
  244. Dim ActItems%, LeastY%, LeastX%, TheOne%, CurrIndex%
  245. Dim FoundDir%, ANDPlane$, XORPlane$, Title$, ExeName$
  246. Dim RunDir$, Params$, TestChr$, TempStr$
  247.  
  248. Dim hAndBmp%, hXorBmp%, lTmp&, iTmp%, w%, h%, p%, bp%
  249. Dim iconDC%, OldDc%
  250.  
  251. ReDim Taken(MAXITEMPTRS) As Integer
  252. '
  253. '  find actual/valid item pointers...
  254. '
  255. gActualItemCt = 0
  256. sLastLoaded = 0
  257. For i = 1 To sHdr.NumItems
  258.   If sItemPtr(i) Then gActualItemCt = gActualItemCt + 1
  259. Next
  260.  
  261. Select Case gActualItemCt
  262.   Case 0
  263.      MsgBombOut "No valid items in group file."
  264.   Case Is > MAXITEMS
  265.      MsgBombOut "Maximum of" & Str$(MAXITEMS) & " items allowed."
  266. End Select
  267.  
  268. frmButtonBar!cmdIcon(0).Width = sHdr.LogPixelsx + 4
  269. frmButtonBar!cmdIcon(0).Height = sHdr.LogPixelsy + 4
  270.  
  271. Open gGroupFilename$ For Binary As 1
  272. CurrIndex = 0
  273.  
  274. frmButtonBar!picTempIcon.Width = sHdr.LogPixelsx + 1
  275. frmButtonBar!picTempIcon.Height = sHdr.LogPixelsy + 1
  276.  
  277. ' create a working DC to transfer icons into;
  278. ' it's compatible with the picture box we want to xfer to
  279. iconDC = CreateCompatibleDC(frmButtonBar!picTempIcon.hDC)
  280. If iconDC = 0 Then
  281.    MsgBombOut "Couldn't create device context."
  282. End If
  283.  
  284. Do Until CurrIndex > (gActualItemCt - 1)
  285.    '
  286.    '  Sort by group window positions.  Just keep finding
  287.    '  the least one and tag it out...
  288.    '
  289.    LeastY = 32000
  290.    LeastX = 32000
  291.    For j = 1 To sHdr.NumItems
  292.       If Not Taken(j) And sItemPtr(j) Then
  293.         If (sItems(j).pt.y < LeastY) Then
  294.            LeastX = sItems(j).pt.x
  295.            LeastY = sItems(j).pt.y
  296.            TheOne = j
  297.         Else
  298.            If (sItems(j).pt.x < LeastX) And (sItems(j).pt.y <= LeastY) Then
  299.              LeastX = sItems(j).pt.x
  300.              LeastY = sItems(j).pt.y
  301.              TheOne = j
  302.            End If
  303.         End If
  304.       End If
  305.    Next
  306.  
  307.    Taken(TheOne) = True
  308.    
  309.    ' Load new button...
  310.    If CurrIndex > 0 Then
  311.       Load frmButtonBar!cmdIcon(CurrIndex)
  312.       sLastLoaded = sLastLoaded + 1
  313.    End If
  314.    
  315.    ' Get icon drawing planes...
  316.    ANDPlane$ = Space$(sItems(TheOne).ANDPlaneBytes)
  317.    XORPlane$ = Space$(sItems(TheOne).XORPlaneBytes)
  318.    Seek 1, (sItems(TheOne).OffsetANDPlane + 1)
  319.    Get 1, , ANDPlane$
  320.    Seek 1, (sItems(TheOne).OffsetXORPlane + 1)
  321.    Get 1, , XORPlane$
  322.    '
  323.    '  Load icon into button via temp pic control...
  324.    '
  325.    frmButtonBar!picTempIcon.Picture = LoadPicture("")
  326.    OldDc = SaveDC(iconDC)
  327.  
  328.    w = sHdr.LogPixelsx
  329.    h = sHdr.LogPixelsy
  330.    p = Asc(sHdr.Planes)
  331.    bp = Asc(sHdr.BitsPerPixel)
  332.    hAndBmp = CreateBitmap(w, h, 1, 1, "")
  333.    hXorBmp = CreateBitmap(w, h, p, bp, "")
  334.    If hAndBmp = 0 Or hXorBmp = 0 Then
  335.        MsgBombOut "Couldn't create bitmaps."
  336.    End If
  337.  
  338.    lTmp = SetBitmapBitsByString(hAndBmp, Len(ANDPlane$), ANDPlane$)
  339.    iTmp = SelectObject(iconDC, hAndBmp)
  340.    iTmp = BitBlt(frmButtonBar!picTempIcon.hDC, 0, 0, w, h, iconDC, 0, 0, SRCAND)
  341.  
  342.    lTmp = SetBitmapBitsByString(hXorBmp, Len(XORPlane$), XORPlane$)
  343.    iTmp = SelectObject(iconDC, hXorBmp)
  344.    iTmp = BitBlt(frmButtonBar!picTempIcon.hDC, 0, 0, w, h, iconDC, 0, 0, SRCINVERT)
  345.    
  346.    ' restore DC *then* we can delete objects
  347.    iTmp = RestoreDC(iconDC, OldDc)
  348.    iTmp = DeleteObject(hAndBmp)
  349.    iTmp = DeleteObject(hXorBmp)
  350.  
  351.    frmButtonBar!cmdIcon(CurrIndex).Picture = frmButtonBar!picTempIcon.Image
  352.    frmButtonBar!cmdIcon(CurrIndex).Visible = True
  353.  
  354.    RunDir$ = ""
  355.    Params$ = ""
  356.    ExeName$ = ""
  357.    
  358.    '  parse out all the filenames, args, etc...
  359.    TempStr$ = FileGetString$(1, sItems(TheOne).OffsetExeName + 1)
  360.    iTmp = Len(TempStr$)
  361.    FoundDir = False
  362.    '
  363.    '  Remember, the ExeName string is really
  364.    '  RunPath + "\" + ExeName + " " + Command line args
  365.    '
  366.    iTmp = InStr(TempStr$, " ")
  367.    If iTmp > 0 Then
  368.       Params$ = LTrim$(Mid$(TempStr$, iTmp + 1))
  369.       TempStr$ = Left$(TempStr$, iTmp - 1)
  370.    End If
  371.    iTmp = Len(TempStr$)
  372.    For i = iTmp To 1 Step -1
  373.       TestChr$ = Mid$(TempStr$, i, 1)
  374.       If TestChr$ = "\" Or TestChr$ = ":" Then
  375.         RunDir$ = Left$(TempStr$, i - 1)
  376.         ExeName$ = RTrim$(Mid$(TempStr$, i + 1))
  377.         FoundDir = True
  378.         Exit For
  379.       End If
  380.    Next
  381.    If Not FoundDir Then ExeName$ = TempStr$
  382.    
  383.    ' attach ExePath (retrieved earlier) to ExeName
  384.    ExeName$ = sCommandPath$(TheOne - 1) + ExeName$
  385.  
  386.    sMyItemInfo(CurrIndex).ExeName = ExeName$
  387.    sMyItemInfo(CurrIndex).WorkingDir = RunDir$
  388.    sMyItemInfo(CurrIndex).Arguments = Params$
  389.  
  390.    CurrIndex = CurrIndex + 1
  391. Loop
  392.  
  393. iTmp = DeleteDC(iconDC)
  394. Title$ = FileGetString(1, sHdr.OffsetName + 1)
  395. Close
  396. '
  397. '  Config & display button bar...
  398. '
  399. frmButtonBar.ScaleMode = 1
  400. frmButtonBar.Caption = Title$
  401. frmButtonBar.Tag = gActualItemCt
  402. Call IniLoad
  403. '
  404. '  Czech configuration & reset if necessary
  405. '  (gGridRows=0 means no previous .ini entry)
  406. '
  407. If (gGridRows = 0) Or (gGridRows * gGridCols < gActualItemCt) Then
  408.    If gGridRows <> 0 Then
  409.       MsgBox "Grid reconfigured because of new items.", MB_SYSTEMMODAL Or MB_ICONINFORMATION, "Another Button Bar"
  410.    End If
  411.    gOnTop = False
  412.    frmButtonBar.Left = 0
  413.    frmButtonBar.Top = 0
  414.    gGridCols = 10
  415.    gGridRows = CInt(gActualItemCt / gGridCols + .4)
  416.    If gActualItemCt < 10 Then gGridCols = gActualItemCt
  417. End If
  418.  
  419. Call ButtonBarDraw
  420. frmButtonBar.Show
  421.  
  422. ' get black focus border off buttons
  423. frmButtonBar!picTempIcon.SetFocus
  424. App.Title = Title$ & " (Buttons)"
  425.  
  426. End Sub
  427.  
  428. Sub CenterForm (Theform As Form)
  429.  
  430.   Theform.Move ((screen.Width / 2) - (Theform.Width / 2)), ((screen.Height / 2) - (Theform.Height / 2))
  431.  
  432. End Sub
  433.  
  434. Function FileGetString$ (FileNum, Offset)
  435. '
  436. '  Start at current position in file and get string
  437. '  until null termination...
  438. '
  439. Dim Bit As String * 1, temp$
  440.  
  441.   Seek FileNum, Offset
  442.   temp$ = ""
  443.   Do
  444.     Get 1, , Bit
  445.     If Asc(Bit) Then temp$ = temp$ & Bit
  446.   Loop While Asc(Bit)
  447.   FileGetString$ = temp$
  448.  
  449. End Function
  450.  
  451. Sub GetGroupFilename ()
  452.  
  453.    frmLoadGroup.Show 1
  454.    Exit Sub
  455.  
  456. End Sub
  457.  
  458. Function GetGroupName$ (Filename$)
  459. Dim TempHdr As GroupHeaderType
  460. Dim InFile As Integer
  461.  
  462.   InFile = FreeFile
  463.   Open Filename$ For Binary As InFile
  464.   Get InFile, , TempHdr
  465.   GetGroupName$ = FileGetString$(InFile, TempHdr.OffsetName + 1)
  466.   Close InFile
  467.  
  468. End Function
  469.  
  470. Sub GetItemInfo ()
  471. '
  472. '  Get item pointers and some other info from group file
  473. '
  474. Dim i%, Done%, TagPos%
  475. Dim TagData As TagDataType
  476.  
  477.   Open gGroupFilename$ For Binary As 1
  478.   '
  479.   '  get the Group header
  480.   '
  481.   Get 1, , sHdr
  482.   '
  483.   '  get program item pointers
  484.   '
  485.   For i = 1 To sHdr.NumItems
  486.     Get 1, , sItemPtr(i)
  487.   Next
  488.   '
  489.   '  get valid item info
  490.   '
  491.   For i = 1 To sHdr.NumItems
  492.     If sItemPtr(i) Then
  493.       Seek 1, (sItemPtr(i) + 1)
  494.       Get 1, , sItems(i)
  495.     End If
  496.   Next
  497.   '
  498.   '  Get "tag" data which contains window state and .exe
  499.   '  paths if any.  This code was gleaned from PC Mag's
  500.   '  BTNGO program in C.
  501.   '
  502.   TagPos = sHdr.OffsetTag + 1
  503.   Seek 1, TagPos
  504.   Done = False
  505.   Do
  506.     Get 1, , TagData
  507.     Select Case TagData.Id
  508.       Case &H8101
  509.          sCommandPath$(TagData.Item) = FileGetString$(1, Loc(1))
  510.       Case &HFFFF, 0
  511.          Done = True
  512.     End Select
  513.     TagPos = TagPos + TagData.NextPtr
  514.     Seek 1, TagPos
  515.   Loop Until Done
  516.  
  517.   Close
  518.  
  519. End Sub
  520.  
  521. Sub IniLoad ()
  522. '
  523. '  Find group file's .ini data if there...
  524. '
  525. Dim tmp%
  526. Dim GroupName$, IniFile$, KeyName$, Default$
  527. Dim ReturnString As String * 40
  528. Dim ReturnLen As Integer
  529.  
  530.   IniFile$ = "tkbar.ini"
  531.   GroupName$ = gGroupFilename$
  532.   '
  533.   '  read in ini file info...
  534.   '
  535.   Default$ = ""
  536.   KeyName$ = "Top"
  537.   ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
  538.   '
  539.   '  was it there?
  540.   '
  541.   If ReturnLen <> 0 Then
  542.      frmButtonBar.Top = Val(Left$(ReturnString$, ReturnLen))
  543.  
  544.      KeyName$ = "Left"
  545.      ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
  546.      frmButtonBar.Left = Val(Left$(ReturnString$, ReturnLen))
  547.  
  548.      KeyName$ = "Rows"
  549.      ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
  550.      gGridRows = Val(Left$(ReturnString$, ReturnLen))
  551.  
  552.      KeyName$ = "Columns"
  553.      ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
  554.      gGridCols = Val(Left$(ReturnString$, ReturnLen))
  555.  
  556.      KeyName$ = "AlwaysOnTop"
  557.      ReturnLen = GetPrivateProfileString%(GroupName$, KeyName$, Default$, ReturnString$, Len(ReturnString$), IniFile$)
  558.      If Val(Left$(ReturnString$, ReturnLen)) > 0 Then
  559.         gOnTop = True
  560.      Else
  561.         gOnTop = False
  562.      End If
  563.   Else
  564.      gGridRows = 0
  565.      gGridCols = 0
  566.   End If
  567.  
  568. End Sub
  569.  
  570. Sub IniSave ()
  571. '
  572. '  Save out configuration...
  573. '
  574. Dim tmp%
  575. Dim GroupName$, IniFile$, KeyName$, KeyValue$
  576.  
  577.   GroupName$ = gGroupFilename$
  578.   IniFile$ = "tkbar.ini"
  579.  
  580.   KeyName$ = "Top"
  581.   KeyValue$ = LTrim$(Str$(frmButtonBar.Top))
  582.   tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)
  583.  
  584.   KeyName$ = "Left"
  585.   KeyValue$ = LTrim$(Str$(frmButtonBar.Left))
  586.   tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)
  587.  
  588.   KeyName$ = "Rows"
  589.   KeyValue$ = LTrim$(Str$(gGridRows))
  590.   tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)
  591.  
  592.   KeyName$ = "Columns"
  593.   KeyValue$ = LTrim$(Str$(gGridCols))
  594.   tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)
  595.  
  596.   KeyName$ = "AlwaysOnTop"
  597.   If gOnTop Then KeyValue$ = "1" Else KeyValue$ = "0"
  598.   tmp = WritePrivateProfileString%(GroupName$, KeyName$, KeyValue$, IniFile$)
  599.  
  600. End Sub
  601.  
  602. Sub Main ()
  603.  
  604. Dim CrLf As String
  605. Dim tmp As Integer
  606.  
  607.   CrLf$ = Chr$(13) & Chr$(10)
  608.  
  609.   gWindowsDir$ = Space$(255)
  610.   tmp = GetWindowsDirectory(gWindowsDir$, 255)
  611.   gWindowsDir$ = Left$(gWindowsDir$, tmp)
  612.   sCaptionHeight = GetSystemMetrics(SM_CYCAPTION)
  613.   '
  614.   '  if no command line argument...
  615.   '
  616.   gGroupFilename$ = Command$
  617.   '
  618.   '  bring up Load Group dialog
  619.   '
  620.   If gGroupFilename$ = "" Then
  621.      Call GetGroupFilename
  622.      If gGroupFilename$ = "" Then End
  623.   End If
  624.   '
  625.   '  do brief czeching on file name...
  626.   '
  627.   If InStr(UCase$(gGroupFilename$), ".GRP") = 0 Then
  628.      MsgBombOut Chr$(34) & gGroupFilename$ & Chr$(34) & CrLf$ & "Invalid file name"
  629.   End If
  630.  
  631.   If Dir$(gGroupFilename$) = "" Then
  632.      MsgBombOut Chr$(34) & gGroupFilename$ & Chr$(34) & CrLf$ & "Invalid file name"
  633.   End If
  634.   '
  635.   '  do it!
  636.   '
  637.   GetItemInfo
  638.   ButtonBarInit
  639.  
  640. End Sub
  641.  
  642. Sub MsgBadNews (Message$)
  643. ' non-fatal message
  644. MsgBox Message$, MB_ICONEXCLAMATION Or MB_SYSTEMMODAL, "Another Button Bar"
  645.  
  646. End Sub
  647.  
  648. Sub MsgBombOut (Message$)
  649. ' fatal message
  650. MsgBox Message$, MB_ICONEXCLAMATION Or MB_SYSTEMMODAL, "Another Button Bar"
  651. End
  652.  
  653. End Sub
  654.  
  655.