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

[VB6] Use IFileOperation to replace SHFileOperation for modern Copy/Move box/prompts

$
0
0
cFileOperation 0.1

Display the latest version of the copy/move/delete progress dialog and the related prompts.

SHFileOperation has been superseded by IFileOperation on Windows Vista and above. At least the basic parts of it are easy to access in VB6- showing the standard Windows dialog/progress boxes to Move, Copy, or Delete files. While the class handles it, this function also requires us to bring in the IShellItem interface and its relatives into VB, so take a look at the class module code if you ever wanted to use other functions that required this.

From MSDN, advantages to IFileOperation:
Quote:

Use of IShellItem to identify items rather than string paths. SHFileOperation required path and destination strings to terminate in two null characters rather than the standard single null character, which itself was used to delimit multiple paths in the string. Identifying an item through IShellItem is more robust and less prone to programming errors. It also allows you to access non-file system items such as virtual folders. Multiple items in one operation can be passed as an IShellItemArray, IDataObject, or a collection accessed through IEnumShellItems rather than as a string.
More accurate error reporting through HRESULT values in conjunction with an API such as FormatMessage. Return codes from SHFileOperation could be misleading or inaccurate.
Extensibility. As a Component Object Model (COM) interface, IFileOperation can have its capabilities extended by a third-party to meet their specific needs, although this should be a very rare case. Windows provides a default implementation of IFileOperation that should meet the needs of most users.
Better progress feedback. Detailed operation progress, including notifications when specific operations begin and end on individual items as well as the overall progress, can be received during the operation. While SHFileOperation did provide progress UI, it was not as detailed.
More functionality. In addition to the copy, delete, move, and rename functionality provided by SHFileOperation, IFileOperation allows you to apply property values and create new items.
More control over the operation. In addition to the operation flags recognized by SHFileOperation, new flags are recognized in IFileOperation::SetOperationFlags that specify extended operation options.
Different operations can be performed in one call. For instance, you can move a set of files, copy others, rename a folder, and apply properties to yet another item all in one operation. SHFileOperation could only do one operation—copy, move, rename, or delete—at a time.
Right now this projects just supports the basic calls to Copy/Move/Delete; look for more options, like customizing actions using the .Advise sink method, in future releases.

Requirements
IFileOperation is only available on Windows Vista and higher; this project will not work on XP.
The included olelib.tlb is an upgrade of the standard one and needs to be added as a reference.

Usage Summary
Using the class is fairly straight forward;
-Add a reference to the upgraded olelib.tlb
-Add the class module to the project and go nuts.
-Sample project included to show how the class is called.

Part 1: The Type Library
The easiest way to go about this, due to the extensive dependency tree, was to start with Eduardo Morcillo's olelib. Everything is too tightly interrelated to have separate projects; the conflicts and hours spent re-doing things would simply be unmanageable. So what I've done is take this excellent work, and add in a number of modern interfaces. Old interfaces are the same; if you already use this file in your projects, you can replace it without making any changes to existing code. There's lots to be done with all the new interfaces I've added, and more projects will be forthcoming.

This project contains, at least for the time being while I await an answer on whether its allowed, the upgraded olelib.tlb and the full source to it. You can compile it yourself with the included mk.bat (if your MKTYPLIB.EXE isn't in the standard folder you'll have to edit it).
Among the interfaces added:
IShellItem
IShellItem2
IShellItemArray
IEnumShellItems
IFileOperation
IPropertyChange
IPropertyChangeArray
IObjectWithPropertyKey
IOperationsProgressDialog
IShellLibrary*
ITaskbarList3*
ITaskbarList4*
IActionProgress*
IShellItemImageFactory*
IThumbnailProvider*
* - Not related to the current project, but look for new projects showing their use soon.

Might be a few more I added a long time ago and forgot about, this update is years in the making.

Add olelib.tlb as a reference to your project.

Part 2 - The Class
Once you've added olelib, you're ready to start using cFileOperation. Since this calls the native methods, everything functions the same as in Explorer, including prompts about overwriting, confirmation deletion, etc. No extra code is needed to handle that.
Here are the currently supported calls:

.ParentWindow - Specify the parent window (e.g. Form1.hWnd) to keep the dialogs on top of it.
.SingleFile - For performing operations on a single file.
.SetFileList - For multiple files, specify an array containing a single full path to a file in each item.
.FileList - Retrieve the current file list.
.DestFolder - The destination folder; don't need to set for Delete.
.Flags - Set flags for the operation; uses the standard FileOperationFlags enum (see below).
.CopyFile - Copies the single file.
.CopyFiles - Copies the file list.
.MoveFile - Moves the single file.
.MoveFiles - Moves the file list.
.DeleteFile - Deletes the single file.
.DeleteFiles - Deletes the file list.

