How to get Unicode char on IME window in VB6? - unicode

I have a special case when the user is first typing through IME by Press Alphabetic KeyCode on my Grid UserControl, How do I pick up the Unicode on IME Window? If the user is typing in English, it is OK. But if the user is typing Chinese or Japanese on IME, the Unicode turns into question marks.
Select Case uMsg
Case WM_IME_SETCONTEXT
If Not wParam = 0 Then
Dim flag As Boolean
flag = ImmAssociateContextEx(lng_hWnd, 0, 16)
If flag Then
Dim IntPtr As Long
IntPtr = ImmGetContext(lng_hWnd)
flag = ImmSetOpenStatus(IntPtr, True)
End If
End If
Case WM_IME_STARTCOMPOSITION
Dim hIMC As Long
hIMC = ImmGetContext(lng_hWnd)
Dim cf As COMPOSITIONFORM
cf.dwStyle = 2
cf.ptCurrentPos.X = UserControl1.ScaleLeft + 3
cf.ptCurrentPos.Y = UserControl1.ScaleTop + UserControl1.Height - 16
ImmSetCompositionWindow hIMC, cf
Case WM_IME_CHAR
'Send IME Char to UserControl1.KeyPress
UserControl1_KeyPress(wParam And &HFFFF&)
Exit Sub
End Select

After I use different Subclasser from Krool, now I can get Right Unicode. Not sure why Paul Caton and LaVolpe cSelfSubHookCallBack doesn't work.
The Subclasser may internally turn Unicode to ANSI or failed to prevent Windows from UNICODE to ANSI conversion.

Related

Finding text AND fields with variable content in Word

