Results 1 to 40 of 4215

Thread: CommonControls (Replacement of the MS common controls)

Threaded View

  1. #10
    Addicted Member
    Join Date
    Apr 2017
    Location
    India
    Posts
    238

    Re: RichtextBox text color - different behavior since Windows 8/10/11

    Quote Originally Posted by Schmidt View Post
    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
  •  



Click Here to Expand Forum to Full Width