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

[VB6] InkEdit with Windows SpellCheck

$
0
0
Here is an example of using an InkEdit control in "inkless mode" as a Unicode-aware RichTextBox.

But on Windows 8 and later there is more!

The program turns on the built-in Windows spellcheck capabilities of RichEdit version 8, which lives inside the InkEdit control when running on current versions of Windows.

Code:

Private Const WM_USER As Long = &H400&
Private Const EM_SETLANGOPTIONS As Long = WM_USER + 120&
Private Const IMF_SPELLCHECKING As Long = &H800&
Private Const IMF_TKBPREDICTION As Long = &H1000&
Private Const IMF_TKBAUTOCORRECTION As Long = &H2000&
Private Const EM_SETEDITSTYLE As Long = WM_USER + 204&
Private Const SES_USECTF As Long = &H10000
Private Const SES_CTFALLOWEMBED As Long = &H200000
Private Const SES_CTFALLOWSMARTTAG As Long = &H400000
Private Const SES_CTFALLOWPROOFING As Long = &H800000

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Sub Form_Load()
    With InkEdit1
        SendMessage .hWnd, _
                    EM_SETLANGOPTIONS, _
                    0, _
                    IMF_SPELLCHECKING _
                Or IMF_TKBPREDICTION _
                Or IMF_TKBAUTOCORRECTION
        SendMessage .hWnd, _
                    EM_SETEDITSTYLE, _
                    SES_USECTF _
                Or SES_CTFALLOWEMBED _
                Or SES_CTFALLOWSMARTTAG _
                Or SES_CTFALLOWPROOFING, _
                    SES_USECTF _
                Or SES_CTFALLOWEMBED _
                Or SES_CTFALLOWSMARTTAG _
                Or SES_CTFALLOWPROOFING
    End With
End Sub

Name:  sshot.png
Views: 132
Size:  6.2 KB

Imagine that. Free spellcheck!


Requirements

Windows 8 or later.
Attached Images
 
Attached Files

[VB6] IEnumVARIANT / For Each support without a typelib

