Wednesday, December 17, 2008

[vb6] Adjust height of combobox dropdown to fit the number of items

When you drop down the dropdown list of a combobox, VB will set its height to display a maximum of 8 items. If the listcount property is larger than 8, vb adds a vertical scrollbar to the list. You might want to override this behaviour and set the height of the dropdown so that it fits exactly the number of items, within reasonable limits, of course. The SetDropdownHeight procedure does exactly this. This procedure should be called in response to the DropDown event of the combobox in question. The DropDown event is raised just before the dropdown is actually displayed. Set the max_extent parameter to reflect the wanted maximum extent of the dropdown. In this particular case, I set it to the ScaleHeight of the form to prevent the dropdown from extending below the form.
    Option Explicit

Private Declare Function MoveWindow& Lib "user32" (ByVal hwnd As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long)

Private Sub Combo1_DropDown()
SetDropdownHeight Combo1, ScaleHeight
End Sub

' Adjust height of combobox dropdown part; call in response to DropDown event
Private Sub SetDropdownHeight(cbo As ComboBox, ByVal max_extent As Integer)
' max_extent is the absolute maximum clientY value that the dropdown may extend to
' case 1: nItems <= 8 : do nothing - vb standard behaviour
' case 2: Items will fit in defined max area : resize to fit
' case 3: Items will not fit : resize to defined max height

If cbo.ListCount > 8 Then
Dim max_fit As Integer ' maximum number of items that will fit in maximum extent
Dim item_ht As Integer ' Calculated height of an item in the dropdown

item_ht = ScaleY(cbo.Height, ScaleMode, vbPixels) - 8
max_fit = (max_extent - cbo.Top - cbo.Height) \ ScaleY(item_ht, vbPixels, ScaleMode)

If cbo.ListCount <= max_fit Then
MoveWindow cbo.hwnd, ScaleX(cbo.Left, ScaleMode, vbPixels), _
ScaleY(cbo.Top, ScaleMode, vbPixels), _
ScaleX(cbo.Width, ScaleMode, vbPixels), _
ScaleY(cbo.Height, ScaleMode, vbPixels) + (item_ht * cbo.ListCount) + 2, 0
Else
MoveWindow cbo.hwnd, ScaleX(cbo.Left, ScaleMode, vbPixels), _
ScaleY(cbo.Top, ScaleMode, vbPixels), _
ScaleX(cbo.Width, ScaleMode, vbPixels), _
ScaleY(cbo.Height, ScaleMode, vbPixels) + (item_ht * max_fit) + 2, 0
End If
End If
End Sub

[vb6] Register COM components

COM components (COM dlls, including ActiveX control libraries) are normally registered by setup programs or manually by using the RegSvr32 utility. If, for some reason you want to register a component in pure code you can do like this instead: First, declare the exported function DllRegisterServer that all COM dlls and ocx's export. To tailor it to your own dlls change the filename and the alias in the declare statement. The function returns 0 on success. The only disadvantage is that you have to know the name of the file at design-time, because declare statements are hard-coded into your executable - there is no such thing as a dynamic declare statement.
    Private Declare Function DllRegisterServerGRADIENTTITLE Lib _
"GradientTitle.ocx" Alias "DllRegisterServer" () As Long
Call the function like this to make the registration:
    Dim retval As Long
retval = DllRegisterServerGRADIENTTITLE

[vb6] Prompt for a folder

You can use the shell library to prompt the user for a folder name, like you see in setup programs. The shell function SHBrowseForFolder pops up a modal dialog box that prompts the user to select a folder. (You will probably need only a subset of the constants. See the Platform SDK for an explanation of when to use the differenct flags).
    Private Const BIF_RETURNONLYFSDIRS = &H1&
Private Const BIF_DONTGOBELOWDOMAIN = &H2&
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNFSANCESTORS = &H8&
Private Const BIF_EDITBOX = &H10&
Private Const BIF_VALIDATE = &H20&
Private Const BIF_BROWSEFORCOMPUTER = &H1000&
Private Const BIF_BROWSEFORPRINTER = &H2000&
Private Const BIF_BROWSEINCLUDEFILES = &H4000&

Private Type BROWSEINFO
hwndOwner As Long
LPCITEMIDLIST As Long
lpszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
(lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidl As Long, ByVal sFolder As String) As Long

Private Function PromptForFolder() As String
Dim bInfo As BROWSEINFO
With bInfo
.hwndOwner = hwnd
.lpszDisplayName = String(260, 32)
.lpszTitle = "Select Directory:"
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With

Dim retval As Long, foldername As String
foldername = String(260, 32)
retval = SHBrowseForFolder(bInfo)
retval = SHGetPathFromIDList(retval, foldername)
PromptForFolder = RTrim$(foldername)
End Function
The VB function as shown returns the full path to the folder. If you want just the name of the folder, return bInfo.lpszDisplayname instead.

[vb6] Get rid of blinking on scrollbar

Have you ever used hours trying to figure out how to get rid of that unsightly blinking on the scrollbar controls ? (well, I have !). The solution is simple (once you know it): Set the Tabstop property to false....

[vb6] When to do Refresh in response to Resize

When a form or picture box is resized, it is automatically invalidated. This means that the Paint event handler is called immediately after the Resize event handler. However, this is only true if either the width or height (or both) were increased by the resize operation. This may be fine, if that is what you want, but in many situations you need to repaint the form / picturebox also when it is made smaller. You cannot simply do a Refresh in the Resize event handler, cause that would entail a duplicate repainting when the form or picturebox is enlarged in one or both dimensions. Instead, you must cheque the new size and compare it to the previous size, refreshing only when appropiate. This example is for a picture box named picCar:
    Private Sub picCar_Resize()
Static OldPictureSizeX As Long
Static OldPictureSizeY As Long
If picCar.Width <= OldPictureSizeX And picCar.Height <= OldPictureSizeY Then
picCar.Refresh
End If
OldPictureSizeX = picCar.Width
OldPictureSizeY = picCar.Height
End Sub

[vb6] How change the font color on a commandbutton ?

The easy answers are "Don't" or "Buy a 3rd party commandbutton control that will let you change the text color". Otherwise, you can use the hack below to change the color. The button is presupposed to reside on a form with scalemode=3. Commandbutton.Name = "Command1", .Caption = "", .Tag = the caption you want. In addition, place a timer on the form; call it Timer1, set its Enabled property to false and Interval to 10. Note: the text is written with the system font. If you want another font, you'll have to create the font and select it into the command1 device context.
    Option Explicit

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const DT_SINGLELINE& = &H20
Private Const DT_CENTER& = &H1
Private Const DT_VCENTER& = &H4
Private Const TRANSPARENT& = 1
Private Declare Function SetBkMode& Lib "gdi32" (ByVal hdc As Long, _
ByVal nBkMode As Long)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function DrawText& Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long)

Private Sub Command1_GotFocus()
Timer1.Enabled = True
End Sub

Private Sub Command1_LostFocus()
Timer1.Enabled = True
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, _
x As Single, y As Single)
PaintCaption Command1, 2, 2, vbRed
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, _
x As Single, y As Single)
PaintCaption Command1, 0, 0, vbRed
End Sub

Private Sub Form_Paint()
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
PaintCaption Command1, 0, 0, vbRed
Timer1.Enabled = False
End Sub

Private Sub PaintCaption(btn As CommandButton, ByVal x As Long, _
ByVal y As Long, clr As Long)
Dim dc As Long, re As RECT
dc = GetDC(btn.hwnd)
SetTextColor dc, clr
SetBkMode dc, TRANSPARENT
re.Left = x
re.Top = y
re.Bottom = btn.Height
re.Right = btn.Width
DrawText dc, btn.Tag, -1, re, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
End Sub

[vb6] How change the backcolor on a commandbutton ?

The intrinsic commandbutton control offers a backcolor property, but if you attempt to set it to anything but the default, you'll notice that your changes are disregarded. To activate the backcolor setting, set the Style property of the button to 1 - graphical.

