Welcome Guest!
 VB 6 Helper
 Previous Message All Messages Next Message 
VB6 Helper Newsletter  Rod Stephens
 Apr 10, 2004 06:06 PDT 

Karen's D & Ds this week mentions MDAC 2.8 SDK. For those of you who
don't know, MDAC (Microsoft Data Access Components) is basically a free
restricted version of SQL Server. You can use it to build relatively
small applications. Later, if you decide you need a more powerful
database, you can easily upgrade to a full version of SQL Server. This
is much easier than developing on an Access database and then later
moving to SQL Server. If you haven't looked into MDAC before, you should
at least read about it now.

Have a great week and thanks for subscribing!

Rod
RodSte-@vb-helper.com
==========

    VB6 Contents:
1. Updated Discussion: How To Become An Expert Programmer
2. Updated HowTo: Prevent a form from moving
3. New HowTo: Use the LoadImage API function to antialias an image and
save the result into a file
4. Converted HowTo: Make a picture box with a hole in it
5. Converted HowTo: Delete a registry key and its subkeys
6. Converted HowTo: Save and restore FlexGrid data in a file when a
program starts and stops
7. Converted HowTo: Change controls faster by preventing window updates
8. Converted HowTo: Lock the computer so the user cannot use other
programs
9. Converted HowTo: Lock the computer and trap the mouse so the user
cannot move it outside of the form
10. Converted HowTo: Make an animated lottery number generator
11. Converted HowTo: Disable certain key combinations such as Alt-Tab
12. Converted HowTo: Make an 8-bit device independent bitmap (DIB) from
scratch
13. Converted HowTo: Create program groups and items in program groups
14. Converted HowTo: Make a mask image for a picture with a
"transparent" color

    Both Contents:
15. New Story: OCR Characters
16. New Links
17. Karen Watterson's Weekly Destinations and Diversions (D & D)
==========
++++++++++
   <VB6>
++++++++++
==========
1. Updated Discussion: How To Become An Expert Programmer
http://www.vb-helper.com/discussion_become_expert.html

Marcus Keustermans (Mar-@forwardslash.com) adds his story.
==========
2. Updated HowTo: Prevent a form from moving
http://www.vb-helper.com/howto_no_move.html
http://www.vb-helper.com/HowTo/howto_no_move.zip

Last week this example showed how to subclass to prevent a form from
moving.

Martijn Coppoolse (vb-help-@martijn.coppoolse.com) points out that
in VB 6 you can set the form's Moveable property to False. That's a LOT
easier!

You can perform more arbitrary restriction's of the form's size and
position using subclassing, but I've rarely seen a program that needed
to do so.
==========
3. New HowTo: Use the LoadImage API function to antialias an image and
save the result into a file
http://www.vb-helper.com/howto_antialias_with_loadimage_into_file.html
http://www.vb-helper.com/HowTo/howto_antialias_with_loadimage_into_file.zip


If you use the LoadIMage API function to load an image into a PictureBox
and then you pass the control's Picture property to SavePicture, you get
a picture containing the PictureBox's background. I don't know why this
is true but here's a workaround.

Rather than assigning the loaded image directly to the PictureBox, the
program loads it into a temporary memory context and then uses BitBlt to
copy the result into the PictureBox. Setting pic.Picture = pic.Image at
the end makes the picture permanent. For example, if you use pic.Cls
after this, the picture remains.

' Use LoadImage to load the picture.
Private Sub LoadWithLoadImage(ByVal pic As PictureBox, ByVal file_name
As String)
Dim hbm As Long
Dim wid As Long
Dim hgt As Long
Dim temp_dc As Long

    ' Load the image using LoadImage.
    wid = pic.ScaleX(pic.ScaleWidth, pic.ScaleMode, vbPixels)
    hgt = pic.ScaleY(pic.ScaleHeight, pic.ScaleMode, vbPixels)
    hbm = LoadImage(ByVal 0&, file_name, _
        IMAGE_BITMAP, wid, hgt, LR_LOADFROMFILE)

    ' Make a device context to hold the picture.
    temp_dc = CreateCompatibleDC(0)
    SelectObject temp_dc, hbm

    ' Copy the picture into the PictureBox.
    BitBlt pic.hdc, 0, 0, wid, hgt, temp_dc, 0, 0, SRCCOPY

    ' Delete the DC and bitmap.
    DeleteDC temp_dc
    DeleteObject hbm

    ' Make the image permanent.
    pic.Picture = pic.Image
End Sub

Private Sub Form_Load()
Dim file_name As String

    file_name = App.Path
    If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"

    ' Load using LoadPicture.
    imgUnaliased.Picture = LoadPicture(file_name & "HalfJack2.bmp")

    ' Load using LoadWithLoadImage.
    LoadWithLoadImage picAliased, file_name & "HalfJack2.bmp"

    ' Copy the picture to an Image control.
    imgCopy.Picture = picAliased.Picture

    ' Save the picture into a file.
    SavePicture picAliased.Picture, file_name & "HalfJack2_small.bmp"
End Sub
==========
4. Converted HowTo: Make a picture box with a hole in it
http://www.vb-helper.com/howto_holed_picturebox.html
http://www.vb-helper.com/HowTo/howto_holed_picturebox.zip

