Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all 1474 articles
Browse latest View live
↧

[VB6] AVICap32 Cam Streaming w/o Clipboard

June 30, 2012, 8:12 am
$
0
0
The idea here is a "web" cam server that streams frames as JPEGs to a non-Web client, using AVICap32.dll but without screwing up the system Clipboard. A webcam HTTP server has also been added (later in this thread).


Caveats

To begin with it seems that in modern versions of Windows AVICap32.dll must work with a WDM/VFW "adapter" driver. On such systems even if you had 12 webcams plugged in they all appear a Device 0. So here we're defaulting to Dev 0 instead of enumerating them and giving the user a choice.

If there are multiple cameras, when the RemCam server starts you may see the system pop up a dialog and ask you which one to use. I've had no luck at all with this myself, and it seems to be a common problem. The workaround I've seen involves reading and writing to some HKLM key, which requires admin rights so I don't consider it a viable solution.

And so far I haven't gotten this to work on any Win7 system (though the only one I have handy has two built-in cams). I also had it fail on a 64-bit Vista system, though that might be related to drivers or something.


Successes

I've had good luck though using a 32-bit Vista system with a single USB cam plugged in. I also had good luck using a 32-bit XP system with one USB cam plugged in (different cam).


Requirements

As far as I can tell this may well work on any system from Windows XP SP1 on up if you can get past the WDM camera issues. This may simply be a matter of proper drivers, though I'd be unsurprised to find there are Win7 issues and 64-bit issues that cannot be overcome.

On XP systems you need to ensure that you have WIA 2.0 installed. XP SP3 may include this now, I haven't verified this. You can download the SDK which contains the required DLL from Windows® Image Acquisition Automation Library v2.0 Tool: Image acquisition and manipulation component for VB and scripting.

This must be manually installed: open WIAAutSDK.zip and see the instructions in the readme file.

Also, when creating deployment packages on a system after WinXP be sure that you package the version of this DLL you take from WIAAutSDK.zip and not the one from your running system!


Some Details

Capture w/o Clipboard

This is done here using a frame callback from AVICap32.dll.

TCP Message Framing

The individual JPEGs are sent as a 4-byte Long (length of the following data), and then a JPEG image file's bytes. Note that the techniques used here do not require writing the JPEGs to disk files as an intermediate step though!


Building the Programs

On a system that has WIA 2.0 present and working, just open and Make the two Projects:
  • RemCam - the server.
  • MulitClient - the client.
You'll also probably want to create a PDW setup, MSI package, or a reg-free COM XCopy-deployable package (assuming you have a 3rd party reg-free COM packager for VB6 programs).


Running RemCam

Install RemCam.exe and a USB webcam on each camera source system. Though technically this is a "server" note that it has not been designed as a true Windows Service.

You'll also want to allow RemCam through any software and hardware firewalls in place. The default TCP port is 8765.

Run RemCam.exe, enter the desired service port # (8765 is prefilled in the Textbox), click on the Start button. Soon it should display a small preview window and it should be online for a single client at this point.


Running MultiClient

Install MultiClient.exe and then run it. Since it establishes only outgoing TCP connections your firewalls probably won't require configuration.

When it comes up, for each active RemCam server you can enter the remote host name or IP address and port number, then click the Connect button. If all goes well, Connect becomes Disconnect and the preview pane should begin showing the stream from that RemCam instance.

Clicking on a camera preview pane "selects" it and the larger camera view pane will begin showing the camera's stream at full speed.


Notes

If you are connected to multiple RemCam servers (up to 4 in this version) you can click the the previews to switch views to the large view pane.

Preview panes "drop" every few frames intentionally to improve performance.

Streaming video by sending JPEG images over a TCP connection isn't the best way to do streaming video. But it's simple and cheap to do and may suffice for many purposes, though it might not be too practical over a slow network.

The RemCam server (as written) requires that your camera support 320x240 capture. If your cameras are different you may need to adjust the code, or even add some option selection capability to RemCam's UI.

I'm working on an important optimization in MultiClient, so I expect to be reposting the attachment soon.


Conclusion

Aside from the limitations of this approach, where it works it seems to work fairly well. I'm not saying the code is bug-free, but at least it is a small amount of code so over time we'll probably get things ironed out.

If anyone has any more info to share on some of the gotchas I've described above, or better yet some fixes or workarounds... I'd love to hear them.

I'm not claiming I'm doing anything truly unique here, but I thought it might be worth sharing. Most similar code I've seen uses the clipboard.
Attached Images
 
Attached Files
↧
Search

Fix Visual Styles Issues (Themes)

June 30, 2012, 8:21 am
$
0
0
Hello,

this function will fix properly following issues with Visual Styles (Themes):
- Frame control (black background on controls)
- Focus rectangles not shown
- Accelerator keys not shown
- CommandButton, CheckBox and OptionButton with Graphical Style not themed

In order to use this function you first need to create a manifest:
Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <dependency>
      <dependentAssembly>
        <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" language="*" processorArchitecture="*" publicKeyToken="6595b64144ccf1df"/>
      </dependentAssembly>
  </dependency>
