The BlackBeltVB.com Newsletter

Volume 1 Issue 1
February 2000
The Art of Programming
"How long will it take me to learn Visual Basic?"
VC for the VB Programmer
Reading and translating C
UserControl - Non-Integral Height ListBox
Make your ListBoxes the exact size you want
Guest Article
Jerry Beers discusses Agents
Code listing for this Issue

The Art of Programming

by Matt Hart

I've often been asked, "How do I program a game?" or "How do I debug my application?". Unfortunately, there's no easy answer to those questions. Programming and debugging are skills that must be learned. It's like asking "How do I draw this portrait?" You can teach someone how to draw, but you can't tell them how to draw.

My first real learning experience with Basic was when I was debugging programs that I typed into my TRS-80 from SoftSide magazine. I had only the reference manual to go by, but I was learning to program because I had to figure out why the program wasn't working. Lots of trial and error and experimentation characterized my first attempts.

Just like when you learn to draw, learning to program means a lot of erasing and throwing away crude attempts. I once spent a month creating an invoice entry program, attempting to place all the various entry types (about a dozen) into a single module. I decided the design was too cumbersome and scrapped everything. I took another month and a half creating separate modules for each entry type.

The point is that my first attempt wasn't in vain, even though it was scrapped. I learned from the experience and applied it later. Just before Windows 3.0 was released, I wrote a DOS program that translated HP PCL soft fonts and files into a custom font and translated PCL for WYSIWYG editing and viewing. Nothing I wrote for DOS made it into a program, but I took the knowledge and moved it to Windows and wrote a PCL translator/editor in VB.

Many of the samples on this site were written so that I could figure out something. IconView, for instance, is one of my older samples. I wanted to learn how to extract icons from executables and DLLs. When writing samples, or any programs for that matter, I have a specific goal in mind. I've been asked, "What kind of program should I write?" If you don't know, then you have no business being a programmer - or you at least need a partner with some vision. I have so many ideas for programs, I could easily stay busy 34 hours a day.

If an artist sits down at a canvas, he isn't going to ask himself, "Now what should I draw today?" A student artist will receive assignments from an instructor, just as a student programmer will be assigned projects. If you are trying to learn programming without an instructor, then you need to assign yourself some projects. If you want to learn subclassing, then figure out something you want that subclassing could provide, like a Move event for a Form, or an application-level Activate event.

I've had the pleasure to work with many fine programmers throughout my career. Each one has their own style of programming. It is possible for me to glance at the code of one of these people and instantly know who wrote the code. Just like an artist, a programmer develops his or her own distinct style. That's why the question, "How do I program a game?" is virtually impossible to answer - there are as many ways to do it as there are styles of artists.

Finally, another question I see is, "How long will it take me to learn Visual Basic?" The answer: the rest of your life.


VC for the VB Programmer

by Matt Hart

This column is going to be a regular feature for a while in this newsletter. There are so many things that VB is capable of, but there aren't always samples in VB that show how to do it. However, there are usually plenty of samples in C. Some things cannot be translated to VB, but most programs can. In addition to presenting a new sample, this column will try to teach you how to go about translating C programs for yourself. I'll even throw in some information on creating DLLs and ActiveX controls using Visual C++.

Sometimes a translation to VB is very easy. I was recently contacted regarding writing a program that would take a word and make it semi-transparent (embossed), then place the word on the Windows desktop so that it was always visible. The idea was to create an always-visible logo in the same manner as television stations are placing their logos on the screen. I knew how to place a written word on the screen like that, but I didn't know of any easy way emboss a word. If I could find some code to do that, I'd be able to write the program.

As I'm sure you're aware, the Internet is a vast resource that programmers can tap to learn new techniques. I found an excellent sample on Codeguru.com, written by Zafir Anjum. However, the sample is a callable procedure written for VC++. Fortunately, the technique is simple enough to translate into VB.

One of the first things you'll notice about C code is all the data types. VB has one data type, Long, that corresponds to dozens of C "handle" types. HBITMAP, HPALETTE, HBRUSH, HDC, and COLORREF types are all Long Integers. C is very picky regarding these data types, though. You can't just declare a variable as LONG (or INT in 32 bit C) and use it where an HBITMAP is needed. You must typecast the variable. Typecasting is simply the process of declaring what type of variable you need to convert to. Even though you know that both a LONG and an HBITMAP are the same basic data type - a 4 byte integer - C must be told that it's okay to store an HBITMAP in a LONG.

    LONG lvar;
    HBITMAP hbm;
    lvar = (HBITMAP) hbm;