This example uses CreateRectRgn to make a region that includes the whole
picture box. It uses CreateEllipticRgn to create a region in the center.
It then uses CombineRgn to subtract the second region from the first and
uses SetWindowRgn to restrict the picture box to the resulting region.

Private Sub Form_Resize()
Const RGN_DIFF = 4

Dim outer_rgn As Long
Dim inner_rgn As Long
Dim combined_rgn As Long
Dim wid As Single
Dim hgt As Single
Dim border_width As Single
Dim title_height As Single

    If WindowState = vbMinimized Then Exit Sub
    
    With picBox
        ' set the picture box to be measured in pixels
        .ScaleMode = vbPixels
        
        ' Create the regions.
        wid = .Width
        hgt = .Height
        outer_rgn = CreateRectRgn(0, 0, wid, hgt)
        
        border_width = (wid - .ScaleWidth) / 2
        title_height = hgt - border_width - .ScaleHeight
        inner_rgn = CreateEllipticRgn( _
            border_width + .ScaleWidth * 0.1, _
            title_height + .ScaleHeight * 0.1, _
            .ScaleWidth * 0.9, .ScaleHeight * 0.9)
    
        ' Subtract the inner region from the outer.
        combined_rgn = CreateRectRgn(0, 0, 0, 0)
        CombineRgn combined_rgn, outer_rgn, _
            inner_rgn, RGN_DIFF
        
        ' Restrict the picture box to the region.
        SetWindowRgn .hWnd, combined_rgn, True
    End With
End Sub
==========
5. Converted HowTo: Delete a registry key and its subkeys
http://www.vb-helper.com/howto_delete_registry_keys.html
http://www.vb-helper.com/HowTo/howto_delete_registry_keys.zip

Recursively delete any subkeys. Then use the RegDeleteKey API function
to delete the key.

WARNING: Messing around with the Registry can be extremely dangerous. If
you accidentally delete the wrong part of your registry, you may make
your system unbootable.

' Delete this key.
Private Sub DeleteKey(ByVal section As Long, ByVal key_name As String)
Dim pos As Integer
Dim parent_key_name As String
Dim parent_hKey As Long

    If Right$(key_name, 1) = "\" Then key_name = Left$(key_name,
Len(key_name) - 1)

    ' Delete the key's subkeys.
    DeleteSubkeys section, key_name

    ' Get the parent's name.
    pos = InStrRev(key_name, "\")
    If pos = 0 Then
        ' This is a top-level key.
        ' Delete it from the section.
        RegDeleteKey section, key_name
    Else
        ' This is not a top-level key.
        ' Find the parent key.
        parent_key_name = Left$(key_name, pos - 1)
        key_name = Mid$(key_name, pos + 1)

        ' Open the parent key.
        If RegOpenKeyEx(section, _
            parent_key_name, _
            0&, KEY_ALL_ACCESS, parent_hKey) <> ERROR_SUCCESS _
        Then
            MsgBox "Error opening parent key"
        Else
            ' Delete the key from its parent.
            RegDeleteKey parent_hKey, key_name

            ' Close the parent key.
            RegCloseKey parent_hKey
        End If
    End If
End Sub

' Delete all the key's subkeys.
Private Sub DeleteSubkeys(ByVal section As Long, ByVal key_name As
String)
Dim hKey As Long
Dim subkeys As Collection
Dim subkey_num As Long
Dim length As Long
Dim subkey_name As String

    ' Open the key.
    If RegOpenKeyEx(section, key_name, _
        0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
    Then
        MsgBox "Error opening key '" & key_name & "'"
        Exit Sub
    End If

    ' Enumerate the subkeys.
    Set subkeys = New Collection
    subkey_num = 0
    Do
        ' Enumerate subkeys until we get an error.
        length = 256
        subkey_name = Space$(length)
        If RegEnumKey(hKey, subkey_num, _
            subkey_name, length) _
                <> ERROR_SUCCESS Then Exit Do
        subkey_num = subkey_num + 1

        subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) -
1)
        subkeys.Add subkey_name
    Loop
    
    ' Recursively delete the subkeys and their subkeys.
    For subkey_num = 1 To subkeys.Count
        ' Delete the subkey's subkeys.
        DeleteSubkeys section, key_name & "\" & subkeys(subkey_num)

        ' Delete the subkey.
        RegDeleteKey hKey, subkeys(subkey_num)
    Next subkey_num

    ' Close the key.
    RegCloseKey hKey
End Sub

The GetKeyInfo function shown in the following code builds a string
describing a key and its subkeys.

' Get the key information for this key and
' its subkeys.
Private Function GetKeyInfo(ByVal section As Long, ByVal key_name As
String, ByVal indent As Integer) As String
Dim subkeys As Collection
Dim subkey_values As Collection
Dim subkey_num As Integer
Dim subkey_name As String
Dim subkey_value As String
Dim length As Long
Dim hKey As Long
Dim txt As String
Dim subkey_txt As String

    Set subkeys = New Collection
    Set subkey_values = New Collection

    If Right$(key_name, 1) = "\" Then key_name = Left$(key_name,
