Disable deleting and editing of previous comments in Defect module (7165 Views)
Reply
Occasional Contributor
deter_dangler
Posts: 2
Registered: ‎03-01-2013
Message 1 of 3 (7,165 Views)
Accepted Solution

Disable deleting and editing of previous comments in Defect module

[ Edited ]

Hi Everyone,

 

Is it possible to restrict the user to just add the comments for a defect? This should not include updating or deleting existing comments.

 

Is that possible?

 

I am using QC 11.00

 

Thanks

Deter

 

Honored Contributor
RoniRobinson
Posts: 623
Registered: ‎07-21-2011
Message 2 of 3 (7,146 Views)

Re: Disable deleting and editing of previous comments in Defect module

You cannot do this in the existing Comment field. What you would need to do is create a new Memo field called Comment History. Then, when comments are entered into the Comment field and saved, the new comments get removed and appended to the Comment History field value.  The Comment History field can be made to display newest first and will also tag the latest comments with the data/time and user information.

 

The below code was written long ago by Vlad Shrbek.  This was originally used with QC 9.2, so changes will probably have to be made.

 

 

 

Sub Defects_DialogBox(DialogBoxName, IsOpen)
  'Use ActiveModule and ActiveDialogName to get
  'the current context.
  if DialogBoxName = "Details" then Actions.Action("BugAddDevCommentsAction1").Visible = False 'Hide "Add Comment" Button
  On Error Resume Next

  On Error GoTo 0
End Sub
Sub Defects_EnterModule
  'Use ActiveModule and ActiveDialogName to get
  'the current context.
  Actions.Action("BugAddDevCommentsAction1").Visible = False 'Hide "Add Comment" Button
  On Error Resume Next

  On Error GoTo 0
End Sub

Function Defects_ActionCanExecute(ActionName)
  'Use ActiveModule and ActiveDialogName to get
  'the current context.
  if ActionName = "BugAddDevCommentsAction1" then
     Defects_ActionCanExecute = false   'Do not allow the function for button "Add Comment"
  end if
  On Error Resume Next

  On Error GoTo 0
End Function

Sub Defects_Bug_New
    Bug_Fields.Field("BG_USER_26").IsVisible = false
    Bug_Fields.Field("BG_USER_26").IsReadOnly = true
End Sub

Sub Defects_Bug_MoveTo
    SetFieldBugVisReadRequire true     'set the requriement of the fields, paramerter is used for distinguishing of from where it is called
End Sub

Sub Defects_Bug_FieldChange(FieldName)
    if FieldName = "BG_STATUS" then
       SetFieldBugVisReadRequire false  'set the requirement of the fields, parameter is used for distinguishing of from where it is called
    end if
End Sub

Sub SetFieldBugVisReadRequire(ParMoveTo)
    Bug_Fields.Field("BG_USER_26").isVisible = true
    Bug_Fields.Field("BG_User_26").IsReadOnly = true
    Bug_Fields.Field("BG_DEV_COMMENTS").IsRequired = false
    if Bug_Fields.Field("BG_STATUS").Value = "Fixed" then
       if not parMoveTo then Bug_Fields.Field("BG_DEV_COMMENTS").IsRequired = true   'set the field Add comment mandatory only when the user changes the status from xxx to Fixed
    end if
End Sub

Function Defects_Bug_CanPost
         AddCommentScript   'add comments script
End Function

sub AddCommentScript
    dim hcuprava   'variable for the result of history comment
    dim hchttp     'variable for comment html tags like <body>
    dim newcomment  'variable for new comment taken from "BG_DEV_COMMENTS"
    dim commenthistory    'variable for comment history "BG_DEV_COMMENTS"  - the name of the add comment field that is used for new comment, "BG_USER_26" - the name of the memo field that is used for Comment history
    newcomment = Bug_Fields.Field("BG_DEV_COMMENTS").Value
    commenthistory = Bug_Fields.Field("BG_USER_26").Value
    if newcomment <> "" then
       hchttp = left(newcomment,12)   'take first 12 chars from html comment "<html><body>"
       if hchttp = "<html><body>" then
          hcuprava = right(newcomment,len(newcomment)-12)
       else
        hcuprava = newcomment
    end if
    hcuprave = "<html><body>" & "<fond color=""#000080""><b>" & fullname & " &lt;" & username & "&gt;," & now & ":</b></font><br>" & hcuprava
    hchttp = right(hcuprava,14)
    if hchttp = "</body></html>" then
       hcuprava = left(hcuprava,len(hcuprava)-14)
    end if
    if commenthistory <> "" then hcuprava = hcuprava & "<br><font color=""#000080""><b>_________________</b></font><br>"
       hchttp = left(commenthistory,12)
       if hchttp = "<html><body>" then
          hcuprava = hcuprava & right(commenthistory,len(commenthistory)-12)
       else
           hcuprava = hcuprava & commenthistory
       end if

       if right(commenthistory,14) <> "</body></html>" then
          hcuprava = hcuprava & "</body></html>"
       end if
       Bug_Fields.Field("BG_USER_26").IsReadOnly = false
       Bug_Fields.Field("BG_USER_26").Value = hcuprava
       Bug_Fields.Field("BG_USER_26").IsReadOnly = true
       Bug_Fields.Field("BG_DEV_COMMENTS").Value = ""
    end if