[vb6] Get rid of the title bar

Problem: I don't want my program to have a titlebar but I do want it listed in the Windows Taskbar. I figured out that I could get rid of the title bar by turning off the controlbox setting and setting the caption to "" but this gives me a blank bar in the taskbar too. Annoyingly, the "ShowInTaskbar" setting is only available at design time so I can't turn it off when the window is visible and back on when minimized. Solution: Set the following form properties: BorderStyle: 0 - None, Caption: whatever, ShowInTaskBar: True and WindowState: 1 - Minimized. Then, in the form load procedure give the form a 3d border by changing its style:
    Private Const WS_DLGFRAME& = &H400000
ModifyStyle hwnd, 0, WS_DLGFRAME
See the tip on the ModifyStyle function and the tip on enabling moving of forms with no title bar.

[vb6] Retrieve pixel color with GetPixel

The color of a pixel on a form or picturebox can be read with the GetPixel API. The function expects X and Y in pixels, so it is necessary to convert from whatever scalemode is in effect to pixels. The code below reads the pixel values from a picturebox when a mouse button is pressed and uses the ScaleX and ScaleY methods of the picturebox control to make the call to GetPixel independent of the scalemode property.
    Private Declare Function GetPixel Lib "gdi32" _
(ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Sub Pict1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Debug.Print GetPixel(Pict1.hdc, Pict1.ScaleX(X, _
Pict1.ScaleMode, 3), Pict1.ScaleY(Y, Pict1.ScaleMode, 3))
End Sub

[vb6] Scrolling multiline textboxes in code

The user can scroll a multiline textbox by using the vertical scroll bar (provided you've assigned a scrollbar to the control), but the developer cannot, unless resorting to sending messages to the control.
    Private Const EM_SCROLL& = &HB5
Private Const SB_LINEDOWN& = 1
Private Const SB_LINEUP& = 0
Private Const EM_LINESCROLL& = &HB6
Private Const EM_SCROLLCARET& = &HB7
Private Const SB_PAGEDOWN& = 3
Private Const SB_PAGEUP& = 2
Private Const EM_GETFIRSTVISIBLELINE& = &HCE
Private Declare Function SendMessageBynum& Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long)
Send the message EM_SCROLL to scroll up or down. This example scrolls down one page:
    SendMessageBynum Text1.hwnd, EM_SCROLL, SB_PAGEDOWN, 0
Send the message EM_SCROLLCARET to scroll to where the caret is:
    SendMessageBynum Text1.hwnd, EM_SCROLLCARET, 0, 0
Send the message EM_LINESCROLL to scroll a specified number of lines or to a specific line index. This example scrolls to line 10:
    Dim FLine&
FLine = SendMessageBynum(Text1.hwnd, EM_GETFIRSTVISIBLELINE, 0, 0)
SendMessageBynum Text1.hwnd, EM_LINESCROLL, 0, 10 - FLine
First, the index of the first visible line is retrieved into FLine. Then, the text is scrolled a number of lines (negative is down, positive is up).

[vb6] Drawing transparent rectangles

You can draw rectangles fast using the Rectangle API. If you want the interior of the rectangles to be transparent, you must first select the special brush NULL_BRUSH into the device context.
    Private Const NULL_BRUSH& = 5
Private Declare Function Rectangle& Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long)

[vb6] Rubber banding the easy way

Most vector graphics programs let you draw a straight line by pressing a mouse button and then, holding the button down, moving the mouse to the where the line should end and then releasing the mouse button. In other words, a new temporary line is drawn whenever the mouse is moved with the button down (so-called rubber banding). If you try to implement this, you run into the problem of how to erase the previous temporary line, as the mouse is moved, especially if the background is anything but a single color. The solution is very simple: Set the Drawmode property of the form or picturebox (or whatever) to 10 - Not Xor Pen. With this drawmode you can undo any drawing operation by repeating it. Draw each temporary line twice - first to erase the previous temp line, second to draw the new one.

[vb6] Get descriptions of API errors

API functions don't exactly adhere to the VB error handling scheme. Instead, they either return numeric error codes or set an error code in an internal register. To retrieve the error code of the last API error in that internal register, use the LastDllError property of the VB Err object. One thing is numeric codes, however, another thing is to get some useful description of what actually went wrong. VB does not provide that for you, but you can use the FormatMessage API to get textual description corresponding to error codes. Pass the error code to the APIerrorDescription below.
    Private Const FORMAT_MESSAGE_FROM_SYSTEM& = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS& = &H200
Private Declare Function FormatMessage& Lib "kernel32" Alias _
"FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long)

Public Function APIerrorDescription(ByVal code As Long) As String
Dim msg As String, r As Long
msg = String(256, 0)
r = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0, code, 0, msg, 256, ByVal 0)
If r Then APIerrorDescription = Left$(msg, r)
End Function

[vb6] Invoke any program from VB code

Use the ShellExecute function to start another program, to print a document file or start explorer in a specified directory. The hwnd parameter is the window handle of your main form, lpOperation specifies the operation you want and can be "open", "print" or "explore" (pass vbNullString to get the default which is "open"). lpFile is the full name of the file. Use lpParameters to specify any parameters to pass to the file, if it's an exe, or vbNullstring if no parameters. nShowCmd specifies how you want the app /doc window to appear, you'd normally pass SW_SHOWNORMAL (=1), but it can be any of the API constants starting with "SW_". The function returns the instance handle of the app, or an error code (those below 33).
    Private Declare Function ShellExecute& Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)

[vb6] Wrap your collections

You can wrap the VBA collection type in a class of your own, and thereby tailor it for any specific use. Paste the code below into a new class module; set the Item property to be the default. Give the NewEnum method a procedure ID of -4 and click the "Hide member" checkbox in the Procedure Attributes dialog. Note that this example is for collecting class objects; that's why the 'Set' keyword is required in the Item Get property. If you are collecting anything else than objects, remove the 'Set'.
This generalized example can be used as a template for generating more specific collection wrappers; for example you may want to replace the Variant type for the object parameters with something more specific and to let the class generate unique strings to use for the keys, or incorporate any other rules into it as it applies. One shortcoming of the VBA collection is the Item method - it is implemented as a method rather than a property. That means that you cannot go: Let TheCollection("key") = MyObject. Instead you have to first remove the object with key "key" and then add MyObject under the same key. That behaviour has been corrected in this example by implementing Item as a property with let and get procedures.
    Option Explicit
Private m_Col As Collection

Public Property Get Count() As Long
Count = m_Col.Count
End Property

Public Sub Add(ByVal NewItem As Variant, ByVal key As Variant)
On Error GoTo ERR_HAND
m_Col.Add NewItem, key
ERR_HAND:
Exit Sub
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Sub

Public Sub Remove(ByVal key As Variant)
On Error GoTo ERR_HAND
m_Col.Remove key
ERR_HAND:
Exit Sub
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Sub

Public Property Let Item(ByVal key As Variant, ByVal NewItem As Variant)
On Error Resume Next
m_Col.Remove key
On Error GoTo ERR_HAND
m_Col.Add NewItem, key
ERR_HAND:
Exit Property
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Property

Public Property Get Item(ByVal key As Variant) As Variant
On Error GoTo ERR_HAND
Set Item = m_Col(key)
Exit Property
ERR_HAND:
Err.Raise Err.Number, "MyCollection Class", Err.Description
End Property

Public Function NewEnum() As IUnknown
Set NewEnum = m_Col.[_NewEnum]
End Function

Private Sub Class_Initialize()
Set m_Col = New Collection
End Sub

[vb6] Autoselect text in textboxes

In some applications, you see textboxes where the entire text is automatically selected when the box obtains focus (The Address box in MS Internet Explorer, for example). You can get the same functionality with a VB textbox by using this code:
    Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub

[vb6] Get hold of string pointers

