VB6 - Values between *

Hi

I have Text in my Text box that may start with AK1 up to AK9.

Then, you have * followed by values, and again a * follow again by values etc.

The * are delimiters between values.

The objective for me is that when i select a specific row, and that it start with AK9, each values between the starts will be shown in the grid in column 1.

As you can see, between the *, the values length can vary. So it must read whats in between *.

Ex:
AK9*A*1*1*1

I would have on column 1 and on 4 rows:
A
1
1
1

delimiter
How can i do that.

So far, this is what i have:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
                                     ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private mlngStartLine As Long
Private mstrCurrColor   As String
Option Explicit
Private Sub EDI_CODE_Click()
 Dim lngSelectedLine As Long
    Dim lngLength       As Long
    Dim lngFirstCharPos As Long
    Dim strBuffer       As String

    ' Determine selected line number (Starts at 0)
    lngSelectedLine = SendMessage(EDI_CODE.hwnd, EM_LINEFROMCHAR, -1, 0)
    lngFirstCharPos = SendMessage(EDI_CODE.hwnd, EM_LINEINDEX, lngSelectedLine, 0&)
    ' length of line
    lngLength = SendMessage(EDI_CODE.hwnd, EM_LINELENGTH, lngFirstCharPos, 0&)

    strBuffer = Space(lngLength)
    ' get line text
    Call SendMessage(EDI_CODE.hwnd, EM_GETLINE, lngSelectedLine, ByVal strBuffer)

    'MsgBox strBuffer
    If Mid$(strBuffer, 1, 3) = "AK9" Then
       
        EDI_DETAILS.TextMatrix(0, 0) = "DESCRIPTION"
        EDI_DETAILS.TextMatrix(0, 1) = "DETAIL"
        EDI_DETAILS.TextMatrix(0, 2) = "CHARS"
        EDI_DETAILS.TextMatrix(0, 3) = "VALIDATION"
        
       EDI_DETAILS.TextMatrix(1, 1) = Mid$(strBuffer, 5, 1)
        EDI_DETAILS.TextMatrix(2, 1) = Mid$(strBuffer, 7, 1)
        EDI_DETAILS.TextMatrix(3, 1) = Mid$(strBuffer, 9, 1)
        EDI_DETAILS.TextMatrix(4, 1) = Mid$(strBuffer, 11, 1)
        
        
        
        'Grig align
        Dim i As Integer

        With EDI_DETAILS

            For i = 0 To .Cols - 1
                .ColAlignment = flexAlignLeftCenter
            Next i

        End With
        
        Dim R        As Long
        Dim C        As Long
        Dim cell_wid As Single
        Dim col_wid  As Single

        For C = 0 To EDI_DETAILS.Cols - 1
            col_wid = 0

            For R = 0 To EDI_DETAILS.Rows - 1
                cell_wid = TextWidth(EDI_DETAILS.TextMatrix(R, C))

                If col_wid < cell_wid Then col_wid = cell_wid
            Next R

            EDI_DETAILS.ColWidth(C) = col_wid + 120
        Next C
        
    Else

        'delete grid if nothing
        EDI_DETAILS.Clear
        EDI_DETAILS.Rows = 10
        EDI_DETAILS.Cols = 4
                
        With EDI_DETAILS
            For i = 0 To .Cols - 1
                .ColAlignment = flexAlignLeftCenter
            Next i
        End With
    End If


End Sub

Open in new window



Thanks
2015-05-25-19-53-06.jpg
EDI-No2.zip
LVL 11
Wilder1626Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Let me download your zip file and then maybe I can better understand what you need.
0
Martin LissOlder than dirtCommented:
There's no textbox in the project you posted. Is it the right one?
0
Martin LissOlder than dirtCommented:
There also does not seem to be any way to get data into EDI_CODE or EDI_DETAILS.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Wilder1626Author Commented:
Strange.

Can you try this one?
You should have some sample data inside the textbox
EDI-No2.zip
0
Martin LissOlder than dirtCommented:
OK, to get the data in-between the asterisks you can do this by adding this code below your line 29.

  

    Dim strParts() As String
    Dim lngIndex As Long
    strParts = Split(strBuffer, "*")
    For lngIndex = 0 To UBound(strParts)
        Debug.Print strParts(lngIndex)
    Next

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Wilder1626Author Commented:
I'm not sure i understand how it would do it.

How would i send the values into the Mshflxgrid?
0
Wilder1626Author Commented:
If i do like below, only the values after the last * transfer

       
  Dim strParts() As String
    Dim lngIndex As Long
    strParts = Split(strBuffer, "*")
    For lngIndex = 0 To UBound(strParts)
    EDI_DETAILS.TextMatrix(1, 1) = strParts(lngIndex)
    Next

Open in new window

0
Wilder1626Author Commented:
Hummm

And that puts all the different values on different cells on the same row
 Dim strParts() As String
    Dim lngIndex As Long
    strParts = Split(strBuffer, "*")
    For lngIndex = 0 To UBound(strParts)
     Debug.Print strParts(lngIndex)
    On Error Resume Next
     If Mid$(strBuffer, 1, 3) = "AK9" Then
    
        EDI_DETAILS.TextMatrix(0, 0) = "DESCRIPTION"
        EDI_DETAILS.TextMatrix(0, 1) = "DETAIL"
        EDI_DETAILS.TextMatrix(0, 2) = "CHARS"
        EDI_DETAILS.TextMatrix(0, 3) = "VALIDATION"
        
         EDI_DETAILS.TextMatrix(1, lngIndex) = strParts(lngIndex)

     End If
    Next

Open in new window