Len(key_name) - 1)

    ' Open the key.
    If RegOpenKeyEx(section, _
        key_name, _
        0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
    Then
        MsgBox "Error opening key."
        Exit Function
    End If

    ' Enumerate the subkeys.
    subkey_num = 0
    Do
        ' Enumerate subkeys until we get an error.
        length = 256
        subkey_name = Space$(length)
        If RegEnumKey(hKey, subkey_num, _
            subkey_name, length) _
                <> ERROR_SUCCESS Then Exit Do
        subkey_num = subkey_num + 1
        
        subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) -
1)
        subkeys.Add subkey_name
    
        ' Get the subkey's value.
        length = 256
        subkey_value = Space$(length)
        If RegQueryValue(hKey, subkey_name, _
            subkey_value, length) _
            <> ERROR_SUCCESS _
        Then
            subkey_values.Add "Error"
        Else
            ' Remove the trailing null character.
            subkey_value = Left$(subkey_value, length - 1)
            subkey_values.Add subkey_value
        End If
    Loop
    
    ' Close the key.
    If RegCloseKey(hKey) <> ERROR_SUCCESS Then
        MsgBox "Error closing key."
    End If

    ' Recursively get information on the keys.
    For subkey_num = 1 To subkeys.Count
        subkey_txt = GetKeyInfo(section, key_name & "\" &
subkeys(subkey_num), indent + 2)
        txt = txt & Space(indent) & _
            subkeys(subkey_num) & _
            ": " & subkey_values(subkey_num) & vbCrLf & _
            subkey_txt
    Next subkey_num

    GetKeyInfo = txt
End Function
==========
6. Converted HowTo: Save and restore FlexGrid data in a file when a
program starts and stops
http://www.vb-helper.com/howto_load_flexgrid.html
http://www.vb-helper.com/HowTo/howto_load_flexgrid.zip

Subroutine LoadData opens the data file. It uses Input to read the
number or rows and columns displayed by the FlexGrid and sets the
control's Rows and Cols properties.

Private Sub LoadData()
Dim file_name As String
Dim fnum As Integer
Dim max_row As Integer
Dim max_col As Integer
Dim R As Integer
Dim C As Integer
Dim txt As String
Dim max_len As Single
Dim new_len As Single

    file_name = App.Path
    If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
    file_name = file_name & "FlexGrid.dat"

    fnum = FreeFile
    Open file_name For Input As fnum

    ' Hide the control until it's loaded.
    MSFlexGrid1.Visible = False
    DoEvents

    ' Get the maximum row and column.
    Input #fnum, max_row, max_col

    MSFlexGrid1.FixedCols = 0
    MSFlexGrid1.Cols = max_col + 1
    MSFlexGrid1.FixedRows = 1
    MSFlexGrid1.Rows = max_row + 1

    ' Load the cell entries.
    For R = 0 To max_row
        For C = 0 To max_col
            Input #fnum, txt
            MSFlexGrid1.TextMatrix(R, C) = txt
        Next C

        ' Read the last blank entry.
        Input #fnum, txt
    Next R

    Close #fnum

    ' Size the columns.
    Font.Name = MSFlexGrid1.Font.Name
    Font.Size = MSFlexGrid1.Font.Size
    For C = 0 To max_col
        max_len = 0
        For R = 0 To max_row
            new_len = TextWidth(MSFlexGrid1.TextMatrix(R, C))
            If max_len < new_len Then max_len = new_len
        Next R
        MSFlexGrid1.ColWidth(C) = max_len + 240
        MSFlexGrid1.ColAlignment(C) = flexAlignLeftCenter
    Next C

    ' Display the control.
    MSFlexGrid1.Visible = True
End Sub

Subroutine SaveData opens the data file and writes the number of rows
and columns into it. It then loops through the FlexGrid's cells writing
its values into the file.

' Save the FlexGrid data.
Private Sub SaveData()
Dim file_name As String
Dim fnum As Integer
Dim max_row As Integer
Dim max_col As Integer
Dim R As Integer
Dim C As Integer

    file_name = App.Path
    If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
    file_name = file_name & "FlexGrid.dat"

    fnum = FreeFile
    Open file_name For Output As fnum

    ' Save the maximum row and column.
    max_row = MSFlexGrid1.Rows - 1
    max_col = MSFlexGrid1.Cols - 1
    Write #fnum, max_row, max_col

    For R = 0 To max_row
        For C = 0 To max_col
            Write #fnum, MSFlexGrid1.TextMatrix(R, C);
        Next C
        Write #fnum,
    Next R

    Close fnum
End Sub
==========
7. Converted HowTo: Change controls faster by preventing window updates
http://www.vb-helper.com/howto_lockwindowupdate .html
http://www.vb-helper.com/HowTo/howto_lockwindowupdate .zip

Thanks to <A HREF="mailto:david.j-@ena.lu">David Jacquet</A>.

If you check the Lock Updates box, the program calls the
LockWindowUpdates API function. It then loads a bunch of values into a
ListBox, unlocks updates if it previously locked them, and displays the
elapsed time.

