Zodiac Super OZ/MEDIADEPOT.ISO/FILES/13/VOL15N11.ZIP/TBWIZ.ZIP/TBLOAD.FRM

Text File | 1996-02-24 | 9KB | 295 lines

VERSION 4.00
Begin VB.Form tbLoadForm
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Load Toolbar"
   ClientHeight    =   1590
   ClientLeft      =   4680
   ClientTop       =   6795
   ClientWidth     =   4515
   ControlBox      =   0   'False
   Height          =   1995
   Left            =   4620
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1590
   ScaleWidth      =   4515
   ShowInTaskbar   =   0   'False
   Top             =   6450
   Width           =   4635
   Begin VB.CommandButton Command2
      Caption         =   "Cancel"
      Height          =   325
      Left            =   3480
      TabIndex        =   2
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton Command1
      Caption         =   "&Open"
      Height          =   325
      Left            =   3480
      TabIndex        =   4
      Top             =   240
      Width           =   975
   End
   Begin VB.Frame Frame1
      Caption         =   "Name Controls:"
      Height          =   1335
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3135
      Begin VB.TextBox Text1
         Height          =   285
         Index           =   1
         Left            =   1200
         TabIndex        =   6
         Text            =   "tbwizIL1"
         Top             =   840
         Width           =   1695
      End
      Begin VB.TextBox Text1
         Height          =   285
         Index           =   0
         Left            =   1200
         TabIndex        =   5
         Text            =   "tbwizTB1"
         Top             =   360
         Width           =   1695
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "ImageList:"
         Height          =   195
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   860
         Width           =   720
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "Toolbar:"
         Height          =   195
         Index           =   0
         Left            =   360
         TabIndex        =   1
         Top             =   390
         Width           =   585
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   3720
      Top             =   1080
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
      DefaultExt      =   "*.tbr"
      DialogTitle     =   "Load Toolbar"
      Filter          =   "*.tbr | Toolbars"
   End
End
Attribute VB_Name = "tbLoadForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit




Function LoadTB() As Integer
'___init vars
Dim CurrFormName$, CurrFormFiles$(1)
Dim i%, ii%
Dim success As Boolean
Dim MyForm As Object
Dim qm$
qm = Chr$(34)
Const frx = ".frx"
Dim guid$, major$, minor$, ocx$
guid$ = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}"
major$ = "1.0"
minor$ = "0"
ocx$ = "COMCTL32.OCX"


'___get project info
With gobjIDEAppInst.ActiveProject
    '___add reference to toolbar & imagelist controls
    On Error Resume Next
    .AddToolboxTypelib guid$, major$, minor$, ocx$
    On Error GoTo 0

    '___get form file names
    CurrFormName$ = .ActiveForm.Properties.Item("Name")
    With .Components
        For i% = 0 To .Count - 1
            If .Item(i%).Name = CurrFormName$ Then
                CurrFormFiles$(0) = .Item(i%).FileNames(0)
                CurrFormFiles$(1) = .Item(i%).FileNames(1)
                Set MyForm = .Item(i%)
            End If
        Next
    End With
End With
On Error GoTo 0

'___make sure this file has been saved
If Exists%(CurrFormFiles$(0)) = 0 Then
    Alert "Please save " & CurrFormName$ & "before attempting to load a toolbar onto it."
    LoadTB = 0
    Exit Function
End If

'___get TBR file name from user
On Error Resume Next
CommonDialog1.FileName = "*.tbr"
CommonDialog1.ShowOpen
If Err = cdlCancel Then LoadTB = 0: Exit Function
On Error GoTo 0
gfnameTBFile = CommonDialog1.FileName

'___init some more vars
Screen.MousePointer = HOURGLASS
Const icTest = "ComctlLib.ImageList"
Const tbTest = "ComctlLib.Toolbar"
Dim linetest$
Dim Target$
Dim Source$
Dim tmpfile$
Dim frxTarg$
Dim BeenThere As Boolean
Dim ilOrg$, ilNew$
Dim tbOrg$, tbNew$
ilNew$ = Text1(1)
tbNew$ = Text1(0)

'___build source, target and temp file names
frxTarg$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile)
Source$ = gfnameTBFile
If Exists%(Source$) = 0 Then Alert "Can't find that toolbar file!": Exit Function
Target$ = CurrFormFiles$(0)
tmpfile$ = ExtractFilePath$(Target$) + "tmpfrm.frm"

