The attached program demonstrates how to read the memory of another process. The user can either launch a new process or specify the process id of a running process. The result is saved in a file.
↧
Reading the memory of another process
↧
Word Wrap
a basic WordWrap program i created or modified from various source codes found on the InterNet .
it does not do a 100% percent job on every type of Text entered,
so please feel free to help improve this Source Code to handle every combination of Characters/Numbers/Etc.
Attachment 93469
it does not do a 100% percent job on every type of Text entered,
so please feel free to help improve this Source Code to handle every combination of Characters/Numbers/Etc.
Attachment 93469
↧
↧
Client/Server - a winsock example
Client/Server is a program that demonstrates how to use winsock to connect to a server or how to accept connections from a client. The program allows the user to send and receive data. Non printable characters are displayed as escape sequences and can also be entered as such. Here is one easy way to try this program:
1. Start two instances of the program.
2. Select "client mode" for one instance and "server mode" for the other.
3. Specify an ip address/host name and port to listen to for the server, then select "Listen" in the "Monitor" menu.
4. Specify a remote ip address/host name and port to connect to for the client, then select "Connect" in the "Client" menu.
5. You should now be able to send data between the two instances of the program through winsock.
1. Start two instances of the program.
2. Select "client mode" for one instance and "server mode" for the other.
3. Specify an ip address/host name and port to listen to for the server, then select "Listen" in the "Monitor" menu.
4. Specify a remote ip address/host name and port to connect to for the client, then select "Connect" in the "Client" menu.
5. You should now be able to send data between the two instances of the program through winsock.
↧
Code for a four point transformation of an image
This code can be used to manipulate an image into any space defined by four corners. Unlike an affine-transform (3 point transformation) which uses a parallelogram shaped space, this 4 point transformation can use absolutely any generic shape that can be defined by four points. Below is this code, split into the two files that I ended up using.
Code for DPointType.bas
Code for FourPointTransform.cls
Use the above class to transform an image in one picture box into a random shape in a second picture box, using the sample code below:
Or use the above class to transform a portion of an image defined by any random 4-point shape in one picture box to fit correctly into a second picture box. This is the inverse of the above transformation. The code is very similar to the above, with just a few changes. See the code below
Code for DPointType.bas
Code:
Public Type DPOINT
X As Double
Y As Double
End TypeCode:
'Requires DPointType.bas
'The Points array holds 4 points. Below is an explanation of each point.
'Points(0) is the position that a rectangle's upper left point is mapped to.
'Points(1) is the position that a rectangle's upper right point is mapped to.
'Points(2) is the position that a rectangle's lower left point is mapped to.
'Points(3) is the position that a rectangle's lower right point is mapped to.
Friend Function X2(ByVal X As Double, ByVal Y As Double, ByVal ImgWidth As Double, ByVal ImgHeight As Double, _
ByRef Points() As DPOINT) As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
b = (Points(1).X - Points(0).X) / (ImgWidth - 1)
d = Points(0).X
c = (Points(2).X - Points(0).X) / (ImgHeight - 1)
a = (Points(3).X - (ImgHeight - 1) * c - d - (ImgWidth - 1) * b) / ((ImgWidth - 1) * (ImgHeight - 1))
X2 = X * (Y * a + b) + Y * c + d
End Function
Friend Function Y2(ByVal X As Double, ByVal Y As Double, ByVal ImgWidth As Double, ByVal ImgHeight As Double, _
ByRef Points() As DPOINT) As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
b = (Points(2).Y - Points(0).Y) / (ImgHeight - 1)
d = Points(0).Y
c = (Points(1).Y - Points(0).Y) / (ImgWidth - 1)
a = (Points(3).Y - (ImgHeight - 1) * b - (ImgWidth - 1) * c - d) / ((ImgHeight - 1) * (ImgWidth - 1))
Y2 = Y * (X * a + b) + X * c + d
End FunctionCode:
Private Sub TransformImage()
dim Xfrm as new FourPointTransform
dim Points(3) as DPOINT
Points(0).X=100 : Points(0).Y=20
Points(1).X=300 : Points(1).Y=45
Points(2).X=115 : Points(2).Y=200
Points(3).X=290 : Points(3).Y=230
for y = 0 to Picture1.Height-1
for x = 0 to Picture1.Width-1
u = Xfrm.X2(X, Y, Picture1.Width, Picture1.Height, Points)
v = Xfrm.Y2(X, Y, Picture1.Width, Picture1.Height, Points)
Picture2.pset(u,v),Picture1.point(x,y)
next x
next y
End SubCode:
Private Sub InverseTransformImage()
dim Xfrm as new FourPointTransform
dim Points(3) as DPOINT
Points(0).X=100 : Points(0).Y=20
Points(1).X=300 : Points(1).Y=45
Points(2).X=115 : Points(2).Y=200
Points(3).X=290 : Points(3).Y=230
for y = 0 to Picture2.Height-1
for x = 0 to Picture2.Width-1
u = Xfrm.X2(X, Y, Picture2.Width, Picture2.Height, Points)
v = Xfrm.Y2(X, Y, Picture2.Width, Picture2.Height, Points)
Picture2.pset(x,y),Picture1.point(u,v)
next x
next y
End Sub↧
[VB6] Function Wait (non-freezing & non-CPU-intensive)
This routine waits for the specified amount of time without freezing the GUI or raising up the CPU usage.
The attached Form demonstrates usage of this simple function.
Code:
Private Type MSG
hWnd As Long
Message As Long
wParam As Long
lParam As Long
Time As Long
Pt_X As Long
Pt_Y As Long
End Type
Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function PeekMessage Lib "user32.dll" Alias "PeekMessageW" (ByRef lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, Optional ByVal lpTimerFunc As Long) As Long
Private Declare Function WaitMessage Lib "user32.dll" () As Long
'This routine waits for the specified amount of time before resuming with the next line of code
Public Function Wait(ByVal Milliseconds As Long) As Boolean
Const PM_QS_POSTMESSAGE = &H980000, WM_TIMER = &H113&
Dim TimerID As Long, M As MSG
TimerID = SetTimer(0&, App.ThreadID, Milliseconds)
If TimerID Then
Do: Wait = WaitMessage
If PeekMessage(M, -1&, WM_TIMER, WM_TIMER, PM_QS_POSTMESSAGE) Then If M.wParam = TimerID Then Exit Do
Loop Until DoEvents < 0
TimerID = KillTimer(0&, TimerID): Debug.Assert TimerID
End If
End Function
↧
↧
[VB6] Shell & Wait
The module included in the attachment contains 3 routines that supplements VB's intrinsic Shell function by waiting for the shelled program to terminate before resuming with the next line of code without blocking other events from firing. The accompanying Form demonstrates usage of each function.
The Shell_n_Wait function augments the native Shell function by waiting for the shelled process until it exits. It also auto-expands environment variables before relaying them to Shell. Instead of retrieving the Process ID/Task ID, Shell_n_Wait returns the terminated process' Exit Code.
The ShellW function is probably the most flexible yet easy-to-use shelling routine ever coded. It accepts Unicode paths to executables or documents (registered file types). Paths can be fully qualified or relative and may contain navigational elements ("." or ".."), environment variables and/or arguments/parameters. The window style (normal, minimized, maximized, hidden, etc.) can be optionally requested. It features the ability to wait for the shelled program indefinitely or exactly as specified. Its return value depends on whether the shelled process is still alive or not. If the process still exists, it retrieves the Process ID, otherwise it returns the Exit Code.
The ShellWS function wraps the Windows Script Host's Run method as shown below:
The Shell_n_Wait function augments the native Shell function by waiting for the shelled process until it exits. It also auto-expands environment variables before relaying them to Shell. Instead of retrieving the Process ID/Task ID, Shell_n_Wait returns the terminated process' Exit Code.
The ShellW function is probably the most flexible yet easy-to-use shelling routine ever coded. It accepts Unicode paths to executables or documents (registered file types). Paths can be fully qualified or relative and may contain navigational elements ("." or ".."), environment variables and/or arguments/parameters. The window style (normal, minimized, maximized, hidden, etc.) can be optionally requested. It features the ability to wait for the shelled program indefinitely or exactly as specified. Its return value depends on whether the shelled process is still alive or not. If the process still exists, it retrieves the Process ID, otherwise it returns the Exit Code.
The ShellWS function wraps the Windows Script Host's Run method as shown below:
Code:
'Runs a program in a new process.
Public Function ShellWS(ByRef Command As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, _
Optional ByVal WaitOnReturn As Boolean) As Long
#Const Referenced = True
#If Not Referenced Then
ShellWS = CreateObject("WScript.Shell").Run(Command, WindowStyle, WaitOnReturn)
#Else
With New WshShell
ShellWS = .Run(Command, WindowStyle, WaitOnReturn)
End With
#End If 'Adapted from "Best Shell & Wait (No API's!)" by Matthew Roberts
End Function 'http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8349&lngWId=1
↧
Client/Server a raw TCP client (Winsock example.)
Client/Server is a program that demonstrates how to use winsock to make raw TCP connections to a server and how to accept connections from a client. The program allows the user to send and receive data. Non printable characters are displayed as escape sequences and can also be entered as such. Here is one easy way to try this program:
1. Start two instances of the program.
2. Select "client mode" for one instance and "server mode" for the other.
3. Specify an ip address/host name and port to listen to for the server, then select "Listen" in the "Monitor" menu.
4. Specify a remote ip address/host name and port to connect to for the client, then select "Connect" in the "Client" menu.
5. You should now be able to send data between the two instances of the program through winsock.
1. Start two instances of the program.
2. Select "client mode" for one instance and "server mode" for the other.
3. Specify an ip address/host name and port to listen to for the server, then select "Listen" in the "Monitor" menu.
4. Specify a remote ip address/host name and port to connect to for the client, then select "Connect" in the "Client" menu.
5. You should now be able to send data between the two instances of the program through winsock.
↧
Image Monitor
Image Monitor is a program that captures any image copied to the clipboard and saves it in a directory specified by the user. It's also a demonstration of how to write vb6 programs that display a system tray icon and balloon tooltips.
↧
[VB6, VBScript] Open File Location
This VB6 project and VBScript file provides functionality similar to Windows Vista & 7's "Open file location" context menu for pre-Vista OSes. In Vista & 7, shortcut files have a handy context menu option, that upon clicking, pre-selects that shortcut's target in a new Explorer window. The VB6 project is fully Unicode-aware, capable of accepting Unicode filenames for shortcuts and their targets. The VBScript file requires an enabled Microsoft Windows Script Host (wscript.exe). Currently, both do not properly work with Advertised shortcuts. To install or uninstall, just open either of the two files without passing any command line parameter. Shown below is the code for the VBScript file.
Attachment 93817
Attachment 93819
Code:
Option Explicit
Private Const sKEY = "HKCU\Software\Classes\lnkfile\shell\OpenFileLocation\"
'Placing this under HKLM\SOFTWARE\Classes\lnkfile
'enables all user profiles to have this context menu.
Private Const sVALUE = "Open &file location"
'&f immediately selects this menu unlike the default
'&i in Vista which collides with "P&in to Start menu".
Private Const sCMD = "wscript.exe %WINDIR%\OpenFileLocation.vbs ""%1"""
'Save this in a file named "OpenFileLocation.vbs" in the
'"\WINDOWS" directory, or if preferred otherwise, edit
'the location & filename in this constant.
Private Const OFL = "OpenFileLocation"
Private Const CMD = "command\"
Private WSH
Set WSH = WScript.CreateObject("WScript.Shell")
If WScript.Arguments.Count Then 'If arguments were passed to this file, Then
OpenFileLocation ' a shortcut file's location was specified
Else 'Else, no arguments were passed
InstallUninstallOFL ' go to Install/Uninstall mode
End If
Set WSH = Nothing 'Destroy object
Private Sub OpenFileLocation
Dim FSO, oShortcut, sFileSpec, sTarget
On Error Resume Next
'Get the shortcut file's location
sFileSpec = WScript.Arguments(0)
'Instantiate a Shortcut Object
Set oShortcut = WSH.CreateShortcut(sFileSpec)
'Retrieve the shortcut's target
sTarget = oShortcut.TargetPath
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
'If the shortcut points to an existing file or folder
If FSO.FileExists(sTarget) Then
'Pre-select that target in a new Explorer window
WSH.Run "explorer.exe /select,""" & sTarget & """"
ElseIf FSO.FolderExists(sTarget) Then
'Short-circuit the preceding expressions instead of using Or
WSH.Run "explorer.exe /select,""" & sTarget & """"
Else 'complain, er, inform if it's missing
WSH.Popup "Could not find:" & vbNewLine & vbNewLine & _
"""" & sTarget & """", , OFL, vbExclamation
End If
Set FSO = Nothing
Set oShortcut = Nothing 'Destroy objects
End Sub
Private Sub InstallUninstallOFL 'Install/Uninstall mode
Dim iButtons, sPrompt
iButtons = vbYesNoCancel Or vbQuestion Or vbDefaultButton3
sPrompt = "Do you want to add the ""Open file location"" context menu " & _
"option to shortcut files?" & vbNewLine & "(Select NO to remove)"
Select Case MsgBox(sPrompt, iButtons, "Install " & OFL & ".vbs")
Case vbYes: InstallOFL
Case vbNo: UninstallOFL
End Select
End Sub
Private Sub InstallOFL 'Adds the context menu entries to the Registry
On Error Resume Next
WSH.RegWrite sKEY, sVALUE, "REG_SZ"
WSH.RegWrite sKEY & CMD, sCMD, "REG_EXPAND_SZ"
If Err Then
MsgBox Err.Description, vbCritical, Err.Source
Else
MsgBox "Installed successfully!", vbInformation, OFL
End If
End Sub
Private Sub UninstallOFL 'Removes the context menu entries from the Registry
On Error Resume Next
WSH.RegDelete sKEY & CMD
WSH.RegDelete sKEY
If Err Then
MsgBox Err.Description, vbCritical, Err.Source
Else
MsgBox "Uninstalled successfully!", vbInformation, OFL
End If
End Sub
Attachment 93819
↧
↧
Menu Explorer
Menu Explorer displays a list of menu's found in any active windows, and displays the items found these menu's. The user can disable/enable these items. Note: there appear to be several types of menu's that can't be detected by this program.
↧
List Processes - Get module and thread information of all processes.
The attached program demonstrates how to gather detailed module, subsystem and thread information of all active processes. This information is then written to a file.
↧
List Processes - Get module and thread information of all processes.
The attached program demonstrates how to gather detailed module, subsystem and thread information of all active processes. This information is then written to a file.
↧
Simple PSD File Generator
I finally figured out how to do this. It generates a native Photoshop PSD file, 3 channels, 8bits per pixel, 256x256 size image. I set all the header stuff as constants basically (though I didn't use the Const statement, I used Dim, and then set them with var = val type lines farther down, so I could later make routines to set the values at runtime). I set them as constants for now because Photoshop (having originated as Mac software) uses Big Endian number in its main file format. And unlike TIFF where you can set II for Intel format (little endian) or MM for Mac format (big endian), Photoshops files are REQUIRE the multibyte values to be big endian, and conversion routines are not trivial. So I opted (for now) to just create a test image generator program with fixed values for all the multibyte values (which is ALL of the entries in the header, so I have fixed width, fixed height, fixed bitdepth, etc). That's why it's more of a fixed size test image generator than a true graphics software or image converter. Though later I plan to expand this to use the CopyMemory API to create a Little to Big Endian converter so I can change these values at runtime.
This is my program's current code.
This is my program's current code.
Code:
Private Sub Form_Load()
Dim Pix(255, 255, 2) As Byte
For y = 0 To 255
For x = 0 To 255
Pix(x, y, 0) = (x * 4) And 255
Pix(x, y, 1) = (y * 4) And 255
Pix(x, y, 2) = (x \ 64) * 17 + (y \ 64) * 68
Next x
Next y
Dim Sig As String
Dim Ver As Integer
Dim Reserved(5) As Byte
Dim Chan As Integer
Dim PHeight As Long
Dim PWidth As Long
Dim Depth As Integer
Dim PMode As Integer
Dim NullLen As Long
Dim CompMethod As Integer
Sig = "8BPS"
Ver = &H100
Chan = &H300
PHeight = &H10000
PWidth = &H10000
Depth = &H800
PMode = &H300
Open "c:\temp\test.psd" For Binary As #1
Put #1, 1, Sig
Put #1, , Ver
Put #1, , Reserved()
Put #1, , Chan
Put #1, , PHeight
Put #1, , PWidth
Put #1, , Depth
Put #1, , PMode
Put #1, , NullLen
Put #1, , NullLen
Put #1, , NullLen
Put #1, , CompMethod
Put #1, , Pix()
Close #1
End
End Sub↧
↧
TextBin - Extract text from binary files
The attached program demonstrates how to extract strings containing only specific characters from a binary file. The project contains a class called TextBinClass and a form TextBinDemoWindow.
The class allows you to specify specific characters and extract these from a binary file. The form contains a demo which shows how to use this class and filter the resulting strings for specific things such as potential .dll references, e-mail addresses, GUIDs and URLs.
The class contains a few speed optimisations such as:
-Using a byte array instead of a string to store the binary data.
-Using the InStrB() function instead of InStr().
-Using the InputB$() function instead of Input$() to read the binary data into a byte array. Using Input$() and StrConv() appears to be slower.
Note:
The term "Unicode" (within the context of this program) simply refers to any string where every other character is a null character.
The class allows you to specify specific characters and extract these from a binary file. The form contains a demo which shows how to use this class and filter the resulting strings for specific things such as potential .dll references, e-mail addresses, GUIDs and URLs.
The class contains a few speed optimisations such as:
-Using a byte array instead of a string to store the binary data.
-Using the InStrB() function instead of InStr().
-Using the InputB$() function instead of Input$() to read the binary data into a byte array. Using Input$() and StrConv() appears to be slower.
Note:
The term "Unicode" (within the context of this program) simply refers to any string where every other character is a null character.
↧
[VB6] modShellZipUnzip.bas
Code:
Option Explicit
'Asynchronously compresses a file or folder. Result differs if folder has a trailing backslash ("\").
Public Function ShellZip(ByRef Source As String, ByRef DestZip As String) As Boolean
Const FOF_NOCONFIRMATION As Variant = 16
CreateNewZip DestZip
On Error Resume Next
With CreateObject("Shell.Application") 'Late-bound
'With New Shell 'Referenced
If Right$(Source, 1&) = "\" Then
.NameSpace(CVar(DestZip)).CopyHere .NameSpace(CVar(Source)).Items, FOF_NOCONFIRMATION
Else
.NameSpace(CVar(DestZip)).CopyHere CVar(Source), FOF_NOCONFIRMATION
End If
End With
ShellZip = (Err = 0&)
End Function
'Asynchronously decompresses the contents of SrcZip into the folder DestDir.
Public Function ShellUnzip(ByRef SrcZip As String, ByRef DestDir As String) As Boolean
Const FOF_NOCONFIRMATION As Variant = 16
On Error Resume Next
With CreateObject("Shell.Application") 'Late-bound
'With New Shell 'Referenced
.NameSpace(CVar(DestDir)).CopyHere .NameSpace(CVar(SrcZip)).Items, FOF_NOCONFIRMATION
End With
ShellUnzip = (Err = 0&)
RemoveTempDir Right$(SrcZip, Len(SrcZip) - InStrRev(SrcZip, "\"))
End Function
'Creates a new empty Zip file only if it doesn't exist.
Private Function CreateNewZip(ByRef sFileName As String) As Boolean
Dim ZipHeader As String * 22
On Error GoTo 1
If GetAttr(sFileName) Then Exit Function 'Don't overwrite existing file
1 Err.Clear: Resume 2
2 On Error GoTo 3
Open sFileName For Binary Access Write As #99
Mid$(ZipHeader, 1&) = "PK" & Chr$(5&) & Chr$(6&)
Put #99, 1&, ZipHeader
3 Close #99
CreateNewZip = (Err = 0&)
End Function
'Schedules a temporary directory tree for deletion upon reboot.
Private Function RemoveTempDir(ByRef sFolderName As String) As Boolean
Dim sPath As String, sTemp As String
On Error Resume Next
sTemp = Environ$("TEMP") & "\"
sPath = Dir(sTemp & "Temporary Directory * for " & sFolderName, vbDirectory Or vbHidden)
If LenB(sPath) Then
With CreateObject("WScript.Shell") 'Late-bound
'With New WshShell 'Referenced
Do: .RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\*RD_" & _
Replace(sPath, " ", "_"), Environ$("ComSpec") & " /C " & _
"@TITLE Removing " & sPath & " ...&" & _
"@RD /S /Q """ & sTemp & sPath & """"
sPath = Dir
Loop While LenB(sPath)
End With
End If
RemoveTempDir = (Err = 0&)
End Function
↧
HTML Document Explorer
The attached program demonstrates how to access HTML documents being displayed by other processes.
↧
winsock chat general
1: how would i go around adding friends to logged in id's and remove friends from friends list .
any answers are acceptable need your idias friends.
any answers are acceptable need your idias friends.
↧
↧
Execute with Acess Denied permission
Hello,
I am impressed by few Antiviruses applications. I am getting 'Access Denied' message on killing them via Process Manager in Windows. So My question is, How can we create such application in VB6 which would be unable to kill by process managers?
If you know please share here.
Thanks
Regards,
I am impressed by few Antiviruses applications. I am getting 'Access Denied' message on killing them via Process Manager in Windows. So My question is, How can we create such application in VB6 which would be unable to kill by process managers?
If you know please share here.
Thanks
Regards,
↧
VB6 - Thumbnail view based on WIA 2.0
Background
As camera resolutions get higher and higher VB6's native image manipulation can get bogged down. This is especially true if you need to do some processing on he thumbnails such as dealing with odd sizes, portrait images, and so on. If you want to create a "viewer" based on one of the ListView controls and ImageList controls (v. 6 or v. 5) then you need to deal with mask-transparency and you might want an outline border.
While dropping down to API calls is fastest, the code can get complex making it harder to tailor even a known-working sample. One alternative is to make use of the WIA 2.0 Library available for XP SP1 and later and already installed as part of Vista or later.
With WIA you also have easy access to JPEG image files' embedded thumbnail image. These are created by many cameras now and can sometimes be optionally inserted using image editing software. When available, these prescaled thumbnails can be used as-is or as the basis for scaling to a specific desired thumbnail size. Even if you rescale it this may save time over scaling the entire full-size image.
Requirements
Since I'm using WIA 2.0 your computer must be running Windows XP SP1 or later. For XP you may have to download and install WIA 2.0 first. However:
Purpose
The Windows Image Acquisition (WIA) Automation Layer is a full-featured image manipulation component that provides end-to-end image processing capabilities. The WIA Automation Layer makes it easy to acquire images from digital cameras, scanners, or Web cameras, and to rotate, scale, and annotate your image files. The WIA Automation Layer supersedes the WIA Scripting Model provided by Windows Image Acquisition (WIA) 1.0.
Developer audience
The WIA Automation Layer API is designed for use by Microsoft Visual Basic 6.0, Active Server Pages (ASP), and scripting programmers.
Run-time requirements
Applications that use the WIA Automation Layer API require Windows Vista or later. Earlier versions of Windows are not supported.
What does this mean?
It means now that Windows 8 is out, Windows XP is on "death watch" and Microsoft has begun removing download links for many XP add-ons.
You'll probably have to scrounge the "Windows® Image Acquisition Automation Library" download from some 3rd party if you failed to get it while it was hot (i.e. in the last 6 years or so).
The WIA 2.0 Automation Library documentation is found in the Windows SDK for Vista (or later) documentation (help) files.
Of course those developing on Vista (the last release officially supporting VB6 development anyway, and in my opinion the best) have no problem except for deployment.
But even then if you want to deploy your programs downlevel to XP SP1 through SP3 you'll want the WIAAutSDK.zip download. It contains a CHM document - but more importantly a redistributable wiaaut.dll that works on XP systems!
MakeThumbs.cls
This is a class wrapping several WIA objects that can be used to accept a photo/image file name and create a thumbnail StdPicture from it ready for adding to an ImageList control.
The class has several properties you set:
Then you call the InitThumbs method to create the backdrop image containing the outline and the mask.
From there you can repeatedly call the FetchThumb method passing an image file name, getting back a StdPicture of the finished thumbnail image.
Use the result with any image control that has a Picture property or method argument and supports a mask color for transparency. The more obvious choices are probably ImageList controls used with a ListView or TreeView control.
JpegThumbs.vbp
This is a sample VB6 project using MakeThumbs. You browse to a folder containing images and then it loads and displays thumbnail images for all of the image file types it supports into an ImageList and ListView. Pretty simple, and the only gingerbread here is the ability to select among 3 thumbnail sizes.
Speed
I won't lie and call this a speed demon, though most of the time will probably be disk I/O. Requesting the same folder (or changing the thumbnail size after loading it once) may be twice or 3 times as quick due to disk caching.
A "first load" here seems to take about 1/8th of a second per image file for 3 to 4MB JPEGs. Doing the same steps using only VB6 native image processing techniques took me substantially longer, closer to 4 seconds per image. However I may have been using some poor techniques there too.
InitThumbs is slow by nature and I wish I had a better way to build the backdrop. But you only need to call it once when changing the dimension or color properties, not for every loaded image.
The Attachment
This contains the JpegThumbs project, including the MakeThumbs class module.
As camera resolutions get higher and higher VB6's native image manipulation can get bogged down. This is especially true if you need to do some processing on he thumbnails such as dealing with odd sizes, portrait images, and so on. If you want to create a "viewer" based on one of the ListView controls and ImageList controls (v. 6 or v. 5) then you need to deal with mask-transparency and you might want an outline border.
While dropping down to API calls is fastest, the code can get complex making it harder to tailor even a known-working sample. One alternative is to make use of the WIA 2.0 Library available for XP SP1 and later and already installed as part of Vista or later.
With WIA you also have easy access to JPEG image files' embedded thumbnail image. These are created by many cameras now and can sometimes be optionally inserted using image editing software. When available, these prescaled thumbnails can be used as-is or as the basis for scaling to a specific desired thumbnail size. Even if you rescale it this may save time over scaling the entire full-size image.
Requirements
Since I'm using WIA 2.0 your computer must be running Windows XP SP1 or later. For XP you may have to download and install WIA 2.0 first. However:
Quote:
Purpose
The Windows Image Acquisition (WIA) Automation Layer is a full-featured image manipulation component that provides end-to-end image processing capabilities. The WIA Automation Layer makes it easy to acquire images from digital cameras, scanners, or Web cameras, and to rotate, scale, and annotate your image files. The WIA Automation Layer supersedes the WIA Scripting Model provided by Windows Image Acquisition (WIA) 1.0.
Developer audience
The WIA Automation Layer API is designed for use by Microsoft Visual Basic 6.0, Active Server Pages (ASP), and scripting programmers.
Run-time requirements
Applications that use the WIA Automation Layer API require Windows Vista or later. Earlier versions of Windows are not supported.
It means now that Windows 8 is out, Windows XP is on "death watch" and Microsoft has begun removing download links for many XP add-ons.
You'll probably have to scrounge the "Windows® Image Acquisition Automation Library" download from some 3rd party if you failed to get it while it was hot (i.e. in the last 6 years or so).
The WIA 2.0 Automation Library documentation is found in the Windows SDK for Vista (or later) documentation (help) files.
Of course those developing on Vista (the last release officially supporting VB6 development anyway, and in my opinion the best) have no problem except for deployment.
But even then if you want to deploy your programs downlevel to XP SP1 through SP3 you'll want the WIAAutSDK.zip download. It contains a CHM document - but more importantly a redistributable wiaaut.dll that works on XP systems!
MakeThumbs.cls
This is a class wrapping several WIA objects that can be used to accept a photo/image file name and create a thumbnail StdPicture from it ready for adding to an ImageList control.
The class has several properties you set:
Set ThumbWidth & ThumbHeight to dimensions (in pixels) for the thumbnails. These dimensions include the 2px-wide border.
Set FrameColor to the desired frame color for the rectangular outline. This outline will be 1px wide with a 1px inner border of the MaskColor.
Set MaskColor to the transparency mask color to use for padding around the scaled thumbnail image from the source JPEG image.
Set FrameColor to the desired frame color for the rectangular outline. This outline will be 1px wide with a 1px inner border of the MaskColor.
Set MaskColor to the transparency mask color to use for padding around the scaled thumbnail image from the source JPEG image.
Then you call the InitThumbs method to create the backdrop image containing the outline and the mask.
From there you can repeatedly call the FetchThumb method passing an image file name, getting back a StdPicture of the finished thumbnail image.
Use the result with any image control that has a Picture property or method argument and supports a mask color for transparency. The more obvious choices are probably ImageList controls used with a ListView or TreeView control.
JpegThumbs.vbp
This is a sample VB6 project using MakeThumbs. You browse to a folder containing images and then it loads and displays thumbnail images for all of the image file types it supports into an ImageList and ListView. Pretty simple, and the only gingerbread here is the ability to select among 3 thumbnail sizes.
Speed
I won't lie and call this a speed demon, though most of the time will probably be disk I/O. Requesting the same folder (or changing the thumbnail size after loading it once) may be twice or 3 times as quick due to disk caching.
A "first load" here seems to take about 1/8th of a second per image file for 3 to 4MB JPEGs. Doing the same steps using only VB6 native image processing techniques took me substantially longer, closer to 4 seconds per image. However I may have been using some poor techniques there too.
InitThumbs is slow by nature and I wish I had a better way to build the backdrop. But you only need to call it once when changing the dimension or color properties, not for every loaded image.
The Attachment
This contains the JpegThumbs project, including the MakeThumbs class module.
↧
VB6 - MSChart XY Scatter Demo
MSChart is a very complex control. Sometimes it can be frustrating to get just what you want out of it.
An example is a "scatter plot" of the sort shown here.
An example is a "scatter plot" of the sort shown here.
Code:
Option Explicit
'Just plop an instance of MSChart as MSChart1 onto a Form.
Private Sub Form_Load()
Dim Series1 As Variant
Dim Series2 As Variant
Dim Series3 As Variant
Dim Series As Integer
Dim I As Integer
Dim Row As Integer
'Hold series data in Variant arrays here, as (X, Y) pairs
'that follow each other:
Series1 = Array(12, 20, 3, 10, 15, 20, 4, 50, 50, 27)
Series2 = Array(1, 12, 23, 9, 48, 25, 16, 16, 30, 37)
Series3 = Array(1, 43, 45, 45, 4, 25, 39, 5, 13, 6)
With MSChart1
.chartType = VtChChartType2dXY
.RowCount = (UBound(Series1) + 1) \ 2
.ColumnCount = 6 '2 columns per series, 3 series.
'Set up each Series for small circles with no lines.
For Series = 1 To 3
With .Plot.SeriesCollection((Series - 1) * 2 + 1)
.SeriesType = VtChSeriesType2dXY
.ShowLine = False
With .SeriesMarker
.Show = True
.Auto = False
End With
With .DataPoints(-1).Marker
.Style = VtMarkerStyleFilledCircle
.Size = ScaleX(7, vbPixels, vbTwips)
With .Pen.VtColor
Select Case Series
Case 1
.Set 192, 64, 64 'Red.
Case 2
.Set 64, 64, 192 'Blue.
Case 3
.Set 64, 192, 64 'Green.
End Select
End With
End With
End With
Next
For I = 0 To UBound(Series1) Step 2
Row = I \ 2 + 1
.DataGrid.SetData Row, 1, Series1(I), False
.DataGrid.SetData Row, 2, Series1(I + 1), False
.DataGrid.SetData Row, 3, Series2(I), False
.DataGrid.SetData Row, 4, Series2(I + 1), False
.DataGrid.SetData Row, 5, Series3(I), False
.DataGrid.SetData Row, 6, Series3(I + 1), False
Next
End With
End Sub↧