$
0
0
In my own projects I use a typelib and a custom interface to do the same thing, (comparable to .NET and Olaf's examples) which might seem overly complex, so here's an example that gets the job done without any dependencies. It also serves as a good example of creating a Lightweight COM Object that's less complex than Curland's examples (which are always over-complicated). It should be easy enough to adapt to your own custom collections.

Code:

' Copyright © 2017 Dexter Freivald. All Rights Reserved. DEXWERX.COM
'
' MEnumerator.bas
'
' Implementation of IEnumVARIANT to support For Each in VB6
'
Option Explicit

Private Type TENUMERATOR
    VTablePtr  As Long
    References  As Long
    Enumerable  As Object
    Index      As Long
    Upper      As Long
    Lower      As Long
End Type

Private Enum API
    NULL_ = 0
    S_OK = 0
    S_FALSE = 1
    E_NOTIMPL = &H80004001
    E_NOINTERFACE = &H80004002
    E_POINTER = &H80004003
#If False Then
    Dim NULL_, S_OK, S_FALSE, E_NOTIMPL, E_NOINTERFACE, E_POINTER
#End If
End Enum

Private Declare Function FncPtr Lib "msvbvm60" Alias "VarPtr" (ByVal FunctionAddress As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function CopyBytesZero Lib "msvbvm60" Alias "__vbaCopyBytesZero" (ByVal Length As Long, Dst As Any, Src As Any) As Long
Private Declare Function CoTaskMemAlloc Lib "ole32" (ByVal cb As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal psz As Long, ByVal cblen As Long) As Long
Private Declare Function VariantCopyToPtr Lib "oleaut32" Alias "VariantCopy" (ByVal pvargDest As Long, ByRef pvargSrc As Variant) As Long

Public Function NewEnumerator(ByRef Enumerable As Object, _
                              ByVal Upper As Long, _
                              Optional ByVal Lower As Long _
                              ) As IEnumVARIANT
   
    Static VTable(6) As Long
    If VTable(0) = NULL_ Then
        VTable(0) = FncPtr(AddressOf IUnknown_QueryInterface)
        VTable(1) = FncPtr(AddressOf IUnknown_AddRef)
        VTable(2) = FncPtr(AddressOf IUnknown_Release)
        VTable(3) = FncPtr(AddressOf IEnumVARIANT_Next)
        VTable(4) = FncPtr(AddressOf IEnumVARIANT_Skip)
        VTable(5) = FncPtr(AddressOf IEnumVARIANT_Reset)
        VTable(6) = FncPtr(AddressOf IEnumVARIANT_Clone)
    End If
   
    Dim This As TENUMERATOR
    With This
        .VTablePtr = VarPtr(VTable(0))
        .Lower = Lower
        .Index = Lower
        .Upper = Upper
        .References = 1
        Set .Enumerable = Enumerable
    End With
   
    Dim pThis As Long
    pThis = CoTaskMemAlloc(LenB(This))
    CopyBytesZero LenB(This), ByVal pThis, This
    GetMem4 pThis, NewEnumerator
End Function

Private Function IID$(ByVal riid As Long)
    StrRef(IID) = SysAllocStringByteLen(riid, 16&)
End Function

Private Function IID_IUnknown() As String
    Static IID As String
    If StrPtr(IID) = NULL_ Then
        IID = String$(8, vbNullChar)
        IIDFromString StrPtr("{00000000-0000-0000-C000-000000000046}"), StrPtr(IID)
    End If
    IID_IUnknown = IID
End Function

Private Function IID_IEnumVARIANT() As String
    Static IID As String
    If StrPtr(IID) = NULL_ Then
        IID = String$(8, vbNullChar)
        IIDFromString StrPtr("{00020404-0000-0000-C000-000000000046}"), StrPtr(IID)
    End If
    IID_IEnumVARIANT = IID
End Function

Private Function IUnknown_QueryInterface(ByRef This As TENUMERATOR, _
                                        ByVal riid As Long, _
                                        ByVal ppvObject As Long _
                                        ) As Long
    If ppvObject = NULL_ Then
        IUnknown_QueryInterface = E_POINTER
        Exit Function
    End If

    Dim siid As String
    siid = IID$(riid)

    If siid = IID_IUnknown Or siid = IID_IEnumVARIANT Then
        DeRef(ppvObject) = VarPtr(This)
        IUnknown_AddRef This
        IUnknown_QueryInterface = S_OK
    Else
        IUnknown_QueryInterface = E_NOINTERFACE
    End If
End Function

Private Function IUnknown_AddRef(ByRef This As TENUMERATOR) As Long
    With This
        .References = .References + 1
        IUnknown_AddRef = .References
    End With
End Function

Private Function IUnknown_Release(ByRef This As TENUMERATOR) As Long
    With This
        .References = .References - 1
        IUnknown_Release = .References
        If .References = 0 Then
            Set .Enumerable = Nothing
            CoTaskMemFree VarPtr(This)
        End If
    End With
End Function

Private Function IEnumVARIANT_Next(ByRef This As TENUMERATOR, _
                                  ByVal celt As Long, _
                                  ByVal rgVar As Long, _
                                  ByVal pceltFetched As Long _
                                  ) As Long
    If rgVar = NULL_ Then
        IEnumVARIANT_Next = E_POINTER
        Exit Function
    End If
   
    Dim Fetched As Long
    With This
        Do Until .Index > .Upper
            VariantCopyToPtr rgVar, .Enumerable(.Index)
            .Index = .Index + 1&
            Fetched = Fetched + 1&
            If Fetched = celt Then Exit Do
            rgVar = PtrAdd(rgVar, 16&)
        Loop
    End With
   
    If pceltFetched Then DLng(pceltFetched) = Fetched
    If Fetched < celt Then IEnumVARIANT_Next = S_FALSE
End Function

Private Function IEnumVARIANT_Skip(ByRef This As TENUMERATOR, ByVal celt As Long) As Long
    IEnumVARIANT_Skip = E_NOTIMPL
End Function

Private Function IEnumVARIANT_Reset(ByRef This As TENUMERATOR) As Long
    IEnumVARIANT_Reset = E_NOTIMPL
End Function

Private Function IEnumVARIANT_Clone(ByRef This As TENUMERATOR, ByVal ppEnum As Long) As Long
    IEnumVARIANT_Clone = E_NOTIMPL
End Function

Private Function PtrAdd(ByVal Pointer As Long, ByVal Offset As Long) As Long
    PtrAdd = (Pointer Xor &H80000000) + Offset Xor &H80000000
End Function

Private Property Let DeRef(ByVal Address As Long, ByVal Value As Long)
    GetMem4 Value, ByVal Address
End Property

Private Property Let DLng(ByVal Address As Long, ByVal Value As Long)
    GetMem4 Value, ByVal Address
End Property

Private Property Let StrRef(ByRef Str As String, ByVal Value As Long)
    GetMem4 Value, ByVal VarPtr(Str)
End Property

Attached Files

[VB6] Registry Key Virtual type checker

$
0
0
Hi,

this module allows to check whether Registry Key is:
- Shared
- Redirected
- Usual
- Symlink
And to show a target of symlink.

Note: Reflected type of keys (OS Vista and older only) are not considered.

RegGetKeyVirtualType() function returns a bitmask of KEY_VIRTUAL_TYPE enum.

Example of using is inside.
For most and reliable operation results elevated privilages required.
Code:

    Dim kvt As KEY_VIRTUAL_TYPE
    ...
    kvt = RegGetKeyVirtualType(HKLM, "SOFTWARE\Classes\AppID", sSymLinkTarget)
   
    If kvt And KEY_VIRTUAL_NOT_EXIST Then sKeyType = "Not exist"
    If kvt And KEY_VIRTUAL_USUAL Then sKeyType = "Usual"
    If kvt And KEY_VIRTUAL_SHARED Then sKeyType = "Shared"
    If kvt And KEY_VIRTUAL_REDIRECTED Then sKeyType = "Redirected"
    If kvt And KEY_VIRTUAL_SYMLINK Then sKeyType = sKeyType & " (Symlink)" & " -> " & sSymLinkTarget
    ...

References:
There is also a short article in Russian about such keys I wrote a long time ago, available here.

See also:
MSDN. Registry Keys Affected by WOW64
MSDN. Accessing an Alternate Registry View
MSDN. Registry Reflection
MSDN. [MS-RRP] Symbolic Links
Stefan Kuhr. Registry Symbolic Links creation tool.
Jeremy Hurren. Registry Filters and Symbolic Links
Paula Tomlinson. Understanding NT

I must warn that the table of virtual types for some keys presented on MSDN page is wrong.
Also, some information how to open and work with symlinks are incomplete. See my code on how to do it reliable.
Attached Files

VB6 - InkEdit and SelText

$
0
0
The InkEdit Control has many useful features, but when it comes to SelText, it does not behave like a normal TextBox. When recovering the text from a multiline InkEdit box, each line is separated by a vbCrLf (&H0D, &H0A). But the SelStart property only uses a vbCr (&H0D). So when you search for a character string, you will get an extra character for each line. This is my way around the problem, and there may be a better way.

Enter the string to search for in the upper TextBox and hit <Enter>. If the string is found, it will be highlit. To find the next instance, use <Ctrl-n>.

J.A. Coutts
Attached Images
 
Attached Files

[VB6] INI file class (unicode aware)

$
0
0
'Mainly intended for caching data beetween read-write operations
'Supports UTF-16 LE ini-files format
'Provides wide range of methods
'Doesn't support reading / saving commentary in ini file

Based on Scripting.Dictionary, see also:
#Const UseHashtable
#Const UseStringBuilder

Examples of using:
Code:


Option Explicit

Private Sub Form_Load()
    Dim Item

    'init
    Dim cIni As clsIniFile
    Set cIni = New clsIniFile

    'open ini file
    cIni.InitFile App.Path & "\some.ini", 1200 '1200 - UTF16-LE or 1251 (ANSI)

    'set case insensitive mode
    cIni.CompareMethod = vbTextCompare

    'write (or overwrite):
    '[Section1]
    'Param1=Data1
    'Param2=Data2
    cIni.WriteParam "Section1", "Param1", "Data1"
    cIni.WriteParam "Section1", "Param2", "Data2"

    'create empty section
    cIni.CreateSection "Section Empty1"
    cIni.CreateSection "Section Empty2"

    Debug.Print "Param1 = " & cIni.ReadParam("Section1", "Param1")
    Debug.Print "Number of parameters in Section1: " & cIni.CountParams("Section1")
    Debug.Print "Total sections: " & cIni.CountSections

    'does data 'Data1' exist in 'Section1' ?
    Debug.Print "Data2 exists? " & cIni.ExistData("Section1", "Data2")
    Debug.Print "param2 exists? " & cIni.ExistParam("Section1", "param2")

    Debug.Print "Currently loaded filename is: " & cIni.FileName

    'search for parameter name, which holds a 'Data2' in 'Section1'
    Debug.Print "Param name of 'Data2' is: " & cIni.GetParamNameByData("Section1", "Data2")

    'enum parameters' names
    For Each Item In cIni.GetParamNames("Section1")
        Debug.Print Item
    Next
    'enum data in section
    For Each Item In cIni.GetParamValues("Section1")
        Debug.Print Item
    Next
    'enum sections' names
    For Each Item In cIni.GetSections
        Debug.Print Item
    Next

    'to remove a parameter
    If cIni.RemoveParam("Section1", "Param2") Then Debug.Print "Param2 is removed successfully!"

    'to remove section
    If cIni.RemoveSection("Section Empty2") Then Debug.Print "'Section Empty2' is removed successfully!"

    'to remove all sections (erase file)
    'cIni.RemoveSectionsAll

    'populate physical file (all cached data will by written to the disk)
    cIni.Flush

    'when you finished work with the class
    Set cIni = Nothing

    Unload Me
End Sub


Result:
Quote:

Param1 = Data1
Number of parameters in Section1: 2
Total sections: 3
Data2 exists? True
param2 exists? True
Currently loaded filename is: H:\_AVZ\Íàøè ðàçðàáîòêè\_Dragokas\clsIniFile\some.ini
Param name of 'Data2' is: Param2
Param1
Param2
Data1
Data2
Section1
Section Empty1
Section Empty2
Param2 is removed successfully!
'Section Empty2' is removed successfully!
Attached Files

[VB6] Always Behind / Always at the Bottom / Bottommost

$
0
0
The following code will put a Form always behind/at the bottom of all top-level windows. This is accomplished by processing the WM_WINDOWPOSCHANGING message.

Code:

Option Explicit    'In a standard .BAS module

Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByVal Value As Long)

Public Function Subclass(ByRef Frm As VB.Form) As Boolean
    Subclass = SetWindowSubclass(Frm.hWnd, AddressOf SubclassProc, ObjPtr(Frm))
End Function

Public Function UnSubclass(ByRef Frm As VB.Form) As Boolean
    UnSubclass = RemoveWindowSubclass(Frm.hWnd, AddressOf SubclassProc, ObjPtr(Frm))
End Function

Private Function SubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    Const WM_WINDOWPOSCHANGING = &H46&, HWND_BOTTOM = 1&, SIGN_BIT = &H80000000

    If uMsg <> WM_WINDOWPOSCHANGING Then
        SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    Else
        PutMem4 (lParam Xor SIGN_BIT) + 4& Xor SIGN_BIT, HWND_BOTTOM    'WINDOWPOS.hWndInsertAfter = HWND_BOTTOM
    End If                                                              'Xor: Unsigned pointer arithmetic
End Function

Usage example:

Code:

Option Explicit    'In Form1

Private Sub Form_Load()
    Subclass Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnSubclass Me
End Sub

VB6 - Activating Hyperlinks using InkEdit

$
0
0
I found code that activated Hyperlinks with VB6 and a RichTextBox. If was far more complex than I wanted because it used subclassing. So I converted it to use an InkEdit box without subclassing. The underlining of the hyperlinks worked quite nicely, but passing the link to the browser did not work with the InkEdit Control.

So I set out to simplify it and make the browser work. I was pleasantly surprised at how simple it turned out to be.
Code:

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub cmdEnable_Click()
    Const EM_AUTOURLDETECT = &H45B
    SendMessage txtMessage.hWnd, EM_AUTOURLDETECT, 1, ByVal 0
    txtMessage.SetFocus
End Sub

Private Sub Form_Load()
    txtMessage.Text = "Sample text with link." & vbCrLf & vbCrLf _
        & "https://www.us-cert.gov/ncas/alerts/TA17-318A" & vbCrLf & vbCrLf _
        & "J.A.Coutts" & vbCrLf
End Sub
Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Debug.Print txtMessage.SelText
    ShellExecute 0&, "open", txtMessage.SelText, 0, 0, 1
End Sub

Private Sub txtMessage_DblClick()
    Timer1.Enabled = True
End Sub

Requirements: One form with, one InkEdit Control(txtMessage), one Command button (cmdEnable), and one Timer (Timer1) set to 20 ms and disabled. The InkEdit box should be multiline, IEM_disabled, with vertical Scrollbars.

The above code comes complete with a sample hyperlink. Click the command button to underline the hyperlink with the default blue. Double Click the link to send it to your default browser. As with the Spell Check, it required a 20 ms delay to allow the hyperlink to be selected

J.A. Coutts
Attached Images
 

[vb6] Resource Image Viewer/Extraction

$
0
0
A tool I developed to help with another project I'm working on. The tool worked well and decided to pretty it up and share it.

This is similar to your typical resource-hacker, but limited in scope to only resource images: icons, cursors, bitmaps, animated icons/cursors. You can view those that are contained in a binary (dll, exe, ocx, etc) and also contained in VB resource files (.res). Additionally, you can open a disk icon/cursor file for review.

There is an option to simulate DPI. This could be useful when you are viewing your own resource file and would like to see what your icons/cursors/bitmaps may look like if you declare your application DPI-aware.

The tool allows you to extract the viewed images to file. For icons/cursors that contain multiple images, you can individually select which are to be extracted and change the order they will appear in within the extracted file.

Also there is a filter option for image width, bit depth and whether icons/cursors include/exclude PNG-encoded images.

Tip: At top of the form, there is a m_AllowSubclassing boolean. Set this to false if you plan on walking through any code; otherwise, leave it to true. The subclassing occurs on three things:

1) The form itself to restrict minimal resizing
2,3) The picturebox and scrollbar to trap mouse wheel scrolling messages