This process of typecasting is used quite often in C code and is one of the first things to trip up an unsuspecting VB programmer. Anytime you see a data type in parentheses, it means that typcasting is being performed.

However, that's not the main trick you need to understand when translating this procedure. Instead, you need to be aware of the properties of the PictureBox and Image controls. An Image control is little more than a bitmap object. When displayed, it is really just "drawn" onto the surface of whatever control it is placed on. The Image control's Picture object holds the bitmap and palette handles. Taking a look at the C procedure's function line:

    HBITMAP Emboss( HBITMAP hBitmap, HBITMAP hbmBackGnd, HPALETTE hPal,
                    BOOL bRaised = TRUE, int xDest = 0, int yDest = 0, 
                    COLORREF clrHighlight, COLORREF clrShadow )

shows that two HBITMAP handles and one HPALETTE handle must be passed. In VB, anything that is a "handle" is a Long Integer. The COLORREF is listed as "a 32 bit value used to specify an RGB color". A 32 bit value in VB is a Long Integer. In 32 bit C, an "int", or Integer, is 32 bits. Thus a C int is a VB Long. A C long is also a VB Long. When the operating system jumps to a 64 bit processor, we'll have to start changing VB code again, because VB's Integer is always 16 bits, and its Long is always 32 bits. The VB translation for the procedure declaration is:

    Public Function Emboss(hBitmap As Long, hbmBackGnd As Long, _
       hPal As Long, bRaised As Boolean, xDest As Long, yDest As Long, _
       clrHighlight As Long, clrShadow As Long) As Long

When translating any graphics commands in C, you need to remember that almost every API function uses pixels, while VB defaults to twips. Thus the xDest and yDest coordinate parameters are going to expect pixels.

Remember when I mentioned the properties of the PictureBox and Image objects? The HBITMAP of an Image control is the Handle property of the Picture object, or Image1.Picture.Handle. The palette is the hPal property, or Image1.Picture.hPal. In the sample included with this article, I don't need the hPal since I'm printing black and white text. However, this is needed if you have a special background like the image supplied with Zafir's sample.

A PictureBox control is a bit different than the Image control. It does have a Picture property that works just like an Image control's. But note that the Picture property (it's really an Object) is a bitmap. Thus, if you haven't specifically loaded in a bitmap, it's nothing, null, zippo. Many VB programmers have been stumped when they draw or print on a PictureBox and save it, only to discover nothing is saved. This is where another property (also an object) comes in - the Image property, not to be confused with the Image control. Unfortunately, it is confusing. Microsoft should have called this object what it really is - the persistant bitmap of the PictureBox control. This is where your drawing and painting is held. However, it's only held if you set the AutoRedraw property of the PictureBox to True. If you don't, then any drawing or paint commands executed on the PictureBox are fed to the current view of the control rather than directly to the persistant bitmap. So when you want to reference or save a PictureBox that is painted, printed, or drawn upon, you need to use the Image property of the PictureBox control - SavePicture Picture1.Image, "filename.bmp".

C doesn't make this distinction. It simply has an hDC object that can be drawn upon. The "persistant bitmap" in C doesn't really exist until it is manually created using the CreateCompatibleBitmap API function. Once it is created, it is "placed" onto the hDC. Then anything drawn upon that hDC becomes part of that persistant bitmap.

That should be enough about graphics to let you understand the reasons for the translation changes. [grin] Anywhere an HSOMETHING is in the C code, it becomes a Long. If there is any (typecasting), it is discarded since not only does VB not use typecasting, everything that's typecast here is a Long. Everything else in the Emboss procedure is a straightforward translation - just insert the API declarations and structures into the VB code and viola - you have a VB translation of a C procedure. Of course, there's a bit more work to get anything to actually display.

To display the entered text, it first must be printed to the PictureBox. The PictureBox is also sized before any printing. To accomplish the Emboss, you also need a background PictureBox. The background can be anything, including a picture or pattern. In this example, I need a single color background because I'll be scanning the embossed result for "valid" pixels so that I can create the transparent effect. First, I setup the working PictureBox, background PictureBox, and a temporary Image control used to store the printed text. The two PBs are initialized with Font and miscellaneous settings once:

Private Sub Form_Load()
    With picMain
        .AutoRedraw = True
        .BorderStyle = 0
        .BackColor = vbWhite
        .ForeColor = vbBlack
        .Font.Name = "Arial"
        .Font.Size = 48
    End With
    With picBack
        .AutoRedraw = True
        .BorderStyle = 0
    End With
End Sub

