Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all 1544 articles
Browse latest View live
↧

Metafile Graphics for DPI Scaling

September 7, 2016, 1:36 pm
$
0
0
One of the headaches in addressing High DPI issues is the scaling of images within our user interfaces. These are typically small "icon" type images we display in various controls. In many cases we can head the problem off by simply dropping our use of iconic graphics, but in others we want icons for a number of reasons. ListView, TreeView, and similar controls just aren't the same when we limit ourselves to textual captions with no iconic images.

I'm not addressing Shell icons (file icons) here because that's a separate topic and one that metafile graphics can't help. There are other ways to manage scaling for those. I'm also not addressing .ICO format custom icons, which can be managed much like Shell icons and also can't be helped using metafiles.

So instead these are completely custom small images used "iconically" in your programs. Images you might have created a BMP, GIF, or ICO for back in the 96 DPI world.


Vector Graphics

Some people will claim that WMF and EMF (and EMF+) metafiles are "vector graphics" formats. I'm not sure that is accurate, but they are probably the closest thing we have natively in Windows

I see metafiles as really a kind of "GDI macro" that can be "played back" into bitmaps. By nature they have a transparent background unless you use some sort of fill operation to color it in.

Things like the hatch and pattern fills that do not scale at all (and thus are of limited real value) tend to disprove the "vector graphics" assertion for me.


Drawing Metafiles: MakeEMF

I'll focus on Enhanced Metafile (EMF) format here. Windows Metafile (WMF) can still be useful. You can do much the same thing for WMFs with only a few changes here and there to MakeEMF.

Even though EMF format images can have OpenGL and GDI+ drawing within them I am sticking with GDI for simplicity and have not investigated those options much. I'm not sure those work in a StdPicture or with VB/ActiveX controls anyway. I haven't looked into EMF+ format metafiles at all and they might even be more problematic for VB anyway.


Project1

Project1 makes use of MakeEMF.cls, a simple class for creating, drawing, and saving an EMF image to disk or retrieving it as a StdPicture object for direct use in VB.

MakeEMF only implements Ellipse and Line drawing. You could also add Arc, Curve, Rectangle, and more drawing operations, as well as fills and even more.


Name: sshot1.png Views: 47 Size: 4.3 KB

Project1


Project1 itself is a little silly, but just a simple demo. However it does create a simple "saved.emf" that is used in the other Projects.

I haven't seen many meaningful examples of creating and drawing metafile graphics in VB6. If you really want to do this you can probably adapt code from other GDI drawing examples to flesh out MakeEMF's repertoire with additional drawing methods.


MakeEMF: Impractical?

I suspect that it isn't worth the trouble of doing something like this in many programs. This probably explains why so little sample code seems to be floating around. I suppose you could use this as a starting point to make your own metafile graphics drawing utility.

My main direction here is using metafile graphics to address DPI scaling. Most people will probably use an existing 3rd party utility for that.

I tend to fall back on Old Reliable: Windows Draw 6 (originally by Micrografx, who were bought out and then bought out at least a second time). I doubt you can buy a copy anymore, but I have it working in Windows Vista and Windows 10 with only a slight loss in functionality.

I got used to Window Draw long ago, originally getting the Windows 3.1 version bundled with a trackball I bought in the early 1990s.

Since I'm no graphics artist my "tool bag" is pretty limited these days, mainly: IrfanView, MS Paint, IcoFX, and Windows Draw 6. These fit like old shoes aside from MS Paint which got re-boned in Windows 7 resulting in a chaotic and often inscrutable user interface.
Attached Images
 
Attached Files
↧
Search

RTF Label & RTF Button

September 7, 2016, 4:34 pm
$
0
0
The attached project contains an RTF Label and an RTF Button control.

I use these all the time, but I haven't messed with the code in either of them in years.

There are quite possibly better options around, but someone asked for these so I posted them.

One nice feature is that you edit the captions directly over the Label or Button (rather than in the properties window).

Also, once one of these controls is on your form, right-click and then "Edit" it to change the caption. A mini-word-processor will pop up.

Enjoy,
Elroy

p.s. A reference to the Rich Text Box control should be made before you throw these into your project.
Attached Files
↧
↧

Vb6 - simple tcp connect

September 19, 2016, 11:11 am
$
0
0
During the process of trying to figure out NAT Traversal (how to get around the problem of NAT blocking external connections), I had to simplify the process of TCP/IP connections. NewSocket was just too complex to start experimenting with it.

PrjTest3.vbp is a very simple example of connecting to a listening socket, and may help some users to understand how the Socket API (ws2_32.dll) functions in Vista or better operating systems. It does not contain a lot of error handling, it does not work with UDP, it does not work with IPv6, and it does not receive messages.

In the Form_Load event, the Winsock service is started (WSAStartup), and the destination IP Address & Port are defined. In cmdConnect_Click, an IPv4 TCP socket is created using a Socket call (aliased API_Socket). Then the local Socket Address structure (sa_local) is populated. This is where Version 2 of the Socket API differs substantially from Version 1. When using GetAddrInfo, binding to a particular socket is not required. We simply use address 0.0.0.0 and port 0, and GetAddrInfo will consult the local DNS to get the Server information and bind to the socket using the appropriate local interface and the first available local port. Because we are using an IP address instead of a domain name, that trip to the local DNS is not necessary. There will only be one address in the linked list, and we copy that information to the Hints structure. From there, we copy the socket portion to sa_dest. Now we have all the information necessary to send a Connection Request (SYN) to the destination. The destination should respond with a SYN-ACK, and the local socket should send an ACK (this is all handled by the API). Once connected, we send a simple text message.

That is about as far as we can go without implementing a callback procedure to intercept messages from the operating system. NewSocket uses Emiliano Scavuzzo's subclassing technique, which does not cause the IDE to crash and is able to differentiate the individual system messages from each socket. To put a socket into the listening mode is similar, but a little more complex. We have to create a socket, bind it to a user defined listening port, and put the socket into the listening mode with API_Listen. When a ConnectionRequest is received from the other end, the socket is closed, the connection is accepted on a different socket, and the socket once again is placed in the listening mode. This allows the server to accept multiple connections on the same port number. There is one caveat here though. Servers normally use blocking calls (each connection is on a separate thread) to handle large numbers of connections. However, we are using non-blocking calls, and the error WSAEWOULDBLOCK is not uncommon and should be ignored.

J.A. Coutts
Attached Files
↧

[VB6] - Trick Advanced Tools.

September 28, 2016, 12:58 am
$
0
0
Hello everyone!
I present to you a small project - Add-in that allows to some extent alleviate debugging some programs as well expand compilation possibilities. All the source codes are in the attachment.
This Add-in has the following features:
  1. Fixes the bug with Not Not Array statement that causes error "Expression too complex" if you'll work with float numbers;
  2. Allows to utilize the automatic conditional constants depending on run mode (IDE/EXE) look like in C++ (NDEBUG);
  3. Allows to disable integer overflow checking in IDE;
  4. Allows to disable floating point result checking in IDE;
  5. Allows to disable array bounds checking in IDE;
  6. Provides the compilation/linking events (both in IDE and EXE), i.e. you can run the commands before/after this events. By using this events you can do many useful things (encryption, replace OBJ files, static linking, etc.)


How does it work?



For fixing Not Not bug and disabling checking it uses the module of replacing of the opcodes handlers (P_Code) to ours. Firstly it finds the table of the opcodes by the signature in the ENGINE section of VBA6.dll module. There are two opcodes types - single-byte and double-bytes. Teh single-byte opcodes is less that 0xFB. It uses the length dissasembler by Ms-Rem that i ported to VB6. Besides it finds the subroutine that redirectes performing to the next opcode as well the subroutine that handles the errors. Since now it is very easy to get an access violation error i kept some checking. For example, access to uninitialized array causes the memory violation error - it handles that error. Because of there isn't an official documentation about VB6 opcodes (i've not found it) i did all the investigations, therefore some opcodes can raise error. In this case you can write them - i'll add handlers.
For others features it uses splicing of the following functions:
  1. TipCompileProject;
  2. TipCompileProjectFull;
  3. TipMakeExe2;
  4. TipFinishExe2.
TipSetConstantValues/TipGetConstantValues functions are used in order to set/get the conditional compilation arguments. The events is just calling of ShellExecuteEx function. There are events before/after project compilation (IDE/EXE) and linking. This project was weakly testing therefore it can contain bugs.
Regading,
Кривоус Анатолий (The trick)
Attached Files
↧

[VB6] Using IAutoComplete / IAutoComplete2 including autocomplete with custom lists

September 28, 2016, 10:43 pm
$
0
0
IAutoComplete / IAutoComplete2 / IEnumString

SHAutocomplete has many well known limitations, the biggest being if you want to supply your own list to use with it. I was very impressed with Krool's work on this interface, and not wanting to include a whole other TLB set out to do it with oleexp.

Turns out it's far easier to work with using oleexp; the only major limitation being how to go about handling multiple autocompletes with different custom lists. UPDATE: Previously this class couldn't support multiple custom lists for different controls because the v-table swapping method was only passing IEnumString, rather than a full cEnumString class. If it were possible to get the full class, one might expect to be able to just change it to As cEnumString - but that didn't work. However changing it to a Long to get the pointer itself actually produced a pointer to the full instance of the class, and voilà, the undocumented-but-ever-useful vbaObjSetAddRef to the rescue, a reference to the class instance is born!
Code:
'Before:
'Public Function EnumStringNext(ByVal this As oleexpimp.IEnumString, ByVal celt As Long, ByVal rgelt As Long, ByVal pceltFetched As Long) As Long
'now:
Public Function EnumStringNext(ByVal this As Long, ByVal celt As Long, ByVal rgelt As Long, ByVal pceltFetched As Long) As Long
Dim cObj As cEnumString
vbaObjSetAddRef cObj, this
If (cObj Is Nothing) = False Then
    EnumStringNext = cObj.IES_Next(celt, rgelt, pceltFetched)