Without the subclassing active, you can't use the mouse wheel for scrolling. The picturebox is coded for standard keyboard navigation.

Name:  ss.jpg
Views: 27
Size:  33.0 KB
Attached Images
 
Attached Files

VB6 - Sample Tray Activation

$
0
0
Attached is a sample program that uses a Tray Icon to activate a program. It uses dilettante's "NotifyIcon" program.

http://www.vbforums.com/showthread.p...ght=notifyicon

I have left his explanations in the User Control intact. When first activated, the "Tray" program starts as a Icon in the system tray surrounded by red. A balloon will appear stating "Connecting to Server". It will normally time out, but I am using a timer to simulate establishing a connection. This causes the balloon to disappear and the red background on the Icon to also disappear. Moving the mouse over the Icon will show "Connected to Server". Ten seconds later, a second timer is used to simulate an incoming message, which will flash with instructions.

Clicking on the Tray Icon will activate a program called "Sample.exe". You will have to compile that program first before it can be activated.

To return the "Tray" program to it's normal state, or to exit the program, right click on the Tray Icon.

J.A. Coutts
Attached Files

[VB6] Registry Hives Enumerator

$
0
0
This is very specific, but maybe will be useful for some registry guy :)

In short:

if you need to build a ton of nested loops for:

just say, you have a task to enumerate:

