home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX" Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX" Begin VB.Form frmMain Caption = "Seagate Crystal Report Engine Automation Server" ClientHeight = 6450 ClientLeft = 210 ClientTop = 1710 ClientWidth = 9480 Icon = "Main.frx":0000 LinkTopic = "Form1" ScaleHeight = 6450 ScaleWidth = 9480 Begin ComctlLib.Toolbar tbToolbar Align = 1 'Align Top Height = 420 Left = 0 TabIndex = 6 Top = 300 Width = 9480 _ExtentX = 16722 _ExtentY = 741 ButtonWidth = 635 ButtonHeight = 582 Appearance = 1 ImageList = "imlIcons" _Version = 327680 BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} NumButtons = 14 BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Bacx" Object.ToolTipText = "Back" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Back" Object.ToolTipText = "Back" Object.Tag = "" ImageIndex = 1 EndProperty BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Forward" Object.ToolTipText = "Forward" Object.Tag = "" ImageIndex = 2 EndProperty BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Save" Object.ToolTipText = "Save" Object.Tag = "" ImageIndex = 19 EndProperty BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Cut" Object.ToolTipText = "Cut" Object.Tag = "" ImageIndex = 3 EndProperty BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Copy" Object.ToolTipText = "Copy" Object.Tag = "" ImageIndex = 4 EndProperty BeginProperty Button9 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Paste" Object.ToolTipText = "Paste" Object.Tag = "" ImageIndex = 5 EndProperty BeginProperty Button10 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Delete" Object.ToolTipText = "Delete" Object.Tag = "" ImageIndex = 6 EndProperty BeginProperty Button11 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button12 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Bold" Object.ToolTipText = "Bold" Object.Tag = "" ImageIndex = 7 EndProperty BeginProperty Button13 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Italic" Object.ToolTipText = "Italic" Object.Tag = "" ImageIndex = 8 EndProperty BeginProperty Button14 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Visible = 0 'False Key = "Underline" Object.ToolTipText = "Underline" Object.Tag = "" ImageIndex = 9 EndProperty EndProperty MouseIcon = "Main.frx":030A End Begin ComctlLib.StatusBar sbStatusBar Align = 2 'Align Bottom Height = 285 Left = 0 TabIndex = 0 Top = 6165 Width = 9480 _ExtentX = 16722 _ExtentY = 503 SimpleText = "" _Version = 327680 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 3 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} AutoSize = 1 Object.Width = 11086 Text = "Status" TextSave = "Status" Key = "" Object.Tag = "" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 6 AutoSize = 2 TextSave = "8/15/97" Key = "" Object.Tag = "" EndProperty BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 5 AutoSize = 2 TextSave = "3:25 PM" Key = "" Object.Tag = "" EndProperty EndProperty MouseIcon = "Main.frx":0326 End Begin ComctlLib.TreeView tvTreeView Height = 5040 Left = 0 TabIndex = 4 Top = 735 Width = 3930 _ExtentX = 6932 _ExtentY = 8890 _Version = 327680 HideSelection = 0 'False Indentation = 529 Style = 7 ImageList = "imlObjects" Appearance = 1 MouseIcon = "Main.frx":0342 End Begin VB.PictureBox picTitles Align = 1 'Align Top Appearance = 0 'Flat BorderStyle = 0 'None ForeColor = &H80000008& Height = 300 Left = 0 ScaleHeight = 300 ScaleWidth = 9480 TabIndex = 1 TabStop = 0 'False Top = 0 Width = 9480 Begin VB.Label lblTitle BorderStyle = 1 'Fixed Single Caption = "Details" Height = 270 Index = 1 Left = 2205 TabIndex = 3 Tag = " ListView:" Top = 15 Width = 9300 End Begin VB.Label lblTitle BorderStyle = 1 'Fixed Single Caption = "Crystal Objects" Height = 270 Index = 0 Left = 120 TabIndex = 2 Tag = " TreeView:" Top = 15 Width = 2010 End End Begin RichTextLib.RichTextBox rtxtCode Height = 5040 Left = 4140 TabIndex = 5 Top = 705 Width = 7365 _ExtentX = 12991 _ExtentY = 8890 _Version = 327680 Enabled = -1 'True HideSelection = 0 'False ScrollBars = 2 RightMargin = 5 AutoVerbMenu = -1 'True OLEDragMode = 0 OLEDropMode = 0 TextRTF = $"Main.frx":035E End Begin ComctlLib.ImageList imlObjects Left = 1485 Top = 5640 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 327680 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 5 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":0445 Key = "Event" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":075F Key = "CRPE" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":0A79 Key = "Method" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":0D93 Key = "Property" EndProperty BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":10AD Key = "Object" EndProperty EndProperty End Begin VB.Image imgSplitter Height = 5040 Left = 3960 MousePointer = 9 'Size W E Top = 735 Width = 150 End Begin ComctlLib.ImageList imlIcons Left = 840 Top = 5730 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 327680 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 19 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":13C7 Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":1919 Key = "" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":1E6B Key = "" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":23BD Key = "" EndProperty BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":290F Key = "" EndProperty BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":2E61 Key = "" EndProperty BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":33B3 Key = "" EndProperty BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":34C5 Key = "" EndProperty BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":35D7 Key = "" EndProperty BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":36E9 Key = "Item" EndProperty BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":3C3B Key = "" EndProperty BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":418D Key = "" EndProperty BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":46DF Key = "" EndProperty BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":4C31 Key = "" EndProperty BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":5183 Key = "closedfldr" EndProperty BeginProperty ListImage16 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":549D Key = "OpenFolder" EndProperty BeginProperty ListImage17 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":57B7 Key = "CRPE" EndProperty BeginProperty ListImage18 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":5AD1 Key = "Object" EndProperty BeginProperty ListImage19 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Main.frx":5DEB Key = "Save" EndProperty EndProperty End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileExit Caption = "E&xit" End End Begin VB.Menu mnuEdit Caption = "&Edit" Begin VB.Menu mnuEditCopy Caption = "&Copy" Shortcut = ^C End End Begin VB.Menu mnuView Caption = "&View" Begin VB.Menu mnuViewToolbar Caption = "&Toolbar" Checked = -1 'True End Begin VB.Menu mnuViewStatusBar Caption = "Status &Bar" Checked = -1 'True End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHelpContents Caption = "&Contents" End Begin VB.Menu mnuHelpSearch Caption = "&Search For Help On..." End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any) Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long Private m_bMoving As Boolean Private m_nodX As Node Private m_DirtyFlag As DirtyFlag Private m_DirtyNode As String Private m_Response As Integer Private m_bLoadingRTF As Boolean Private m_strTemp As String Private m_bAdded As Boolean Const sglSplitLimit = 500 Private Sub cmdExit_Click() ' quit application On Error Resume Next Unload Me End Sub Private Sub Form_Load() ' restore last window settings, ' load the treelist with Automation Server object names Dim Index As Integer 'Node counter On Error GoTo Form_Load_Err: 'retain screen settings from last session Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000) Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000) Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500) Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500) 'add Automation Server objects to TreeView GetNodeFromIniFile 'expand the first level by default tvTreeView.Nodes(1).Expanded = True 'disable label editing tvTreeView.LabelEdit = tvwManual 'load the rtf file for the root node rtxtCode.filename = App.Path & "\Source\CRPEAuto.rtf" Form_Load_Exit: Exit Sub Form_Load_Err: MsgBox Error$ GoTo Form_Load_Exit: Resume 0 End Sub Private Sub Form_Unload(Cancel As Integer) ' Save window settings, prompt to save dirty objects Dim i As Integer ' check dirtyflags, save dirty stuff If m_DirtyFlag.TreeView Then If MsgBox("Save Object List?", vbInformation + vbOKCancel, "Unsaved Data Warning") = vbOK Then SaveObjectList End If End If 'close all sub forms For i = Forms.Count - 1 To 1 Step -1 Unload Forms(i) Next If Me.WindowState <> vbMinimized Then SaveSetting App.Title, "Settings", "MainLeft", Me.Left SaveSetting App.Title, "Settings", "MainTop", Me.Top SaveSetting App.Title, "Settings", "MainWidth", Me.Width SaveSetting App.Title, "Settings", "MainHeight", Me.Height End If End Sub Private Sub mnuFileSave_Click() ' save the current Richtext object On Error GoTo mnuFileSave_Click_Err: MousePointer = vbHourglass 'Dim strFilename As String 'strFilename = rtxtCode.filename rtxtCode.SaveFile rtxtCode.filename m_DirtyFlag.rtf = False ' made it here with no error, file was saved mnuFileSave_Click_Exit: MousePointer = vbDefault Exit Sub mnuFileSave_Click_Err: MsgBox Error$ GoTo mnuFileSave_Click_Exit: End Sub Private Sub mnuViewBrowser_Click() 'Dim frmB As New frmBrowser 'frmB.StartingAddress = "http://elvis/aristotle/default.asp" 'frmB.Show End Sub Private Sub mnuFileExit_Click() ' Unload Form Unload Me End Sub Private Sub mnuViewStatusBar_Click() If mnuViewStatusBar.Checked Then sbStatusBar.Visible = False mnuViewStatusBar.Checked = False Else sbStatusBar.Visible = True mnuViewStatusBar.Checked = True End If SizeControls imgSplitter.Left End Sub Private Sub mnuViewToolbar_Click() If mnuViewToolbar.Checked Then tbToolbar.Visible = False mnuViewToolbar.Checked = False Else tbToolbar.Visible = True mnuViewToolbar.Checked = True End If SizeControls imgSplitter.Left End Sub Private Sub Form_Resize() Static bDone As Boolean On Error Resume Next SizeControls imgSplitter.Left End Sub Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) With imgSplitter rtxtCode.Move .Left, .Top, .Width \ 2, .Height - 20 End With m_bMoving = True End Sub Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim sglPos As Single If m_bMoving Then sglPos = x + imgSplitter.Left If sglPos < sglSplitLimit Then rtxtCode.Left = sglSplitLimit ElseIf sglPos > Me.Width - sglSplitLimit Then rtxtCode.Left = Me.Width - sglSplitLimit Else rtxtCode.Left = sglPos End If End If End Sub Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) SizeControls rtxtCode.Left rtxtCode.Visible = True m_bMoving = False End Sub Sub SizeControls(x As Single) On Error Resume Next Dim intHeight As Integer 'set the width If x < 1500 Then x = 1500 If x > (Me.Width - 1500) Then x = Me.Width - 1500 tvTreeView.Width = x imgSplitter.Left = x rtxtCode.Left = x + 40 rtxtCode.Width = Me.Width - (tvTreeView.Width + 140) lblTitle(0).Width = tvTreeView.Width lblTitle(1).Left = rtxtCode.Left + 20 lblTitle(1).Width = rtxtCode.Width - 40 'set the top If tbToolbar.Visible Then tvTreeView.Top = tbToolbar.Height + picTitles.Height Else tvTreeView.Top = picTitles.Height End If rtxtCode.Top = tvTreeView.Top If sbStatusBar.Visible Then If tbToolbar.Visible Then 'take off the status bar height if it is not visible intHeight = Me.ScaleHeight - (picTitles.Height + sbStatusBar.Height + tbToolbar.Height) Else intHeight = Me.ScaleHeight - (picTitles.Height + sbStatusBar.Height) End If Else If tbToolbar.Visible Then intHeight = Me.ScaleHeight - (picTitles.Height + tbToolbar.Height) Else intHeight = Me.ScaleHeight - picTitles.Height End If End If tvTreeView.Height = intHeight rtxtCode.Height = intHeight imgSplitter.Top = tvTreeView.Top imgSplitter.Height = intHeight End Sub Private Sub rtxtCode_Change() If Not m_bLoadingRTF Then m_DirtyFlag.rtf = True End If End Sub Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button) Select Case Button.Key Case "Back" If Not tvTreeView.SelectedItem.Parent Is Nothing Then tvTreeView.SelectedItem = tvTreeView.SelectedItem.Parent End If Case "Forward" If Not tvTreeView.SelectedItem.Child Is Nothing Then tvTreeView.SelectedItem = tvTreeView.SelectedItem.Child End If Case "Cut" 'mnuEditCut_Click Case "Copy" mnuEditCopy_Click Case "Paste" 'mnuEditPaste_Click Case "Delete" 'mnuFileDelete_Click Case "Properties" 'mnuFileProperties_Click Case "Save" 'rtxtCode.SaveFile App.Path & "\" & tvTreeView.SelectedItem.Text & ".rtf" 'mnuFileSave_Click Case "bold" 'togglebuttonvalue Button 'rtxtCode.SelBold = (Button.Value = tbrPressed) Case "italic" 'togglebuttonvalue Button 'rtxtCode.SelItalic = (Button.Value = tbrPressed) Case "underline" 'togglebuttonvalue Button 'rtxtCode.SelUnderline = (Button.Value = tbrPressed) End Select End Sub Private Sub mnuHelpContents_Click() Dim nRet As Integer 'if there is no helpfile for this project display a message to the user 'you can set the HelpFile for your application in the 'Project Properties dialog If Len(App.HelpFile) = 0 Then MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption Else On Error Resume Next nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0) If Err Then MsgBox Err.Description End If End If End Sub Private Sub mnuHelpSearch_Click() Dim nRet As Integer 'if there is no helpfile for this project display a message to the user 'you can set the HelpFile for your application in the 'Project Properties dialog If Len(App.HelpFile) = 0 Then MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption Else On Error Resume Next nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0) If Err Then MsgBox Err.Description End If End If End Sub Private Sub mnuViewRefresh_Click() 'To Do 'MsgBox "Refresh Code goes here!" End Sub Private Sub mnuEditCopy_Click() Clipboard.Clear Clipboard.SetText rtxtCode.SelText, vbCFText End Sub Private Sub mnuEditCut_Click() 'To Do 'MsgBox "Cut Code goes here!" End Sub Private Sub mnuEditDSelectAll_Click() 'To Do 'MsgBox "Select All Code goes here!" End Sub Private Sub mnuEditInvertSelection_Click() 'To Do 'MsgBox "Invert Selection Code goes here!" End Sub Private Sub mnuEditPaste_Click() 'To Do 'MsgBox "Paste Code goes here!" End Sub Private Sub mnuEditPasteSpecial_Click() 'To Do 'MsgBox "Paste Special Code goes here!" End Sub Private Sub mnuEditUndo_Click() 'To Do 'MsgBox "Undo Code goes here!" End Sub Private Sub mnuFileOpen_Click() 'To Do 'MsgBox "Open Code goes here!" End Sub Private Sub mnuFileFind_Click() 'To Do 'MsgBox "Find Code goes here!" End Sub Private Sub mnuFileSendTo_Click() 'To Do 'MsgBox "Send To Code goes here!" End Sub Private Sub mnuFileNew_Click() 'To Do 'MsgBox "New File Code goes here!" End Sub Private Sub mnuFileDelete_Click() 'To Do 'MsgBox "Delete Code goes here!" End Sub Private Sub mnuFileRename_Click() 'To Do 'MsgBox "Rename Code goes here!" End Sub Private Sub mnuFileProperties_Click() 'To Do 'MsgBox "Properties Code goes here!" End Sub Private Sub mnuFileMRU_Click(Index As Integer) 'To Do 'MsgBox "MRU Code goes here!" End Sub Private Sub tvTreeView_NodeClick(ByVal Node As ComctlLib.Node) ' Display sample code for the selected node On Error GoTo tvTreeView_NodeClick_Err: Dim lngResult As Long Dim strFileName As String Dim strDash As String Dim strParent As String '***************************************** '* temporary desabled '***************************************** ' tell Change event not to set dirty flag 'm_bLoadingRTF = True Node.Selected = True '***************************************** '* temporary desabled '***************************************** ' save file first if dirty 'If m_DirtyNode = "" Then ' m_DirtyNode = Node.Text 'ElseIf m_DirtyFlag.rtf = True And tvTreeView.SelectedItem.Text <> m_DirtyNode Then ' m_Response = MsgBox("Do you wish to save: " & m_DirtyNode, vbQuestion + vbYesNo) ' If m_Response = vbYes Then ' mnuFileSave_Click ' End If ' clear the dirty flag regardless of user choice ' m_DirtyFlag.rtf = False ' store the name of the current node for next comparison ' m_DirtyNode = Node.Text 'End If If Node = tvTreeView.Nodes(1).Root Then strDash = "" strParent = "" strFileName = App.Path & "\Source\" & "CRPEAuto" & ".rtf" ElseIf Node.Image = "Method" Then strDash = "1" strParent = Node.Parent.Text strFileName = App.Path & "\Source\" & strDash & Node.Text & strParent & ".rtf" ElseIf Node.Image = "Event" Then strDash = "2" strParent = Node.Parent.Text strFileName = App.Path & "\Source\" & strDash & Node.Text & strParent & ".rtf" ElseIf Node.Image = "Property" Then strDash = "0" strParent = Node.Parent.Text strFileName = App.Path & "\Source\" & strDash & strParent & ".rtf" ElseIf Node.Image = "Object" Then strDash = "0" strParent = "" strFileName = App.Path & "\Source\" & strDash & Node.Text & strParent & ".rtf" End If rtxtCode.filename = strFileName tvTreeView_NodeClick_Exit: m_bLoadingRTF = False Exit Sub tvTreeView_NodeClick_Err: If Err.Number = 75 Then ' file not found ' create new file for this node 'lngResult = CopyFile(App.Path & "\new.rtf", strFileName, 1) 'If Dir$(strFileName) <> "" Then 'Resume 0 'Else ' didn't work, ignore and exit 'End If End If End Sub Public Sub GetNodeFromIniFile() ' load treelist with object descriptors ' in Browser.ini (comma delimeted file) On Error GoTo GetNodeFromIniFileError Dim intFile As Integer ' open the object descriptor file intFile = FreeFile Open GetIniFilePath For Input Access Read As #intFile ' parse each line in file, create nodes in treelist While Not EOF(intFile) m_bAdded = True ' get next line from file Line Input #intFile, m_strTemp m_strTemp = Trim$(m_strTemp) ' if first char is apostrophe, it is a comment; don't process If Left$(m_strTemp, 1) <> "'" Then 'add node to treeview (not from lstSortFile) AddNodeToTreeView Else 'line was a comment End If Wend GetNodeFromIniFileExit: On Error Resume Next Close #intFile Exit Sub GetNodeFromIniFileError: If Err.Number = 35602 Then 'duplicate item.. ignore (do not add) m_bAdded = False Resume Next ElseIf Err.Number = 35601 Then 'item not found.. ignore (do not add) m_bAdded = False Resume Next Else MsgBox Error$ End If GoTo GetNodeFromIniFileExit: Resume 0 End Sub Public Function GetIniFilePath() As String GetIniFilePath = App.Path & "\" & App.Title & ".ini" End Function Private Sub togglebuttonvalue(btn As Button) ' makes normal buttons act like toggles ' useful for toolbar buttons that can be on or off ' when you don't want them to be part of a button group On Error Resume Next Static cButtons As Collection Static bSet As Boolean Dim intState As Integer Dim intNewState As Integer If Not bSet Then bSet = True Set cButtons = New Collection End If intState = cButtons(btn.Key) If Err = 0 Then 'have a value Else 'btn not in collection yet... add it Err.Clear intState = tbrUnpressed 'first time, it is always unpressed cButtons.Add intState, btn.Key End If If Err = 0 Then If intState = tbrPressed Then intNewState = tbrUnpressed Else intNewState = tbrPressed End If btn.Value = intNewState cButtons.Remove btn.Key cButtons.Add intNewState, btn.Key Else 'screwed up, but lets not talk about it End If End Sub Private Sub SaveObjectList() ' write all nodes from tvTreelist to Seagate.ini ' separate node properties into comma delimited line On Error GoTo SaveObjectList_Err: Dim n As Node Dim strFileName As String Dim strLine As String Dim lngResult As Long Dim hFile As Integer ' fetch the INI file name strFileName = App.Path & GetIniFilePath() ' back up existing file ' NOTE: the vb Name method actually moves the file, ' so existing file wil not exist after this line executes Name strFileName As strFileName & ".old" ' create new file (see previous note on vb Name function) hFile = FreeFile Open strFileName For Output As #hFile ' write each node's info to strFileName ' each node is represented on one line ' by comma delimited string of it's properties For Each n In tvTreeView 'tvtreelist ' assemble comma delimited string from node properties strLine = n.Parent & ", " & n.Text & ", " & n.Image.Name Write #hFile, strLine Next n On Error Resume Next Close #hFile SaveObjectList_Exit: Exit Sub SaveObjectList_Err: MsgBox Error$ GoTo SaveObjectList_Exit: Resume 0 End Sub Public Sub AddNodeToTreeView() On Error GoTo AddNodeToTreeViewError Dim strGrandParent As String Dim strParent As String Dim strName As String Dim strImage As String Dim strType As String Dim strKey As String ' extract GrandParent name strGrandParent = ExtractFromList(strList:=m_strTemp, intIndex:=1, strDelimiter:=",") ' extract Parent name strParent = ExtractFromList(strList:=m_strTemp, intIndex:=2, strDelimiter:=",") ' extract node name strName = ExtractFromList(strList:=m_strTemp, intIndex:=3, strDelimiter:=",") ' extract object type strType = ExtractFromList(strList:=m_strTemp, intIndex:=4, strDelimiter:=",") ' assign node icon based on object type Select Case strType Case TYPE_METHOD strImage = "Method" Case TYPE_EVENT strImage = "Event" Case TYPE_PROPERTY strImage = "Property" Case Else 'default type is object (0) strImage = "Object" End Select ' Generate Key ' Properties, events, and methods must have ' a more detailed Key than objects. If strImage = "Object" Then strKey = strName & strImage & strParent Else strKey = strName & strImage & strParent & strGrandParent End If 'Can only add a node if Name is valid If strName <> "" Then If strParent = "" Then ' create root node (no parent) tvTreeView.Nodes.Add , , strKey, strName, "CRPE", "CRPE" Else 'Attach the child node to specified parent tvTreeView.Nodes.Add strParent & "Object" & strGrandParent, tvwChild, strKey, strName, strImage End If End If AddNodeToTreeViewExit: Exit Sub AddNodeToTreeViewError: If Err.Number = 35602 Then 'duplicate item.. ignore (do not add) ' m_bAdded = False Resume Next ElseIf Err.Number = 35601 Then ' If Err.Number = 35601 Then 'item not found.. ignore (do not add) m_bAdded = False Resume Next Else MsgBox Error$ End If GoTo AddNodeToTreeViewExit: Resume 0 End Sub 
(.txt)