Принимая приманку из ответа Днисли (где он спрашивает, может ли кто-то сделать надстройку), я сделал надстройку для VB6. Это немного грубо (и я объясню почему в ближайшее время), но это делает работу.
Я создал новый проект надстройки в VB6, который дал мне стандартную форму "frmAddin" (которую я не использую) и конструктор "Connect". Я сам добавил класс Color, который содержит следующее:
Option Explicit
Dim m_iForeColour As Integer
Dim m_iBackColour As Integer
Dim m_iIndicatorColour As Integer
Public Property Let ForeColour(ByVal iID As Integer)
m_iForeColour = iID
End Property
Public Property Get ForeColour() As Integer
ForeColour = m_iForeColour
End Property
Public Property Let BackColour(ByVal iID As Integer)
m_iBackColour = iID
End Property
Public Property Get BackColour() As Integer
BackColour = m_iBackColour
End Property
Public Property Let IndicatorColour(ByVal iID As Integer)
m_iIndicatorColour = iID
End Property
Public Property Get IndicatorColour() As Integer
IndicatorColour = m_iIndicatorColour
End Property
А затем я изменил код в конструкторе "Connect" следующим образом:
Option Explicit
Public FormDisplayed As Boolean
Public VBInstance As VBIDE.VBE
Dim mcbMenuCommandBar As Office.CommandBarControl
Dim mfrmAddIn As New frmAddIn
Public WithEvents MenuHandler As CommandBarEvents 'command bar event handler
Dim mcbToolbar As Office.CommandBarControl
Public WithEvents MenuHandler2 As CommandBarEvents
Dim codeColours() As Colour
'*****************************************************************************
' RunScript Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' Runs the code that sets the required colours for the code window in the
' active IDE.
' *** A PROJECT MUST BE LOADED BEFORE THIS WILL ACTUALLY WORK ***
'*****************************************************************************
Sub RunScript()
ReadColoursFile
' Select Tools > Options
SendKeys "%to", 5
' Go to tabs, select "Options"
SendKeys "+{TAB}"
SendKeys "{RIGHT}"
' Select listbox
SendKeys "{TAB}"
Dim colourSetting As Colour
Dim iColour As Integer
For iColour = 0 To 9
SetColours iColour, codeColours(iColour)
Next iColour
SendKeys "~"
End Sub
'*****************************************************************************
' ReadColoursFile Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' Reads the colour file from disk and populates the codeColours array which
' is used by the SetColour* methods for selecting the correct colours from
' the options screen.
'*****************************************************************************
Sub ReadColoursFile()
Dim colourLine As String
Dim colourArray() As String
Dim colourSetting As Colour
Dim oFSO As FileSystemObject
Set oFSO = New FileSystemObject
If Not oFSO.FileExists(App.Path & "\VB6CodeColours.dat") Then
MsgBox "VB6CodeColours.dat not found in " & App.Path, vbOKOnly, "VB6CodeColours Settings file not found!"
Exit Sub
End If
Set oFSO = Nothing
Open App.Path & "\VB6CodeColours.dat" For Input As #1
ReDim codeColours(9) As Colour
While Not EOF(1)
Line Input #1, colourLine
colourArray = Split(colourLine, ",")
If IsNumeric(colourArray(0)) Then
If codeColours(colourArray(0)) Is Nothing Then
Set colourSetting = New Colour
If IsNumeric(colourArray(1)) Then
colourSetting.ForeColour = CInt(colourArray(1))
End If
If IsNumeric(colourArray(2)) Then
colourSetting.BackColour = CInt(colourArray(2))
End If
If IsNumeric(colourArray(3)) Then
colourSetting.IndicatorColour = CInt(colourArray(3))
End If
Set codeColours(colourArray(0)) = colourSetting
End If
End If
Wend
Close #1
Set colourSetting = Nothing
End Sub
'*****************************************************************************
' SetColours Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' Selects the colour item from the list and then iterates the colour selector
' controls associated with that item and sets them according to the values
' set in the VB6CodeColours.dat file.
'*****************************************************************************
Sub SetColours(ByVal iColour As Integer, ByRef colourSetting As Colour)
Dim iKey As Integer
SendKeys "{HOME}"
For iKey = 1 To iColour
SendKeys "{DOWN}"
Next iKey
SetColourSelector colourSetting.ForeColour
SetColourSelector colourSetting.BackColour
SetColourSelector colourSetting.IndicatorColour
SendKeys "+{TAB}"
SendKeys "+{TAB}"
SendKeys "+{TAB}"
End Sub
'*****************************************************************************
' SetColourSelector Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' Sets the colour in the selector combo. Assumes the focus is on the
' preceeding control before the code is run (first line tabs to the
' assumed control).
'*****************************************************************************
Sub SetColourSelector(ByVal iColour As Integer)
Dim iKey As Integer
SendKeys "{TAB}"
SendKeys "{HOME}"
For iKey = 1 To iColour
SendKeys "{DOWN}"
Next iKey
End Sub
'*****************************************************************************
' AddinInstance_OnConnection Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' This method runs when the addin is loaded by the IDE
'*****************************************************************************
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
On Error GoTo ErrorHandler
'save the vb instance
Set VBInstance = Application
If ConnectMode ext_cm_External Then
Set mcbMenuCommandBar = AddToAddInCommandBar("VB6 Code Colouring")
'sink the event
Set Me.MenuHandler = VBInstance.Events.CommandBarEvents(mcbMenuCommandBar)
Dim oStdToolbar As Office.CommandBar
Dim oStdToolbarItem As Office.CommandBarControl
Set oStdToolbar = VBInstance.CommandBars("Standard")
Set oStdToolbarItem = oStdToolbar.Controls.Add(Type:=msoControlButton)
oStdToolbarItem.Style = msoButtonCaption
oStdToolbarItem.Caption = "Set IDE Colours"
oStdToolbarItem.BeginGroup = True
Set Me.MenuHandler2 = VBInstance.Events.CommandBarEvents(oStdToolbarItem)
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
'*****************************************************************************
' AddinInstance_OnDisconnection Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' This method runs when the addin is removed by the IDE and cleans up any
' references etc.
'*****************************************************************************
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
On Error Resume Next
'delete the command bar entry
mcbMenuCommandBar.Delete
'shut down the Add-In
If FormDisplayed Then
SaveSetting App.Title, "Settings", "DisplayOnConnect", "1"
FormDisplayed = False
Else
SaveSetting App.Title, "Settings", "DisplayOnConnect", "0"
End If
Unload mfrmAddIn
Set mfrmAddIn = Nothing
Set MenuHandler = Nothing
Set MenuHandler2 = Nothing
End Sub
'*****************************************************************************
' MenuHandler_Click Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' This method performs the tasks needed when the menu item is clicked.
'*****************************************************************************
Private Sub MenuHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
RunScript
End Sub
'*****************************************************************************
' MenuHandler2_Click Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' This method performs the tasks needed when the toolbar button is clicked.
'*****************************************************************************
Private Sub MenuHandler2_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
RunScript
End Sub
'*****************************************************************************
' AddToAddInCommandBar Sub
'-----------------------------------------------------------------------------
' DESCRIPTION:
' Adds the specified item to the menu list.
'*****************************************************************************
Function AddToAddInCommandBar(sCaption As String) As Office.CommandBarControl
Dim cbMenuCommandBar As Office.CommandBarControl 'command bar object
Dim cbMenu As Object
On Error Resume Next
'see if we can find the Add-Ins menu
Set cbMenu = VBInstance.CommandBars("Add-Ins")
If cbMenu Is Nothing Then
'not available so we fail
Exit Function
End If
On Error GoTo ErrorHandler
'add it to the command bar
Set cbMenuCommandBar = cbMenu.Controls.Add(1)
'set the caption
cbMenuCommandBar.Caption = sCaption
Set AddToAddInCommandBar = cbMenuCommandBar
Exit Function
ErrorHandler:
' Exit gracefully
End Function
Этот код позволяет приложению читать нужные мне цвета из файла, который находится в том же каталоге, что и .dll (называемый VB6CodeColours.dat). Этот файл содержит следующее (и он будет зависеть от того, какие цвета вы заменяете в VB6.EXE, поэтому прямое копирование и вставка, вероятно, не сработает.
0,14,12,0
1,0,0,0
2,16,13,0
3,0,15,15
4,16,5,5
5,7,12,0
6,11,12,0
7,8,12,0
8,16,10,10
9,16,3,3
Выглядит бред, но я объясню.
Он имеет формат "Цвет кода", "Передний план", "Фон", "Индикатор", поэтому в верхней строке будет установлен "Обычный текст" для 14-го элемента в поле со списком "Передний план", 12-го для фона и 1-го для индикатора. ,
Почему я сказал, что это довольно грубое решение:* Он использует SendKeys. Я уверен, что дальнейших объяснений здесь не требуется :) * Пользователь должен нажать на опцию меню / панели инструментов, чтобы она вступила в силу.
* Код, на мой взгляд, не очень хорошо структурирован, но основан на количестве времени, которое я мог бы посвятить ему в то время. Я стремлюсь улучшить его в будущем, но он отлично работает для меня в текущем состоянии (так что я, вероятно, оставлю это!)
Возможно, с основой, кто-то может расширить это дальше.