Private Sub Command1_Click()
Dim start_time As Single
Dim i As Long
Dim num_items As Long

    num_items = CLng(txtNumItems.Text)
    List1.Clear
    lblTime.Caption = ""
    MousePointer = vbHourglass
    DoEvents

    start_time = Timer

    If Check1.Value = vbChecked Then
        ' Lock the window to prevent updates.
        LockWindowUpdate List1.hWnd 'locks the refresh control
    End If

    ' Create the list items.
    For i = 1 To num_items
        List1.AddItem "Item " & Format$(i) & _
            " of " & Format$(num_items)
    Next i

    If Check1.Value = vbChecked Then
        ' Unlock the window so it can update again.
        LockWindowUpdate 0
    End If

    lblTime.Caption = Format$(Timer - start_time, "0.00") & _
        " seconds"

    MousePointer = vbDefault
End Sub

In one test, the program took 4.99 seconds to load 30,000 list items
without locking. It took only 3.4 seconds with LockWindowUpdate.
==========
8. Converted HowTo: Lock the computer so the user cannot use other
programs
http://www.vb-helper.com/howto_lock_computer.html
http://www.vb-helper.com/HowTo/howto_lock_computer.zip

The program uses SetWindowPos to make its form topmost and position it
over the entire screen including the task bar. It then uses the
SystemParametersInfo API function to tell the system a screen saver is
running. That disables Alt-Tab and Ctl-Alt-Del.

Private Sub cmdLockWorkstation_Click()
Dim prev_value As Long
Dim wid As Long
Dim hgt As Long

    cmdLockWorkstation.Enabled = False
    cmdUnlockWorkstation.Enabled = True
    cmdExit.Enabled = False

    ' Save the current size and position.
    m_LastLeft = Left
    m_LastTop = Top
    m_LastWidth = Width
    m_LastHeight = Height

    ' Put the form on top of everything including
    ' the task bar.
    wid = Screen.Width / Screen.TwipsPerPixelX
    hgt = Screen.Height / Screen.TwipsPerPixelY
    SetWindowPos hwnd, HWND_TOPMOST, 0, 0, wid, hgt, 0

    ' Tell the system a screen saver is running.
    SystemParametersInfo SPI_SCREENSAVERRUNNING, True, prev_value, 0
End Sub

To unlock the workstation, the program uses SystemParametersInfo to tell
the system that no screen saver is running.

Private Sub cmdUnlockWorkstation_Click()
Dim prev_value As Long

    cmdLockWorkstation.Enabled = True
    cmdUnlockWorkstation.Enabled = False
    cmdExit.Enabled = True

    ' Restore the size and position.
    Move m_LastLeft, m_LastTop, m_LastWidth, m_LastHeight

    ' Tell the system no screen saver is running.
    SystemParametersInfo SPI_SCREENSAVERRUNNING, False, prev_value, 0
End Sub

This program may not work on all operating systems.
==========
9. Converted HowTo: Lock the computer and trap the mouse so the user
cannot move it outside of the form
http://www.vb-helper.com/howto_lock_computer_trap_mouse.html
http://www.vb-helper.com/HowTo/howto_lock_computer_trap_mouse.zip

Thanks to <A HREF="mailto:Chr-@Provider-Services.com">Chris Wagg</A>.

The program uses the ClipCursor API function to confine the mouse to the
form. It then uses the SystemParametersInfo API function to tell the
system a screen saver is running. That disables Alt-Tab and Ctl-Alt-Del.
The user can see what's on the screen but cannot get the mouse out of
the form.

Private Sub cmdLockWorkstation_Click()
Dim window As RECT

    cmdLockWorkstation.Enabled = False
    cmdUnlockWorkstation.Enabled = True
    cmdExit.Enabled = False

    ' Restrict the mouse to this window.
    GetWindowRect hwnd, window
    ClipCursor window

    ' Tell the system a screen saver is running.
    SystemParametersInfo SPI_SCREENSAVERRUNNING, True, 0, 0
End Sub

To unlock the computer, the program uses the ClipCursor API function to
free the mouse. It then calls the SystemParametersInfo API function to
indicate that no screen saver is running.

Private Sub cmdUnlockWorkstation_Click()
    cmdLockWorkstation.Enabled = True
    cmdUnlockWorkstation.Enabled = False
    cmdExit.Enabled = True

    ' Free the mouse
    ClipCursorByNum 0&

    ' Tell the system no screen saver is running.
    SystemParametersInfo SPI_SCREENSAVERRUNNING, False, 0, 0
End Sub
==========
10. Converted HowTo: Make an animated lottery number generator
http://www.vb-helper.com/howto_lotto.html
http://www.vb-helper.com/HowTo/howto_lotto.zip

Thanks to Greg Doran (GJ-@eircom.ie).

The program displays balls falling down into a read out area and showing
their numbers. It uses Shape controls to represent the balls and Line
controls to perform some line drawing. It's quite an elaborate
animation!

See the code for details.
==========
11. Converted HowTo: Disable certain key combinations such as Alt-Tab
http://www.vb-helper.com/howto_disable_keys.html
http://www.vb-helper.com/HowTo/howto_disable_keys.zip

Thanks to <A HREF="mailto:Her-@Eldering.net">Herman Eldering</A>.

Use a low-level keyboard hook WH_KEYBOARD_LL.

This works only for NT 4.0 SP3 and later, and Windows 2000. It doesn't
work for Windows 98. It probably works for Windows XP (someone <A
HREF="mailto:RodSte-@vb-helper.com">let me know</A>).