1) several keys
2) in the same location of HKLM / HKCU / HKU + every SID
3) separately consider WOW6432Node (read value with KEY_WOW64_64KEY flag and without) + exclude one of 'shared' keys (keys that point to the same phisical location in both 64/32-bit modes).

you can fit all in 1 single cycle with this 'Hives Enumerator' class.

Example:

Here is your old code:
Code:


    sRegRuns(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
    sDes(1) = "Run"

    sRegRuns(2) = "Software\Microsoft\Windows\CurrentVersion\RunServices"
    sDes(2) = "RunServices"

        '...

    For i = 0 To UBound(aHives) 'HKLM, HKCU, HKU()

        For Each UseWow In Array(False, True)

            If (bIsWin32 And UseWow) _
              Or bIsWin64 And UseWow And _
              (sHive = "HKCU" _
              Or StrBeginWith(sHive, "HKU\")) Then Exit For

            For K = LBound(sRegRuns) To UBound(sRegRuns)

Here is how it looks now with my class:

Code:


    Dim HE as clsHiveEnum
    Set HE = New clsHiveEnum
    '...

    sRegRuns(1) = "Software\Microsoft\Windows\CurrentVersion\Run"
    sDes(1) = "Run"

    sRegRuns(2) = "Software\Microsoft\Windows\CurrentVersion\RunServices"
    sDes(2) = "RunServices"

    '...

    HE.Init HE_HIVE_ALL, HE_SID_ALL, HE_REDIR_BOTH
    HE.AddKeys sRegRuns

    Do While HE.MoveNext

        'that's all :) Just use HE.Hive, HE.Key, HE.Redirected and many more...
    Loop

Or you can enum hives without keys. Just don't use HE.AddKeys.

Required:
Some enums to Global module: just to support quick IntelliSense tips.

Dependencies:
modRegVirtualType.bas (included)

Good luck :)
-----------------


Live example (attached as demo):

Code:


    Dim HE As clsHiveEnum
    Set HE = New clsHiveEnum

    Dim aKey(1) As String

    aKey(0) = "HKLM\Software\Classes\AppID"
    aKey(1) = "Software\Classes\CLSID"

    HE.Init HE_HIVE_HKLM Or HE_HIVE_HKU, HE_SID_ALL, HE_REDIR_BOTH

    HE.AddKeys aKey

    Do While HE.MoveNext
        Debug.Print " --------- "
        Debug.Print "Hive handle: " & HE.Hive
        Debug.Print "Hive name:  " & HE.HiveName
        Debug.Print "Hive + key:  " & HE.KeyAndHive
        Debug.Print "Key:        " & HE.Key
        Debug.Print "Redirected:  " & HE.Redirected
        Debug.Print "Array index: " & HE.KeyIndex
        Debug.Print "User name:  " & HE.UserName
    Loop

    Set HE = Nothing

Result:
Quote:

---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\AppID
Key: Software\Classes\AppID
Redirected: False
Array index: 0
User name: All users
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\CLSID
Key: Software\Classes\CLSID
Redirected: True
Array index: 1
User name: All users
---------
Hive handle: -2147483646
Hive name: HKLM
Hive + key: HKLM\Software\Classes\CLSID
Key: Software\Classes\CLSID
Redirected: False
Array index: 1
User name: All users
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\.DEFAULT\Software\Classes\CLSID
Key: .DEFAULT\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Default user
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-19\Software\Classes\CLSID
Key: S-1-5-19\Software\Classes\CLSID
Redirected: True
Array index: 1
User name: Local service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-19\Software\Classes\CLSID
Key: S-1-5-19\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Local service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-20\Software\Classes\CLSID
Key: S-1-5-20\Software\Classes\CLSID
Redirected: True
Array index: 1
User name: Network service
---------
Hive handle: -2147483645
Hive name: HKU
Hive + key: HKU\S-1-5-20\Software\Classes\CLSID
Key: S-1-5-20\Software\Classes\CLSID
Redirected: False
Array index: 1
User name: Network service
Above, we requested:
1) for HE_HIVE_HKLM + HE_HIVE_HKU hives.
2) aKey(0) have exception: list HKLM only (see prefix "HKLM\...")
3) HE_SID_ALL
4) WOW + no WOW

