CommonControls (Replacement of the MS common controls)

[DrUnicode]

U.S. Keyboard will not join ~ and a.
U.S. International will join them and print ã.
"Tilde" is to the left of Number 1 on U.S. International keyboard. Use shift to get it and then follow it with "a".
Try this in Notepad first.
Once you confirm this, try same in UniTextBox.

U.S. International layout (OnScreenKeyboard):

[georgekar]

Join as we speak, but this ã is another unicode char.

[Krool]

Does not work by me...

[georgekar]

In Xp those keys are blue...(here in red circles)

[DrUnicode]

Does not work by me...

Does it work in Notepad but not in UniTextBox?

[DrUnicode]

This is with U.S. International:



This is with ABNT2 Brazilian Portuguese:

[Krool]

Ok, it seems to work now. Can anyone else check it out. By replacing the code in my TextBox as following:

Private TextBoxKeyCodeCache As Integer, TextBoxDeadKeyCodeCache As Integer

    Case WM_KEYDOWN, WM_KEYUP
        Dim KeyCode As Integer
        KeyCode = wParam And &HFF&
        If wMsg = WM_KEYDOWN Then
            RaiseEvent KeyDown(KeyCode, GetShiftState())
            If IsDeadKey(KeyCode) = True  And TextBoxDeadKeyCodeCache = 0 Then TextBoxDeadKeyCodeCache = KeyCode
            TextBoxKeyCodeCache = KeyCode
        ElseIf wMsg = WM_KEYUP Then
            RaiseEvent KeyUp(KeyCode, GetShiftState())
        End If
        wParam = KeyCode
    Case WM_CHAR
        Dim KeyChar As Integer, UniChar As String
        If TextBoxKeyCodeCache <> 0 Then
            If TextBoxDeadKeyCodeCache <> 0 Then
                KeyCodeToUniChar TextBoxDeadKeyCodeCache
                TextBoxDeadKeyCodeCache = 0
            End If
            UniChar = KeyCodeToUniChar(TextBoxKeyCodeCache)
            If Len(UniChar) > 1 Then
                TextBoxKeyCodeCache = CUIntToInt(AscW(Mid$(UniChar, 2, 1)))
            Else
                TextBoxKeyCodeCache = 0
            End If
        End If
        If Len(UniChar) > 0 Then
            KeyChar = CUIntToInt(AscW(UniChar))
        Else
            KeyChar = CUIntToInt(wParam And &HFFFF&)
        End If
        RaiseEvent KeyPress(KeyChar)
        If (wParam And &HFFFF&) <> 0 And KeyChar = 0 Then
            Exit Function
        Else
            wParam = CIntToUInt(KeyChar)
        End If

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyW" (ByVal uCode As Long, ByVal uMapType As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwThreadID As Long) As Long
Private Declare Function GetKeyboardState Lib "user32" (ByRef pbKeyState As Byte) As Long
Private Declare Function ToUnicodeEx Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, ByRef lpKeyState As Byte, ByVal lpwszBuffer As Long, ByVal cchBuffer As Long, ByVal wFlags As Long, ByVal hKL As Long) As Long

Public Function KeyCodeToUniChar(ByVal KeyCode As Integer) As String
Dim Buffer As String, BufferPtr As Long, B(0 To 255) As Byte, RetVal As Long
Buffer = String$(32, vbNullChar)
BufferPtr = StrPtr(Buffer)
GetKeyboardState B(0)
RetVal = ToUnicodeEx(KeyCode, 0, B(0), BufferPtr, Len(Buffer), 0, GetKeyboardLayout(0))
SysReAllocString VarPtr(KeyCodeToUniChar), BufferPtr
End Function

Public Function IsDeadKey(ByVal KeyCode As Integer) As Boolean
Const MAPVK_VK_TO_CHAR As Long = &H2
IsDeadKey = CBool(MapVirtualKey(KeyCode, MAPVK_VK_TO_CHAR) < 0)
End Function

[DrUnicode]

With your changes I'm getting "à" instead of "ã" with U.S. International keyboard.
What is strange is that I get this Grave accent both with and without shift.

BTW - I tried my original code also in your control and it worked OK, even with "ã".

[DrUnicode]

I don't know if this helps but if you hold the Shift Key, press Tilde and then "A" you get "Ã"
but if you release the shift after tilde you get "à" in lieu of "ã".

[Krool]

With your changes I'm getting "à" instead of "ã" with U.S. International keyboard.
What is strange is that I get this Grave accent both with and without shift.

BTW - I tried my original code also in your control and it worked OK, even with "ã".

