Page 95 of 96 FirstFirst ... 45859293949596 LastLast
Results 3,761 to 3,800 of 3802

Thread: CommonControls (Replacement of the MS common controls)

  1. #3761
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,543

    Talking Re: CommonControls (Replacement of the MS common controls)

    Code:
    Public Sub SetForeColor(Optional lForeColor As ColorConstants = vbBlack)
    Dim tCharFormat As CHARFORMAT2
            With tCharFormat
                .cbSize = LenB(tCharFormat): .crTextColor = lForeColor: .dwMask = CFM_COLOR
            End With
            SendMessage RTB.hWnd, EM_SETCHARFORMAT, SCF_ALL, VarPtr(tCharFormat)
    End Sub

  2. #3762
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    yeah, it's not liking any RTB as Richtexbox functions in my program
    wont color the string using it
    oddly though no type mismatch error, it just never even enters the function

    X = 0
    Do Until X > UBound(Keywords1)
    sFindit = Keywords1(X)
    HighlightWords rtxtMarc, sFindit, vbBlue, Cntr2
    Cntr = Cntr + Cntr2
    X = X + 1
    Loop

    red text supposed to jump into function here, but stepping thru skips past it and no error!

    EDIT, fixed by doing this
    Public Function HighlightWords(RTB As VBCCR17.RichTextBox, _
    sFindstring As String, _
    lcolor As Long, _
    ccntr As Integer) _
    As Integer

    Code:
    Public Function HighlightWords(RTB As RichTextBox, _
                                           sFindstring As String, _
                                           lcolor As Long, _
                                           ccntr As Integer) _
                                           As Integer
       
        Dim lFindLength As Long         'Length of string to find
        Dim iMatchCount As Integer      'Number of matches
        Dim boolon As Boolean
        Dim aa As Long
        
        boolon = RTB.Visible
        RTB.Visible = False
        frmDatatrapUndo = False 'set to false since highlighting is not a recognized change
        
        'Cache the length of the string to find
        lFindLength = Len(sFindstring)
        
        'needs to always start at 1, but after finding can start at aa + lFindLength
        'match test to get going
        aa = InStr(1, RTB.Text, sFindstring, vbTextCompare)
        
        'match found
        If aa <> 0 Then
          iMatchCount = iMatchCount + 1
          RTB.SelStart = aa - 1 'rtb counts first position as 0
          RTB.SelLength = lFindLength
          RTB.SelBold = True
          RTB.SelColor = lcolor
          Do
           aa = InStr(aa + lFindLength, RTB.Text, sFindstring, vbTextCompare)
           If aa = 0 Then Exit Do
           iMatchCount = iMatchCount + 1
           RTB.SelStart = aa - 1 'rtb counts first position as 0
           RTB.SelLength = lFindLength
           RTB.SelBold = True
           RTB.SelColor = lcolor
          Loop
        End If
        
        'Restore the insertion point to zero
        RTB.SelStart = 0
         
        'Return the number of matches
        ccntr = iMatchCount
        If boolon = True Then
          RTB.Visible = True
        Else
          RTB.Visible = False
        End If
         
      End Function
    Last edited by sdowney1; Apr 18th, 2024 at 07:00 AM.

  3. #3763
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    If you have 2 references you can't declare "As RichTextBox" w/o putting the lib before, e.g. "As VBCCR17.RichTextBox".
    If you want both in 1 sub then resort to "As Object".
    Hi, thanks very much

    Doing that has fixed my public function for coloring rtxtMarc
    I suppose this will work for all the RTB functions


    Public Function HighlightWords(RTB As VBCCR17.RichTextBox, _
    sFindstring As String, _
    lcolor As Long, _
    ccntr As Integer) _
    As Integer

    EDIT, I am switching to using as Object as that works and I think it's a better idea rather than hardcoding in the ocx version

    Public Function HighlightWords(RTB As Object, _
    sFindstring As String, _
    lcolor As Long, _
    ccntr As Integer) _
    As Integer
    Last edited by sdowney1; Apr 18th, 2024 at 07:31 AM.

  4. #3764
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by VanGoghGaming View Post
    Code:
    Public Sub SetForeColor(Optional lForeColor As ColorConstants = vbBlack)
    Dim tCharFormat As CHARFORMAT2
            With tCharFormat
                .cbSize = LenB(tCharFormat): .crTextColor = lForeColor: .dwMask = CFM_COLOR
            End With
            SendMessage RTB.hWnd, EM_SETCHARFORMAT, SCF_ALL, VarPtr(tCharFormat)
    End Sub
    thanks for this

  5. #3765
    Frenzied Member VanGoghGaming's Avatar
    Join Date
    Jan 2020
    Location
    Eve Online - Mining, Missions & Market Trading!
    Posts
    1,543

    Talking Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by sdowney1 View Post
    thanks for this
    I copied that from my own RichTextBox class, you may want to take a look at it if you want to learn more about RichTextBoxes. For example you don't need to implement your own text search routine since the RichTextBox can do that for you in a much better way (with the EM_FINDTEXTEX message), it can search forward, backward, case sensitive/insensitive, match whole word or partial.

  6. #3766
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by VanGoghGaming View Post
    You can send the "EM_EXLIMITTEXT" message to increase the characters limit:

    Code:
    Private Const EM_EXLIMITTEXT As Long = &H435, lMaxLimit As Long = &H7FFFFFFF
    
    SendMessage RichTextBox.hWnd, EM_EXLIMITTEXT, 0&, lMaxLimit
    That is helpful
    I was then able to load a 139mb text file into this RTB control, it took couple minutes to load and then to be able to access it.
    How big a file does that sendmessage command allow to load into a RTB?

    Is that as big as it gets or can you get more.
    139 mb in the file corresponds with 75,000 individual MARC records in my file. Which is a lot of records.
    Think 75,000 items in a library. And all in one file. Conceivably most people would break up a file to make it more manageable.

  7. #3767
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    It takes 9 secs to load the 139mb into a MS RTB and it takes 3 minutes to load in the Krool unicode RTB.
    I am using this method here, is there a better way?

    'load file method
    MDIMarc.rtxtMarc.Enabled = False
    MDIMarc.rtxtMarc.LoadFile (CommonDialog1.FileName), rtfText
    MDIMarc.rtxtMarc.Enabled = True

  8. #3768
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    I finally get to see unicode languages in the MariaDB and the program
    I had to put this in my.ini and restart the DB server
    and then had to modify the database and a table to use CHARACTER SET utf8;
    I's all in these links. Will work for MySql or MariaDB

    https://stackoverflow.com/questions/...in-mysql-table
    https://stackoverflow.com/questions/...24493#20624493


    C:\Program Files\MariaDB 11.3\bin>mariadb -u root -p --port=3308
    Enter password: ****
    Welcome to the MariaDB monitor. Commands end with ; or \g.
    Your MariaDB connection id is 18
    Server version: 11.3.2-MariaDB mariadb.org binary distribution

    Copyright (c) 2000, 2018, Oracle, MariaDB Corporation Ab and others.

    Type 'help;' or '\h' for help. Type '\c' to clear the current input statement.

    MariaDB [(none)]>

    MariaDB [(none)]> ALTER DATABASE testspecialchars CHARACTER SET utf8;
    Query OK, 1 row affected (0.007 sec)

    MariaDB [(none)]> use testspecialchars;
    Database changed

    MariaDB [testspecialchars]> ALTER TABLE bookdata CONVERT TO CHARACTER SET utf8;
    Query OK, 3 rows affected (0.051 sec)
    Records: 3 Duplicates: 0 Warnings: 0

    And the picture shows greek and chinese text in the DB displaying properly
    I am able to just copy, paste, update unicode now

    This is really cool
    Attached Images Attached Images  

  9. #3769

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    Update released.

    Included the AutoVerbMenu in the RichTextBox control.
    Small change..
    Ctrl+Alt+V shortcut changed to Ctrl+Shift+V as this is common for Me.PasteSpecial CF_UNICODETEXT.
    Menu text changed from 'Paste Special' to 'Paste as plain text'.
    Ctrl+Alt+V should be reserved for a paste special dialog box to choose a format. (like Wordpad)

    Name:  RichEditAutoVerbMenu.png
