frmOptions Source Code

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