Some API functions return pointers to strings (char*) allocated by that function. This is all very kind, except that you cannot do anything with that pointer with plain Basic. Use the lstrcpyn and lstrlen API functions to copy a string and to learn the string length, respectively. The pCharToString function shown below wraps the two string functions. For example, suppose an API function has returned you a pointer to a string. You can then call the pCharToString function with the string pointer as the parameter. The return is the copied string.
    Private Declare Function lstrcpyn& Lib "kernel32" Alias _
"lstrcpynA" (ByVal Recipient As String, ByVal pSourceString _
As Long, ByVal iMaxLength As Long)
Private Declare Function lstrlen& Lib "kernel32" Alias _
"lstrlenA" (ByVal lpString As Long)

Public Function pCharToString(ByVal Address As Long) As String
Dim r As Long
r = lstrlen(Address)
pCharToString = String(r, Chr(32))
r = lstrcpyn(pCharToString, Address, r + 1)
End Function

[vb6] CopyMemory and array copying

The CopyMemory API function is extremely handy in many situations, especially when calling API functions or subclassing. The reason is that, unlike some other languages, in VB you cannot access a variable via its memory address. A workaround is to do a physical copy of the data between variables. The declare for the function is very flexible - you can pass any data type for its source and destination parameters, and you can pass them ByVal or Byref - just state "ByVal" in the function call if calling ByVal. The last parameter is for indicating the number of bytes to copy.
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
As an example of using CopyMemory, the code snippet below copies 11 elements from one array to another array, without having to reference each and every array slot. Note that in this case, the parameters can be passed ByRef (as for the pDst parameter) or ByVal as for the pSrc parameter. In the last case a pointer to the first element of the source array is obtained with the (hidden) VarPtr function.
    Dim i As Integer
Dim Receiver(10) As Long
Dim Source(5 To 15) As Long
For i = 5 To 15
Source(i) = i
Next

CopyMemory Receiver(0), ByVal VarPtr(Source(5)), LenB(Source(5)) * 11

[vb6] A cheap CheckFrame control

Some commercial control libraries include a frame control where the caption is replaced by a checkbox control. You don't have to pay for this ! Place a standard frame control on a form and give it the caption " ". Then place a checkbox control on top of that caption.

[vb6] Rounding numbers

If you are displaying real numbers, you might like to display them in rounded format, and possibly with a fixed number of digits after the decimal separator. The format function rounds numbers if you specify a an expression for its format parameter where zeros indicate that the digit is valid and "\0" indicate that the function should append a trailing zero. For example:
    Dim n As Single
n = 23.647
Debug.Print Format$(n, "0.000")
Debug.Print Format$(n, "0.00\0")
Debug.Print Format$(n, "0.0\0\0")
Debug.Print Format$(n, "0.\0\0\0")
Debug.Print Format$(n, "0.00")
If your decimal separator is the dot character, the output from this code is:
    23.647
23.650
23.600
24.000
23.65

[vb6] Subclass forms and controls

Windows continually sends messages to windows, including the forms and controls in a VB application. Visual Basic takes care of responding to all these messages for you. Some messages are passed on to you in the form of control or form events, after VB has done anything it needs to do. Sometimes, this is not good enough. Maybe parameters passed to your events are missing (as in the WM_PAINT) message, maybe the VB response to a message is unwanted or maybe VB does not pass the message on to the developer at all. Then there is a case for subclassing. When Windows "sends a message" what is actually going on is Windows calling a function in the app. For normal VB programs, this function is a function in the VB run-time library. When you subclass a form a control, you tell Windows not to call the function in the VB run-time, but to call a function you supply. In order for this to work you must write a WndProc function with a certain number and type of arguments (as below) and obtain the address of that function. The function has to be in a standard module and you use the VB AddressOf operator to obtain its address. As an example, paste the code below into a standard module. This particular example subclasses the Form1 form and responds to just one message - the WM_GETMINMAXINFO - passing all other messages to the old VB window procedure. If you want to listen to other messages, you must implement code to handle them and get the appropriate WM_ constant from your favourite API viewer or the Win32 documentation.
    Public Declare Function CallWindowProc Lib "User32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam 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 Const GWL_WNDPROC = (-4)
Public m_oldProc As Long 'The old VB window procedure for form1
Private Const WM_GETMINMAXINFO = &H24

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

Dim R As Long

If uMsg = WM_GETMINMAXINFO Then
'Do your processing here ...
'Here: do or don't call the VB window procedure (as below)
Else
'For messages you don't care about, pass it on to VB
R = CallWindowProc(m_oldProc, Form1.hwnd, uMsg, wParam, lParam)
End If

WndProc = R
End Function
In addition, the subclassing needs to be set up and also discontinued at some point - here, in the Form_Load and Form_Unload procedures of Form1, respectively:
    Private Sub Form_Load()
m_oldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong hwnd, GWL_WNDPROC, m_oldProc
End Sub
The above subclassing method works just fine and is probably the most efficient one you're likely to get. However, it is suited only for debugged programs being compiled for release. That is because VB will crash when it hits a breakpoint in your code, essentially making it impossible to debug a program (!). The solution is to use a dll or ocx subclassing component. You can buy one or get one for free.

[vb6] Make ANY form fixed size

Visual Basic forms can be made non-sizable by setting the borderstyle property to 0, 1, 3 or 4. However, that also means that the user cannot minimize the form to the taskbar. Worse, the MDI form cannot be made non-sizable at all. That is, unless you implement the code below. This trick requires that you subclass the form and intercept the WM_GETMINMAXINFO message, not passing the message on to VB. This message is sent to a window when Windows queries for the maximum and minimum sizes of the window and of the tracking rectangle displayed when resizing. The code works by setting the minimum equal to the maximum, effectively making the form fixed in size. In order not to confuse the user, the maximize button in the right side of the title bar should be disabled. Do that by modifying the window style - see other tip "ModifyStyle". In this particular example, the form is fixed at VGA-size and initially centered on the screen, but the size and position is up to you, of course.
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Const WM_GETMINMAXINFO = &H24
Private Const WS_MAXIMIZEBOX& = &H10000

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type

Dim MinMax As MINMAXINFO

Private Sub Form_Load()
ModifyStyle hwnd, WS_MAXIMIZEBOX, 0 'Disable Maximize box
Dim nLeft As Long, nTop As Long

With MinMax
.ptMaxSize.x = 640
.ptMaxSize.y = 480
.ptMinTrackSize.x = .ptMaxSize.x
.ptMinTrackSize.y = .ptMaxSize.y
.ptMaxTrackSize.x = .ptMaxSize.x
.ptMaxTrackSize.y = .ptMaxSize.y
nLeft = (Screen.Width - .ptMaxSize.x * Screen.TwipsPerPixelX) / 2
nTop = (Screen.Height - .ptMaxSize.y * Screen.TwipsPerPixelY) / 2
'Display with new size and centered on screen
Move nLeft, nTop, .ptMaxSize.x * Screen.TwipsPerPixelX, _
.ptMaxSize.y * Screen.TwipsPerPixelY
End With
End Sub
In the window procedure, add the following code to intercept the message. The code works by copying our private MinMax over the MINMAXINFO pointed to by lParam.
    If msg = WM_GETMINMAXINFO Then
CopyMemory ByVal lParam, MinMax, LenB(MinMax)
End If

[vb6] Go to web page or send an e-mail

It is very simple to enable links to web pages in your application or have the user send you an e-mail by clicking on your e-mail address, displayed in a label, for example. Just call the DoWebLink sub below, passing the startup form of your app and a link. The link may be a web-link, like http://www.santa-claus.gl/ or a mail address, like "mailto:SantaClaus@Santaorg.gl". You can make the link more browser-like by displaying it in a blue color and display the hand cursor when the mouse is hovering over it. The cursor can be found under the name h_point.cur on your VB CD-rom.
    Private Const SW_SHOWNORMAL& = 1