File Operation Flags

See MSDN Description of Flags

Can't put it much better than MSDN.


-------
All bug reports, comments, criticisms, and suggestions welcome.
PLEASE NOTE: I don't have access to multiple test systems; everything works on Win7 x64, and everything should work from Vista through 10, but please let met know if there's an issue.
Attached Files

VB6 - Chat Client/Server

$
0
0
This is a 2 part program consisting of a server component and a client component. Because the server component services more than one client, the server must use a Socket Array, which requires an ActiveX Control. Since I cannot post OCX components, I have also provided the OCX code. Instructions on compiling and registering the component are included in the Readme file. To test your new OCX, I have included prjWebTest. Remember to change the NewSocketOCX reference lines in the project and the form.

The server component operates as a Service under the control of the Service Manager. As such, it has no visible interface, and the Administrator uses a client component to monitor the service. There is also daily log files to log access and errors. It offers service in straight text or encrypted modes, in either IPv4 or IPv6. IPv6 has experienced very limited testing due to the lack of a native IPv6 network.

For the Encryption mode, the client passes the User Name (Handle) and the Public Exchange Key (2048 bit) to the server. The server then uses that key to pass a random 256 bit Symmetric Key back to the client. The client then uses the Private Exchange Key to decrypt the Symmetric Key. Because the server is simply reflecting encoded traffic back to all the connected clients, it does not need to decrypt any of the traffic. The Exchange Key pair is created automatically by the operating system if it does not already exist.

Encoded traffic prevents network snooping, but cannot be considered secure without additional security by way of a password or secret token. Anyone with the correct client software can connect and obtain the current Symmetric Key.

J.A. Coutts
Attached Images
 
Attached Files

Unicode Textbox

$
0
0
Here's my version of a Unicode & RTF textbox.

It's about as full featured as you can get while using the RichTx32.ocx control.

Full Unicode and RTF editing while in the IDE design mode. Just right-click and "Edit" to paste in your Unicode/RTF text.

Every single event, property, and method is passed through (with the exception of the data bound properties).

It's actually a bit like a mini-Unicode-word-processor while you're in the IDE design mode. Be sure to take a look at the Sel... properties. Usually, with the regular RTF box, those are only available at runtime, but with this control, they're all available at design time as well. Mess with them while in "Edit" mode of the control, and you can format your text while you're typing it.

The only downside is that pasted text (while in "Edit" mode), must be RTF (or ascii). There can be Unicode embedded in the RTF, but you can't paste "raw" Unicode. So what does this mean? It means you can paste pretty much anything from WordPad (and Word), and it'll go straight in (Unicode and all). Because, in these circumstances, there'll be an RTF representation of the copy in the clipboard. However, Notepad can do Unicode but it doesn't do RTF. Therefore, if you try to copy-and-paste Unicode from the Notepad, it won't work. However, if you copy from Notepad, paste to WordPad, then copy the same text from WordPad, and then paste into this control, it'll work. That's because WordPad will give you an RTF representation of the Unicode.

From WordPad, you can even paste pictures into it.

Please let me know what you think of it and whether you see any problem/enhancements from which it may benefit. Also, if anyone can figure out the pure-Unicode pasting, I'd be delighted to listen.

Enjoy,
UnicodeTextbox.zip
Attached Files

Reading and Writing UTF-16 and UTF-8 Files

$
0
0
Ok, here's my procrastination for the day. I've long been able to read Unicode (UTF-16) files, but I decided I also wanted to read and write UTF-8 files, so I did it. The attached "test" project is the best way to get it, but here's the essential code for the file IO. Focus specifically on the ReadAsciiOrUnicodeNotepadFile and WriteAsciiOrUnicodeNotepadFile procedures. I thought about making them Get/Let properties, but I think they're better this way. Again, don't forget that the attached ZIP has a nice demo.

UTF8 and UTF16.zip

Code:

Option Explicit
'
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
'
Private Const Utf8CodePage As Long = 65001
'
Public Enum AsciiUnicodeEncoding
    AsciiEncode = 0
    Utf8Encode = 1
    Utf16Encode = 2
End Enum
'

Public Function ReadAsciiOrUnicodeNotepadFile(sFileSpec As String) As String
    ' These are typically .TXT files.  They can be read with notepad.
    Dim iFle As Long
    Dim bb() As Byte
    Dim i As Integer
    Dim s As String
    '
    iFle = FreeFile
    Open sFileSpec For Binary As iFle
    If LOF(iFle) = 0 Then
        Close iFle
        Exit Function
    End If
    '
    Get iFle, , i
    Select Case i
    Case &HFEFF ' UTF16 file header.  First byte = FF, second byte = FE.
        ReDim bb(1 To LOF(iFle) - 2&)
        Get iFle, , bb
        ReadAsciiOrUnicodeNotepadFile = bb ' This directly copies the byte array to the Unicode string (no conversion).
    Case &HBBEF
        ReDim bb(1 To LOF(iFle) - 3&)
        Seek iFle, 4
        Get iFle, , bb
        ReadAsciiOrUnicodeNotepadFile = Utf8toUtf16(bb)
    Case Else ' Assume ascii.
        s = Space$(LOF(iFle))
        Seek iFle, 1
        Get iFle, , s
        ReadAsciiOrUnicodeNotepadFile = s
    End Select
    '
    Close iFle