</assembly>
Or just put attached resource fille into your application. That is the same just compiled into a resource.

This need to be put on the Sub Main:
Code:
Private Sub Main()
Call InitVisualStyles
Form.Show vbModeless
End Sub
To put on every Form Load event:
Code:
Private Sub Form_Load()
Call SetupVisualStyles(Me)
End Sub
The Code is too long to put directly here. So I have attached it. (see CodeVisualStyles.txt)
Attached Files
↧
↧

JSON Parser

July 1, 2012, 11:39 pm
$
0
0
JSON coder/decoder.
You must to patch Visual Basic 6 with Service Pack 6 before compiling with this TLB!

The ToJSON function can parse data with all kinds of errors, but parsing the JSON comments is not implemented.
The JSON comments are not part of the standard and slow down the parsing.

Formatted output:
Code:
[
  {},
  [
  {},
  []
  ],
  1,
  [
  4,
  5.1,
  {
    "a":1,
    "b":2
  }
  ],
  "3\u000B"
]
C-like empty items parsing (last empty is ignored):
Code:
[]            []
[,]          [null]
[,,]          [null,null]
[null]        [null]
[null,null]  [null,null]
[,1]          [null,1]
[,,2]        [null,null,2]
[1,]          [1]
[2,,]        [2,null]
Skip whitespace function released as:
VB Code:
  1. Private Const WhiteSpace = " " & vbTab & vbCrLf
  2. Private Function SkipWhiteSpace() As Integer
  3.   i = i + (CharsCountPtrStr(i, WhiteSpace) * 2)
  4.   SkipWhiteSpace = MemInt(i)
  5. End Function

Declared through Type Library functions:
Code:
CharsCountPtrStr = shlwapi.StrSpnW
MemInt = msvbvm60.GetMem2
FindCharsPtrStr = shlwapi.StrPBrkW
AllocString = oleaut32.SysAllocStringLen
Also in the project you can find:
Type library with sources (‎Usable VB and Windows API declarations are added during the programming from December 1, 2011)
Function to detect is file exists
Functions for reading and writing the whole binary and text files
Functions for reading and writing the file times
Function to detect is current thread active (IsAppActive)
Function to get window class

Rate and comment please!
Attached Files
↧

[VB] Parsing Excel tabbed data to the object (and vice versa)

July 4, 2012, 1:37 am
$
0
0
Parsing the data that was copied from Excel.
Data with header is represented as the Collections in the Dictionary.
Data without header is represented as the Collections in the Collection.

Do not forget to add Microsoft Scripting Runtime to the references.

VB Code:
  1. Public Function FromTable(s As String, Optional WithHeader As Boolean = True, _
  2.   Optional Delimiter As String = vbTab) As Object
  3.   Dim TC As Collection, TD As Dictionary, Columns() As Collection
  4.   Dim Rows() As String, Row() As String, Header() As String
  5.   Dim iRow As Long, nRows As Long, iColumn As Long, nColumns As Long, nCurColumns As Long
  6.   If Len(Delimiter) <> 0 Then
  7.     If WithHeader = True Then
  8.       Set TD = New Dictionary
  9.       Rows = Split(s, vbCrLf)
  10.       nRows = UBound(Rows)
  11.       If nRows <> -1 Then
  12.         Header = Split(Rows(0), Delimiter)
  13.         nColumns = UBound(Header)
  14.         ReDim Preserve Columns(nColumns)
  15.         For iColumn = 0 To nColumns
  16.           Set Columns(iColumn) = New Collection
  17.           TD.Add Header(iColumn), Columns(iColumn)
  18.         Next iColumn
  19.         For iRow = 1 To nRows
  20.           Row = Split(Rows(iRow), Delimiter)
  21.           nCurColumns = UBound(Row)
  22.           If nCurColumns > nColumns Then
  23.             nCurColumns = nColumns
  24.           End If
  25.           For iColumn = 0 To nCurColumns
  26.             Columns(iColumn).Add Row(iColumn)
  27.           Next iColumn
  28.           For iColumn = nColumns + 1 To nColumns
  29.             Columns(iColumn).Add vbNullString
  30.           Next iColumn
  31.         Next iRow
  32.         Set FromTable = TD
  33.       End If
  34.     Else
  35.       Set TC = New Collection
  36.       Rows = Split(s, vbCrLf)
  37.       nRows = UBound(Rows)
  38.       If nRows <> -1 Then
  39.         Row = Split(Rows(0), Delimiter)
  40.         nColumns = UBound(Row)
  41.         ReDim Preserve Columns(nColumns)
  42.         For iColumn = 0 To nColumns
  43.           Set Columns(iColumn) = New Collection
  44.           TC.Add Columns(iColumn)
  45.           Columns(iColumn).Add Row(iColumn)
  46.         Next iColumn
  47.         For iRow = 1 To nRows
  48.           Row = Split(Rows(iRow), Delimiter)
  49.           nCurColumns = UBound(Row)
  50.           If nCurColumns > nColumns Then
  51.             nCurColumns = nColumns
  52.           End If
  53.           For iColumn = 0 To nCurColumns
  54.             Columns(iColumn).Add Row(iColumn)
  55.           Next iColumn
  56.           For iColumn = nColumns + 1 To nColumns
  57.             Columns(iColumn).Add vbNullString
  58.           Next iColumn
  59.         Next iRow
  60.         Set FromTable = TC
  61.       End If
  62.     End If
  63.   End If
  64. End Function
  65.  
  66. Public Function IsCollection(a) As Boolean
  67.   If IsObject(a) Then
  68.     If ObjPtr(a) <> 0 Then
  69.       If TypeOf a Is Collection Then
  70.         IsCollection = True
  71.       End If
  72.     End If
  73.   End If
  74. End Function
  75. Public Function ToTable(obj As Object, Optional Delimiter As String = vbTab) As String
  76.   Dim iColumn As Long, nColumns As Long
  77.   Dim iRow As Long, nRows As Long, Items(), Columns() As Collection
  78.   If (Len(Delimiter) <> 0) And IsObject(obj) Then
  79.     If ObjPtr(obj) <> 0 Then
  80.       If TypeOf obj Is Dictionary Then
  81.         nColumns = obj.Count - 1
  82.         If nColumns >= 0 Then
  83.           Items = obj.Items
  84.           ReDim Preserve Columns(nColumns)
  85.           For iColumn = 0 To nColumns
  86.             If IsCollection(Items(iColumn)) = True Then
  87.               Set Columns(iColumn) = Items(iColumn)
  88.             Else
  89.               Exit Function
  90.             End If
  91.           Next iColumn
  92.         End If
  93.       ElseIf TypeOf obj Is Collection Then
  94.         nColumns = obj.Count - 1
  95.         If nColumns >= 0 Then
  96.           ReDim Preserve Columns(nColumns)
  97.           For iColumn = 0 To nColumns
  98.             If IsCollection(obj(iColumn + 1)) Then
  99.               Set Columns(iColumn) = obj(iColumn + 1)
  100.             Else
  101.               Exit Function
  102.             End If
  103.           Next iColumn
  104.         End If
  105.       Else
  106.         Exit Function
  107.       End If
  108.       For iRow = 1 To Columns(0).Count
  109.         For iColumn = 0 To nColumns
  110.           ToTable = ToTable & Columns(iColumn)(iRow)
  111.           If iColumn <> nColumns Then
  112.              ToTable = ToTable & Delimiter
  113.           Else
  114.             ToTable = ToTable & vbCrLf
  115.           End If
  116.         Next iColumn
  117.       Next iRow
  118.     End If
  119.   End If
  120. End Function