Else
    Debug.Print "esn obj fail"
End If

End Function
Finally, IAutoCompleteDropdown is used to provide the status of the dropdown autosuggest list. The .DropdownStatus method reports whether it's down, and the text of an item if an item in the list is selected. In the sample project, this is run on an automatically updated timer enabled in the 'basic filesystem' routine. It also exposes the .ResetEnumerator call to update the dropdown list while it's open.

Here's what the code looks like:

cAutoComplete.cls
Code:
Option Explicit

Private pACO As AutoComplete
Private pACL As ACListISF
Private pACL2 As IACList2
Private pACLH As ACLHistory
Private pACLMRU As ACLMRU
Private pACM As ACLMulti
Private pObjMgr As IObjMgr
Private pDD As IAutoCompleteDropDown
Private pUnk As oleexp3.IUnknown
Private m_hWnd As Long
Private pCust As cEnumString

Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long)

Private Sub Class_Initialize()
Set pACO = New AutoComplete
End Sub

Public Sub AC_Filesys(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS)
Set pACL = New ACListISF
pACO.Init hWnd, pACL, "", ""
pACO.SetOptions lOpt
pACO.Enable 1
m_hWnd = hWnd
End Sub
Public Sub AC_Disable()
pACO.Enable 0
End Sub
Public Sub AC_Enable()
pACO.Enable 1
End Sub
Public Sub AC_Custom(hWnd As Long, sTerms() As String, lOpt As AUTOCOMPLETEOPTIONS)
Set pCust = New cEnumString
pCust.SetACStringList sTerms
pACO.Init hWnd, pCust, "", ""
pACO.SetOptions lOpt
pACO.Enable 1
m_hWnd = hWnd
End Sub
Public Sub AC_ACList2(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS, lOpt2 As AUTOCOMPLETELISTOPTIONS)
Set pACL = New ACListISF
Set pACL2 = pACL
If (pACL2 Is Nothing) = False Then
    pACL2.SetOptions lOpt2
    pACO.Init hWnd, pACL2, "", ""
    pACO.SetOptions lOpt
    pACO.Enable 1
    m_hWnd = hWnd
Else
    Debug.Print "Failed to create IACList2"
End If
End Sub
Public Sub AC_History(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS)
Set pACLH = New ACLHistory
pACO.Init hWnd, pACLH, "", ""
pACO.SetOptions lOpt
pACO.Enable 1
m_hWnd = hWnd

End Sub
Public Sub AC_MRU(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS)
Set pACLMRU = New ACLMRU
pACO.Init hWnd, pACLMRU, "", ""
pACO.SetOptions lOpt
pACO.Enable 1
m_hWnd = hWnd

End Sub

Public Sub AC_Multi(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS, lFSOpts As AUTOCOMPLETELISTOPTIONS, bFileSys As Boolean, bHistory As Boolean, bMRU As Boolean, bCustom As Boolean, Optional vStringArrayForCustom As Variant)

  On Error GoTo e0

Set pACM = New ACLMulti
Set pObjMgr = pACM

If bFileSys Then
    Set pACL = New ACListISF
    Set pACL2 = pACL
    pACL2.SetOptions lFSOpts
    pObjMgr.Append pACL2
End If
If bMRU Then
    Set pACLMRU = New ACLMRU
    pObjMgr.Append pACLMRU
End If
If bHistory Then
    Set pACLH = New ACLHistory
    pObjMgr.Append pACLH
End If
If bCustom Then
    Dim i As Long
    Dim sTerms() As String
    ReDim sTerms(UBound(vStringArrayForCustom))
    For i = 0 To UBound(vStringArrayForCustom)
        sTerms(i) = vStringArrayForCustom(i)
    Next i
    Set pCust = New cEnumString
    pCust.SetACStringList sTerms
    pObjMgr.Append pCust
End If

pACO.Init hWnd, pObjMgr, "", ""
pACO.SetOptions lOpt
pACO.Enable 1
m_hWnd = hWnd
  On Error GoTo 0
  Exit Sub

e0:

    Debug.Print "cAutocomplete.AC_Multi.Error->" & Err.Description & " (" & Err.Number & ")"

End Sub

Public Function DropdownStatus(lpStatus As Long, sText As String)
If pDD Is Nothing Then
    Set pDD = pACO
End If
Dim lp As Long

pDD.GetDropDownStatus lpStatus, lp
SysReAllocString VarPtr(sText), lp
CoTaskMemFree lp

End Function
Public Sub ResetEnum()
If pDD Is Nothing Then
    Set pDD = pACO
End If
pDD.ResetEnumerator
End Sub
Implementing IEnumString's functions:
Code:
Public Function IES_Next(ByVal celt As Long, ByVal rgelt As Long, ByVal pceltFetched As Long) As Long
Dim lpString As Long
Dim i As Long
Dim celtFetched As Long
If rgelt = 0 Then
    IES_Next = E_POINTER
    Exit Function
End If

For i = 0 To (celt - 1)
    If nCur = nItems Then Exit For
    lpString = CoTaskMemAlloc(LenB(sItems(nCur)) & vbNullChar)
    If lpString = 0 Then IES_Next = S_FALSE: Exit Function
   
    CopyMemory ByVal lpString, ByVal StrPtr(sItems(nCur)), LenB(sItems(nCur) & vbNullChar)
    CopyMemory ByVal UnsignedAdd(rgelt, i * 4), lpString, 4&
   
    nCur = nCur + 1
    celtFetched = celtFetched + 1
Next i
 If pceltFetched Then
    CopyMemory ByVal pceltFetched, celtFetched, 4&
 End If
 If i <> celt Then IES_Next = S_FALSE

End Function
Public Function IES_Skip(ByVal celt As Long) As Long
If nCur + celt <= nItems Then
    nCur = nCur + celt
    IES_Skip = S_OK
Else
    IES_Skip = S_FALSE
End If
End Function
For the complete code, see the attached project.

Requirements
-oleexpimp.tlb v2.0 - I've forked and continued olelib2.tlb much the same as I did with the original. This new file replaces olelib2 in the same way oleexp3 replaces olelib (you can run search and replace). This file is included in the main oleexp download.
-oleexp3.tlb v3.8 - New version released with this project (29 Sep 2016)

Thanks
Krool's project mentioned above is what inspired me to do this, and I borrowed a few techniques from his project, especially for IEnumString.
Attached Files
↧
↧

Improved circle drawing

September 29, 2016, 7:20 pm
$
0
0
Here's my code for drawing a circle, that has significant improvements over the internal VB6 circle drawing commands.
Code:
Private Sub DrawCircle(ByVal X0 As Long, ByVal Y0 As Long, ByVal Radius As Long, ByVal Color As Long)
    Dim xMax As Long
    Dim Y As Long
    Dim X As Long
    For Y = -Radius To Radius
        xMax = Int(Sqr(Radius * Radius - Y * Y))
        For X = -xMax To xMax
            PSet (X0 + X, Y0 + Y), Color
        Next X
    Next Y
End Sub
The built in DrawWidth property makes a PSet dot bigger, so you can try to draw a circle with it, but it is not even close to being a perfectly symmetrical circle, until it reaches quite large sizes.

The builtin Circle command allows you to make a perfect circle, but the color you set using the color number in the Circle command only effects the circle's outline. To set the interior color of the circle, you have to set the FillColor property in a separate command, and furthermore you need to set the FillStyle to even make the interior of the circle visible (otherwise it's invisible/transparent). So you need to set 2 properties before even running the Circle command, and every time you want to change the color, you need to change the FillColor property.

This DrawCircle method that I created though, makes drawing a perfectly symmetric circle as easy as running one line of code, the code to call the method. All 4 parameters needed to draw the circle are specified at the time of calling the method.

The below sample code shows how to use this method in a MouseDown event in Form1, to make it draw a green circle of radius 10 (center pixel plus 10 pixels out from the center, which some people might call radius 11). The center of the circle will be wherever you click the mouse. Note that ScaleMode property of Form1 should be Pixel (not the default Twip), and that AutoRedraw should be set to True.
Code:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawCircle X, Y, 10, &HFF00&
End Sub
↧

Using OERN (On Error Resume Next)

October 5, 2016, 10:59 am
$
0
0
This isn't any substantial piece of code, but it points out a potential problem I see experienced programmers making on these forums. Also, I must give Bonnie West some credit for pointing this out to me and forcing me to develop a clear understanding of it all.

Let me start by outlining how the three On Error... statements work, which isn't well documented in the MSDN.

On Error Resume Next - Always clears the ERR object upon execution, but leaves results in the ERR object even after end/exit from a procedure call.

On Error Goto LineLabel - Always clears the ERR object upon execution, and the ERR object is also cleared upon end/exit from a procedure call, regardless of whether Resume, Resume LineLabel, or Resume Next is used.

On Error Goto 0 - Always clears the ERR object upon execution.

It's the difference between On Error Resume Next and On Error Goto LineLabel that is often unappreciated. To illustrate, I've set up the following example. Just paste it into Form1's code and execute:

Code:

Option Explicit

Private Sub Form_Load()
    MsgBox SomeTestWithOern_TrueIfError
    Unload Me
End Sub

Private Function SomeTestWithOern_TrueIfError() As Boolean
    Dim i As Long
    Dim b As Boolean
    '
    On Error Resume Next
    i = 1 / 1 ' Does NOT cause error.
    '
    ' Just some other function maybe used herein.
    ' In this example, nothing is done with the return, but it could be.
    b = AnotherTestWithOren_TrueIfError
    '
    ' And now we return, thinking that we've only tested our i = 1/1 line for an error.
    SomeTestWithOern_TrueIfError = Err.Number <> 0