Can you please show me your source code implemented into my TextBox? (couldn't get it work by me straight from your original code)

[Krool]

I found the reason. I skipped the following from your original code:

   If Not IsUnicode(ToCharacterEx) Then 'This may not be necessary
      ToCharacterEx = ChrW$(KeyAscii)
   End If

As I thought that this is not necessary. However, it actually is..

[DrUnicode]

Attached is IME code in your control.
Attached Zip has only TextBoxW.ctl and Common.bas, the only 2 file that were modified.

[georgekar]

To many lines to make it to work. With much of research I found that the use of GetLastKeyPressed is what we need to do the job right.
These works for me...and I think that can be work for you too...If a key give two or more wchars then with GetLastKeyPressed you don't need to interpret what it is interpreted for you...and in the right way...

dim UKEY$
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoW" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As Long, ByVal cchData As Long) As Long
Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout&) ' not NT?
Private Const DWL_ANYTHREAD& = 0
Const LOCALE_ILANGUAGE = 1
Const WM_KEYFIRST = &H100  ' I have no idea why keyfirst must be &h100
 Const WM_KEYLAST = &H108
 Private Type POINTAPI
    X As Long
    Y As Long
End Type
 Private Type Msg
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
Public Function GetLastKeyPressed() As Long
' no subclass
' we have one keyboard only so in the keydown...99.99% we get the keystroke
Dim Message As Msg
    If PeekMessageW(Message, 0, WM_KEYFIRST, WM_KEYLAST, 0) Then
        GetLastKeyPressed = Message.wParam
    Else
        GetLastKeyPressed = -1
    End If
    Exit Function
End Function

Function GetKeY(ascii As Integer) As String
    Dim Buffer As String, Ret As Long. r as long
    Buffer = String$(514, 0)
      r = GetKeyboardLayout(DWL_ANYTHREAD) And &HFFFF
      r = Val("&H" & Right(Hex(r), 4))
    Ret = GetLocaleInfo(r, LOCALE_ILANGUAGE, StrPtr(Buffer), Len(Buffer))
    If Ret > 0 Then
        GetKeY = ChrW$(AscW(StrConv(ChrW$(ascii Mod 256), 64, CLng(Val("&h" + Left$(Buffer, Ret - 1))))))
    Else
        GetKeY = ChrW$(AscW(StrConv(ChrW$(ascii Mod 256), 64, 1033)))
    End If
End Function



in keydown event
.........code for arrows and special keys
I = GetLastKeyPressed
 If I <> -1 And I <> 94 Then UKEY$ = ChrW(I) Else UKEY$ = ""


in keypress event
..................code for other keys...
 If EditFlag And KeyAscii > 32 And KeyAscii <> 127 Then
            If UKEY$ <> "" Then
            kk$ = UKEY$
            Else
  kk$ = GetKeY(KeyAscii)   ' this was the old way...I didn't deleted...If UKEY$ didn't work (if GetLastKeyPresserd give always -1, we can write...)
  End If
             RaiseEvent RemoveOne(kk$)   ' this is for undo
            If SelStart = 0 Then mSelstart = 1
           
            SelStartEventAlways = SelStart + 1
   
                List(SELECTEDITEM - 1) = Left$(List(SELECTEDITEM - 1), SelStart - 2) + kk$ + Mid$(List(SELECTEDITEM - 1), SelStart - 1)
            
         
            End If
         End If

With GetKey we can get the unicode from ascii...reading the keyboard localeid...but we miss the dead keys and double chars...
Now we have both...because we read the unicode value before. With the addition of Unicode No 94 as the dead key indicator..we are complete
In my control there is no RTB or other control..from third party. In fact there are no other control but the user control only, and three shapes for constructing the scroll bar.

[Krool]

I finally got it now to work, the solution was to save the keystate of the dead key.

@ DrUnicode, can you please test again on your side?

Private Declare Function GetKeyboardState Lib "user32" (ByRef pbKeyState As Byte) As Long