WARNING: Use this at your own risk. You could conceivably use it to
prevent all keyboard input and really mess up your system.

When you check or uncheck the program's check box, the following code
installs or uninstalls the keyboard hook.

Private Sub chkDisable_Click()
    If chkDisable = vbChecked Then
        hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf
LowLevelKeyboardProc, App.hInstance, 0)
    Else
        UnhookWindowsHookEx hhkLowLevelKybd
        hhkLowLevelKybd = 0
    End If
End Sub

The keyboard hook looks for the Alt-Tab, Alt-Escape, and Ctrl-Escape key
combinations. If it finds one of those, it "eats" the key stroke.

Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam
As Long, ByVal lParam As Long) As Long
   Dim fEatKeystroke As Boolean
   
   If (nCode = HC_ACTION) Then
      If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam =
WM_KEYUP Or wParam = WM_SYSKEYUP Then
         CopyMemory p, ByVal lParam, Len(p)
         fEatKeystroke = _
            p.vkCode = VK_LWIN Or _
            p.vkCode = VK_RWIN Or _
            p.vkCode = VK_APPS Or _
            p.vkCode = VK_CONTROL Or _
            p.vkCode = VK_SHIFT Or _
            p.vkCode = VK_MENU Or _
            ((GetKeyState(VK_CONTROL) And &H8000) <> 0) Or _
            ((p.flags And LLKHF_ALTDOWN) <> 0)
        End If
    End If
    
    If fEatKeystroke Then
        LowLevelKeyboardProc = -1
    Else
        LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal
lParam)
    End If
End Function
==========
12. Converted HowTo: Make an 8-bit device independent bitmap (DIB) from
scratch
http://www.vb-helper.com/howto_make_8bit_dib.html
http://www.vb-helper.com/HowTo/howto_make_8bit_dib.zip

Subroutine CreateDIB makes a new DIB. It initializes the BITMAPINFO_256
structure, gets the screen's DC, and calls CreateDIBitmap to make the
DIB.

Dim Pixels() As Byte          ' Pixel data.
Dim bm_info As BITMAPINFO_256 ' DIB bitmap info.
Dim hDIB As Long              ' Bitmap handle.
Dim wid As Integer            ' Size of the bitmap.
Dim hgt As Integer

' Create the DIB.
Private Sub CreateDIB()
Dim screen_hdc As Long

    With bm_info.bmiHeader
        .biSize = Len(bm_info.bmiHeader)
        .biWidth = wid          ' Width in pixels.
        .biHeight = hgt         ' Height in pixels.
        .biPlanes = 1           ' 1 color plane.
        .biBitCount = 8         ' 8 bits per pixel.
        .biCompression = BI_RGB ' No compression.
        .biSizeImage = 0        ' Unneeded with no compression.
        .biXPelsPerMeter = 0    ' Unneeded.
        .biYPelsPerMeter = 0    ' Unneeded.
        .biClrUsed = 256        ' # colors in color table that are used
by the image. 0 means all.
        .biClrImportant = 256   ' # important colors. 0 means all.
    End With

    ' Get the screen's device context.
    screen_hdc = GetDC(0)

    ' Create the DIB.
    hDIB = CreateDIBitmap(screen_hdc, _
        bm_info.bmiHeader, CBM_INIT, Pixels(0, 0), _
        bm_info, DIB_RGB_COLORS)
End Sub

Subroutine SetColorTable initializes the DIB's color table to 256 shades
of blue.

' Initialize 256 shades of blue.
Private Sub SetColorTable()
Dim i As Integer

    For i = 0 To 255
        bm_info.bmiColors(i).rgbRed = 0
        bm_info.bmiColors(i).rgbGreen = 0
        bm_info.bmiColors(i).rgbBlue = i
        bm_info.bmiColors(i).rgbReserved = 0
    Next i
End Sub

Subroutine SetPixels draws a picture on the DIB, covering it with shades
of blue. For every 20th pixel vertically and horizontally, the code
subtracts the color value from 255 to make part of a line.

' Create a drawing.
Private Sub SetPixels()
Dim X As Integer
Dim Y As Integer

    wid = 100
    hgt = 256
    ReDim Pixels(0 To wid - 1, 0 To hgt - 1)
    For Y = 0 To hgt - 1
        For X = 0 To wid - 1
            If Y Mod 20 = 19 Or X Mod 20 = 19 Then
                Pixels(X, Y) = Y
            Else
                Pixels(X, Y) = 255 - Y
            End If
        Next X
    Next Y
End Sub

Subroutine DrawDIB draws the DIB onto the program's form. It creates a
compatible device context, uses SelectObject to copy the DIB into the
device context, uses StretchBlt to copy the device context's picture
onto the form, and calls DeleteDC to delete the device context.

' Draw the DIB onto the form.
Private Sub DrawDIB()
Dim compat_dc As Long

    ' Create a compatible device context.
    compat_dc = CreateCompatibleDC(hdc)
    
    ' Select the DIB into the compatible DC.
    SelectObject compat_dc, hDIB
        
    ' Copy the compatible DC's image onto the form.
    StretchBlt Picture1.hdc, 0, 0, _
        Picture1.ScaleWidth, Picture1.ScaleHeight, _
        compat_dc, 0, 0, wid, hgt, _
        SRCCOPY

    ' Destroy the compatible DC.
    DeleteDC compat_dc