End Function

Private Function AnotherTestWithOren_TrueIfError() As Boolean
    Dim i As Long
    '
    On Error Resume Next
    i = 1 / 0 ' Causes error.
    AnotherTestWithOren_TrueIfError = Err.Number <> 0
End Function
In case you don't want to execute it, the message box reports "True", which is misleading. The SomeTestWithOern_TrueIfError didn't technically have any error. That's the point I'm trying to make.

And now, this can be fixed with the addition of a single line, an "On Error Goto 0" at the end of AnotherTestWithOren_TrueIfErro, as follows:

Code:

Option Explicit

Private Sub Form_Load()
    MsgBox SomeTestWithOern_TrueIfError
    Unload Me
End Sub

Private Function SomeTestWithOern_TrueIfError() As Boolean
    Dim i As Long
    Dim b As Boolean
    '
    On Error Resume Next
        i = 1 / 1 ' Does NOT cause error.
        '
        ' Just some other function maybe used herein.
        ' In this example, nothing is done with the return, but it could be.
        b = AnotherTestWithOren_TrueIfError
        '
        ' And now we return, thinking that we've only tested our i = 1/1 line for an error.
        SomeTestWithOern_TrueIfError = Err.Number <> 0
    On Error GoTo 0
End Function

Private Function AnotherTestWithOren_TrueIfError() As Boolean
    Dim i As Long
    '
    On Error Resume Next
        i = 1 / 0 ' Causes error.
        AnotherTestWithOren_TrueIfError = Err.Number <> 0
    On Error GoTo 0
End Function
This time, the message box reports "False"!!! In fact, I put the "On Error Goto 0" in both test functions, just as good programming practice. Also, just to make sure I always "turn off" my "On Error Resume Next" statements, I've adopted the convention of indenting between them.

Regards,
Elroy

EDIT1: Just as an FYI, even my recommendation isn't a perfect fix because the ERR object is truly a global object. Clearing ERR anywhere clears it everywhere.
↧

[CODE] Responsive applications in VB6 (and immune to resolution changes)

October 22, 2016, 1:35 pm
$
0
0
Make VB6 applications look, feel and work state-of-the-art.

See this video for more:
https://youtu.be/2RPnJotSYj0

I HAVE HEAVILY MODIFIED THE CODE NOT COMPLETELY CODED IT. THE CREDITS CAN BE FOUND BELOW. I HAVE ALSO CONSOLIDATED OTHER PROJECTS TO CREATE A BASIC PACKAGE FOR BEGINNERS THAT WILL MAKE YOUR APPLICATIONS LOOK GREAT.

With the following code, your form controls will automatically resize with the forms and look awesome (The looks have to do with manifests which I have credited below). Also, it is responsive to resolution changes.

To use the source code:
Visit the manifest creator page for instructions on theming.

For the automatic resizing:
Add the module ScalingModule (Module2) to your project.

Then declare in each form:
Private InitialControlList() As ControlInitial

Then insert the following code in all forms to be resized:

Private Sub Form_Load()
InitialControlList = GetLocation(Me)
ReSizePosForm Me, Me.height, Me.width, Me.Left, Me.Top
End Sub

Private Sub Form_Resize()
ResizeControls Me, InitialControlList
End Sub