'___remove target form from project & rename it
ii% = gobjIDEAppInst.ActiveProject.RemoveComponent(MyForm, True)
Name Target$ As tmpfile$
Open Target$ For Output As #1
Open tmpfile$ For Input As #3

'___run through tbr file to determine original names of toolbar & imagelist controls
Open Source$ For Input As #2
Do While Not EOF(2)
     Line Input #2, linetest$
     If InStr(linetest$, icTest$) > 0 Then
        linetest$ = Trim$(linetest$)
        For ii% = Len(linetest$) To 1 Step -1
            If Mid$(linetest$, ii%, 1) = Chr$(32) Then
                ilOrg$ = Mid$(linetest$, ii% + 1)
                Exit For
            End If
        Next
    End If
    If InStr(linetest$, tbTest$) > 0 Then
        linetest$ = Trim$(linetest$)
        For ii% = Len(linetest$) To 1 Step -1
            If Mid$(linetest$, ii%, 1) = Chr$(32) Then
                tbOrg$ = Mid$(linetest$, ii% + 1)
                Exit For
            End If
        Next
    End If
    If (Len(tbOrg$) * Len(ilOrg$)) <> 0 Then Exit Do
Loop
Close #2

'__*** showtime ***
'___copy current form file line by line into target file
Open Source$ For Input As #2
Do While Not EOF(3)
   Line Input #3, linetest$
   Print #1, linetest$
   '___insert control defs from toolbar file into target after form WIDTH definition
   If (Left$(Trim$(linetest$), 5)) = "Width" And (BeenThere = False) Then
         BeenThere = True
         Line Input #2, linetest$
         Do Until Trim$(linetest$) = "TB_EVENTS"
           If InStr(linetest$, frx) > 0 Then    '___fix frx file reference
                i% = InStr(linetest$, qm)
                linetest$ = Left$(linetest$, i%) + frxTarg$ + Mid$(linetest$, (InStr(linetest$, frx)))
           End If
           '___substitute new names for tb & il controls
           i% = InStr(linetest$, ilOrg$)
           If i% > 0 Then
              linetest$ = Left$(linetest$, i% - 1) + ilNew$ + Mid$(linetest$, i% + Len(ilOrg$))
           End If
           i% = InStr(linetest$, tbOrg$)
           If i% > 0 Then
              linetest$ = Left$(linetest$, i% - 1) + tbNew$ + Mid$(linetest$, i% + Len(tbOrg$))
           End If
           Print #1, linetest$
           Line Input #2, linetest$
         Loop
   End If
'___copy remainder of form source file
Loop

'___now add tbr event handling code to end of target file
Do Until EOF(2)
           Line Input #2, linetest$
            '___substitute specified names for il & tb
            i% = InStr(linetest$, ilOrg$)
           If i% > 0 Then
              linetest$ = Left$(linetest$, i% - 1) + ilNew$ + Mid$(linetest$, i% + Len(ilOrg$))
           End If
           i% = InStr(linetest$, tbOrg$)
           If i% > 0 Then
              linetest$ = Left$(linetest$, i% - 1) + tbNew$ + Mid$(linetest$, i% + Len(tbOrg$))
           End If
           Print #1, linetest$
Loop
'___clean up
Close #1
Close #2
Close #3
Kill tmpfile$
'___bring form file  back into project
tmpfile$ = gobjIDEAppInst.ActiveProject.AddFile(Target$)
Set MyForm = Nothing
'___wait a bit
i% = DoEvents%()
i% = DoEvents%()
i% = DoEvents%()
'___force VB show the newly augmented form by sending ENTER to Project window
tmpfile$ = ExtractFileRoot$(gobjIDEAppInst.ActiveProject.FileName)
AppActivate tmpfile$
SendKeys "{ENTER}"
End Function



Private Sub Command1_Click()
'load a toolbar
Dim i%
i% = LoadTB()
Screen.MousePointer = DEFAULT
Unload Me
End Sub

Private Sub Command2_Click()
'cancel
Unload Me
End Sub

Private Sub Form_Load()
'bring non modal window to top
WinCenter Me
Show
Me.SetFocus
End Sub