End Sub
==========
13. Converted HowTo: Create program groups and items in program groups
http://www.vb-helper.com/howto_make_program_group.html
http://www.vb-helper.com/HowTo/howto_make_program_group.zip

The program uses DDE to send appropriate messages to ProgMan (the
program manager). The group appears as a folder in the Start
Menu\Programs directory (C:\Windows\Start Menu\Programs in Windows 98).

To create a group, the program sends ProgMan the message of the form:

    [CreateGroup(MyGroup,mygroup.grp)]

' Create a new program group.
'   lbl     Label for sending DDE messages
'   gname   The group's name
'   fname   Group file name
Private Sub CreateGroup(lbl As Label, gname As String, fname As String)
Dim i As Integer

    lbl.LinkTopic = "ProgMan|Progman"
    lbl.LinkMode = 2
    DoEvents
    lbl.LinkTimeout = 100

    ' Create the program group.
    lbl.LinkExecute "[CreateGroup(" & gname & _
        "," & fname & ")]"

    ' Restore lbl values.
    lbl.LinkTimeout = 50
    lbl.LinkMode = 0
End Sub

To create an item, the program sends ProgMan a message of the form:

    [AddItem(D:\Tmp\Ideas.txt,My New Item)]

' Create a new item in a group.
'   lbl     Label for sending DDE messages
'   gname   The group's name
'   cmd     Fully qualified command for item
'   iname   The item's name
Private Sub CreateItem(lbl As Label, gname As String, cmd As String,
iname As String, minimized As Boolean)
    lbl.LinkTopic = "ProgMan|Progman"
    lbl.LinkMode = 2
    DoEvents
    lbl.LinkTimeout = 100

    lbl.LinkExecute "[ShowGroup(" & gname & ", 1)]"

    If minimized Then
        lbl.LinkExecute "[AddItem(" & _
            cmd & "," & iname & ",,,,,,,1)]"
    Else
        lbl.LinkExecute "[AddItem(" & _
            cmd & "," & iname & ")]"
    End If

    ' Restore lbl values.
    lbl.LinkTimeout = 50
    lbl.LinkMode = 0
End Sub
==========
14. Converted HowTo: Make a mask image for a picture with a
"transparent" color
http://www.vb-helper.com/howto_make_image_mask.html
http://www.vb-helper.com/HowTo/howto_make_image_mask.zip

This program makes a mask for an image that contains a "transparent"
color. For example, suppose the image should be transparent where it is
green and visible elsewhere. The program would use this routine to
convert all green pixels to white and all other pixels to black. It
could then use that mask to overlay the picture on another picture.

The MakeMask subroutine uses the GetDIBits API function to load the
source image into a device-independent bitmap (DIB). It processes the
image's pixels and uses the SetDIBits API function to save the results
into a mask PictureBox.

Private Sub MakeMask(ByVal from_picture As PictureBox, ByVal
mask_picture As PictureBox, ByVal from_color As OLE_COLOR, ByVal
to_color As OLE_COLOR, ByVal other_color As OLE_COLOR)
Dim bitmap_info As BITMAPINFO
Dim pixels() As Byte
Dim bytes_per_scanLine As Integer
Dim pad_per_scanLine As Integer
Dim X As Integer
Dim Y As Integer
Dim r As Byte
Dim g As Byte
Dim b As Byte
Dim to_r As Byte
Dim to_g As Byte
Dim to_b As Byte
Dim other_r As Byte
Dim other_g As Byte
Dim other_b As Byte

    ' Make RGBTriplet values for the colors.
    UnRGB to_color, to_r, to_g, to_b
    UnRGB other_color, other_r, other_g, other_b
    UnRGB from_color, r, g, b

    ' Prepare the bitmap description.
    from_picture.ScaleMode = vbPixels
    With bitmap_info.bmiHeader
        .biSize = 40
        .biWidth = from_picture.ScaleWidth
        ' Use negative height to scan top-down.
        .biHeight = -from_picture.ScaleHeight
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        bytes_per_scanLine = ((((.biWidth * .biBitCount) + 31) \ 32) *
4)
        pad_per_scanLine = bytes_per_scanLine - (((.biWidth *
.biBitCount) + 7) \ 8)
        .biSizeImage = bytes_per_scanLine * Abs(.biHeight)
    End With

    ' Load the bitmap's data.
    ReDim pixels(1 To 4, 1 To from_picture.ScaleWidth, 1 To
from_picture.ScaleHeight)
    GetDIBits from_picture.hdc, from_picture.Image, _
        0, from_picture.ScaleHeight, pixels(1, 1, 1), _
        bitmap_info, DIB_RGB_COLORS

    ' Modify the pixels.
    For Y = 1 To from_picture.ScaleHeight
        For X = 1 To from_picture.ScaleWidth
            ' See if we need to change this pixel.
            If (pixels(pixR, X, Y) = r) And _
               (pixels(pixG, X, Y) = g) And _
               (pixels(pixB, X, Y) = b) _
            Then
                pixels(pixR, X, Y) = to_r
                pixels(pixG, X, Y) = to_g
                pixels(pixB, X, Y) = to_b
            Else
                pixels(pixR, X, Y) = other_r
                pixels(pixG, X, Y) = other_g
                pixels(pixB, X, Y) = other_b
            End If
        Next X
    Next Y

    ' Display the result.
    SetDIBits picMask.hdc, picMask.Image, _
        0, from_picture.ScaleHeight, pixels(1, 1, 1), _
        bitmap_info, DIB_RGB_COLORS
    picMask.Picture = picMask.Image
    picMask.Visible = True