End Sub

 

 

Frequent Advisor
Scott A Wood
Posts: 68
Registered: ‎11-13-2007
Message 3 of 3 (6,723 Views)

Re: Disable deleting and editing of previous comments in Defect module

I implemented this code and found a few typos in it along the way.  Here is the updated code we implemented.

 

--Add new "Comments History" field.  --Note if it isn't BG_USER_25, scripts will need to be updated.
--Updated the "R&D Comments" field label to "New Comment".


Sub Defects_DialogBox(DialogBoxName, IsOpen)
  'Use ActiveModule and ActiveDialogName to get
  'the current context.
  if DialogBoxName = "Details" then
    if (Actions.Action("BugAddDevCommentsAction1").Visible = True) then
      Actions.Action("BugAddDevCommentsAction1").Visible = False 'Hide "Add Comment" Button
    end if
  end if
  On Error Resume Next

  On Error GoTo 0
End Sub

 

Function Defects_ActionCanExecute(ActionName)
  'Use ActiveModule and ActiveDialogName to get
  'the current context.
  if ActionName = "BugAddDevCommentsAction1" then
     Defects_ActionCanExecute = false   'Do not allow the function for button "Add Comment"
  end if
  On Error Resume Next

  On Error GoTo 0
End Function

 

Sub Defects_Bug_New
    Bug_Fields.Field("BG_USER_25").IsVisible = false
    Bug_Fields.Field("BG_USER_25").IsReadOnly = true
End Sub

 


Sub Defects_Bug_MoveTo
    SetFieldBugVisReadRequire true     'set the requriement of the fields, paramerter is used for distinguishing of from

where it is called
End Sub

 

Sub Defects_Bug_FieldChange(FieldName)
    if FieldName = "BG_STATUS" then
       SetFieldBugVisReadRequire false  'set the requirement of the fields, parameter is used for distinguishing of from

where it is called
    end if
End Sub

 

Sub SetFieldBugVisReadRequire(ParMoveTo)
    Bug_Fields.Field("BG_USER_25").isVisible = true
    Bug_Fields.Field("BG_User_25").IsReadOnly = true
    Bug_Fields.Field("BG_DEV_COMMENTS").IsRequired = false
    if Bug_Fields.Field("BG_STATUS").Value = "Fixed" then
       if not parMoveTo then Bug_Fields.Field("BG_DEV_COMMENTS").IsRequired = true   'set the field Add comment mandatory

only when the user changes the status from xxx to Fixed
    end if
End Sub

 

Function Defects_Bug_CanPost
         AddCommentScript   'add comments script
End Function

 


sub AddCommentScript
    dim hcuprava   'variable for the result of history comment
    dim hchttp     'variable for comment html tags like <body>
    dim newcomment  'variable for new comment taken from "BG_DEV_COMMENTS"
    dim commenthistory    'variable for comment history "BG_DEV_COMMENTS"  - the name of the add comment field that is used

for new comment, "BG_USER_25" - the name of the memo field that is used for Comment history
    newcomment = Bug_Fields.Field("BG_DEV_COMMENTS").Value
    commenthistory = Bug_Fields.Field("BG_USER_25").Value
    if newcomment <> "" then
       hchttp = left(newcomment,12)   'take first 12 chars from html comment "<html><body>"
       if hchttp = "<html><body>" then
          hcuprava = right(newcomment,len(newcomment)-12)
       else
        hcuprava = newcomment
    end if
    hcuprava = "<html><body>" & "<font color=""#000080""><b>" & fullname & " - " & username & " - " & now &

":</b></font><br>" & hcuprava
    hchttp = right(hcuprava,14)
    if hchttp = "</body></html>" then
       hcuprava = left(hcuprava,len(hcuprava)-14)
    end if
    if commenthistory <> "" then hcuprava = hcuprava & "<br><font color=""#000080""><b>_________________</b></font><?br>"
       hchttp = left(commenthistory,12)
       if hchttp = "<html><body>" then
          hcuprava = hcuprava & right(commenthistory,len(commenthistory)-12)
       else
           hcuprava = hcuprava & commenthistory
       end if

       if right(commenthistory,14) <> "</body></html>" then
          hcuprava = hcuprava & "</body></html>"
       end if
       Bug_Fields.Field("BG_USER_25").IsReadOnly = false
       Bug_Fields.Field("BG_USER_25").Value = hcuprava
       Bug_Fields.Field("BG_USER_25").IsReadOnly = true
       Bug_Fields.Field("BG_DEV_COMMENTS").Value = ""
    end if
End Sub

 

The opinions expressed above are the personal opinions of the authors, not of HP. By using this site, you accept the Terms of Use and Rules of Participation.