Play around with the sample project for more! You may need to add a few components/references for it to work. The exe should probably work out of the box (But I can't assure it).

Credits:

I modified (heavily) the inefficient code for resizing form and controls found here:
http://www.dreamincode.net/forums/to...reen-size-vb6/

The manifest creator for better looks:
http://www.vbforums.com/showthread.p...nifest-Creator
(See #79 on page 2 for better code)

A TON of interfaces to make VB6 look better:
http://www.vbforums.com/showthread.p...ary-oleexp-tlb

Taskbar Progressbar Animation:
http://www.vbforums.com/showthread.p...n-taskbar-etc)

Source Codes:

The Project's Source code (all that you saw in the video) can be found here:
http://bit.do/vb6-1-all

Everything except the taskbar integration:
http://bit.do/vb6-1-no-task

Please credit me and the others above!
↧
Search

VB6 Build-in types extension library (FTypes)

October 29, 2016, 3:49 am
$
0
0
This project aim is to extend Visual Basic 6.0 build-in types (like Integer, Long, String and etc.) in order to make work with it more convinient ("one-liner" style if needed) and support extended properties/methods on that basic types.

Classes:

- ArrayEx
- ByteEx
- IntegerEx
- LongEx
- DoubleEx
- StringEx

Sample usage:

Dim s As New StringEx

s = "Hello"

MsgBox s.Clone.Parse(" Hello VBForum ").TrimL.Insert(0, "'").Concat("!!!'").Upper 'produces 'HELLO VBFORUM !!!'

MsgBox s 'produces Hello since Clone was used in first msgbox


Notes:

- Each class has default property Value that is used to assign/read value of appropriate basic VB 6.0 type;
- Each class has Clone method that produces a new instance of class with same value;
- If class function returns same type as class has - that means NO new instanse created (except Clone method) and call modifies initial value assigned at first use of class Value property;

Most valuable features:

- Aim on performance;
- ArrayEx class reports of dimensions, elements size and allows to get pointer of any type of basic array assigned via Value property;
- StringEx class has powerfull Parse method that can get byte arrays and produce utf-16 native VB6 string (f.e. from ansi, utf-8 with/without bom, utf-16 with/without bom/LE/BE text file);
- StringEx class works with dynamically buffered string, so "Concat" and other methods are very usefull within loops (f.e. 'This Is My New Test String' concatenation of 50000 iterations took ~0.37 sec against same VB6 concatenation taking ~23 sec);
- StringEx class has additional methods like Duplicate, Insert & Remove and etc as well as native to a developer Trim, TrimL/R, Replace, Left, Right and etc methods;
- StringEx class exposes a string pointer so you can manipulate it with your own RtlMoveMemory-based routines;
- ByteEx/IntegerEx/LongEx/DoubleEx classes each have Parse method capable to extract numbers from Variant string as well as get value from numeric types directly without overflow;

List of revisions:

29-Oct-2016
- 1.0.0 (with updates)
Attached Files
↧
↧

VB6 Built-in types extension library (FTypes)

October 29, 2016, 3:49 am
$
0
0
This project aim is to extend Visual Basic 6.0 built-in types (like Integer, Long, String and etc.) in order to make work with it more convinient ("one-liner" style if needed) and support extended properties/methods on that basic types.

Classes:

- ArrayEx
- ByteEx
- IntegerEx
- LongEx
- DoubleEx
- StringEx

Sample usage:

Dim s As New StringEx

s = "Hello"

MsgBox s.Clone.Parse(" Hello VBForum ").TrimL.Insert(0, "'").Concat("!!!'").Upper 'produces 'HELLO VBFORUM !!!'

MsgBox s 'produces Hello since Clone was used in first msgbox


Notes:

- Each class has default property Value that is used to assign/read value of appropriate basic VB 6.0 type;
- Each class has Clone method that produces a new instance of class with same value;
- If class function returns same type as class has - that means NO new instanse created (except Clone method) and call modifies initial value assigned at first use of class Value property;

Most valuable features:

- Aim on performance;
- ArrayEx class reports of dimensions, elements size and allows to get pointer of any type of basic array assigned via Value property;
- StringEx class has powerfull Parse method that can get byte arrays and produce utf-16 native VB6 string (f.e. from ansi, utf-8 with/without bom, utf-16 with/without bom/LE/BE text file);
- StringEx class works with dynamically buffered string, so "Concat" and other methods are very usefull within loops (f.e. 'This Is My New Test String' concatenation of 50000 iterations took ~0.37 sec against same VB6 concatenation taking ~23 sec);
- StringEx class has additional methods like Duplicate, Insert & Remove and etc as well as native to a developer Trim, TrimL/R, Replace, Left, Right and etc methods;
- StringEx class exposes a string pointer so you can manipulate it with your own RtlMoveMemory-based routines;
- ByteEx/IntegerEx/LongEx/DoubleEx classes each have Parse method capable to extract numbers from Variant string as well as get value from numeric types directly without overflow;

List of revisions:

29-Oct-2016
- 1.0.0 (with updates)
Attached Files
↧

VB6 - Simple Sock

November 1, 2016, 11:14 am
$
0
0
SimpleSock basically performs the same functions as NewSocket. Like NewSocket, it supports IPv6 as well as IPv4. This more or less restricts it's use to Windows Vista or better, as older operating systems do not support dual stack using "ws2_32.dll". Unlike NewSocket, it cannot be used as a Control Array because of the way it handles listening sockets (more on that later).

While Emiliano Scavuzzo's subclassing technique remains fairly much intact, the rest of the program has been completely rewritten and hopefully simplified. Notifying the Class with the protocol being used (TCP/UDP) is no longer required. Instead there are separate routines to handle each task. Lets take a look at some of the basics.

UDP (User Datagram Protocol)
I started with this one because it is the simplest. UDP is a peer-to-peer protocol, because both parties are equal and either one can initiate the conversation. It is also connectionless. That is to say that data is just sent with no idea if it made it correctly to the other end. The packet size is also very limited (256 bytes). For these reasons, it is rarely used for sensitive bulk data. In the sample program provided, an instance of SimpleSock is created called "mSocket". "mSocket" defaults to IPv4, so if IPv6 is required, you must notify the instance by setting the mSocket.IPvFlg to 6. To initiate a UDP session, you simply call:
Code:
mSocket.UDPInit(Destination, PortConnect, PortLocal)
The Destination Port and the Local Port are required, but if it is not known, the Destination can be left blank. This might be the case if the initial receiver does not know where the first message will be originating from. If blank, the GetAddrInfo function will return the LoopBack address (127.0.0.1 for IPv4 & ::1 for IPv6). You can test this functionality by setting the UDP option and the Local and Destination ports (they can both be the same), and typing a message in the text box followed by an <Enter>. The program will send the message to itself and the sender address (127.0.0.1/::1) will appear in the Destination text box. In the real world however, the sender's IP address will appear in the Destination text box, at which point the user can once again call the UDPInit function to update its information.

So what information gets updated? The first time through, UPDInit creates the socket and binds it to the Local Port. It then creates a "sockaddr" for the destination using GetAddrInfo. The sockaddr structure is the part that gets updated. For those familiar with the original IPv4 structure, it looked like this:
Code:
Private Type sockaddr_in
    sin_family          As Integer  '2 bytes
    sin_port            As Integer  '2 bytes
    sin_addr            As in_addr  '4 bytes
    sin_zero(0 To 7)    As Byte    '8 bytes
End Type                            'Total 16 bytes
or reflected as:
Private Type sockaddr
    sa_family          As Integer  '2 bytes
    sa_data(0 to 13)    As Byte    '14 bytes
End Type                            'Total 16 bytes
When IPv6 came along, this had to be changed to:
Code:
Private Type sockaddr_in6
    sin6_family        As Integer  '2 bytes
    sin6_port          As Integer  '2 bytes
    sin6_flowinfo      As Long    '4 bytes
    sin6_addr          As in6_addr '16 bytes
    sin6_scope_id      As Long    '4 bytes
End Type                            'Total 28 bytes
Private Type sockaddr
    sa_family          As Integer  '2 bytes
    sa_data(0 to 25)    As Byte    '26 bytes
End Type                            'Total 28 bytes
The larger sockaddr is used to carry the information for both IP protocols, with the extra 12 bytes being ignored for IPv4. Because the packet data is of limited length, UDP data is left in the Winsock Buffer and the calling program is informed of it's length. The calling program then recovers the data and empties the Winsock Buffer.

To send data via UDP, we need the Socket Handle, the binary Data and it's length, and the sockaddr and it's length for the destination. The data is passed to the output buffer as string data and converted to byte data, or sent directly to the output buffer as byte data. Providing that the sockaddr has been updated correctly, all the information is available to send back to the other end with a call to mSocket.UDPSend.

TCP (Transport Control Protocol)
The more commonly used protocol is TCP. There are actually 2 types of TCP, because one end acts as the server, and one end acts as the client. Lets look at the client end first, because it is the simpler. We establish a connection with the other end by calling:
Code:
mSocket.TCPConnect(Destination, PortConnect)
We supply the Destination as either an IP address or a domain name, and the destination port as a long variable. GetAddrInfo will find the IP address for a Domain name, provided the name is defined in a DNS host, or it is a local network name. Normally, the Local port is not required, as the API will find the first available port. SimpleSock however does have the ability to use a selected port. If the port selected is not being used, it will bind the created socket to the port. It also eliminates the TIME_WAIT period by setting the options "SO_LINGER" & "SO_REUSEADDR". For reasons unknown, I had to set both these options to achieve the desired result. The API will send out a SYN request to the other end, and wait for a response. If the other end is listening for a connection request, it will send a SYN_ACK back to us. The API will acknowledge this by sending an ACK, and the connection is established. Once the connection is established, a "Connect" event is fired back to the calling program, and data can be sent immediately using "TCPSend".

Receipt of data is similar to UDP, except that SimpleSock removes the data from the Winsock buffer and adds it to it's own buffer. This is necessary because sent records can be quite lengthy, and are received in chunks. What is different about SimpleSock is the provision to handle encrypted data. This is accomplished by using 2 separate event messages (DataArrival/EncrDataArrival) to inform the calling program of data arrival.

To act as a TCP server, the socket is created and bound to the selected port using:
Code:
mSocket.Listen(PortListen)
When a connection request is received from the other end, the API sends an "FD_ACCEPT" message to the "PostSocket" routine. This is where SimpleSock differs from NewSocket and it predecessors. The older programs would create a new socket and a temporary instance of the class to handle it. It would then be registered as an "Accept" item, before firing off a "ConnectionRequest" event to the calling program. The calling program would then close the Listening socket and call the class "Accept" function with the new socket handle. Closing of the listening socket and de-registering it caused the Socket Collection to be destroyed and the Window closed. The new socket would then be registered as a normal socket (causing a new Window and Socket Collection to be created), ownership of the new socket transferred from the temporary Class to the original Class, and the temporary Class destroyed. The calling program would then create a new Listening Socket. If this all sounds very complicated, it was. But it was necessary in order to duplicate the way that the MS Winsock Control handled things when used as a Control Array.

When SimpleSock receives an "FD_ACCEPT" message from an incoming connection attempt, it creates and registers the new socket as it normally would, and leaves the original listening socket intact. It then fires off a "ConnectionRequest" event to the calling program. The calling program then calls mSocket.Accept with the new socket handle. The Accept function saves the listening socket handle, sets a flag, and readies the new socket to receive and send data. If another connection request is received while the new socket is open, it will be ignored because the new socket is not in the listening mode. When the new socket is closed, the listening socket handle will be restored, and another connection request will be entertained.

This simplified approach is only useful when using the SimpleSock Class directly. It will not be effective if it was made into a Control and used as a Control Array. The next step is to make the Class able to handle multiple connections on the same listening port without creating a Control.

J.A. Coutts

Note: When using Link Local IPv6 addresses to communicate with older systems such as Vista, you may have to add the interface (eg. %8) to the IP address.

Note: The sample program is a demonstration program that uses various aspects of the socket function. It may not work properly when switching from one to another. Restart the program to test different functions.
Attached Images
 
Attached Files
↧

[VB6] SAX: Not just for XML

November 7, 2016, 11:32 am
$
0
0
MXHTMLWriter is a handy feature added to MSXML SAX2 in version 6.0, but few have probably heard of SAX and few still of MXHTMLWriter.

See MXHTMLWriter CoClass for an overview.

There are several ways to use MXHTMLWriter but here I'll turn it "inside out" by explicitly raising events to it via IVBSAXContentHandler instead of letting other parts of MSXML raise the events. This is a very basic example showing how to do that to write HTML, and in this case the demo involves simple reporting.

Depending on your purpose you might want the results in different ways. Here I show how to get file output, String output, and Byte array output (since for that we can get UTF-8 or other character encodings).

It should be plenty speedy enough for most purposes:

Name: sshot.png Views: 55 Size: 3.1 KB

Here is the crux of the demo:

Code:
Private Sub Report(ByRef Dest As Variant, Optional ByVal Encoding As String = "ASCII")
    'Dest:    Can be an instance of an IStream implementation or a String.
    '
    'Encoding: Can be "UTF-8" or "Windows-1252" or "UTF-16" etc. as desired.
    '          Always ignored for String output which is always UTF-16
    '          ("Unicode").
    Const REPORT_TITLE As String = "January 2009 Sales"
    Const CSS_STYLES As String = vbNewLine _
        & "*{font:normal normal normal 8pt Arial;}" & vbNewLine _
        & "th,td{border:1px solid black;}" & vbNewLine _
        & "th{background-color:royalblue;color:white;font-weight:bold;}" & vbNewLine _
        & "td{background-color:white;color:green;}" & vbNewLine _
        & "table,th,td{border-collapse:collapse;}" & vbNewLine _
        & ".SH{color:red;}"
    Dim Attrs As MSXML2.SAXAttributes60
    Dim Handler As MSXML2.IVBSAXContentHandler
    Dim Writer As MSXML2.MXHTMLWriter60
    Dim FieldsUB As Long
    Dim Fields() As ADODB.Field
    Dim Col As Long
    Dim Row As Long
    Dim LatitudeField As Long
    Dim Value As Variant

    Set Attrs = New MSXML2.SAXAttributes60
    Set Writer = New MSXML2.MXHTMLWriter60
    Set Handler = Writer
    With Writer
        .disableOutputEscaping = False
        .indent = True
        .Encoding = "ASCII"
        .byteOrderMark = True 'Has no effect for 8-bit encodings or any String output.
        .output = Dest 'Can be an IStream implementation, or a String value to set
                      'the output type to String.
    End With
    With RS
        .MoveFirst
        FieldsUB = .Fields.Count - 1
        ReDim Fields(FieldsUB)
        For Col = 0 To FieldsUB
            Set Fields(Col) = .Fields(Col)
            If Fields(Col).Name = "Latitude" Then LatitudeField = Col
        Next
    End With
    With Handler
        .startDocument
        .startElement "", "", "HTML", Attrs
        .startElement "", "", "HEAD", Attrs 'Auto-emits a META tag for encoding.
        Attrs.addAttribute "", "", "name", "", "generator"
        Attrs.addAttribute "", "", "content", "", App.CompanyName _
                                                & " " & App.EXEName _
                                                & " " & CStr(App.Major) _
                                                & "." & CStr(App.Minor)
        .startElement "", "", "META", Attrs
        Attrs.Clear
        .endElement "", "", "META"
        .startElement "", "", "TITLE", Attrs
        .characters REPORT_TITLE
        .endElement "", "", "TITLE"
        Attrs.addAttribute "", "", "type", "", "text/css"
        .startElement "", "", "STYLE", Attrs
        Attrs.Clear
        .characters CSS_STYLES
        .endElement "", "", "STYLE"
        .endElement "", "", "HEAD"
        .startElement "", "", "BODY", Attrs
        .startElement "", "", "TABLE", Attrs
        .startElement "", "", "TR", Attrs
        For Col = 0 To FieldsUB
            .startElement "", "", "TH", Attrs
            .characters Replace$(Fields(Col).Name, "_", " ")
            .endElement "", "", "TH"
        Next
        .endElement "", "", "TR"
        Do Until RS.EOF
            'Hightlight rows for Southern Hemisphere:
            If Fields(LatitudeField).Value < 0 Then
                Attrs.addAttribute "", "", "class", "", "SH"
            Else
                Attrs.Clear
            End If
            .startElement "", "", "TR", Attrs
                For Col = 0 To FieldsUB
                    .startElement "", "", "TD", Attrs
                    Value = Fields(Col).Value
                    If Not IsNull(Value) Then .characters CStr(Value)
                    .endElement "", "", "TD"
                Next
            .endElement "", "", "TR"
            RS.MoveNext
        Loop
        .endElement "", "", "TABLE"
        .endElement "", "", "BODY"
        .endElement "", "", "HTML"
        .endDocument
    End With
    With Writer
        .Flush
        If VarType(Dest) = vbString Then
            Dest = .output 'Fetch String output.
        End If
    End With
End Sub
The attachment contains some raw data, which is why it is so large.

MSXML 6.0 has been part of Windows since Vista. You might still be able to download a redist version for XP SP2 or maybe SP3 from Microsoft.
Attached Images
 
Attached Files
↧

[VB6, Vista+] Add the Windows Send To submenu to your popup menu

November 30, 2016, 7:28 pm
$
0
0

So at first I set out to just duplicate the functionality, but then immediately saw the FOLDERID_SendTo special folder, and realized that it should be possible to add a fully functional SendTo menu. It's not just creating something similar, it actually implements the same Send To menu you get in Explorer- using shell interfaces to perform the actions the exact same way.

This project is a little high on the complexity scale, but not too bad.

The core parts of the code look like this:
Code:
Public psiSTChild() As IShellItem 'need to store the loaded SendTo items so they can be called when selected
Public Const widBaseST = 2800&
Public widSTMax As Long

Public Function GenerateSendToMenu() As Long
'it's the callers responsibility to call DestroyMenu()
Dim mii As MENUITEMINFOW
Dim i As Long, j As Long, k As Long
Dim hIcon As Long
Dim isiif As IShellItemImageFactory
Dim hMenu As Long
Dim lpCap As Long
Dim sCap As String
hMenu = CreateMenu()
Dim s1 As String, lp1 As Long
Dim psiSendTo As IShellItem
Dim nChild As Long
Dim pcl As Long
Dim penum As IEnumShellItems

On Error GoTo e0

Call SHGetKnownFolderItem(FOLDERID_SendTo, KF_FLAG_DEFAULT, 0&, IID_IShellItem, psiSendTo)
If (psiSendTo Is Nothing) = False Then
    psiSendTo.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, penum
    If (penum Is Nothing) = False Then
        ReDim psiSTChild(0)
        Do While (penum.Next(1&, psiSTChild(nChild), pcl) = S_OK)
            psiSTChild(nChild).GetDisplayName SIGDN_NORMALDISPLAY, lpCap
            sCap = LPWSTRtoStr(lpCap)
            Set isiif = psiSTChild(nChild)
            isiif.GetImage 16, 16, SIIGBF_ICONONLY, hIcon
            With mii
                .cbSize = Len(mii)
                .fMask = MIIM_ID Or MIIM_STRING Or MIIM_BITMAP
                .wID = (widBaseST + j)
                .cch = Len(sCap)
                .dwTypeData = StrPtr(sCap)
                .hbmpItem = hIcon
                Call InsertMenuItemW(hMenu, j, True, mii)
   
                Call DestroyIcon(hIcon)
                j = j + 1
            End With
            Set isiif = Nothing
            nChild = nChild + 1
            ReDim Preserve psiSTChild(nChild)
        Loop
    Else
        Debug.Print "GenerateSendToMenu->Failed to get enum obj"
    End If
Else
    Debug.Print "GenerateSendToMenu->Failed to get SendTo folder obj"
End If
widSTMax = j
GenerateSendToMenu = hMenu
Exit Function
e0:
Debug.Print "GenerateSendToMenu.Error->" & Err.Description & " (" & Err.Number & ")"
End Function
GenerateSendToMenu creates a submenu for a standard API popup menu. The shell items loaded from the SendTo folder are stored in a public array, so we can access them after a selection is made:
Code:
If idCmd Then
    Select Case idCmd
        Case widBaseST To (widBaseST + widSTMax)
            Dim lp As Long
            psiSTChild(idCmd - widBaseST).GetDisplayName SIGDN_NORMALDISPLAY, lp
            If MsgBox("Send to " & LPWSTRtoStr(lp) & "?", vbYesNo, "Confirm SendTo") = vbYes Then
                ExecSendTo (idCmd - widBaseST)
            End If
    End Select
End If
Finally, we use a technique you may recall from my Create Zip Files demo- dropping an IDataObject representing the files we're moving onto an IDropTarget belonging to the destination:
Code:
Private Sub ExecSendTo(nIdx As Long)
Dim pdt As IDropTarget
psiSTChild(nIdx).BindToHandler 0&, BHID_SFUIObject, IID_IDropTarget, pdt
If ((pdt Is Nothing) = False) And ((pdoFiles Is Nothing) = False) Then
    Dim dwEffect As Long
    dwEffect = DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK
    pdt.DragEnter pdoFiles, MK_LBUTTON, 0&, 0&, dwEffect
    pdt.Drop pdoFiles, MK_LBUTTON, 0&, 0&, dwEffect
End If
End Sub
As an added bonus, picking the files with IFileOpenDialog makes it super-easy to get the IDataObject for the files, pdoFiles.
Code:
Dim fod As New FileOpenDialog
Dim psiaRes As IShellItemArray
With fod
    .SetOptions FOS_ALLOWMULTISELECT Or FOS_DONTADDTORECENT
    .SetTitle "Choose files for SendTo..."
    .Show Me.hWnd
    .GetResults psiaRes
    If (psiaRes Is Nothing) = False Then
        psiaRes.BindToHandler 0&, BHID_DataObject, IID_IDataObject, pdoFiles
    End If
End With
Requirements
-Windows Vista or newer
-oleexp.tlb v4.0 or higher (only for IDE, doesn't need to be included with compiled exe)
-mIID.bas - included in the oleexp download

Extra Thoughts
Generate IDataObject from file list
If you want to get an IDataObject but just have a list of file paths, you can do it like this, where sSelFullPath is a string array of full paths to the files:
Code:
Public Declare Function SHCreateShellItemArrayFromIDLists Lib "shell32" (ByVal cidl As Long, ByVal rgpidl As Long, ppsiItemArray As IShellItemArray) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long


Dim psia As IShellItemArray
Dim pdoFiles As oleexp.IDataObject
Dim apidl() As Long
Dim i As Long

ReDim apidl(0)
For i = 0 To UBound(sSelFullPath)
    ReDim Preserve apidl(i)
    apidl(i) = ILCreateFromPathW(StrPtr(sSelFullPath(i)))
Next i
Call SHCreateShellItemArrayFromIDLists(UBound(apidl) + 1, VarPtr(apidl(0)), psia)
psia.BindToHandler 0&, BHID_DataObject, IID_IDataObject, pdoFiles
Customizing the enumeration
Say, for example, you want to override the user preference for hidden files (in the pic up top, Desktop.ini is shown because my system is set to show all hidden/system files). There's two ways go about this. If you're targeting only Windows 8 and above, you can play around with the wonderful world of the IBindCtx parameter with STR_ENUM_ITEMS_FLAGS
Windows Vista and Windows 7 however, you're going to have to drop down to IShellFolder and use the .EnumObjects SHCONTF options. Doing it in VB with oleexp requires far less code than Raymond uses, if anyone is really interested I could write up the VB code.
Attached Files
↧
↧

[VB6] SHBrowseForFolder - Custom filter for shown items: BFFM_IUNKNOWN/IFolderFilter

December 1, 2016, 5:04 pm
$
0
0

It's possible to have complete control over what items are shown in the SHBrowseForFolder dialog. The picture above shows a filter of *.exe applied to a dialog with the BIF_BROWSEINCLUDEFILES option, but you can filter in a wide variety of ways as the IShellFolder and pidl for each item is passed, allowing you to get the name and compare by string and properties, as in the demo, or anything else you could want. The project notes where you could even filter by SHCONTF options.
This is accomplished through the BFFM_IUNKNOWN message that is received in the callback function. A lot of places have mentioned what it's for, but I wanted to show the actual details of using that message to set up a filter.

First, you create a class module that implements the IFolderFilter interface and create an instance of it before calling the dialog. The GetEnumFlags method is where you can filter by SHCONTF, but this demo is mainly concerned with examining each item in the ShouldShow method. Whether to show the item or not is based on the return code, so the class module function is swapped out to a function in the module. Here's the demo filters files, but not folders, according to the pattern specified in the text box:
Code:
Public Function ShouldShowVB(ByVal this As IFolderFilter, ByVal psf As IShellFolder, ByVal pidlFolder As Long, ByVal pidlItem As Long) As Long
Dim psi As IShellItem
Dim lpName As Long, sName As String
Dim dwAtr As Long
On Error GoTo e0

SHCreateItemWithParent 0&, psf, pidlItem, IID_IShellItem, psi
If (psi Is Nothing) = False Then
    psi.GetAttributes SFGAO_FILESYSTEM Or SFGAO_FOLDER, dwAtr
    If ((dwAtr And SFGAO_FILESYSTEM) = SFGAO_FILESYSTEM) And ((dwAtr And SFGAO_FOLDER) = 0) Then 'is in normal file system, is not a folder
        psi.GetDisplayName SIGDN_PARENTRELATIVEPARSING, lpName
        sName = LPWSTRtoStr(lpName)
        Debug.Print "ShouldShow?" & sName & "|" & gSpec
        If PathMatchSpecW(StrPtr(sName), StrPtr(gSpec)) Then
            ShouldShowVB = S_OK 'should show
        Else
            ShouldShowVB = S_FALSE 'should not show
        End If
    End If
Else
    Debug.Print "ShouldShow.NoItem"
End If

Exit Function
e0:
Debug.Print "ShouldShowVB.Error->" & Err.Description
End Function
Now that the filter object and routine are good to go, it needs to be assigned to the dialog. When the BFFM_IUNKNOWN message fires, the lParam contains a pointer to an IUnknown object which implements IFolderFilterSite, which contains the call to assign our filter class. If the messages fires but the object is Nothing, the filter class needs to be released and reset, otherwise a subsequent call to SHBrowseDialog won't be filtered.
Code:
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Dim pSite As IFolderFilterSite
Dim pUnk As oleexp.IUnknown

Select Case uMsg

    Case BFFM_IUNKNOWN
        'lParam contains a pointer to an IUnknown that implements IFolderFilterSite
        Debug.Print "Received BFFM_IUNKNOWN"
        vbaObjSetAddRef pUnk, lParam
        Debug.Print "Set obj"
        If (pUnk Is Nothing) = False Then
            Set pSite = pUnk
            If (pSite Is Nothing) = False Then
                Debug.Print "Setting filter"
                pSite.SetFilter cFilter
                Debug.Print "Filter set"
            Else
                Debug.Print "Failed to set pSite"
            End If
        Else
            Debug.Print "Failed to set pUnk"
            Set cFilter = Nothing
        End If
End Select
End Function
And that's about it. The rest is just calling the dialog like normal (+making a new instance of the cFolderFilter class first).

Requirements
-The demo project requires Windows Vista or newer, although it could theoretically be reworked to support XP.
-oleexp 4.1 or newer (this project requires a bug fixed only in 4.1, not 4.0)
-mIID.bas (included in the oleexp download)
Attached Files
↧

Resizeable VB6 UserForms (and Unicode Form Captions)

December 4, 2016, 8:56 am
$
0
0
This system uses a small amount of code in a form module plus a small class module shared by all of your forms to enable you and the user to be able to move and size any form and have all of the controls on the form resize properly. In summary:


  • Form and control resizing is available (including use of the maximize button) all of the time for all new and existing forms. This requires 2 variable declarations and 4 lines of code in each form.
  • The programmer has control over whether resize is allowed, what controls will resize, whether the form retains its height to width ratio as it resizes, etc.
  • Form sizing routines are available to make a form a certain percentage of the screen size, regardless of the screen resolution and size.
  • A form can be maximized without getting distorted.
  • A form’s last size and position can be saved and then restored the next time the form is used. This data can be saved to a file or to the registry. This takes only 10 lines of code for each form.
  • As a bonus, you can now easily set the form title (caption) with any Unicode string you want.
  • Minimal use of Windows API (2 calls).



Class Module

In a form that you want to be resizable you should put the following code (cut and paste if necessary). There are more optional things you can add that will be discussed later but the simplest code to provide comprehensive resizing requires only the following a few lines of code in your form (not clResizer):

First, ensure that the BorderStyle property of the form is set to “2 – Sizable”.

In the declaration section which is below the Option Explicit statement (which you definitely should be using):

Code:
Private frmResize As New clResizer
Public UniCaption As String
Then if you have a Form_Load procedure (if not, make one), put this line in it:

Code:
frmResize.NewSetup Me ' put after any form setup code in this subroutine
That’s all that is required to have form resizing that also makes all of the controls on your form resize along with the form and to prevent everything on the form from being distorted by keeping the form’s height/width aspect ratio the same as the original form.

Normally you will want the form to appear in the same size and position on the user’s screen each time the form is displayed. We will cover various other options later but to have automatic save and restore of your form’s size and position, modify the Form_Load routine as shown below and modify or add the Form_Unload routine as shown below.

Code:
Private Sub Form_Load()
frmResize.NewSetup Me ' put after any form setup code in this subroutine
If frmResize.GetFormParmsFromFile(App.Path) = 0 Then ' specify "" to read from the registry
  ' either first time through (file does not exist) or had read error
  frmResize.CenterForm 30, 30, True ' center form on screen and make 30% the width of screen
  frmResize.MoveForm 5, 5, False
  End If
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
' put any other code you need to save data from the form here
If Not Cancel Then
  ' This is our last shot at the form before unloading. It is possible that you
  '  have code to just hide the form and in that case we don't need to save the
  '  form settings because sometime later before the program ends this Form_Unload
  '  routine will be called.
 
  ' Don't write to App.Path in a real EXE, Windows no longer allows writing files
  ' to the Program Files folders
  frmResize.SaveFormParms2File App.Path ' specify "" to write to the registry
  End If
End Sub

Displaying a Unicode Caption

There are several peope and companies who provide Unicode controls to put onto a Form but there is no native way of putting a Unicode title on the base Form itself. This is especially frustrating since VB6 deals with Unicode directly. The problem is that the IDE editor doesn’t do Unicode nor does the code that sets up the form when it is displayed. There is now a public variable in each form called UniCaption. If you set this variable to any string then when the form is displayed UniCaption will be the form caption instead of whatever was used previously as Form.Caption. If you leave this variable blank then whatever you had set as the Form.Caption is used for the Form caption.

Suppose you have a form named fmTestMe. Suppose you want the string “あいうえお Caption” to be displayed as the caption of fmTestMe. If it never changed you could put the following line in the Form_Load sub of the form:

Code:
UniCaption = ChrW$(&H3042) & ChrW$(&H3044) & ChrW$(&H3046) & ChrW$(&H3048) & _
ChrW$(&H304A) & " Caption"
Alternatively, you can set the variable from a normal module or another class module or form by specifying the form name (the following snippet assumes the form name is TestForm):

Code:
TestForm.UniCaption = ChrW$(&H3042) & ChrW$(&H3044) & ChrW$(&H3046) & ChrW$(&H3048) & _
ChrW$(&H304A) & " Caption"
If the value of UniCaption is set before anything else is done with the form then the code you put in the Form_Load routine that calls NewSetup not only sets the size and location of your form, it also takes the value for UniCaption and sets the form caption with it.

But suppose you want to change the caption one or more times after it has been displayed. First, put the following simple routine in your form code so you can get to the variable and procedure in the class module:

Code:
Public Sub SetUnicodeCaption(Caption As String)
UniCaption = Caption
frmResize.ShowUniCap
End Sub
And then whenever you want to change it after the form has been displayed you would call it like this (if the form name was TestForm and the new Caption string was the variable MyNewCaption):

TestForm.SetUnicodeCaption(myNewCaption)


Form Design Considerations

Fonts

Since the objective of this system is to enable making your forms larger and smaller with corresponding change in the size and fonts of each control, you should avoid the use of raster fonts in your forms since these scale extremely poorly. Typical Windows raster fonts include:

8514oem Regular
ADMUI3Lg Regular
ADMUI3Sm Regular
Courier Regular (there is a TrueType version called Courier New that is okay)
Fixedsys Regular
Modern Regular
MS San Serif Regular (this is the VB6 standard font)
MS Serif Regular
Roman Regular
Script Regular
Small Fonts Regular
System Bold
Terminal

List/Combo Boxes
Drop-down boxes appear to size properly. If you use a list or combo box that shows more than one items at a time, it is possible that as you resize the form the text at the bottom gets dropped off and a vertical scrollbar appears. That’s because these controls size their own fonts based on the vertical size of the box. I have rarely seen this behavior be any problem but when I did I just set the control’s IntegralHeight property to False and gave a tiny bit more room at the bottom of the control.

Setting the Form’s Initial Size and Position

Below are some techniques for setting the initial position of the form. My recommendation is to initially put the form on the same screen as VB and since it is resizable and moveable the user will put it wherever it works best and then we will save and restore that size and position for future re-use.

Because of the way forms work, once it is displayed the programmer has little control over the position of the form. Generally you will be more concerned about what the user does to items on the form and you won’t be too worried about where the form is or how large it is as long as the user can put it wherever he/she likes and can make it as large or small as desired.

Programatically we can respond to the Resize event (which we already do) but that is largely driven by the user who is resizing the form. I suppose you could catch this re-sizing event and do something different but I don’t know what. There is no easy way to catch a Move event and the whole purpose of this system is to let the user move the form and re-size as he/she sees fit. So this means that in general we would want to move and or re-size the form just before it is being displayed via the Form.Show command.

You can put code in the Initialize event for the form but keep in mind that at this point we have not yet had Windows make the form resizable so any attempt to resize the form will not work. Also, if you try something like the following in another module it will not work either:

Code:
fmTestMe.CenterForm(50, 50, True)
fmTestMe.Show
Anything in a normal module before the Show command basically causes the Initialize event to fire and our code will be executing before the Windows call to enable resizing. The resizing code is called in the Load event which is after Initialize and just before the form is displayed.

The only way I know of to get code to affect the form after the Show statement is if the form has been Hidden instead of Unloaded.

My recommendation is to decide what you want to do regarding the form size and location and put the code to do this in the Load event procedure in the code for the Form. You have 3 routines you in the Class module for form location that enable you set the size and position to be centered or anywhere on the screen and with little effort you can derive many others. The code to access these 3 routines will need to be in your Form module code.

Code:
Sub CenterForm(WidthPerCent As Single, HeightPerCent As Single, Limit2Screen As Boolean)
This class module sub enables you to center and optionally resize the form.


  • To size the form based on the available screen width and height
    • WidthPerCent and HeightPerCent are the %'s of the screen width and height respectively
    • To make a form fill up half of the screen width regardless of the screen size and resolution you would specify the following in the form’s Load procedure:


Code:
frmResize.CenterForm 50, 50, True
  • Note – As long as Zoomable is True (default), the setting for HeightPerCent is ignored because the code determines the required height to keep the height/width ratio constant.





  • To size the form based on the original size of the form
    • WidthPerCent and HeightPerCent are based on the original form size but negative
    • To make a form be twice the size of the original form you would specify the following in the Load procedure of your form:


Code:
frmResize.CenterForm -200, -200, True  ' for 200% but negative
  • Note – As long as Zoomable is True (default), the HeightPerCent parameter is ignored.


  • If limit2Screen is True then the form size is adjusted as necessary to keep it all onscreen.



Code:
Sub MoveForm(WidthPerCent As Single, HeightPerCent As Single, Limit2Screen As Boolean)
This class module sub enables you to move the form and optionally keep it onscreen.


  • To move the form based on the available screen width and height
    • WidthPerCent and HeightPerCent are the %'s of the screen width and height respectively
    • To make a form’s upper left corner go to the middle of the screen regardless of the screen size and resolution you would specify the following in the form’s Load procedure:


Code:
frmResize.MoveForm 50, 50, True
  • Note – As long as Zoomable is True (default), the setting for HeightPerCent is ignored because the code determines the required height to keep the height/width ratio constant.



  • To move the form to the specific left and top coordinates
    • WidthPerCent and HeightPerCent are the specific form position values for Left and Top
    • To make a form go to the top left of the screen you would specify this in the Load procedure:


Code:
Frmresize.MoveForm 0, 0, True
  • Note – As long as Zoomable is True, the HeightPerCent parameter is ignored.


  • If limit2Screen is True then the form size is adjusted as necessary to keep it all onscreen.


So if we wanted to make our form be 65% the width of the screen (whatever that may be) and also displayed with the upper left corner 5% of the screen width and height from the screen’s upper left corner we could have a Form_Load routine that looks like this:

Code:
Private Sub Form_Load()
frmResize.NewSetup Me
frmResize.CenterForm 65, 65, True ' center form on screen and make 65% the width of screen
frmResize.MoveForm 5, 5, False
End Sub

Continued below...
Attached Files
↧
Search

VB6 - NAT Traversal

December 5, 2016, 11:33 am
$
0
0
A NAT router is an excellent way to protect your computer network from outside hackers. The normal way to allow an outside host to connect with an internal host sitting behind a NAT router is to manually add a port forwarding address to the router setup. Setting up a router is not a simple task for the average user, and some routers have restricted access (especially public WiFi routers). To understand how to allow a host to connect with your program through a NAT router without adjusting the router setup, you must first understand how a NAT router works. Since we are interested in TCP connections, we will restrict our discussion to this type of connection.

All outbound connection requests (SYN request) are allowed through the router. At this point, the connection and it's translation are added to a NAT table. Your computer initiated the request using it's private IP address (eg. 192.168.1.5) and it's first available port (eg. 50342). The NAT router does the same thing. It uses the public address (eg. 201.34.87.52) and it's first available port (eg. 54671) and translates the outbound request to use these values. The other end only sees the router values. It never sees the values that your computer used. The values added to the NAT table on a SYN request include all 4 values:
Private IP Private Port Public IP Public Port
192.168.1.5 50342 201.34.87.52 54671
Most routers will allow about 60 seconds for this initial connection request to be acknowledged. Otherwise, it times out and is removed from the table. The connection acknowledgement (SYN-ACK) from the other end is received by the router, translated back to the private values, and forwarded to your computer. Once the connection is established, the inactivity timeout is much longer (say 24 hours), but will vary with the router.

So to traverse a NAT router without changing it's settings, we must create the NAT table entry and then connect to it before it times out. To accomplish this, we use a third party server which supplies the connecting IP address and port. Seems simple enough, but there is a complication. TCP standards do not allow us to share a port. So we will just close the existing connection and open it again with the same port number. There are 2 problems with this approach. One is that there is a TIME_WAIT after a connection is closed, which is to allow for straggling packets to be received.The other issue is that the newer versions of Microsoft sockets don't allow us to pick and choose the internal port number on a TCP connection request. It automatically chooses the first available port. So I set out to find a resolution to these issues.

To enable each side to connect to each other, we must kill the connection to the server without leaving the socket in a TIME_WAIT state. To do this, we set the "SO_LINGER" & "SO_REUSEADDR" options when we connect to the server. When we receive instructions from the server with the IP address & port number of the other end, we kill the existing socket and initiate a connection request using the same local IP address and port to the remote IP address and port. That creates a temporary NAT Table entry in the router.

When both sides are connected to the server, the server sends to each side the IP and port from the other side. Both ends will kill the existing socket that connects it to the server, create a new socket on the same local IP & port, and send a connection request to the other end. Don't ask me how this works, but the first one to receive the SYN request sends a SYN-ACK to the other end. This is enough to establish a connection and extend the timeout on the NAT router. Both ends will just have a connected socket (no listening socket).

So why are we going to this length to establish a connection? We want to allow a direct connection between 2 parties without the necessity of having the server forward all the information from both ends (as in a proxy server). The only purpose of the server is to supply the necessary information to establish that connection. Once directly connected, the entire session can be encrypted, and the server has no record of it.

The attached programs (NAT.vbp & Server.vbp) allow us to test this functionality. The server is set up to listen on port 24 using "SimpleServer.cls". Being a server, firewalls and routers must be setup to allow outside connections on port 24. To test "NAT.vbp", I added a NAT router between one of my computers and the local network, and a different NAT router to a second computer. This created a double NAT situation between these 2 particular computers, but a single NAT between each computer and the rest of the local network. The server program (Server.vbp) I set up on the local network. That left all 3 computers on separate networks. As each Nat.vbp connects to the server program, the server will display the connecting IP address and port. Machines operating from behind a NAT router will display the IP address and port of the NAT router public interface, instead of the computer's local IP address and port. Then the Trigger button on the server was clicked to send instructions to the 2 test computers. It took about 1 second for the connection to be established between the 2 test computers.

I had a great deal of difficulty getting this to work because of the vintage of one of the routers. Most routers will assign the same public port to a connection when it is using the same Private IP address and port. The older router however incremented the Public port number with each connection. I got around this problem by adding 1 to "sAddr" in the "SndConnect" routine of the machine behind the newer router.
Code:
mSocket.TCPConnect(sAddr, lPort + 1, PortListen)
You can test how your own router behaves by connecting to the server program from behind the router and noting the port number displayed in the TextBox on the server. Then disconnect and connect again. It should be the same each time.

J.A. Coutts
Attached Images
 
Attached Files
↧

Compression in VB6: modern solutions

December 10, 2016, 7:59 am
$
0
0
Compression has never been an easy task for VB developers. Until Windows 8, Microsoft provided very little support for it, and while 3rd-party solutions have long been available, they tend to be either very expensive or very complicated.

For many years, VB6 developers fell back on the classic zLib compression library (http://zlib.net/). zLib is an open-source compression library with a very permissive license, and it is "good enough" for most tasks: decent compression ratios, but with relatively slow compression and decompression speeds.

But in recent years, even zLib has become problematic. The stdcall variant of zLib (usable from VB6) hasn't been updated in over a decade, meaning it contains serious known security bugs. You can always compile your own version of zLib from the latest source code, but the core library definitions are bugged, so this requires a fairly deep knowledge of C and a lot of patience. (Also, zLib's source code hasn't been updated in over three years, and there are a huge number of bug fixes that have yet to be incorporated.)

And even if you do manage to survive all this and successfully build an up-to-date version of zLib, you're still left with compression technology that is now 20+ years old. A great deal of compression research has been done since 1995 (when zLib first released), and there are now open-source libraries that are both much faster than zLib, and with even better compression ratios.

So here's what this small project does: it provides a "Compression" module that wraps four different open-source compression libraries: zLib, zstd, lz4, and lz4_hc. If you're on Windows 8 or newer, it also wraps the four compression algorithms provided by the Windows Compression API. All compression/decompression functions are unified so you simply call a function like "Compress", and pass a "compression library enum" that specifies which compression engine you want to use.

To simplify this demo, precompiled DLLs are provided for each 3rd-party library. Because the 3rd-party libraries are all open-source projects (links to code below), I believe these still meet the vbforums requirements for precompiled binaries. You are of course free to compile these yourself, from the latest source code, but you will need a modern copy of Visual Studio, some knowledge of compiling C code, and you must manually modify the project files to build stdcall variants. (They all default to cdecl, as-is.)

Note that the 3rd-party DLLs are all bare C libraries, so they do not need to be registered on target PCs. Simply ship them in a subfolder of your project - for example, this demo project uses a "\Plugins\" subfolder, and the DLLs are all loaded at run-time via LoadLibrary.

As for the Windows Compression APIs - they are not redistributable, so your clients can only use if they're on Windows 8, 8.1, or 10. I imagine this greatly limits their usefulness for most developers. Sorry. :(

Here is a brief overview of the supported compression libraries, all of which are 100% open-source and free to use in personal or commercial projects (with attribution - see the included license files for details).

- zLib is the classic library you know and love. I've freshly compiled the "newest" version (v1.2.8) for this demo. Despite its age, zLib remains a solid general-purpose compression library, with good compression ratios across a wide variety of data, but with slow compression speeds compared to the competition. zLib supports a "compression level" parameter that allows you to choose a trade-off between faster but worse compression, or slower but better compression. Generally speaking, there is no longer much reason to use zLib, unless you specifically need the DEFLATE algorithm it provides (e.g. to work with .gz files).

- zstd (or "zstandard") is a modern replacement for zLib. It was originally developed by Yann Collet, and its ongoing development is now sponsored by Facebook. It is 100% open-source and BSD licensed. zstd is significantly faster than zLib at both compression and decompression, and it also achieves better compression ratios. It provides a "compression level" parameter just like zLib, but with a much wider range, including extremely slow speeds but extremely good compression ratios if you need that sort of thing. For most users, zstd could replace zLib in their existing projects, and they'd immediately get a "free" performance boost from it.

- lz4 is a real-time compression engine that emphasizes performance above all else. It was also developed by Yann Collet, and it is also 100% open-source and BSD licensed. lz4 is so fast that it is now used for OS-level compression (Linux), file system compression (OpenZFS, SquashFS), database compression (MySQL), RAM caching (Emscripten, ZRam), and a whole bunch of video games (Battlefield 4, Black Ops 3, etc). LZ4's speed comes at a trade-off, however - it does not compress as well as zLib or zstd on most data. It also provides an adjustable "compression level" parameter, but instead of providing "slower but better" compression as you increase this value, lz4 provides "faster but worse" compression. It is the best solution when speed is paramount. (For example, lz4 is one of the few algorithms fast enough to provide a performance benefit vs raw uncompressed data when reading/writing to a hard drive.)

- lz4_hc comes "for free" with lz4. It is a "high-compression" variant of lz4, with much better compression ratios but much slower compression speeds. Decompression speed remains the same. It is a good solution if you have all the time in the world for compression, but you still require very fast decompression. (This is the version that video games use, for example.)

- The Windows Compression API available in Windows 8+ provides four different compression algorithms: MSZIP, XPRESS, XPRESS_HUFF, and LZMS. The pros and cons of each algorithm are described on MSDN. Unlike the 3rd-party libraries, these algorithms do not support variable compression levels, so you are always stuck with the default behavior.

The included demo project allows you to compare compression speed, decompression speed, and compression ratio across all libraries. A baseline comparison of "no compression" is also provided, which measures timing against bare RtlMoveMemory calls. I've included a few multilanguage XML files for comparison (because they're small enough to fit inside vbforum size limits), but for best results, you should test some of your own files. Just drag-and-drop a file onto the project window to run an automated test across all libraries.

Name: Compression_results.jpg Views: 212 Size: 49.9 KB

Checkboxes allow you to toggle various test settings. Note that by default, libraries are tested at their default compression level. Different libraries default to different settings - for example, zLib defaults to a "good but slow" setting, while zstd defaults to its "fastest possible" setting - making comparisons somewhat tricky. To help remedy this, I've provided a checkbox that automatically tests each library at its minimum, maximum, and "middle" settings. This gives a good overview of what each library is capable of.

At present, the Compression module operates entirely on byte arrays and/or bare pointers (passed using VarPtr()). This makes it trivial to compress source data of any size or type. Specialized functions for Strings or other data types could always be added, but for now, those are left as an exercise to the reader.

Bug reports and feedback welcome, of course. Thank you to everyone who has contributed feedback so far.

Updates:
Code:
12 December 2016: fixed text box scroll behavior in test program.
                    (Thank you to Steve Grant for reporting.)
                  Added functions to report each library's default, minimum, and maximum compression settings. 
                  Also updated the test framework to let you test these settings. 
                    (Thank you to Arnoutdv for the suggestion.)
                  Added support for the Windows Compression API, available on Win 8 or newer. 
                    (Thank you to dilettante for the idea.)
11 December 2016: recompile liblz4.dll to fix issues on old OS versions. 
                    (Thank you to Steve Grant for reporting.)
10 December 2016: initial release
Download here:
Attached Images
 
Attached Files
↧
↧

Custom Scrollbar (vbRichClient)

December 22, 2016, 8:30 am
$
0
0
As requested here http://www.vbforums.com/showthread.p...using-Pictures

This is a custom scrollbar class that requires only to be given a reference to a picture box, as illustrated in this demo. The same class supports both horizontal and vertical orientations.

It is 99% compliant to a regular scrollbar; the ony real exception is that it's Change and Scroll events also report the current value of the scrollbar. In the case of the latter, it actually reports an exact value (e.g. 6.72, rather than 7), which can be useful for smooth-scrolling type effects. Or you can just use Round(ExactValue) in the event handler if you prefer to not have this level of precision.

Requires a reference to Olaf's vbRichClient5.dll
Attached Files
↧

[VB6] ListView / TreeView Extended and Custom Checkboxes

December 28, 2016, 5:15 pm
$
0
0

So I've mentioned this and posted snippets in a few threads, but thought it would be good to do a formal sample project on this, especially since I've never seen one done before.

By default, the ListView and TreeView controls, whether it's from the OCX or manually created, only has the basic checked or unchecked state. But what if you want to add the Partial check state? Or even more? Or customize the regular checked and unchecked look? Most of the time people jump to owner draw, but there's a much simpler way: checkboxes are simply an imagelist, so all you have to do is create your own and assign it just like you do for the regular icons, no owner drawing required. The ListView/TreeView even manages the number of checkboxes for you; no special code is required to cycle through all the checkboxes then loop back to the beginning. There's 8 different checkboxes in the sample project, I'm not sure what the limit is but you almost certainly won't hit it.

The only thing that makes this even a little complex is that you have to drop down to the API level to set the imagelist, and subclass it just to prevent VB from accidentally removing the imagelist. The good news though is that it's entirely possible to do it with the regular Common Controls 5.0 ListView/TreeView control, which is what the sample project uses.

The new checkboxes are stored in a resource file and accessed from there, but I've also included the .ico's as normal files in the zip.

How it works

First we create a new API ImageList with our new checkboxes:
Code:
Dim hIco As Long

himlCheck = ImageList_Create(32, 32, ILC_COLOR32 Or ILC_ORIGINALSIZE, 1, 1)
ImageList_SetIconSize himlCheck, 16, 16
hIco = ResIconTohIcon("CHK_STD_UNCHKD", 16, 16)
Call ImageList_AddIcon(himlCheck, hIco)
Call DestroyIcon(hIco)
'rinse and repeat for all other checkboxes. Note that if you're doing this with a TreeView,
'you need a blank icon (not unchecked, entirely blank) as the first image, but with the ListView
'you just start with the first box in the series- usually unchecked.
The checkbox imagelist is the State ImageList, so when setting up the ListView, it's assigned as such:
ListView_SetImageList hLVS, himlCheck, LVSIL_STATE

That's all you have to do to get started- all items will default to the first checkbox in the list, then cycle through in order with each click, then after the last one returns to the beginning.

If you want to set the check state through code, you need to use API since True/False isn't good enough,
Code:
Dim li As ListItem
Dim lvi As LVITEM

    lvi.iItem = li.Index - 1 'get your li from ListView.Items.Add() and similar
    lvi.Mask = LVIF_STATE
    lvi.StateMask = LVIS_STATEIMAGEMASK
    lvi.State = IndexToStateImageMask(k) 'where k is the 1-based index of the checkbox you want
    ListView_SetItem ListView1.hWnd, lvi
True/False also doesn't work for retrieving the check state either, so you just have to reverse how it was done when added,
CheckIndex = StateImageMaskToIndex(ListView_GetItemState(hLVS, iItem, LVIS_STATEIMAGEMASK)) 'where iItem is zero-based

The procedure for the TreeView is virtually identical, with the important step of adding the blank image mentioned earlier, and needing to get the hItem since the APIs don't use the index (TVITEM.hItem = pvGetHItem(Comctllib.Node))

That covers the basic concept, all the other code is just standard setup.

Requirements
-Windows Vista or higher (although everything is listed as available in comctl32 6.0, it seems XP isn't going to work :( )
-Common Controls 6.0 Manifest - The sample project has the cc6.0 manifest embedded in its resource file so it will work when compiled, but to work in the IDE your VB6.exe must also be set up to use the 6.0 controls. See LaVolpe's excellent manifest creator project to generate the manifest and startup code for your own projects.
Attached Files
↧

[VB6, Vista+] Core Audio - Change the system default audio device

December 29, 2016, 6:45 pm
$
0
0

Changing the system-wide default input and output audio devices

WARNING: This feature is not designed to be accessible to programs and uses a COM interface that is undocumented and unsupported by Microsoft. As such, it may not function in future versions of Windows.

Several times I've come across people asking how to change the default input/output devices through code, and usually the reply is that it isn't possible. Changing the device per-app is well documented, but many people want to be able to set the system-wide default like the Sound control panel applet does. Tonight I was looking into that a little deeper, and the applet does it through an undocumented private COM interface called IPolicyConfig. So naturally I immediately found the definition and added it to oleexp.

There's two versions of the interface included, one for Windows Vista (IPolicyConfigVista / CPolicyConfigVistaClient) and one for Windows 7 and higher (IPolicyConfig / PolicyConfigClient).
Using this interface to set the defaults is very easy:
Code:
Private pPolicyCfg As PolicyConfigClient

If (pPolicyCfg Is Nothing) Then
    Set pPolicyCfg = New PolicyConfigClient
End If
pPolicyCfg.SetDefaultEndpoint StrPtr(sDeviceID), eMultimedia
pPolicyCfg.SetDefaultEndpoint StrPtr(sDeviceID), eCommunications
It's actually far more complicated to figure out the device ID string that you need, as it's not name, it's a string like {0.0.1.00000000}.{b12f40bc-c3ec-4a74-afcc-4b6d0eb6914a}. The good news is enumerating all the devices and their IDs (as well as enabling them if you need to, as they need to be active to be set as default) was covered in my Core Audio Basics demo. The enumeration code is copied right out of that project.

Requirements
-Windows Vista or higher
-oleexp.tlb v4.11 or higher (new release for this demo)
-oleexp addon mIID.bas (included in oleexp download)
-oleexp addon mCoreAudio.bas (included in oleexp download)
-oleexp addon mPKEY.bas (included in oleexp download)
Attached Files
↧
Viewing all 1544 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>