Private TextBoxKeyCodeCache As Integer, TextBoxDeadKeyCodeCache As Integer, TextBoxDeadKeyState(0 To 255) As Byte

    Case WM_KEYDOWN, WM_KEYUP
        Dim KeyCode As Integer
        KeyCode = wParam And &HFF&
        If wMsg = WM_KEYDOWN Then
            RaiseEvent KeyDown(KeyCode, GetShiftState())
            TextBoxKeyCodeCache = KeyCode
            If IsDeadKey(KeyCode) = True And TextBoxDeadKeyCodeCache = 0 Then
                TextBoxDeadKeyCodeCache = KeyCode
                GetKeyboardState TextBoxDeadKeyState(0)
            End If
        ElseIf wMsg = WM_KEYUP Then
            RaiseEvent KeyUp(KeyCode, GetShiftState())
        End If
        wParam = KeyCode
    Case WM_CHAR
        Dim KeyChar As Integer, UniChar As String
        If TextBoxKeyCodeCache <> 0 Then
            Dim ScanCode As Integer, B(0 To 255) As Byte
            ScanCode = LoByte(HiWord(lParam))
            If TextBoxDeadKeyCodeCache <> 0 Then
                KeyCodeToUniChar TextBoxDeadKeyCodeCache, ScanCode, TextBoxDeadKeyState()
                TextBoxDeadKeyCodeCache = 0
            End If
            GetKeyboardState B(0)
            UniChar = KeyCodeToUniChar(TextBoxKeyCodeCache, ScanCode, B())
            TextBoxKeyCodeCache = 0
        End If
        If Len(UniChar) > 0 Then
            KeyChar = CUIntToInt(AscW(UniChar))
        Else
            KeyChar = CUIntToInt(wParam And &HFFFF&)
        End If
        RaiseEvent KeyPress(KeyChar)
        If (wParam And &HFFFF&) <> 0 And KeyChar = 0 Then
            Exit Function
        Else
            wParam = CIntToUInt(KeyChar)
        End If

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyW" (ByVal uCode As Long, ByVal uMapType As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwThreadID As Long) As Long
Private Declare Function ToUnicodeEx Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, ByRef lpKeyState As Byte, ByVal lpwszBuffer As Long, ByVal cchBuffer As Long, ByVal wFlags As Long, ByVal hKL As Long) As Long

Public Function KeyCodeToUniChar(ByVal KeyCode As Integer, ByVal ScanCode As Integer, ByRef B() As Byte) As String
Dim Buffer As String, BufferPtr As Long, RetVal As Long
Buffer = String$(32, vbNullChar)
BufferPtr = StrPtr(Buffer)
RetVal = ToUnicodeEx(KeyCode, ScanCode, B(0), BufferPtr, Len(Buffer), 0, GetKeyboardLayout(0))
SysReAllocString VarPtr(KeyCodeToUniChar), BufferPtr
End Function

Public Function IsDeadKey(ByVal KeyCode As Integer) As Boolean
Const MAPVK_VK_TO_CHAR As Long = &H2
IsDeadKey = CBool(MapVirtualKey(KeyCode, MAPVK_VK_TO_CHAR) < 0)
End Function

[georgekar]

If someone press ' twice then the second time he has to get these ' two times.

[DrUnicode]

@ DrUnicode, can you please test again on your side?

Yes. All working fine now. Tested Kazakh, U.S. Normal, U.S. International.

Did you remove this piece of code?

If Len(UniChar) > 1 Then
   TextBoxKeyCodeCache = CUIntToInt(AscW(Mid$(UniChar, 2, 1)))

I think you may need it for IME that generates 2 Unicode characters for single keystroke.
I can't remember which IME I tested this with because it was 9 years ago.

[Krool]

Did you remove this piece of code?

If Len(UniChar) > 1 Then
   TextBoxKeyCodeCache = CUIntToInt(AscW(Mid$(UniChar, 2, 1)))

I think you may need it for IME that generates 2 Unicode characters for single keystroke.
I can't remember which IME I tested this with because it was 9 years ago.

