|
-
Dec 21st, 2021, 04:11 AM
#10
Addicted Member
Re: RichtextBox text color - different behavior since Windows 8/10/11
 Originally Posted by Schmidt
Sure... relatively easy to do via the IVBFlexDataSource interface, when you implement it in a little Class like the one below.
Into a Class, named cTextDataSource:
Code:
Option Explicit
Implements IVBFlexDataSource
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal codePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private UTF8() As Byte, Offsets() As Long, LineCount As Long, LastLineIdx As Long, Line As String
Public Sub BindToTextFile(FG As VBFlexGrid, FileName As String)
UTF8 = ReadFileBytes(FileName)
LineCount = GetLines(UTF8, Offsets)
LastLineIdx = -1
Set FG.FlexDataSource = Me 'bind this Class (and set a few FG-defaults)
FG.ColWidth(0) = 1800
FG.ExtendLastCol = True
FG.ScrollTrack = True
End Sub
Private Function ReadFileBytes(FileName As String) As Byte()
Dim FNr As Long: FNr = FreeFile
On Error GoTo 1
Open FileName For Binary As FNr
ReDim ReadFileBytes(LOF(FNr) - 1)
Get FNr, , ReadFileBytes
1 If Err Then ReadFileBytes = StrConv(Err.Description, vbFromUnicode)
Close FNr
End Function
Private Function GetLines(UTF8() As Byte, Offsets() As Long) As Long
Dim OffsUB As Long: OffsUB = 1024: ReDim Offsets(OffsUB)
Dim i As Long, j As Long, LF As Byte
For i = 0 To UBound(UTF8)
If UTF8(i) = 13 Or UTF8(i) = 10 Then LF = UTF8(i): Exit For
Next
For i = 0 To UBound(UTF8)
If UTF8(i) = LF Then
If j >= OffsUB Then OffsUB = 1.5 * OffsUB: ReDim Preserve Offsets(OffsUB)
j = j + 1: Offsets(j) = i
End If
Next
If UTF8(i - 1) <> 13 And UTF8(i - 1) <> 10 Then
If j >= OffsUB Then OffsUB = 1.5 * OffsUB: ReDim Preserve Offsets(OffsUB)
j = j + 1: Offsets(j) = i
End If
GetLines = j
End Function
Private Function GetLine(ByVal ZeroBasedLineIdx As Long) As String
Dim Offs As Long: Offs = Offsets(ZeroBasedLineIdx)
If UTF8(Offs) = 13 Then Offs = Offs + 1
If UTF8(Offs) = 10 Then Offs = Offs + 1
Dim BLen As Long: BLen = Offsets(ZeroBasedLineIdx + 1) - Offs
If BLen > 0 Then 'UTF8-to-BSTR conversion, directly from the UTF8-bytearray
GetLine = Space$(MultiByteToWideChar(65001, 0, VarPtr(UTF8(Offs)), BLen, 0, 0))
MultiByteToWideChar 65001, 0, VarPtr(UTF8(Offs)), BLen, StrPtr(GetLine), Len(GetLine)
End If
End Function
'***** Implementation of IVBFlexDataSource *****
Private Function IVBFlexDataSource_GetRecordCount() As Long
IVBFlexDataSource_GetRecordCount = LineCount
End Function
Private Function IVBFlexDataSource_GetFieldCount() As Long
IVBFlexDataSource_GetFieldCount = 2
End Function
Private Function IVBFlexDataSource_GetFieldName(ByVal Field As Long) As String
Select Case Field
Case 0: IVBFlexDataSource_GetFieldName = "TimeStamp"
Case 1: IVBFlexDataSource_GetFieldName = "LogInfo"
End Select
End Function
Private Function IVBFlexDataSource_GetData(ByVal Field As Long, ByVal Record As Long) As String
If LastLineIdx <> Record Then
LastLineIdx = Record
Line = GetLine(Record)
End If
Select Case Field
Case 0: IVBFlexDataSource_GetData = Left$(Line, 19)
Case 1: IVBFlexDataSource_GetData = Mid$(Line, 21)
End Select
End Function
Private Sub IVBFlexDataSource_SetData(ByVal Field As Long, ByVal Record As Long, ByVal NewData As String)
End Sub
And this into a Form for testing with one of your own Log- or TextFiles:
(the Form needs an instance of VBFlexgrid1, ... either in version 1.4. or in newest version 1.5)
Code:
Option Explicit
Const FileName = "c:\temp\test3.txt"
Private FlexDS As New cTextDataSource
Private Sub Form_Load()
VBFlexGrid1.Font.Name = "Arial"
FlexDS.BindToTextFile VBFlexGrid1, FileName
End Sub
Private Sub Form_Resize()
VBFlexGrid1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Since the FlexGrid is normally used for "Multi-Column-Data",
I've artificially created a LogFile with a leading (ISO) Timestamp per Line, to have more than one Column "to split" for the FG.
Used the RC6 for that, with the following snippet:
Code:
With New_c.StringBuilder
Dim i As Long, D As Double: D = Now
For i = 1 To 100000
D = D + 1 / 86400
.Add Format$(D, "yyyy\-mm\-dd hh\:nn\:ss")
.AddNL " Some loooooooooooooooooonger Log-Entry-Line " & i
Next
New_c.FSO.WriteByteContent FileName, .ToUTF8
End With
HTH
Olaf
Only just a moment ago, I posted a query in Krool's 'VBFlexGrid Control' thread about whether we can bind a VBFlexGrid to a database table (for a different purpose though). In fact, it so happened that I mentioned about you too in that post!
And, after posting it, I came here (to the 'Common Controls' thread) almost immediately to check for any new posts and I find yours on how to load large text files in the VBFlexGrid!!!!! What a coincidence and what a joy! Thanks a TON, Olaf. Will try it out soon in the recently released 1.5 Ocx.
In case large RichText (with all formatting - B/I/U/etc. - intact) has to be loaded and shown, then which control of Krool's will be ideal? (since VBFlexGrid or ListBox cannot show Rich Text, if I am right). Or, using PictureBox only will be the ideal one? If so, what would be the code as a startup for the same? Kindly please show me the way, since showing large RichText content also will be the case for me.
Kind regards.
Last edited by softv; Dec 21st, 2021 at 04:16 AM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|