The text to emboss is printed before the Emboss procedure is called:

    With picMain
        .Visible = False
        .Cls
        .Width = .TextWidth(txtEmboss.Text)
        .Height = .TextWidth(txtEmboss.Text)
    End With
    With picBack
        .Width = picMain.Width
        .Height = picMain.Height
        picBack.Line (0, 0)-(.ScaleWidth, .ScaleHeight), vbYellow, BF
        .Picture = .Image
    End With
    picMain.Print txtEmboss.Text
    imTemp.Picture = picMain.Image

I also delete the previous bitmap and regions, if any, before creating new ones. The HBITMAP embossed image bitmap is then created:

    If hBmp Then DeleteObject hBmp: hBmp = 0
    If hRgn Then DeleteObject hRgn: hRgn = 0
    hBmp = Emboss(imTemp.Picture.Handle, picBack.Picture.Handle, _
                  0, True, 0, 0, vbWhite, vbBlack)

Now that you have an HBITMAP, what do you do with it? Well, just as in C, you must "select" it onto the hDC of the PictureBox control. This code:

    SelectObject picMain.hdc, hBmp

is functionally equivalent to picMain.Picture = LoadPicture("filename.bmp") or Set picMain.Picture = somcontrol.Picture. It selects, or "places", the bitmap onto the hDC of the PictureBox. Unfortunately, the PictureBox doesn't really know that its Picture property is valid at this point. However, we don't absolutely need the Picture property, since everything can be accomplished with the API.

After getting the embossed image (including background) onto the PictureBox, a window region is created and set onto the PictureBox. This region is a poly-polygon region, or a region containing multiple polygons. Each valid pixel in the embossed image is given its own little 4 pixel polygon surrounding and including it. Then all those polygons are created as a region and selected into the PictureBox. The PictureBox is then moved onto the desktop via the SetParent API function and moved to the top/left corner and placed on top of all other windows.

It is possible for other windows to be placed on top after this one, thus obscuring it. You can easily use a Timer to ocassionally set it back on top. This will impose a negligible speed penalty.

Well, that's about it for this time. I hope you enjoy the sample, but more importantly, I hope you have learned a little bit more about translating VC to VB.

Article Code Listing

' Emboss.frm
 Option Explicit

 Const EM_SETSEL = &HB1
 Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Private Sub cmdEmboss_Click()
    Static bHere As Boolean
    If bHere Then Exit Sub
    bHere = True
    MousePointer = vbHourglass
    With picMain
        .Visible = False
        .Cls
        .Width = .TextWidth(txtEmboss.Text)
        .Height = .TextWidth(txtEmboss.Text)
    End With
    With picBack
        .Width = picMain.Width
        .Height = picMain.Height
        picBack.Line (0, 0)-(.ScaleWidth, .ScaleHeight), vbYellow, BF
        .Picture = .Image
    End With
    picMain.Print txtEmboss.Text
    imTemp.Picture = picMain.Image
    
    If hBmp Then DeleteObject hBmp: hBmp = 0
    If hRgn Then DeleteObject hRgn: hRgn = 0
    
    hBmp = Emboss(imTemp.Picture.Handle, picBack.Picture.Handle, 0, _
        True, 0, 0, vbWhite, vbBlack)
    If hBmp Then
        SelectObject picMain.hdc, hBmp
        CreateTransparency picMain
    End If
    picMain.Visible = True
    MousePointer = vbDefault
    bHere = False
End Sub

Private Sub Form_Load()
    With picMain
        .AutoRedraw = True
        .BorderStyle = 0
        .BackColor = vbWhite
        .ForeColor = vbBlack
        .Font.Name = "Arial"
        .Font.Size = 48
    End With
    With picBack
        .AutoRedraw = True
        .BorderStyle = 0
    End With
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If hBmp Then DeleteObject hBmp: hBmp = 0
    If hRgn Then DeleteObject hRgn: hRgn = 0
    If hOldParent Then
        SetParent picMain.hwnd, hOldParent
        hOldParent = 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub txtEmboss_GotFocus()
    SendMessage txtEmboss.hwnd, EM_SETSEL, 0, ByVal -1
End Sub

' Emboss.bas
Option Explicit

Public Const WHITENESS = &HFF0062   ' (DWORD) dest = WHITE
Public Const SRCCOPY = &HCC0020     ' (DWORD) dest = source
Public Const MERGEPAINT = &HBB0226  ' (DWORD) dest = (NOT source) OR dest
Public Const RASTERCAPS = 38        '  Bitblt capabilities
Public Const RC_PALETTE = &H100     '  supports a palette
Public Const ALTERNATE = 1
Public Const BS_SOLID = 0