↧

Patch Collection to support case sensitivity

July 7, 2012, 3:07 am
$
0
0
The Collection is 3-4 and more times faster then the Dictionary when adding items, and 2 times slower when retrieving.

Tested compiled and runned from the IDE in the Windows XP 64 and in the Windows 7 64 with different versions of msvbvm60.dll and vba6.dll.
So it is must be stable.

VB Code:
  1. Private Declare Sub GetMem1 Lib "msvbvm60" (ByVal Address As Long, n As Byte)
  2. Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Address As Long, ByVal n As Byte)
  3. Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Address As Long, n As Integer)
  4. Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Address As Long, n As Long)
  5.  
  6. Private Const PAGE_EXECUTE_READWRITE = &H40&
  7. Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
  8. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  9.  
  10. Sub Main()
  11.   Dim c As New Collection
  12.   PatchCollection
  13.   c.Add 1, "Test"
  14.   c.Add 2, "test"
  15.   MsgBox c("Test")
  16.   MsgBox c("test")
  17. End Sub
  18.  
  19. Private Property Get MemByte(ByVal Address As Long) As Byte
  20.   GetMem1 Address, MemByte
  21. End Property
  22. Private Property Let MemByte(ByVal Address As Long, ByVal n As Byte)
  23.   PutMem1 Address, n
  24. End Property
  25. Private Function MemInt(ByVal Address As Long) As Integer
  26.   GetMem2 Address, MemInt
  27. End Function
  28. Private Function Mem(ByVal Address As Long) As Long
  29.   GetMem4 Address, Mem
  30. End Function
  31. Public Sub PatchCollection(Optional ByVal IsCaseSensitive As Boolean = True)
  32.   Dim Addr As Long
  33.   If InIDE = False Then
  34.     addr = GetModuleHandle("MSVBVM60.DLL")
  35.   Else
  36.     Addr = GetModuleHandle("VBA6.DLL")
  37.   End If
  38.   Addr = SearchPatchBytes(Addr)
  39.   PatchByte(Addr) = IsCaseSensitive + 1
  40.   Addr = SearchPatchBytes(Addr)
  41.   PatchByte(Addr) = IsCaseSensitive + 1
  42. End Sub
  43. Private Function InIDE() As Boolean
  44.   On Error Resume Next
  45.   Debug.Print 0 / 0
  46.   InIDE = Err.Number <> 0
  47. End Function
  48. 'Patch calls to the oleaut32_VarBstrCmp function
  49. Private Function SearchPatchBytes(ByVal Addr As Long)
  50.   Addr = Addr + 7
  51.   Do
  52.     Do
  53.       While MemByte(Addr) <> &H68 'push
  54.         Addr = Addr + 1
  55.       Wend
  56.       Addr = Addr + 1
  57.     Loop While (Mem(Addr) And &HFFFFFFFE) <> &H30000 'NORM_IGNORECASE = 0/1
  58.     Addr = Addr + 4
  59.   Loop While MemInt(Addr) <> &H16A 'push 1 (Locale identifier)
  60.   SearchPatchBytes = Addr - 4
  61. End Function
  62. Private Property Let PatchByte(ByVal Addr As Long, ByVal b As Byte)
  63.   Dim OldProtect As Long
  64.   VirtualProtect Addr, 1, PAGE_EXECUTE_READWRITE, OldProtect
  65.   MemByte(Addr) = b
  66. End Property

