-
Jun 6th, 2010, 11:41 AM
#1
[VB6] Unicode classes, functions...
This thread is dedicated for stable, tested & known to work solutions for your Unicode needs. This means:- Code should be safe to use in your project. No unexpected crashes caused by the code itself.
- If the feature exists in ANSI (= provided by Microsoft as native VB6 feature or TLB/OCX component), the Unicode version should give the same minimum amount of features
I try to update this first post to keep it up-to-date. There is a lot into Unicode in VB6 and it is most of the time challenging to get it right, but these should provide some simple stuff that helps to get started. The hardest part are the controls and currently I do not know of a free control that wouldn't have issues, thus none listed here.
Classes
Unicode File Open/Save Dialog
Unicode Message Box (note: MsgBox function replacement below)
VB6 native method replacements
Command line parameters
This function is not an exact copy of native Command$: instead it parses the command line parameters and returns a string array. The return value is the number of parameters in the array.
If you want a direct Command$ replacement, have a look in this post for CommandW.
Code:
Option Explicit
Private Declare Function CommandLineToArgvW Lib "shell32" (ByVal lpCmdLine As Long, pNumArgs As Integer) As Long
Private Declare Function GetCommandLineW Lib "kernel32" () As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Ptr As Long, Value As Long)
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Public Function Command(Parameters() As String, Optional EXE As String) As Long
Dim A As Integer, I As Long, Ptr As Long, Pos As Long
If Not Not Parameters Then Erase Parameters
Debug.Assert App.hInstance
Parameters = VBA.Split(vbNullString)
Ptr = CommandLineToArgvW(GetCommandLineW, A)
If Ptr <> 0 And A > 0 Then
GetMem4 Ptr, Pos
EXE = vbNullString
PutMem4 VarPtr(EXE), SysAllocStringLen(Pos, lstrlenW(Pos))
If A > 1 Then
ReDim Parameters(0 To A - 2)
For I = Ptr + 4 To Ptr + (A - 1) * 4 Step 4
GetMem4 I, Pos
PutMem4 VarPtr(Parameters(Command)), SysAllocStringLen(Pos, lstrlenW(Pos))
Command = Command + 1
Next I
End If
LocalFree Ptr
End If
End Function
Form's Caption
Does not work when themes enabled via manifest & only works in XP/Vista/Windows 7, does not work in Windows 2000.
Code:
' this code can be pasted into any Form
Option Explicit
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 Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Public Property Get CaptionW() As String
Dim lngLen As Long, lngPtr As Long
lngLen = DefWindowProcW(Me.hWnd, WM_GETTEXTLENGTH, 0, ByVal 0)
If lngLen Then
lngPtr = SysAllocStringLen(0, lngLen)
PutMem4 ByVal VarPtr(CaptionW), ByVal lngPtr
DefWindowProcW Me.hWnd, WM_GETTEXT, lngLen + 1, ByVal lngPtr
End If
End Property
Public Property Let CaptionW(ByRef NewValue As String)
DefWindowProcW Me.hWnd, WM_SETTEXT, 0, ByVal StrPtr(NewValue)
End Property
MsgBox
No HelpFile & HelpContext support, but adds custom resource icon & owner window support.
Code:
Option Explicit
Private Declare Function MessageBoxIndirectW Lib "user32" (lpMsgBoxParams As Any) As Long
Public Function MsgBox(Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title As String, Optional ResourceIcon As String, Optional ByVal hWndOwner As Long = -1) As VbMsgBoxResult
Dim Params(0 To 9) As Long
If hWndOwner = -1 Then
hWndOwner = 0
If Not VB.Screen.ActiveForm Is Nothing Then
hWndOwner = Screen.ActiveForm.hWnd
End If
End If
If StrPtr(Title) = 0 Then Title = App.Title
If StrPtr(ResourceIcon) Then Buttons = (Buttons Or &H80&) And Not (&H70&)
Params(0) = 40
Params(1) = hWndOwner
Params(2) = App.hInstance
Params(3) = StrPtr(Prompt)
Params(4) = StrPtr(Title)
Params(5) = Buttons
Params(6) = StrPtr(ResourceIcon)
MsgBox = MessageBoxIndirectW(Params(0))
End Function
Tutorials
UTF-8 string conversions
Last edited by Merri; Sep 2nd, 2010 at 11:36 AM.
Reason: LaVolpe pointed out a memory leak bug in Command (did not check whether EXE is empty string or not)
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|