Private Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long)

Public Sub DoWebLink(MainForm As Form, sLink As String)
Dim r As Long
If 33 > ShellExecute(MainForm.hwnd, "open", sLink, vbNullString, _
vbNullString, SW_SHOWNORMAL) Then
'raise an error
End If
End Sub

[vb6] Disable default popups

Some controls, such as the intrinsic textbox control, display their own popupmenus, thereby effectively excluding you from displaying your own popup (it looks awkward if the default menu displays, followed by your custom menu). You can disable the default menu by disabling the control, as in the code below. The only disadvantage is that the control displays its disabled state while the custom menu is on - that may be confusing to the user. By using the LockWindowUpdate API, the control never gets a chance to display its disabled state. If the control name is "Text1" and the name of the custom menu is "MyPopUpMenu":
    Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)

If Button = vbRightButton Then
' Avoid the 'disabled' gray text by locking updates
LockWindowUpdate Text1.hWnd
' A disabled TextBox will not display a context menu
Text1.Enabled = False
' Give the previous line time to complete
DoEvents
' Display own context menu
PopupMenu MyPopUpMenu
' Enable the control again
Text1.Enabled = True
' Unlock updates
LockWindowUpdate 0&
End If
End Sub

[vb6] Get the decimal separator and digit grouping symbol

To obtain the current user's settings for the decimal separator and digit grouping symbol, use the GetLocaleInfo function. You can use the same method to retrieve a slurry of other useful information, such as the names of months and days, language, currency format etc.
    Private Const LOCALE_USER_DEFAULT& = &H400
Private Const LOCALE_SDECIMAL& = &HE
Private Const LOCALE_STHOUSAND& = &HF
Private Declare Function GetLocaleInfo& Lib "kernel32" Alias _
"GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, _
ByVal lpLCData As String, ByVal cchData As Long)

Private Function ThousandSeparator() As String
Dim r As Long, s As String
s = String(10, "a")
r = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, s, 10)
ThousandSeparator = Left$(s, r)
End Function

Private Function DecimalSeparator() As String
Dim r As Long, s As String
s = String(10, "a")
r = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, s, 10)
DecimalSeparator = Left$(s, r)
End Function

[vb6] Generic control handling procedure

Sometimes it is useful to perform a certain action or set a certain property for all the controls of a certain type on a form. Say you needed to disable all controls of a certain type:
    Private Sub DisableControls(Frm As Form, CtrlTypeName As String)
Dim nCount As Integer
For nCount = 0 To Frm.Controls.Count - 1
If TypeName(Frm.Controls(nCount)) = CtrlTypeName Then
Frm.Controls(nCount).Enabled = False
End If
Next
End Sub
Of course, the actual modification(s) done to the controls inside the loop can be anything, as long as the methods and properties are defined for the type of control that you pass. Use of the function would be something like: DisableControls Me, "TextBox"
That would disable all TextBoxes on the form.

Tuesday, December 16, 2008

[vb6] Use the RtlMoveMemory API function to copy data

Certain API functions return pointers to memory, that are of little use in VB where there is no intrinsic way of handling direct memory copy or accessing the variable pointed to directly. You can use the following function to copy bytes to a VB variable:
    Private|Public Declare Sub CopyBytes Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal ByteLen As Long).
If the memory address is given as the value of a variable, pass it ByVal, otherwise pass the address of a variable indirectly by passing the variable ByRef. For example, having obtained some pointer from an API function and holding that pointer in variable MyPointer:
    Dim Barray(bLen) as byte
CopyBytes Barray(0), ByVal MyPointer, bLen
You need to determine bLen - the number of bytes to copy - beforehand.

[vb6] VarType function determines what is contained in a variant

The VB VarType function is the way for determining what type of data is contained in a variant variable, if it is an array and of which type. For example:
    Dim Barray(20) As Byte
Dim MyVariant as Variant
MyVariant = Barray
Return = VarType(MyVariant)
"Return" turns out to be equal to vbArray Or vbByte.

[vb6] Use variants for passing arrays to and from classes

An array can be packed in a single variable of type variant. This goes for arrays of any datatype except user-defined types and fixed-length strings. The variant can then be passed to and from functions and subs, e.g.
In a calling procedure:
    Dim B(20) as Byte
Dim V as Variant
V = B
'Call the sub "MySub"
MySub (V)
'-----------------
'In MySub:
Dim Bb() as Byte
Dim Vb as Variant
Bb = Vv
'The Bb array is redimensioned automatically.
Similarly, the variant can be passed back in the form of function result.

[vb6] Use the IS operator to compare objects

With ordinary variables you would use the = operator to compare different variables. This does not work with object variables. Instead you have to use the IS operator, e.g.:
    Dim MyObject as MyClass
Dim MyOtherObject as MyClass

Set MyObject = New MyClass
Set MyOtherObject = MyObject

'Now, the two object variables reference the same object.

If MyOtherObject Is MyObject Then
'The message box should pop up:
MsgBox "Yes, MyObject points to the same object as MyOtherObject and vice versa"
End If
The IS operator must be used within an If - Then statement.

[vb6] Correct use of the Dir function

The Visual Basic Dir function is used to test if a certain file exists in a given directory. The Help topic in VB for the function states the function declaration: Dir[(pathname[, attributes])] The help topic incorrectly states that if the "attributes" parameter is omitted, all files are returned that match "pathname". In fact, if a file is flagged as Hidden, it will not be found by the Dir function, when no attributes are supplied to the function. Correct search for all files irrespective of their flags is therefore: Dir(pathname, vbNormal Or vbHidden Or vbSystem Or vbReadOnly)

[vb6] Disabling user input in combobox

If you don't want the user to be able to modify or delete text in the textbox part of a combobox control, you can set its style to 2 - dropdown list. However, in doing so, you also disable your own ability to do the same, because the text property is read-only at runtime. This means that if the style is set to 2 you cannot set the text property in code and you cannot link the combo box to a database either, because scrolling the database alters the textbox property. The solution is simple: Set the style to 0 - dropdown combo, its locked property to false and add the following to the combobox code:
    Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> vbKeyUp And KeyCode <> vbKeyDown Then
Combo1.Locked = True
End If
End Sub

' The up-down arrow keys must be allowed to enable
' mouse-less users to scroll the list.
' Unlock the combobox again on key up events:
Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
Combo1.Locked = False
End Sub

[vb6] Read the computer name and current user name

These functions may be used to retrieve the computer name and the name of the current user (or at least the names as they are known to the operating system).
    Private Declare Function GetComputerName& Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long)
Private Declare Function GetUserName& Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long)

Private Function ComputerName() As String
Dim s As String, l As Long
l = 15
s = String(l, Chr(32))
GetComputerName s, l
ComputerName = Left$(s, l)
End Function

Private Function UserName() As String
Dim s As String, l As Long
l = 255
s = String(l, Chr(32))
GetUserName s, l
UserName = Left$(s, l)
End Function

[vb6] Get the current color depth

If you are displaying graphics, you might like to learn the current color depth - true-color bitmaps generally don't look good on 256-color screens. The ColorDepth function returns the color depth as a bits per pixel number, for example on a true-color display the function will return 24. The function obtains a screen dc because the GetDeviceCaps function needs a dc for input.
    Private Const PLANES& = 14
Private Const BITSPIXEL& = 12
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long)

Private Function ColorDepth() As Integer
Dim nPlanes As Integer, BitsPerPixel As Integer, dc As Long
dc = GetDC(0)
nPlanes = GetDeviceCaps(dc, PLANES)
BitsPerPixel = GetDeviceCaps(dc, BITSPIXEL)
ReleaseDC 0, dc
ColorDepth = nPlanes * BitsPerPixel
End Function

[vb6] Convert global variables to global properties

You should consider removing all your global variables and implement them as private variables in a BAS module instead. Then, you can declare global property procedures in the BAS module to manipulate the private variables. This way, you can do parameter validation in the property let procedure.