End Function

Public Sub WriteAsciiOrUnicodeNotepadFile(sFileSpec As String, sData As String, Encoding As AsciiUnicodeEncoding)
    ' These are typically .TXT files.  They can be read with notepad.
    Dim iFle As Long
    '
    iFle = FreeFile
    Open sFileSpec For Binary As iFle
    Select Case Encoding
    Case AsciiEncode
        Put iFle, , sData
    Case Utf8Encode
        Put iFle, , CByte(&HEF)
        Put iFle, , CByte(&HBB)
        Put iFle, , CByte(&HBF)
        Put iFle, , Utf16toUtf8(sData)
    Case Utf16Encode
        Put iFle, , &HFEFF ' This is the Unicode header to a text file.  First byte = FF, second byte = FE.
        Put iFle, , Utf16ByteArrayFromString(sData)
    End Select
    Close iFle
End Sub

Public Function Utf16ByteArrayFromString(s As String) As Byte()
    ' This directly copies the Unicode string into the byte array, using two bytes per character (i.e., Unicode).
    Utf16ByteArrayFromString = s
End Function
 
Public Function Utf16toUtf8(s As String) As Byte()
    ' UTF-8 returned to VB6 as a byte array (zero based) because it's pretty useless to VB6 as anything else.
    Dim iLen As Long
    Dim bbBuf() As Byte
    '
    iLen = WideCharToMultiByte(Utf8CodePage, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    ReDim bbBuf(0 To iLen - 1) ' Will be initialized as all &h00.
    iLen = WideCharToMultiByte(Utf8CodePage, 0, StrPtr(s), Len(s), VarPtr(bbBuf(0)), iLen, 0, 0)
    Utf16toUtf8 = bbBuf
End Function
 
Public Function Utf8toUtf16(bb() As Byte) As String
    ' Incoming must be a dimensioned byte array with a UTF-8 string in it.
    Dim sBuf As String
    Dim iLen As Long
    '
    iLen = MultiByteToWideChar(Utf8CodePage, 0, VarPtr(bb(LBound(bb))), UBound(bb) - LBound(bb) + 1, 0, 0)
    sBuf = String$(iLen, 0)
    iLen = MultiByteToWideChar(Utf8CodePage, 0, VarPtr(bb(LBound(bb))), UBound(bb) - LBound(bb) + 1, StrPtr(sBuf), Len(sBuf))
    Utf8toUtf16 = sBuf
End Function

Attached Files

VB6 - DNS Monitor

$
0
0
DNS Monitor is a utility program that allows you to monitor and log DNS requests transiting your network. This program has been around for some time and is by far the most popular download on my Web site. I have never posted the code because it utilized the Dart Service Control (which is not free), and I finally got around to converting it to using the Microsoft NTSvc.ocx control. At the same time, I implemented low level packet filtering within WinPKFilter, so that the program only sees port 53 UDP data. Examining all packets had its advantages, but it was very inefficient.

DNS Monitor hooks the NDIS driver in your windows operating system, and sets the NIC to operate in promiscuous mode. In this mode, you can see all DNS requests on your network if you are using a hub instead of a switch. The advantage of monitoring DNS requests rather than Web GET requests is that these requests are very small and cover services over and above just the World Wide Web. Additionally, most operating systems will cache these requests, so that all you see is the first request. This gives you a fairly concise picture of Internet usage. On my network, I can see traffic on the WiFi part as well because I am using a WiFi hotspot that connects into the same hub. My new Windows Tablet makes an insane number of DNS queries just powering up and loading a home page on Internet Explorer.

There are 2 components to DNS Monitor. The main program is interactive, and allows you to monitor and capture current DNS activity. The only setup required is for the user to confirm which IP Adapter is being utilized. The captured data is logged to daily files stored in the "%windir%\System32\LogFiles\DNS\" directory by date.

DNS Monitor also has an optional service component. This service operates in the background with no user interaction required, even when the user is logged off. It will not however persist through a type 3 Sleep mode. To install the service, simply click on the "Install" button. Once successfully installed, the "Start" button will become active and you can start the service, providing that the active server is "OFFLINE". You can also use the Service Manager (services.msc).

To install DNS Monitor, you must first install WinpkFilter!
http://www.ntkernel.com/downloads/winpkflt_rtl.zip
There is no charge for personal use.

NOTE: On 64 bit operating systems (Vista/Win7/Win8), driver signing is enforced, and must be circumvented! Currently the only way to do that is to use the F8 key on boot up and disable driver signing. The ability to use the Group Policy Editor or modify the BCD file to fullfill this task is no longer available on fully updated systems. Once disabled the driver can be loaded, but permanently signing the driver with a digital signature recognized by Microsoft is prohibitively expensive. What is still available is to run your system in Test Mode. Your driver must still be signed, but you can locally sign your own driver (ndisrd.sys). To make this easier, a small utility is made available from NGOHQ.
http://www.ngohq.com/home.php?page=dseo
This little utility does not have to be installed, but must be run in Administrative Mode. Win 8.1 however is a different kettle of fish. If your computer uses Unified Extensible Firmware Interface (UEFI), it probably uses Secure Boot and hides the TESTSIGNING setting. Secure Boot can be temporarily turned off, TESTSIGNING turned on, and Secure Boot turned back on. However, as of this posting I have not confirmed if TESTSIGNING is still active. I will post more as I uncover it.

J.A. Coutts
Attached Images
 
Attached Files

Radio Buttons as list of buttons and more

$
0
0
I make some additions and a bit of changes that not change the programming schema, but now works fine the trasparency of the control (backstyle=1) (is a copy of the form picture). Also I put a special color to act as text color for seleced item for menu items.
This I done for member Elroy, who wants to duplicate an exist control but he didn't thought that starting something new is better by wrapping code on a RTB control. Every item as a radio button with his thought would be a fresh RTB. I don't like that approach. I would like better to handle a group of selections in list, so i can handle the number without thinking about how big is my form.
You can freely use that code and if you like make it a better control..
Attached Images
 
Attached Files

Textbox validation for integers and float/scientific numbers

Unicode OptionButton

$
0
0
Here's a Unicode Option Button. Just see small sample project. It should be self-explanatory.

One weakness: You can't paste the caption with pure unicode (without an RTF format being in the clipboard). It's best to paste into WordPad, re-copy, and then it'll paste into the Option Button's caption. I know how to paste pure unicode, but it just makes the control quite a bit heavier. You can set the caption at runtime with a string (which is unicode, of course) and it'll correctly go into the caption as unicode.

Enjoy:
UnicodeOptionButton.zip

EDIT: There's also a GroupNum property for creation Option Button groups. No need for separate frames or containers. Initially, it defaults to 0, linking them all together.
Attached Files

Zoom Dialog

$
0
0
This is a part of file selectors, and here I made a class to be used more easily.

In example is a dialog that can be zoomed, without using any window style. So we can draw anything.

The window to zoom need to fix the scale from a most used font size. Then we can expand it without loosing width/height ratio and always fixed the scale to that font size we have choose.
We can expand to the right (optional) without scale. So with one move we can scale and expand as we wish. The dialog never loose at the minimum right expansion the form basic ratio.


New example;
Attached Files

Keep open CreateObject("ADODB.Connection")

$
0
0
I am working now changing the old DAO to ADO in my M2000 environment. I see some reduce in speed and I found why...All of my commands use the old DBEngine and workspaces...and so I was to change that to a variant
mybase= CreateObject("ADODB.Connection")
But in DAO the opening and close of Workspace has no delays. So I thinking about and my solution is easy to follow... All we have is to save the object and reused it and at the end we can delete all together.
Why we have a solution here which uses a collection and not use one or more variants variables and do the same thing at the end of program?
For simple programs the easy way is to use simple variables. But in more complicated, when we can't figure how many open connection we have, this collection is useful. We can expand the use of it if we pass to the index of it a number indicating the number of open connection (not as ordinal but as an autoincrement number)

So, when we need to set a mybase with SET mybase= CreateObject("ADODB.Connection")
we can see if exist and if exist we can use that or if not we make one.

We need to set that in the same module as with the functions included in the thread
Dim conCollection As Collection
Dim init As Boolean


If Not getone(base, myBase) Then

Set myBase = CreateObject("ADODB.Connection")
' it is better to use the default CursorLocation. So do not change it
' With CursorLocation=3 I can't read an mdb file written with DAO..but with CursorLocation=2 I can..

Set.Open ....the known string here.., 3, 4

end if

now we can open and close recordsets easy and fast.

So before we close the program e say just CloseAllConnections
CloseAllConnections



Code:

Dim conCollection As Collection
Dim init As Boolean

Sub PushOne(conname As String, v As Variant)
On Error Resume Next
conCollection.Add v, conname
Set v = conCollection(conname)
End Sub

Sub CloseAllConnections()
Dim v As Variant, BB As Boolean
On Error Resume Next
If Not init Then Exit Sub
If conCollection.Count > 0 Then
Dim i As Long
Err.clear
For i = conCollection.Count To 1 Step -1
On Error Resume Next
BB = conCollection(i).connectionstring <> ""
If Err.Number = 0 Then
        If conCollection(i).ActiveConnection <> "" Then conCollection(i).Close       
End If
conCollection.Remove i
Err.clear
Next i
Set conCollection = New Collection
End If
Err.clear
End Sub
Function getone(conname As String, this As Variant) As Boolean
On Error Resume Next
Dim v As Variant
InitMe
Err.clear
Set v = conCollection(conname)
If Err.Number = 0 Then getone = True: Set this = v
Err.clear
End Function

Sub InitMe()
If init Then Exit Sub
Set conCollection = New Collection
init = True
End Sub

Zcreenshot (translucent selection-box seamless screenshot application)

$
0
0
Thought I'd share this awesome little open-source app with tons of useful code examples with VBForums. I've won 2 awards for code of the month over at PlanetSourceCode, and this was one of them.

Fully operational screenshot application that is activated with a set of hot-keys of your choice, that when activated changes your mouse cursor to the selection-cross to let you know you can now click and drag a translucent selection box across any part of your desktop, and when the mouse is released, it will be saved to a folder with only the area selected. JPEG compression is available for saving the image, or standard raw bitmap. The appearance of the selection box is fully customizable (as far as translucency, border color, and background color) As well as saving all preferences in an INI file, such as which compression to use, running on start-up, it also features the ability to easily access the application through use of the Windows tray area; you may also access the screenshot folder where the images are saved to from the tray icon for ease of use. As well demonstrating quite a large number of API calls in relation to I/O and GDI+/other graphic operations, this also demonstrates the basics of making an application that runs on start up and is easily available from tray area. Great, fairly simple application to learn a lot of the basics to make headway to becoming an advanced programmer.
:check:Zcreenshot.zip
Name:  PIC201382023235054.jpg
Views: 29
Size:  73.4 KB
Attached Images
 
Attached Files

OptionButtonEx (grouping without frames, Unicode at runtime, & lightweight)

$
0
0
Here's what I'm calling OptionButtonEx. It has two features that the regular OptionButton doesn't have:

1) There's a GroupNum property that allows grouping of sets of them without the need for creating extra containers (frames, etc). The default is group zero, which will link all new option buttons together, but you can create as many groups (sets of option buttons) as you like.

