2017/10/22(sun) RelaxTools-Addin Version 4.14.5(RustRemover)

◇機能改善
・yuki さんの要望で「十字カーソル」で行全体を選択するモードを復活。
・ToitoiseSVN のコミット時のブックの閉じ方を変更。

Source/src/Class/TortoiseSVN.cls

@@ -121,6 +121,8 @@ Private Sub IVersion_Brouser()
 
     strCommand = CMD_BROUSER & GetPath(WB.FullName) & OPT_END0
     Run strCommand
+
+
 
     WB.ChangeFileAccess Mode:=xlReadWrite
 
@@ -147,13 +149,14 @@ Private Sub IVersion_Cleanup()
         Exit Sub
     End If
 
+    strCommand = CMD_CLEANUP & "/PATH:" & rlxGetFullpathFromPathName(strBook) & " " & OPT_END0
+    If Run(strCommand) < 0 Then
+        Exit Sub
+    End If
+
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
-
-    strCommand = CMD_CLEANUP & "/PATH:" & rlxGetFullpathFromPathName(strBook) & " " & OPT_END0
     WB.Close False
-
-    Run strCommand
 
     Workbooks.Open strBook
     Application.DisplayAlerts = True
@@ -180,18 +183,24 @@ Private Sub IVersion_Commit()
         Exit Sub
     End If
 
+    strCommand = CMD_COMMIT & GetPath(WB.FullName) & OPT_END0
+    If Run(strCommand) < 0 Then
+        Exit Sub
+    End If
+
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
 
-    strCommand = CMD_COMMIT & GetPath(WB.FullName) & OPT_END0
     WB.Close False
+    Set WB = Nothing
 
-    Run strCommand
+    Set WB = Workbooks.Open(strBook)
+    WB.Windows(1).visible = False
 
-    Workbooks.Open strBook
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
 
+    WB.Windows(1).visible = True
     Exit Sub
 e:
     Application.DisplayAlerts = True
@@ -338,17 +347,25 @@ Private Sub IVersion_Unlocked()
 
     On Error Resume Next
 
+    strCommand = CMD_UNLOCK & GetPath(WB.FullName) & OPT_END0
+    If Run(strCommand) < 0 Then
+        Exit Sub
+    End If
+
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
 
-    strCommand = CMD_UNLOCK & GetPath(WB.FullName) & OPT_END0
     WB.Close False
-    Run strCommand
-
-    Workbooks.Open strBook
+    Set WB = Nothing
+
+
+    Set WB = Workbooks.Open(strBook)
+    WB.Windows(1).visible = False
+
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
 
+    WB.Windows(1).visible = True
     Exit Sub
 e:
     Application.DisplayAlerts = True
@@ -425,19 +442,23 @@ Private Sub IVersion_Revert()
     End If
 
     On Error Resume Next
-        
+
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
 
     strCommand = CMD_REVERT & GetPath(WB.FullName) & OPT_END0
     WB.Close False
+    DoEvents
+    Set WB = Nothing
 
     Run strCommand
-
-    Workbooks.Open strBook
+    Set WB = Workbooks.Open(strBook)
+    WB.Windows(1).visible = False
+
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
 
+    WB.Windows(1).visible = True
     Exit Sub
 e:
     Application.DisplayAlerts = True
@@ -482,19 +503,23 @@ Private Sub IVersion_Update()
     End If
 
     On Error Resume Next
-        
+
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
-
+    
     strCommand = CMD_UPDATE & GetPath(WB.FullName) & OPT_END0
     WB.Close False
-
+    DoEvents
+    Set WB = Nothing
+
     Run strCommand
-
-    Workbooks.Open strBook
+    Set WB = Workbooks.Open(strBook)
+    WB.Windows(1).visible = False
+
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
 
+    WB.Windows(1).visible = True
     Exit Sub
 e:
     Application.DisplayAlerts = True
@@ -517,21 +542,21 @@ e:
     MsgBox "TortoiseSVNの起動に失敗しました。インストールされていないか、PATHの設定を確認してください。", vbOKOnly + vbCritical, C_TITLE
 End Sub
 
-Private Sub Run(ByVal strExe As String)
+Private Function Run(ByVal strExe As String)
     On Error Resume Next
 
     Err.Clear
     With CreateObject("WScript.Shell")
-        .Run EXE_NAME & " " & OPT_COMMAND & strExe, 1, True
+        Run = .Run(EXE_NAME & " " & OPT_COMMAND & strExe, 1, True)
     End With
     If Err.Number <> 0 Then
         MsgBox "TortoiseSVNの起動に失敗しました。インストールされていないか、PATHの設定を確認してください。", vbOKOnly + vbCritical, C_TITLE
     End If
 
-    Exit Sub
+    Exit Function
 e:
     MsgBox "TortoiseSVNの起動に失敗しました。インストールされていないか、PATHの設定を確認してください。", vbOKOnly + vbCritical, C_TITLE
-End Sub
+End Function
 Private Function GetPath(ByVal strBook As String) As String
 
     GetPath = OPT_PATH & """" & strBook & """ "

Source/src/Form/frmCrossLine.frm

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmCrossLine 
    Caption         =   "十字カーソル設定"
-   ClientHeight    =   3015
+   ClientHeight    =   4710
    ClientLeft      =   45
    ClientTop       =   435
-   ClientWidth     =   8355
+   ClientWidth     =   6780
    OleObjectBlob   =   "frmCrossLine.frx":0000
    StartUpPosition =   1  'オーナー フォームの中央
 End
@@ -48,22 +48,38 @@ Attribute VB_Exposed = False
 Option Explicit
 Private mResult As VBA.VbMsgBoxResult
 