We got:
1) only 1 iteration of aKey(0) -> HKLM\Software\Classes\AppID, because it is 'Shared' key. WOW mode is point to the same phisical location, so WOW iteration is skipped.
2) 2 iteration of aKey(1) of HKLM. 1 - WOW, 2 - No WOW.
3) 5 iterations of aKey(1) of HKU. 1 - .Default SID, 2 - S-1-5-19, 3 - S-1-5-20, where:
- HKU\.Default\Software\Classes\CLSID is not 'redirected' key, that's why only 1 iteration
- S-1-5-19 and S-1-5-20 ARE 'redirected' keys, that's why +2 iterations for each (WOW, no WOW)

Note: that class doesn't check and skip keys that are not exist (it is responsibility of caller).
E.g. if I'll create:
- HKEY_USERS\S-1-5-19\Software\Classes\Wow6432Node\CLSID
and remove:
- HKEY_USERS\S-1-5-19\Software\Classes\CLSID
class will produce 2 iterations (with .Redirected = 'true', and with 'false').

-----------------------------------

Detailed description of the class:

Common scheme of the cycle:
Code:

' {
'  1. Keys (if supplied)
'  {
'    2. HKLM / HKCU / HKU + every SID...
'    {
'      3. REDIR_WOW (redirected) / REDIR_NO_WOW
'    }
'  }
' }

Stages of using:

I. Required initialization:

Set global rule for iterator:
Code:

HE.Init [Hives], [opt_SIDs], [opt_WOW_Modes]
where every arg. is a sum of bits, available from Intellisense, e.g.:
Code:

HE.Init HE_HIVE_HKLM Or HE_HIVE_HKCU
[Hives]

Code:

    HE_HIVE_ALL - all
    HE_HIVE_HKLM - HKLM only
    HE_HIVE_HKCU - HKCU only
    HE_HIVE_HKU - HKU only

What properties are affected:
- .Hive
- .HiveName
- .HiveNameAndSID
- .KeyAndHive
- .UserName

[SIDs]
Code:

    HE_SID_ALL - all
    HE_SID_DEFAULT - HKU\.Default (target of HKU\S-1-5-18 symlink)
    HE_SID_SERVICE - mean HKU\S-1-5-19 (Local service) and HKU\S-1-5-20 (Network service)
    HE_SID_USER - mean other currently logged users, excepting current user (available as HKCU)

What properties are affected:
- .HiveNameAndSID
- .KeyAndHive
- .UserName
- .IsSidSystem
- .IsSidUser
- .IsSidDefault properties.

[WOW_Modes]
Code:

    HE_REDIR_BOTH - to iterate both WOW modes (checking for 'Shared' keys will be activated for this flag only)
    HE_REDIR_NO_WOW - NO_WOW only (64-bit keys)
    HE_REDIR_WOW - WOW only (32-bit keys)
    HE_REDIR_DONT_IGNORE_SHARED - ignore checking for 'Shared' type. Force iteratation of every WOW mode.

What properties are affected:
- .Redirected

2. Optional. Supply key (keys).

a) Supply array of keys:
Code:

HE.AddKeys string_array
What properties are affected:
- .Key
- .KeyAndHive
- .SharedKey
- .KeyIndex

b) Supply single key (or keys one by one with several .AddKey calls)

What properties are affected:
- .Key
- .KeyAndHive
- .SharedKey
- special excludes for hives.
Code:

HE.AddKey [Key], [opt_PostPlaceholder]
where:
[Key] is a key in any of 2 formats:
1) Key
2) Hive\Key

It's can be:
Quote:

Software\Classes\CLSID
HKLM\Software\Classes\AppID
HKEY_LOCAL_MACHINE\Software\Classes\AppID
In case, you prepended concrete "Hive" to key it will be treated as an exclude from global rule (e.g., HE.Init HE_HIVE_ALL): for such key, enumerator will return only concrete hive (HKLM in example above).

[opt_PostPlaceholder] - optional. Any text. Enumerator will append it to the .Key. You can use it in your cycle e.g., to replace with a data that was not known to you at the time of class initialization (e.g. to replace manually "{CLSID}" by real CLSID in different parts of key for different keys).


II. Beginning of enumeration.

Code:

Do while HE.MoveNext
        'use any HE property
Loop


III. Using of properties.

HE.Hive - hive handle (constant)
HE.Key - string, representing the key only, e.g. 'Software\Microsoft'
HE.Redirection - boolean, representing WOW mode (false - native key, true - 32-bit key).
HE.KeyAndHive - string, "Hive\Key"
HE.HiveName - string, short name of hive, e.g. "HKLM"
HE.HiveNameAndSID - string, e.g. "HKU\S-1-5-19"
HE.UserName - string:
- for HKLM - "All users"
- for HKCU - current user's name
- for HKU\S-1-5-19 - "Local service"
- for HKU\S-1-5-20 - "Network service"
- for HKU\.Default - "Default user"
- for HKU\S-some another SID - user's name of that SID
HE.KeyIndex - index of array passed to the class used in current iteration, e.g. need, if you track several linked arrays by its index, like array of keys + array of these keys' description and want to get description by index for current iteration (see first example above - for sDes() array it will be sDes(HE.KeyIndex) ).
HE.SharedKey - boolean. To know if this key have a 'shared' type, e.g. need, if you know that this key1 linked to another key2, so if key1 is 'Shared' and key2 is not, now you know e.g. that you need to pay attention on both WOW modes of key2.
HE.IsSidService - boolean. TRUE, if current iteration is on 'HKU\S-1-5-19' or, 'HKU\S-1-5-20'
HE.IsSidUser - boolean. TRUE, if current iteration is on 'HKU\S-Some custom logged user'
HE.IsSidDefault - boolean. TRUE, if current iteration is on 'HKU\.Default'

Methods:

PrintAll - test reason. To show in debug. window all properties of all iterations. Try play with it :)


IV. Optional steps.

Repeat enum.

If you need repeat enumeration again with the same settings:
Code:

HE.Repeat

Do While HE.MoveNext
'...


Erase / fresh enum:

Just use .Init again with the same or new settings.
It will erase all data supplied before. No need to terminate the class.
Attached Files

