Change font style to Richtextbox vb.net - vb.net

I need to change font style and add it to Richtextbox, this is my code but i get some errors. please help
Dim sb = New StringBuilder()
sb.AppendFormat(New Font("IDAutomationHC39M", 12,FontStyle.Regular).AppendLine("SCAN BARCODE: " & txtBarcode.Text)
RichTextBoxPrintCtrl1.Text = sb.ToString()

To change the font for only a part of the text in your RichTextBox you need to search for the text required, then calculate its length and select it. At this point you can apply the font you want to the SelectionFont property.
Sub SetBarCodeText(searchText as String)
Dim len As Integer = searchText.Length
Dim pos As Integer = RichTextBoxPrintCtrl1.Find(searchText, 0, RichTextBoxFinds.NoHighlight)
if pos >= 0 Then
Dim start As Integer = pos
Dim endpos As Integer = start + len
RichTextBoxPrintCtrl1.Select(start, endpos - start)
RichTextBoxPrintCtrl1.SelectionFont = new Font("IDAutomationHC39M", 12, FontStyle.Regular)
End If
End Sub
and you call the method above with
RichTextBoxPrintCtrl1.Text = "SCAN BARCODE: " & txtBarcode.Text
SetBarCodeText("SCAN BARCODE: " & txtBarcode.Text)

Related

I want to make a maths quiz on vb.net that uses bracket questions

So I've used visual basics (vb.net) for a bit now and understand some stuff. Right now I want to make a maths quiz that when I click a button it takes me to a new form and starts the quiz. When the quiz starts I want it so it gives the user random numbers and the user needs to answer it in a textbox and if correct it moves on to the next question (Basic, I should be able to do). IMPORTANT - my question is, there's a maths rule called BODMAS (Bracket.Order.Division.Multiply.Add.Subtract) and I want to add this rule into my coding instead of doing regular simple maths...
EXAMPLE question is 2 x (2+3) - 1 = ?
2 x 5 - 1 = ?
10 - 1 = ?
9 = 9
person writes answer to textbox and moves to next similar question
This is my first time using this but I wanted to write in-depth so people can understand. Please help me if you find a video explaining what I'm looking for or if someone has a file with a similar code I could download would be greatly appreciated!
Basically,you need to determine the range of numbers you use, and then match them randomly among '*', '/', '+', '-'. Then randomly insert brackets into it.
Private codeStr As String
Private Function GenerateMathsQuiz() As String
Dim r As Random = New Random()
Dim builder As StringBuilder = New StringBuilder()
'The maximum number of operations is five, and you can increase the number [5] to increase the difficulty
Dim numOfOperand As Integer = r.[Next](1, 5)
Dim numofBrackets As Integer = r.[Next](0, 2)
Dim randomNumber As Integer
For i As Integer = 0 To numOfOperand - 1
'All numbers will be random between 1 and 10
randomNumber = r.[Next](1, 10)
builder.Append(randomNumber)
Dim randomOperand As Integer = r.[Next](1, 4)
Dim operand As String = Nothing
Select Case randomOperand
Case 1
operand = "+"
Case 2
operand = "-"
Case 3
operand = "*"
Case 4
operand = "/"
End Select
builder.Append(operand)
Next
randomNumber = r.[Next](1, 10)
builder.Append(randomNumber)
If numofBrackets = 1 Then
codeStr = InsertBrackets(builder.ToString())
Else
codeStr = builder.ToString()
End If
Return codeStr
End Function
Public Function InsertBrackets(ByVal source As String) As String
Dim rx As Regex = New Regex("\d+", RegexOptions.Compiled Or RegexOptions.IgnoreCase)
Dim matches As MatchCollection = rx.Matches(source)
Dim count As Integer = matches.Count
Dim r As Random = New Random()
Dim numIndexFirst As Integer = r.[Next](0, count - 2)
Dim numIndexLast As Integer = r.[Next](1, count - 1)
While numIndexFirst >= numIndexLast
numIndexLast = r.[Next](1, count - 1)
End While
Dim result As String = source.Insert(matches(numIndexFirst).Index, "(")
result = result.Insert(matches(numIndexLast).Index + matches(numIndexLast).Length + 1, ")")
Return result
End Function
When you finish this, you will get a math quiz, then you need to know how to compile and run code at runtime.
Private Function GetResult(ByVal str As String) As String
Dim sb As StringBuilder = New StringBuilder("")
sb.Append("Namespace calculator" & vbCrLf)
sb.Append("Class calculate " & vbCrLf)
sb.Append("Public Function Main() As Integer " & vbCrLf)
sb.Append("Return " & str & vbCrLf)
sb.Append("End Function " & vbCrLf)
sb.Append("End Class " & vbCrLf)
sb.Append("End Namespace" & vbCrLf)
Dim CompilerParams As CompilerParameters = New CompilerParameters()
CompilerParams.GenerateInMemory = True
CompilerParams.TreatWarningsAsErrors = False
CompilerParams.GenerateExecutable = False
CompilerParams.CompilerOptions = "/optimize"
Dim references As String() = {"System.dll"}
CompilerParams.ReferencedAssemblies.AddRange(references)
Dim provider As VBCodeProvider = New VBCodeProvider()
Dim compile As CompilerResults = provider.CompileAssemblyFromSource(CompilerParams, sb.ToString())
If compile.Errors.HasErrors Then
Dim text As String = "Compile error: "
For Each ce As CompilerError In compile.Errors
text += "rn" & ce.ToString()
Next
Throw New Exception(text)
End If
Dim Instance = compile.CompiledAssembly.CreateInstance("calculator.calculate")
Dim type = Instance.GetType
Dim methodInfo = type.GetMethod("Main")
Return methodInfo.Invoke(Instance, Nothing).ToString()
End Function
Finally, you can use these methods like:
Private Sub GetMathQuizBtn_Click(sender As Object, e As EventArgs) Handles GetMathQuizBtn.Click
Label1.Text = GenerateMathsQuiz()
End Sub
Private Sub ResultBtn_Click(sender As Object, e As EventArgs) Handles ResultBtn.Click
If TextBox1.Text = GetResult(Label1.Text) Then
MessageBox.Show("bingo!")
TextBox1.Text = ""
Label1.Text = GenerateMathsQuiz()
Else
MessageBox.Show("result is wrong")
End If
End Sub
Result:

Repeat character in Two or More Textboxes VB Net

I want to compare the Textbox1 with TextBox2, or Textbox line 1 of the text box to the 2nd line, to show me the existing Character in another textbox, or show me how many characters are repeated. iI really like learning, so I would be helpful because I want to learn...
TextBox1.Text = 1,4,7,11,13,16,19,20,28,31,44,37,51,61,62,63,64,69,71,79,80
TextBox2.Text = 1,5,7,10,13,16,26,20,28,31,44,37,51,72,73,74,69,71,79,80
TextBox3.Text = Character Repeated: 1,7,13,16,20,28,31,44,37,51,69,71,79,80
TextBox4.Text = Number of Character Repeated = 14
TextBox5.Text = Number of Character which has not been repeated: 4,11,19,61,62,63,64 etc, you got to idea
TextBox6.Text = Number of Character isn't Repeated: 7
here are some codes: but I do not know how to apply them correctly.
Code 1: Show repetable character:
' Split string based on space
TextBox1.Text = System.IO.File.ReadAllText(Mydpi.Text)
TextBox2.Text = System.IO.File.ReadAllText(Mydpi.Text)
TextBox4.Text = System.IO.File.ReadAllText(Mydpi.Text)
For i As Integer = 0 To TextBox2.Lines.Count - 1
Dim textsrtring As String = TextBox4.Lines(i)
Dim words As String() = textsrtring.Split(New Char() {","c})
Dim found As Boolean = False
' Use For Each loop over words
Dim word As Integer
For Each word In words
TxtbValBeforeCompar.Text = TextBox1.Lines(i)
CompareNumbers()
If TextBox1.Lines(i).Contains(word) Then
found = True
Dim tempTextBox As TextBox = CType(Me.Controls("Checkertxt" & i.ToString), TextBox)
On Error Resume Next
If TextBox2.Lines(i).Contains(word) Then
If tempTextBox.Text.Contains(word) Then
Else
tempTextBox.Text = tempTextBox.Text + " " + TxtbValAfterCompar.Text()
End If
Else
End If
End If
Next
Next
Private Sub CompareNumbers()
'First Textbox that is to be used for compare
Dim textBox1Numbers As List(Of Integer) = GetNumbersFromTextLine(N1Check.Text)
'Second Textbox that is to be used for compare
Dim textBox2Numbers As List(Of Integer) = GetNumbersFromTextLine(TxtbValBeforeCompar.Text)
'Union List of Common Numbers (this uses a lambda expression, it can be done using two For Each loops instead.)
Dim commonNumbers As List(Of Integer) = textBox1Numbers.Where(Function(num) textBox2Numbers.Contains(num)).ToList()
'This is purely for testing to see if it worked you can.
Dim sb As StringBuilder = New StringBuilder()
For Each foundNum As Integer In commonNumbers
sb.Append(foundNum.ToString()).Append(" ")
TxtbValAfterCompar.Text = (sb.ToString())
Next
End Sub
Private Function GetNumbersFromTextLine(ByVal sTextLine As String) As List(Of Integer)
Dim numberList As List(Of Integer) = New List(Of Integer)()
Dim sSplitNumbers As String() = sTextLine.Split(" ")
For Each sNumber As String In sSplitNumbers
If IsNumeric(sNumber) Then
Dim iNum As Integer = CInt(sNumber)
TxtbValAfterCompar.Text = iNum
If Not numberList.Contains(iNum) Then
TxtbValAfterCompar.Text = ("")
numberList.Add(iNum)
End If
Else
End If
Next
Return numberList
End Function
Code 2: Remove Duplicate Chars (Character)
Module Module1
Function RemoveDuplicateChars(ByVal value As String) As String
' This table stores characters we have encountered.
Dim table(value.Length) As Char
Dim tableLength As Integer = 0
' This is our result.
Dim result(value.Length) As Char
Dim resultLength As Integer = 0
For i As Integer = 0 To value.Length - 1
Dim current As Char = value(i)
Dim exists As Boolean = False
' Loop over all characters in the table of encountered chars.
For y As Integer = 0 To tableLength - 1
' See if we have already encountered this character.
If current = table(y) Then
' End the loop.
exists = True
y = tableLength
End If
Next
' If we have not encountered the character, add it.
If exists = False Then
' Add character to the table of encountered characters.
table(tableLength) = current
tableLength += 1
' Add character to our result string.
result(resultLength) = current
resultLength += 1
End If
Next
' Return the unique character string.
Return New String(result, 0, resultLength)
End Function
Sub Main()
' Test the method we wrote.
Dim test As String = "having a good day"
Dim result As String = RemoveDuplicateChars(test)
Console.WriteLine(result)
test = "areopagitica"
result = RemoveDuplicateChars(test)
Console.WriteLine(result)
End Sub
End Module
You could make use of some LINQ such as Intersect and Union.
Assuming your TextBox1 and TextBox2 contains the text you have provided.
Here's a simple method to find repeated and non repeated characters.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim firstBoxList = TextBox1.Text.Split(",").ToList()
Dim secondBoxList = TextBox2.Text.Split(",").ToList()
Dim intersectionList = firstBoxList.Intersect(secondBoxList)
For Each str As String In intersectionList
TextBox3.Text = TextBox3.Text & str & ","
Next
TextBox4.Text = intersectionList.Count()
Dim notRepeatedCharacter = firstBoxList.Union(secondBoxList).ToList
notRepeatedCharacter.RemoveAll(Function(x) intersectionList.Contains(x))
For each str As String In notRepeatedCharacter
TextBox5.Text = TextBox5.Text & str & ","
Next
TextBox6.Text = notRepeatedCharacter.Count()
End Sub
The output is something like that:
This consider both of the textboxes not repeated character.
If you just want to find the not repeated characters from first list to the second, this should do it:
firstBoxList.RemoveAll(Function(x) secondBoxList.Contains(x))
For Each str As String In firstBoxList
TextBox7.Text = TextBox7.Text & str & ","
Next
TextBox8.Text = firstBoxList.Count
And this is the output:
Here's the full code using String.Join to make the lists look smoother in the text boxes:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'First we grab all the numbers written inside the textboxes (I am not verifying anything)
Dim firstBoxList = TextBox1.Text.Split(",").ToList()
Dim secondBoxList = TextBox2.Text.Split(",").ToList()
'Second we intersect the two lists and show them
Dim intersectionList = firstBoxList.Intersect(secondBoxList)
TextBox3.Text = String.Join(",", intersectionList)
TextBox4.Text = intersectionList.Count()
'We're checking the distintc character from both lists
Dim notRepeatedCharacter = firstBoxList.Union(secondBoxList).ToList
notRepeatedCharacter.RemoveAll(Function(x) intersectionList.Contains(x))
TextBox5.Text = String.Join(",", notRepeatedCharacter)
TextBox6.Text = notRepeatedCharacter.Count()
'we're checkng the distinct character inside first list that doesn't show in second list
firstBoxList.RemoveAll(Function(x) secondBoxList.Contains(x))
TextBox7.Text = String.Join(",", firstBoxList)
TextBox8.Text = firstBoxList.Count
End Sub

How to align dot in currency while printing

I have something like this:
Public Function ItemsToBePrinted()
Dim p_dt As DataTable = Model_Query(2)
Dim p_str As String = ""
Dim StringToPrint As String = ""
For Each drow As DataRow In p_dt.Rows
Dim str_itemName As New String(drow.Item("item_name").ToString)
Dim str_itemQty As New String(drow.Item("item_qty").ToString)
Dim str_itemUnitPrice As New String(drow.Item("item_unitprice").ToString)
Dim str_itemDisc As New String(drow.Item("item_disamt").ToString)
Dim str_itemTotalAmt As New String(drow.Item("item_totamt").ToString)
Dim lineLen1 As String = str_itemName.Length
Dim lineLen2 As String = str_itemQty.Length
Dim lineLen3 As String = str_itemUnitPrice.Length
Dim lineLen4 As String = str_itemDisc.Length
Dim spcLen1 As New String(" "c, 20 - lineLen1)
Dim spcLen2 As New String(" "c, 5 - lineLen2)
Dim spcLen3 As New String(" "c, 5 - lineLen3)
Dim spcLen4 As New String(" "c, 8 - lineLen4)
If drow.Item("item_disamt") = 0 Then
StringToPrint = $"{str_itemName}{spcLen1}{str_itemQty}{spcLen2}{str_itemUnitPrice}{spcLen3}{spcLen4}{str_itemTotalAmt}"
Else
StringToPrint = $"{str_itemName}{spcLen1}{str_itemQty}{spcLen2}{str_itemUnitPrice}{spcLen3}{str_itemDisc}{spcLen4}{str_itemTotalAmt}"
End If
p_str &= StringToPrint & Environment.NewLine
Next
Return p_str
End Function
Public Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim p_font As Font = New Font("Consolas", 10)
e.Graphics.DrawString(PrintItemHeader(), p_font, Brushes.Black, 2 * 8, 305)
e.Graphics.DrawLine(p_pen, 16, 340, 350, 340)
e.Graphics.DrawString(ItemsToBePrinted(), p_font, Brushes.Black, 2 * 8, 345)
Currently Im using the spcLen to count the space to make them align to left but I have no idea how to change alignment to right...
Here is the output:
How can I align the dot like this? All the data will align to right except Item Code
Item Code Qty Unit Disc Amount
Price
----------------------------------------------
XXXX 33 4.70 155.10
XXXX 2 3.00 6.00
XXXX 2 9.00 1.80 16.20
XXXX 1 7.50 7.50
XXXX 11 12.00 10.00 122.00
When you have to print the numeric columns you should put the spaces before the number and not after it because you want them aligned on the right
I would write a simple method that aligns your columns data on the right or on the left according to the space and the alignment required.
Function AlignText(text As String, TotalSpace As Integer, AlignRight As Boolean)
Dim alignResult As String
if string.IsNullOrEmpty Then
alignResult = new String(" "c, TotalSpace)
Else
if text.Length > TotalSpace Then
text = text.SubString(0, TotalSpace)
End If
If AlignRight Then
alignResult = New String(" "c, TotalSpace - text.Length) & text
Else
alignResult = text & New String(" "c, TotalSpace - text.Length)
End If
End If
Return alignResult
End Function
Now you can call this method in this way
Dim str_itemName = AlignText(drow.Item("item_name").ToString, 20, False)
Dim str_itemQty = AlignText(drow.Item("item_qty").ToString, 3, True)
Dim str_itemUnitPrice = AlignText(drow.Item("item_unitprice").ToString, 10, True)
Dim str_itemDisc = AlignText(drow.Item("item_disamt").ToString), 10, True)
Dim str_itemTotalAmt = AlignText(drow.Item("item_totamt").ToString), 10, True)
Of course you should remove all your space's calcs inside the loop and this coding will also remove the need of an If to skip the missing discount field
You should format your string using the String.Format function which allows you to create useful string representation when printing. Check out these 2 links:
https://www.dotnetperls.com/format-vbnet
https://msdn.microsoft.com/en-us/library/system.string.format(v=vs.110).aspx