[vb6] Make form stay on top

Sometimes you need a form to stay on top, even when another form has focus, so that its immediately available to the user. This code toggles the OnTop state for a form when passed the hwnd property of a form:
    Private Const GW_HWNDFIRST& = 0
Private Const HWND_NOTOPMOST& = -2
Private Const HWND_TOPMOST& = -1
Private Const SWP_NOMOVE& = &H2
Private Const SWP_NOSIZE& = &H1
Private Declare Function GetWindow& Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long)
Private Declare Function SetWindowPos& Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long)

Private Sub ToggleTopmost(ByVal hWindow As Long)
Dim hw As Long
hw = GetWindow(hWindow, GW_HWNDFIRST)
If hw = hWindow Then
SetWindowPos hWindow, HWND_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos hWindow, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub

[vb6] Enable Form move anywhere

If a form has a title bar, the user can move it by pressing the left mouse button on the title bar and then move the window. However, if the form doesn't have a title bar, it cannot be moved. The sub listed below enables movement of a form, irrespective of its style. Typically, you would call this sub when the user presses the left mouse button on the form and possibly also when he presses the same button on contained controls. The sub works by faking a WM_NCLBUTTONDOWN message to be sent to the form window procedure.
    Private Const HTCAPTION& = 2
Private Const WM_NCLBUTTONDOWN& = &HA1
Private Declare Function SendMessageBynum& Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function ReleaseCapture& Lib "user32" ()

Public Sub StartMove(frm As Form)
ReleaseCapture
SendMessageBynum frm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

[vb6] Convert system colors

Color values are specified in Visual Basic using the OLE_COLOR type. The colors come in two flavors; either true RGB values or the system colors with values above &H80000000. When using Visual Basic functions that take color parameters, VB will convert the system colors to their real value for you. However, Windows API functions don't understand the system values, so you will have to convert them manually. One way to do this is to use the OleTranslateColor function. If you convert a real color, i.e. below &H80000000, the function simply returns the same value, but for system colors, it will return a value that can be used as color parameter in an API call.
    Private Declare Function TranslateColor Lib "olepro32.dll" _
Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, _
ByVal palet As Long, col As Long) As Long

Private Function GetRealColor(ByVal Color As OLE_COLOR) As Long
Dim R As Long
R = TranslateColor(Color, 0, GetRealColor)
If R <> 0 Then 'raise an error
End If
End Function

[vb6] Get the reference count on a VB Class object

The reference count on COM objects, including VB Class objects, are managed by Visual Basic and there is normally no reason to know about it. However, when debugging code involving class objects, it is often useful to read the reference count on an object. The function below returns the reference count, and uses the CopyMemory API and the hidden VB function ObjPtr to retrieve the address of the class object.
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, src As Any, ByVal nbytes As Long)

Private Function GetRefCount(obj As IUnknown) As Long
If obj Is Nothing Then Exit Function
CopyMemory GetRefCount, ByVal (ObjPtr(obj)) + 4, 4
GetRefCount = GetRefCount - 2
End Function

[vb6] Undo the last user action on a Textbox control

Visual Basic lets the user undo his last editing on a textbox control via the Undo item on the Textbox popupmenu, but does not give the developer access to the same functionality. The procedure below does:
    Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lparam As Long)
Private Const EM_UNDO = &HC7&

Private Sub TextUndo(T As TextBox)
SendMessageBynum T.hwnd, EM_UNDO, 0, 0
End Sub

[vb6] Set the margins of a Textbox control

The VB Textbox control superclasses the Windows Edit window class, but doesn't implement its margin property. This procedure sets the left and right margins of a textbox control at run-time, with the margins measured in pixels.
    Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lparam As Long)
Private Const EC_LEFTMARGIN& = &H1&
Private Const EC_RIGHTMARGIN& = &H2&
Private Const EM_SETMARGINS = &HD3&

Private Sub SetTextMargin(T As TextBox, ByVal mLeft As Integer, ByVal mRight As Integer)
Dim lparam As Long
lparam = mLeft + mRight * &H10000
SendMessageBynum T.hwnd, EM_SETMARGINS, EC_LEFTMARGIN Or EC_RIGHTMARGIN, lparam
End Sub

[vb6] Make the toolbar buttons flat

If you have Visual Basic 6, you have the option of creating a toolbar with flat-style buttons. If you have earlier versions of VB, you'll have to do it yourself, like this:
    Public Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, ByVal hWndChildAfter As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String)
Public Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long)
Public Const WM_USER& = &H400
Public Const TBSTYLE_FLAT& = &H800
Public Const TB_SETSTYLE& = (WM_USER + 56)
Public Const TB_GETSTYLE& = (WM_USER + 57)
Public Const TBCLASSNAME = "ToolbarWindow32"

'Make a toolbar flat style
Public Sub MakeFlat(Tb As Toolbar)

Dim Style&, TbHandle&

TbHandle = FindWindowEx(Tb.hwnd, 0&, TBCLASSNAME, vbNullString)
If TbHandle = 0 Then Debug.Print "Error"

Style = SendMessageBynum(TbHandle, TB_GETSTYLE, 0&, 0&)
Style = Style Or TBSTYLE_FLAT

Call SendMessageBynum(TbHandle, TB_SETSTYLE, 0, Style)

End Sub

[vb6] Modify the styles for a window

Some style and extended style bits have no counterpart in VB properties for forms and control windows and hence cannot be set in Visual Basic, but it may be possible to change the style at run-time after the window has been created. Use the ModifyStyle and ModifyStyleEx functions to remove and / or add style bits to the window style or window extended style, respectively. Note that changing these bits will often have no effect in Visual Basic - you have to experiment to find out which modifications work and which do not.
    Private Const GWL_EXSTYLE& = (-20)
Private Const GWL_STYLE& = (-16)
Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)

Public Sub ModifyStyle(ByVal hWindow As Long, _
ByVal Remove As Long, ByVal Add As Long)

Dim style As Long, OldStyle As Long
OldStyle = GetWindowLong(hWindow, GWL_STYLE)
style = (OldStyle And (Not Remove)) Or Add
SetWindowLong hWindow, GWL_STYLE, style

End Sub

Public Sub ModifyStyleEx(ByVal hWindow As Long, _
ByVal Remove As Long, ByVal Add As Long)

Dim xstyle As Long, OldStyle As Long
OldStyle = GetWindowLong(hWindow, GWL_EXSTYLE)
xstyle = (OldStyle And (Not Remove)) Or Add
SetWindowLong hWindow, GWL_EXSTYLE, xstyle

End Sub

For example, to remove the maximize and minimize buttons from a form and make it transparent, you will use the above functions like this:
    ModifyStyle hwnd, WS_MAXIMIZEBOX Or WS_MINIMIZEBOX, 0
ModifyStyleEx hwnd, 0, WS_EX_TRANSPARENT

[vb6] Get value of a hexadecimal string expression

You can convert a numeric value to a hexadecimal string expression using the Hex$ function, but how do you do it the other way round ? Believe it or not, this simple function will do the trick:
    Public Function HxVal(s As String) As Long
HxVal = CLng("&H" & s)
End Function

[vb6] Extract red, green or blue component from color value

The individual color components of an RGB value held in a long can be extracted with some bit manipulation to give values in the range 0 to 255:
    Private Function Red&(ByVal Color&)
Red = Color And (Not &HFFFFFF00)
End Function
Private Function Green&(ByVal Color&)
Green = (Color And (Not &HFFFF00FF)) \ &H100&
End Function
Private Function Blue&(ByVal Color&)
Blue = (Color And (Not &HFF00FFFF)) \ &HFFFF&
End Function

[vb6] Extract WORD from DWORD