0
Wilder1626Author Commented:
That's exactly what i need :)
  Dim strParts() As String
    Dim lngIndex As Long
    strParts = Split(strBuffer, "*")
    For lngIndex = 0 To UBound(strParts)
     Debug.Print strParts(lngIndex)
    On Error Resume Next
     If Mid$(strBuffer, 1, 3) = "AK9" Then
    
        EDI_DETAILS.TextMatrix(0, 0) = "DESCRIPTION"
        EDI_DETAILS.TextMatrix(0, 1) = "DETAIL"
        EDI_DETAILS.TextMatrix(0, 2) = "CHARS"
        EDI_DETAILS.TextMatrix(0, 3) = "VALIDATION"
        
         EDI_DETAILS.TextMatrix(lngIndex, 1) = strParts(lngIndex)

     End If
    Next

Open in new window

0
Martin LissOlder than dirtCommented:
I'm not sure what it is that you want to do but...

Dim strParts() As String
    Dim lngIndex As Long
    strParts = Split(strBuffer, "*")
    For lngIndex = 0 To UBound(strParts)
If strParts(0) = "AK9" Then
   
        EDI_DETAILS.TextMatrix(0, 0) = "DESCRIPTION"
        EDI_DETAILS.TextMatrix(0, 1) = "DETAIL"
        EDI_DETAILS.TextMatrix(0, 2) = "CHARS"
        EDI_DETAILS.TextMatrix(0, 3) = "VALIDATION"
       
         EDI_DETAILS.TextMatrix(lngIndex, 1) = strParts(lngIndex)

     End If
    Next
0
Wilder1626Author Commented:
What i want to to is that, whenever my cursor in on one of the line in the textbox, if the 3 first digits are AK9, it will transpose the values in the second column of the grid

  Dim strParts() As String
    Dim lngIndex As Long
    strParts = Split(strBuffer, "*")
    For lngIndex = 0 To UBound(strParts)
     Debug.Print strParts(lngIndex)
    On Error Resume Next
        
     If Mid$(strBuffer, 1, 3) = "AK9" Then

        EDI_DETAILS.TextMatrix(0, 0) = "DESCRIPTION"
        EDI_DETAILS.TextMatrix(0, 1) = "DETAIL"
        EDI_DETAILS.TextMatrix(0, 2) = "CHARS"
        EDI_DETAILS.TextMatrix(0, 3) = "VALIDATION"
        EDI_DETAILS.TextMatrix(lngIndex, 1) = strParts(lngIndex)
    End If
    Next

Open in new window


Ex1:
no 1
Ex2:
no2
0
Martin LissOlder than dirtCommented:
Please see the comments at lines 60 and 64.

Private Sub EDI_CODE_Click()
 Dim lngSelectedLine As Long
    Dim lngLength       As Long
    Dim lngFirstCharPos As Long
    Dim strBuffer       As String
    Dim strParts() As String
    Dim lngIndex As Long
    Dim i As Integer
    Dim R        As Long
    Dim C        As Long
    Dim cell_wid As Single
    Dim col_wid  As Single

    ' Determine selected line number (Starts at 0)
    lngSelectedLine = SendMessage(EDI_CODE.hwnd, EM_LINEFROMCHAR, -1, 0)
    lngFirstCharPos = SendMessage(EDI_CODE.hwnd, EM_LINEINDEX, lngSelectedLine, 0&)
    ' length of line
    lngLength = SendMessage(EDI_CODE.hwnd, EM_LINELENGTH, lngFirstCharPos, 0&)

    strBuffer = Space(lngLength)
    ' get line text
    Call SendMessage(EDI_CODE.hwnd, EM_GETLINE, lngSelectedLine, ByVal strBuffer)

    If strBuffer <> "" Then
        strParts = Split(strBuffer, "*")
        If strParts(0) = "AK9" Then
            EDI_DETAILS.TextMatrix(0, 0) = "DESCRIPTION"
            EDI_DETAILS.TextMatrix(0, 1) = "DETAIL"
            EDI_DETAILS.TextMatrix(0, 2) = "CHARS"
            EDI_DETAILS.TextMatrix(0, 3) = "VALIDATION"
            For lngIndex = 1 To UBound(strParts)
                EDI_DETAILS.TextMatrix(lngIndex, 1) = strParts(lngIndex)
            Next
            'Grid align
            With EDI_DETAILS
    
                For i = 0 To .Cols - 1
                    .ColAlignment = flexAlignLeftCenter
                Next i
    
            End With
            
            For C = 0 To EDI_DETAILS.Cols - 1
                col_wid = 0
    
                For R = 0 To EDI_DETAILS.Rows - 1
                    cell_wid = TextWidth(EDI_DETAILS.TextMatrix(R, C))
    
                    If col_wid < cell_wid Then col_wid = cell_wid
                Next R
    
                EDI_DETAILS.ColWidth(C) = col_wid + 120
            Next C
        End If
    Else

        'delete grid if nothing
        
        EDI_DETAILS.Clear
        ' You don't need these two unless you change the size of the grid
        EDI_DETAILS.Rows = 10
        EDI_DETAILS.Cols = 4
        
        ' You don't need this when the grid is blank
'        With EDI_DETAILS
'            For i = 0 To .Cols - 1
'                .ColAlignment = flexAlignLeftCenter
'            Next i
'        End With
    End If


End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
In addition to the above you might want to add this code which changes the EDI_CODE_MousePointer.

Private Sub EDI_CODE_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
    EDI_CODE.MousePointer = vbArrow ' You might also want to try vbArrowQuestion
End Sub

Open in new window

0
Wilder1626Author Commented:
Thank you so much again for your help, this is very good.

I've also added the vbArrowQuestion. this is very sharp
0
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.