Highlight text in a richtextbox in windows forms

How to make when i type in a RichTextBox a certain word it gets highlited?
how do i find words in the text to use SelectionColor or SelectionFont
For example: i want that all times that the word "hello" appear in the RichTextBox it turn to bold or turn into a color...
Then if i open my program and type "hello, how are you?" the word hello turns into bold... any idea? (my idea is to make a text editor with syntax highlight that ill specify the words)
(sorry if there is another question like that, i tried to search but i didn't find a answer that helped me)
its windows forms, visual basic
This code should do the work:
Dim searchstring As String = "hello"
' The word you're looking for
Dim count As New List(Of Integer)()
For i As Integer = 0 To richTextBox1.Text.Length - 1
If richTextBox1.Text.IndexOf(searchstring, i) <> -1 Then
'If the word is found
'Add the index to the list
count.Add(richTextBox1.Text.IndexOf(searchstring, i))
End If
Next
Try
For i As Integer = 0 To count.Count - 1
richTextBox1.[Select](count(i), searchstring.Length)
richTextBox1.SelectionFont = New Font(richTextBox1.Font, FontStyle.Bold)
count.RemoveAt(i)
Next
Catch
End Try
richTextBox1.[Select](richTextBox1.Text.Length, 0)
richTextBox1.SelectionFont = New Font(richTextBox1.Font, FontStyle.Regula
For each index select the text and make it bold.
Now add this code to the TextChanged-Event to check any time the text changed for your word.
I got it in a different way:
While Not RichTextBox1.Text.IndexOf("hello", startIndex) = -1
selectedIndex= RichTextBox1.SelectionStart
Try
RichTextBox1.Select(RichTextBox1.Text.IndexOf("test", startIndex) - 1, 1)
Catch
End Try
If RichTextBox1.SelectedText = " " Or RichTextBox1.SelectedText = Nothing Then
RichTextBox1.Select(RichTextBox1.Text.IndexOf("hello", startIndex) + "test".Length, 1)
If RichTextBox1.SelectedText = " " Or RichTextBox1.SelectedText = Nothing Then
RichTextBox1.Select(RichTextBox1.Text.IndexOf("hello", startIndex), "test".Length)
RichTextBox1.SelectionColor = Color.Blue
End If
End If
startIndex = RichTextBox1.Text.IndexOf("hello", startIndex) + "hello".Length
RichTextBox1.SelectionStart = selectedIndex
RichTextBox1.SelectionLength = 0
RichTextBox1.SelectionColor = Color.Black
End While
I don't know if it is the best way, but works.
That is a code for highlighting selected text at yellow (can be replaced by any other color), after finding it:
'find the text that need to be highlighted.
foundIndex = RichTextBox1.Find("hello", foundIndex + 1, -1, selectedFinds)
RichTextBox1.Focus()
If foundIndex = -1 Then
MessageBox.Show("This document don't contains the text you typed, or any of the text you typed as a whole word or mach case.", "Find Text Error", MessageBoxButtons.OK, MessageBoxIcon.Asterisk)
else
'now the text will be highlighted.
RichTextBox1.SelectionBackColor = Color.Yellow
Richtextbox1.focus
End If
I hope that code will help.
Private Sub RichTextBox1_DragOver(sender As Object, e As DragEventArgs) Handles RichTextBox1.DragOver
Dim p As Point
p.X = e.X
p.Y = e.Y
Dim num As Integer
Dim rightTXT As String
Dim leftTXT As String
Dim textpart As String
Dim TSelect As Boolean
Dim curpos As Integer = RichTextBox1.GetCharIndexFromPosition(RichTextBox1.PointToClient(p))
Dim PosStart As Integer
TSelect = False
If e.Data.GetDataPresent(DataFormats.StringFormat) Then
e.Effect = DragDropEffects.All
Try
leftTXT = Microsoft.VisualBasic.Left(RichTextBox1.Text, curpos)
If InStr(leftTXT, "%", CompareMethod.Text) Then
rightTXT = Microsoft.VisualBasic.Right(RichTextBox1.Text, Len(RichTextBox1.Text) - curpos)
If InStr(rightTXT, "%", CompareMethod.Text) Then
PosStart = curpos - InStr(StrReverse(leftTXT), "%") + 1
num = curpos + InStr(rightTXT, "%") - PosStart - 1
textpart = (RichTextBox1.Text.Substring(PosStart, num).TrimEnd)
Label3.Text = "mouse drag over:" + textpart
Label5.Text = num.ToString()
If ListBox1.Items.Contains(textpart) Then
TSelect = True
End If
End If
End If
Catch ex As Exception
Label4.Text = ex.ToString()
End Try
End If
If TSelect Then
Me.RichTextBox1.Select(PosStart - 1, num + 2)
wordSearch = RichTextBox1.SelectedText
Label4.Text = "word drag state: true"
match = True
Else
Label3.Text = "mouse drag over:"
Label4.Text = "word drag state: false"
Me.RichTextBox1.Select(0, 0)
End If
End Sub
I find the above codes to be too lengthy/complicated for a simple task...
Dim c As Integer = 0
Dim o As Integer = 0
Dim s As Integer = 0
Dim txt As String = RTB.Text
RTB.BackColor = Color.Black
Dim starts As Integer = 0
Do While txt.Contains(key) ' this avoids unnecessary loops
s = txt.IndexOf(key)
starts = s + o
RTB.Select(starts, key.Length)
RTB.SelectionBackColor = Color.Yellow
RTB.SelectionColor = Color.Blue
txt = txt.Substring(s + key.Length)
o += (s + key.Length)
c += 1
Loop
Me.Status.Text = c.ToString() & " found" ' and the number found

How to Display a Bmp in a RTF control in VB.net

I Started with this C# Question
I'm trying to Display a bmp image inside a rtf Box for a Bot program I'm making.
This function is supposed to convert a bitmap to rtf code whis is inserted to another rtf formatter srtring with additional text. Kind of like Smilies being used in a chat program.
For some reason the output of this function gets rejected by the RTF Box and Vanishes completly. I'm not sure if it the way I'm converting the bmp to a Binary string or if its tied in with the header tags
lb.SelectedRtf = FormatText(build.ToString, newColor)
'returns the RTF string representation of our picture
Public Shared Function PictureToRTF(ByVal Bmp As Bitmap) As String
'Create a new bitmap
Dim BmpNew As New Bitmap(Bmp.Width, Bmp.Height, Imaging.PixelFormat.Format24bppRgb)
Dim gr = Graphics.FromImage(BmpNew)
gr.DrawimageUnscaled(Bmp, 0, 0)
gr.dispose()
Dim stream As New MemoryStream()
BmpNew.Save(stream, System.Drawing.Imaging.ImageFormat.Bmp)
Dim bytes As Byte() = stream.ToArray()
Dim str As String = BitConverter.ToString(bytes, 0).Replace("-", String.Empty)
'header to string we want to insert
Using g As Graphics = Main.CreateGraphics()
xDpi = g.DpiX
yDpi = g.DpiY
End Using
Dim _rtf As New StringBuilder()
' Calculate the current width of the image in (0.01)mm
Dim picw As Integer = CInt(Math.Round((Bmp.Width / xDpi) * HMM_PER_INCH))
' Calculate the current height of the image in (0.01)mm
Dim pich As Integer = CInt(Math.Round((Bmp.Height / yDpi) * HMM_PER_INCH))
' Calculate the target width of the image in twips
Dim picwgoal As Integer = CInt(Math.Round((Bmp.Width / xDpi) * TWIPS_PER_INCH))
' Calculate the target height of the image in twips
Dim pichgoal As Integer = CInt(Math.Round((Bmp.Height / yDpi) * TWIPS_PER_INCH))
' Append values to RTF string
_rtf.Append("{\pict\wbitmap0")
_rtf.Append("\picw")
_rtf.Append(Bmp.Width.ToString)
' _rtf.Append(picw.ToString)
_rtf.Append("\pich")
_rtf.Append(Bmp.Height.ToString)
' _rtf.Append(pich.ToString)
_rtf.Append("\wbmbitspixel24\wbmplanes1")
_rtf.Append("\wbmwidthbytes40")
_rtf.Append("\picwgoal")
_rtf.Append(picwgoal.ToString)
_rtf.Append("\pichgoal")
_rtf.Append(pichgoal.ToString)
_rtf.Append("\bin ")
_rtf.Append(str.ToLower & "}")
Return _rtf.ToString
End Function
Public Function FormatText(ByVal data As String, ByVal newColor As fColorEnum) As String
data = System.Net.WebUtility.HtmlDecode(data)
data = data.Replace("|", " ")
Dim reg As New Regex("\$(.[0-9]+)\$")
If reg.IsMatch(data) Then
Dim meep As String = Regex.Match(data, "\$(.[0-9]+)\$").Groups(1).ToString
Dim idx As Integer = Convert.ToInt32(meep)
Dim img As String = Fox2RTF(idx)
If img IsNot Nothing Then data = Regex.Replace(data, "\$(.[0-9]+)\$", img)
End If
Dim myColor As System.Drawing.Color = fColor(newColor)
Dim ColorString = "{\colortbl ;"
ColorString += "\red" & myColor.R & "\green" & myColor.G & "\blue" & myColor.B & ";}"
Dim FontSize As Integer = cMain.ApFont.Size
Dim FontFace As String = cMain.ApFont.Name
FontSize *= 2
Dim test As String = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033" & ColorString & "{\fonttbl{\f0\fcharset0 " & FontFace & ";}}\viewkind4\uc1\fs" & FontSize.ToString & data & "\par}"
Return "{\rtf1\ansi\ansicpg1252\deff0\deflang1033" & ColorString & "{\fonttbl{\f0\fcharset0 " & FontFace & ";}}\viewkind4\uc1\fs" & FontSize.ToString & data & "\cf0 \par}"
End Function
Private Function Fox2RTF(ByRef Img As Integer) As String
Dim shape As New FurcadiaShapes(Paths.GetDefaultPatchPath() & "system.fsh")
Dim anims As Bitmap() = Helper.ToBitmapArray(shape)
' pic.Image = anims(Img)
Return PictureToRTF.PictureToRTF(anims(Img))
End Function
Never found the Soultion I was hoping for with this.. But I did find a work around http://www.codeproject.com/Articles/30902/RichText-Builder-StringBuilder-for-RTF