Results 1 to 13 of 13

Thread: [VB6] Unicode classes, functions...

Threaded View

  1. #1

    Thread Starter
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    [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
  •  



Click Here to Expand Forum to Full Width