|
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
|
|
 |
|
