This thread is for discussion of gbLocator - a file and folder search utility for blind and low vision users. I posted it a few days ago in the Source Code forum.
1. F1 shows Settings Shortcuts and F2 shows Actions Shortcuts.
2. When Ctrl-F1 is used to start a browser, the BigX toolbar is shown - literally a big "X" over the small browser "x". (optional)
3. Folders now have "(f)" in front of them in Column 1 and when spoken, is spoken as "folder"
4. When opening a file/folder externally (browser, default client, or File Explorer), user can choose between opening the BigX toolbar or Windows Narrator (or neither)
5. A variety of changes to the text spoken when an action is taken - generally more informative but sometimes shorter
6. The Ctrl+Mouse fontsize change now works over the RE and the LV
7. When Expanding a folder, the folder name is now NOT shown in the RE. Having that long a visible search string was annoying.
8. As searches are made, the last 5 search terms are kept. To see them, press the up/down arrow keys when focus is on the RE (for my low vision users, I avoid dropdown combobox solutions).
9. Previews of image files (I don't think this was in the previous version)
Howdy, Mike!
Thanks for that post. I'm glad to hear it was ok at 1920x1080. I tried the newest version on 3840x2160 and it seems to draw correctly. If you would, please try the latest version on your 3840x2160 again and let me know if it look ok for you too.
In the latest version, I can't repeat the problem you mentioned, about ESC. As you noted, ESC is supposed to stop talking and exit only if talking is stopped.
Howdy, Pierre!
Yes, with David's encouragement, I put up a thread about gbLocator on the Everything forum!
I was pretty excited about the possibility of getting responses there, but it's been 5 days and I've had zero responses! Bummer that! I will have to be patient!
Test. I don't seem to have figured out how to make a reply that carries the name of the person making the reply. This time, I pressed "New Reply" across the top of the thread.
There are currently a number of threads in gbThreads that contain a Shell to WMIC (Windows Management Instrumentation Command-line), including some from the last few years.
If you are currently using an application that Shells to WMIC, it will not work in Win11 25H2 (coming very soon). It is being removed (along with PowerShell 2.0).
One thing I learned from this, for absolute speed, you can’t use normal WString comparison. Also, Equal is faster than Comparison if that’s all you need, which is the case with a hash table. Comparison requires two comparisons to determine if it’s less than or greater than. For absolute speed, you can’t use; If A$ = B$ Then.
In the Equal callback, testing the lengths first immediately eliminates some values. Passing a pointer and the length to the callback eliminates that overhead in the callback.
I could get this faster, about 0.095 seconds to find 1,000,000 keys, by writing the code inline instead of using callbacks, but the complexity isn’t worth the benefit.
find 100,000 random keys = 0.004 seconds
find 1,000,000 random keys = 0.112 seconds
find 5,000,000 random keys = 0.900 seconds
A unique key, WString, is used to store and retrieve a payload value, Object.
Key is case sensitive.
Property Set Capacity(ByVal value As Long), about number of expected items.
Can Store/Restore To/From File. To use that you need to provide callbacks. One to pack the object into a String and another to restore the object from a String.
Declare Function ObjectStoreCallback(o As IUnknown) As String
Declare Function ObjectRestoreCallback(ByRef stored As String) As IUnknown
When you implement the callbacks, use the actual “Interface” instead of “IUnknown.”
INC has no dependencies.
Code:
'ObjectHash.inc
'Public domain, use at own risk. SDurham
#If Not %Def(%OHash250808)
%OHash250808 = 1
Declare Function ObjectStoreCallback(o As IUnknown) As String
'store object's data in a String and return the String
'when you implement the callback, replace IUnknown with the actual interface
Declare Function ObjectRestoreCallback(ByRef stored As String) As IUnknown
'restore object's data and return new instance
'when you implement the callback, replace IUnknown with the actual interface
Type WStrT
mem As Word Ptr
count As Long
End Type
Type OHashNodeT
key As WStrT
value As Long
next As OHashNodeT Ptr
End Type
Type StrBuildT
mem As Long
count As Long
max As Long
End Type
Class OHashC
'Key/Value WString/Object Hash Table
'value stored and retrieved using unique key
'key case sensitive
Instance mCapacity As Long
Instance mCount As Long
Instance mArr() As Long
Instance mIndex As Long
Instance mNode As OHashNodeT Ptr
Instance mStore As Long
Instance mRestore As Long
Class Method Create()
mCapacity = 30 'default capacity
ReDim mArr(0 To mCapacity - 1)
End Method
Class Method Destroy()
Me.ClearMe()
Erase mArr()
End Method
Interface OHashI : Inherit IUnknown
Property Set Capacity(ByVal value As Long)
'about number of expected items : hash table must be empty
If mCount = 0 And value > 0 Then
mCapacity = value
ReDim mArr(0 To mCapacity - 1)
End If
End Property
Method Storage(ByVal storeCB As Long, ByVal restoreCB As Long)
'store and restore callbacks must be set to call Stor/Restore methods
If storeCB And restoreCB Then
mStore = storeCB : mRestore = restoreCB
End If
End Method
Method Clear()
'empty container
Me.ClearMe()
End Method
Property Get Count() As Long
'get item count
Property = mCount
End Property
Method Set(ByRef key As WString, value As IUnknown)
'add key and associated value : key added if not in hash table
Local index, keymem, keylen As Long
Local node As OHashNodeT Ptr
If IsObject(value) Then
keymem = StrPtr(key)
keylen = Len(key)
index = WStrHashIndex(keymem, keylen, mCapacity)
node = mArr(index)
While node
If WStrEqual(keymem, keylen, @node.key.mem, @node.key.count) Then
@node.value = Me.FreeObj(@node.value)
@node.value = Me.LongFromObj(value)
Exit Method
End If
node = @node.next
Wend
'key not in hash table
node = MemAlloc(SizeOf(@node))
If node Then
WStrSet @node.key, key
@node.value = Me.LongFromObj(value)
@node.next = mArr(index)
mArr(index) = node
Incr mCount
End If
End If
End Method
Method Get(ByRef key As WString) As IUnknown
'get key's associated value : null if key not in hash table
Local o As IUnknown
Local node As OHashNodeT Ptr
node = Me.Contains(key)
If node Then
o = Me.ObjFromLong(@node.value)
Method = o
End If
End Method
Method Contains(ByRef key As WString) As Long
'true/false if key in hash table
Local keymem, keylen As Long
Local node As OHashNodeT Ptr
If mCount Then
keymem = StrPtr(key)
keylen = Len(key)
node = mArr(WStrHashIndex(keymem, keylen, mCapacity))
While node
If WStrEqual(keymem, keylen, @node.key.mem, @node.key.count) Then
Method = node : Exit Method
End If
node = @node.next
Wend
End If
End Method
Method Delete(ByRef key As WString)
'delete key and associated value
Local index, keymem, keylen As Long
Local node, prev As OHashNodeT Ptr
If mCount Then
keymem = StrPtr(key)
keylen = Len(key)
index = WStrHashIndex(keymem, keylen, mCapacity)
node = mArr(index)
While node
If WStrEqual(keymem, keylen, @node.key.mem, @node.key.count) Then
If prev Then
@prev.next = @node.next
Else
mArr(index) = @node.next
End If
node = Me.FreeNode(node)
Decr MCount
Exit Method
End If
node = @node.next
Wend
End If
End Method
Method Start()
'reset cursor to start
mIndex = -1 : mNode = 0
End Method
Method Each() As Long
'move cursor to next key in hash table : true/false success
Register i As Long
If mCount Then
If mNode And @mNode.next Then
mNode = @mNode.next
Method = 1 : Exit Method
Else
mNode = 0
For i = mIndex + 1 To mCapacity - 1
If mArr(i) Then
mIndex = i
mNode = mArr(i)
Method = 1 : Exit Method
End If
Next i
End If
End If
mIndex = -1 : mNode = 0
End Method
Method Key() As WString
'get key at cursor position : null if cursor invalid
If mNode Then Method = WStrGet(@mNode.key)
End Method
Method Value() As IUnknown
'get value at cursor position : null if cursor invalid
If mNode Then Method = Me.ObjFromLong(@mNode.value)
End Method
Method Store() As String
'store container as String
Local key, s As String
Local value As IUnknown
Local sb As StrBuildT
If mCount And mStore Then
StrBuildPush sb, Mkl$(mCount)
Me.Start()
While Me.Each()
key = ChrToUtf8$(Me.Key())
value = Me.Value()
If IsObject(value) Then
Call Dword mStore Using ObjectStoreCallback(value) To s
StrBuildPush sb, Mkl$(Len(key))
StrBuildPush sb, key
StrBuildPush sb, Mkl$(Len(s))
StrBuildPush sb, s
End If
Wend
Method = StrBuildPop(sb)
End If
End Method
Method Restore(ByRef stored As String)
'restore container from String
Register i As Long
Local items, bytes As Long
Local key, s As String
Local o As IUnknown
Local p As Long Ptr
Me.ClearMe()
If mRestore And Len(stored) Then
p = StrPtr(stored)
items = @p : Incr p
For i = 1 To items
bytes = @p : Incr p
key = Peek$(p, bytes) : p += bytes
bytes = @p : Incr p
s = Peek$(p, bytes) : p += bytes
Call Dword mRestore Using ObjectRestoreCallback(s) To o
Me.Set(Utf8ToChr$(key), o)
Next i
End If
End Method
Method FileStore(ByVal file As WString)
'store container to File
If Len(file) And mStore Then Me.FilePut(file, Me.Store())
End Method
Method FileRestore(ByVal file As WString)
'restore container from File
If IsFile(file) And mRestore Then Me.Restore(Me.FileGet(file))
End Method
End Interface
Class Method ClearMe()
Register i As Long
Local node As OHashNodeT Ptr
For i = 0 To mCapacity - 1
While mArr(i)
node = mArr(i)
mArr(i) = @node.next
Me.FreeNode(node)
Wend
Next i
mCount = 0
End Method
Class Method FreeNode(ByVal node As OHashNodeT Ptr) As Long
If node Then
WStrFinal @node.key
@node.value = Me.FreeObj(@node.value)
MemFree(node)
End If
End Method
Class Method LongFromObj(o As IUnknown) As Long
If IsObject(o) Then
o.AddRef()
Method = Peek(Long, VarPtr(o))
End If
End Method
Class Method ObjFromLong(ByVal h As Long) As IUnknown
Local o As IUnknown
If h Then
Poke Long, VarPtr(o), h
o.AddRef()
Method = o
End If
End Method
Class Method FreeObj(ByVal h As Long) As Long
Local o As IUnknown
If h Then
Poke Long, VarPtr(o), h
o = Nothing
End If
End Method
Class Method FilePut(ByVal file As WString, ByRef value As String)
Local f As Long
If Len(file) = 0 Then Exit Method
f = FreeFile
Open file For Binary As f
SetEof f
Put$ f, value
Close f
End Method
Class Method FileGet(ByVal file As WString) As String
Local f As Long, value As String
If IsFalse IsFile(file) Then Exit Method
f = FreeFile
Open file For Binary As f
Get$ f, Lof(f), value
Close f
Method = value
End Method
End Class
#EndIf '%OHash250808
#If Not %Def(%WStr250808)
%WStr250808 = 1
'----------------------------------------------------------------------
'WString Container = Word Array
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
%WrdSize = 2
Type WStrT
mem As Word Ptr
count As Long
End Type
'----------------------------------------------------------------------
Sub WStrFinal(t As WStrT)
'call before variable gores out of scope to free memory
WStrClear t
End Sub
'----------------------------------------------------------------------
Sub WStrClear(t As WStrT)
'empty container
t.mem = MemFree(t.mem)
t.count = 0
End Sub
'----------------------------------------------------------------------
Function WStrCount(t As WStrT) As Long
'get character count
Function = t.count
End Function
'----------------------------------------------------------------------
Function WStrGet(t As WStrT) As WString
'get value
If t.mem Then Function = Peek$$(t.mem, t.count)
End Function
'----------------------------------------------------------------------
Macro WStrGetM(t) = Peek$$(t.mem, t.count)
'----------------------------------------------------------------------
Sub WStrSet(t As WStrT, ByRef value As WString)
'set value
Local characters As Long
t.mem = MemFree(t.mem)
t.count = 0
characters = Len(value)
If characters Then
t.mem = MemAlloc(characters * %WrdSize)
If t.mem Then
Memory Copy StrPtr(value), t.mem, characters * %WrdSize
t.count = characters
End If
End If
End Sub
'----------------------------------------------------------------------
#EndIf '%WStr250808
#If Not %Def(%WStrHash250808)
%WStrHash250808 = 1
'----------------------------------------------------------------------
'WString Hash Index
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
Function WStrHashIndex(ByVal keymem As Word Ptr, ByVal keylen As Long, ByVal capacity As Long) As Long
'get key's hash index position
Register i As Long
Register total As Long
Local temp As Long
If keymem Then
For i = 0 To keylen - 1
temp += @keymem[i] + total
Shift Left total, 8
total += temp
Next i
Function = Abs(total Mod capacity)
End If
End Function
'----------------------------------------------------------------------
#EndIf '%WStrHash250808
#If Not %Def(%WStrEqual250808)
%WStrEqual250808 = 1
'----------------------------------------------------------------------
Function WStrEqual(ByVal memA As Word Ptr, ByVal lenA As Long, ByVal memB As Word Ptr, ByVal lenB As Long) As Long
'true/false if two strings equal
Register i As Long
If memA And memB And lenA = lenB Then
For i = 0 To lenA - 1
If @memA[i] <> @memB[i] Then Exit Function
Next i
Function = 1
End If
End Function
'----------------------------------------------------------------------
#EndIf '%WStrEqual250808
#If Not %Def(%StrBuild250811)
%StrBuild250811 = 1
'----------------------------------------------------------------------
'String Builder
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
%BytSize = 1
%StrBuildBufferMax = 5000000
'----------------------------------------------------------------------
Type StrBuildT
mem As Long
count As Long
max As Long
End Type
'----------------------------------------------------------------------
Sub StrBuildPush(t As StrBuildT, ByVal value As String)
'append value
Local strlen, currentcount, buffer, newmax As Long
strlen = Len(value)
If strlen Then
If strlen > t.max - t.count Then
currentcount = t.count : t.count = 0 : t.max = 0
buffer = Max&(1, 2 * currentcount)
buffer = Min&(buffer, %StrBuildBufferMax)
newmax = currentcount + buffer + strlen
t.mem = MemReAlloc(t.mem, newmax * %BytSize)
If t.mem = 0 Then Exit Sub
t.count = currentcount : t.max = newmax
End If
Memory Copy StrPtr(value), t.mem + (t.count * %BytSize), strlen * %BytSize
t.count += strlen
End If
End Sub
'----------------------------------------------------------------------
Function StrBuildPop(t As StrBuildT) As String
'get whole string : free memory
If t.mem And t.count Then Function = Peek$(t.mem, t.count)
t.mem = MemFree(t.mem)
t.count = 0
t.max = 0
End Function
'----------------------------------------------------------------------
#EndIf '%StrBuild250811
#If Not %Def(%Memory230925)
%Memory230925 = 1
'----------------------------------------------------------------------
'Memory Allocation
'Public domain, use at own risk. SDurham
'----------------------------------------------------------------------
Declare Function GlobalAlloc Lib "Kernel32.dll" Alias "GlobalAlloc" (ByVal uFlags As Dword, ByVal dwBytes As Dword) As Dword
Declare Function GlobalReAlloc Lib "Kernel32.dll" Alias "GlobalReAlloc" (ByVal hMem As Dword, ByVal dwBytes As Dword, ByVal uFlags As Dword) As Dword
Declare Function GlobalFree Lib "Kernel32.dll" Alias "GlobalFree" (ByVal hMem As Dword) As Dword
%MEMFIXED = &H0000 : %MEMMOVEABLE = &H0002 : %MEMZEROINIT = &H0040 : %MEMGPTR = (%MEMZEROINIT Or %MEMFIXED)
'----------------------------------------------------------------------
Function MemAlloc(ByVal bytes As Long) As Long
'allocate memory
If bytes Then Function = GlobalAlloc(ByVal %MEMGPTR, ByVal bytes)
End Function
'----------------------------------------------------------------------
Function MemReAlloc(ByVal hMem As Long, ByVal bytes As Long) As Long
'reallocate new size
If hMem And bytes Then
Function = GlobalReAlloc(ByVal hMem, ByVal bytes, ByVal %MEMMOVEABLE Or %MEMZEROINIT)
ElseIf bytes Then
Function = GlobalAlloc(ByVal %MEMGPTR, ByVal bytes)
ElseIf hMem Then
Function = GlobalFree(ByVal hMem)
End If
End Function
'----------------------------------------------------------------------
Function MemFree(ByVal hMem As Long) As Long
'free memory
If hMem Then GlobalFree(ByVal hMem)
End Function
'----------------------------------------------------------------------
#EndIf '%Memory230925
Code:
'ObjectHash.bas
#Option LargeMem32
#Dim All
#Compile Exe
#Include Once "WIN32API.INC"
#Include Once "..\ObjectHash.inc"
%TextBox = 101
%BtnID = 102
Global gDlg As Long
Global gBuild As IStringBuilderW
Sub SS(ByVal value As WString)
gBuild.Add(value + $CrLf)
End Sub
Class TestC
Instance mX As Long
Interface TestI : Inherit IUnknown
Property Get X() As Long
Property = mX
End Property
Property Set X(ByVal value As Long)
mX = value
End Property
Property Get Str() As WString
Property = Format$(mX)
End Property
End Interface
End Class
Function TestStore(o As TestI) As String
'store callback
'store object's data in a String and return the String
'when you implement the callback, replace IUnknown with the actual interface
If IsObject(o) Then Function = Mkl$(o.X)
End Function
Function TestRestore(ByRef stored As String) As TestI
'restore callback
'restore object's data and return new instance
'when you implement the callback, replace IUnknown with the actual interface
Local o As TestI : o = Class "TestC"
o.X = Cvl(stored)
Function = o
End Function
Sub SampleCode()
Register i As Long
Local hash As OHashI : hash = Class "OHashC"
Local o As TestI : o = Class "TestC"
Local stored As String
Local a() As WString
Local d As Double
Local testcount As Long : testcount = 100000 'can change
Randomize
MousePtr 11
Control Set Text gDlg, %TextBox, ""
SS ""
SS "Property Set Capacity(ByVal value As Long)"
hash.capacity = testcount
SS ""
SS "Method Storage(ByVal storeCB As Long, ByVal restoreCB As Long)"
hash.Storage(CodePtr(TestStore), CodePtr(TestRestore))
SS ""
SS "Method Add(ByRef key As WString, value As IUnknown) As Long"
SS "add key/value items"
For i = 65 To 69
o = Class "TestC" : o.X = i
hash.Set(Chr$$(i), o)
Next i
hash.Start()
While hash.Each()
o = hash.Value()
If IsObject(o) Then SS "key = " + $Dq + hash.Key() + $Dq + " | value = " + o.Str
Wend
SS ""
SS "change value for key C"
o = Class "TestC" : o.X = 4444
hash.Set("C", o)
hash.Start()
While hash.Each()
o = hash.Value()
If IsObject(o) Then SS "key = " + $Dq + hash.Key() + $Dq + " | value = " + o.Str
Wend
SS ""
SS "Method Get(ByRef key As WString) As IUnknown"
SS "get object to change value for key C"
o = hash.Get("C") : If IsObject(o) Then o.X = 999999999
hash.Start()
While hash.Each()
o = hash.Value()
If IsObject(o) Then SS "key = " + $Dq + hash.Key() + $Dq + " | value = " + o.Str
Wend
SS ""
SS "Method Contains(ByRef key As WString)"
SS "hash table contains key B = " + Format$(hash.Contains("B"))
SS "hash table contains key E = " + Format$(hash.Contains("E"))
SS "hash table contains key ZZZ = " + Format$(hash.Contains("ZZZ"))
SS ""
SS "Method Delete(ByRef key As WString)"
SS "delete key C"
hash.Delete("C")
hash.Start()
While hash.Each()
o = hash.Value()
If IsObject(o) Then SS "key = " + $Dq + hash.Key() + $Dq + " | value = " + o.Str
Wend
SS ""
SS "Method Store() As String"
stored = hash.Store()
SS "Method Restore(ByRef stored As String)"
hash.Restore(stored)
SS "Method FileStore(ByVal file As String)"
hash.FileStore("Stored.hash")
SS "Method FileRestore(ByVal file As String)"
hash.FileRestore("Stored.hash")
Kill "Stored.hash"
hash.Start()
While hash.Each()
o = hash.Value()
If IsObject(o) Then SS "key = " + $Dq + hash.Key() + $Dq + " | value = " + o.Str
Wend
ReDim a(1 To testcount)
For i = 1 To testcount
a(i) = RandomString()
Next i
SS ""
SS "add "+Format$(testcount,"#,")+" random key/value items"
hash.Clear()
d = Timer
For i = 1 To testcount
o = Class "TestC" : o.X = i
hash.Set(a(i), o)
Next i
SS "Time = " + Format$(Timer - d, "000.000")
SS "Count = " + Format$(hash.Count, "#,") + " duplicate keys not allowed"
SS ""
SS "find "+Format$(testcount,"#,")+" random keys"
d = Timer
For i = 1 To testcount
If hash.Contains(a(i)) = 0 Then
? "hash table fail" : Exit For
End If
Next i
SS "Time = " + Format$(Timer - d, "000.000")
SS ""
SS ""
Control Set Text gDlg, %TextBox, gBuild.String
gBuild.Clear
MousePtr 1
End Sub
Function RandomString() As String
Register i As Long
Local s As String
For i = 1 To Rnd(5, 8)
Select Case As Const Rnd(1, 2)
Case 1 : s += Chr$(Rnd(65, 90))
Case 2 : s += Chr$(Rnd(97, 122))
End Select
Next i
Function = s
End Function
Function PBMain()
gBuild = Class "StringBuilderW"
Dialog Default Font "courier new", 12, 0, 0
Dialog New 0, "Sample Code", 0, 0, 0, 0, %WS_Caption Or %WS_ClipSiblings Or %WS_MinimizeBox Or %WS_SysMenu Or %WS_ThickFrame, %WS_Ex_AppWindow To gDlg
Control Add TextBox, gDlg, %TextBox, "", 0, 0, 0, 0, %ES_AutoHScroll Or %ES_AutoVScroll Or %ES_MultiLine Or %ES_NoHideSel Or %ES_WantReturn Or %WS_HScroll Or %WS_VScroll Or %WS_Border, 0
Control Add Button, gDlg, %BtnID, "Run", 275, 220, 60, 15, %BS_Flat, 0
SendMessageW(GetDlgItem(gDlg, %TextBox), %EM_SETLIMITTEXT, 4000000, 0)
Dialog Show Modeless gDlg, Call DlgCB
While IsWin(gDlg)
Dialog DoEvents
Wend
End Function
CallBack Function DlgCB()
Select Case As Long Cb.Msg
Case %WM_InitDialog
WM_InitDialog()
Case %WM_Size
WM_Size()
Case %WM_Command
Select Case As Long Cb.Ctl
Case %BtnID : If Cb.CtlMsg = %BN_Clicked Then SampleCode()
End Select
End Select
End Function
Sub WM_InitDialog()
Local clientW, clientH As Long
Desktop Get Client To clientW, clientH
clientW /= 7
clientH /= 4
Dialog Set Loc gDlg, clientW / 2, clientH / 7
Dialog Set Size gDlg, clientW, clientH
End Sub
Sub WM_Size()
Local clientW, clientH As Long
Local marg As Long
Local buttonW, buttonH As Long
Local txtWidth, txtHeight As Long
Local fromLeft, fromBottom As Long
Dialog Get Client gDlg To clientW, clientH
marg = 1 : buttonW = 30 : buttonH = 10
fromLeft = clientW - marg - marg - buttonW
fromBottom = clientH - marg - marg - buttonH
Control Set Size gDlg, %BtnID, buttonW, buttonH
Control Set Loc gDlg, %BtnID, fromLeft, fromBottom
txtWidth = clientW - marg - marg
txtHeight = clientH - marg - buttonH - marg - marg
Control Set Size gDlg, %TextBox, txtWidth, txtHeight
Control Set Loc gDlg, %TextBox, marg, marg
End Sub
I was going to wait about posting gbNotes until I added more features, but I've gotten distracted and probably won't touch it again for a while. But since I use it daily I thought it ought to be good enough to share.
The "database" is just a text file that uses "++++" as a delimiter between entries.
The first line of each entry is just a user name. Any number of lines can added after that.
On the left is a search term editor, a list of the most search terms and a list of the most recent search matches. Click on a match to see and edit the content. Ctrl+D will insert a date line into the editor, below which you can enter new content.
Each day, it does a backup of the CRM.txt file into a "backup" folder.
You can also view/edit/search the entire CRM.txt file
There's not much more to it. Simple, but good enough to let me track my contacts.
A while back I asked about CRM app recommendations. Not having found something as simple as I wanted, I wrote my own and have been using it the last couple of months.
I still have a list of changes I want to make to it, but since I've been using for a while now, I guess it's worth offering up to anyone who wants it.
%MultiLineREStyle_Wrap = %WS_Child Or %WS_ClipSiblings Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or _
%ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop Or %ES_SaveSel
Global hDlg, hRichEdit, hListView, hComboBox, hList, hDlgI As Dword
Global D() As String, REText$, SearchTerm$, SearchTerms$
Global RESearchTerm As WStringZ * 100
Global SearchDirection, BackupNumber, CFN, iSkip, Maximized, Minimized, Mute As Long
Function PBMain() As Long
Dialog Default Font "Arial Black", 16,1
Dialog New Pixels, 0, "gbNotes " + $Ver,,,800,800, %WS_OverlappedWindow To hDlg
Dialog Set Icon hDlg, "xlogo"
Control Add ComboBox, hDlg, %IDC_ComboBox,, 10,10,400,200, %CBS_Simple Or %CBS_NoIntegralHeight Or %WS_VScroll Or %WS_TabStop, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_ComboBox To hComboBox
Control Add ListView, hDlg, %IDC_ListView, "",10,40,400,400, %WS_TabStop Or %LVS_Report Or %LVS_ShowSelAlways Or %LVS_SingleSel, %WS_Ex_ClientEdge
ListView Insert Column hDlg, %IDC_ListView, 1,"All Contacts",400,0
ListView Insert Column hDlg, %IDC_ListView, 2,"Position",150,0
Control Handle hDlg, %IDC_ListView To hListView
LoadLibrary("msftedit.dll")
Control Add "RichEdit50W", hDlg, %IDC_RichEdit, "", 410,10,400,400, %MultiLineREStyle_Wrap, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_RichEdit To hRichEdit
SendMessage hDlg, %EM_SetEventMask, 0, %ENM_SelChange
SendMessage hRichEdit, %EM_SetEventMask, 0, %ENM_SelChange Or %ENM_Link
SendMessage hRichEdit, %EM_AUTOURLDETECT, %True, 0
Control Add Statusbar, hDlg, %IDC_StatusBar, "Welcome to gbNotes!", 0,0,0,90
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local pNMLV As NMListView Ptr, iRow As Long, temp$
Select Case Cb.Msg
Case %WM_InitDialog
If IsFalse IsFolder("backup") Then MkDir "backup"
Settings_INI "get"
BuildAcceleratorTable
LoadCRMFile 'create D() from CRM.txt
DisplayCRMArray 'put D() into LV
LoadComboBox
Control Set Text hDlg, %IDC_ComboBox, SearchTerm$
If Maximized Then Dialog Show State hDlg, %SW_Maximize 'restore Maximized state if necessary
If Minimized Then Dialog Show State hDlg, %SW_Minimize 'restore Maximized state if necessary
Control Set Text hDlg, %IDC_RichEdit, D(CFN)
ListView Select hDlg, %IDC_ListView, CFN
ListView_SetItemState hListView, CFN-1, %LVIS_Focused, %LVIS_Focused '<--- keyboard synchronizing code
ListView Visible hDlg, %IDC_ListView, CFN
Case %WM_Size : Resize
Case %WM_Command
Select Case Cb.Ctl
' Case %IdCancel : Dialog End hDlg
Case %IdOk 'Enter Key
If GetParent(GetFocus) = hComboBox Then
sBeep
Control Get Text hDlg, %IDC_ComboBox To SearchTerm$
Search
AddSearchTerm
End If
Case %IDC_ComboBox
Select Case Cb.CtlMsg
Case %CBN_SelChange
'get post-selection text
Control Send hDlg, %IDC_ComboBox, %CB_GetCurSel, 0, 0 To iRow
ComboBox Get Text hDlg, %IDC_ComboBox, iRow+1 To SearchTerm$
Dialog Set Text hDlg, "SearchTerm = " + SearchTerm$ + " " + Time$
Search
End Select
Case %IDT_Exit : sBeep : Dialog End hDlg
Case %IDT_SaveCFN : sBeep : SaveCFN : ST Trim$(Parse$(D(CFN),$CrLf,1)) + " saved"
Case %IDT_New : NewCFN : ST "New Contact"
Case %IDT_Delete : sBeep : DeleteCFN : ST ""
Case %IDT_Search : sBeep : Control Get Text hDlg, %IDC_ComboBox To SearchTerm$ : Search 'ST
Case %IDT_InsertDate : sBeep : InsertDate : ST ""
Case %IDT_InsertDelimiter : sBeep : InsertDelimiter : ST ""
Case %IDT_ShowAll : sBeep : ShowAll : ST "All CRM.txt Loaded in Editor"
Case %IDT_SaveAll : sBeep : SaveAll : ST "Editor Content saved to crm.txt"
' Case %IDT_Sort : sBeep : SortData
Case %IDT_Mute : WinBeep(275,150) : Mute Xor=1 : ST "Mute is " + IIf$(Mute,"ON","OFF")
Case %IDT_SetFocusRE : SetFocus hRichEdit
Case %IDT_SearchDown : SearchDirection = 1 : FindRE : ST ""
Case %IDT_SearchUp : SearchDirection = 0 : FindRE
Case %IDT_NextREDown : sBeep : SearchDirection = 1 : SearchText RESearchTerm, %FR_Down
Case %IDT_AllContacts : DisplayCRMArray
End Select
Case %WM_Notify
Select Case Cb.NmId
Case %IDC_RichEdit
Select Case Cb.NmCode
Case %EN_Link : OpenLink(Cb.LParam)
End Select
Case %IDC_ListView
Select Case Cb.NmCode
Case %LVN_ItemChanged '%NM_Click
pNMLV = Cb.LParam
If (@pNMLV.uChanged And %LVIF_STATE) = %LVIF_STATE Then ' if state has changed
If (@pNMLV.unewstate And %LVIS_SELECTED) = %LVIS_SELECTED Then
ListView Get Select hDlg, %IDC_ListView To iRow
ListView Get Text hDlg, %IDC_Listview, iRow, 2 To temp$
CFN = Val(temp$)
Control Set Text hDlg, %IDC_RichEdit, D(CFN)
sBeep
End If
End If
End Select
End Select
Case %WM_Destroy
SaveBackup
Settings_INI "save"
End Select
End Function
Sub Resize
Local x,y,w,h,wc,hc,wt,ht As Long
Control Get Size hDlg, %IDC_Toolbar To wt,ht
Dialog Get Client hDlg To w,h
Control Set Loc hDlg, %IDC_ComboBox, 10,ht+10
Control Get Size hDlg, %IDC_ComboBox To wc,hc
Control Set Loc hDlg, %IDC_ListView, 10,ht+hc+20
Control Set Size hDlg, %IDC_ListView, 400, h-ht-hc-30-40
Control Set Loc hDlg, %IDC_RichEdit, wc+15,ht+10
Control Set Size hDlg, %IDC_RichEdit, w-wc-25,h-ht-30-30
End Sub
Function OpenLink(ByVal lpLink As Dword) As Long
Local enlinkPtr As ENLINK Ptr, linkText As String, iReturn As Long
Control Get Text hDlg, %IDC_RichEdit To REText$
enlinkPtr = lpLink
If @enLinkPtr.Msg = %WM_LButtonUp Then
LinkText = Mid$(REText$,@enLinkPtr.chrg.cpMin+1 To @enLinkPtr.chrg.cpMax)
LinkText = Remove$(LinkText, Any $Cr+$Lf+$Spc)
iReturn = ShellExecute(hDlg, "Open", (LinkText), $Nul, $Nul, %SW_ShowNormal)
End If
End Function
Sub LoadComboBox
Local temp$, i As Long
Open "searchterms.txt" For Binary As #1 : Get$ #1, Lof(1), SearchTerms$ : Close #1
If Len(SearchTerms$) = 0 Then SearchTerms$ = "Texas" + $CrLf + "Papua New Guinea"
SearchTerms$ = Trim$(SearchTerms$, Any $CrLf + $Spc)
SearchTerm$ = Parse$(SearchTerms$,$CrLf,1)
ComboBox Reset hDlg, %IDC_ComboBox
Control Set Text hDlg, %IDC_ComboBox, SearchTerm$
For i = 1 To Min(5,ParseCount(searchterms$,$CrLf))
ComboBox Insert hDlg, %IDC_ComboBox, i, Parse$(SearchTerms$,$CrLf,i)
Next i
End Sub
Sub LoadCRMFile
Local tmp$, temp$, i,iCount As Long
Open "crm.txt" For Binary As #1 : Get$ #1, Lof(1), temp$ : Close #1
If Len(Trim$(temp$)) = 0 Then
temp$ = "Gary Beene" + $CrLf + "Dallas, Texas" + $CrLf + $Delim + $CrLf + "Stuart McLachlan" + $CrLf + "Papua New Guinea"
Open "crm.txt" For Output As #1 : Print #1, temp$; : Close #1
End If
iCount = ParseCount(temp$, $Delim)
ReDim D(1 To iCount)
Parse temp$, D(), $Delim
For i = 1 To iCount
D(i) = Trim$(D(i), Any $CrLf + $Spc)
tmp$ = Parse$(D(i),$CrLf,1)
If Trim$(tmp$) = "" Then ? "Data Issue:" + $CrLf + D(i-1)
Next i
ST "Records: " + Format$(iCount,"##,###")
End Sub
Sub DisplayCRMArray
Local temp$, i As Long
ListView Reset hDlg, %IDC_ListView
For i = 1 To UBound(D)
D(i) = Trim$(D(i))
ListView Insert Item hDlg, %IDC_ListView, i,0,Parse$(D(i),$CrLf,1)
ListView Set Text hDlg, %IDC_ListView, i,2,Format$(i)
Next i
End Sub
Sub Search
Local temp$, i,iCount As Long
ListView Reset hDlg, %IDC_ListView
For i = 1 To UBound(D)
If InStr(LCase$(D(i)), LCase$(SearchTerm$)) Then
Incr iCount
ListView Insert Item hDlg, %IDC_ListView, iCount, 0, Parse$(D(i),$CrLf,1)
ListView Set Text hDlg, %IDC_ListView, iCount, 2, Format$(i)
End If
Next i
Sub Settings_INI(Task$)
Local x,y,w,h, tempz, INIFileName As WStringZ * %Max_Path, WinPla As WindowPlacement
'set ini filename
INIFileName = Exe.Path$ + Exe.Name$ + ".ini" 'get INI file name
Select Case Task$
Case "get"
'get dialog width/height from INI file and use to set Dialog size
GetPrivateProfileString "All", "Width", "800", w, %Max_Path, INIFileName
GetPrivateProfileString "All", "Height", "800", h, %Max_Path, INIFileName
Dialog Set Size hDlg,Val(w), Val(h) 'width/height
'get dialog top/left from INI file and use to set Dialog location
Getprivateprofilestring "All", "Left", "0", x, %Max_Path, INIFileName
Getprivateprofilestring "All", "Top", "0", y, %Max_Path, INIFileName
If IsFile(INIFileName) Then Dialog Set Loc hDlg, Val(x), Val(y) 'left/top but only once INIFileName exists
'get value for string variables
GetPrivateProfileString "All", "RESearchTerm", "TWC", RESearchTerm, %Max_Path, INIFileName
Sub SaveCFN
Local temp$
Control Get Text hDlg, %IDC_RichEdit To temp$
If InStr(temp$, $Delim) Then ? "Cannot Save!" : Exit Sub
D(CFN) = temp$
Open "crm.txt" For Output As #1 : Print #1, Join$(D(), $CrLf + $Delim + $CrLf); : Close #1
ListView Set Text hDlg, %IDC_ListView, CFN, 1, Parse$(D(CFN),$CrLf,1)
SetFocus hRichEdit
End Sub
Sub ShowAll
Control Set Text hDlg, %IDC_RichEdit, Join$(D(),$CrLf + $Delim + $CrLf)
SendMessage hRichEdit, %EM_SetSel, 0, 0
SetFocus hRichEdit
End Sub
Sub SaveAll
Local temp$
If MsgBox("Update All CRM Data?", %MB_YesNo Or %MB_IconQuestion Or %MB_TaskModal, "Update CRM") = %IdYes Then
Control Get Text hDlg, %IDC_RichEdit To temp$
temp$ = Trim$(temp$, Any $CrLf + " +")
Open "crm.txt" For Output As #1
Print #1, temp$;
Close #1
LoadCRMFile 'create D() from CRM.txt
DisplayCRMArray 'put D() into LV
End If
End Sub
Sub sBeep
If Mute Then Exit Sub
WinBeep(275,150)
End Sub
Sub BuildAcceleratorTable
Local ac() As ACCELAPI, hAccelerator As Dword, c As Long ' for keyboard accelator table values
Dim ac(10)
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_Delete : ac(c).cmd = %IDT_Delete : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_D : ac(c).cmd = %IDT_InsertDate : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_E : ac(c).cmd = %IDT_ShowAll : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_F : ac(c).cmd = %IDT_SearchDown : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_I : ac(c).cmd = %IDT_InsertDelimiter : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_R : ac(c).cmd = %IDT_SetFocusRE : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_M : ac(c).cmd = %IDT_Mute : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_N : ac(c).cmd = %IDT_NextREDown : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key = %VK_S : ac(c).cmd = %IDT_SaveCFN : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_F : ac(c).cmd = %IDT_SearchUp : Incr c
ac(c).fvirt = %FVIRTKEY Or %FCONTROL Or %FSHIFT : ac(c).key = %VK_S : ac(c).cmd = %IDT_SaveAll : Incr c
Accel Attach hDlg, AC() To hAccelerator
End Sub
Sub InsertDelimiter
Clipboard Reset
Clipboard Set Text $CrLf + $Delim + $CrLf + $CrLf
SendMessage hRichEdit, %WM_Paste, 0, 0
End Sub
Sub InsertDate
Clipboard Reset
Clipboard Set Text $CrLf + "Discussion: " + Date$ + " " + Time$ + " ---------" + $CrLf + $CrLf
SendMessage hRichEdit, %WM_Paste, 0, 0
End Sub
'Sub SortData
' Array Sort D(1)
' Open "crm.txt" For Output As #1 : Print #1, Join$(D(), $CrLf + $Delim + $CrLf); : Close #1
' LoadCRMFile 'create D() from CRM.txt
' DisplayCRMArray 'put D() into LV
'End Sub
Sub AddSearchTerm
Local i As Long
'If SearchTerm alread in use, do nothing
For i = 1 To Min(5,ParseCount(SearchTerms$,$CrLf))
If LCase$(Parse$(SearchTerms$,$CrLf,i)) = LCase$(SearchTerm$) Then Exit Sub
Next i
'If new search term, add it top of the list of SearchTerms$
SearchTerms$ = SearchTerm$ + $CrLf + SearchTerms$
SearchTerms$ = Trim$(SearchTerms$, Any $CrLf + $Spc)
Open "searchterms.txt" For Output As #1 : Print #1, SearchTerms$; : Close #1
LoadComboBox
End Sub
Sub SaveBackup
Local temp$
temp$ = Time$
Replace ":" With "." In temp$
Incr BackupNumber
Open "backup\crm_" + Format$(BackupNumber) + "_" + Date$ + "_" + temp$ + ".txt" For Output As #1
Print #1, Join$(D(), $CrLf + $Delim + $CrLf); : Close #1
End Sub
Sub FindRE
GetRESearchTerm
SearchText RESearchTerm, %FR_Down
End Sub
Function SearchText(ByVal sTextToSearchFor As WString, SearchDirection As Long) As Long
Local FindTextText As FINDTEXTEX
Local NextMatch, SelStart, SelEnd As Long
If SearchDirection = 1 Then
FindTextText.chrg.cpMin = SelEnd + 1 'Search from current position
FindTextText.chrg.cpMax = -1 '- till the end
Else '%FR_UP
FindTextText.chrg.cpMin = SelStart 'Search from current position
FindTextText.chrg.cpMax = 0 '- up to the start
End If
NextMatch = SendMessage(hRichEdit, %EM_FINDTEXTEX, SearchDirection, VarPtr(FindTextText)) 'Return next match or -1 for no more
If NextMatch = -1 Then WinBeep(250,300) :Exit Function
SendMessage(hRichEdit, %EM_SETSEL, FindTextText.chrgText.cpMin, FindTextText.chrgText.cpMax)
End Function
Sub GetRESearchTerm
Dialog New Pixels, 0, "Search RE",,,200,80, %WS_SysMenu To hDlgI
Dialog Set Icon hDlgI, "xsearch"
Control Add TextBox, hDlgI, %IDC_InputTextBox,RESearchTerm, 20,10,160,30
Control Add Button, hDlgI, %IDC_InputOk, "Ok", 20,50,50,25
Control Add Button, hDlgI, %IDC_InputCancel, "Cancel", 90,50,90,25
RESearchTerm = ""
Dialog Show Modal hdlgI Call hDlgIProc
End Sub
CallBack Function hDlgIProc() As Long
Select Case Cb.Msg
Case %WM_Command
Select Case Cb.Ctl
Case %IdOk , %IDC_InputOk : Control Get Text hDlgI, %IDC_InputTextBox To RESearchTerm : Dialog End hDlgI
Case %IdCancel, %IDC_InputCancel : Dialog End hDlgI
End Select
End Select
End Function
Sub NewCFN
ReDim Preserve D(1 To UBound(D)+1)
D(UBound(D)) = "New Entry"
CFN = UBound(D)
ListView Insert Item hDlg, %IDC_ListView, CFN, 0, "New Entry " + $CrLf + "Date: " + Date$
ListView Set Text hDlg, %IDC_ListView, CFN, 2, Format$(CFN)
I'd like to start by thanking Albert for hosting our community's new home. This platform has been crucial in bringing our group together and facilitating knowledge-sharing, which would be difficult to achieve without it.
That being said, I think we're still vulnerable to disruptions if something happens to Albert or the current setup. To address this, I propose that we establish a committee to oversee the creation of a more permanent and stable home for our community. This would involve securing reliable hosting, maintenance, and data management, including the ability to export our databases if needed.
To ensure the committee represents our diverse international community, I suggest we aim for broad representation of at least 3-5 members. I know we could nominate some individuals who have demonstrated long-term commitment, but it's essential that potential committee members volunteer and are voted in to confirm their willingness and community acceptance to take on this responsibility.
I'm personally willing to contribute financially to partially support a hosted platform managed by an elected committee, even if I'm not part of the committee myself. I could (and should) not do it alone though, so I expect other donations to help meet the appropriate level of support we would look to achieve.
Establishing bylaws, rules, and other governing documents would be an important next step, which I believe the committee should handle once it's formed.
You'll recall that I spoke with David (Everything author) and he encouraged me to post something on his forum. I've just done that and hope to get some feedback from folks on his forum.
Here are gbLocator images - one with the toolbar showing (low vision users) and one with the toolbar hidden (blind users).
... does this forum allow inline images or just thumbnails that are links to the full size image?
I will have to be patient!
![[Image: gbnotes.png]](http://garybeene.com/images/gbnotes.png)
![[Image: gbnotes.png]](https://garybeene.com/images/gbnotes.png)