Yes I removed that. Because 2 Unicode characters by a single keystroke just happens when you press a dead key twice. (for e.g. pressing two times ^ will result in ^^ or 2x time WM_CHAR with key char ^)
This case is also described in the MSDN page for the ToUnicode API. ("The most common cause for this is that a dead-key character (accent or diacritic) stored in the keyboard layout could not be combined with the specified virtual key to form a single character.")
But in our case this cannot happen. (VB's main loop itself will produce the WM_CHAR).
We just need to handle the case when a WM_CHAR is coming and previous key was a dead-key, in order to combine them.

Another point: AscW returns a key char and not a key code. Thus this would also be wrong, no?

[DrUnicode]

Because 2 Unicode characters by a single keystroke just happens when you press a dead key twice.

It was 9 years ago when I ran into this issue reported by a customer.
Apparently a particular IME generated a surrogate pair, 2 Unicode characters for a single keystroke.
In this case you don't get a WM_KEYDOWN for the second charcter but you do get another WM_CHAR.
We need to find out which IME does this and which keystroke to test this.

[georgekar]

Maybe I write for nothing..but...I have solve this problem. I can't work with the library of Krool because I found difficulties to run it in Xp.
We can get the pressing keys as unicode string before the keypress event..So we have to take these keys in a string and use it in the keypress event. So we need a string as buffer, as a variable declared for module/class/form/user control...The last pressing key return -1 if we have no char...so we skip the writing to the buffer. If we have a number 94 then that is ANY dead key (in any combination, so we don't have to read Shift state), and we just SKIP the buffer writing. In Keypress event we process the buffer if the key that supposed to give is a key in the range of keys and not delete or other<32 (in my control ascii code 32 is used for two things so I have to exclude it).
So how we get two or more keystrokes that produce ONE unicode code? Easy as you see, because we read the final Unicode code (so this is done from os for us)...and not the intermediate keystrokes. If you wish to write the OS again then make your own code..but in that situation..do not use the ready made control from MS...make your own, you will be happy too. You can leave the original messages (by raising events prior the right process) to give external process for the final user...and check for changes to values and then "skip" the right process if you found any (because this process are not known to the final user).

[Krool]

It was 9 years ago when I ran into this issue reported by a customer.
Apparently a particular IME generated a surrogate pair, 2 Unicode characters for a single keystroke.
In this case you don't get a WM_KEYDOWN for the second charcter but you do get another WM_CHAR.
We need to find out which IME does this and which keystroke to test this.

Ok, then following way would solve it. (Though I cannot test)

    Case WM_CHAR
        Static SurrogateKeyChar As Integer
        Dim KeyChar As Integer, UniChar As String
        If TextBoxKeyCodeCache <> 0 Then
            If TextBoxDeadKeyCodeCache <> 0 Then
                KeyCodeToUnicode TextBoxDeadKeyCodeCache, TextBoxDeadScanCodeCache, TextBoxDeadKeyStateCache()
                TextBoxDeadKeyCodeCache = 0
            End If
            Dim KeyState(0 To 255) As Byte
            GetKeyboardState KeyState(0)
            UniChar = KeyCodeToUnicode(TextBoxKeyCodeCache, HiWord(lParam), KeyState())
            TextBoxKeyCodeCache = 0
        End If
        If Len(UniChar) > 0 Then
            KeyChar = CUIntToInt(AscW(UniChar))
            If Len(UniChar) > 1 Then SurrogateKeyChar = CUIntToInt(AscW(Mid$(UniChar, 2, 1)))
        Else
            If SurrogateKeyChar <> 0 Then
                KeyChar = SurrogateKeyChar
                SurrogateKeyChar = 0
            Else
                KeyChar = CUIntToInt(wParam And &HFFFF&)
            End If
        End If
        RaiseEvent KeyPress(KeyChar)

[Krool]

But still there is one important issue.
Open notepad and any of your Unicode TextBox. When you enter a dead key now in the notepad, for e.g. `. Then switch to the Unicode TextBox and enter the the 'a' character. Do you get 'à' or just 'a'? Same vice versa. The notepad does it correctly, seems like it somehow knows that a dead key was pressed before.

But I think in DrUnicode version this is not a problem due to the last thing "If Not IsUnicode(ToCharacterEx) Then" fixes this issue. But for me that is not a proper way.

[Tanner_H]

Nice work making progress on this! While we're talking about dead keys, here's another language to test: Vietnamese. The Vietnamese keyboard works a little differently because regular letters can function as dead keys, but only if they are followed by certain characters.

For example: in Notepad, typing 1 gives you:

ă

Typing 1 and then 9 erases that character, and replaces it with:

ặ

Similarly, typing 1 and then 8 gives you:

ắ

So that initial ă can be merged with a number of other diacritics, or it can be used as a standalone character. This is different from other dead keys because the first character appears when pressed, and it's only treated as a dead key if a subsequent key modifies it in some way. Hopefully your existing code works with these as well!

@Krool:

"The notepad does it correctly, seems like it somehow knows that a dead key was pressed before."

ToUnicode, for better or worse, uses the global (kernel-mode) key buffer to assemble keystrokes. So a dead key typed in one window will affect the ToUnicode buffer in another window. It's part of what makes ToUnicode so difficult to use, because every time you call it, it rewrites the global key buffer, so trying to use it from a hook (for example) can prevent other windows from receiving the correct keystrokes.

[Tanner_H]

It was 9 years ago when I ran into this issue reported by a customer.
Apparently a particular IME generated a surrogate pair, 2 Unicode characters for a single keystroke.
In this case you don't get a WM_KEYDOWN for the second charcter but you do get another WM_CHAR.
We need to find out which IME does this and which keystroke to test this.

Could we test this with direct entry using the Alt key? For example, Alt+173 569 should produce the surrogate pair character 𪘁.

I haven't tested yet, but I'm not sure whether this still causes two WM_CHAR messages to be raised. What's strange is that Notepad doesn't handle this kind of Alt+key input correctly. (It produces a ☺character.) However, WordPad correctly produces 𪘁.

[wqweto]

But still there is one important issue.
Open notepad and any of your Unicode TextBox. When you enter a dead key now in the notepad, for e.g. `. Then switch to the Unicode TextBox and enter the the 'a' character. Do you get 'à' or just 'a'? Same vice versa. The notepad does it correctly, seems like it somehow knows that a dead key was pressed before.

I'm positive Notepad knows nothing of this and doesn't need to mess with key down/up at all. It just uses the unicode version of the standard Edit windows control *and* has a unicode message pump as the main app loop (GetMessageW/DispatchMessageW). This way on WM_CHAR it does get a unicode character in wParam in the lower 16-bits (not only the lower 8-bits as in VB6).

VB6 run-time uses PeekMessageA/DispatchMessageA in the main msg pump, so even unicode hWnds (those created with CreateWindowExW or those with "unicode" wndproc set with SetWindowLongW) get a strippped down wParam on WM_CHAR -- the OS has done a Unicode to ACP (current system code page for non-unicode application) conversion on their behalf. And I doubt there is a reliable way to revert this conversion from ACP to Unicode once the damage is done.

You have to intercept WM_CHAR earlier, in case of VB6 dispatched messages in the control's wndproc it is already too late to take counter measures. I've tested CyberActiveX's Unicode rich-textbox (the free download) and it is not working with my keyboard (I'm a native Bulgarian using cyrillic alphabet with a twist -- almost like Kazakh one) -- unicode input get converted to ? both in the IDE and compiled. I can take screenshots, videos, whatever to prove it :-))