2) There is a CaptionUnicode property. This property is available only at runtime, but it allows the setting (and getting) of a Unicode caption (using a standard VB6 string). This isn't available at design time because it would make this control too heavy (requiring a RichTextBox). I've previously posted a Unicode Option Button which is Unicode editable at design time for those who want that functionality.

This control is almost as lightweight as the regular option button, and has these two new features.

Enjoy.

OptionButtonEx.zip
Attached Files

[VB6] MS Office (MODI) OCR - OCR "for free"

$
0
0
This may already have been posted, but a search turned nothing up here in the CodeBank.


If you have an appropriate version of Microsoft Office you can use MODI to do OCR on images. The obvious candidates are 32-bit Office 2003 and 2007, but supposedly this can be made to work in 32-bit Office 2010 as well.

As far as I can tell there is no way to feed images to MODI.Document except by having it load them from disk. But you could always "dump" images to a temporary folder as required, so that isn't a nasty restriction.


Requirements

VB6 development tools. Of course the logic can be trivially ported to Office VBA or even a WSH or MSHTA script written in VBScript.

A version of 32-bit Office supporting MODI.


Notes

This program uses early binding against Microsoft Office Document Imaging 11.0 Type Library (Office 2003). This is used to give us easy access to MODI.Document's OnOCRProgress event and the predefined constant miLANG_ENGLISH in Enum MiLANGUAGES.

