Tomando a isca da resposta do dnissley (onde ele pergunta se alguém poderia fazer um add-in), eu fiz um add-in para o VB6. É um pouco grosseiro (e explicarei o porquê em breve), mas faz o trabalho.
Eu criei um novo projeto Add-In no VB6 que me deu o formato padrão "frmAddin" (que eu não uso) e o designer "Connect". Adicionei uma classe Color que contém o seguinte:
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
Em seguida, alterei o código no Designer "Connect" como segue:
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
Esse código permite que o aplicativo leia as cores que eu quero de um arquivo que resida no mesmo diretório que o .dll (chamado VB6CodeColours.dat). Este arquivo contém o seguinte (e ele varia de acordo com as cores que você substitui no VB6.EXE, portanto, uma cópia e uma cópia retas provavelmente não funcionarão.
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
Parece rabugento, mas vou explicar.
Tem o formato "Cor do Código", "Primeiro Plano", "Fundo", Indicador "para que a linha superior defina o" Texto Normal "para o 14º item na combinação para Primeiro Plano, o 12º para Fundo e o 1º para o Indicador .
Por que eu disse que é uma solução bem crua:
* Ele usa SendKeys. Nenhuma outra explicação necessária, tenho certeza :)
* O usuário tem que clicar no menu / barra de ferramentas para que ele tenha efeito.
* O código não está melhor estruturado (na minha opinião), mas foi baseado na quantidade de tempo que eu poderia dedicar a ele na época. Eu pretendo melhorá-lo no futuro, mas funciona bem para mim no estado atual (então provavelmente vou deixá-lo!)
Talvez com base, alguém possa expandi-lo ainda mais.