End Sub

For more information on graphics programming in Visual Basic, see my
book "Visual Basic Graphics Programming"
(http://www.vb-helper.com/vbgp.htm).
==========
++++++++++
<Both>
++++++++++
==========
15. New Story: OCR Characters
http://www.vb-helper.com/stories_days_of_yore.html

W. H. Minter (inpu-@phreaker.net) has three related stories about
working in the OCR (Optical Character Recognition) field with some
really interesting characters. They're pretty long so I'm not including
them here. Go read them on line.
==========
16. New Links
http://www.vb-helper.com/links.html

VB-Programmerzone
http://www.vb-programmerzone.de.vu
A German vb-site with tools, source code, lots of tips and tricks and a
big link library.

==========
17. Karen Watterson's Weekly Destinations and Diversions (D & D)
http://www.vb-helper.com/karens_weekly_diversions.html

Readable

- Larry Seltzer's April 8th article, A Hands-On Look at Windows Security
Update CD <http://www.eweek.com/article2/0,1759,1563280,00.asp>.
- Read the excellent 23-page technical article (with code) on using
forms authentication with Reporting Services
<http://msdn.microsoft.com/data/default.aspx?pull=/library/en-us/dnsql2k/html/ufairs.asp>.

- Yukon article by Microsoft's Brad Sarsfield and Srik Raghavan Overview
of Native XML Web Services for Microsoft SQL Server 2005
<http://msdn.microsoft.com/data/default.aspx?pull=/library/en-us/dnsql90/html/sql2005websvc.asp>.

- Keith Brown's Beware of Fully Trusted Code
<http://msdn.microsoft.com/msdnmag/issues/04/04/SecurityBriefs/>.
- Oracle-Dell Deal Strikes Blow at Microsoft
<http://www.eweek.com/article2/0,1759,1562608,00.asp>.
- According to "eWeek," Microsoft hosted 1,500 of its 2,600 global MVPs
<http://www.eweek.com/article2/0,1759,1560964,00.asp> during the first
week of April. The MVP program is 11 years old, and attendees got to
select from more than 200 technical sessions.
- Rick Dobson's "Smart Access" article about
<http://www.eweek.com/article2/0,1759,1560964,00.asp>signing Access 2003
projects <http://www.pinpub.com/html/main.isx?sub=62&story=2693> free
online.
- Don Kiely's article
<http://www.pinpub.com/html/main.isx?sub=62&story=2693>Consuming ADO.NET
DataSets in the Microsoft Office System
<http://msdn.microsoft.com/office/default.aspx?pull=/library/en-us/dno2k3ta/html/ODC_Office2003ADONET.asp>.

- Rocky Lhotka's aritcle on coordinating async service calls
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnadvnet/html/vbnet03232004.asp>.

- Several strong articles in the April issue of "DM Review." Examples:
Tom Haughey's article, Is Data Modeling one of the Great Con Jobs in
Data Management History?
<http://www.dmreview.com/article_sub.cfm?articleId=1000939> And Mal
Chisholm's piece on Normalizing Reference Data
<http://www.dmreview.com/article_sub.cfm?articleId=1000932>. See also
What Is Reference Data?
http://www.refdataportal.com/index.cfm?fuseaction=refdata&mode=whatisit>
and free articles from InfoModel, Inc.
<http://www.infomodelusa.com/Articles.htm>
- 28th quarterly issue of Robert Seiner's TDAN <http://www.tdan.com>
(free online journal for data admins). Sample articles: -- Dave Marco on
"Managed Meta Data Environment," David Hay on "Modeling Business Rules:
What Data Models Cannot Do", and Malcolm Chisholm on "Understanding
Hidden Subtypes" along with regular feature columns by Craig Mullins and
Fabian Pascal.
- "99% marketing free" 25-page PPT on BPEL
<http://blog.fivesight.com/prb/space/BPEL/BPEL4ProgArchies.pdf>, one of
the features of Microsoft's new BizTalk 2004. Related: BizTalk Server:
Using Microsoft Tools for Business Process Management
crosoft.com/download/e/6/f/e6fcf394-e03e-4e15-bd80-8c1c127e88e7/BPM.doc>
and BPEL: Make Your Services Flow
<http://www.sys-con.com/webservices/articlea.cfm?id=589>.

Selected KB articles

- 311284 HOW TO: Handle Document Events in a Visual Basic .NET
Application
<http://support.microsoft.com/default.aspx?scid=kb%3ben-us%3b311284>
- 313805 How to use the Find method and the Restrict method to retrieve
appointments
<http://support.microsoft.com/default.aspx?scid=kb%3ben-us%3b313805>
- 319058 BUG: DTS Package Execution Is Canceled Unexpectedly in a Visual
Basic Application
<http://support.microsoft.com/default.aspx?scid=kb%3ben-us%3b319058>
- 317661 HOW TO: Load and Save XML by Using DOM in .NET Framework with
Visual Basic NET
<http://support.microsoft.com/default.aspx?scid=kb%3ben-us%3b317661>
- 316887 HOW TO: Read and Write a File to and from a BLOB Column by
Using ADO.NET and Visual Basic .NET
<http://support.microsoft.com/default.aspx?scid=kb%3ben-us%3b316887>
- 837226 BUG: A "The memory could not be 'read'" error or a "Freedom
Engine COM Server has encountered a problem" error may occur when you
upgrade a Visual Basic 6.0 project to Visual Basic .NET
<http://support.microsoft.com/default.aspx?scid=kb%3ben-us%3b837226>

Browsable

- The "official" Windows Forms site <http://www.windowsforms.net/>.
- Math/humanities <http://MathematicalConnections.com>.
- Journal of Integer Sequences <http://www.math.uwaterloo.ca/JIS>.
- Chemistry in art (a virtual exhibition)
<http://www.hyle.org/art/cia/index.html>.
- WizSoft offers a variety of data and text mining tools
<http://www.wizsoft.com>.
- Delightful feature on butterflies
ttp://www.nwf.org/nationalwildlife/article.cfm?articleId=905&issueId=67>
from Oct/Nov 2003 issue of National Wildlife.
- Baseball: The April 2002 issue (PDF) of Dave Wilton's Way With Words
<http://www.wordorigins.org/newsltr.htm> is all about baseball
terminology - and is a great read. For a rather different perspective,
see the April 2004 CFO magazine's feature about the finances of baseball
franchises (Squeeze Play
<http://www.cfo.com/Article?article=12868&f=home_featured>).
- Bob Newhart <http://www.bob-newhart.com/> (no, he's not dead yet).
- Succinct history of programming languages
<http://www.princeton.edu/~ferguson/adw/programming_languages.shtml>.
- PDC bloggers site <http://pdcbloggers.net/>.

Downloadable

- VS6 SP6
<http://msdn.microsoft.com/vstudio/downloads/updates/sp/vs6/sp6/default.aspx>.

- Free components from Aspose:
    - Aspose.License <http://www.aspose.com/Products/Aspose.License/>
    - Aspose.Obfuscator
<http://www.aspose.com/Products/Aspose.Obfuscator/>
- Free components and apps from WeOnlyDo:
    - wodBeep <http://www.weonlydo.com/index.asp?showform=Beep> (Tool
for working with the BEEP protocol for asynchronous interactions)
    - DHCPServer <http://www.weonlydo.com/index.asp?showform=DHCPServer>
(Dynamic Host Configuration Protocol server component)
    - wodShellMenu
<http://www.weonlydo.com/index.asp?showform=ShellMenu> (gives control
over Explorer user-defined menus)
    - Free applications based on WeDoOnly components