' SetWindowPos Flags
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40

' SetWindowPos() hwndInsertAfter values
Public Const HWND_TOPMOST = -1

' Bitmap Header Definition
Type BITMAP '14 bytes
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Type POINTAPI
    x As Long
    y As Long
End Type

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
    ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
    ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal nPlanes As Long, _
    ByVal nBitCount As Long, lpBits As Any) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hdc As Long) As Long
Declare Function CreatePolyPolygonRgn Lib "gdi32" (lpPoint As POINTAPI, _
    lpPolyCounts As Long, ByVal nCount As Long, _
    ByVal nPolyFillMode As Long) As Long
Declare Function CreateSolidBrush Lib "gdi32" _
    (ByVal crColor As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" _
    (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
    ByVal x As Long, ByVal y As Long) As Long
Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, _
    ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal dwRop As Long) As Long
Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
    ByVal hObject As Long) As Long
Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, _
    ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _
    ByVal crColor As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long) As Long
Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
    ByVal crColor As Long) As Long
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) As Long
Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
    ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long


'//prototype for default arguments - include this in your header file
'HBITMAP Emboss( HBITMAP hBitmap, HBITMAP hbmBackGnd, HPALETTE hPal,
'               BOOL bRaised = TRUE,
'               int xDest = 0, int yDest = 0,
'               COLORREF clrHighlight = GetSysColor( COLOR_BTNHIGHLIGHT ),
'               COLORREF clrShadow = GetSysColor( COLOR_BTNSHADOW ));

'/////////////////////////////////////////////////////////////////////////
'// Emboss       - Creates a 3D embossed effect
'// Returns      - A new bitmap containing the resulting effect
'// hBitmap      - Bitmap that contains the basic text & shapes
'// hbmBackGnd       - Contains the color image
'// hPal         - Handle of palette associated with hbmBackGnd
'// bRaised      - True if raised effect is desired. False for sunken effect
'// xDest        - x coordinate - used to offset hBitmap
'// yDest        - y coordinate - used to offset hBitmap
'// clrHightlight    - Color used for the highlight edge
'// clrShadow        - Color used for the shadow
'//
'// Note - 1. Neither of the bitmap handles passed in should be selected
'//           in a device context.
'//        2. The pixel at 0,0 in hBitmap is considered the background color
'//

Public hBmp As Long, hRgn As Long, hOldParent As Long

