Goldfish Source Code (353K)
VB5 Goldfish Executable (149K)
VB6 Goldfish Exectuable (148K)
19 Dec 2002
vbAccelerator CoolMenu Toolbar and Menu controls version 3 incorporated.
XP Visual Styles implemented
Stability updates.
Subclassing Without The Crashes
Add Your App to the Systray the Easy Way
Two code only solutions for displaying Common/Dialogs
vbAccelerator No Status Bar Control
PopupMenu DLL - Create Unlimited Popup Menus
vbAccelerator Toolbar and CoolMenu Control v3.5
Sophisticated Control Over Window Sizing and Moving
vbAccelerator - Contents of code file: fAbout.frm
VERSION 5.00
Begin VB.Form frmAbout
BackColor = &H00FFFFFF&
BorderStyle = 3 'Fixed Dialog
Caption = "vbAccelerator's Goldfish"
ClientHeight = 5175
ClientLeft = 5880
ClientTop = 3450
ClientWidth = 5550
ClipControls = 0 'False
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3571.877
ScaleMode = 0 'User
ScaleWidth = 5211.736
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "OK"
Default = -1 'True
Height = 345
Left = 4140
TabIndex = 3
Top = 4620
Width = 1260
End
Begin VB.TextBox txtSpecialCopyright
Height = 675
Left = 1140
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Text = "fAbout.frx":0000
Top = 5640
Width = 4455
End
Begin VB.Shape shpRect
BorderColor = &H00C0C000&
BorderWidth = 16
Height = 855
Index = 1
Left = 180
Top = 240
Width = 855
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "vbAccelerator's"
BeginProperty Font
Name = "Tahoma"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404000&
Height = 480
Left = 1140
TabIndex = 10
Top = 120
Width = 2865
End
Begin VB.Label lblVersion
BackStyle = 0 'Transparent
Caption = "Version: 2.00"
ForeColor = &H00000000&
Height = 225
Left = 1080
TabIndex = 14
Top = 3960
Width = 1410
End
Begin VB.Line Line1
BorderColor = &H00C0C0C0&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 957.833
X2 = 5253.993
Y1 = 2691.849
Y2 = 2691.849
End
Begin VB.Image imgIcon
Height = 480
Left = 360
Picture = "fAbout.frx":00C8
Top = 420
Width = 480
End
Begin VB.Shape shpRect
BorderColor = &H000080FF&
BorderWidth = 8
Height = 675
Index = 0
Left = 4500
Top = 360
Width = 615
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Goldfish"
BeginProperty Font
Name = "Tahoma"
Size = 27.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Index = 1
Left = 1500
TabIndex = 11
Top = 480
Width = 2835
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = "Giving Your Windows Clipboard a Feeling for History."
BeginProperty Font
Name = "Tahoma"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 495
Index = 2
Left = 2100
TabIndex = 9
Top = 1080
Width = 2835
End
Begin VB.Label lblCopyright
BackStyle = 0 'Transparent
Caption = "Copyright 1998-1999 Steve McMahon "
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 195
Left = 1080
MouseIcon = "fAbout.frx":133A
MousePointer = 99 'Custom
TabIndex = 8
Tag = "/j_index_url_cright.htm.htm"
Top = 4620
Width = 3990
End
Begin VB.Label lblURL
BackStyle = 0 'Transparent
Caption = "/index.html"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 195
Left = 1080
MouseIcon = "fAbout.frx":1644
MousePointer = 99 'Custom
TabIndex = 7
Tag = "/index.html"
Top = 4800
Width = 3870
End
Begin VB.Label lblDotLine
BackStyle = 0 'Transparent
Caption = "................."
BeginProperty Font
Name = "Times New Roman"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 60
TabIndex = 6
Top = 720
Width = 2115
End
Begin VB.Label lblDotLine
BackStyle = 0 'Transparent
Caption = "................."
BeginProperty Font
Name = "Times New Roman"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 3600
TabIndex = 5
Top = 60
Width = 2235
End
Begin VB.Label lblProduct
BackStyle = 0 'Transparent
Caption = "Goldfish Home Page"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 195
Left = 1080
MouseIcon = "fAbout.frx":194E
MousePointer = 99 'Custom
TabIndex = 4
Tag =
"/s_index_url_goldfish.htm.htm"
Top = 4140
Width = 2355
End
Begin VB.Label lblDescription
BackStyle = 0 'Transparent
Caption = $"fAbout.frx":1C58
ForeColor = &H00000000&
Height = 1050
Index = 1
Left = 1080
TabIndex = 1
Top = 2640
Width = 3855
End
Begin VB.Label lblDescription
BackStyle = 0 'Transparent
Caption = $"fAbout.frx":1D5A
ForeColor = &H00000000&
Height = 810
Index = 0
Left = 1080
TabIndex = 0
Top = 1860
Width = 3885
End
Begin VB.Label lblInfo
BackColor = &H0080C0FF&
Height = 225
Index = 4
Left = 1080
TabIndex = 13
Top = 540
Width = 3885
End
Begin VB.Label lblDescription
BackColor = &H00C0E0FF&
ForeColor = &H00000000&
Height = 870
Index = 3
Left = 1080
TabIndex = 12
Top = 780
Width = 3885
End
Begin VB.Shape shpRect
BorderStyle = 0 'Transparent
FillColor = &H00C0E0FF&
FillStyle = 0 'Solid
Height = 615
Index = 2
Left = 4860
Top = 180
Width = 555
End
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal
samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "About " & App.Title
Me.Icon = frmGoldfish.Icon
lblVersion.Caption = "Version: " & App.Major & "." & Format$(App.Minor,
"00") & "." & Format$(App.Revision, "0000")
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO,
SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC,
gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Error - File Can Not Be Found...
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As
String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open
Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A
Registry Key
Dim tmpVal As String ' Tempory Storage
For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry
Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open
Registry Key
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...
tmpVal = String$(1024, 0) ' Allocate Variable
Space
KeyValSize = 1024 ' Mark Variable Size
'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key
Value
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null
Terminated String...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found,
Extract From String
Else ' WinNT Does NOT
Null Terminate String...
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found,
Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case KeyValType ' Search Data
Types...
Case REG_SZ ' String Registry
Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word
Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char.
By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double
Word To String
End Select
GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit
GetKeyError: ' Cleanup After An Error Has Occured...
KeyVal = "" ' Set Return Val To
Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function
Private Sub imgVBAccelerator_Click()
pShell "/index.html"
End Sub
Private Sub pShell(ByVal sWhat As String)
On Error Resume Next
ShellEx sWhat, , , , , Me.hwnd
If (Err.Number <> 0) Then
MsgBox "Sorry, I failed to open '" & sWhat & "' due to an error." &
vbCrLf & vbCrLf & "[" & Err.Description & "]", vbExclamation
End If
End Sub
Private Sub lblCopyright_Click()
pShell lblCopyright.Tag
End Sub
Private Sub lblProduct_Click()
pShell lblProduct.Tag
End Sub
Private Sub lblURL_Click()
pShell lblURL.Tag
End Sub