Views: 534
Size:  3.1 KB

    German translation also added. I may add others as well soon without further notice.

  10. #3770
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    Hi, wide combo box is the new combobox?
    This no longer works with the new control
    Any ideas why?

    it's listcount when form loads is zero

    EDIT, it looks like an empty wCombobox does not work anymore here.
    As I put in a value cboFind.AddItem ("test"), and then the cboFind.list(0) came up with 'test'
    So it does not like a totally empty combo box which the original non unicode control was ok with

    Private Sub cmbFindCheck()
    For xxx = 0 To cboFind.ListCount
    If cboFind.List(xxx) = cboFind.Text Then Exit Sub 'found in box
    Next xxx
    If Trim(cboFind.Text) <> "" Then cboFind.AddItem cboFind.Text ' not found add it
    End Sub

    I added this in the formload
    cboFind.AddItem ("")
    cboReplace.AddItem ("")

    And changed to this
    For xxx = 0 To cboFind.ListCount - 1

    Which allows the form to function, and it does find all the individual chinese and greek and english chars, and can replace them.
    But it then has an empty added in item first in the box which you see when it drops down, prefer not to see that empty string in the combo box.
    At least right now it works.

    EDIT again. I got it like it should be working.
    I left off the additem "" at form load and everything is as it was.
    It really needed 'Listcount - 1' to be there to let it not enter the For Next when the box is empty.
    Last edited by sdowney1; Apr 18th, 2024 at 12:12 PM.

  11. #3771
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    Is there a way for the msgbox to display the unicode string chars in a message?
    It will just show question marks like this for cboFind variable, which is a unicode string.

    So in the msgbox, it says, "Finished searching for ?" rather than showing the unicode chars.

    Code:
    If lngResult = -1 Then
                'Text not found
                MsgBox "Finished searching for '" & cboFind & "'", vbInformation, "BookStore Editor"
                cmdFind.Caption = "&Find" 'Set caption
                cmdReplace.Enabled = False 'Disable Replace button
                cmdReplaceAll.Enabled = False 'Disable ReplaceAll button
    Attached Images Attached Images  

  12. #3772
    Fanatic Member
    Join Date
    Mar 2024
    Posts
    549

    Re: CommonControls (Replacement of the MS common controls)

    SOLVED!
    Can't believe how much progress I made today.

    Found this function for a wide msgbox, and it works. I have frmFind.hWnd in there as that is my form running the finds.
    The code is in a module.

    Code:
    Private Declare Function MessageBoxW Lib "User32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
    
    
    Public Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Access") As VbMsgBoxResult
        MsgBoxW = MessageBoxW(frmFind.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
    End Function
    run it like this in program
    MsgBoxW "Finished searching for '" & cboFind & "'", vbInformation, "BookStore Editor"

    results in the pic
    Attached Images Attached Images  
    Last edited by sdowney1; Apr 18th, 2024 at 01:11 PM.

  13. #3773
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    6,014

    Re: CommonControls (Replacement of the MS common controls)

    @sdowney1, maybe you should start new threads for asking questions..

  14. #3774
    Member
    Join Date
    Mar 2020
    Posts
    37

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    German translation also added. I may add others as well soon without further notice.
    If you need French :

    Cut : Couper
    Copy : Copier
    Paste : Coller
    Paste special : Collage spécial
    Paste as plain text : Coller sans mise en forme (or : Texte non formaté)

    Code:
    Case &HC ' French
       Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&Répéter" & vbTab & "Ctrl+Y", "&Couper" & vbTab & "Ctrl+X", "C&opier" & vbTab & "Ctrl+C", "Co&ller" & vbTab & "Ctrl+V", "Coller &sans mise en forme" & vbTab & "Ctrl+Shift+V", "&Effacer" & vbTab & "Suppr")
    Last edited by Crapahute; Apr 19th, 2024 at 06:01 AM.

  15. #3775

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Crapahute View Post
    If you need French :

    Cut : Couper
    Copy : Copier
    Paste : Coller
    Paste special : Collage spécial
    Paste as plain text : Coller sans mise en forme (or : Texte non formaté)

    Code:
    Case &HC ' French
       Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&Répéter" & vbTab & "Ctrl+Y", "&Couper" & vbTab & "Ctrl+X", "C&opier" & vbTab & "Ctrl+C", "Co&ller" & vbTab & "Ctrl+V", "Coller &sans mise en forme" & vbTab & "Ctrl+Shift+V", "&Effacer" & vbTab & "Suppr")
    Thanks. Though "Supprimer" seems to be more common than "Effacer". I looked at the notepad ++ language xml files for a little help.

    I also added now Chinese, Czech, Danish, Greek, Spanish, French, Italian, Japanese, Portuguese, Russian and Swedish.
    Others may follow ..

  16. #3776
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    528

    Re: CommonControls (Replacement of the MS common controls)

    Krool - any plans to modernize the VB DriveListBox control?

  17. #3777

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Updated manifest in the OCX thread which applies now the miscStatus* attributes. Thanks to wqweto and his UMMM tool.

  18. #3778
    Lively Member
    Join Date
    Oct 2014
    Posts
    102

    Re: CommonControls (Replacement of the MS common controls)

    Hello Krool!

    Compilation Error Feedback:

    1?ComCtlsDemo.zip "Last edited by Krool; Yesterday at 07:24 PM. "
    2. In the IDE environment, there is garbled characters, and it cannot be compiled normally. This has never happened before. Related process name "Friend Sub FIRichEditOleCallback_GetContextMenu"
    3?"VBCCR17 1.7.104 Last edited by Krool; Yesterday at 02:23 AM." ---OK
    4. Operating system version "Win10 Chinese Simplified Chinese Version"
    5. VB6 version: VB6 SP6, VBA9782
    Please help resolve this error, thank you very much!

    Name:  Error.jpg
Views: 451
Size:  72.5 KB

    Code:
    #If VBA7 Then
    Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As LongPtr, ByVal lpCharRange As LongPtr, ByRef hMenu As LongPtr)
    #Else
    Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As Long, ByVal lpCharRange As Long, ByRef hMenu As Long)
    #End If
    If PropAutoVerbMenu = False Then
        Dim RECR As RECHARRANGE
        CopyMemory RECR, ByVal lpCharRange, LenB(RECR)
        RaiseEvent OLEGetContextMenu(SelType, LpOleObject, RECR.Min, RECR.Max, hMenu)
    Else
        hMenu = CreatePopupMenu()
        Dim LangID As Integer
        LangID = GetUserDefaultUILanguage() And &HFF&
        Dim MII As MENUITEMINFO, Text As String, i As Long
        MII.cbSize = LenB(MII)
        For i = 1 To 7
            Select Case LangID
                Case &H4 ' Chinese
                    Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H5 ' Czech
                    Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop?ovat" & vbTab & "Ctrl+C", "&Vlo?t" & vbTab & "Ctrl+V", "Vlo?t &jako prost?text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
                Case &H6 ' Danish
                    Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "S? &ind" & vbTab & "Ctrl+V", "Inds? som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
                Case &H7 ' German
                    Text = VBA.Choose(i, "&R?kg?gig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf?en" & vbTab & "Strg+V", "Nur &Text einf?en" & vbTab & "Strg+Umschalt+V", "&L?chen" & vbTab & "Entf")
                Case &H8 ' Greek
                    Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
                    ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
                    ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
                Case &H9 ' English
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
                Case &HA ' Spanish
                    Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s?o texto" & vbTab & "Ctrl+May?+V", "&Borrar" & vbTab & "Supr")
                Case &HB ' Finnish
                    Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit? & vbTab & "Ctrl+V", "Liit?pelkk??&tekstin? & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
                Case &HC ' French
                    Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R?ablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
                Case &H10 ' Italian
                    Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
                Case &H11 ' Japanese
                    Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H15 ' Polish
                    Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon?" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
                Case &H16 ' Portuguese
                    Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
                Case &H18 ' Romanian
                    Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
                Case &H19 ' Russian
                    Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
                    ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
                    ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
                Case &H1D ' Swedish
                    Text = VBA.Choose(i, "&?gra" & vbTab & "Ctrl+Z", "&G? om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
                Case Else
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
            End Select
            MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_STRING
            MII.fType = 0
            MII.dwTypeData = StrPtr(Text)
            MII.cch = Len(Text)
            MII.hBmpItem = NULL_PTR
            Select Case i
                Case 1
                    If Me.CanUndo = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 2
                    If Me.CanRedo = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 3, 4, 7
                    If (SelType And SEL_TEXT) = SEL_TEXT Or (SelType And SEL_OBJECT) = SEL_OBJECT Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 5
                    If Me.CanPaste = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 6
                    If Me.CanPaste(CF_UNICODETEXT) = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
            End Select
            MII.wID = i
            InsertMenuItem hMenu, 0, 0, MII
        Next i
        MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_FTYPE
        MII.fType = MFT_SEPARATOR
        MII.dwTypeData = 0
        MII.cch = 0
        MII.hBmpItem = NULL_PTR
        MII.fState = 0
        MII.wID = i
        InsertMenuItem hMenu, 2, 1, MII
    End If
    End Sub

  19. #3779

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by smileyoufu View Post
    Hello Krool!

    Compilation Error Feedback:

    1?ComCtlsDemo.zip "Last edited by Krool; Yesterday at 07:24 PM. "
    2. In the IDE environment, there is garbled characters, and it cannot be compiled normally. This has never happened before. Related process name "Friend Sub FIRichEditOleCallback_GetContextMenu"
    3?"VBCCR17 1.7.104 Last edited by Krool; Yesterday at 02:23 AM." ---OK
    4. Operating system version "Win10 Chinese Simplified Chinese Version"
    5. VB6 version: VB6 SP6, VBA9782
    Please help resolve this error, thank you very much!

    Name:  Error.jpg
Views: 451
Size:  72.5 KB

    Code:
    #If VBA7 Then
    Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As LongPtr, ByVal lpCharRange As LongPtr, ByRef hMenu As LongPtr)
    #Else
    Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As Long, ByVal lpCharRange As Long, ByRef hMenu As Long)
    #End If
    If PropAutoVerbMenu = False Then
        Dim RECR As RECHARRANGE
        CopyMemory RECR, ByVal lpCharRange, LenB(RECR)
        RaiseEvent OLEGetContextMenu(SelType, LpOleObject, RECR.Min, RECR.Max, hMenu)
    Else
        hMenu = CreatePopupMenu()
        Dim LangID As Integer
        LangID = GetUserDefaultUILanguage() And &HFF&
        Dim MII As MENUITEMINFO, Text As String, i As Long
        MII.cbSize = LenB(MII)
        For i = 1 To 7
            Select Case LangID
                Case &H4 ' Chinese
                    Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H5 ' Czech
                    Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop?ovat" & vbTab & "Ctrl+C", "&Vlo?t" & vbTab & "Ctrl+V", "Vlo?t &jako prost?text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
                Case &H6 ' Danish
                    Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "S? &ind" & vbTab & "Ctrl+V", "Inds? som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
                Case &H7 ' German
                    Text = VBA.Choose(i, "&R?kg?gig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf?en" & vbTab & "Strg+V", "Nur &Text einf?en" & vbTab & "Strg+Umschalt+V", "&L?chen" & vbTab & "Entf")
                Case &H8 ' Greek
                    Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
                    ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
                    ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
                Case &H9 ' English
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
                Case &HA ' Spanish
                    Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s?o texto" & vbTab & "Ctrl+May?+V", "&Borrar" & vbTab & "Supr")
                Case &HB ' Finnish
                    Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit? & vbTab & "Ctrl+V", "Liit?pelkk??&tekstin? & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
                Case &HC ' French
                    Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R?ablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
                Case &H10 ' Italian
                    Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
                Case &H11 ' Japanese
                    Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H15 ' Polish
                    Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon?" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
                Case &H16 ' Portuguese
                    Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
                Case &H18 ' Romanian
                    Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
                Case &H19 ' Russian
                    Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
                    ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
                    ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
                Case &H1D ' Swedish
                    Text = VBA.Choose(i, "&?gra" & vbTab & "Ctrl+Z", "&G? om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
                Case Else
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
            End Select
            MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_STRING
            MII.fType = 0
            MII.dwTypeData = StrPtr(Text)
            MII.cch = Len(Text)
            MII.hBmpItem = NULL_PTR
            Select Case i
                Case 1
                    If Me.CanUndo = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 2
                    If Me.CanRedo = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 3, 4, 7
                    If (SelType And SEL_TEXT) = SEL_TEXT Or (SelType And SEL_OBJECT) = SEL_OBJECT Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 5
                    If Me.CanPaste = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 6
                    If Me.CanPaste(CF_UNICODETEXT) = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
            End Select
            MII.wID = i
            InsertMenuItem hMenu, 0, 0, MII
        Next i
        MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_FTYPE
        MII.fType = MFT_SEPARATOR
        MII.dwTypeData = 0
        MII.cch = 0
        MII.hBmpItem = NULL_PTR
        MII.fState = 0
        MII.wID = i
        InsertMenuItem hMenu, 2, 1, MII
    End If
    End Sub
    You may have BETA windows feature non-unicode UTF8 option enabled. This garbles ANSI files. (Range 128 to 255 I guess)
    https://stackoverflow.com/questions/...rt-actually-do

    Edit: I guess the best is to ChrW() also those chars which ANSI could display but are above 128 and causes issues on UTF-8.
    Last edited by Krool; Apr 22nd, 2024 at 12:51 AM.

  20. #3780

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    smileyoufu,
    below is the adjustment which should work and display the characters correctly even when the non-unicode app option "utf-8" is enabled.
    Can you confirm ? Then I would update the project soon.

    Code:
            Select Case LangID
                Case &H4 ' Chinese
                    Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H5 ' Czech
                    Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop" & ChrW(&HED&) & "rovat" & vbTab & "Ctrl+C", "&Vlo" & ChrW(&H17E&) & "it" & vbTab & "Ctrl+V", "Vlo" & ChrW(&H17E&) & "it &jako prost" & ChrW(&HFD&) & " text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
                Case &H6 ' Danish
                    Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "Sæt &ind" & vbTab & "Ctrl+V", "Inds" & ChrW(&HE6&) & "t som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
                Case &H7 ' German
                    Text = VBA.Choose(i, "&R" & ChrW(&HFC&) & "ckg" & ChrW(&HE4&) & "ngig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf" & ChrW(&HFC&) & "gen" & vbTab & "Strg+V", "Nur &Text einf" & ChrW(&HFC&) & "gen" & vbTab & "Strg+Umschalt+V", "&L" & ChrW(&HF6&) & "schen" & vbTab & "Entf")
                Case &H8 ' Greek
                    Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
                    ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
                    ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
                Case &H9 ' English
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
                Case &HA ' Spanish
                    Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s" & ChrW(&HF3&) & "lo texto" & vbTab & "Ctrl+May" & ChrW(&HFA&) & "s+V", "&Borrar" & vbTab & "Supr")
                Case &HB ' Finnish
                    Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit" & ChrW(&HE4&) & vbTab & "Ctrl+V", "Liit" & ChrW(&HE4&) & " pelkk" & ChrW(&HE4&) & "n" & ChrW(&HE4&) & " &tekstin" & ChrW(&HE4&) & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
                Case &HC ' French
                    Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R" & ChrW(&HE9&) & "tablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
                Case &H10 ' Italian
                    Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
                Case &H11 ' Japanese
                    Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H15 ' Polish
                    Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon" & ChrW(&HF3&) & "w" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
                Case &H16 ' Portuguese
                    Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
                Case &H18 ' Romanian
                    Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
                Case &H19 ' Russian
                    Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
                    ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
                    ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
                Case &H1D ' Swedish
                    Text = VBA.Choose(i, "&" & ChrW(&HC5&) & "ngra" & vbTab & "Ctrl+Z", "&G" & ChrW(&HF6&) & "r om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
                Case Else
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
            End Select

  21. #3781
    Lively Member
    Join Date
    Oct 2014
    Posts
    102

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    smileyoufu,
    below is the adjustment which should work and display the characters correctly even when the non-unicode app option "utf-8" is enabled.
    Can you confirm ? Then I would update the project soon.

    Code:
            Select Case LangID
                Case &H4 ' Chinese
                    Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H5 ' Czech
                    Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop" & ChrW(&HED&) & "rovat" & vbTab & "Ctrl+C", "&Vlo" & ChrW(&H17E&) & "it" & vbTab & "Ctrl+V", "Vlo" & ChrW(&H17E&) & "it &jako prost" & ChrW(&HFD&) & " text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
                Case &H6 ' Danish
                    Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "Sæt &ind" & vbTab & "Ctrl+V", "Inds" & ChrW(&HE6&) & "t som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
                Case &H7 ' German
                    Text = VBA.Choose(i, "&R" & ChrW(&HFC&) & "ckg" & ChrW(&HE4&) & "ngig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf" & ChrW(&HFC&) & "gen" & vbTab & "Strg+V", "Nur &Text einf" & ChrW(&HFC&) & "gen" & vbTab & "Strg+Umschalt+V", "&L" & ChrW(&HF6&) & "schen" & vbTab & "Entf")
                Case &H8 ' Greek
                    Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
                    ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
                    ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
                Case &H9 ' English
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
                Case &HA ' Spanish
                    Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s" & ChrW(&HF3&) & "lo texto" & vbTab & "Ctrl+May" & ChrW(&HFA&) & "s+V", "&Borrar" & vbTab & "Supr")
                Case &HB ' Finnish
                    Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit" & ChrW(&HE4&) & vbTab & "Ctrl+V", "Liit" & ChrW(&HE4&) & " pelkk" & ChrW(&HE4&) & "n" & ChrW(&HE4&) & " &tekstin" & ChrW(&HE4&) & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
                Case &HC ' French
                    Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R" & ChrW(&HE9&) & "tablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
                Case &H10 ' Italian
                    Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
                Case &H11 ' Japanese
                    Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H15 ' Polish
                    Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon" & ChrW(&HF3&) & "w" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
                Case &H16 ' Portuguese
                    Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
                Case &H18 ' Romanian
                    Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
                Case &H19 ' Russian
                    Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
                    ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
                    ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
                Case &H1D ' Swedish
                    Text = VBA.Choose(i, "&" & ChrW(&HC5&) & "ngra" & vbTab & "Ctrl+Z", "&G" & ChrW(&HF6&) & "r om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
                Case Else
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
            End Select
    Hello Krool!
    Thank you very much for your quick response.
    It is confirmed that the solution works properly under the IDE and compiles to .exe files successfully.
    Thank you very much!

  22. #3782
    Lively Member
    Join Date
    Oct 2014
    Posts
    102

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    You may have BETA windows feature non-unicode UTF8 option enabled. This garbles ANSI files. (Range 128 to 255 I guess)
    https://stackoverflow.com/questions/...rt-actually-do

    Edit: I guess the best is to ChrW() also those chars which ANSI could display but are above 128 and causes issues on UTF-8.

    Hello Krool!
    My computer's "Beta: Global Language Support with Unicode UTF-8 (U)" feature is not enabled and the checkbox is unchecked.

    Name:  BetaTest.jpg
Views: 474
Size:  25.9 KB

  23. #3783
    Member
    Join Date
    Sep 2022
    Posts
    60

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    I guess the richtx32.ocx does not localize it .. or am I wrong ?
    Code:
    2000 MENU
    LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
    {
      POPUP "Context"
      {
        MENUITEM "&Undo\tCtrl+Z",  2104
        MENUITEM SEPARATOR
        MENUITEM "Cu&t\tCtrl+X",  2100
        MENUITEM "&Copy\tCtrl+C",  2101
        MENUITEM "&Paste\tCtrl+V",  2102
        MENUITEM "&Delete\tDel",  2103
        MENUITEM SEPARATOR
        MENUITEM "&Object",  2110
      }
    }
    Ooops! As usual it seems you were right and I was wrong.

    I didn't know the source code for the MS control was available. Where did you get it?

    That code clearly shows that the menu items labels are hardcoded. So there must be different versions of the ocx for each language (?). What a mess! I thought all the lanaguage dependent text was provided by the OS. Now I realize that some of the text could be provided by the runtime and some be hardcoded. Now I undestand the installation warning about the language supported by some controls / dlls.

    My OSs (Windows 10 & XP) are Spanish. Most of the software I use is either Spanish or language agnostic. VB6 is Spanish. I don't have VB.NET installed now, but the version I used time ago (2008) was Spanish. So that's why the controls in the projects I download seem to be localized?

    My conclussion: for compatibility with the MS control yours should support translations. That's overkill, isn't it? Maybe some resource file can be used if present? Or at least let the user create a custom menu calling the functions originally called by the default menu?

    For my personal use (and I don't create distributable software) I don't mind having mixed Spanish & English (or even Italian or French) text, so for me everything's OK as it is now.

    Thanks!

  24. #3784

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by jpfa View Post
    Ooops! As usual it seems you were right and I was wrong.

    I didn't know the source code for the MS control was available. Where did you get it?

    That code clearly shows that the menu items labels are hardcoded. So there must be different versions of the ocx for each language (?). What a mess! I thought all the lanaguage dependent text was provided by the OS. Now I realize that some of the text could be provided by the runtime and some be hardcoded. Now I undestand the installation warning about the language supported by some controls / dlls.

    My OSs (Windows 10 & XP) are Spanish. Most of the software I use is either Spanish or language agnostic. VB6 is Spanish. I don't have VB.NET installed now, but the version I used time ago (2008) was Spanish. So that's why the controls in the projects I download seem to be localized?

    My conclussion: for compatibility with the MS control yours should support translations. That's overkill, isn't it? Maybe some resource file can be used if present? Or at least let the user create a custom menu calling the functions originally called by the default menu?

    For my personal use (and I don't create distributable software) I don't mind having mixed Spanish & English (or even Italian or French) text, so for me everything's OK as it is now.

    Thanks!
    I think some major languages are now supported. You should see spanish now.
    And fallback is anyway then english.

  25. #3785
    New Member
    Join Date
    Oct 2023
    Posts
    4

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by smileyoufu View Post
    Hello Krool!

    Compilation Error Feedback:

    1?ComCtlsDemo.zip "Last edited by Krool; Yesterday at 07:24 PM. "
    2. In the IDE environment, there is garbled characters, and it cannot be compiled normally. This has never happened before. Related process name "Friend Sub FIRichEditOleCallback_GetContextMenu"
    3?"VBCCR17 1.7.104 Last edited by Krool; Yesterday at 02:23 AM." ---OK
    4. Operating system version "Win10 Chinese Simplified Chinese Version"
    5. VB6 version: VB6 SP6, VBA9782
    Please help resolve this error, thank you very much!

    Name:  Error.jpg
Views: 451
Size:  72.5 KB

    Code:
    #If VBA7 Then
    Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As LongPtr, ByVal lpCharRange As LongPtr, ByRef hMenu As LongPtr)
    #Else
    Friend Sub FIRichEditOleCallback_GetContextMenu(ByVal SelType As Integer, ByVal LpOleObject As Long, ByVal lpCharRange As Long, ByRef hMenu As Long)
    #End If
    If PropAutoVerbMenu = False Then
        Dim RECR As RECHARRANGE
        CopyMemory RECR, ByVal lpCharRange, LenB(RECR)
        RaiseEvent OLEGetContextMenu(SelType, LpOleObject, RECR.Min, RECR.Max, hMenu)
    Else
        hMenu = CreatePopupMenu()
        Dim LangID As Integer
        LangID = GetUserDefaultUILanguage() And &HFF&
        Dim MII As MENUITEMINFO, Text As String, i As Long
        MII.cbSize = LenB(MII)
        For i = 1 To 7
            Select Case LangID
                Case &H4 ' Chinese
                    Text = VBA.Choose(i, ChrW(&H64A4&) & ChrW(&H6D88&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H6062&) & ChrW(&H590D&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H526A&) & ChrW(&H5207&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H590D&) & ChrW(&H5236&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H7C98&) & ChrW(&H8D34&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H7C98&) & ChrW(&H8D34&) & ChrW(&H7EAF&) & ChrW(&H6587&) & ChrW(&H672C&) & vbTab & "Ctrl+Shift+V", ChrW(&H5220&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H5 ' Czech
                    Text = VBA.Choose(i, "&Zp" & ChrW(&H11B&) & "t" & vbTab & "Ctrl+Z", "Z&novu" & vbTab & "Ctrl+Y", "Vyjmou&t" & vbTab & "Ctrl+X", "&Kop?ovat" & vbTab & "Ctrl+C", "&Vlo?t" & vbTab & "Ctrl+V", "Vlo?t &jako prost?text" & vbTab & "Ctrl+Shift+V", "&Odstranit" & vbTab & "Del")
                Case &H6 ' Danish
                    Text = VBA.Choose(i, "&Fortryd" & vbTab & "Ctrl+Z", "&Annuller fortryd" & vbTab & "Ctrl+Y", "&Klip" & vbTab & "Ctrl+X", "K&opier" & vbTab & "Ctrl+C", "S? &ind" & vbTab & "Ctrl+V", "Inds? som almindelig &tekst" & vbTab & "Ctrl+Shift+V", "&Slet" & vbTab & "Del")
                Case &H7 ' German
                    Text = VBA.Choose(i, "&R?kg?gig" & vbTab & "Strg+Z", "&Wiederholen" & vbTab & "Strg+Y", "&Ausschneiden" & vbTab & "Strg+X", "&Kopieren" & vbTab & "Strg+C", "&Einf?en" & vbTab & "Strg+V", "Nur &Text einf?en" & vbTab & "Strg+Umschalt+V", "&L?chen" & vbTab & "Entf")
                Case &H8 ' Greek
                    Text = VBA.Choose(i, "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+Z", "&" & ChrW(&H391&) & ChrW(&H3BA&) & ChrW(&H3CD&) & ChrW(&H3C1&) & ChrW(&H3C9&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3B1&) & ChrW(&H3AF&) & ChrW(&H3C1&) & ChrW(&H3B5&) & ChrW(&H3C3&) & ChrW(&H3B7&) & ChrW(&H3C2&) & vbTab & "Ctrl+Y", _
                    ChrW(&H391&) & ChrW(&H3C0&) & ChrW(&H3BF&) & ChrW(&H3BA&) & ChrW(&H3BF&) & "&" & ChrW(&H3C0&) & ChrW(&H3AE&) & vbTab & "Ctrl+X", "&" & ChrW(&H391&) & ChrW(&H3BD&) & ChrW(&H3C4&) & ChrW(&H3B9&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Ctrl+C", "&" & ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & vbTab & "Ctrl+V", _
                    ChrW(&H395&) & ChrW(&H3C0&) & ChrW(&H3B9&) & ChrW(&H3BA&) & ChrW(&H3CC&) & ChrW(&H3BB&) & ChrW(&H3BB&) & ChrW(&H3B7&) & ChrW(&H3C3&) & ChrW(&H3B7&) & " " & ChrW(&H3C9&) & ChrW(&H3C2&) & " " & ChrW(&H3B1&) & ChrW(&H3C0&) & ChrW(&H3BB&) & ChrW(&H3CC&) & " " & ChrW(&H3BA&) & ChrW(&H3B5&) & ChrW(&H3AF&) & ChrW(&H3BC&) & ChrW(&H3B5&) & ChrW(&H3BD&) & ChrW(&H3BF&) & vbTab & "Ctrl+Shift+V", "&" & ChrW(&H394&) & ChrW(&H3B9&) & ChrW(&H3B1&) & ChrW(&H3B3&) & ChrW(&H3C1&) & ChrW(&H3B1&) & ChrW(&H3C6&) & ChrW(&H3AE&) & vbTab & "Del")
                Case &H9 ' English
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
                Case &HA ' Spanish
                    Text = VBA.Choose(i, "&Deshacer" & vbTab & "Ctrl+Z", "&Rehacer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "&Pegar" & vbTab & "Ctrl+V", "Pegar &s?o texto" & vbTab & "Ctrl+May?+V", "&Borrar" & vbTab & "Supr")
                Case &HB ' Finnish
                    Text = VBA.Choose(i, "K&umoa" & vbTab & "Ctrl+Z", "T&ee uudelleen" & vbTab & "Ctrl+Y", "&Leikkaa" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "L&iit? & vbTab & "Ctrl+V", "Liit?pelkk??&tekstin? & vbTab & "Ctrl+Vaihto+V", "&Poista" & vbTab & "Del")
                Case &HC ' French
                    Text = VBA.Choose(i, "&Annuler" & vbTab & "Ctrl+Z", "&R?ablir" & vbTab & "Ctrl+Y", "Cou&per" & vbTab & "Ctrl+X", "&Copier" & vbTab & "Ctrl+C", "C&oller" & vbTab & "Ctrl+V", "Coller du &texte uniquement" & vbTab & "Ctrl+Maj+V", "&Supprimer" & vbTab & "Suppr")
                Case &H10 ' Italian
                    Text = VBA.Choose(i, "Ann&ulla digitazione" & vbTab & "Ctrl+Z", "&Ripristina digitazione" & vbTab & "Ctrl+Y", "Tag&lia" & vbTab & "Ctrl+X", "&Copia" & vbTab & "Ctrl+C", "&Incolla" & vbTab & "Ctrl+V", "Incollare solo &testo" & vbTab & "Ctrl+Maiusc+V", "&Elimina" & vbTab & "Canc")
                Case &H11 ' Japanese
                    Text = VBA.Choose(i, ChrW(&H5143&) & ChrW(&H306B&) & ChrW(&H623B&) & ChrW(&H3059&) & "(&U)" & vbTab & "Ctrl+Z", ChrW(&H3084&) & ChrW(&H308A&) & ChrW(&H76F4&) & ChrW(&H3057&) & "(&R)" & vbTab & "Ctrl+Y", _
                    ChrW(&H5207&) & ChrW(&H308A&) & ChrW(&H53D6&) & ChrW(&H308A&) & "(&T)" & vbTab & "Ctrl+X", ChrW(&H30B3&) & ChrW(&H30D4&) & ChrW(&H30FC&) & "(&C)" & vbTab & "Ctrl+C", ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & "(&P)" & vbTab & "Ctrl+V", _
                    ChrW(&H30D7&) & ChrW(&H30EC&) & ChrW(&H30FC&) & ChrW(&H30F3&) & " " & ChrW(&H30C6&) & ChrW(&H30AD&) & ChrW(&H30B9&) & ChrW(&H30C8&) & ChrW(&H3068&) & ChrW(&H3057&) & ChrW(&H3066&) & ChrW(&H8CBC&) & ChrW(&H308A&) & ChrW(&H4ED8&) & ChrW(&H3051&) & ChrW(&H308B&) & vbTab & "Ctrl+Shift+V", ChrW(&H524A&) & ChrW(&H9664&) & "(&D)" & vbTab & "Del")
                Case &H15 ' Polish
                    Text = VBA.Choose(i, "&Cofnij" & vbTab & "Ctrl+Z", "&Pon?" & vbTab & "Ctrl+Y", "Wy&tnij" & vbTab & "Ctrl+X", "&Kopioi" & vbTab & "Ctrl+C", "Wk&lej" & vbTab & "Ctrl+V", "Wklej jako zwyk" & ChrW(&H142&) & "y &tekst" & vbTab & "Ctrl+Shift+V", "&Wyczy" & ChrW(&H15B&) & ChrW(&H107&) & vbTab & "Del")
                Case &H16 ' Portuguese
                    Text = VBA.Choose(i, "An&ular" & vbTab & "Ctrl+Z", "&Refazer" & vbTab & "Ctrl+Y", "Cor&tar" & vbTab & "Ctrl+X", "&Copiar" & vbTab & "Ctrl+C", "Co&lar" & vbTab & "Ctrl+V", "Colar &somente texto" & vbTab & "Ctrl+Shift+V", "&Eliminar" & vbTab & "Del")
                Case &H18 ' Romanian
                    Text = VBA.Choose(i, "A&nulare" & vbTab & "Ctrl+Z", "&Revenire" & vbTab & "Ctrl+Y", "Dec&upare" & vbTab & "Ctrl+X", "&Copiere" & vbTab & "Ctrl+C", "&Lipire" & vbTab & "Ctrl+V", "Lipi" & ChrW(&H21B&) & "i ca &text simplu" & vbTab & "Ctrl+Shift+V", ChrW(&H218&) & "ter&gere" & vbTab & "Del")
                Case &H19 ' Russian
                    Text = VBA.Choose(i, ChrW(&H41E&) & ChrW(&H442&) & ChrW(&H43C&) & ChrW(&H435&) & ChrW(&H43D&) & ChrW(&H430&) & vbTab & "Ctrl+Z", ChrW(&H41F&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H442&) & ChrW(&H43E&) & ChrW(&H440&) & vbTab & "Ctrl+Y", _
                    ChrW(&H412&) & ChrW(&H44B&) & ChrW(&H440&) & ChrW(&H435&) & ChrW(&H437&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+X", ChrW(&H41A&) & ChrW(&H43E&) & ChrW(&H43F&) & ChrW(&H438&) & ChrW(&H440&) & ChrW(&H43E&) & ChrW(&H432&) & ChrW(&H430&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+C", ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Ctrl+V", _
                    ChrW(&H412&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & ChrW(&H432&) & ChrW(&H43A&) & ChrW(&H430&) & " " & ChrW(&H442&) & ChrW(&H435&) & ChrW(&H43A&) & ChrW(&H441&) & ChrW(&H442&) & ChrW(&H430&) & vbTab & "Ctrl+Shift+V", ChrW(&H423&) & ChrW(&H434&) & ChrW(&H430&) & ChrW(&H43B&) & ChrW(&H438&) & ChrW(&H442&) & ChrW(&H44C&) & vbTab & "Del")
                Case &H1D ' Swedish
                    Text = VBA.Choose(i, "&?gra" & vbTab & "Ctrl+Z", "&G? om" & vbTab & "Ctrl+Y", "&Klipp ut" & vbTab & "Ctrl+X", "K&opiera" & vbTab & "Ctrl+C", "K&listra in" & vbTab & "Ctrl+V", "Klistra in som vanlig &text" & vbTab & "Ctrl+Shift+V", "Ra&dera" & vbTab & "Del")
                Case Else
                    Text = VBA.Choose(i, "&Undo" & vbTab & "Ctrl+Z", "&Redo" & vbTab & "Ctrl+Y", "Cu&t" & vbTab & "Ctrl+X", "&Copy" & vbTab & "Ctrl+C", "&Paste" & vbTab & "Ctrl+V", "Paste &as plain text" & vbTab & "Ctrl+Shift+V", "&Delete" & vbTab & "Del")
            End Select
            MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_STRING
            MII.fType = 0
            MII.dwTypeData = StrPtr(Text)
            MII.cch = Len(Text)
            MII.hBmpItem = NULL_PTR
            Select Case i
                Case 1
                    If Me.CanUndo = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 2
                    If Me.CanRedo = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 3, 4, 7
                    If (SelType And SEL_TEXT) = SEL_TEXT Or (SelType And SEL_OBJECT) = SEL_OBJECT Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 5
                    If Me.CanPaste = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
                Case 6
                    If Me.CanPaste(CF_UNICODETEXT) = True Then
                        MII.fState = MFS_ENABLED
                    Else
                        MII.fState = MFS_DISABLED
                    End If
            End Select
            MII.wID = i
            InsertMenuItem hMenu, 0, 0, MII
        Next i
        MII.fMask = MIIM_STATE Or MIIM_ID Or MIIM_FTYPE
        MII.fType = MFT_SEPARATOR
        MII.dwTypeData = 0
        MII.cch = 0
        MII.hBmpItem = NULL_PTR
        MII.fState = 0
        MII.wID = i
        InsertMenuItem hMenu, 2, 1, MII
    End If
    End Sub
    The IDE's codepage doesn't support these charters. Please use the English version.
    -----(Same meaning as above)-----
    GBK?????????????????

  26. #3786

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by linhongye2010 View Post
    The IDE's codepage doesn't support these charters. Please use the English version.
    -----(Same meaning as above)-----
    GBK?????????????????
    Please re-download the demo.

  27. #3787

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Update released.

    Included the Span/UpTo method in the RichTextBox control. (richtx32.ocx compatibility)
    The lack of these methods was complained already several times. Anyway, now it's done.

  28. #3788

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Update released.

    ToolBar buttons can have a dropdown button menu only without submenus.
    Of course you can handle the ButtonDropDown event and show your own menu. However, it would be easier to just supply a menu handle to a button object which takes care of positioning, exclude rects, WM_CANCELMODE upon recursive invocation, left or right align etc. already built-in in the ToolBar control.

    Therefore included the hMenu run-time property in the TbrButton object.
    Returns/sets a handle to a popup menu which will be used as a button dropdown menu.
    This is especially useful when a menu with submenus is needed. You can supply whatever menu which is accepted by TrackPopupMenuEx. (e.g. GetMenu()+GetSubMenu() of a VB.Form)
    Included ButtonMenuClick2 event in the ToolBar control.

    Your application is responsible for destroying the menu handle when it is no longer needed. Best is to also set Button.hMenu to 0 when your app destroys the menu handle.
    Last edited by Krool; May 2nd, 2024 at 12:18 PM.

  29. #3789

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    OCX 1.8 released.

  30. #3790

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Update released.

    Included the PasteSpecialDlg method in the RichTextBox control. (OleUIPasteSpecialW)
    Ctrl+Alt+V shortcut now invokes the paste special dialog box.
    The AutoVerbMenu is added with a paste special menu entry.

    The OCX VBCCR18 was also updated. The internal type lib version is now 1.1.

    Code:
    Object={379157C5-E9BD-43F1-9F83-B037496BED42}#1.1#0; VBCCR18.OCX
    As it's early stage of VBCCR18 I decided to increase type lib version. (requires a re-register)
    However, I plan now to keep things as they are and do bugfixes only. But I saw this feature quite useful..
    Last edited by Krool; May 5th, 2024 at 03:45 PM.

  31. #3791
    New Member
    Join Date
    Aug 2017
    Posts
    5

    Re: CommonControls (Replacement of the MS common controls)

    Krool, any chance you make your version of Masked Edit Control (MSMASK32.ocx) ?

  32. #3792

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by garibaldi View Post
    Krool, any chance you make your version of Masked Edit Control (MSMASK32.ocx) ?
    No. VBCCR18 will now be "as is" with bug fix support only.

  33. #3793
    Hyperactive Member
    Join Date
    Feb 2015
    Location
    Colorado USA
    Posts
    270

    Re: CommonControls (Replacement of the MS common controls)

    Krool, the latest ComCtrlsDemo.zip is not a zip file...

  34. #3794
    New Member
    Join Date
    Aug 2017
    Posts
    5

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Krool View Post
    No. VBCCR18 will now be "as is" with bug fix support only.
    Aah ok then, thanks.

  35. #3795
    Lively Member
    Join Date
    Nov 2023
    Posts
    98

    Re: CommonControls (Replacement of the MS common controls)

    I have not found an update to support Unicode drag and drop (ListBoxW)

  36. #3796

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by HackerVlad View Post
    I have not found an update to support Unicode drag and drop (ListBoxW)
    AllowDropFiles property and DropFiles event.
    I see them. O_o

  37. #3797
    Member
    Join Date
    Mar 2020
    Posts
    37

    Re: CommonControls (Replacement of the MS common controls)

    Hi,

    Maybe I miss something, but when using ImageCombo with 'MS Common Controls' with this example :

    Code:
    Private Sub Form_Load()
    
    	ImageCombo1.ComboItems.Add , , "Test", "printer"
    	ImageCombo1.ComboItems.Add , , "Test2", "printer"
    	ImageCombo1.ComboItems.Add , , "Test3", "printer"
    	
    	ImageCombo1.ComboItems(1).Selected = True
    
    End Sub
    The item is selected and displayed with its icon.

    But When I do the same with Krool's CommonControls, there is no icon next to the selected item. I have to click ImageCombo1 to get the list with the icons.

  38. #3798
    Member
    Join Date
    Mar 2020
    Posts
    37

    Re: CommonControls (Replacement of the MS common controls)

    Ok, I've moved my code into Private Sub Form_Activate() and it works.

  39. #3799

    Thread Starter
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,439

    Re: CommonControls (Replacement of the MS common controls)

    Quote Originally Posted by Crapahute View Post
    Hi,

    Maybe I miss something, but when using ImageCombo with 'MS Common Controls' with this example :

    Code:
    Private Sub Form_Load()
    
    	ImageCombo1.ComboItems.Add , , "Test", "printer"
    	ImageCombo1.ComboItems.Add , , "Test2", "printer"
    	ImageCombo1.ComboItems.Add , , "Test3", "printer"
    	
    	ImageCombo1.ComboItems(1).Selected = True
    
    End Sub
    The item is selected and displayed with its icon.

    But When I do the same with Krool's CommonControls, there is no icon next to the selected item. I have to click ImageCombo1 to get the list with the icons.
    I can't reproduce as it's working for me. Can you show a full demo ? Maybe I am missing something.

  40. #3800
    Member
    Join Date
    Mar 2020
    Posts
    37

    Re: CommonControls (Replacement of the MS common controls)

    Sorry, that had nothing to do with your CommonControls' ImageCombo.

    In fact, I use a class FormResize.cls to resize the form and its objects.
    When loading, the form resizes and changing font size of the objects made the icon disappear in my ImageCombo.
    So selecting the default item of the combo after the resize solved my problem.

Page 95 of 96 FirstFirst ... 45859293949596 LastLast

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