cheers,
</wqw>

[georgekar]

In post 533 I display that:
..........
If PeekMessageW(Message, 0, WM_KEYFIRST, WM_KEYLAST, 0) Then
GetLastKeyPressed = Message.wParam
Else
GetLastKeyPressed = -1
End If
Exit Function
...........
And now in 544..we read it again...

[DrUnicode]

Using English iInternational I can type "`" in Notepad and "a" in UniTextBox and I get the combined "à" in UniTextBox.
Same for keyboard ABNT2 Portuguese, type "~" in Notepad and "a" in UniTextBox and I get "â" in UniTextBox.
In both cases it works the other way around, accent in UniTextBox and "a" in Notepad gives "á" or "ã".

Tanner_H
Vietnamese:
In UniTextBox I get the correct character with 1, 1+9, 1+8
ă
ặ
ắ

In ComCtldemo I also get:
ă
ặ
ắ

wqweto I've tested CyberActiveX's Unicode rich-textbox (the free download) and it is not working with my keyboard (I'm a native Bulgarian using cyrillic alphabet with a twist

There are 2 RichEdit controls that we distribute:
One is UniRichEdit_BDC0849A.ocx, a wrapper for vbRichTextBox and we would not expect it to handle IME correctly.
The full Unicode version is UniRichEdit100_EDA1811C.ocx. This is the one that handles IME using same technique as UniTextBox.
You need to download UniSuitePlus to get this control.
UniTextBox is part of UniSuitePlus_BDC0849A.ocx which has 27 controls as a single ocx.

[Tanner_H]

I'm positive Notepad knows nothing of this and doesn't need to mess with key down/up at all. It just uses the unicode version of the standard Edit windows control *and* has a unicode message pump as the main app loop (GetMessageW/DispatchMessageW). This way on WM_CHAR it does get a unicode character in wParam in the lower 16-bits (not only the lower 8-bits as in VB6).

VB6 run-time uses PeekMessageA/DispatchMessageA in the main msg pump, so even unicode hWnds (those created with CreateWindowExW or those with "unicode" wndproc set with SetWindowLongW) get a strippped down wParam on WM_CHAR -- the OS has done a Unicode to ACP (current system code page for non-unicode application) conversion on their behalf. And I doubt there is a reliable way to revert this conversion from ACP to Unicode once the damage is done.

I think we covered this ground a bit earlier in the thread...

The ToUnicode API *can* be used to reverse-engineer the missing Unicode char. It's not pretty, and you have to do some extra work to handle dead keys (because ToUnicode removes dead keys from the key buffer as it processes them). But it does work. No normal Unicode-aware program has reason to do this, because TranslateMessage (inside GetMessageW) typically does this for you. But you can access ToUnicode directly and perform your own virtual key to character translations.

DrUnicode's solution (from Michael Kaplan, who literally wrote Microsoft's keyboard layout creator) handles this by waiting for WM_CHAR, then using ToUnicode to perform the same virtual key to Unicode translation that TranslateMessage normally would, using key state data cached during WM_KEYDOWN.

I found it easier to perform the translation inside WM_KEYDOWN, then dispatch the correct WM_CHAR message(s) manually. Both of these methods produce the same Unicode output as a normal, W-aware message loop.

This said, there *are* some situations you can't solve this way. As I just learned (in reference to my question about Alt+Unicode key values, above), Alt+# keypresses don't raise normal WM_KEYDOWN messages. They raise WM_SYSKEYDOWN messages, and ToUnicode doesn't handle the WM_CHAR translation. I don't know what does.

So manual code is needed to cover this case, because WM_CHAR is indeed too late.

But for "normal" key events (including IME), these methods do work. In fact, manual ToUnicode usage is the only way to convert keypresses to Unicode characters outside a normal message loop. (For example, a windowless program.)