When working with API functions, there is frequently a need to extract the low WORD (i.e. bits 0 to 15) or the high WORD (i.e. bits 16 to 31) from a DWORD (usually held in a VB Long variable). The sub below extracts both values and return them as Longs. If you need only one of these values, you can make a LoWord or HiWord function from the sub.
    Public Sub SplitDword(ByVal Dword As Long, HiWord%, LoWord%)
HiWord = (Dword And (Not &HFFFF&)) \ &HFFFF&
LoWord = Dword And &HFFFF&
End Sub

Wednesday, November 26, 2008

[mssql] Performing a case-sensitive search and replace in SQL 2000/2005

If you need to perform a case sensitive search and/or replace in an SQL 2000 or SQL 2005 database you need to use the correct collation method. In the situation I had today I needed to change some copy throughout a website, all of which is in a string resource table, but I had to be careful to maintian case used, i.e: ‘Shipping’ had to change to ‘Delivery’, but ’shipping’ had to change to ‘delivery’.

Your database may have been set up to use a case-sensitive collation method, or it may not have, or you may not have been involved in setup. I don’t know which collation method is the smartest in the world to use - I’m not a DBA - but here’s how to find out which collation you’re working with.

Execute this query in a query analyser:

select charindex('If the result is 0 you are in a case-sensitive collation mode', 'RESULT')

A 0 return result means you’re working with a case-sensitive collation mode. This means you can write your search/replace query (I’ll give an example below) without specifying the collation method you want to use and your query will consider ‘RESULT’ different to ‘result’.

If you DO have to specify a collation method you just have to declare it after the column name you’re interested in. Here’s an example:

update StringResource
set ConfigValue = replace(ConfigValue COLLATE Latin1_General_BIN, 'Shipping', 'Delivery')
from StringResource
where charindex('Shipping', configvalue COLLATE Latin1_General_BIN) > 0

update StringResource
set ConfigValue = replace(ConfigValue COLLATE Latin1_General_BIN, 'shipping', 'delivery')
from StringResource
where charindex('shipping', configvalue COLLATE Latin1_General_BIN) > 0

This query replaces the word ‘Shipping’ with ‘Delivery’ in the ConfigValue column in the StringResource table. There are two seperate statements, one for each case I’m replacing, because I need to specify the casing I’m concerned with explicitly. The important part of the collation type is the _BIN part, which specifies that I want to compare strings as binary data. More information about aspects of collation sorting here. This method may not be the smartest in the world so I would appreciate any comments.

Wednesday, September 10, 2008

[vb6] Why ADO's Find method is the devil

Takeaway: How do you use ADO's Find method with multiple criteria? Easy. You don't. But don't fret, you should be using Filter anyway. Take a look at this superior alternative.

Q: How can I get ADO's Find method to find records based on the values in two different columns?

—Ali Siasifar


A: Well, the short answer is that you can't. ADO's Recordset.Find method works on one column, and one column only. Having said that, you could use something like the code in Listing A, which finds all records in a hypothetical table where the City and Country fields are "London" and "UK," respectively. It does this by finding the first record where Country is "UK" and checking the City field to see if it equals "London." If it does, we have found one of the records we are looking for. If not, we look for the next record where Country is "UK" and try again.

I have to ask, though, why are you using Find? Although Find is appropriate in some situations, using it to locate records is generally very inefficient, both in terms of speed and memory use. Find works by examining each record in a Recordset for the criteria you give it after you have created the Recordset and retrieved all the data from your database. Retrieving lots of unwanted records, particularly down the wire from a server, when you are really interested in only a handful—or even worse, just one bit of data—creates a lot of unnecessary overhead. Unless you have a very compelling reason for using Find, I'd recommend using an alternative approach, like filtering your Recordset or using SQL, for serious performance gains.

Filtering
The Recordset.Filter method filters out records that don't match one or more criteria. You can specify multiple conditions in a filter by using and or or, so using Filter would allow you to check multiple columns. For example, suppose we open a Recordset and execute the following code:
 
rs.Filter = "LastName='Adams' and FirstName='Lamont'"

The Recordsetrs would then contain only records where the LastName and FirstName fields were Adams and Lamont, respectively. If no records existed that match these criteria, rs would be empty, with rs.EOF and rs.BOF both true. To remove a filter from a Recordset, set the Filter property to an empty string ("") or the constant adFilterNone.

Filter does have its drawbacks, of course. Filtering a Recordset requires the creation of a new cursor and makes the "topmost" record in the filtered set the current record. Like Find, a Filter occurs on the client side after the Recordset has been created and data retrieved from the database. So once again, you could be retrieving more data that you need. All these factors contribute to make filtering a Recordset fairly expensive.

Unlike Find, however, filtering does makes sense in some circumstances, such as when you’re working with a large set of data on which you expect to make quite a few filter operations. In situations such as this, the overhead involved in creating multiple Recordsets retrieving small amounts of data may be less than that involved in one trip and multiple filters.

Restricting the results with SQL
Your last option would be to use some kind of a SQL SELECT statement to ensure that the Recordset contained only records with the values you are looking for. SQL processing is done by the data provider and is generally the fastest way to retrieve a restricted set of data because the only real overhead is the opening of the Recordset, which you have to do anyway. Most database systems interpret SQL with blinding speed, at least until you throw multiple joins or subqueries into the mix, so any extra processing time is negligible. Also, by retrieving only the records you want, you cut the waste and overhead of retrieving an entire table of data and filtering or using Find to locate the desired records.

I don’t have space in this column for a class in SQL, but every developer should have at least a basic understanding of it. I will explain, though, just for clarity, that assuming a table name of Customers, the SQL equivalent of the Filter we performed above would be:

rs.Open "SELECT * FROM Customers " _
& "WHERE LastName='Adams' AND " _
& "FirstName='Lamont';", cn

where cn is an open connection object.

A picture is worth 50 records
Throughout this column, I've been stressing that ADO’s Find and Filter methods are inefficient compared to restricting your result set with SQL. But how inefficient are they, exactly? I did a little informal benchmarking on the performance differences of locating multiple records using Find, Filter, and a SQL statement. The results, shown in Figure A, provide a little concrete data to back me up.

Figure A
SQL outperformed Find and Filter in my informal benchmarking.


The time results represent the average number of seconds needed to use a client-side, static cursor to open the Customers table in SQL Server's sample Northwind catalog and locate all records belonging to customers in London. I ran 50 trials using ADO version 2.6. These results will be a bit faster than real-world performance, since the data provider cached the same Recordsets that were opened, closed, and reopened in rapid succession for this rough test. But the differences in speed are still telling, particularly when operating over a network. Keep these results in mind the next time you need to find a few records and you're working with ADO.

Sunday, August 31, 2008

[messanger] Ten Must-Have Plug-ins to Power Up Pidgin

Cross-platform, multi-protocol instant messaging application Pidgin is very functional, but by default it's not what most people would call sexy. But like many great software projects, from Firefox to foobar2000, the looks and extra functionality are there—you just have to know where to find them. Today we're taking a look at 10 of the best Pidgin plug-ins for taking Pidgin from drab to fab.

NOTE: Unless linked elsewhere, the plug-ins listed are included with the default installation of Pidgin—it's just a matter of turning them on in Tools -> Plugins and, in some cases, configuring them.

Stay Smart Over IM with Text Replacement


text-replacements.pngIt's easy to get sloppy on the grammar when you're chatting, but the Text Replacement plug-in's autocorrection macros seamlessly correct common typos on-the-fly. If you've got a particular grammar offense that's not included in Text Replacement by default, you can add your own corrections to the list. Wish you had this functionality in every program? Check out Texter (Windows), TextExpander (Mac), or Snippits (Linux).

Encrypt Chat Sessions with Pidgin-Encrypt