or with TLB (see my others posts to download it):
VB Code:
  1. Sub Main()
  2.   Dim c As New Collection
  3.   PatchCollection
  4.   c.Add 1, "Test"
  5.   c.Add 2, "test"
  6.   MsgBox c("Test")
  7.   MsgBox c("test")
  8. End Sub
  9.  
  10. Public Sub PatchCollection(Optional ByVal IsCaseSensitive As Boolean = True)
  11.   Dim addr As Long
  12.   If InIDE = False Then
  13.     addr = GetModuleHandle("MSVBVM60.DLL")
  14.   Else
  15.     addr = GetModuleHandle("VBA6.DLL")
  16.   End If
  17.   addr = SearchPatchBytes(addr)
  18.   PatchByte(addr) = IsCaseSensitive + 1
  19.   addr = SearchPatchBytes(addr)
  20.   PatchByte(addr) = IsCaseSensitive + 1
  21. End Sub
  22. Private Function InIDE() As Boolean
  23.   On Error Resume Next
  24.   Debug.Print 0 / 0
  25.   InIDE = Err.Number <> 0
  26. End Function
  27. 'Patch calls to the oleaut32_VarBstrCmp function
  28. Private Function SearchPatchBytes(ByVal addr As Long)
  29.   addr = addr + 7
  30.   Do
  31.     Do
  32.       While MemByte(addr) <> &H68 'push
  33.         addr = addr + 1
  34.       Wend
  35.       addr = addr + 1
  36.     Loop While (Mem(addr) And &HFFFFFFFE) <> &H30000 'NORM_IGNORECASE = 0/1
  37.     addr = addr + 4
  38.   Loop While MemInt(addr) <> &H16A 'push 1 (Locale identifier)
  39.   SearchPatchBytes = addr - 4
  40. End Function
  41. Private Property Let PatchByte(ByVal addr As Long, ByVal b As Byte)
  42.   Dim OldProtect As Long
  43.   VirtualProtect addr, 1, PAGE_EXECUTE_READWRITE, OldProtect
  44.   MemByte(addr) = b
  45. End Property
↧
↧

[VB6] 7-zip support

July 8, 2012, 4:37 am
$
0
0
Here is an open source project that provides support for 7-zip in your VB6 projects.

https://github.com/wqweto/VszLib

Using VszLib.dll + 7z.dll your applications can create and extract 7z, zip, tar.gz, tar.bz2 and many more compression formats. Latest versions of 7z format include LZMA2 method for faster multi-core compression.

Post your comments and questions here.

cheers,
</wqw>
p.s. @Moderators: Please remove original thread.
↧

[VB6] Google Cloud Print service support

July 8, 2012, 4:40 am
↧

The Best GGD That Was Ever Made

July 14, 2012, 9:44 pm
$
0
0
That is actually the title of this program I wrote (using VB6). It is based on the a sprite dumping software called GGD, which stands for Game Graphics Dumper. GGD was basically a very fancy version of a RAW image loader. It can take ANY file, and it does not know the format, nor how to read any header, so you supply a LOT of info so GGD can load the Graphics (stuff like, offset to image data, height, width, tiled or linear arranged pixels, color channel order, bits per pixel, offset to palette data, and all the same formats for the image are repeated for the palette, selectable endianness, etc). This way almost ANY format you can imagine (as long as it is in RGB or RGBA colorspace, cause YUV doesn't work here) that might ever be found in any video game or any other source (and as long as it isn't encrypted or compressed), can be displayed and saved as an ordinary bitmap file.

Well the controls for the original GGD were not user friendly, and the documentation was in Chinese or Japanese, so it was basically a "if you only know English, figure it out for yourself" type software (although some hacker made a translated version in English later, the controls still were horrible). Then came one called Tiled GGD that had some extra options for tiled graphics, including options for planar arranged color channels (instead of per-pixel arranged color channels, though I think planar color channels were also available in the original GGD), and it was based on GGD (it was a derivative work you might say), but it was made by an English speaking guy (luckily), and the controls were easier to use. However it lacked a number of features of the original GGD, namely it lacked the ability to arange the bit masks that were used to define which bits in a 16 (or 15) bit per pixel image were used for what colors, and also what ones were used for alpha (if any at all).