<http://www.weonlydo.com/index.asp?download2=1>
- Download a 45-day free trial of Microsoft's Virtual PC 2004
ails.aspx?FamilyId=4A15008C-3E10-4C54-BCD5-ADC1E780715F&displaylang=en>.
Tech overview
tp://www.microsoft.com/windowsxp/virtualpc/evaluation/techoverview.asp>.
Open source Bochs <http://bochs.sourceforge.net/> project offers similar
functionality.
- Get help developing apps with embedded VC++ and/or VS.NET for Windows
Mobile 2003. Download the second version of the Windows Mobile 2003
Developer Resources kit
<http://www.microsoft.com/downloads/details.aspx?FamilyId=6A34DC83-C3CE-4A4C-AB83-491FD5729551&displaylang=en>.

- MDAC 2.8 SDK
<http://www.microsoft.com/downloads/details.aspx?familyid=5067faf8-0db4-429a-b502-de4329c8c850&displaylang=en>.

- Among other things, IBM's AlphaWorks has released a licensable IBM
Tivoli Access Manager for Microsoft .NET
<http://www.alphaworks.ibm.com/tech/amnet?Open&ca=daw-flnt-040804> and
an XML-based Advanced Pattern Search Toolkit for Sequential Data
<http://www.alphaworks.ibm.com/tech/apas?Open&ca=daw-flnt-040804>.
- Download Tamas Miklos's freeware system audit tool, Aida32
<http://www.aida32.hu/aida32.php>.
==========
Archives:
    http://www.topica.com/lists/VBHelper
    http://www.topica.com/lists/VB6Helper
    http://www.topica.com/lists/VBNetHelper
    
http://www.vb-helper.com/cgi-bin/mojo/mojo.cgi?flavor=archive&list=VB_Helper_Newsletter


Post questions at:
    http://www.topica.com/lists/VBHelperQA
	
 Previous Message All Messages Next Message 
  Check It Out!

  Topica Channels
 Best of Topica
 Art & Design
 Books, Movies & TV
 Developers
 Food & Drink
 Health & Fitness
 Internet
 Music
 News & Information
 Personal Finance
 Personal Technology
 Small Business
 Software
 Sports
 Travel & Leisure
 Women & Family

  Start Your Own List!
Email lists are great for debating issues or publishing your views.
Start a List Today!

© 2001 Topica Inc. TFMB
Concerned about privacy? Topica is TrustE certified.
See our Privacy Policy.