@DrUnicode - awesome, that's great news. I am also trying to track down an IME that produces surrogate pairs naturally (since we can't get them via Alt+numbers, as mentioned above). I'll let you know if I find one.

[Krool]

Thanks to georgekar, I have finally a perfect solution.

Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type TMSG
hWnd As Long
Message As Long
wParam As Long
lParam As Long
Time As Long
PT As POINTAPI
End Type
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageW" (ByRef lpMsg As TMSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Public Function PeekCharCode(ByVal hWnd As Long) As Long
Dim Msg As TMSG
Const PM_NOREMOVE As Long = &H0, WM_CHAR As Long = &H102
If PeekMessage(Msg, hWnd, WM_CHAR, WM_CHAR, PM_NOREMOVE) <> 0 Then PeekCharCode = Msg.wParam
End Function

That 'PeekCharCode' function I do call in the WM_KEYDOWN message and cache it in a variable.
Then in the WM_CHAR message I cast this to back to wParam, but only in case the cache variable is <> 0.

I tested and it seems to work good. Even globally with the dead chars and so on.

Only issue might be the surrogate pairs, no? (But I don't know how to test this, since I do not know a sample) But in that case (surrogate pairs) the cached key char value would be 0 (due to no KeyDown before) but than the key char in WM_CHAR would be untouched. So at this point maybe not 100% but therefore the rest.

EDIT: Update released

[wqweto]

Thanks to georgekar, I have finally a perfect solution.

Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type TMSG
hWnd As Long
Message As Long
wParam As Long
lParam As Long
Time As Long
PT As POINTAPI
End Type
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageW" (ByRef lpMsg As TMSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Public Function PeekCharCode(ByVal hWnd As Long) As Long
Dim Msg As TMSG
Const PM_NOREMOVE As Long = &H0, WM_CHAR As Long = &H102
If PeekMessage(Msg, hWnd, WM_CHAR, WM_CHAR, PM_NOREMOVE) <> 0 Then PeekCharCode = Msg.wParam
End Function

That 'PeekCharCode' function I do call in the WM_KEYDOWN message and cache it in a variable.
Then in the WM_CHAR message I cast this to back to wParam, but only in case the cache variable is <> 0.

I tested and it seems to work good. Even globally with the dead chars and so on.

Only issue might be the surrogate pairs, no? (But I don't know how to test this, since I do not know a sample) But in that case (surrogate pairs) the cached key char value would be 0 (due to no KeyDown before) but than the key char in WM_CHAR would be untouched. So at this point maybe not 100% but therefore the rest.

EDIT: Update released

@Krool: This is seems like a solution to the problem, good you somehow deciphered georgekar thoughts :-)) The only missing part is if someone uses SendMessage to send WM_CHAR to your wndproc (on-screen keyboard, whatever) then you don't get a chance to peek it on WM_KEYDOWN, more I doubt the WM_CHAR message even gets in the message queue.

Anyway, my proposal is to peek both ANSI *and* Unicode WM_CHARs (using both PeekMessageA and PeekMessageW one after another) and store these wParam's as an (ansi, unicode) pair for consecutive WM_CHAR handling. On WM_CHAR check if wParam is the ansi part of the pair and substitute with the unicode value, else leave wParam fall through.

@DrUnicode: I noticed you are including an upgraded release of a project of mine in your UniSuite -- the UniHookMenu. At least you've seen my profile picture on PSC from something like 12 years ago :-)) Btw, I like control's icon w/ the hook -- Dread Pirate Roberts, no? :-))

cheers,
</wqw>

[Krool]

@Krool: This is seems like a solution to the problem, good you somehow deciphered georgekar thoughts :-)) The only missing part is if someone uses SendMessage to send WM_CHAR to your wndproc (on-screen keyboard, whatever) then you don't get a chance to peek it on WM_KEYDOWN, more I doubt the WM_CHAR message even gets in the message queue.

Anyway, my proposal is to peek both ANSI *and* Unicode WM_CHARs (using both PeekMessageA and PeekMessageW one after another) and store these wParam's as an (ansi, unicode) pair for consecutive WM_CHAR handling. On WM_CHAR check if wParam is the ansi part of the pair and substitute with the unicode value, else leave wParam fall through.

In that case (sending WM_CHAR manually) the wParam value of the sendmessage function will be used. Because the cache variable is zero and therefore the value of wParam gets not altered. So only when doing a user input (KeyDown) the wParam value in WM_CHAR gets altered, and in addition only when there is a WM_CHAR in the pipe-line already. That way, in my opinion, makes it very fail-safe.

[Tanner_H]

@Krool: This is seems like a solution to the problem, good you somehow deciphered georgekar thoughts :-)) The only missing part is if someone uses SendMessage to send WM_CHAR to your wndproc (on-screen keyboard, whatever) then you don't get a chance to peek it on WM_KEYDOWN, more I doubt the WM_CHAR message even gets in the message queue.