VB6 - Very simple CoreAudio Demo (vbRichClient5)

[RESOLVED] Why String Table

$
0
0
Hi
What is the advantage of using string table resource than saving the string values in module defining Public?

[VB6] Detect if process is hung

$
0
0
It's a console application based on IsHungAppWindow API.

Syntax:

FreezeDetector.exe [opt_Filters]

Filters:
"IMAGENAME eq [Process name]"
"PID eq [Process ID]"

Note: All filters should be quoted

Examples:
FreezeDetector.exe without arguments - will list all processes with hung windows
FreezeDetector.exe "IMAGENAME eq my.exe" - check if my.exe process' window is hang
FreezeDetector.exe "PID eq 1234" - check if window of process with Process ID 1234 is hang.

Return exit code:
0 - was hang
1 - no hangs found.

Compatibility: Win2k+
Attached Files

XML Parser (written entirely on VB6)

$
0
0
Author: Jason Thorn (Fork by Alex Dragokas)

There are 2 projects:

1) GUI
(activeX dll based)
compile vbXml-browser\Browser\Browser.vbg
Required: MSCOMCTL.OCX

2) Simple app (debug. window sample)
vbXml-simple\Project1.vbp

Some xml files samples are in 'xml-files' dir.

Classes allows to:
- read .XML files
- append nodes / attributes
- serialize back to .xml

Supported:
- all required special characters
- CDATA markup
- UTF-16 LE XML files format (however, it will be converted to ANSI)
- XML header
- reading tags' attributes

Currently not supported:
- Entities

P.S. There maybe some trouble with compilation GUI (vbg) caused by binary incompatibility. Maybe, someone help me to set project correctly.

PPS. Classes are not well tested. I'll be glag to get feedback.

Name:  title.jpg
Views: 145
Size:  23.7 KB

Feel free to use,
Good luck :)
Attached Images
 
Attached Files

Code for working with Unsigned Shorts

$
0
0
In VB6, the Integer data type is equivalent to a Short (signed short) in C. Now when you encounter a UShort (unsigned short) in a file or in a structure returned from a DLL call, what do you do? You can either hope that the value stored in it happens to be less than 32768 (a region in which Shorts and UShorts are identical), or try to find a way to get the full range of possible UShort values represented in VB6. My code here does the latter.

Code:

Private Function UShortToInt(ByVal Value As Integer) As Long
    UShortToInt = Value And &HFFFF&
End Function

Private Function IntToUShort(ByVal Value As Long) As Integer
    IntToUShort = (Value And &H7FFF) - (Value And &H8000)
End Function