Public Function Emboss(hBitmap As Long, hbmBackGnd As Long, hPal As Long, _
                       bRaised As Boolean, xDest As Long, yDest As Long, _
                        clrHighlight As Long, clrShadow As Long) As Long
    Const PSDPxax As Long = &HB8074A
    Dim bmInfo As BITMAP
    Dim hbmOld As Long, hbmShadow As Long, hbmHighlight As Long, _
        hbmResult As Long, hbmOldMem As Long
    Dim hbrPat As Long
    Dim hdc As Long, hColorDC As Long, hMonoDC As Long, hMemDC  As Long
    Dim lRet As Long

    If Not bRaised Then
        ' // Swap the highlight and shadow color
        Dim clrTemp As Long
        clrTemp = clrShadow
        clrShadow = clrHighlight
        clrHighlight = clrTemp
    End If

    '// We create two monochrome bitmaps. One of them will contain the
    '// highlighted edge and the other will contain the shadow. These
    '// bitmaps are then used to paint the highlight and shadow on the
    '// background image.

    hbmResult = 0
    hdc = GetDC(0)

    '// Create a compatible DCs
    hMemDC = CreateCompatibleDC(hdc)
    hMonoDC = CreateCompatibleDC(hdc)
    hColorDC = CreateCompatibleDC(hdc)

    If hMemDC = 0 Or hMonoDC = 0 Or hColorDC = 0 Then
        If hMemDC Then DeleteDC hMemDC
        If hMonoDC Then DeleteDC hMonoDC
        If hColorDC Then DeleteDC hColorDC
        Exit Function
    End If

    '// Select the background image into memory DC so that we can draw it
    hbmOldMem = SelectObject(hMemDC, hbmBackGnd)
    
    '// Get dimensions of the background image
    Dim bm As BITMAP
    lRet = GetObject(hbmBackGnd, LenB(bm), bm)

    '// Create the monochrome and compatible color bitmaps
    lRet = GetObject(hBitmap, LenB(bmInfo), bmInfo)
    hbmShadow = CreateBitmap(bmInfo.bmWidth, bmInfo.bmHeight, _
        1, 1, ByVal 0)
    hbmHighlight = CreateBitmap(bmInfo.bmWidth, bmInfo.bmHeight, _
        1, 1, ByVal 0)
    hbmResult = CreateCompatibleBitmap(hdc, bm.bmWidth, bm.bmHeight)

    hbmOld = SelectObject(hColorDC, hBitmap)

    '// Set background color of bitmap for mono conversion
    '// We assume that the pixel in the top left corner has the
    '// background color
    lRet = SetBkColor(hColorDC, GetPixel(hColorDC, 0, 0))

    '// Create the highlight bitmap.
    hbmHighlight = SelectObject(hMonoDC, hbmHighlight)
    lRet = PatBlt(hMonoDC, 0, 0, bmInfo.bmWidth, bmInfo.bmHeight, _
        WHITENESS)
    lRet = BitBlt(hMonoDC, 0, 0, bmInfo.bmWidth - 1, bmInfo.bmHeight - 1, _
        hColorDC, 1, 1, SRCCOPY)
    lRet = BitBlt(hMonoDC, 0, 0, bmInfo.bmWidth, bmInfo.bmHeight, hColorDC, _
        0, 0, MERGEPAINT)
    hbmHighlight = SelectObject(hMonoDC, hbmHighlight)


    '// create the shadow bitmap
    hbmShadow = SelectObject(hMonoDC, hbmShadow)
    lRet = PatBlt(hMonoDC, 0, 0, bmInfo.bmWidth, bmInfo.bmHeight, _
        WHITENESS)
    lRet = BitBlt(hMonoDC, 1, 1, bmInfo.bmWidth - 1, bmInfo.bmHeight - 1, _
        hColorDC, 0, 0, SRCCOPY)
    lRet = BitBlt(hMonoDC, 0, 0, bmInfo.bmWidth, bmInfo.bmHeight, _
        hColorDC, 0, 0, MERGEPAINT)
    hbmShadow = SelectObject(hMonoDC, hbmShadow)


    '// Now let's start working on the final image
    lRet = SelectObject(hColorDC, hbmResult)
    '// Select and realize the palette if one is supplied
    If hPal And (GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE) Then
        SelectPalette hColorDC, hPal, False
        RealizePalette hColorDC
    End If
    '// Draw the background image
    lRet = BitBlt(hColorDC, 0, 0, bm.bmWidth, bm.bmHeight, hMemDC, 0, 0, _
        SRCCOPY)
    '// Restore the old bitmap in the hMemDC
    lRet = SelectObject(hMemDC, hbmOldMem)

    '// Set the background and foreground color for the raster operations
    lRet = SetBkColor(hColorDC, RGB(255, 255, 255))
    lRet = SetTextColor(hColorDC, RGB(0, 0, 0))

    '// blt the highlight edge
    hbrPat = CreateSolidBrush(clrHighlight)
    hbrPat = SelectObject(hColorDC, hbrPat)
    hbmHighlight = SelectObject(hMonoDC, hbmHighlight)
    lRet = BitBlt(hColorDC, xDest, yDest, bmInfo.bmWidth, bmInfo.bmHeight, _
        hMonoDC, 0, 0, PSDPxax)
    lRet = DeleteObject(SelectObject(hColorDC, hbrPat))
    hbmHighlight = SelectObject(hMonoDC, hbmHighlight)

    '// blt the shadow edge
    hbrPat = CreateSolidBrush(clrShadow)
    hbrPat = SelectObject(hColorDC, hbrPat)
    hbmShadow = SelectObject(hMonoDC, hbmShadow)
    lRet = BitBlt(hColorDC, xDest, yDest, bmInfo.bmWidth, bmInfo.bmHeight, _
        hMonoDC, 0, 0, PSDPxax)
    lRet = DeleteObject(SelectObject(hColorDC, hbrPat))
    hbmShadow = SelectObject(hMonoDC, hbmShadow)

    '// select old bitmap into color DC
    lRet = SelectObject(hColorDC, hbmOld)

    lRet = DeleteObject(hbmShadow)
    lRet = DeleteObject(hbmHighlight)

    lRet = ReleaseDC(0, hdc)


    '// Release the DC's
    lRet = DeleteDC(hMemDC)
    lRet = DeleteDC(hMonoDC)
    lRet = DeleteDC(hColorDC)

    Emboss = hbmResult
End Function