To use this code with Office 2007 you'd need to change the reference to Microsoft Office Document Imaging 12.0 Type Library and recompile.

You could also use late binding, but then you would either have to give up using WithEvents (not valid for As Object) and the OnOCRProgress event entirely... or else use additional code or a C++ helper DLL to bind to the event.

MODI was removed in Office 2010, but you might look at:



Attached Demo

The attachment is large because of included image files.

The program just grabs the file names from a hard-coded folder, then loads and OCRs them one by one and displays the resulting text in a RichTextBox. A status line reports progress on each image as it works.

A Timer control is used to work through the queue of images, primarily to help avoid the program being marked unresponsive by Windows.

The demo helps illustrate the "garbage in, garbage out" nature of OCR: the quality of the results depends on what you feed into it.
Attached Files

[VB6] Code Tip: Toggle Button with Image and Text (Vista+, ComCtl6)

$
0
0
NOTE: I will make a sample project, but since I had deleted this content and there was a 'please delete me' filler I wanted to repost as soon as possible. What happened was, I tried the code I posted, it seemed to work, so I posted it. I don't know if something in my system changed, or if I was hallucinating, or what, but the next minute I look and this method is not working. I came up with a fix, but it turns this from a code snippet into something fairly complicated. So standby for a sample project, but I wanted to get the post back up.