When you get a UShort value, you simply use UShortToInt to convert it to Int (what's called Long in VB6), which even though it is technically a signed data type it can represent all positive values that UShort can. This gives you access to the full range of values that you were intended to be able to have access to in the UShort field from whatever file you read the data from. If you need to save a UShort to file, just work with the data in an Int and then use IntToUShort to convert it to a UShort prior to saving it to the file.

VB6 - Simple Hash Program

$
0
0
Attached is a program to calculate the various hash values for a string or a binary file. This can be useful if you are downloading an executable file (.exe/.dll etc) and the author has provided a hash value under a different cover. This allows you to verify that the code has not been tampered with, which is not all that uncommon an occurrence these days. Personally, I would recommend nothing less than SHA256, which is why I have made it the default.

The InkEdit controls used support Unicode, and you can choose whether to use ASCII (7 bits) or Unicode (16 bits) for the text hash. They will give different answers.


J.A. Coutts
Attached Images
 
Attached Files

Code for speed testing memory copy

$
0
0
Here's my code for testing the speed of various memory copy functions. The value printed by the print function after each 100 iterations of the function being tested is the average time (in milliseconds) that it took to execute that function. The below VB6 source code has comments that show how it works.

Code:

Private Declare Sub CopyBytes Lib "FastMemCopy.dll" (ByRef Dest As Any, ByRef Src As Any, ByVal ByteCount As Long)
Private Declare Sub CopyWords Lib "FastMemCopy.dll" (ByRef Dest As Any, ByRef Src As Any, ByVal WordCount As Long)
Private Declare Sub CopyDWords Lib "FastMemCopy.dll" (ByRef Dest As Any, ByRef Src As Any, ByVal DWordCount As Long)
Private Declare Sub CopyBytesFast Lib "FastMemCopy.dll" (ByRef Dest As Any, ByRef Src As Any, ByVal ByteCount As Long)
Private Declare Sub CopyWordsFast Lib "FastMemCopy.dll" (ByRef Dest As Any, ByRef Src As Any, ByVal WordCount As Long)

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long


Private Sub Form_Load()
    Dim Mem1(100000000 - 1) As Byte
    Dim Mem2(100000000 - 1) As Byte
    Dim TimeStart As Long
    Dim TimeEnd As Long
    Dim TimePassed As Double
    Dim TimePassedAvg As Double
    Dim i As Long
   
   
   
    timeBeginPeriod 1
   
   
    'Perform 100 iterations of copying 100 million bytes, 1 byte at a time
    TimePassedAvg = 0
    For i = 1 To 100
        TimeStart = timeGetTime
        CopyBytes Mem2(0), Mem1(0), 100000000
        TimeEnd = timeGetTime
        TimePassed = TimeEnd - TimeStart
        TimePassedAvg = TimePassedAvg + TimePassed / 100
    Next i
    Print TimePassedAvg
   
    'Perform 100 iterations of copying 100 million bytes, 2 bytes at a time
    TimePassedAvg = 0
    For i = 1 To 100
        TimeStart = timeGetTime
        CopyWords Mem2(0), Mem1(0), 50000000
        TimeEnd = timeGetTime
        TimePassed = TimeEnd - TimeStart
        TimePassedAvg = TimePassedAvg + TimePassed / 100
    Next i
    Print TimePassedAvg
   
    'Perform 100 iterations of copying 100 million bytes, 4 bytes at a time
    TimePassedAvg = 0
    For i = 1 To 100
        TimeStart = timeGetTime
        CopyDWords Mem2(0), Mem1(0), 25000000
        TimeEnd = timeGetTime
        TimePassed = TimeEnd - TimeStart
        TimePassedAvg = TimePassedAvg + TimePassed / 100
    Next i
    Print TimePassedAvg
   
   
   
    'Should dentical to the fourth test, as 100000000 is an exact multiple of 4 bytes
    TimePassedAvg = 0
    For i = 1 To 100
        TimeStart = timeGetTime
        CopyBytesFast Mem2(0), Mem1(0), 100000000 'Copy as many 4byte blocks as possible and then copy remaining data 1 byte at a time
        TimeEnd = timeGetTime
        TimePassed = TimeEnd - TimeStart
        TimePassedAvg = TimePassedAvg + TimePassed / 100
    Next i
    Print TimePassedAvg
   
    'Should dentical to the fourth test, as 100000000 is an exact multiple of 4 bytes
    TimePassedAvg = 0
    For i = 1 To 100
        TimeStart = timeGetTime
        CopyWordsFast Mem2(0), Mem1(0), 50000000 'Copy as many 4byte blocks as possible and then copy remaining data 2 bytes at a time
        TimeEnd = timeGetTime
        TimePassed = TimeEnd - TimeStart
        TimePassedAvg = TimePassedAvg + TimePassed / 100
    Next i
    Print TimePassedAvg
   
   
    'Perform 100 iterations of copying 100 million bytes using CopyMemory
    'Not sure what method CopyMemory uses, but it is supposed to work on overlapping memory regions, so it must use an advanced technique
    TimePassedAvg = 0
    For i = 1 To 100
        TimeStart = timeGetTime
        CopyMemory Mem2(0), Mem1(0), 100000000
        TimeEnd = timeGetTime
        TimePassed = TimeEnd - TimeStart
        TimePassedAvg = TimePassedAvg + TimePassed / 100
    Next i
    Print TimePassedAvg
   
   
   
    timeEndPeriod 1
   
End Sub

When the program is actually run, I find that there is really no speed difference at all between the different functions. Not sure why this is, but maybe on modern CPUs, it always takes the same amount of time to copy a given number of bytes, regardless if they are copied by Byte, Word, or DWord. So copying 4 bytes takes the same amount time as copying 2 words or 1 dword. Unlike on older CPUs, maybe you don't get a speed boost by optimizing your program, by having it copy dwords or words instead of bytes.

Here's the results of running this program 3 different times.
First time I ran the program:
25.66
26.17
25.90
25.83
26.29
25.71

Second time I ran the program:
27.36
30.50
30.17
26.73
26.88
26.18

Third time I ran the program:
25.58
25.98
25.64
25.44
25.86
25.73

As you can see, the there is no consistency at all between different times I ran the tester program. Nor is there any consistency regarding which function is faster. Sometimes one function was faster, and sometimes another one was faster. The only thing consistent is that the times tended to hover around 26ms, and every once in a while the functions (for no apparent reason) ran slower, sometimes taking about 30ms to complete. I'm not sure what caused those outlier 30ms times. And all of these inconsistencies I've mentioned are present despite getting calculating an average time, by running a given function 100 times, each time it was tested. I hope somebody can explain these inconsistencies.


The first 5 Copy functions are ones in a DLL I made myself in assembly language, and assembled with FASM. Below is the source code for that DLL file. It's also has comments so you can see how it works.
Code:

format PE GUI 4.0 DLL
entry dllmain
include "macro\export.inc"

Arg1 equ ebp+8
Arg2 equ Arg1+4
Arg3 equ Arg2+4


section ".text" code readable executable
        dllmain:
        mov eax,1
        ret 12

        CopyBytes:
        push ebp
        mov ebp,esp
        push esi
        push edi
        push ecx
        mov edi,[Arg1]
        mov esi,[Arg2]
        mov ecx,[Arg3] ;Number of bytes to copy
        rep movsb ;Copy data 1 byte at a time
        pop ecx
        pop edi
        pop esi
        leave
        ret 12

        CopyWords:
        push ebp
        mov ebp,esp
        push esi
        push edi
        push ecx
        mov edi,[ebp+8]
        mov esi,[ebp+12]
        mov ecx,[ebp+16] ;Number of words (2 byte blocks) to copy
        rep movsw ;Copy data 1 word at a time
        pop ecx
        pop edi
        pop esi
        leave
        ret 12

        CopyDWords:
        push ebp
        mov ebp,esp
        push esi
        push edi
        push ecx
        mov edi,[ebp+8]
        mov esi,[ebp+12]
        mov ecx,[ebp+16] ;Number of dwords (4 byte blocks) to copy
        rep movsd ;Copy data 1 dword at a time
        pop ecx
        pop edi
        pop esi
        leave
        ret 12


        CopyBytesFast:
        push ebp
        mov ebp,esp
        push esi
        push edi
        push ecx
        mov edi,[Arg1]
        mov esi,[Arg2]
        mov eax,[Arg3] ;Number of bytes to copy
        xor edx,edx
        mov ecx,4
        div ecx
        mov ecx,eax
        rep movsd ;First, copy as much data as possible 4 bytes at a time
        mov ecx,edx
        rep movsb ;Then, copy remaining data 1 byte at a time
        pop ecx
        pop edi
        pop esi
        leave
        ret 12

        CopyWordsFast:
        push ebp
        mov ebp,esp
        push esi
        push edi
        push ecx
        mov edi,[Arg1]
        mov esi,[Arg2]
        mov eax,[Arg3] ;Number of words to copy
        xor edx,edx
        mov ecx,2
        div ecx
        mov ecx,eax
        rep movsd ;First, copy as much data as possible 2 words at a time
        mov ecx,edx
        rep movsw ;Then, copy remaining data 1 word at a time
        pop ecx
        pop edi
        pop esi
        leave
        ret 12


section ".edata" export readable
        export "FastMemCopy.dll",\
              CopyBytes, "CopyBytes",\
              CopyWords, "CopyWords",\
              CopyDWords, "CopyDWords",\
              CopyBytesFast, "CopyBytesFast",\
              CopyWordsFast, "CopyWordsFast"

section ".reloc" fixups readable
        dq 0

VB6 - User SID/Path

$
0
0
I needed a value that was unique to the current logged in user, so what is more unique than the User SID (User Security ID). Using the attached code, I found the SID:
Buffer:
70 70 27 00 00 00 00 00 01 05 00 00 00 00 00 05
15 00 00 00 27 E9 C3 D8 E9 4C AB 9A D3 BA 44 5F
E9 03 00 00
Of the 36 bytes provided, the first 4 are the memory location, the next 16 are common to all User SID's, and the last 16 are 4 long values that are unique to each user when combined.

J.A. Coutts
Attached Images
 
Attached Files

[VB6] BTEnum - Enumerate Bluetooth devices

$
0
0
This uses the Microsoft Bluetooth APIs to get a list of remembered and in-range visible Bluetooth devices.

Requires Windows XP SP 2 or later, and a Bluetooth adapter/radio supporting the Microsoft Bluetooth stack.


A search can take a while, so you can specify the timeout. Shorter timeouts might miss some devices.

Demo using the BTEnum class is attached. Sample run:

Name:  sshot.png
Views: 86
Size:  6.2 KB


Only tested on Windows 10 1709.

There were some tricky aspects to getting this working. There might still be flaws and it might not work right on older OSs due to changes in structs over time.
Attached Images
 
Attached Files

Linear Algebra for 3D Space

$
0
0
I'm not sure who will actually benefit from these procedures, but I suspect a few people will occasionally find them through Google. I've just got quite a bit of work into them, and wanted to share.

Also, for those versed in linear algebra, let me provide a few definitions and some context.

1) Everything follows the right-hand-rule.

