Option Explicit
Dim hLighter() As Highlighter
Dim lStyle As Long
Public hlPath As String
Public hlMain As SCIHighlighter
Public WhatToDo As Long
Dim lSelLang As Long
Dim Lexer() As String
Private Sub clrBack_Click()
hLighter(lSelLang).StyleBack(lStyle) = clrBack.SelectedColor
End Sub
Private Sub clrFore_Click()
hLighter(lSelLang).StyleFore(lStyle) = clrFore.SelectedColor
End Sub
Private Sub cmbFont_Click()
On Error Resume Next
hLighter(lSelLang).StyleFont(lStyle) = cmbFont.Text
End Sub
Private Sub cmbKeyword_Click()
On Error Resume Next
txtKeyword.Text = hLighter(lSelLang).Keywords(cmbKeyword.ListIndex)
End Sub
Private Sub cmdCancel_Click()
WhatToDo = 0
Me.Hide
End Sub
Private Sub cmdOK_Click()
Dim i As Long
WriteSettings
WhatToDo = 1
Call hlMain.LoadHighlighters(hlPath)
Me.Hide
End Sub
Private Sub Form_Load()
'ListLangs App.Path & "\highlighters"
With tvMain
.Initialize
.InitializeImageList
Call .AddBitmap(LoadResPicture(102, vbResBitmap)) 'Folder Open
Call .AddBitmap(LoadResPicture(103, vbResBitmap)) 'Page
Call .AddBitmap(LoadResPicture(104, vbResBitmap)) 'Folder
.ItemHeight = 18
'LoadResPicture(103, vbResIcon)
'Call .AddIcon ' Folder Open
'Call .AddIcon ' Page
'Call .AddIcon(LoadResPicture(104, vbResIcon)) ' Folder Folder
End With
InitTreeView
Me.Left = GetSetting("ScintillaClass", "Settings", "OptLeft", (Screen.Width - Me.Width) \ 2)
Me.Top = GetSetting("ScintillaClass", "Settings", "OptTop", (Screen.Height - Me.Height) \ 2)
tbMain_TabClick 1, 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Erase Lexer()
SaveSetting "ScintillaClass", "Settings", "OptLeft", Me.Left
SaveSetting "ScintillaClass", "Settings", "OptTop", Me.Top
End Sub
Private Sub lstStyle_Click()
DispOpt
End Sub
Private Sub tbMain_TabClick(OldTab As Integer, NewTab As Integer)
On Error Resume Next
picOptions.visible = False
picStyles.visible = False
picKeywords.visible = False
Select Case NewTab
Case 1
picOptions.visible = True
chkAutoCloseBraces.SetFocus
Case 2
picStyles.visible = True
txtFilter.SetFocus
Case 3
picKeywords.visible = True
cmbKeyword.SetFocus
End Select
End Sub
Private Sub tvMain_NodeClick(ByVal hNode As Long)
lSelLang = -1
If Left(tvMain.GetNodeKey(hNode), 3) = "syn" Then
picOptions.visible = False
picKeywords.visible = False
picStyles.visible = True
lSelLang = Mid(tvMain.GetNodeKey(hNode), 4)
End If
If Left(tvMain.GetNodeKey(hNode), 3) = "key" Then
picOptions.visible = False
picKeywords.visible = True
picStyles.visible = False
lSelLang = Mid(tvMain.GetNodeKey(hNode), 4)
End If
If Left(tvMain.GetNodeKey(hNode), 3) = "gen" Then
picOptions.visible = True
picKeywords.visible = False
picStyles.visible = False
lSelLang = -1
End If
DispOpt True
End Sub
Private Sub txtComment_Change()
On Error Resume Next
hLighter(lSelLang).strComment = txtComment.Text
End Sub
Private Sub txtFilter_Change()
' On Error Resume Next
hLighter(lSelLang).strFilter = txtFilter.Text
End Sub
Private Sub txtKeyword_Change()
On Error Resume Next
hLighter(lSelLang).Keywords(cmbKeyword.ListIndex) = txtKeyword.Text
End Sub
Private Sub txtSize_Change()
On Error Resume Next
hLighter(lSelLang).StyleSize(lStyle) = txtSize.Text
End Sub
Private Sub txtSize_KeyPress(KeyAscii As Integer)
KeyAscii = IsNumericKey(KeyAscii)
End Sub
Private Sub chkBold_Click()
On Error Resume Next
hLighter(lSelLang).StyleBold(lStyle) = chkBold.Value
End Sub
Private Sub chkEOL_Click()
On Error Resume Next
hLighter(lSelLang).StyleEOLFilled(lStyle) = chkEOL.Value
End Sub
Private Sub chkItalic_Click()
On Error Resume Next
hLighter(lSelLang).StyleItalic(lStyle) = chkItalic.Value
End Sub
Private Sub chkUnderline_Click()
On Error Resume Next
hLighter(lSelLang).StyleUnderline(lStyle) = chkUnderline.Value
End Sub
Private Sub chkVisible_Click()
On Error Resume Next
hLighter(lSelLang).StyleVisible(lStyle) = chkVisible.Value
End Sub
Private Sub DispOpt(Optional ListStyles As Boolean = False)
On Error Resume Next
Dim lLexNum As Long, i As Long
' This is a basic function that will just set the options
' to the different options (checkboxes, textboxes, etc.),
' based on the highlighter selected.
'If lstStyle.ListIndex = -1 Then Exit Sub
lStyle = lstStyle.ItemData(lstStyle.ListIndex)
txtFilter.Text = hLighter(lSelLang).strFilter
cmbFont.Text = hLighter(lSelLang).StyleFont(lStyle)
clrFore.SelectedColor = hLighter(lSelLang).StyleFore(lStyle)
clrBack.SelectedColor = hLighter(lSelLang).StyleBack(lStyle)
txtStyleDesc.Text = IIf(hLighter(lSelLang).StyleName(lStyle) <> "", hLighter(lSelLang).StyleName(lStyle), IIf(Lexer(lStyle) <> "", Lexer(lStyle), ""))
txtComment.Text = hLighter(lSelLang).strComment
txtSize.Text = hLighter(lSelLang).StyleSize(lStyle)
chkBold.Value = hLighter(lSelLang).StyleBold(lStyle)
chkEOL.Value = hLighter(lSelLang).StyleEOLFilled(lStyle)
chkItalic.Value = hLighter(lSelLang).StyleItalic(lStyle)
chkUnderline.Value = hLighter(lSelLang).StyleUnderline(lStyle)
chkVisible.Value = hLighter(lSelLang).StyleVisible(lStyle)
cmbKeyword.ListIndex = 0
txtKeyword.Text = hLighter(lSelLang).Keywords(0)
If lSelLang > -1 And ListStyles = True Then
lstStyle.Clear
lLexNum = hLighter(lSelLang).iLang
Lexer() = Split(LexList(lLexNum), ":")
For i = 0 To 127 'UBound(Lexer())
If LCase(hLighter(lSelLang).StyleName(i)) = "defau" Or LCase(hLighter(lSelLang).StyleName(i)) = "not set" Or LCase(hLighter(lSelLang).StyleName(i)) = "default" Or LCase(hLighter(lSelLang).StyleName(i)) = "defaul" Or LCase(hLighter(lSelLang).StyleName(i)) = "none" Then
hLighter(lSelLang).StyleName(i) = ""
End If
If UBound(hLighter(lSelLang).StyleName) > 0 And hLighter(lSelLang).StyleName(i) <> "" Then
lstStyle.AddItem hLighter(lSelLang).StyleName(i)
lstStyle.ItemData(lstStyle.ListCount - 1) = i
ElseIf UBound(Lexer) >= i And Lexer(i) <> "" Then
lstStyle.AddItem Lexer(i)
lstStyle.ItemData(lstStyle.ListCount - 1) = i
End If
Next i
If lstStyle.ListCount > 0 Then lstStyle.ListIndex = 0
End If
End Sub
Private Sub WriteSettings()
On Error Resume Next
Dim i As Long, x As Long
Dim strFile As String
Dim strOutput As String
For i = 0 To UBound(hLighter) - 1
Open Left(hLighter(i).strFile, Len(hLighter(i).strFile) - 3) & "bin" For Binary Access Write As #1
hLighter(i).strFile = Left(hLighter(i).strFile, Len(hLighter(i).strFile) - 3) & "bin"
Put #1, , hLighter(i)
Close #1
' strFile = hLighter(i).strFile
' writeini "data", "filter", hLighter(i).strFilter, strFile
' writeini "data", "LangName", hLighter(i).strName, strFile
' For X = 0 To 127
' strOutput = ""
' If StyleSet(i, X) Then
' If hLighter(i).StyleBold(X) = 1 Then
' strOutput = "B"
' End If
' strOutput = strOutput & ":"
' If hLighter(i).StyleItalic(X) = 1 Then
' strOutput = strOutput & "I"
' End If
' strOutput = strOutput & ":"
' If hLighter(i).StyleUnderline(X) = 1 Then
' strOutput = strOutput & "U"
' End If
' strOutput = strOutput & ":"
' If hLighter(i).StyleVisible(X) = 1 Then
' strOutput = strOutput & "V"
' End If
' strOutput = strOutput & ":C:"
' If hLighter(i).StyleEOLFilled(X) = 1 Then
' strOutput = strOutput & "E"
' End If
' strOutput = strOutput & "::"
' If hLighter(i).StyleFont(X) <> "" Then
' strOutput = strOutput & hLighter(i).StyleFont(X)
' End If
' strOutput = strOutput & ":"
' strOutput = strOutput & hLighter(i).StyleSize(X)
' strOutput = strOutput & ":"
' If hLighter(i).StyleFore(X) <> 0 Then
' strOutput = strOutput & hLighter(i).StyleFore(X)
' End If
' strOutput = strOutput & ":"
' If hLighter(i).StyleBack(X) <> 0 Then
' strOutput = strOutput & hLighter(i).StyleBack(X)
' End If
' strOutput = strOutput & ":"
' If hLighter(i).StyleName(X) <> "" Then
' strOutput = strOutput & hLighter(i).StyleName(X)
' End If
' strOutput = strOutput & ":"
' Call writeini("data", "Style[" & X & "]", strOutput, strFile)
' End If
' Next X
' For X = 0 To 7
'
' If hLighter(i).Keywords(X) <> "" Then
' Call writeini("data", "Keywords[" & X & "]", hLighter(i).Keywords(X), strFile)
' End If
' Next X
Next i
End Sub
Private Sub txtStyleDesc_Change()
On Error Resume Next
hLighter(lSelLang).StyleName(lStyle) = txtStyleDesc.Text
lstStyle.List(lstStyle.ListIndex) = txtStyleDesc.Text
End Sub
Private Sub InitTreeView()
Dim pNode As Long, pMain As Long
Dim i As Long
With tvMain
.Clear
.HideSelection = False
.HasRootLines = True
.HasButtons = True
.HasLines = True
.TrackSelect = True
pMain = .AddNode(, , "Main", "Settings", 2, 0, True)
.AddNode pMain, , "gen", "General Options", 1, 1
pNode = .AddNode(pMain, , "Syntax", "Syntax", 2, 0)
ReDim hLighter(0 To UBound(Highlighters))
For i = 0 To UBound(Highlighters) - 1
hLighter(i) = Highlighters(i)
.AddNode pNode, rLast, "syn" & i, hLighter(i).strName, 1, 1
Next i
.Expand pNode
pNode = .AddNode(pMain, , "Keywords", "Keywords", 2, 0)
For i = 0 To UBound(Highlighters) - 1
hLighter(i) = Highlighters(i)
.AddNode pNode, rLast, "key" & i, hLighter(i).strName, 1, 1
Next i
.Expand pMain
End With
End Sub