' Creates a multi-polygon region that uses one polygon for each point.
' On large bitmaps, this can take a while to scan.
Public Sub CreateTransparency(pic As PictureBox)
    Dim h As Long, lBack As Long, lPolyCount As Long, lMax As Long, _
        lNum As Long, x As Long, y As Long
        
    h = pic.hdc
    lBack = GetPixel(h, 0, 0)
    lPolyCount = 0
    
    lMax = 1024
    ReDim pMain(1 To lMax) As POINTAPI
    ReDim lData(1 To lMax) As Long
    lNum = 0
    
    ' Scan for pixels other than the background color and
    ' create polygons for each point.
    For x = 0 To pic.ScaleWidth \ Screen.TwipsPerPixelX - 1
        For y = 0 To pic.ScaleHeight \ Screen.TwipsPerPixelY - 1
            If GetPixel(h, x, y) <> lBack Then
                lPolyCount = lPolyCount + 1
                lNum = (lPolyCount - 1) * 4 + 1
                If lNum + 3 > lMax Then
                    lMax = lNum + 131
                    ReDim Preserve pMain(1 To lMax) As POINTAPI
                    ReDim Preserve lData(1 To lMax) As Long
                End If
                pMain(lNum).x = x
                pMain(lNum).y = y
                pMain(lNum + 1).x = x + 1
                pMain(lNum + 1).y = y
                pMain(lNum + 2).x = x + 1
                pMain(lNum + 2).y = y + 1
                pMain(lNum + 3).x = x
                pMain(lNum + 3).y = y + 1
                lData(lPolyCount) = 4
                DoEvents
            End If
        Next
    Next
        
    ' Create the multi-polygon region
    hRgn = CreatePolyPolygonRgn(pMain(1), lData(1), lPolyCount, ALTERNATE)
        
    ' Set it to the window (PictureBox)
    SetWindowRgn pic.hwnd, hRgn, True
        
    ' Move the PictureBox to the desktop and set it on top of
    ' all other windows. Other "topmost" windows could be
    ' subsequentally moved on top of this one. You would have
    ' to hook all apps to watch for that, or you can just use a
    ' Timer to set the window topmost again every second or sooner.
    ' There would be little to no processor time involved.
    hOldParent = SetParent(pic.hwnd, GetDesktopWindow())
    SetWindowPos pic.hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
        SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub

UserControl - Non-Integral Height ListBox

by Matt Hart

When I wrote the article on setting window styles for the July issue of Visual Basic Programmer's Journal, I knew I'd discovered a valuable and really cool hack. The responses I've received to the article have been very positive - and the questions I've been asked are solveable using that technique.

However, it remains a mystery to most people - in how it works, how to implement it, and where and why to use it. In this article, I'll show you just one of the cool things you can accomplish when you can dynamically modify the style of a window by giving you a non-integral height ListBox control.

You have to wonder what the folks at Microsoft were thinking. I can understand why they might not want to include an owner-drawn ListBox, but I can't figure out why they wouldn't allow you to create the non-integral height ListBox (NIH). An NIH ListBox is one that has a single style bit that isn't set in a normal ListBox. Many programmers are left scratching their collective heads, wondering why that crazy ListBox isn't resizing to the exact height they want. Well, it's because VB's ListBox doesn't support NIH. Instead, it jumps to a lower height that makes its client area an exact number of lines. It doesn't want partial list items showing for some reason.

However, that capability is just a single style bit away. Unfortunately, Microsoft doesn't provide direct access to the styles of a window that are read-only. While some styles can be changed on the fly, others are set and done when the object is created. The NIH style is one of them. This hack is just the thing for changing that style bit.

The caveat to setting the window style is that the application must be hooked before the object that you want changed is created. In VB, this gives you two options: either create a Sub Main procedure that your project starts with rather than a Form_Load, or use the VB Load statement to create a new control array element. Either way is pretty simple, but if you want to change existing code, go with the Sub Main method.

That said, I'm going to show you the Load method first. You'll need to use the Load method if you want both NIH and normal ListBox controls on the same form. Well, you can get away with the Sub Main method anyway, but it's more difficult to figure out which ListBox being created is the one you want to change.

You need to understand Control Arrays. A control array is really just a collection of like controls that have valid Index properties. You can start of with a control array that has a single control. That's what the sample included with the MHListBox control does. One ListBox is on the form with a valid Index property (it's set to 0). The events for control arrays add an Index As Integer parameter to distinguish the control in which the event is occurring. To add another control to the array during run-time, use the Load statement.

    Load List1(1)

That loads a new ListBox control and assigns it an Index property of 1. To activate the MHListBox control so that it changes the style to NIH, place the enable code before the Load and the disable code after the Load.

     MHListBox1.Enable
     Load List1(1)
     MHListBox1.Disable

This causes List1(1) to fall through the MHListBox procedures and have its style changed. That's all you need to get an NIH ListBox using the control.