Well my program called "The Best GGD That Was Ever Made" is my own take on how the GGD program should have been designed, and has the functionality missing from Tiled GGD, which existed in the original GGD. It also is designed to have a much more intuitive user interface than the original GGD. To load a file, just drag it Windows explorer onto most any spot in the GUI, then press "load file" button. If it doesn't look right, change some of the parameters and press "load file" again. To load a palette, drag a file that you believe has the color palette for the image into the square black box and check the box "Use External palette", then press the "load file" button again. If the palette looks wrong, adjust the palette parameters and press "load file" again. To save a palette, select the option button (radio button) for the palette format you want, and press "save palette". When the picture looks right, press the "save image" button to save the image as a BMP file.

Below here is the VB code for the software.
Click to view: http://pastebin.com/raw.php?i=3tSjajtx
Click to download TXT file: http://pastebin.com/download.php?i=3tSjajtx




Here's the code that sets up the form in the FRM file.
Click to view: http://pastebin.com/raw.php?i=fLp30wPe
Click to download TXT file: http://pastebin.com/download.php?i=fLp30wPe



Here is a screenshot of the GUI:





It also has one dependency that isn't a normal VB6 runtime file. Download the DLL file at: http://www.dllbank.com/zip/n/nctimagefile.dll.zip
↧
Search

CRC32 - Fastest Implementation Available VB6

July 23, 2012, 7:12 am
$
0
0
The implementation I have written achieves its speed through use of x86 assembly code. In fact, the entire implementation of the CRC32 algorithm is written in assembly.

I use assembly via some tricks involving class modules and the object's vtable. I allocate a block of memory, write the machine code to the memory, then rewrite the functions vtable entry to point to my block of code.

It is roughly 25x faster than the current "fastest" implementation found on pscode.con that gets its speed through asm assisted bitshifting (which was written by me too) and probably 100x to 150x faster than a pure VB approach.

The project and code file(s) can be found here:
http://www27.brinkster.com/wsckvbupdates/CRC32.zip

P.S. because it is hosted on a free web server, you might have to copy the link and manually paste it rather than clicking on it.
Also, look forward to more hashing algorithms, encryptions, and etc to be written in asm taylored for use with vb6 to be released in the future!
↧
↧

[VB6] TEMPer Gold USB HID Thermometer Class

August 1, 2012, 2:00 pm
$
0
0
Note

Be sure to see the updated version (posted as version 2 below)!


Some Background

TEMPer is a series of products by PCsensor for measuring temperature (and in some cases humidity). There are many models on the market with varying capabilities. While some of the early units appear as USB Serial devices (COMx: ports) the newer ones are USB HID devices that use the standard Windows driver and don't require driver installation.

TEMPerGold.cls is a Visual Basic 6.0 Class that works only with the TEMPer Gold product. It is a wrapper around the RDingUSB.dll that comes with the unit's software package. The software is a basic .Net application you may or may not find useful. There is basically ZERO documentation available on the companion mini-CD or online.

TEMPer Gold runs from about $9 to $20 USD (depending on where you shop) if you are curious. I've never seen the red LED light up as described by PCsensor. But perhaps mine has a dummy LED where the LED would go, having been dropped to save costs?


Basic Operation

If you plug in the TEMPer Gold without installing any software it "installs" in Windows as two HID devices: one a keyboard and the other a special function device.

As a "keyboard" you can make basic use of the TEMPer by opening Excel or even Notepad and then holding Caps Lock or Num Lock for 3 seconds, which makes it start "typing" readings until you hold down Caps Lock or Num Lock 3 seconds again.

Details on using the sample .Net applet can be found on the PCsensor web site (see link above). I didn't install it because I have too much .Net clutter here right now anyway, and did not want to risk the cruft a poorly constructed installer might leave behind even after uninstalling it.


Extracting RDingUSB.dll

Since [version 1 of] my code requires this DLL you'll have to extract it in order to use TEMPerGold.cls yourself.

The easiest way is to locate the MSI package containing the PCsensor demo applet and do an "administrative install" to extract the installation files to a folder. Example:

Code:
msiexec /a "d:\work\temper\thepackage.msi" /qb TARGETDIR="d:\work\temper\packagefiles"

My Demo

The attached demo Project archive contains all of the files needed to build and run the VB6 demo. However for it to run you'll need to either put RDingUSB.dll in the Project folder yourself, or else place it where a normal system DLL Search will find it.

The demo as written manages the state of its UI to guide you through the right steps, but basically:
  • First you Open the device.
  • Then you can Get/Set the Calibration.
  • Then you can start taking sample readings.
  • Finally you Close the device.
Calibration is an offset ranging from -8 to +7°C, and it seems to be non-volatile. You only need to set it when you want to adjust it.


Oof!

This was a messy thing to track down and I had lots of false starts.

While written only for the TEMPer Gold you can probably modify it to work for other TEMPer devices that are USB HID devices. The earlier models that present themselves as a USB COM-port might be easier to use but most of the logic in this class will not apply.

From a DUMPBIN of the file the RDingUSB.dll is really a renamed SonixUSB.dll.


Taking it Further

You could easily write a data logger, charting application, etc. if you want one.

I'm thinking of adding it as optional functionality to my GossCam webcam server posted here in another thread.
Attached Images
   
Attached Files
↧