Problem: A regular CommandButton can have its image set with BM_SETIMAGE, but making it into a pushbutton (toggle button) by setting its style to BS_PUSHLIKE does not work. Conversely, a checkbox can be made into a pushbutton, but then you can't set its picture with BM_SETIMAGE and also have text.

Solution: A workable solution is to simply mimic the behavior of a pushbutton using BM_SETSTATE- which toggles whether the button is in its mousedown appearance. It stays depressed when focus is lost and when left clicked, and as far as I can tell behaves no different than a BS_PUSHLIKE button. The only trick is preventing a change to the state when focus is lost.

This code assumes you already have a project using modern common controls; see other threads for info about that.

On Form_Load, set the icon and whatever other styles you need for the button; e.g.

Code:

hBtn = Command1.hWnd
Call SendMessage(Command1.hWnd, BM_SETIMAGE, 1&, ByVal hIcon1)
SetButtonStyle Command1.hWnd, BS_NOTIFY Or BS_LEFT

hBtn is a Public Long. BS_NOTIFY is required; BS_LEFT I just added because it looks better, you can omit it or change it as long as the notify style remains. Do NOT set BS_PUSHLIKE.
Then you can toggle it on and off like this:

Code:

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bFlag Then
    ToggleButtonState Command1.hWnd, 0
    bFlag = False
Else
    ToggleButtonState Command1.hWnd, 1
    bFlag = True
End If
End Sub


Public Sub ToggleButtonState(hWnd As Long, lState As Long)
Call SendMessage(hWnd, BM_SETSTATE, lState, ByVal 0&)
End Sub

bFlag is a project level setting you're tracking with the button state.

The big problem, and initial issue with this post, is that the button seems to lose the effect when focus is lost. Further complicating the issue, the Command_LostFocus is only fired when you click some controls and not others in VB (but the effect is lost on all), so your main form has to be subclassed to intercept the BN_KILLFOCUS message (the button itself need not be subclassed).

Code:

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'[...other subclass code]
    Case WM_COMMAND
        Dim lCode As Long
        lCode = HiWord(wParam)
        Select Case lCode
            Case BN_KILLFOCUS
                If lParam = hBtn Then
                    If bFlag Then
                        Call SendMessage(hBtn, BM_SETSTATE, 1&, ByVal 0&)
                    End If
                End If
                WndProc = 1
                Exit Function
'[...other subclass code


I know this is rather trivial, but when I came across the problem I saw lots of people asking and no adequate solutions. In modern UI's there's lots of places I prefer toggle buttons to checkboxes, so figured someone else might come across the same issue one day.


Declares and Supports
Code:

Public Const BM_SETIMAGE = &HF7
Public Const BM_SETSTATE = &HF3
Public Const BS_LEFT = &H100&
Public Const BS_NOTIFY = &H4000&
Public Const BN_KILLFOCUS = 7&
Public Const WM_COMMAND = &H111

Public Const GWL_STYLE = (-16)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                                                                    Source As Any, _
                                                                    ByVal Length As Long)

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
                                                                      ByVal wMsg As Long, _
                                                                      ByVal wParam As Long, _
                                                                      lParam As Any) As Long

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                                          ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
                                                                          ByVal nIndex As Long, _
                                                                          ByVal dwNewLong As Long) As Long
Public Function SetButtonStyle(hWnd As Long, dwNewStyle As Long, Optional bAdd As Boolean = True) As Long
Dim dwStyle As Long
If bAdd Then
    dwStyle = GetWindowLong(hWnd, GWL_STYLE)
End If
dwStyle = dwStyle Or dwNewStyle
SetButtonStyle = SetWindowLong(hWnd, GWL_STYLE, dwStyle)
End Function

Public Function HiWord(dwValue As Long) As Integer
  CopyMemory HiWord, ByVal VarPtr(dwValue) + 2, 2
End Function

How to make a new Ctrl-Break key.

$
0
0
My new Win 8.1 system keyboard doesn't have a Ctrl-Break key, and I found that extremely annoying when working with Visual Basic. So with some research, I located some info on how to disable the Caps Lock key. In the registry locate the key, HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout
and add a binary value:
"Scancode Map" = 00 00 00 00 00 00 00 00 02 00 00 00 00 00 3a 00 00 00 00 00
The first 8 bytes are always zero.
The next 4 bytes are one more than the number of keys being mapped.
The next 2 bytes are the key code that you want to map to (in this case 00 00).
the next 2 bytes are the key code that you want to change (Caps Lock = 3A 00).
The last 4 bytes are always zero.
I decided to use the Ctrl-F12 key as a Ctrl-Break, and finding the key codes for those was a little more difficult.
"Scancode Map" = 00 00 00 00 00 00 00 00 02 00 00 00 46 e0 58 00 00 00 00 00
Reboot the system for the changes to take effect, and you have a new Ctrl-Break key.

