Keskustelu: Ohjelmointikysymykset: VB.NET: Richtextbox:n ominaisuudet käyttöön. VB2008 + access 2007

Imports System.Data
Imports System.Data.OleDb
Imports Microsoft.VisualBasic
'...

Sub MainFormLoad(sender As Object, e As EventArgs)
    Richtextbox1.Text = _
    "plaa plaa plaa_SELECT joku1 FROM jostain where joku2 like '%" _
    + Chr(34) + " & muuttuja & " + Chr(34) + "%'_plää plää plää" + _
    Environment.NewLine + _
    "plaa plaa plaa_SELECT joku1 FROM jostain where joku2 like '%" _
    + Chr(34) + " & muuttuja & " + Chr(34) + "%'_plää plää plää"
    vaihda_väri()
    Richtextbox1.SelectionStart = Richtextbox1.Text.Length
End Sub

Sub MainFormShown(sender As Object, e As EventArgs)
    Dim muuttuja(10) As Object
    muuttuja(0) = "jotain"
    muuttuja(1) ="jotain toista"
   'jne...

    Dim strArray() As String
    Dim i, j As Integer
    strArray = Split(richtextbox1.Text, "_")

    If strArray.Length > 0 Then
      For i = 0 To strArray.Length -1
        If strArray(i).IndexOf("SELECT") > -1 Then
          strArray(i) = Replace(strArray(i), Chr(34) + _
          " & muuttuja & " + Chr(34), muuttuja(j))
          j += 1
          msgbox(strArray(i))
          '...
          'Dim cmd As OleDbCommand = _
          'New OleDbCommand(strArray(i), connection)
          'plaa plaa plaa
        End If
      Next i
    End If
End Sub

Sub vaihda_väri()
    Dim merkki As String = "_", i As Integer = 0
    For i = 0 to RichTextBox1.Text.Length
      Etsi (merkki, i, RichTextBox1.Text.Length)
      RichTextBox1.SelectionColor = RichTextBox1.BackColor
    Next i
End Sub

Public Function Etsi( ByVal hakusana As String, _
  ByVal alku As Integer, ByVal loppu As Integer) As Integer
    Dim palaute As Integer = -1
    If hakusana.Length > 0 And alku >= 0 Then
      If loppu > alku Or loppu = -1 Then
        Dim indeksi As Integer = _
          richTextBox1.Find(hakusana, alku, _
          loppu, RichTextBoxFinds.MatchCase)
            If indeksi >= 0 Then
              palaute = indeksi
            End If
      End If
    End If
    Return palaute
 End Function

' VB6 ActiveX.dll
' GetInstalledFonts : ifonts (ifonts.cls)
' käännä ja rekisteröi regsvr.32.exe:llä
Option Explicit

Private Const DLL_PROCESS_DETACH = 0
Private Const DLL_PROCESS_ATTACH = 1
Private Const DLL_THREAD_ATTACH = 2
Private Const DLL_THREAD_DETACH = 3

Public Function DllMain(hInst As Long, _
fdwReason As Long, lpvReserved As Long) As Boolean
   Select Case fdwReason
      Case DLL_PROCESS_DETACH
      Case DLL_PROCESS_ATTACH
         DllMain = True
      Case DLL_THREAD_ATTACH
      Case DLL_THREAD_DETACH
   End Select
End Function

Public Function InstFonts() As Variant

  Dim strFonts() As String
  Dim i As Integer
  Dim j As Integer
  For i = 0 To Screen.FontCount - 1
    If InStr(Screen.Fonts(i), "@") = 0 And _
    InStr(Screen.Fonts(i), "WST_") = 0 Then
      ReDim Preserve strFonts(j)
      strFonts(j) = Screen.Fonts(i)
      j = j + 1
    End If
  Next i
  InstFonts = strFonts()
  Erase strFonts

End Function

'VB.NET sovellus
' Käännä (VB6) GetInstalledFonts.dll .NET assemblyksi:
' InteropGetInstalledFonts.dll  TLbImp.exe - ohjelmalla &
' tuo käännetty assembly projektiin...

Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports InteropGetInstalledFonts
Imports Microsoft.VisualBasic

<Microsoft.VisualBasic.ComClass()>Public Partial Class MainForm
Inherits System.Windows.Forms.Form