pidgin-encrypt.pngKeep your IM sessions secure without hassle with the Pidgin-Encrypt plug-in. Back when Pidgin was still called GAIM, we showed you how easy it is to set up a secure chat session with this extension. To use Pidgin-Encrypt, download the installer from the Pidgin-Encrypt homepage, enable it in Tools -> Plugins, and then start a secure chat by clicking the padlock icon. UPDATE: A lot of readers are pointing out the Pidgin Off-the-Record plug-in, a more popular peer-reviewed encryption plug-in. The OTR homepage appears to be down at the moment so I haven't been able to try it out, but if you're looking for IM encryption, you may want to consider OTF rather than Pidgin-Encrypt.

Start BitTorrent Downloads through Pidgin with Autoaccept

autoaccept1.pngThe Autoaccept plug-in allows you to set rules for automatically accepting file transfers from specific users. As I pointed out in the top 10 BitTorrent tools and tricks, this feature can, among other things, be especially handy for remotely starting up BitTorrent downloads.

Keep Notified of Chats with Guifications

guifications.pngThe Guifications plug-in notifies you of user status and incoming messages with a small pop-up window in the corner of your screen, similar to how Growl works with Adium on the Mac. You can customize the look, location, and what events will trigger a Guification alert so you're only distracted by a Guification pop-up when you really want to be.

Get SMS Alerts of IMs While You're Away

If instant messaging is an extremely important part of what you do, the gSMS plug-in can keep you abreast of IMs even when you're away from your computer by sending an SMS message to your phone through Google Calendar, of all places. You'll need to download gSMS from the link above to add this plug-in to Pidgin.

Remember Where You Left Off with Enhanced History

history.pngPidgin comes with a built-in History plug-in that automatically inserts your last conversation with the current contact in your new conversation—especially handy if you're rejoining a conversation and want to pick up where you left off (after restarting your computer, for example). If that's enough for your needs, just flip the switch on it and you're set with the default plug-in. If you want more functionality, like the ability to display anywhere from zero to 255 previous conversations or limit chat histories by how long ago they occurred, the non-default Enhanced History plug-in is for you.

Save Your Chat Sessions with SessionSave

This plug-in remembers the state of your Pidgin chat windows when you quit and re-opens your conversation windows just as you left them—sort of like the session saving function built into the Tab Mix Plus Firefox extension. Coupled with one of the History plug-ins above, you won't miss a beat if you have to quickly quit Pidgin or restart your computer.

Add Now Playing Status to Pidgin

musictrac.pngIf you're terrible at setting your status or remembering to change it, let the MusicTracker plug-in update your status for you. The plug-in sets your status to whatever music you're listening to, works with tons of digital music players from iTunes and Winamp on Windows to Amarok and XMMS on Linux, and exactly what it displays is very customizable.

Get Updates on New Releases with Release Notification

If you're a Pidgin die-hard, you'll definitely want to enable the Release Notification plug-in, which periodically checks for updates to Pidgin and alerts you whenever one is available.

Theme Pidgin with the GTK Theme Selector or GTK+ Theme Control

themes-pidgin.pngPidgin runs on both Windows and Linux using the GTK graphical environment, so theming Pidgin is as easy as using GTK's built-in theming tools. Here's how it works on Windows.

First, you probably want to find a good-looking theme. A good place to start is at the Gnome Application Themes, where you can browse tons of GTK themes (like this one I'm using).

Found one? Download it and extract the contents to C:\Program Files\Common Files\GTK\2.0\share\themes (there should already be a few themes in there to give you an idea of what the results should look like). Now you just need to fire up the Gnome Theme Selector (it should be in your Start menu) and pick the theme you just installed.

Alternately, you could install the Pidgin GTK+ Theme Control plug-in, which allows you to adjust Pidgin's look directly from Pidgin.

Tuesday, August 26, 2008

Stone Age Cartoon



[vb6] Pause() function for Wait/Sleep

The best way to pause code execution is to provide a mechanism that gives the parent application such as Excel or Word opportunities to handle events as well as other operating system tasks. The routine below provides both and allows a pause of as little as a hundredth of a second.

Note that the declaration of the Sleep API function has to be placed above all other routines in the module.

[Begin Code Segment]

Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)

Public Sub Pause( _
ByVal Seconds As Single, _
Optional ByVal PreventVBEvents As Boolean)

' Pauses for the number of seconds specified. Seconds can be specified down to
' 1/100 of a second. The Windows Sleep routine is called during each cycle to
' give other applications time because, while DoEvents does the same, it does
' not wait and hence the VB loop code consumes more CPU cycles.

Const MaxSystemSleepInterval = 25 ' milliseconds
Const MinSystemSleepInterval = 1 ' milliseconds

Dim ResumeTime As Double
Dim Factor As Long
Dim SleepDuration As Double

Factor = CLng(24) * 60 * 60

ResumeTime = Int(Now) + (Timer + Seconds) / Factor

Do
SleepDuration = (ResumeTime - (Int(Now) + Timer / Factor)) * Factor * 1000
If SleepDuration > MaxSystemSleepInterval Then SleepDuration = MaxSystemSleepInterval
If SleepDuration < MinSystemSleepInterval Then SleepDuration = MinSystemSleepInterval
Sleep SleepDuration
If Not PreventVBEvents Then DoEvents
Loop Until Int(Now) + Timer / Factor >= ResumeTime

End Sub

[End Code Segment]

The DoEvents call is used to give the managed environment such as Excel or Word opportunities to handle events and do other work. But DoEvents only works within the managed environment and can still consume a considerable amount of resources without some other throttling mechanism. By also using the Windows Sleep API call the Windows operating system is given an opportunity to let other processes run. And, since the code is doing nothing but waiting, it is the appropriate thing to do.

Often the task involves waiting for an asynchronous task to complete such as a web query. To use the above routine while waiting for such a task to compete, two time durations are needed: the total amount of time to wait until it can be assumed that a failure has occurred in the other task, and the amount of time to wait between checks that the other task has completed. Determining how long to wait until giving up requires consideration of the longest possible time that the task could reasonably take and how long the user is willing to wait for that task to complete - wait too long and the user gets frustrated, don't wait long enough and the risk increases of falsely assuming an error occurred when it didn't. This duration is the more difficult to determine of the two. The second time, the duration between checks for completion, is easier to determine. This duration should be long enough to not consume unnecessary CPU cycles doing the check, but short enough to respond quickly when the status of the asynchronous task changes. A duration of between a quarter of a second and one second is usually reasonable. The sample code below illustrates how to wait for an asynchronous task to complete that usually finishes in less than 10 seconds.

  Dim TimeoutTime As Date
TimeoutTime = Now() + TimeSerial(0, 0, 30) ' Allow 30 seconds for the asynchronous task to complete before assuming it failed
Do While Now() < TimeoutTime And Not IsTaskComplete
Pause 0.5 ' Pause half a second to allow the ashyncronous task (and the rest of the environment) to do work
Loop

The above example uses a function named IsTaskComplete to determine if the asynchronous task completed. The function can do anything such as checking if a cell changed, checking if a control's property is set, or checking if a file exists.

Bad Software Developement Cycle Illustration







Monday, July 28, 2008

Oracle connection strings

Oracle ODBC connection strings

Open connection to Oracle database using ODBC
"Driver= {Microsoft ODBCforOracle};Server=Your_Oracle_Server.world;Uid=Your_Username;Pwd=Your_Password;" Oracle OLE DB & OleDbConnection (.NET framework) connection strings Open connection to Oracle database with standard security:
1. "Provider=MSDAORA;Data Source= Your_Oracle_Database;UserId=Your_Username;Password=Your_Password;"
2. "Provider= OraOLEDB.Oracle;Your_Oracle_Database;UserId=Your_Username;Password=Your_Password;"

Open trusted connection to Oracle database
"Provider= OraOLEDB.Oracle;DataSource=Your_Oracle_Database;OSAuthent=1;"

MySQL connection strings

MySQL ODBC connection strings

Open connection to local MySQL database using MySQL ODBC 3.51 Driver
"Provider=MSDASQL; DRIVER={MySQL ODBC 3.51Driver}; SERVER= localhost; DATABASE=Your_MySQL_Database; UID= Your_Username; PASSWORD=Your_Password; OPTION=3"

