VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} HistoryForm BorderStyle = 3 'Fixed Dialog Caption = "Form1" ClientHeight = 6015 ClientLeft = 45 ClientTop = 435 ClientWidth = 7980 ControlBox = 0 'False MaxButton = 0 'False MinButton = 0 'False OleObjectBlob = "HistoryForm.dsx":0000 ShowInTaskbar = 0 'False StartUpPosition = 1 'CenterOwner End Attribute VB_Name = "HistoryForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Const CmdTitle = "P4OFC - Document History" Private Const MsgSelectValid = "Please select a valid version." Private Const MsgCantViewDeleted = "You can't view a deleted revision." Private Const MsgCantDiffDeleted = "You can't diff a deleted revision against another." Private Const MsgOneVersion = "Please select only one version." Private Const MsgTwoVersions = "Please select two and only two versions." Private m_Listbox As ListBoxCopy Private m_ListboxDetails As ListBoxCopy Private m_SummaryList As Collection ' filelog results Private m_FullList As Collection ' filelog -l results Private m_ResultBoxHeight As Integer ' Store value Private Sub chkShowDetail_Click() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "chkShowDetail_Click") Dim YDist As Integer If Not chkShowDetail.Value Then DetailsLabel.Visible = False DetailsList.Visible = False YDist = -DetailsList.Height Else DetailsLabel.Visible = True DetailsList.Visible = True YDist = DetailsList.Height End If cmdClose.Top = cmdClose.Top + YDist cmdDiffRevs.Top = cmdDiffRevs.Top + YDist cmdDiffvsCurrent.Top = cmdDiffvsCurrent.Top + YDist cmdViewFile.Top = cmdViewFile.Top + YDist chkShowDetail.Top = chkShowDetail.Top + YDist Me.Height = Me.Height + (20 * YDist) UpdateList EnableControls Exit Sub Error_Block: t.Report End Sub Private Sub cmdClose_Click() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "cmdClose_Click") Unload Me Exit Sub Error_Block: t.Report End Sub Private Function GetVer(line As String) As String Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "GetVer") Dim SpaceInd As Integer SpaceInd = InStr(2, line, " ") If SpaceInd > 0 Then GetVer = Mid(line, 2, SpaceInd - 2) Else GetVer = vbNullString End If End Function Private Function IsDeleted(line As String) As Boolean ' Returns true if specifid revision is deleted Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "IsDeleted") ' Format of line '#4 change 101 delete on 2002/02/26 by robert@work_test (binary) 'asdfa ' Dim Fields() As String Fields = Split(line, " ") If UBound(Fields) > 3 Then IsDeleted = (Fields(3) = "delete") End If End Function Private Sub cmdDiffRevs_Click() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "cmdDiffRevs_Click") ' Check what's there Dim ind1 As Integer Dim ind2 As Integer Dim line1 As String Dim line2 As String Dim ver1 As String Dim ver2 As String Dim SpaceInd As Integer If TwoSelected(ind1, ind2) Then line1 = ResultBox.list(ind1) If Left(line1, 1) = "#" Then ver1 = GetVer(line1) End If line2 = ResultBox.list(ind2) If Left(line2, 1) = "#" Then ver2 = GetVer(line2) End If If IsDeleted(line1) Or IsDeleted(line2) Then MsgBox MsgCantDiffDeleted, vbOKOnly + vbExclamation, CmdTitle Exit Sub End If If Len(ver1) <> 0 And Len(ver2) <> 0 Then Me.Hide g_p4interface.P4Office_DoDiffOld ver1, ver2 Unload Me Else MsgBox MsgSelectValid, vbOKOnly + vbExclamation, CmdTitle End If Else MsgBox MsgTwoVersions, vbOKOnly + vbExclamation, CmdTitle End If Exit Sub Error_Block: t.Report End Sub Private Sub cmdDiffvsCurrent_Click() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "cmdDiffvsCurrent_Click") ' Check what's there Dim i As Integer Dim line As String Dim ver As String Dim SpaceInd As Integer If OnlyOneSelected(i) Then line = ResultBox.list(i) If Left(line, 1) = "#" Then ver = GetVer(line) If Len(ver) <> 0 Then If IsDeleted(line) Then MsgBox MsgCantDiffDeleted, vbOKOnly + vbExclamation, CmdTitle Exit Sub End If Me.Hide g_p4interface.P4Office_DoDiffCurrent ver Unload Me Else MsgBox MsgSelectValid, vbOKOnly + vbExclamation, CmdTitle End If Else MsgBox MsgSelectValid, vbOKOnly + vbExclamation, CmdTitle End If Else MsgBox MsgOneVersion, vbOKOnly + vbExclamation, CmdTitle End If Exit Sub Error_Block: t.Report End Sub Private Sub cmdViewFile_Click() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "cmdViewFile_Click") ' Check what's there Dim i As Integer Dim line As String Dim ver As String Dim SpaceInd As Integer If OnlyOneSelected(i) Then line = ResultBox.list(i) If Left(line, 1) = "#" Then ver = GetVer(line) If Len(ver) <> 0 Then If IsDeleted(line) Then MsgBox MsgCantViewDeleted, vbOKOnly + vbExclamation, CmdTitle Exit Sub End If Me.Hide g_p4interface.P4Office_ViewVersion ver Unload Me Else MsgBox MsgSelectValid, vbOKOnly + vbExclamation, CmdTitle End If Else MsgBox MsgSelectValid, vbOKOnly + vbExclamation, CmdTitle End If Else MsgBox MsgOneVersion, vbOKOnly + vbExclamation, CmdTitle End If Exit Sub Error_Block: t.Report End Sub Private Function OnlyOneSelected(ind1 As Integer) As Boolean ' Checks how many rows selected and returns the one required. Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "OnlyOneSelected") Dim i As Integer Dim bFound As Boolean bFound = False ind1 = 0 i = 1 ' Ignore first box which is filename While i < ResultBox.ListCount If ResultBox.Selected(i) Then If Left(ResultBox.list(i), 1) = "#" Then ind1 = i If bFound Then OnlyOneSelected = False Exit Function Else bFound = True End If End If End If i = i + 1 Wend OnlyOneSelected = bFound End Function Private Function TwoSelected(ind1 As Integer, ind2 As Integer) As Boolean ' Checks how many rows selected and returns true if only 2 Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "TwoSelected") Dim i As Integer Dim NoFound As Integer NoFound = 0 i = 1 ' Ignore first box which is filename While i < ResultBox.ListCount If ResultBox.Selected(i) Then If Left(ResultBox.list(i), 1) = "#" Then NoFound = NoFound + 1 If NoFound = 1 Then ind1 = i ElseIf NoFound = 2 Then ind2 = i End If End If End If i = i + 1 Wend TwoSelected = (NoFound = 2) End Function Private Sub InitForm() Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "InitForm") ' Allow right click and copy menu to be used Set m_Listbox = New ListBoxCopy m_Listbox.Initialize Me, ResultBox Set m_ListboxDetails = New ListBoxCopy m_ListboxDetails.Initialize Me, DetailsList Set m_SummaryList = New Collection Set m_FullList = New Collection m_ResultBoxHeight = ResultBox.Height chkShowDetail_Click EnableControls ' Decide which buttons to make visible If Not g_p4interface.IsWord Then cmdDiffRevs.Visible = False cmdDiffvsCurrent.Visible = False ' Move buttons over a bit to the right cmdClose.Left = cmdViewFile.Left cmdViewFile.Left = cmdDiffvsCurrent.Left ResultBox.MultiSelect = fmMultiSelectSingle End If End Sub Private Sub ResultBox_Change() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ResultBox_Change") EnableControls Exit Sub Error_Block: t.Report End Sub Private Sub ResultBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' This event handled because it replaces _Click event which doesn't seem to fire On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ResultBox_MouseUp") EnableControls Exit Sub Error_Block: t.Report End Sub Private Sub ResultBox_Click() On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "ResultBox_Click") EnableControls Exit Sub Error_Block: t.Report End Sub ' Decide which buttons to enable Private Sub EnableControls() Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "EnableControls") Dim ind1 As Integer Dim ind2 As Integer cmdDiffvsCurrent.Enabled = False cmdDiffRevs.Enabled = False cmdViewFile.Enabled = False If OnlyOneSelected(ind1) Then cmdDiffvsCurrent.Enabled = True cmdViewFile.Enabled = True End If If TwoSelected(ind1, ind2) Then cmdDiffRevs.Enabled = True End If If chkShowDetail.Value Then UpdateDetails End If End Sub Private Sub AddLines(arr() As String, list As Collection) Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "AddLines") Dim i As Integer Dim j As Integer Dim start As Integer Dim ind As Integer Dim line As String Dim s As String If IsEmptyArray(arr) Then Exit Sub For i = LBound(arr) To UBound(arr) s = arr(i) start = 1 While start <= Len(s) ind = InStr(start, s, vbLf) If ind > 0 Then line = Mid$(s, start, ind - start) list.Add line start = ind + 1 Else list.Add Mid$(s, start) start = Len(s) + 1 End If Wend Next End Sub Private Sub UpdateList() Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "UpdateList") Dim i As Integer ResultBox.Clear For i = 1 To m_SummaryList.Count ResultBox.AddItem m_SummaryList.Item(i) Next End Sub Private Sub UserForm_Initialize() ' Allow right click menu for copying to clipboard On Error GoTo Error_Block Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "UserForm_Initialize") InitForm Exit Sub Error_Block: t.Report End Sub Private Sub UpdateDetails() Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "UpdateDetails") ' Check what's there Dim i As Integer Dim start As Integer Dim line As String Dim ver As String DetailsList.Clear If ResultBox.ListIndex < 0 Then Exit Sub End If line = ResultBox.list(ResultBox.ListIndex) If Left(line, 1) = "#" Then ver = GetVer(line) If Len(ver) <> 0 Then start = 0 i = 1 While i <= m_FullList.Count If ver = GetVer(m_FullList.Item(i)) Then start = i + 1 ElseIf start > 0 Then If Left(m_FullList.Item(i), 1) <> "#" Then DetailsList.AddItem m_FullList.Item(i) Else start = 0 i = m_FullList.Count ' Exit loop End If End If i = i + 1 Wend End If End If End Sub Public Sub DoHistory(DocPathname As String) Dim t As Tracker: Set t = GStackTrace.Enter(TypeName(Me), "DoHistory") Dim p4cmd As String Dim Result As Long Dim InfoArr() As String Dim ErrorArr() As String Dim FileName As String Me.Caption = CmdTitle Me.FileName.Text = DocPathname Me.ResultBox.Clear p4cmd = p4cmdstring("filelog", DocPathname) Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName) If Result <> 0 Then Me.ResultBox.AddItem "*** Error ***" End If AddLines InfoArr, m_SummaryList AddLines ErrorArr, m_SummaryList UpdateList p4cmd = p4cmdstring("filelog -l", DocPathname) Result = p4runcmd(p4cmd, InfoArr, ErrorArr, FileName) AddLines InfoArr, m_FullList Screen.MousePointer = vbDefault SetParent2 Me, g_p4interface.App.Caption Me.Show vbModal End Sub