Hyperlink Control

August 9, 2012, 1:36 pm
$
0
0
This is a UserControl for simulating a Hyperlink. The control is build up by a simple label.
But it have some advantages comparing to a simple label putted on a form.

It will show up a hand cursor when the mouse is over the control. In addition a hover effect can be used when the mouse is over it.
The control itself can receive focus, which is very helpful for keyboard users. But it only keeps the focus when control is not entered by mouse.

The control fires a "Jump" event. In that event the code should be put to open a url, document or anything else.

Attachment 90381

Attachment: Sample project with the hyperlink (user)control.

EDIT1:
- It now supports a ColorUsed property.
- The focus can be navigated now with the arrow keys within the controls container.
- Added a PrepareJump event where the user can set if the LostFocus Event will always be fired or not. (Example Usage: Calling a MsgBox in the Jump Event will not fire the LostFocus Event. Therefore a possible focusrect drawing is still visible while the MsgBox is displayed)
- other minor improvements
Attached Images
 
Attached Files
↧

[vb6] Module: GetDataFromURL

August 14, 2012, 9:51 am
$
0
0
Originally, i writed this module for self. Now i'm publish module for others. :)

This module created for the send GET\POST queries to the server.

GetDataFromUrl: - Sending request to remote server.
strURL - URL of the target page.
Optional strMethod = GET - Page request method: GET, POST or Multipart. (POST with multipart)
Optional Async = false - Run in asynchronous mod. (To prevent gui lags).
Optional strPostData = "" - Data to post. (Only if strMethod = POST\Multipart)
Optional boundary = "" - Boundary for multipart. (Only if strMethod = Multipart. Create with Make_Boundary.)

Make_Boundary: - Making Boundary for POST + multipart request.

Add_Multipart: - Adding fields for POST + multipart request.
post_field - Field.
post_data - Value of field. Leave empty, if you sending a file.
boundary - Boundary. (Create with Make_Boundary.)
Optional file_path = "" - Path to file. Leave empty, if you want to send post_data.Attachment 90481


GET request example:
Code:
Dim ansv As String
ansv = GetDataFromURL("http://vbforums.com")
POST request example:
Code:
Dim ansv As String
ansv = GetDataFromURL("http://vbforums.com", "POST", false, "field1=value1&field2=value2")

POST request with multipart example:
Code:
Dim ansv As String
Dim Multipart As String
Dim Boundary As String

Boundary = Make_Boundary

Multipart = Add_Multipart("Field1", "Value1", Boundary)
Multipart = Multipart & Add_Multipart("Field2", "Value2", Boundary)
Multipart = Multipart & Add_Multipart("File2", VbNullString, Boundary, "C:\test.txt") 'File upload example
Multipart = Multipart & "--" & Boundary & "--"


ansv = GetDataFromURL("http://vbforums.com", "Multipart", false, Multipart, Boundary)
---------------------------------
I hope you enjoy it. :) Sorry for my bad english.

Attachment 90481
Attached Files
↧

[VB/VBA] LunarPhase - Phase of the Moon

August 25, 2012, 8:06 pm
$
0
0
When you don't need it, you don't need it. But when you do it can take a little thinking through.

The basic concept is fairly easy if you simply need rough, non-astronomical results. Take your target date/time, find out how far it is from a base date/time with a known phase (say New Moon), take the Lunar phase cycle period, and then the result is easy:

Phase = Delta Mod Period

Usually you'll want the value in more granular form. Maybe quarters is good enough, etc. so just divide the "Phase" value by the fraction of "Period" you want for granularity.

Another refinement is to make sure your base and target times are for the same time zone so you can avoid being off by 0 to 24 hours.


Here I used a UTC "base" New Moon date & time so I correct local time to UTC before calculating (this function is in the attached demo project). I found 24 images for the entire cycle so I am returning a phase value that is 1/24th of a Lunar period. I was careful to reduce the use of non-integer arithmetic and avoid rounding.

So hopefully this works out reasonably accurately for simple "display the phase of the Moon" purposes:
Code:
Public Const PhaseBase As Date = #1/17/1980 9:18:00 PM# 'GMT/UTC.
Public Const LunarSynod As Long = 42524    'Minutes.

Public Function LunarPhase(ByVal TargetDate As Date) As Integer
    'Returns lunar phase for TargetDate starting from PhaseBase
    'timestamp forward, at 1/24 cycle intervals, i.e. values
    'from 0 to 23:
    '
    '    0 = New Moon
    '    6 = First Quarter
    '  12 = Full Moon
    '  18 = Last Quarter
   
    LunarPhase = _
        (Fix(DateDiff("n", PhaseBase, ToUTC(TargetDate))) Mod LunarSynod) _
      \ (LunarSynod \ 24)
End Function
I've wrapped it in a small demo application for testing.
Attached Images
 
Attached Files
↧
↧

[VB6] - Lottery-Algorithm