MySQL OLE DB & OleDbConnection (.NET framework) connection strings

Open connection to MySQL database:
"Provider=MySQLProv;Data Source=Your_MySQL_Database;User Id=Your_Username; Password=Your_Password;"

SQL Server connection strings

SQL ODBC connection strings

Standard Security:<> "Driver={SQLServer};Server=Your_Server_Name;Database=Your_Database_Name;Uid=Your_Username;Pwd=Your_Password;"

Trusted connection:<> "Driver={SQLServer};Server=Your_Server_Name;Database=Your_Database_Name;Trusted_Connection=yes;"

SQL OLE DB connection strings

Standard Security:
"Provider=SQLOLEDB;Data Source=Your_Server_Name;Initial Catalog= Your_Database_Name;UserId=Your_Username;Password=Your_Password;"

Trusted connection:
"Provider=SQLOLEDB;Data Source=Your_Server_Name;Initial Catalog=Your_Database_Name;Integrated Security=SSPI;"

SQL OleDbConnection .NET strings

Standard Security:
"Provider=SQLOLEDB;Data Source=Your_Server_Name;Initial Catalog= Your_Database_Name;UserId=Your_Username;Password=Your_Password;"

Trusted connection:
"Provider=SQLOLEDB;Data Source=Your_Server_Name;Initial Catalog=Your_Database_Name;Integrated Security=SSPI;"

SQL SqlConnection .NET strings

Standard Security:
1. "Data Source=Your_Server_Name;Initial Catalog= Your_Database_Name;UserId=Your_Username;Password=Your_Password;" <>2. "Server=Your_Server_Name;Database=Your_Database_Name;UserID=Your_Username;Password=Your_Password;Trusted_Connection=False"

Trusted connection:
1. "Data Source=Your_Server_Name;Initial Catalog=Your_Database_Name;Integrated Security=SSPI;"
2."Server=Your_Server_Name;Database=Your_Database_Name;Trusted_Connection=True;"

MS Access connection strings

MS Access ODBC connection strings

Standard Security:
"Driver= {MicrosoftAccessDriver(*.mdb)};DBQ=C:\App1\Your_Database_Name.mdb;Uid=Your_Username;Pwd=Your_Password;"

Workgroup:
"Driver={Microsoft Access Driver (*.mdb)}; Dbq=C:\App1\Your_Database_Name.mdb; SystemDB=C:\App1\Your_Database_Name.mdw;"

Exclusive "Driver={Microsoft Access Driver (*.mdb)}; DBQ=C:\App1\Your_Database_Name.mdb; Exclusive=1; Uid=Your_Username; Pwd=Your_Password;"

MS Access OLE DB & OleDbConnection (.NET framework) connection strings

Open connection to Access database:
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=c:\App1\Your_Database_Name.mdb; User Id=admin; Password="

Open connection to Access database using Workgroup (System database):
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=c:\App1\Your_Database_Name.mdb; Jet OLEDB:System Database=c:\App1\Your_System_Database_Name.mdw"

Open connection to password protected Access database:
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=c:\App1\Your_Database_Name.mdb; Jet OLEDB:Database Password=Your_Password"

Open connection to Access database located on a network share:
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=\\Server_Name\Share_Name\Share_Path\Your_Database_Name.mdb"

Open connection to Access database located on a remote server:
"Provider=MS Remote; Remote Server=http://Your-Remote-Server-IP; Remote Provider=Microsoft.Jet.OLEDB.4.0; Data Source=c:\App1\Your_Database_Name.mdb"

Thursday, July 10, 2008

[mssql] Performance Tuning SQL Server Joins

One of the best ways to boost JOIN performance is to limit how many rows need to be JOINed. This is especially beneficial for the outer table in a JOIN. Only return absolutely only those rows needed to be JOINed, and no more.

*****

If you perform regular joins between two or more tables in your queries, performance will be optimized if each of the joined columns have their own indexes. This includes adding indexes to the columns in each table used to join the tables. Generally speaking, a clustered key is better than a non-clustered key for optimum JOIN performance.

*****

If you have two or more tables that are frequently joined together, then the columns used for the joins on all tables should have an appropriate index. If the columns used for the joins are not naturally compact, then considering adding surrogate keys to the tables that are compact in order to reduce the size of the keys, thus decreasing read I/O during the join process, increasing overall performance.

*****

JOIN performance has a lot to do with how many rows you can stuff in a data page. For example, let's say you want to JOIN two tables. Most likely, one of these two tables will be smaller than the other, and SQL Server will most likely select the smaller of the two tables to be the inner table of the JOIN. When this happens, SQL Server tries to put the relevant contents of this table into the buffer cache for faster performance. If there is not enough room to put all the relevant data into cache, then SQL Server will have to use additional resources in order to get data into and out of the cache as the JOIN is performed.

If all of the data can be cached, the performance of the JOIN will be faster than if it is not. This comes back to the original statement, that the number of rows in a table can affect JOIN performance. In other words, if a table has no wasted space, it is much more likely to get all of the relevant inner table data into cache, boosting speed. The moral to this story is to try to get as much data stuffed into a data page as possible. This can be done through the use of a high fillfactor, rebuilding indexes often to get rid of empty space, and to optimize datatypes and widths when creating columns in tables.

*****

Keep in mind that when you create foreign keys, an index is not automatically created at the same time. If you ever plan to join a table to the table with the foreign key, using the foreign key as the linking column, then you should consider adding an index to the foreign key column. An index on a foreign key column can substantially boost the performance of many joins.

*****

Avoid joining tables based on columns with few unique values. If columns used for joining aren’t mostly unique, then the SQL Server optimizer may not be able to use an existing index in order to speed up the join. Ideally, for best performance, joins should be done on columns that have unique indexes.

*****

For best join performance, the indexes on the columns being joined should ideally be numeric data types, not CHAR or VARCHAR, or other non-numeric data types. The overhead is lower and join performance is faster.

*****

For maximum performance when joining two or more tables, the indexes on the columns to be joined should have the same data type, and ideally, the same width.

This also means that you shouldn't mix non-Unicode and Unicode datatypes. (e.g. VARCHAR and NVARCHAR). If SQL Server has to implicitly convert the data types to perform the join, this not only slows the joining process, but it also could mean that SQL Server may not use available indexes, performing a table scan instead.

*****

When you create joins using Transact-SQL, you can choose between two different types of syntax: either ANSI or Microsoft. ANSI refers to the ANSI standard for writing joins, and Microsoft refers to the old Microsoft style of writing joins. For example:

ANSI JOIN Syntax

SELECT fname, lname, department
FROM names INNER JOIN departments ON names.employeeid = departments.employeeid

Former Microsoft JOIN Syntax

SELECT fname, lname, department
FROM names, departments
WHERE names.employeeid = departments.employeeid

If written correctly, either format will produce identical results. But that is a big if. The older Microsoft join syntax lends itself to mistakes because the syntax is a little less obvious. On the other hand, the ANSI syntax is very explicit and there is little chance you can make a mistake.

For example, I ran across a slow-performing query from an ERP program. After reviewing the code, which used the Microsoft JOIN syntax, I noticed that instead of creating a LEFT JOIN, the developer had accidentally created a CROSS JOIN instead. In this particular example, less than 10,000 rows should have resulted from the LEFT JOIN, but because a CROSS JOIN was used, over 11 million rows were returned instead. Then the developer used a SELECT DISTINCT to get rid of all the unnecessary rows created by the CROSS JOIN. As you can guess, this made for a very lengthy query. I notified the vendor's support department about it, and they fixed their code.

The moral of this story is that you probably should be using the ANSI syntax, not the old Microsoft syntax. Besides reducing the odds of making silly mistakes, this code is more portable between database, and eventually, I imagine Microsoft will eventually stop supporting the old format, making the ANSI syntax the only option.