J.A. Coutts
Attached Images
 

VB6 Dual-Pivot-QuickSort

$
0
0
Just to throw something new (for VB6) into the ring of competing Sort-Algos...

I've just finished porting (from Java-SourceCode) the relative new (Sep. 2009) Dual-Pivot-Algorithm, invented by
Vladimir Yaroslavskiy, who has tuned good old QuickSort significantly, leaving over next to zero disadvantages.

Here his posting, which finally led to the inclusion of this new algorithm into the official Java-SDK (used in Java.Array)
http://permalink.gmane.org/gmane.com...ibs.devel/2628

The source for this new Algo is contained in the attached Demo-Zip.

Here's a Screenshot, which shows its performance with different kinds of Input-Data:
With normal (random) Data it shows no disadvantages to a Standard-QuickSort -
but offers huge improvements over "naive Quicksorts" when fed with "inconvenient data".

As a side-note:
HeapSort is outperformed in all tests quite significantly by the DualPivot-Algo...
HeapSort is also beaten by the naive QuickSort in all tests, except the one with constant Data.



Olaf
Attached Files

Fix for SSTab not correctly handling focus and comboboxes

$
0
0
Make a Class module out of the following code, create an object with it for any form that uses the SSTab control and follow directions in comments.

Code:

'
' ****************************************************************
' ****************************************************************
' ****************************************************************
' This program is free software: you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' version 3 as published my the Free Software Foundation:
' http://www.gnu.org/licenses/gpl.html
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' This software was originally written by Elroy Sullivan, PhD in
' cooperation with Shriners Hospitals for Children, Houston.
' Dr. Sullivan can be reached at elroysullivan@gmail.com.
' ****************************************************************
' ****************************************************************
' ****************************************************************
'
Option Explicit
'
Dim WithEvents tabCtl As SSTab
Dim frm As Form
Dim TabStops() As Boolean
'
' A primary purpose of this fix is to correctly control the tab stops.
' To make the appearance of tabs, the SSTab control simply moves the controls out of view.
' An artifact of this approach is that the controls are still able to get the focus when the
' user uses the TAB key.  The following code corrects this problem by appropriately turning
' on and off the TabStop properties of the controls as the user tabs from one tab to another.
'
' Another problem has to do with ComboBoxes.  When changing to a new tab, dropdown comboboxes
' will have their text selected.  The combobox will not have the focus, but their text will be
' selected.  The primary problem with this is that it right-justifies the text when there is more
' text than will fit in the textbox portion of the combobox, and this is confusing to users.
' This problem is corrected in the following code.
'

Friend Sub SetTabControl(TheTabControl As SSTab, TheForm As Form)
    ' Call this in the form load event.
    Dim ctl As Control
    Dim ptr As Long
    '
    Set tabCtl = TheTabControl
    Set frm = TheForm
    '
    ' Store the true value of the TabStops.
    ReDim TabStops(0 To frm.Controls.Count - 1)
    ' Not all controls have TabStop property, so we must set error trapping.
    On Error Resume Next
    For ptr = 0 To frm.Controls.Count - 1
        TabStops(ptr) = frm.Controls(ptr).TabStop
    Next ptr
    On Error GoTo 0
End Sub

Friend Sub SetTabStopsAccordingly()
    ' Call this in the form activate event.
    ' After this first call, it will automatically be called when the tabs change.
    Dim ctl As Control
    Dim ctlTheControlOrContainer As Control
    Dim ItsOnTheTabControl As Boolean
    Dim ptr As Long
    '
    For ptr = 0 To frm.Controls.Count - 1
        Set ctl = frm.Controls(ptr)
        Set ctlTheControlOrContainer = ctl ' The control might be on a container that's on the SSTab, rather than directly on the SSTab.
        Do
            Select Case True
            Case TypeOf ctlTheControlOrContainer.Container Is SSTab
                ItsOnTheTabControl = True
                Exit Do ' The way out.
            Case TypeOf ctlTheControlOrContainer.Container Is Form
                ItsOnTheTabControl = False
                Exit Do ' The way out.
            End Select
            Set ctlTheControlOrContainer = ctlTheControlOrContainer.Container ' Must deal with controls nested deeper than the SSTab control.
        Loop
        If ItsOnTheTabControl Then
            ' Not all controls have TabStop property, so we must set error trapping.
            On Error Resume Next
            If ctlTheControlOrContainer.Left >= 0 Then
                ctl.TabStop = TabStops(ptr) ' If it's showing, restore the original TabStop value.
                ' Must also fix the problem with combo boxes having an internal focus set.
                ctl.SelStart = 0
                ctl.SelLength = 0
            Else
                ctl.TabStop = False
            End If
            On Error GoTo 0
        End If
    Next ptr