Third-party applications that directly post Unicode character messages are hopefully using WM_UNICHAR. This allows the target window to respond to the first probe (with wParam = UNICODE_NOCHAR, or 0xffff) with a 1, meaning it can accept WM_UNICHAR messages.

@Krool: it should be easy to add handling for WM_UNICHAR. In fact, aside from the UNICODE_NOCHAR case, you could probably just forward WM_UNICHAR messages to your existing WM_CHAR code, and have it work without trouble. (Though surrogate pairs might still require special handling...)

[Krool]

Third-party applications that directly post Unicode character messages are hopefully using WM_UNICHAR. This allows the target window to respond to the first probe (with wParam = UNICODE_NOCHAR, or 0xffff) with a 1, meaning it can accept WM_UNICHAR messages.

@Krool: it should be easy to add handling for WM_UNICHAR. In fact, aside from the UNICODE_NOCHAR case, you could probably just forward WM_UNICHAR messages to your existing WM_CHAR code, and have it work without trouble. (Though surrogate pairs might still require special handling...)

You mean like following?

Private Const WM_UNICHAR As Long = &H109, UNICODE_NOCHAR As Long = &HFFFF&

Case WM_UNICHAR
    If wParam = UNICODE_NOCHAR Then WindowProcControl = 1 Else SendMessage hWnd, WM_CHAR, wParam, ByVal lParam
    Exit Function

[Tanner_H]

That looks good to me!

BTW, thanks for all your great work, Krool. Really appreciate you sharing your controls.

[lrd_VB6]

hello

I slightly modified the control "Toolbar" because I thought it was not working properly.
Especially the height that I was not correct.

I was submiting your appobation but my tests are pretty conclusive.

I retouched all routines using "TB_GETSTYLE" and especially "UserControl_Resize"

What does the "TB_GETPADDING" because when I use the button size is wrong. (for me!).

I ask the question again:
Is it possible to have a control of the position "CommonDialog"?
This would be very useful to me!

kind regards

Attachment 120825

[Krool]

I slightly modified the control "Toolbar" because I thought it was not working properly.
Especially the height that I was not correct.

I was submiting your appobation but my tests are pretty conclusive.

I retouched all routines using "TB_GETSTYLE" and especially "UserControl_Resize"

What does the "TB_GETPADDING" because when I use the button size is wrong. (for me!).

I ask the question again:
Is it possible to have a control of the position "CommonDialog"?
This would be very useful to me!

I recommend the use of the CommonDialog class instead of a control in this case.
But, you can "wrap" the COmmonDialog class into a new UserControl, for you special needs.

For the ToolBar:
You are correct. TB_GETPADDING is wrong. ("The padding values are used to create a blank area between the edge of the button and the button's image and/or text")
And according to MSDN the divider line is always two-pixel. (CCS_NODIVIDER = "Prevents a two-pixel highlight from being drawn at the top of the control")
I will fix this soon. Thanks

[Krool]

It was 9 years ago when I ran into this issue reported by a customer.
Apparently a particular IME generated a surrogate pair, 2 Unicode characters for a single keystroke.
In this case you don't get a WM_KEYDOWN for the second charcter but you do get another WM_CHAR.
We need to find out which IME does this and which keystroke to test this.

It would be good to know which IME and what key exactly generates two WM_CHARs.
But the following would solve this case also?

Case WM_CHAR
    Dim KeyChar As Integer
    If TextBoxCharCodeCache <> 0 Then
        KeyChar = CUIntToInt(TextBoxCharCodeCache And &HFFFF&)
        TextBoxCharCodeCache = ComCtlsPeekCharCode(hWnd) ' Instead of 0&, look for another WM_CHAR in the pipeline.
    Else
        KeyChar = CUIntToInt(wParam And &HFFFF&)
    End If

And I tried some tests with PostMessage and SendMessage with manually WM_KEYDOWN and WM_CHAR and the current implementation seems to be very fail-safe. I could not detect an error with this solution. (peek charcode in WM_KEYDOWN)

[wqweto]

@Krool: Latest rich-textbox works with Bulgarian keyboard layout entering 'Shift+A' -- correctly produces ѝ (something like u with accent)

cheers,
</wqw>

[DrUnicode]

It would be good to know which IME and what key exactly generates two WM_CHARs.
But the following would solve this case also?

Went through my old Emails but could not find the one that addresses this issue.

Case WM_CHAR
    Dim KeyChar As Integer
    If TextBoxCharCodeCache <> 0 Then
        KeyChar = CUIntToInt(TextBoxCharCodeCache And &HFFFF&)
        TextBoxCharCodeCache = ComCtlsPeekCharCode(hWnd) ' Instead of 0&, look for another WM_CHAR in the pipeline.
    Else
        KeyChar = CUIntToInt(wParam And &HFFFF&)
    End If