The Sub Main method affects all ListBox controls on the form. To use it, change your project's properties (Project / Properties) Startup Object to Sub Main. Then the Sub Main procedure will execute before any forms are loaded. Note that you must manually show your main form from the Sub Main procedure - it won't simply load after Sub Main is finished.

Public Sub Main()
    hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, _
                             App.hInstance, App.ThreadID)
    frmMHListBox.Show
    If hHook Then
        UnhookWindowsHookEx hHook
        hHook = 0
    End If
End Sub

Note that I pass the App.hInstance and App.ThreadID in the SetWindowsHookEx API call. While the SDK documentation says that passing nulls allows you to create system-wide hooks, this is only possible from a DLL. At least it is unless you don't mind crashing your system. VB will go ahead and create a system-wide hook, but other applications can't see the hook code and your system will crash.

The Enable and Disable method of the MHListBox control pretty much just execute that same code sans the form show. The functional code is all in the Bas module's AppHook and ListBox_WndProc procedure.

And that's where the trick I learned comes into play. The AppHook procedure watches as various objects are created. It checks the class name of each object. When it finds one that matches the VB ListBox, it subclasses the "future" window handle of that object so that it can catch the WM_CREATE message. Note that VB5 and VB6 have different class names depending on whether you are running in the IDE or as an EXE.

