HistoryForm.Dsr #1

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