+Private Sub chkFillVisible_Change()
+
+    fraFill.enabled = chkFillVisible.Value
+    fraFillColor.enabled = chkFillVisible.Value
+    fraFillTransparency.enabled = chkFillVisible.Value
+    lblClick.enabled = chkFillVisible.Value
+    lblPercent.enabled = chkFillVisible.Value
+    lblFillColor.enabled = chkFillVisible.Value
+    txtFillTransparency.enabled = chkFillVisible.Value
+    spnFillTransparency.enabled = chkFillVisible.Value
+
+End Sub
+
 Private Sub cmdCancel_Click()
     Unload Me
 End Sub
 
 Private Sub cmdInit_Click()
 
-    lblEven.BackColor = &H8000&
+    chkFillVisible.Value = False
+    lblFillColor.BackColor = &H50B000
+    txtFillTransparency.Value = "50"
+
+    lblEven.BackColor = &H50B000
     txtCol.Value = "2"
-
-    lblFont.BackColor = &H8000&
+    lblFont.BackColor = &H50B000
 
 End Sub
 
 Private Sub cmdOk_Click()
 
-    Dim strFillVisible As String
+    Dim blnFillVisible As Boolean
     Dim strFillColor As String
     Dim strFillTransparency As String
     Dim strLineVisible As String
@@ -76,13 +92,21 @@ Private Sub cmdOk_Click()
     Dim blnLineWidth As Boolean
 
 
+    Select Case Val(txtFillTransparency.Value)
+        Case 0 To 100
+        Case Else
+            MsgBox "透明度は0～100%を入力してください。", vbOKOnly + vbExclamation, C_TITLE
+            Exit Sub
+    End Select
+
     Select Case Val(txtCol.Value)
         Case 0.25! To 100
         Case Else
             MsgBox "線の幅は0.25～10を入力してください。", vbOKOnly + vbExclamation, C_TITLE
             Exit Sub
     End Select
 
+
     Select Case True
         Case optHolizon.Value
             lngType = C_HOLIZON
@@ -92,14 +116,25 @@ Private Sub cmdOk_Click()
             lngType = C_ALL
     End Select
 
+
+    If chkFillVisible.Value Then
+        blnFillVisible = False
+    Else
+        blnFillVisible = True
+    End If
+
+    strFillColor = "&H" & Right$("00000000" & Hex(lblFillColor.BackColor), 8)
+    strFillTransparency = txtFillTransparency.Value
+
     strLineColor = "&H" & Right$("00000000" & Hex(lblEven.BackColor), 8)
     strLineWeight = txtCol.Value
 
     blnGuid = chkGuid.Value
 
     strFontColor = "&H" & Right$("00000000" & Hex(lblFont.BackColor), 8)
 
-    Call setCrossLineSetting(lngType, strLineColor, strLineWeight, blnGuid, strFontColor)
+    Call setCrossLineSetting(lngType, blnFillVisible, strFillColor, strFillTransparency, strLineVisible, strLineColor, strLineWeight, blnGuid, strFontColor, blnEdit, blnLineWidth)
+
 
     Unload Me
 End Sub
@@ -109,6 +144,21 @@ Private Sub CommandButton1_Click()
 
 End Sub
 
+Private Sub lblFillColor_Click()
+
+    Dim lngColor As Long
+    Dim Result As VbMsgBoxResult
+
+    lngColor = lblFillColor.BackColor
+
+    Result = frmColor.Start(lngColor)
+
+    If Result = vbOK Then
+        lblFillColor.BackColor = lngColor
+    End If
+
+End Sub
+
 Private Sub lblFont_Click()
 
     Dim lngColor As Long
@@ -173,16 +223,61 @@ Private Function spinDown2(ByVal vntValue As Variant) As Variant
     spinDown2 = lngValue
 
 End Function
+Private Function spinUp(ByVal vntValue As Variant) As Variant
+
+    Dim lngValue As Single
+
+    lngValue = Val(vntValue)
+    lngValue = lngValue + 5
+    If lngValue > 100 Then
+        lngValue = 100
+    End If
+    spinUp = lngValue
+
+End Function
+
+Private Function spinDown(ByVal vntValue As Variant) As Variant
+
+    Dim lngValue As Single
+
+    lngValue = Val(vntValue)
+    lngValue = lngValue - 5
+    If lngValue < 0 Then
+        lngValue = 0
+    End If
+    spinDown = lngValue
+
+End Function
+
+
+
+Private Sub spnFillTransparency_SpinDown()
+    txtFillTransparency.Text = spinDown(txtFillTransparency.Text)
+End Sub
+
+Private Sub spnFillTransparency_SpinUp()
+    txtFillTransparency.Text = spinUp(txtFillTransparency.Text)
+End Sub
 
 Private Sub UserForm_Initialize()
 
+    Dim blnFillVisible As Boolean
+    Dim lngFillColor As Long
+    Dim dblFillTransparency As Double
+    Dim lngLineVisible As Long
     Dim lngLineColor As Long
     Dim lngFontColor As Long
     Dim sngLineWeight As Single
+    Dim strOnAction As String
     Dim lngType As Long
     Dim blnGuid As Boolean
+    Dim blnEdit As Boolean
+    Dim blnLineWidth As Boolean
 
-    Call getCrossLineSetting(lngType, lngLineColor, sngLineWeight, blnGuid, lngFontColor)
+    Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth)
+
+
+
 
     Select Case lngType
         Case C_HOLIZON
@@ -193,6 +288,14 @@ Private Sub UserForm_Initialize()
             optAll.Value = True
     End Select
 
+    If blnFillVisible Then
+        chkFillVisible.Value = False
+    Else
+        chkFillVisible.Value = True
+    End If
+
+    lblFillColor.BackColor = lngFillColor
+    txtFillTransparency.Value = dblFillTransparency
 
     chkGuid.Value = blnGuid