Public Function AppHook(ByVal idHook As Long, ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
    Dim CWP As CWPSTRUCT
    CopyMemory CWP, ByVal lParam, Len(CWP)
    Select Case CWP.message
        Case WM_CREATE
            Dim aClass As String, lRet As Long, k As Long
            aClass = Space$(256)
            lRet = GetClassName(CWP.hwnd, aClass, 256)
            aClass = Left$(aClass, lRet)
            Select Case aClass
                Case "ThunderListBox", "ThunderRT5ListBox", "ThunderRT6ListBox"
                    lWndProc = SetWindowLong(CWP.hwnd, GWL_WNDPROC, _
                                             AddressOf ListBox_WndProc)
            End Select
        End Select
    AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function

That's half the trick. The other half occurs in the subclassing procedure. The only message that procedure ever sees is the WM_CREATE message - it un-subclasses itself after it processes the message. The trick in here that actually took me hours of experimenting to figure out was that you need to set the style using the SetWindowLong API function. I tried modifying the CREATESTRUCT, and the maddening thing was that it worked sometimes. However, SetWindowLong works every time. The original WndProc address is reset immediately after changing the style.

Public Function ListBox_WndProc(ByVal hwnd As Long, ByVal Msg As Long, _
                ByVal wParam As Long, ByVal lParam As Long) As Long
     Select Case Msg
        Case WM_CREATE
            Dim lStyle As Long
            lStyle = GetWindowLong(hwnd, GWL_STYLE)
            lStyle = lStyle Or LBS_NOINTEGRALHEIGHT
            SetWindowLong hwnd, GWL_STYLE, lStyle
            SetWindowLong hwnd, GWL_WNDPROC, lWndProc
        End Select
    ListBox_WndProc = CallWindowProc(lWndProc, hwnd, Msg, wParam, lParam)
End Function

That's it. A simple hack that has proven extremely useful. I've been contacted by many people who read the original VBPJ article and have tried to modify it for their own purposes. Some were successful, while others needed only to look for the proper class name and get the style bits correct. However, the technique fit the bill every time.


Using Microsoft Agent - Part 1

by Jerry Beers

Anyone who has ever watched an episode of Star Trek knows that the vision of the future for computer interfaces includes a conversational interface. Microsoft’s Agent technology takes a big step to implementing this type of interface. The Agent technology is not an application, but a technology that programmers and web developers can use to implement a new interface to their applications and web pages. This technology brings together many pieces including: 3D character animation, text-to-speech, and speech recognition.

There are two main ways to use Microsoft Agent. Using ActiveX, you can include Agent as part of a web page and write scripts using VBScript or Jscript to control it, or you can implement it as part of an application. Since the Agent programming interface is based on COM technology, any language that supports COM can be used to program the Agent services. This article will focus on Visual Basic application development.

Since some of the components of Agent are optional (text-to-speech and speech recognition), they are released as separate packages. The core install program and each of the components can be downloaded and installed from the following location:

http://www.microsoft.com/msagent

For our sample, we will build a VB application that uses Microsoft Agent characters to interact with the user and will allow the user to launch programs from a specified directory using voice commands. The sample will be developed in three articles: first we will learn the basics of Microsoft Agent, then we will learn to program the Agent control to respond to spoken commands, and finally we will learn how to use the Agent technologies on a web page.

To get started, install at least the core components, start a new project and include the Microsoft Agent Control as one of the components of your project. In order to use the text-to-speech and speech recognition features, you will have to install these components too. Note that if you are using Windows 2000, the core components are installed by default with the operating system.

Although most programs you will write that use the Agent control will have a traditional interface too, for this example, we are going to work with the Agent alone so change the form’s Form’s visible Visible property to false. Drop the Agent control on your form and name it Agent.

The Agent services can control multiple characters at once. A character’s information is stored in a file with an "acs" extension. This file defines the animations that the character supports and also the text-to-speech properties for that character, i.e. its "voice." In order to use a character, first it must be loaded into the Agent control’s characters collection. We will do this in the Form_Load event procedure:

    Dim aCharFile as String, aAgentName as String
    aCharFile = "merlin.acs"    ' since this is a relative path,
                                ' the Windows\msagent\chars directory
                                ' will be used

    aAgentName = "Jerry"        ' This is an arbitrary string you
                                ' can use to identify your character
    Agent.Characters.Load aAgentName, aCharFile

The aAgentName parameter is an arbitrary string that you will use to refer to that character. The same character cannot be loaded more than once for each instance of the control. If more than one application or instance of the control refers to the same character, the Agent services will not show the character twice. The aCharFile parameter tells the Agent control where to find the file for this character. If this parameter is omitted, the default character, as specified by the user, will be used. If this parameter is not a full path, the path will be prefixed with the Windows\msagent\chars directory.

In order to easily work with the character currently being used, declare an object in the general declarations section of the form:

    Dim CurAgent As IagentCtlCharacterEx

Now you can set this object to any character that has already been loaded:

    Set CurAgent = Agent.Characters(aAgentName)

This gives us an easy reference to this character in the collection. The aAgentName parameter is a string that matches the one used in the Load call.

Finally we are set up and ready to do something visual with our character. Any animation supported by the character can be played using the Play method. There are two special animations that have their own methods, the "Showing" animation (with the Show method) and the "Hiding" animation (with the Hide method). Before you can do any interaction with your character, you must first show it:

    CurAgent.Show

This will cause the character to become visible by playing the "Showing" animation. Now we can play some of the other animations. A list of the supported animations for the Microsoft characters can be found at the following location:

http://www.microsoft.com/msagent/documentation.htm

For a list of supported animations for third party characters, consult the documentation that comes with the character. There are a few common animations, but there is no guarantee that third party characters will support them.

    CurAgent.Play "Greet"
    CurAgent.Play "Wave"

Now we want our character to speak to us. The Speak method allows us to tell the character what to say. There are two parameters to the Speak method, and although they are both optional, at least one of them must be supplied. The first parameter supplies the text to be spoken and the second parameter specifies the path of an audio file to use. If the second parameter is not used, the text-to-speech engine will be used (if installed). We will discuss the use of an audio file in a later article. For now, just use the first parameter to specify the text to speak:

    CurAgent.Speak "Hello|Hi|Howdy"

If the text includes the vertical bar character "|", the server will randomly choose from the phrases separated by that bar. In the example, the character will sometimes say "Hello," sometimes will say "Hi," and other times will say "Howdy." This allows you to make the character a little more natural by choosing between similar phrases.

Finally, we need a way to end the application. When the user right-clicks on the character, a pop-up menu will appear allowing the user to hide that character. This will fire the Hide event of the Agent control. Keep in mind that in a normal situation there would be some additional interface that would allow the user to exit the application. For our sample, we will end the application in the Hide event procedure:

    ' This event fires when the character is hidden.
    ' The cause parameter tells why it was hidden:
    '  1 = User hid the character through the character's
    '      taskbar icon pop-up menu or using speech input.
    '  3 = This application hid the character in code
    '  5 = Another application hid the character in code
    '  7 = User hid the character through the character's pop-up menu.
Private Sub Agent_Hide(ByVal CharacterID As String, _
                       ByVal Cause As Integer)
    ' Unload the main form, thereby ending the application
    Unload Me
End Sub

As you can see, with very little code you can easily control the Agent characters to do quite a lot. In this simple example we have learned how to set up the Agent services and control the character animations and speech. In the next article, we will delve a little deeper into the features of the Agent services and learn how to add voice commands to which the characters will respond.


Back to Newsletters
Copyright © 2000 by Matt Hart and Jerry Beers, All Rights Reserved Worldwide.
Nothing on this web site may be reproduced, in any form, without express written consent.