2) In the attached module, the concept of a "Segment" is actually just an ordered basis. It's basically four 3D vectors. One defines the origin, one defines the X (forward, East) axis, one defines the Y (left, North) axis, and one defines the Z (up) axis. These three axes are orthonormal (i.e., orthogonal with one unit length). The origin is not built into the three orthonormal axes. In other words, these three axes are setup as if the origin is always <0,0,0>. This makes rotations of these Segments much easier.

3) When using quaternions, they always follow the JPL convention and are unit quaternions (i.e., no built-in scaling).

4) There are some functions that are specific to emulating functions found in the BodyBuilder language by Vicon. These may be a bit unusual for a "pure" mathematician, but they serve my purposes.

5) When converting from Euler angles to quaternions (and vice-versa), many procedures found on the web will only do it in one angle order (typically ZYX). However, the attached procedures will do it in any order of your choosing. The only online reference for this that I could find was an old scanned 1977 NASA document, specifically Appendix A.

6) If you actually start studying this code, note that all the rotations are actually performed using quaternions. In other words, Euler angles aren't used directly for anything other than reporting results.

7) I'm also wondering if there's possibly some graphical API interface that I could be using to do some of this faster. Any ideas on that front are more than welcome. Don't forget though that I'll always need to specify the angle order when moving between Euler angles and quaternions, and not have it pre-defined.

The BAS module was too large to put into a CODE block, so it's attached. However, here's a list of functions.

Code:


'
' List of functions herein:
'
'  Make Segment (ordered basis) Functions:
'
'      SegFrom5Pts
'      SegFrom3Pts
'      SegFromLines
'
'  Conversion Functions:
'
'      Euler2Quat
'      Quat2Euler
'      Seg2Quat                ' Abandons origin.
'      Quat2Seg                ' Leaves origin as <0,0,0>.
'      Seg2Euler              ' Abandons origin.
'      Euler2Seg              ' Leaves origin as <0,0,0>
'
'      Rad2Deg
'      Deg2Rad
'      VecRad2Deg
'      VecDeg2Rad
'
'      Axes2Quat              ' Similar to Seg2Quat.
'      Quat2Fwd                ' Forward (x) axis of quat. Same as X axis of segment.
'      Quat2Left              ' Left (y) axis of quat.    Same as Y axis of segment.
'      Quat2Up                ' Up (z) axis of quat.      Same as Z axis of segment.
'      AxisAngle2Quat          ' This is the rotation axis, not any segment axis.
'      QuatAxis                ' This returns the rotation axis.
'      QuatAngle              ' This returns the rotation angle.
'
'  Rotation Functions:
'
'      RotSeg (with axis & angle)
'      RotSegByQuat
'      RotVec (with axis & angle)
'      RotVecByQuat
'      RotQuat (by quat)
'      UnRotQuat (by quat)    ' Same as a QuatBetween function: UnRotQuat(q2, q1).
'
'  Angles Between Functions:
'
'      EulerBetweenSegs        = -<seg1, seg2, order> (BodyBuilder)
'      FixedBetweenSegs        =  <seg1, seg2, order> (BodyBuilder)
'      EulerBetweenQuats
'      (QuatBetweenQuats)      ' Do UnRotQuat(q2, q1).
'
'  Quick Functions:
'
'      XProd
'      DotProd
'
'      VecAvg
'      VecSum
'      VecDif
'      VecAddNum
'      VecDivNum
'      VecMultNum
'      VecMag
'      NegVec
'      UnitVec
'
'      NegQuat
'
'      MakeLine
'      MakeVec
'      MakeQuat
'
'  Trigonometry Functions:
'
'      ACos
'      ASin
'      ATan2
'
'  Debugging Functions:
'
'      AngString
'      PntString
'
'      VecString
'      QuatString
'      SegString
'


Enjoy,
Elroy


EDIT1: Just to mention it, when doing Euler2Quat (or Quat2Euler), there are actually twelve possible orders, and I've only covered six of them. The six I've covered are: xyz, xzy, yzx, yxz, zxy, & zyx. There's also a way to get from Euler angles to a quaternion whereby you do the rotation on the first axis, then the second, and then finish up by returning to the first axis. In other words, these rotation orders would be denoted as: xyx, xzx, yxy, yzy, zxz, & zyz. At present, I've got no need for this approach, and they're not currently covered in the attached code.
Attached Files
Viewing all 1536 articles
Browse latest View live