End Sub

Private Sub tabCtl_Click(PreviousTab As Integer)
    SetTabStopsAccordingly
End Sub

Private Sub tabCtl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' This allows other controls to close up when user click off.
    ' The problem is that clicking into the body of the tab control does NOT cause change in focus.
    ' The control with the focus keeps it, and it may not close up as typically happens when clicking on dead space of a form.
    ' You may also want to consider placing this "SetFocus" code on the labels on the tabs.  This is NOT automatically done
    ' because the programmer may want to use a label click for other purposes.
    tabCtl.SetFocus
End Sub

Simple Bingo Engine

$
0
0
Hey guys, I made this Bingo Engine, in case any of you guys need ideas on how to make one or need one, there you go. I have also included a small demo project.
Attached Files

Random number generator

$
0
0
Here is a small program that demonstrate a random number generator. There are two buttons and a listbox. We can see the frequencies of each of 100 numbers (from 0 to 99). We produce 2000000 random numbers. With the left button is mine generator the other is the vb generator. In Ide vb generetor is faster, but in compiled code mine generator is 2 times quicker. Why? First I would like more span to the frequencies, and the function give a number form 0 to 9999. In mine computer needed 1 seconds for 2 million random numbers, and 2 seconds using the vb function.
Attached Files

[VB6] Call Functions By Pointer (Universall DLL Calls)

$
0
0
I was recently made aware that a function I've used from time to time for calling virtual functions of COM objects was perfectly adept at calling functions from just about any standard DLL out there. So, I whipped up a 'generic' class that can call both standard DLL functions & COM VTable functions. No thunks are used, just a couple of supporting API calls in the main class, including the low-level core API function: DispCallFunc

What does this mean for you? Well, it does allow you to call DLL functions from nearly 10 different calling conventions, including CDecl. It also allows you to call virtual functions from COM objects.

I'd consider this topic advanced for one reason only. This is very low level. If you provide incorrect parameter information to the class, your project is likely to crash. For advanced coders, we have no problem doing the research to understand what parameter information is required, be it variable type, a pointer, a pointer to a pointer, function return types, etc, etc. Not-so-advanced coders just want to plug in values & play, but when playing at such a low level, that usually results in crashes, in frustration.

The attachment includes very simple examples of calling DLL functions and calling a COM virtual function. You will notice that the form has no API function declarations, though several DLL functions are called & executed correctly.

For DLL calls, the class takes the DLL name and function name to be called. Technically, you aren't passing the function pointer to the class. However, the class does make the call to the pointer, not via declared API functions. Just thought I'd throw this comment in, should someone suggest we aren't really calling functions by pointer. The class is, the user calling the class is not, but can be if inclined to modify the code a bit.

Tip: If you really like this class, you may want to instantiate one for each DLL you will be calling quite often. This could speed things up a bit when making subsequent calls. As is, the class will load the requested DLL into memory if it isn't already. Once class is called again, for a different DLL, then the previous DLL is unloaded if needed & the new DLL loaded as needed. So, if you created cUser32, cShell32, cKernel32 instances, less code is executed in the class if it doesn't have to drop & load DLLs.
Code:

' top of form
Private cUser32 As cUniversalDLLCalls
Private cKernel32 As cUniversalDLLCalls
Private cShell32 As cUniversalDLLCalls
' in form load
Set cUser32 = New cUniversalDLLCalls
Set cKernel32 = New cUniversalDLLCalls
Set cShell32 = New cUniversalDLLCalls
' now use cUser32 for all user32.dll calls, cKernel32 for kernel32, cShell32 for shell32, etc

Tip: When using the STR_ANSI flag to indicate the passed parameters include string values destined for ANSI functions, the class will convert the passed string to ANSI before calling the function. Doing so, default Locale is used for string conversion. If this is a problem, you should ensure you convert the string(s) to ANSI before passing it to the class. If you do this conversion, use STR_NONE & pass the string via StrPtr(). FYI: strings used strictly as a buffer for return values should always be passed via StrPtr() and the flag STR_NONE used; regardless if destined for ANSI or unicode functions.
Code:

' how to have a VB string contain ANSI vs Unicode
myString = StrConv(myString, vbFromUnicode, [Locale ID])
' how to convert the returned ANSI string to a proper VB string
myString = StrConv(myString, vbUnicode, [Locale ID])

Attached Files
Viewing all 1326 articles
Browse latest View live




Latest Images