Public Shared WithEvents fnt As stdole.IFontDisp  =  _
New stdole.StdFontClass()
Public Shared WithEvents fntFamily As FontFamily
Public Shared fntStyle As FontStyle
Public Declare Auto Function OLEInitialize Lib "ole32" _
Alias "OleInitialize" (ByVal frm As Form) As Integer

  Public Sub New()
    Me.InitializeComponent()
    OLEInitialize(Me)
  End Sub

  Sub MainFormLoad(sender As Object, e As EventArgs)

       Dim ctl As Control
       For Each ctl In Me.Controls
         If ctl.name.Substring(0,5) = "fsBtn" Then
             ctl.Tag = False
             ctl.BackColor = Color.WhiteSmoke
         End If
       Next

       FillCboFontNames

  End Sub

  Sub ComboBox1SelectedIndexChanged(sender As Object, e As EventArgs)
     ChangeRtfStyle
  End Sub

  Sub FsBtn0Click(sender As Object, e As EventArgs)
    SetFontStyleOptions(sender)
  End Sub

  Sub FsBtn1Click(sender As Object, e As EventArgs)
    SetFontStyleOptions(sender)
  End Sub

  Sub FsBtn2Click(sender As Object, e As EventArgs)
    SetFontStyleOptions(sender)
  End Sub

  Sub FsBtn3Click(sender As Object, e As EventArgs)
    SetFontStyleOptions(sender)
  End Sub

  <ComRegisterFunction()> _
  Public Sub FillCboFontNames()

    Dim i As Integer = 0
      Dim index As Integer = 0

      Dim iFonts As New InteropGetInstalledFonts.ifontsClass()
      Dim strFonts() As Object = _
      iFonts.InstFonts()
      For i =  0 To strFonts.getUpperBound(0)
        comboBox1.Items.Add(strFonts(i))
      Next
      For i = 0 To comboBox1.Items.Count -1
        If  comboBox1.Items(i) = "Times New Roman" Then
          index = i: Exit for
        End If
      Next
      comboBox1.SelectedIndex = index
      numericUpDown1.Value = 10
      strFonts = Nothing
      iFonts = Nothing

  End Sub

  <ComRegisterFunction()> _
  Public Sub ChangeRtfStyle()

    fnt.Name = ComboBox1.SelectedItem.ToString
    fnt.Size = numericUpDown1.value

    Try
    fntFamily = New FontFamily(fnt.Name)
    Richtextbox1.SelectionFont = _
    New Font(fntFamily, fnt.Size, fntStyle)
    Catch ex As Exception
    End Try

  End Sub

  Sub NumericUpDown1ValueChanged(sender As Object, e As EventArgs)
    fnt.Size = numericUpDown1.value
    Richtextbox1.SelectionFont = _
    New Font(fntFamily, fnt.Size, fntStyle)
  End Sub

  Sub FcBtnClick(sender As Object, e As EventArgs)
    SetFontColorOptions(sender)
  End Sub

  Sub BcBtnClick(sender As Object, e As EventArgs)
     SetFontColorOptions(sender)
  End Sub

  <ComRegisterFunction()> _
  Public Sub SetFontColorOptions(ctl As Control)

    colorDialog1.ShowDialog

    Select Case ctl.Name
      Case "fcBtn"
       richTextbox1.SelectionColor = _
       ColorDialog1.Color: Exit Sub
      Case "bcBtn"
      richTextbox1.SelectionBackColor = _
       ColorDialog1.Color: Exit Sub
    End Select

  End Sub

  <ComRegisterFunction()> _
  Public Sub SetFontStyleOptions(ctl As Control)

      ctl.Tag = Not ctl.Tag

      If ctl.Tag Then
      ctl.BackColor = Color.LightGray
      Else
      ctl.BackColor = Color.WhiteSmoke
      End If
      Dim i As Integer = 0
      Dim binStr As String = ""

      For i = 3 To 0 Step -1
        If Me.Controls("fsBtn" & Cstr(i)).Tag = True Then
          binStr += "1"
        Else
          binStr += "0"
      End If
      Next

      Dim value As long = 0
      For i = binStr.Length To 1 Step -1
      If Mid(binStr, i, 1) = "1" Then
        value +=  2 ^ (binStr.Length - i)
      End If
      Next i
      fntStyle= value
      ChangeRtfStyle

  End Sub

  Sub MainFormFormClosing(sender As Object, e As FormClosingEventArgs)
     OLEInitialize(Nothing)
  End Sub

End Class