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.
↧
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
'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&)
End Function
'Compresses a file or folder. The folder must end in a 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
'Creates a new empty Zip file only if it doesn't exist.
Public 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
↧
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↧
↧
[VB6] Form-less CommonDialog (comdlg32.ocx)
It is possible to show the common dialogs without using a Form to put the ActiveX control in. Here's how:
Code:
'In a BAS module
Option Explicit
Private Sub Main()
Const cdlCCFullOpen = 2&, cdlCCHelpButton = 8&, cdlCFApply = &H200&, cdlCFBoth = 3&
Const cdlCFEffects = &H100&, cdlCFHelpButton = 4&, cdlHelpContents = 3&
Const cdlOFNAllowMultiselect = &H200&, cdlOFNExplorer = &H80000, cdlOFNHelpButton = &H10&
Const cdlPDHelpButton = &H800&, cdlPDNoWarning = &H80&, cdlPDPrintSetup = &H40&
On Error Resume Next
With CreateObject("MSComDlg.CommonDialog") 'Late-bound
'With New CommonDialog 'Referenced comdlg32.ocx (not from Toolbox)
.AboutBox
.Flags = cdlCCFullOpen Or cdlCCHelpButton
.ShowColor
.Flags = cdlCFApply Or cdlCFBoth Or cdlCFEffects Or cdlCFHelpButton
.ShowFont
.HelpCommand = cdlHelpContents
.HelpFile = Dir(Environ$("WINDIR") & "\Help\*.hlp")
.ShowHelp
.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHelpButton
.ShowOpen
.ShowSave
.Flags = cdlPDHelpButton Or cdlPDNoWarning
.ShowPrinter
.Flags = .Flags Or cdlPDPrintSetup
.ShowPrinter
End With
End Sub
↧
[VB6] Uncompressed AVI Writer
Here is a minimalistic cAviWriter class (less than 200 LOC w/ no dependencies) that can be used to create uncompressed AVIs for use in standard animation control.
The sample projects loads a transparent ajax-loader PNG strip and blends it with current vbButtonFace color (Form's back color). Then the frames are split from the bitmap strip and appended to a temporary AVI file. Then an animation control is placed on the form (all API) and the temp AVI file is loaded and played.
The nice thing about animation control is that it uses a separate thread to cycle the animation, so when long running tasks are executed on the UI thread the ajax-loader continues to spin. Enjoy!
cheers,
</wqw>
Code:
Option Explicit
'=========================================================================
' API
'=========================================================================
'--- for AVIFileOpen
Private Const OF_WRITE As Long = &H1
Private Const OF_CREATE As Long = &H1000
'--- for CreateDIBSection
Private Const DIB_RGB_COLORS As Long = 0
Private Declare Sub AVIFileInit Lib "avifil32.dll" ()
Private Declare Sub AVIFileExit Lib "avifil32.dll" ()
Private Declare Function AVIFileOpen Lib "avifil32.dll" Alias "AVIFileOpenA" (ppfile As Long, ByVal szFile As String, ByVal uMode As Long, ByVal lpHandler As Long) As Long
Private Declare Function AVIFileCreateStream Lib "avifil32.dll" (ByVal pfile As Long, ppavi As Long, psi As TAVISTREAMINFO) As Long
Private Declare Function AVIFileRelease Lib "avifil32.dll" (ByVal pfile As Long) As Long
Private Declare Function AVIStreamSetFormat Lib "avifil32.dll" (ByVal pavi As Long, ByVal lPos As Long, lpFormat As Any, ByVal cbFormat As Long) As Long
Private Declare Function AVIStreamWrite Lib "avifil32.dll" (ByVal pavi As Long, ByVal lStart As Long, ByVal lSamples As Long, ByVal lpBuffer As Long, ByVal cbBuffer As Long, ByVal dwFlags As Long, plSampWritten As Long, plBytesWritten As Long) As Long
Private Declare Function AVIStreamRelease Lib "avifil32.dll" (ByVal pavi As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, lpBitsInfo As BITMAPINFOHEADER, ByVal wUsage As Long, lpBits As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ApiBitBlt Lib "gdi32" Alias "BitBlt" (ByVal hdcDest As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TAVISTREAMINFO
fccType As Long
fccHandler As Long
dwFlags As Long
dwCaps As Long
wPriority As Integer
wLanguage As Integer
dwScale As Long
dwRate As Long
dwStart As Long
dwLength As Long
dwInitialFrames As Long
dwSuggestedBufferSize As Long
dwQuality As Long
dwSampleSize As Long
rcFrame As RECT
dwEditCount As Long
dwFormatChangeCount As Long
szName(0 To 63) As Byte
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
'=========================================================================
' Constants and member variables
'=========================================================================
Private m_hAviFile As Long
Private m_hAviStream As Long
Private m_lSample As Long
Private m_uBmpInfo As BITMAPINFOHEADER
Private m_hDC As Long
Private m_hDib As Long
Private m_hPrevDib As Long
Private m_lpBits As Long
'=========================================================================
' Methods
'=========================================================================
Public Function Init( _
sFile As String, _
ByVal lWidth As Long, _
ByVal lHeight As Long, _
Optional ByVal lRate As Long = 10) As Boolean
Dim uStream As TAVISTREAMINFO
Terminate
If AVIFileOpen(m_hAviFile, sFile, OF_CREATE Or OF_WRITE, 0) < 0 Then
GoTo QH
End If
With uStream
.fccType = pvToFourCC("vids")
.fccHandler = 0 ' pvToFourCC("DIB ")
.dwScale = 1
.dwRate = lRate
.rcFrame.Right = lWidth
.rcFrame.Bottom = lHeight
End With
If AVIFileCreateStream(m_hAviFile, m_hAviStream, uStream) < 0 Then
GoTo QH
End If
With m_uBmpInfo
.biSize = Len(m_uBmpInfo)
.biWidth = lWidth
.biHeight = lHeight
.biPlanes = 1
.biBitCount = 24 ' 32
.biSizeImage = ((lWidth * .biBitCount \ 8 + 3) And -4&) * lHeight
End With
If AVIStreamSetFormat(m_hAviStream, 0, m_uBmpInfo, Len(m_uBmpInfo)) < 0 Then
GoTo QH
End If
m_hDC = CreateCompatibleDC(0)
m_hDib = CreateDIBSection(m_hDC, m_uBmpInfo, DIB_RGB_COLORS, m_lpBits, 0, 0)
m_hPrevDib = SelectObject(m_hDC, m_hDib)
m_lSample = 0
'--- success
Init = True
Exit Function
QH:
Terminate
End Function
Public Function AddFrame( _
oPic As StdPicture, _
Optional ByVal lX As Long, _
Optional ByVal lY As Long) As Boolean
Dim hTempDC As Long
Dim hPrevBmp As Long
hTempDC = CreateCompatibleDC(m_hDC)
hPrevBmp = SelectObject(hTempDC, oPic.handle)
Call ApiBitBlt(m_hDC, 0, 0, m_uBmpInfo.biWidth, m_uBmpInfo.biHeight, hTempDC, lX, lY, vbSrcCopy)
Call SelectObject(hTempDC, hPrevBmp)
Call DeleteDC(hTempDC)
If AVIStreamWrite(m_hAviStream, m_lSample, 1, m_lpBits, m_uBmpInfo.biSizeImage, 0, 0, 0) < 0 Then
GoTo QH
End If
m_lSample = m_lSample + 1
'--- success
AddFrame = True
QH:
End Function
Private Sub Terminate()
If m_hAviStream <> 0 Then
Call AVIStreamRelease(m_hAviStream)
m_hAviStream = 0
End If
If m_hAviFile <> 0 Then
Call AVIFileRelease(m_hAviFile)
m_hAviFile = 0
End If
If m_hDC <> 0 Then
If m_hPrevDib <> 0 Then
Call SelectObject(m_hDC, m_hPrevDib)
m_hPrevDib = 0
End If
If m_hDib <> 0 Then
Call DeleteObject(m_hDib)
m_hDib = 0
m_lpBits = 0
End If
Call DeleteDC(m_hDC)
m_hDC = 0
End If
End Sub
'= private ===============================================================
Private Function pvToFourCC(sText As String) As Long
Call CopyMemory(pvToFourCC, ByVal StrPtr(StrConv(sText, vbFromUnicode)), 4)
End Function
'=========================================================================
' Base class events
'=========================================================================
Private Sub Class_Initialize()
Call AVIFileInit
End Sub
Private Sub Class_Terminate()
Terminate
Call AVIFileExit
End SubThe nice thing about animation control is that it uses a separate thread to cycle the animation, so when long running tasks are executed on the UI thread the ajax-loader continues to spin. Enjoy!
cheers,
</wqw>
↧
VB6 - ImageListPicker Control
This is a simple GUI UserControl for "picking" from a list of pictures.
Your program loads some pictures into it, then the user can scroll the visible list horizontally and click on one to select it.
METHODS
Add - Add a StdPicture to the list.
Delete X - Delete picture X from the list. X from 1 to n.
ClearAll - Clears the list.
PROPERTIES
ListItems(X) - Retrieves item X as a StdPicture object.
ListIndex - Currently selected item, 0 = none selected.
ThumbNailHeight, ThumbnailWidth - Visible size in pixels for the scrolling thumbnails.
ThumbnailsMargin - Space between each thumbnail in pixels. Must be 3 or greater to allow room for the selection rectangle.
EVENTS
Click - Fired when user clicks on a thumbnail image.
No special requirements or dependencies. Uses intrinsic VB6 controls and image operations. Just add the .CTL and .CTX files to your Project folder then add the control using Project|Add|File...
Source provided in the attachment as part of a demo project, along with some sample pictures (which is why the attachment is so large).
You could enhance it to add "tag" values, "file names" and so on. It would be easy enough to create a "vertical" version of this control too.
Your program loads some pictures into it, then the user can scroll the visible list horizontally and click on one to select it.
METHODS
Add - Add a StdPicture to the list.
Delete X - Delete picture X from the list. X from 1 to n.
ClearAll - Clears the list.
PROPERTIES
ListItems(X) - Retrieves item X as a StdPicture object.
ListIndex - Currently selected item, 0 = none selected.
ThumbNailHeight, ThumbnailWidth - Visible size in pixels for the scrolling thumbnails.
ThumbnailsMargin - Space between each thumbnail in pixels. Must be 3 or greater to allow room for the selection rectangle.
EVENTS
Click - Fired when user clicks on a thumbnail image.
No special requirements or dependencies. Uses intrinsic VB6 controls and image operations. Just add the .CTL and .CTX files to your Project folder then add the control using Project|Add|File...
Source provided in the attachment as part of a demo project, along with some sample pictures (which is why the attachment is so large).
You could enhance it to add "tag" values, "file names" and so on. It would be easy enough to create a "vertical" version of this control too.
↧
[VB6] DownloadURL2File Function (Unicode-aware) + IsInternetConnected Function
Code:
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateFileW Lib "kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, Optional ByVal dwFlagsAndAttributes As Long, Optional ByVal hTemplateFile As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInternet As Long) As Long
Private Declare Function InternetOpenW Lib "wininet.dll" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrlW Lib "wininet.dll" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, ByRef lpdwNumberOfBytesRead As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, Optional ByRef lpNumberOfBytesWritten As Long, Optional ByVal lpOverlapped As Long) As Long
'Downloads the file specified by the sURL argument to the local file pointed
'by the sFileName parameter. The optional Chunk parameter determines the number
'of bytes to be downloaded at a time. Bigger chunks download faster while smaller
'ones enables the GUI to be more responsive. Returns the total number of bytes
'successfully written to disk. Maximum download size of 2047.99 MB only.
Public Function DownloadURL2File(ByRef sURL As String, ByRef sFileName As String, Optional ByVal Chunk As Long = 1024&) As Long
Const INTERNET_OPEN_TYPE_DIRECT = 1&, INTERNET_FLAG_DONT_CACHE = &H4000000, INTERNET_FLAG_RELOAD = &H80000000
Const GENERIC_WRITE = &H40000000, FILE_SHARE_NONE = 0&, CREATE_ALWAYS = 2&
Const INVALID_HANDLE_VALUE = -1&, ERROR_INSUFFICIENT_BUFFER = &H7A&
Dim hInternet As Long, hURL As Long, hFile As Long, nBytesRead As Long, nBytesWritten As Long
Dim bSuccess As Boolean, sBuffer_Ptr As Long, sBuffer_Size As Long, sBuffer As String
If LenB(sURL) = 0& Or LenB(sFileName) = 0& Or Chunk < 2& Then Exit Function
hInternet = InternetOpenW(StrPtr(App.Title), INTERNET_OPEN_TYPE_DIRECT, 0&, 0&, 0&)
If hInternet Then
hURL = InternetOpenUrlW(hInternet, StrPtr(sURL), 0&, 0&, INTERNET_FLAG_DONT_CACHE Or INTERNET_FLAG_RELOAD, 0&)
If hURL Then
hFile = CreateFileW(StrPtr(sFileName), GENERIC_WRITE, FILE_SHARE_NONE, 0&, CREATE_ALWAYS) 'Overwrite existing
If hFile <> INVALID_HANDLE_VALUE Then
Do: SysReAllocStringLen VarPtr(sBuffer), , (sBuffer_Size + Chunk) * 0.5!
sBuffer_Size = LenB(sBuffer): sBuffer_Ptr = StrPtr(sBuffer)
Do While InternetReadFile(hURL, sBuffer_Ptr, sBuffer_Size, nBytesRead)
If nBytesRead Then
bSuccess = (WriteFile(hFile, sBuffer_Ptr, nBytesRead, nBytesWritten) <> 0&) _
And (nBytesWritten = nBytesRead): Debug.Assert bSuccess
DoEvents
If bSuccess Then DownloadURL2File = DownloadURL2File + nBytesWritten
Else
Exit Do
End If
Loop
Loop While Err.LastDllError = ERROR_INSUFFICIENT_BUFFER
hFile = CloseHandle(hFile): Debug.Assert hFile
End If
hURL = InternetCloseHandle(hURL): Debug.Assert hURL
End If
hInternet = InternetCloseHandle(hInternet): Debug.Assert hInternet
End If
End Function
Code:
Private Declare Function InternetCheckConnectionW Lib "wininet.dll" (Optional ByVal lpszUrl As Long, Optional ByVal dwFlags As Long, Optional ByVal dwReserved As Long) As Long
'Allows an application to check if a connection to the Internet can be established.
Public Function IsInternetConnected(Optional ByRef sURL As String = "http://www.google.com/") As Boolean
Const FLAG_ICC_FORCE_CONNECTION = &H1&
IsInternetConnected = InternetCheckConnectionW(StrPtr(sURL), FLAG_ICC_FORCE_CONNECTION)
End Function
↧
↧
JACZip Archiver
JACZip is a straight forward ZIP Archive/Unarchive program using the
built in facilities within Windows. The Microsoft implementation of
the ZIP function into the Windows Explorer is to say the least
cumbersome, and with WinZip you never really know what it has done.
If the old Command Line PKZIP supported long file names, I would
probably still be using it.
The program has been tested on Vista and Win7. XP SP2 also supports
zipped files, but JACZip has not been tested on that platform. It
requires "Microsoft Shell Controls And Automation", "Microsoft
Scripting Runtime", as well as the "Microsoft Common Dialog Control",
and the "Microsoft Flexgrid Control".
A more detailed explanation is contained in the readme file.
J.A. Coutts
built in facilities within Windows. The Microsoft implementation of
the ZIP function into the Windows Explorer is to say the least
cumbersome, and with WinZip you never really know what it has done.
If the old Command Line PKZIP supported long file names, I would
probably still be using it.
The program has been tested on Vista and Win7. XP SP2 also supports
zipped files, but JACZip has not been tested on that platform. It
requires "Microsoft Shell Controls And Automation", "Microsoft
Scripting Runtime", as well as the "Microsoft Common Dialog Control",
and the "Microsoft Flexgrid Control".
A more detailed explanation is contained in the readme file.
J.A. Coutts
↧
DataGrid Multiple Row Selection
The Data Bound DataGrid Control provides the ability to select
multiple rows using the CTRL key and mouse, but it lacks the
ability to use the SHIFT key in conjunction with the mouse.
The routines below add that ability by utilizing the MouseUp event.
multiple rows using the CTRL key and mouse, but it lacks the
ability to use the SHIFT key in conjunction with the mouse.
The routines below add that ability by utilizing the MouseUp event.
Code:
Option Explicit
Dim PrevBmk As Long
Dim CurrentBmk As Long
Private Sub DataGrid1_Click()
If DataGrid1.SelBookmarks.Count > 0 Then
'If there is a bookmark present, make it the previous bookmark
CurrentBmk = DataGrid1.SelBookmarks(DataGrid1.SelBookmarks.Count - 1)
End If
End Sub
Private Sub DataGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim M%, N%
If Shift > 0 And DataGrid1.SelBookmarks.Count = 0 Then
'Prompt user to utilize row selection column
MsgBox "You must use the far left column to select multiple records!"
ElseIf Shift = vbShiftMask Then
PrevBmk = CurrentBmk 'Save previous bookmark
CurrentBmk = DataGrid1.SelBookmarks(DataGrid1.SelBookmarks.Count - 1)
Debug.Print PrevBmk, CurrentBmk
If PrevBmk = 0 Then Exit Sub 'no previous bookmark
N% = CurrentBmk - PrevBmk 'Number of bookmarks to be made (+/-)
Select Case N% 'Set step direction for/next routine
Case Is < 0
M% = 1 'Step forward
Case Is = 0
Exit Sub 'Only 1 selected
Case Is > 0
M% = -1 'Step reverse
End Select
For N% = N% To -M% Step M%
DataGrid1.SelBookmarks.Add DataGrid1.GetBookmark(-N%)
Debug.Print DataGrid1.SelBookmarks(DataGrid1.SelBookmarks.Count - 1)
Next N%
End If
End Sub↧
[VB6] Dereferencing Pointers sans CopyMemory
Here are several functions which retrieves the value or data located at the memory address specified by the given pointer. These functions perform the inverse operation of VarPtr, StrPtr and ObjPtr. Rather than using the ubiquitous CopyMemory, alternative APIs are presented instead.
The API declarations:
The pointer dereferencing functions:
Sample usage:
References:
SysReAllocString function at MSDN
Hidden Gems for Free by Michel Rutten
[Benchmark] CopyMemory vs. __vbaCopyBytes by Henrik Ilgen
Using The Native Functions in VBs Runtime DLL by Voodoo Attack!!
The API declarations:
Code:
Private Declare Function ObjSetAddRef Lib "msvbvm60.dll" Alias "__vbaObjSetAddref" (ByRef ObjDest As Object, ByVal Ptr2Obj As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Private Declare Sub CopyBytes Lib "msvbvm60.dll" Alias "__vbaCopyBytes" (ByVal ByteLen As Long, ByVal Destination As Long, ByVal Source As Long)
Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Byte)
Private Declare Sub GetMem2 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Integer)
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Long)
Private Declare Sub GetMem8 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Currency)
Code:
'Retrieves the Byte value from the specified memory address
Public Function GetBytFromPtr(ByVal Ptr As Long) As Byte
GetMem1 Ptr, GetBytFromPtr
End Function
'Retrieves the Integer value from the specified memory address
Public Function GetIntFromPtr(ByVal Ptr As Long) As Integer
GetMem2 Ptr, GetIntFromPtr
End Function
'Retrieves the Long value from the specified memory address
Public Function GetLngFromPtr(ByVal Ptr As Long) As Long
GetMem4 Ptr, GetLngFromPtr
End Function
'Retrieves the Currency value from the specified memory address
Public Function GetCurFromPtr(ByVal Ptr As Long) As Currency
GetMem8 Ptr, GetCurFromPtr
End Function
'Returns a copy of a null-terminated Unicode string (LPWSTR/LPCWSTR)
Public Function GetStrFromPtr(ByVal Ptr As Long) As String
SysReAllocString VarPtr(GetStrFromPtr), Ptr
End Function
'Returns an object from the given pointer
Public Function GetObjFromPtr(ByVal Ptr As Long) As Object
ObjSetAddRef GetObjFromPtr, Ptr
End Function
'Returns a copy of a UDT given a pointer (replace As UDT with any desired Type)
Public Function GetUDTFromPtr(ByVal Ptr As Long) As UDT
CopyBytes LenB(GetUDTFromPtr), VarPtr(GetUDTFromPtr), Ptr
End Function
Code:
Private Type UDT 'Len LenB
'---------
Byt As Byte ' 1 4 <-- padded to fill 32 bits
Bln As Boolean ' 2 2
Int As Integer ' 2 2
Lng As Long ' 4 4
Obj As Object ' 4 4
Sng As Single ' 4 4
Str As String ' 4 4
Cur As Currency ' 8 8
Dtm As Date ' 8 8
Dbl As Double ' 8 8
Vnt As Variant ' 16 16
FLS As String * 40 ' 40 80 <-- Unicode in memory; ANSI when written to disk
'---------
End Type '101 144
Code:
Public Sub DerefPtrs() 'Call from Debug window
Dim U As UDT
Debug.Print
Debug.Print "GetBytFromPtr = " & GetBytFromPtr(VarPtr(CByte(&HAD)))
Debug.Print "GetIntFromPtr = " & GetIntFromPtr(VarPtr(&HEAD))
Debug.Print "GetLngFromPtr = " & GetLngFromPtr(VarPtr(&HADC0FFEE))
Debug.Print "GetCurFromPtr = " & GetCurFromPtr(VarPtr(1234567890.1234@))
Debug.Print "GetStrFromPtr = """ & GetStrFromPtr(StrPtr(App.Title)) & """"
Debug.Print "GetObjFromPtr = """ & GetObjFromPtr(ObjPtr(App)).Path & """"
Debug.Print
With U
.Byt = &HFF
.Bln = True
.Int = &H7FFF
.Lng = &H7FFFFFFF
Set .Obj = Forms
.Sng = 3.402823E+38!
.Str = "The Quick Brown Fox Jumps Over The Lazy Dog"
.Cur = 922337203685477.5807@
.Dtm = Now
.Dbl = 4.94065645841247E-324
.Vnt = CDec(7.92281625142643E+27)
.FLS = "Jackdaws Love My Big Sphinx Of Quartz..."
End With
With GetUDTFromPtr(VarPtr(U))
Debug.Print "Byt = " & .Byt
Debug.Print "Bln = " & .Bln
Debug.Print "Int = " & .Int
Debug.Print "Lng = " & .Lng
Debug.Print "Obj = """ & TypeName(.Obj) & """"
Debug.Print "Sng = " & .Sng
Debug.Print "Str = """ & .Str & """"
Debug.Print "Cur = " & .Cur
Debug.Print "Dtm = " & .Dtm
Debug.Print "Dbl = " & .Dbl
Debug.Print "Vnt = " & .Vnt
Debug.Print "FLS = """ & .FLS & """"
End With
End Sub
References:
SysReAllocString function at MSDN
Hidden Gems for Free by Michel Rutten
[Benchmark] CopyMemory vs. __vbaCopyBytes by Henrik Ilgen
Using The Native Functions in VBs Runtime DLL by Voodoo Attack!!
↧
VB6 - DirectShow WebCam Minimal Code
There are a number of possible APIs in Windows for previewing and capturing from webcams. One of the most popular for its broad support on Windows versions and its relative ease of use when requirements are simple is the AviCap/Video for Windows API.
But a downside of VfW is that the driver model Windows uses to support video capture devices changed after the end of 16-bit Windows (Win3.1, etc.). This means several things, but most commonly frustrating is that instead of mapping multiple webcams as device 1, 2, ... 9 they work through a compatibility layer thats maps one of them as device 1.
This can make selecting the webcam to use difficult to impractical. And using more than one webcam at a time doesn't seem possible.
The usual answer has been: "Use DirectShow instead of VfW."
DirectShow vs. VB6
One problem with using DirectShow is that Microsoft seemed to have lost enthusiasm after providing only a partial implementation. The parts of DirectShow (also called ActiveMovie) we did get a VB6-friendly API for are implemented in the Quartz.dll which should be part of Windows in any recent version (and perhaps even back to most "late" Windows 95 versions like 95B or OSR2.x).
You can still do a lot of things using just what we have, but the finer points of using DirectShow in VB6 require a 3rd party DLL to wrap a few more DirectShow C++ interfaces.
This "Minimal Approach" to VB6, DirectShow, and WebCams
What I have done here is to try to stretch things as far as I could manage.
Here is what you can do:
Here is what you can't do:
The Demo
What I wanted to accomplish was to see how far I could get with the two tasks we can perform without using any 3rd party libraries.
Form1
This is the main UI Form, which uses Form2 as a dialog when requested via its menu ("Add new camera...").
There is a lot more code there than I'd like that does nothing except manage the menu. As you add cameras they are added to the menu. There is also code there to load and save "settings" which include the index of the selected camera and list of added cameras by name.
Basically a lot of UI-management code which I hope doesn't obscure the DirectShow-related logic itself.
The other ugly hunk of code in there is the BuildGraph() function, which is a small interpreter of a sort that processes a "filter script" and a "connection script" to add the necessary filters and connect them to create a webcam preview graph for DirectShow.
Form2
Since I can't find any way to find just the list of usuable webcams, the user has to pick them out from among the full list of available "filters" (as they are called)! Not practical at all for a real application, but it works for a test/demo program.
That's what Form2 in the demo Project is for, a dialog from which to pick new cameras.
Note that your camera might appear there once, twice, or even three or more times depending on how many "filters" of different kinds it supports. Just pick any of them, the demo program will just use the name and sort it out later.
Module1
This contains some GDI and OLE API calls to convert the captured frame from a "packed DIB" into a StdPicture object that can be used with PaintPicture, etc. This raw StdPicture is created using a "memory DC" so there are some limits on how you can use it, i.e. simply assigning it to a PictureBox.Picture has some issues.
But in this demo we need to scale it anyway since we can't control the actual capture dimensions.
You could rework this passing in the hDC of a Form, PictureBox etc. I suppose.
Running the DSMini1 Project
The attached ZIP archive contains the entire Project.
All you should need to do is unzip the archive, then open the Project in VB6. If you have a webcam connected, you can just go ahead and run it within the IDE.
From there you will have to "Add" your webcam by browsing the filter list.
After a valid add, the live preview starts immediately at the left.
Clicking on the Snap button should take a snapshot and display it in the PictureBox at the right.
If you have another webcam connectd you shuld be able to add that one too. Once you have two or more added you can choose among them via Form1's menu.
Settings are persisted in Settings.txt, so a subsequent run should save you the trouble of picking cameras again.
Remarks
I don't know what webcams this will work with, but I know it works with two very different ones I've tried so far.
But a downside of VfW is that the driver model Windows uses to support video capture devices changed after the end of 16-bit Windows (Win3.1, etc.). This means several things, but most commonly frustrating is that instead of mapping multiple webcams as device 1, 2, ... 9 they work through a compatibility layer thats maps one of them as device 1.
This can make selecting the webcam to use difficult to impractical. And using more than one webcam at a time doesn't seem possible.
The usual answer has been: "Use DirectShow instead of VfW."
DirectShow vs. VB6
One problem with using DirectShow is that Microsoft seemed to have lost enthusiasm after providing only a partial implementation. The parts of DirectShow (also called ActiveMovie) we did get a VB6-friendly API for are implemented in the Quartz.dll which should be part of Windows in any recent version (and perhaps even back to most "late" Windows 95 versions like 95B or OSR2.x).
You can still do a lot of things using just what we have, but the finer points of using DirectShow in VB6 require a 3rd party DLL to wrap a few more DirectShow C++ interfaces.
This "Minimal Approach" to VB6, DirectShow, and WebCams
What I have done here is to try to stretch things as far as I could manage.
Here is what you can do:
- Choose among your webcams and display a live preview image.
- "Snap" and display a still image from the webcam feed.
Here is what you can't do:
- Get a "friendly" list of just the usable webcams.
- Control the capture resolution/dimensions or other capture settings or even raise the built-in dialogs to let the user do so.
The Demo
What I wanted to accomplish was to see how far I could get with the two tasks we can perform without using any 3rd party libraries.
Form1
This is the main UI Form, which uses Form2 as a dialog when requested via its menu ("Add new camera...").
There is a lot more code there than I'd like that does nothing except manage the menu. As you add cameras they are added to the menu. There is also code there to load and save "settings" which include the index of the selected camera and list of added cameras by name.
Basically a lot of UI-management code which I hope doesn't obscure the DirectShow-related logic itself.
The other ugly hunk of code in there is the BuildGraph() function, which is a small interpreter of a sort that processes a "filter script" and a "connection script" to add the necessary filters and connect them to create a webcam preview graph for DirectShow.
Form2
Since I can't find any way to find just the list of usuable webcams, the user has to pick them out from among the full list of available "filters" (as they are called)! Not practical at all for a real application, but it works for a test/demo program.
That's what Form2 in the demo Project is for, a dialog from which to pick new cameras.
Note that your camera might appear there once, twice, or even three or more times depending on how many "filters" of different kinds it supports. Just pick any of them, the demo program will just use the name and sort it out later.
Module1
This contains some GDI and OLE API calls to convert the captured frame from a "packed DIB" into a StdPicture object that can be used with PaintPicture, etc. This raw StdPicture is created using a "memory DC" so there are some limits on how you can use it, i.e. simply assigning it to a PictureBox.Picture has some issues.
But in this demo we need to scale it anyway since we can't control the actual capture dimensions.
You could rework this passing in the hDC of a Form, PictureBox etc. I suppose.
Running the DSMini1 Project
The attached ZIP archive contains the entire Project.
All you should need to do is unzip the archive, then open the Project in VB6. If you have a webcam connected, you can just go ahead and run it within the IDE.
From there you will have to "Add" your webcam by browsing the filter list.
After a valid add, the live preview starts immediately at the left.
Clicking on the Snap button should take a snapshot and display it in the PictureBox at the right.
If you have another webcam connectd you shuld be able to add that one too. Once you have two or more added you can choose among them via Form1's menu.
Settings are persisted in Settings.txt, so a subsequent run should save you the trouble of picking cameras again.
Remarks
I don't know what webcams this will work with, but I know it works with two very different ones I've tried so far.
↧
↧
Simple "Mass on Spring" Simulation
This code simulates oscillation of mass on a spring and graphs that motion. To use this code, just start a new project, place a picture box on the form, paste the code into the form's Load event, and run the program.
Code:
'set up the display------------------------------
Form1.ScaleMode = 3
With Picture1
.Appearance = 0
.BorderStyle = 0
.AutoRedraw = True
.Width = 257
.Height = 257
.ScaleMode = 0
.ScaleWidth = .Width
.ScaleHeight = -.Height
.ScaleLeft = 0
.ScaleTop = .Height \ 2
End With
'run the simulation------------------------------
Dim f As Double 'net force acting on mass
Dim a As Double 'acceleration
Dim v As Double 'velocity
Dim p As Double 'position
Dim k As Double 'spring constant
Dim d As Double 'damping factor
Dim m As Double 'mass
Dim i As Double 'time increment
Dim t As Double 'time
p = 100
k = 0.1
d = 0.15
m = 2
i = 0.01
For t = 0 To 257 Step i
f = (-p * k) + (-v * d)
a = f / m
v = v + a * i
p = p + v * i
Picture1.PSet (t, p)
Next t↧
VB6 Real Unicode Display in RichTextBox without installing RICHTX32.OCX
Hi Guys!
I combined two nice features for a part of my project and I decided to share it with you. Well, I had three chalanges when I was doing this:
1. Use a RichTextBox for unicode display;
2. Use real unicode characters like superscript numbers (not fake offsets)
3. Not to use a setup which is nearly a must if you are using RichTextBox control to copy and register RICHTX32.OCX file. (because my project was only 380KB which looks stupid for a setup.)
Infact, I did a very small part of the job. This is a nice combination of two different modules written by some other hardworking people.
After a long research dilettante suggested me this project to display real unicode contents RTB Superscript.zip. It is written only "Superscript" but it does a quite well job with unicodes, too... However, only compatible RichText Box object...
At first I was very happy with this but then I realized that it causes error in computers which has no RICHTX32.OCX file in System 32 folder.
I sworn my not to use setup for a 380KB project.
Then in another thread ,again dilettante, suggested me a code (Naked RichEdit.zip) which draws it's own RichTextBox which is only depending on "riched20.dll", nearly found in any PC.
Then I made some tweaks, modifications and combined them, droped some notes into code to help for some basic features.
And TA-TAA:
Attachment 95963 !!!
I hope someone will find it useful, too...
PS: If anybody knows how to change the font in the code, please do let me know :D
I combined two nice features for a part of my project and I decided to share it with you. Well, I had three chalanges when I was doing this:
1. Use a RichTextBox for unicode display;
2. Use real unicode characters like superscript numbers (not fake offsets)
3. Not to use a setup which is nearly a must if you are using RichTextBox control to copy and register RICHTX32.OCX file. (because my project was only 380KB which looks stupid for a setup.)
Infact, I did a very small part of the job. This is a nice combination of two different modules written by some other hardworking people.
After a long research dilettante suggested me this project to display real unicode contents RTB Superscript.zip. It is written only "Superscript" but it does a quite well job with unicodes, too... However, only compatible RichText Box object...
At first I was very happy with this but then I realized that it causes error in computers which has no RICHTX32.OCX file in System 32 folder.
I sworn my not to use setup for a 380KB project.
Then in another thread ,again dilettante, suggested me a code (Naked RichEdit.zip) which draws it's own RichTextBox which is only depending on "riched20.dll", nearly found in any PC.
Then I made some tweaks, modifications and combined them, droped some notes into code to help for some basic features.
And TA-TAA:
Attachment 95963 !!!
I hope someone will find it useful, too...
PS: If anybody knows how to change the font in the code, please do let me know :D
↧
VB6 Real Unicode Display in Rich Edit without installing RICHTX32.OCX
Hi Guys!
I combined two nice features for a part of my project and I decided to share it with you. Well, I had three challanges when I was doing this:
1. Use a RichTextBox for unicode display;
2. Use real unicode characters like superscript numbers (not fake offsets)
3. Not to use a setup which is nearly a must if you are using RichTextBox control to copy and register RICHTX32.OCX file. (because my project was only 380KB which looks stupid for a setup.)
Infact, I did a very small part of the job. This is a nice combination of two different modules written by some other hardworking people.
After a long research dilettante suggested me this project to display real unicode contents RTB Superscript.zip. It is written only "Superscript" but it does a quite well job with unicodes, too... However, only compatible RichText Box object...
At first I was very happy with this but then I realized that it causes error in computers which has no RICHTX32.OCX file in System 32 folder.
I sworn my not to use setup for a 380KB project.
Then in another thread ,again dilettante, suggested me a code (Naked RichEdit.zip) which draws it's own RichTextBox which is only depending on "riched20.dll", nearly found in any PC.
Then I made some tweaks, modifications and combined them, droped some notes into code to help for some basic features.
And TA-TAA:
Attachment 95963 !!!
I hope someone will find it useful, too...
PS: If anybody knows how to change the font in the code, please do let me know :D
I combined two nice features for a part of my project and I decided to share it with you. Well, I had three challanges when I was doing this:
1. Use a RichTextBox for unicode display;
2. Use real unicode characters like superscript numbers (not fake offsets)
3. Not to use a setup which is nearly a must if you are using RichTextBox control to copy and register RICHTX32.OCX file. (because my project was only 380KB which looks stupid for a setup.)
Infact, I did a very small part of the job. This is a nice combination of two different modules written by some other hardworking people.
After a long research dilettante suggested me this project to display real unicode contents RTB Superscript.zip. It is written only "Superscript" but it does a quite well job with unicodes, too... However, only compatible RichText Box object...
At first I was very happy with this but then I realized that it causes error in computers which has no RICHTX32.OCX file in System 32 folder.
I sworn my not to use setup for a 380KB project.
Then in another thread ,again dilettante, suggested me a code (Naked RichEdit.zip) which draws it's own RichTextBox which is only depending on "riched20.dll", nearly found in any PC.
Then I made some tweaks, modifications and combined them, droped some notes into code to help for some basic features.
And TA-TAA:
Attachment 95963 !!!
I hope someone will find it useful, too...
PS: If anybody knows how to change the font in the code, please do let me know :D
↧