I need to find and delete every occurrence of the following pattern in a Word 2010 document:
RPDIS→ text {INCLUDEPICTURE c:\xxx\xxx.png" \*MERGEFORMAT} text ←RPDIS
Where:
RPDIS→ and ←RPDIS are start and end delimiters
Between the start and end delimiters there can be just text or text and fields with variable content
The * wildcard in the Word Find and Replace dialog box will find the pattern if it contains text only but it will ignore patterns where text is combined with fields. And ^19 will find the field but not the rest of the pattern until the end delimiter.
Can anyone help, please?
Here's a VBA solution. It wildcard searches for RPDIS→*←RPDIS. If the found text contains ^19 (assuming field codes visible; if objects are visible instead of field codes, then the appropriate test is text contains ^01), the found text is deleted. Note that this DOES NOT care about the type of embedded field --- it will delete ANY AND ALL embedded fields that occur between RPDIS→ and ←RPDIS, so use at your own risk. Also, the code has ChrW(8594) and ChrW(8592) to match right-arrow and left-arrow respectively. You may need to change that if your arrows are encoded differently.
Sub test()
Dim wdDoc As Word.Document
Dim r As Word.Range
Dim s As String
' Const c As Integer = 19 ' Works when field codes are visible
Const c As Integer = 1 ' Works when objects are visible
Set wdDoc = ActiveDocument
Set r = wdDoc.Content
With r.Find
.Text = "RPDIS" & ChrW(8594) & "*" & ChrW(8592) & "RPDIS"
.MatchWildcards = True
While .Execute
s = r.Text
If InStr(1, s, chr(c), vbTextCompare) > 0 Then
Debug.Print "Delete: " & s
' r.Delete ' This line commented out for testing; remove comments to actively delete
Else
Debug.Print "Keep: " & s
End If
Wend
End With
End Sub
Hope that helps.

How to count the visible number of lines of text in a text box on an MS Access form

OK, here's what I am trying to achieve. I have an MS Access 2016 DB with a form on it - one of the fields is a text field (max 255 chars), that users can enter "notes", by date.
The form is a continuous form, and there are a LOT of notes. And as most notes are only a single sentence, not the full 255 chars, to save screen space, the text box is sized to only allow show two lines of text (users can double click on the note to see the full text in the rare instances that the text is up to 255 chars).
The problem with this approach is that it is not always clear if a note goes beyond the two lines.
So I am trying to find a way to tell how many lines of text the note uses in the text box, and then I'll highlight the text box if this is the case.
Note what I am talking about here is text wrapping within a text box, not (necessarily) text with line breaks (although there may be line breaks also). Given the wrapping changes dependent upon the text (eg long words will "wrap early" to a new line), so using a simple char count doesn't work, even with a monospace font.
I have searched a lot online and found nothing, except a ref to a possible solution here:
http://www.lebans.com/textwidth-height.htm
But the download is an old Access file type I can no longer open.
Does anyone have any ideas (except for a form redesign - which is my last option hopefully!)
To count the number of lines in a string, or text box, you can use this expression:
UBound(Split(str, vbCrLf))
So
UBound(Split([textBoxName], vbCrLf))
OK, I have come up with a "solution" to this - it's neither neat nor fast, but it appears to work in my situation. I have posted the VBA code for anyone for whom it might interest.
This function is then used on a continuous form's textbox conditional highlighting, so I can highlight those instances where the text has wrapped beyond "n" lines (in my case, two lines)
FYI it's only partially tested, with no error handling!
' Returns TRUE if the text in a textbox wraps/breaks beyond the number of visible lines in the text box (before scrolling)
' THIS ONLY WORKS FOR MONOSPACE FONTS IN A TEXTBOX WHERE WE KNOW THE WidthInMonospaceCharacters
' WidthInMonospaceCharacters = number of MONOSPACE characters to EXACTLY fill one line in your text box (needs to be counted manually
' VisibleLinesInTextBox = number of lines your text box shows on screen (without scrolling)
Function UnseenLinesInTextBox(YourText As String, WidthInMonospaceCharacters As Long, VisibleLinesInTextBox As Long) As Boolean
Dim LineBreakTexts() As String
Dim CleanText As String
Dim LineCount As Long
Dim LineBreaks As Long
Dim i As Long
' Doesn't matter if we can't see invisible end spaces/line breaks, so lose them
' NB advise cleaning text whenver data updated then no need to run this line
CleanText = ClearEndSpacesAndLineBreaks(YourText)
' Check for any line breaks
LineBreakTexts = Split(CleanText, vbCrLf)
' Too many line breaks means we can't be all in the textbox, so report and GTFOOD
LineBreaks = UBound(LineBreakTexts)
If LineBreaks >= VisibleLinesInTextBox Then
UnseenLinesInTextBox = True
GoTo CleanExit
End If
' No line breaks, and text too short to wrap, so exit
If LineBreaks = 0 And Len(CleanText) <= WidthInMonospaceCharacters Then GoTo CleanExit
' Loop thorough the line break text, and check word wrapping for each
For i = 0 To LineBreaks
LineCount = LineCount + CountWrappedLines(LineBreakTexts(i), WidthInMonospaceCharacters, VisibleLinesInTextBox)
If LineCount > VisibleLinesInTextBox Then
UnseenLinesInTextBox = True
GoTo CleanExit
End If
Next i
CleanExit:
Erase LineBreakTexts
End Function
' Add BugOutLineCount if we are using this simply to see if we are exceeding X number of lines in a textbox
' Put this number of lines here (eg if we have a two line text box, enter 2)
Function CountWrappedLines(YourText As String, WidthInMonospaceCharacters As Long, Optional BugOutLineCount As Long) As Long
Dim SpaceBreakTexts() As String
Dim LineCount As Long, RollingCount As Long, SpaceBreaks As Long, i As Long
Dim WidthAdjust As Long
Dim CheckBugOut As Boolean
Dim tmpLng1 As Long, tmpLng2 As Long
If BugOutLineCount > 0 Then CheckBugOut = True
' Check for space breaks
SpaceBreakTexts = Split(YourText, " ")
SpaceBreaks = UBound(SpaceBreakTexts)
If SpaceBreaks = 0 Then
' No spaces, so text will wrap simply based on the number of characters per line
CountWrappedLines = NoSpacesWrap(YourText, WidthInMonospaceCharacters)
GoTo CleanExit
End If
' Need to count the wrapped line breaks manually
' We must start with at least one line!
LineCount = 1
For i = 0 To SpaceBreaks
tmpLng1 = Len(SpaceBreakTexts(i))
If i = 0 Then
' Do not count spaces in the first word...
RollingCount = RollingCount + tmpLng1
Else
' ... but add spaces to the count for the next texts
RollingCount = 1 + RollingCount + tmpLng1
End If
' Need this adjustment as wrapping works slightly differently between mid and
' end of text
If i = SpaceBreaks Then
WidthAdjust = WidthInMonospaceCharacters
Else
WidthAdjust = WidthInMonospaceCharacters - 1
End If
' Check when we get a wrapped line
If RollingCount > WidthAdjust Then
' Check the the length of the word itself doesn't warp over more than one line
If tmpLng1 > WidthInMonospaceCharacters Then
tmpLng2 = NoSpacesWrap(SpaceBreakTexts(i), WidthInMonospaceCharacters)
If i <> 0 Then
LineCount = LineCount + tmpLng2
Else
LineCount = tmpLng2
End If
' As we have wrapped, then we already have a word on the next line to count in the rolling count
RollingCount = tmpLng1 - ((tmpLng2 - 1) * WidthInMonospaceCharacters)
Else
' New line reached
LineCount = LineCount + 1
' As we have wrapped, then we already have a word on the next line to count in the rolling count
RollingCount = Len(SpaceBreakTexts(i))
End If
End If
If CheckBugOut Then If LineCount > BugOutLineCount Then Exit For
Next i
CountWrappedLines = LineCount
CleanExit:
Erase SpaceBreakTexts
End Function
' Work out how many lines text will wrap if it has NO spaces
Function NoSpacesWrap(YourText As String, WidthInMonospaceCharacters) As Long
Dim WordLines As Double
Dim MyInt As Integer
WordLines = (Len(YourText) / WidthInMonospaceCharacters)
MyInt = Int(WordLines)
' Line(s) are exact width we are looking at
If WordLines - MyInt = 0 Then
NoSpacesWrap = MyInt
Else
NoSpacesWrap = MyInt + 1
End If
End Function
Function ClearEndSpacesAndLineBreaks(YourText As String) As String
Dim str As String
Dim CurrentLength As Long
str = YourText
' Need to loop this in case we have a string of line breaks and spaces invisibly at end of text
Do
CurrentLength = Len(str)
' Clear end spaces
str = RTrim(str)
' Clear end line break(s) whihc are TWO characters long
Do
If Right(str, 2) <> vbCrLf Then Exit Do
str = Left(str, Len(str) - 2)
Loop
If Len(str) = CurrentLength Then Exit Do
Loop
ClearEndSpacesAndLineBreaks = str
End Function
Do please provide any feedback and comments!

Need code for removing all unicode characters in vb6

I need code for removing all unicode characters in a vb6 string.
If this is UTF-16 text (as normal VB6 String values all are) and you can ignore the issue of surrogate pairs, then this is fairly quick and reasonably concise:
Private Sub DeleteNonAscii(ByRef Text As String)
Dim I As Long
Dim J As Long
Dim Char As String
I = 1
For J = 1 To Len(Text)
Char = Mid$(Text, J, 1)
If (AscW(Char) And &HFFFF&) <= &H7F& Then
Mid$(Text, I, 1) = Char
I = I + 1
End If
Next
Text = Left$(Text, I - 1)
End Sub
This has the workaround for the unfortunate choice VB6 had to make in returning a signed 16-bit integer from the AscW() function. It should have been a Long for symmatry with ChrW$() but it is what it is.
It should beat the pants off any regular expression library in clarity, maintainability, and performance. If better performance is required for truly massive amounts of text then SAFEARRAY or CopyMemory stunts could be used.
Public Shared Function StripUnicodeCharactersFromString(ByVal inputValue As String) As String
Return Regex.Replace(inputValue, "[^\u0000-\u007F]", String.Empty)
End Function
Vb6 - not sure will
sRTF = "\u" & CStr(AscW(char))
work? - You could do this for all char values above 127
StrConv is the command for converting strings.
StrConv Function
Returns a Variant (String) converted as specified.
Syntax
StrConv(string, conversion, LCID)
The StrConv function syntax has these named arguments:
Part Description
string Required. String expression to be converted.
conversion Required. Integer. The sum of values specifying the type of conversion to perform. `128` is Unicode to local code page (or whatever the optional LCID is)
LCID Optional. The LocaleID, if different than the system LocaleID. (The system LocaleID is the default.)

How to convert Unicode characters to escape codes

So, I have a bunch of strings like this: {\b\cf12 よろてそ } . I'm thinking I could iterate over each character and replace any unicode (Edit: Anything where AscW(char) > 127 or < 0) with a unicode escape code (\u###). However, I'm not sure how to programmatically do so. Any suggestions?
Clarification:
I have a string like {\b\cf12 よろてそ } and I want a string like {\b\cf12 [STUFF]}, where [STUFF] will display as よろてそ when I view the rtf text.
You can simply use the AscW() function to get the correct value:-
sRTF = "\u" & CStr(AscW(char))
Note unlike other escapes for unicode, RTF uses the decimal signed short int (2 bytes) representation for a unicode character. Which makes the conversion in VB6 really quite easy.
Edit
As MarkJ points out in a comment you would only do this for characters outside of 0-127 but then you would also need to give some other characters inside the 0-127 range special handling as well.
Another more roundabout way, would be to add the MSScript.OCX to the project and interface with VBScript's Escape function. For example
Sub main()
Dim s As String
s = ChrW$(&H3088) & ChrW$(&H308D) & ChrW$(&H3066) & ChrW$(&H305D)
Debug.Print MyEscape(s)
End Sub
Function MyEscape(s As String) As String
Dim scr As Object
Set scr = CreateObject("MSScriptControl.ScriptControl")
scr.Language = "VBScript"
scr.Reset
MyEscape = scr.eval("escape(" & dq(s) & ")")
End Function
Function dq(s)
dq = Chr$(34) & s & Chr$(34)
End Function
The Main routine passes in the original Japanese characters and the debug output says:
%u3088%u308D%u3066%u305D
HTH

What's the best option to display Unicode text (hebrew, etc.) in VB6

I have some customers who want to use our speech therapy software in Hebrew.
The programs are in VB6. The best option I'm aware of are:
use the Forms 2.0 controls from MS Office, but you can't distribute them.
http://www.hexagora.com/en_dw_unictrl.asp $899
http://www.iconico.com/UniToolbox/ $499
Any other options?
I found this tutorial very useful. Yes it is partially an ad for another Unicode Control Suite, but it has a lot of information about how to do it yourself and what issues are involved.
EDIT
I knew I had way more on this stored in my bookmarks.
First of all there is an article from Chilkat (another component vendor) about how to use the Font's charset (assuming it is a unicode font) to set different font types (you have to manually change the .frm since charset isn't exposed in the gui). Then all you have to do is convert from AnsiToUTF8 and back to support different languages (that is what Chilkat's control does).
Second, there are the Vesa Piittinen's free (Creative Commons, source included) VB6 controls for download here. They include Textbox, Label, Menu, List, Dialog, CommandButton, Caption (form's caption)). I haven't played with them much, but basically he is doing all the onPaint and the nice thing is that is all done in VB and you can look at the source.
Presumably your users don't have Hebrew selected as the system default code page, otherwise you could just use the native VB6 controls (bearing in mind that Hebrew is right-to-left, obviously!).
Don't use Forms 2 - it will crash your VB6 program. Microsoft Knowledge Base article: "FM20.DLL is known to have many problems when used with Visual Basic and other developer products. Its use is neither recommended nor supported in any Visual Studio product."
I've no personal experience of the others, but your #3 option UniToolbox has been around for years and Google throws up some positive chatter about it on the newsgroups (EDIT - for instance VB6 internationalisation guru Michael Kaplan recommended it in a post in 2004 and a blog post in 2005).
One whacky option is to use API calls with the native VB6 controls - some pointers in Michael Kaplan's excellent book on Internationalization with VB6 and some sample code on his website too. But it would be lots of work. Do buy the book anyway as it's a gold mine of information on international issues in VB6. For instance the sample chapter explains your problems with Hebrew. Look for it secondhand as it's out of print.
Here is all you should need:
Option Explicit
'
Private Type GETTEXTEX
cb As Long
flags As Long
codepage As Long
lpDefaultChar As Long
lpUsedDefChar As Long
End Type
'
Private Type GETTEXTLENGTHEX
flags As Long
codepage As Long
End Type
'
Private Type SETTEXTEX
flags As Long
codepage As Long
End Type
'
Private Declare Function DefWindowProcW Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (Destination As Any, Value As Any)
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal OleStr As Long, ByVal bLen As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SendMessageWLng Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
' The following is from MSDN help:
'
' UNICODE: International Standards Organization (ISO) character standard.
' Unicode uses a 16-bit (2-byte) coding scheme that allows for 65,536 distinct character spaces.
' Unicode includes representations for punctuation marks, mathematical symbols, and dingbats,
' with substantial room for future expansion.
'
' vbUnicode constant: Converts the string toUnicode using the default code page of the system.
' vbFromUnicode constant: Converts the string from Unicode to the default code page of the system.
'
' LCID: The LocaleID, if different than the system LocaleID. (The system LocaleID is the default.)
'
Public Property Let UniCaption(ctrl As Object, sUniCaption As String)
Const WM_SETTEXT As Long = &HC
' USAGE: UniCaption(SomeControl) = s
'
' This is known to work on Form, MDIForm, Checkbox, CommandButton, Frame, & OptionButton.
' Other controls are not known.
'
' As a tip, build your Unicode caption using ChrW.
' Also note the careful way we pass the string to the unicode API call to circumvent VB6's auto-ASCII-conversion.
DefWindowProcW ctrl.hWnd, WM_SETTEXT, 0&, ByVal StrPtr(sUniCaption)
End Property
Public Property Get UniCaption(ctrl As Object) As String
Const WM_GETTEXT As Long = &HD
Const WM_GETTEXTLENGTH As Long = &HE
' USAGE: s = UniCaption(SomeControl)
'
' This is known to work on Form, MDIForm, Checkbox, CommandButton, Frame, & OptionButton.
' Other controls are not known.
Dim lLen As Long
Dim lPtr As Long
'
lLen = DefWindowProcW(ctrl.hWnd, WM_GETTEXTLENGTH, 0&, ByVal 0&) ' Get length of caption.
If lLen Then ' Must have length.
lPtr = SysAllocStringLen(0&, lLen) ' Create a BSTR of that length.
PutMem4 ByVal VarPtr(UniCaption), ByVal lPtr ' Make the property return the BSTR.
DefWindowProcW ctrl.hWnd, WM_GETTEXT, lLen + 1&, ByVal lPtr ' Call the default Unicode window procedure to fill the BSTR.
End If
End Property
Public Property Let UniClipboard(sUniText As String)
' Puts a VB string in the clipboard without converting it to ASCII.
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
'
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Property
Public Property Get UniClipboard() As String
' Gets a UNICODE string from the clipboard and puts it in a standard VB string (which is UNICODE).
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Dim sUniText As String
Const CF_UNICODETEXT As Long = 13&
'
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
iStrPtr = GetClipboardData(CF_UNICODETEXT)
If iStrPtr Then
iLock = GlobalLock(iStrPtr)
iLen = GlobalSize(iStrPtr)
sUniText = String$(iLen \ 2& - 1&, vbNullChar)
lstrcpy StrPtr(sUniText), iLock
GlobalUnlock iStrPtr
End If
UniClipboard = sUniText
End If
CloseClipboard
End Property
Public Sub SetupRichTextboxForUnicode(rtb As RichTextBox)
' Call this so that the rtb doesn't try to do any RTF interpretation. We will just be using it for Unicode display.
' Once this is called, the following two procedures will work with the rtb.
Const TM_PLAINTEXT As Long = 1&
Const EM_SETTEXTMODE As Long = &H459
SendMessage rtb.hWnd, EM_SETTEXTMODE, TM_PLAINTEXT, 0& ' Set the control to use "plain text" mode so RTF isn't interpreted.
End Sub
Public Property Let RichTextboxUniText(rtb As RichTextBox, sUniText As String)
' Usage: Just assign any VB6 string to the rtb.
' If the string contains Unicode (which VB6 strings are capable of), it will be correctly handled.
Dim stUnicode As SETTEXTEX
Const EM_SETTEXTEX As Long = &H461
Const RTBC_DEFAULT As Long = 0&
Const CP_UNICODE As Long = 1200&
'
stUnicode.flags = RTBC_DEFAULT ' This could be otherwise.
stUnicode.codepage = CP_UNICODE
SendMessageWLng rtb.hWnd, EM_SETTEXTEX, VarPtr(stUnicode), StrPtr(sUniText)
End Property
Public Property Get RichTextboxUniText(rtb As RichTextBox) As String
Dim uGTL As GETTEXTLENGTHEX
Dim uGT As GETTEXTEX
Dim iChars As Long
Const EM_GETTEXTEX As Long = &H45E
Const EM_GETTEXTLENGTHEX As Long = &H45F
Const CP_UNICODE As Long = 1200&
Const GTL_USECRLF As Long = 1&
Const GTL_PRECISE As Long = 2&
Const GTL_NUMCHARS As Long = 8&
Const GT_USECRLF As Long = 1&
'
uGTL.flags = GTL_USECRLF Or GTL_PRECISE Or GTL_NUMCHARS
uGTL.codepage = CP_UNICODE
iChars = SendMessageWLng(rtb.hWnd, EM_GETTEXTLENGTHEX, VarPtr(uGTL), 0&)
'
uGT.cb = (iChars + 1) * 2
uGT.flags = GT_USECRLF
uGT.codepage = CP_UNICODE
RichTextboxUniText = String$(iChars, 0&)
SendMessageWLng rtb.hWnd, EM_GETTEXTEX, VarPtr(uGT), StrPtr(RichTextboxUniText)
End Property
Public Sub SaveStringToUnicodeFile(sData As String, sFileSpec As String)
' These are typically .TXT files. They can be read with notepad.
Dim iFle As Long
'
iFle = FreeFile
Open sFileSpec For Binary As iFle
Put iFle, , &HFEFF ' This is the Unicode header to a text file. First byte = FF, second byte = FE.
Put iFle, , UnicodeByteArrayFromString(sData)
Close iFle
End Sub
Public Function LoadStringFromUnicodeFile(sFileSpec As String) As String
' These are typically .TXT files. They can be read with notepad.
Dim iFle As Long
Dim bb() As Byte
Dim i As Integer
'
iFle = FreeFile
Open sFileSpec For Binary As iFle
Get iFle, , i
If i <> &HFEFF Then ' Unicode file header. First byte = FF, second byte = FE.
Close iFle
Exit Function ' It's not a valid Unicode file.
End If
ReDim bb(1 To LOF(iFle) - 2&)
Get iFle, , bb
Close iFle
LoadStringFromUnicodeFile = bb ' This directly copies the byte array to the Unicode string (no conversion).
' Note: If you try to directly read the file as a string, VB6 will attempt to convert the string from ASCII to Unicode.
End Function
Public Function AsciiByteArrayFromString(s As String) As Byte()
' This converts the "s" string to an ASCII string before placing in the byte array.
AsciiByteArrayFromString = StrConv(s, vbFromUnicode)
End Function
Public Function StringFromAsciiByteArray(bb() As Byte) As String
' This assumes that the "bb" array uses only one byte per character and expands it to UNICODE before placing in string.
StringFromAsciiByteArray = StrConv(bb, vbUnicode)
End Function
Public Function UnicodeByteArrayFromString(s As String) As Byte()
' This directly copies the Unicode string into the byte array, using two bytes per character (i.e., Unicode).
UnicodeByteArrayFromString = s
End Function
Public Function StringFromUnicodeByteArray(bb() As Byte) As String
' This directly copies the byte array into the Unicode string, using two bytes per character.
'
' Interestingly, you can assign an odd number of bytes to a string.
' The Len(s) function will not count the last (odd) byte, but the LenB(s) function will correctly report it.
' However, it is advisable to keep the byte array an even number of bytes.
StringFromUnicodeByteArray = bb
End Function
According to KB224305 ("INFO: Usage and Redistribution of FM20.DLL"), you can install the free "Microsoft ActiveX Control Pad", which in turn installs the Forms 2.0 Library.
Maybe this is an option for you.
Charset table from this link
DBCS - Double-Byte Character Set
DBCS is actually not the correct terminology for what Windows uses. It is actually MBCS where a character can be 1 or 2 bytes. To illustrate this consider the following code which will take a Unicode string of English and Chinese characters, convert to a byte array of MBCS Chinese, dump the byte array to the immediate window, and finally convert it back to a Unicode string to display in a Unicode aware textbox. The byte array when converted using Chinese(PRC) LCID = 2052 contains single bytes for the english characters and double bytes for the Unicode characters. This proves that it is MBCS and not DBCS:
Here are some comments about displaying Unicode characters in Microsoft Visual Basic forms using resource (.RES) files:
When I pasted Russian or Japanese characters to Microsoft Visual Basic 6 Resource Editor when creating a resource (.RES) file, the characters would appear as question marks (?) both in MSVB6 Resource Editor and in MSVB6 forms displayed on a computer with Russian or Japanese locale, respectively, using the resource DLL that I built from the RES file through MSVB6.
However, if I added the characters to the resource file by pasting them into Resource Hacker http://www.angusj.com/resourcehacker, the characters still would display as question marks in MSVB6 Resource Editor, but would display correctly on a computer with appropriate locale after I built the resource DLLs through MSVB6.
One can make resource DLLs for each of several languages and use Microsoft's GetUserDefaultLCID or GetUserDefaultLocaleName to decide which to load.