September 5, 2012, 9:18 am
$
0
0
On a german Forum I developed the following Lottery-Algorithm (which i haven't found on the Internet in this form).

I would like to hear your opinions and/or suggestions to improve it

vb Code:
  1. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  2.  
  3. Sub Lottery(ByVal DrawNumbers As Long, ByVal TotalNumbers As Long)
  4. Dim arrSource() As Long    
  5. Dim arrDest() As Long
  6.  
  7. Dim i As Long
  8. Dim j As Long
  9. Dim Counter As Long
  10. Dim RandomNumber As Long
  11.  
  12.     'What Lottery is played
  13.     ReDim arrDest(1 To DrawNumbers)
  14.     ReDim arrSource(1 To TotalNumbers)
  15.     
  16.     'Create Source-Array
  17.     For i = 1 To TotalNumbers
  18.     
  19.         arrSource(i) = i
  20.     
  21.     Next
  22.     
  23.     Counter = 0
  24.  
  25.     Randomize
  26.  
  27.     Do
  28.  
  29.         RandomNumber = Int(UBound(arrSource) * Rnd + 1)
  30.     
  31.         Counter = Counter + 1
  32.         arrDest(Counter) = arrSource(RandomNumber)
  33.         
  34.         'Cutting out the RandomNumber drawn
  35.         For j = RandomNumber + 1 To UBound(arrSource)
  36.         
  37.             CopyMemory arrSource(j - 1), arrSource(j), 4
  38.             
  39.         Next
  40.         
  41.         'Cut down the Source-Array
  42.         ReDim Preserve arrSource(1 To UBound(arrSource) - 1)
  43.            
  44.     Loop Until Counter = DrawNumbers
  45.     
  46.     For i=1 to DrawNumbers
  47.      
  48.          Debug.Print arrDest(i)
  49.  
  50.     Next
  51.  
  52. End Sub
  53.  
  54. 'Calling the function with
  55. Call Lottery (6, 49)
↧

Caption Gradiator III / VB6 Form Gradient Titlebar

September 25, 2012, 1:01 pm
$
0
0
Hello, :wave:

Caption Gradiator III is a Basic Module that facilitates a custom gradient color titlebar for Visual Basic forms. The original program came from another VB author's web sight. The code was bloated and had several bugs including the failure to repaint area around the form control box buttons. The original author's approach to fixing the bugs was to tie the process to a sub class timer thereby increasing the bloat. My approach was to use better logic and less code. I learned from the original code as opposed to copying the code. The changes I made were significant and I have no problem with calling this my own program. The process is called from the Form_Load event and cancelled in the Form_Unload event as illustrated in the form code in the project.

Enjoy,
OldRon, aka servowizard
Attached Files
↧
Search

MemoryView

September 26, 2012, 6:26 am
$
0
0
This started as a simple program to show a hex dump of 'safe' memory addresses,
i.e. those returned by VarPtr, StrPtr, VarPtrArray, and an undocumented
function, StringArrPtr.

After playing with it for a bit, I got interested in how VB stores its variables in memory
and this is the result.

It uses CopyMemory liberally, so if you start tweaking it, be careful and
save your project before running in case you crash VB. (You can select
Tools|Options|Environment and click on Save when program starts.)

The program allows you to examine numeric values, numeric arrays, numeric safe arrays,
string values, string arrays, string safe arrays, and UDTs (Types).

Here's a sample output

**Long variable with value of &H4030201
Start Address: &H0013F8AC Number of Bytes: 16
________________________________________________________________________________
Base: OS: Hex: Ascii:
0013F8AC 0000 01 02 03 04 40 F9 13 00 10 FA 13 00 01 00 00 00 ....@...........
________________________________________________________________________________
Attached Files
↧

VB6 - Melas: Line Charting Classes

September 28, 2012, 7:59 pm
$
0
0
Why Melas?

I needed an alternative to the MSChart control for creating simple line charts in batch mode. MSChart can do the job just fine with some fiddling, however I needed to create these charts and write them as JPEG or PNG files for direct serving from a Web server. The only snag is that to capture the drawn chart from the MSChart control you need to use the clipboard and I didn't want to disturb its contents since a user might well be working while a background charting operation was going on.


What is Melas?

There is a main class called Melas and a set of "child" classes it uses to represent various things (axes, plots, legends, etc.). You create an instance of Melas and initialize it with a reference to some VB6 object having an hDc so that it can be drawn on. In most cases this will be a Form, a PictureBox, or a UserControl.

From there you use some MSChart-like operations to flesh out the rest and plot your lines.


Still Rough

There is more to do here yet, especially in terms of dealing with pesky boundary conditions (do I subtract a pixel here or not?), making sure rotated text gets positioned correctly, etc.

However I decided to post it as-is.

For one thing it is still simple enough that somebody could use it as an example or jumping-off point for creating their own more comprehensive MSChart alternative. For another I am taking the code in a specific direction for my own purposes that will make the logic more complex to follow as well as being less general-purpose in nature.


Notes

There is no code here to grab the resulting chart image and save it, the focus here is drawing the chart. You can use simple .SavePicture() operations to create BMP files or else use another technique to grab and save in other formats.

The core of the Melas classes is the Canvas class, which is primarily meant to create non-clipped and clipped regions where the Y-coordinate is flipped (0 at the bottom instead of the top as in regular VB6 drawing) and both X and Y are scaled without using a custom ScaleMode.

Inside the Melas class you will find places where it uses Canvas coordinates, and others where it draws directly and uses VB6 cordinates. Sorry about the confusion - this is just a heads-up to anybody trying to unravel the logic.

The attachment contains the Melas classes and 5 demos. There are some images in there and a small database, which is why the attachment is so large. Melas itself is fairly small and doesn't add a ton to the size of compiled programs.
Attached Images
     
Attached Files
↧
↧

VB6 IDE solving UAC and Visual Style issues

September 29, 2012, 2:08 pm
$
0
0
Hello,

the VB6 IDE (VB6.exe) has issues when the UAC (Windows Vista and 7) is activated.
This may cause that opening .vbp files for example will fail.

To solve this it is just required to add a resource directly into the VB6.exe.

The source code of "RequireAdmin.res" is:

Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
      <security>
        <requestedPrivileges>
            <requestedExecutionLevel level="requireAdministrator" uiAccess="false"/>
        </requestedPrivileges>
      </security>
  </trustInfo>
</assembly>
In the attachment I have added the same as a compiled resource.

Use a resource hacker to put the resource file directly into the VB6.exe.
I used following resource hacker for that job: http://www.angusj.com/resourcehacker/
(File -> Open ... VB6.exe -> Action -> Add a new Resource ...)

The result is now that every time the VB6.exe will be accessed it is ensured that the admin rights are on.
Opening .vbp files works therefore without any problems.

I have also attached another compiled resource file with visual styles included, just for those who want it too.

The source code of "VisualStylesAndRequireAdmin.res" is:
Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
      <security>
        <requestedPrivileges>
            <requestedExecutionLevel level="requireAdministrator" uiAccess="false"/>
        </requestedPrivileges>
      </security>
  </trustInfo>
  <dependency>
      <dependentAssembly>
        <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" language="*" processorArchitecture="*" publicKeyToken="6595b64144ccf1df"/>
      </dependentAssembly>
  </dependency>
</assembly>
EDIT: Reason for this is that adding a manifest file into the VB6.exe directory won't work anymore in Windows 7.
Attached Files
↧

VB6 - SysBitmaps Control: Free Toolbar images, from Windows

September 29, 2012, 2:19 pm
$
0
0
Here is a quicky for populating toolbars with standard bitmaps embedded in comctl32.dll.

There is still (at least) one bug: if you load some large (24x24) bitmaps and then shift and load some small 916x160 bitmaps the small ones get corrupted. probably an issue with the way I'm using PictureBoxes in there.

This is a control and not a class so that I can use those PictureBoxes to cut up the image-strip bitmaps instead of doing a lot of GDI API fiddling.
Attached Images
 
Attached Files
↧

Translator with Sound/Speech

October 11, 2012, 5:40 pm
$
0
0
Here is a little word translation sample i would like people to have.. if you have any questions feel free to ask. you can also download the sounds/speech, ask me how if you need and i will show you how

i only used textbox and mine does not display (chinese,arabic...) languages its shows up as ?????... if you need other languages i would recommend switch to other types of control that will support other languages such as "Microsoft Forms 2.0 Object Library" (or other controls)

Speech translation will work however, even if it does not display correctly in textbox

anyways here is a working translator with sound


***Additional*** Example of how to get speech/sound status
Code:
Private Sub Command1_Click()
WindowsMediaPlayer1.URL = "http://translate.google.com/translate_tts?ie=UTF-8&tl=" & GetLanguage(cmbTo) & "&q=" & ieGoogle.document.getElementById("result_box").innertext
ChangeStatus "Loading Speech/Audio...."
Do Until WindowsMediaPlayer1.playState = wmppsPlaying
  DoEvents
Loop
ChangeStatus "Playing Speech/Audio..."
Do Until WindowsMediaPlayer1.playState = wmppsStopped
  DoEvents
Loop
ChangeStatus "Ready"
End Sub

Private Sub Command2_Click()
WindowsMediaPlayer1.URL = "http://translate.google.com/translate_tts?ie=UTF-8&tl=" & GetLanguage(cmbFrom) & "&q=" & txtTranslate.Text
ChangeStatus "Loading Speech/Audio...."
Do Until WindowsMediaPlayer1.playState = wmppsPlaying
  DoEvents
Loop
ChangeStatus "Playing Speech/Audio..."
Do Until WindowsMediaPlayer1.playState = wmppsStopped
  DoEvents
Loop
ChangeStatus "Ready"
End Sub

Private Sub cmdTranslate_Click()
On Error Resume Next
  Command1.Enabled = True
  Command2.Enabled = True
  txtResult.Enabled = True
  txtResult.Text = ieGoogle.document.getElementById("result_box").innertext
 
  ChangeStatus "Preparing Speech/Audio...."
 
  WindowsMediaPlayer1.URL = "http://translate.google.com/translate_tts?ie=UTF-8&tl=" & GetLanguage(cmbFrom) & "&q="
 
  Do Until WindowsMediaPlayer1.playState = wmppsReady
    DoEvents
  Loop
  ChangeStatus "Ready"
End Sub
Attached Files
↧
Viewing all 1474 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>