This looks like it would solve the surrogate issue.

Tested your latest build with several IME and all worked OK.
Nice work.

[lrd_VB6]

hello

Too bad, I'm disappointed.
You have not used the code that I had proposed in the attached zip file.
I just tested the release and it does not work as well as mine.
Roll style "Align = Top" a "Align = Left" and it becomes almost imposible to adjust the width !!
I find your version a bit complicated but I have only tested on XP, so it may be there are things I do not know!

I find the code:

Private Function ChangeStyle(ByVal bSetMask, Mask As Long) As Boolean
Dim dwStyle As Long, NewStyle As Long

    If ToolBarHandle Then
        dwStyle = SendMessage(ToolBarHandle, TB_GETSTYLE, 0, ByVal 0&)

        If bSetMask Then
            NewStyle = dwStyle Or Mask
        Else
            NewStyle = dwStyle And Not Mask
        End If

        If dwStyle <> NewStyle Then
            SendMessage ToolBarHandle, TB_SETSTYLE, 0, ByVal NewStyle
            ChangeStyle = True
        End If
    End If

End Function

Public Property Let Divider(ByVal Value As Boolean)
    PropDivider = Value

    If ChangeStyle(Not PropDivider, CCS_NODIVIDER) Then
        SetWindowPos ToolBarHandle, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
        UserControl_Resize
    End If

    UserControl.PropertyChanged "Divider"
End Property

easier to read than:

Public Property Let Divider(ByVal Value As Boolean)
    PropDivider = Value

    If ToolBarHandle <> 0 Then
Dim dwStyle As Long

        dwStyle = SendMessage(ToolBarHandle, TB_GETSTYLE, 0, ByVal 0&)

        If PropDivider = True Then
            If (dwStyle And CCS_NODIVIDER) = CCS_NODIVIDER Then
                SendMessage ToolBarHandle, TB_SETSTYLE, 0, ByVal dwStyle And Not CCS_NODIVIDER
                SetWindowPos ToolBarHandle, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            End If

        Else

            If Not (dwStyle And CCS_NODIVIDER) = CCS_NODIVIDER Then
                SendMessage ToolBarHandle, TB_SETSTYLE, 0, ByVal dwStyle Or CCS_NODIVIDER
                SetWindowPos ToolBarHandle, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
            End If
        End If

        Call UserControl_Resize
    End If

    UserControl.PropertyChanged "Divider"
End Property

Then my code version is "simpler" and does not have the default when you want to change the height or width if you change the property "Align"

Private Sub UserControl_Resize()
Static InProc As Boolean

    If ToolBarHandle = 0 Then Exit Sub
Dim dwStyle As Long
Dim mWidth  As Single, mHeight As Single
Dim mAlign  As VBRUN.AlignConstants
    If InProc Then Exit Sub
    InProc = True
    dwStyle = SendMessage(ToolBarHandle, TB_GETSTYLE, 0, ByVal 0&)

    With UserControl
        mAlign = .Extender.Align
'
'Align Change ?
'
        If ChangeStyle(mAlign = vbAlignRight Or mAlign = vbAlignLeft, CCS_VERT) Then ' force resize Height or Width

            Select Case mAlign 

                Case vbAlignTop, vbAlignBottom ', vbAlignNone
                    Me.Height = 10 

                Case vbAlignLeft, vbAlignRight
                    Me.Width = 10
            End Select

        End If

        MoveWindow ToolBarHandle, 0, 0, .ScaleWidth, .ScaleHeight, 1 ' set size AND redraw for TB_AUTOSIZE calc
        SendMessage ToolBarHandle, TB_AUTOSIZE, 0, ByVal 0&

        GetIdealSize mWidth, mHeight
'
' In GetIdealSize() Now
'        If (dwStyle And CCS_NODIVIDER) = 0 Then
'            mHeight = mHeight + .ScaleY(2, vbPixels, vbContainerSize)
'        End If

        Select Case mAlign

            Case vbAlignTop, vbAlignBottom ', vbAlignNone
                mWidth = Me.Width

            Case vbAlignLeft, vbAlignRight
                mHeight = Me.Height

            Case Else
'optional, force a minimum width or height
                If Me.Height > mHeight Then mHeight = Me.Height
                If Me.Width > mWidth Then mWidth = Me.Width
        End Select

        .Size mWidth, mHeight
        MoveWindow ToolBarHandle, 0, 0, .ScaleWidth, .ScaleHeight, 1
    End With

    InProc = False
End Sub

But as I said, I did do the test ONLY on XP, so ....

Otherwise, nice work, I hope I can continue to make my contribution to the building.


kind regards

[lrd_VB6]

Oups