I am trying to pass an array of fixed length strings to a function. However, the function will not know the size of the strings. The parameter should take any size strings. How would I go about this? Here is my code:
Public Type myRecord
names(15) As String * 250
End Type
Function def:
Function HasQuotes(textArr() As String) As String
End Function
Usage:
HasQuotes(rowRec.names)
where rowRec is a MyRecord.
When I run this code I get the following error Type Mismatch: array or user defined type expected. This is because the parameter is not defined as textArr() As String * 250. How can I make the parameter accept any string length?
You Have to follow Proper syntax you can Try Following updated Code
Private Type myRecord
names(15) As String * 250
End Type
Private Sub Command1_Click()
Dim rowRec As myRecord
rowRec.names(0) = ("Vaibhav")
Dim v As String
v = HasQuotes(rowRec.names)
End Sub
Function HasQuotes(ByRef textArr() As String * 250) As String
MsgBox textArr(0)
End Function
You are going to have trouble passing an array of fixed-length strings of any length. One simple solution is to convert them to an array of variable-length strings:
Private Sub Test()
Dim rowRec As myRecord
Dim names(15) As String
Dim i As Integer
Dim s As String
rowRec.names(0) = "Brian"
rowRec.names(15) = "Stafford"
'move the data to an array of variable-length strings
For i = 0 To 15
names(i) = rowRec.names(i)
Next
s = HasQuotes(names)
'move the data back to the original array if needed
For i = 0 To 15
rowRec.names(i) = names(i)
Next
End Sub
I cant understand about the difference between Function and Sub procedures in VB.NET.
The one with Function :
Private Function remainder (intno1 As Integer, intno2 As _ Integer) As Integer
Dim intresult As Integer
intresult = intno1 Mod intno2
remainder = intresult
End Function
and then by this way i call it :
Private Sub cmdrem _Click()
Dim intm As Integer, intn As Integer
Dim intmod As Integer
intm = Val (txtno1.Text)
intn = Val (txtno2.Text)
intmod = remainder (intm, intn)
lblres.text = "Answer Is = " + Str(intmod)
End Sub
would you please help me ?
some main differences between procedure and function in vb are that the function returns a value but sub procedure never returns value.
the return type must be defined in function declaration.
A function always is declared with keyword Function and a sub procedure is declared with keyword Sub.
Function ends with the keyword end function
and procedure ends with keyword end sub.
Am trying to make my vb6 app run faster, the reason is that am populating vbaccelerators sgrid with about 10k items all at once (this is a requirement from client).
I had to populate about 20 columns for each of the 10k items, and i have to perform string comparison in about more than half of them, so i wrote a string comparison function and did profiling
Function IsEqual(byval value1 as string, Byval value2 as string) as boolean
' content, various versions are below
End function
currently the items = 5000 and each of the time below shows the time it took and various versions of the function:
LCase$(Value1) = LCase$(value2)
time: 29149 ms
(StrComp(Value1, value2, 1) = 0 )
time: 30836 ms
If StrComp(Value1, value2, 1) = 0 Then
IsEqual = True
Else
IsEqual = False
End If
time 34180 ms
If StrComp(Value1, value2, 1) = 0 Then IsEqual = True
time 28387 ms
Timing is done with:
Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Declare Function timeGetTime Lib "winmm.dll" () As Long
which returns the time in milliseconds.
Is there anyway to make the comparison faster?
Things that might improve performance include..
Change your parameters to ByRef
Using ByVal parameters copies the variables onto the stack. While this is a generally a good idea, if your comparison function is well-behaved and doesn't change the variables, making an extra copy of the data is not necessary.
Populate the grid on demand,
Only populate the parts of the grid that are showing on screen - track this with grid movement events. There are even grid controls for VB6 that facilitate this by letting you define "virtual" items and raising events to let you know which ones you need to populate. TList is the one I'm familiar with - I'll temper that suggestion with the caveat that it's licensing model can be a real PITA to work with.
This should be pretty fast.
Option Explicit
Private Declare Sub DerefByte Lib "msvbvm60" Alias "GetMem1" (ByVal Add As Long, ByRef Value As Byte)
Private Declare Sub DerefLong Lib "msvbvm60" Alias "GetMem4" (ByVal Add As Long, ByRef Value As Long)
Private Sub Form_Load()
Debug.Print IsEqual("Hello", "hello")
Debug.Print IsEqualB("Hello", "hello")
End Sub
Public Function IsEqualB(Str1 As String, Str2 As String) As Boolean
Dim lpS1 As Long, lpS2 As Long
Dim t1 As Byte, t2 As Byte
Dim lSz As Long
Dim i As Long
IsEqualB = True
lpS1 = StrPtr(Str1)
lpS2 = StrPtr(Str2)
DerefLong lpS1 - 4, lSz
If lSz = LenB(Str2) Then
For i = 0 To lSz - 1 Step 2
DerefByte lpS1 + i, t1
DerefByte lpS2 + i, t2
If Not (t1 = t2) Then
IsEqualB = False
Exit For
End If
Next
Else
IsEqualB = False
End If
End Function
Public Function IsEqual(Str1 As String, Str2 As String) As Boolean
Dim lpS1 As Long, lpS2 As Long
Dim t1 As Byte, t2 As Byte
Dim lSz As Long
Dim i As Long
IsEqual = True
lpS1 = StrPtr(Str1)
lpS2 = StrPtr(Str2)
DerefLong lpS1 - 4, lSz
If lSz = LenB(Str2) Then
For i = 0 To lSz - 1 Step 2
DerefByte lpS1 + i, t1
DerefByte lpS2 + i, t2
If Not (t1 Or &H20) = (t2 Or &H20) Then
IsEqual = False
Exit For
End If
Next
Else
IsEqual = False
End If
End Function
The basic premise here is to do byte by byte comparison mod 2 over the Unicode strings. One of the above functions is case sensitive, IsEqualB, then other is insensitive IsEqual.
Of course, it uses a couple of undocumented functions in the Visual Basic 6 runtime: but if you want speed, that's what you have to do, unfortunately.
Have you tried:
Function IsEqual(byval value1 as string, Byval value2 as string) as boolean
Return StrComp(LCase$(Value1), LCase$(value2), vbBinaryCompare) = 0
End function
You can probably cut your execution time in half by using "OPTION COMPARE TEXT". Place this line at the top of your code module.
OPTION COMPARE TEXT
This line, when used, will cause string compare within the code module be case insensitive. Because of this, you can simply use:
Function IsEqual(byval value1 as string, Byval value2 as string) as boolean
IsEqual = (Value1 = Value2)
End Function
look at the LockWindowUpdate() WinAPI call. This can really help grids when you are populating them . Make sure you call it once to lock the window and once to unlock it.
I'm extremely unfamiliar with VB6 so please excuse the rookie question:
I'm attempting to turn a long into it's component bytes. In C it is simple because of the automatic truncation and the bitshift operators. For the life of me I cannot figure out how to do this in VB6.
Attempts so far have all generally looked something like this
sys1 = CByte(((sys & &HFF000000) / 16777216)) ' >> 24
sys2 = CByte(((sys & &HFF0000) / 65536)) ' >> 16
sys1 and sys2 are declared as Byte and sys is declared as Long
I'm getting a type mismatch exception when I try to do this. Anybody know how to convert a Long into 4 Bytes ??
Thanks
You divide correctly, but you forgot to mask out only the least significant bits.
Supply the word you want to divide into bytes, and the index (0 is least significant, 1 is next, etc.)
Private Function getByte(word As Long, index As Integer) As Byte
Dim lTemp As Long
' shift the desired bits to the 8 least significant
lTemp = word / (2 ^ (index * 8))
' perform a bit-mask to keep only the 8 least significant
lTemp = lTemp And 255
getByte = lTemp
End Function
Found on FreeVBCode.com. Not tested, sorry.
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal _
Length As Long)
Public Function LongToByteArray(ByVal lng as Long) as Byte()
'Example:
'dim bytArr() as Byte
'dim iCtr as Integer
'bytArr = LongToByteArray(90121)
'For iCtr = 0 to Ubound(bytArr)
'Debug.Print bytArr(iCtr)
'Next
'******************************************
Dim ByteArray(0 to 3)as Byte
CopyMemory ByteArray(0), Byval VarPtr(Lng),Len(Lng)
LongToByteArray = ByteArray
End Function
You can convert between simple value types and Byte arrays by combining UDTs and the LSet statement.
Option Explicit
Private Type DataBytes
Bytes(3) As Byte
End Type
Private Type DataLong
Long As Long
End Type
Private DB As DataBytes
Private DL As DataLong
Private Sub cmdBytesToLong_Click()
Dim I As Integer
For I = 0 To 3
DB.Bytes(I) = CByte("&H" & txtBytes(I).Text)
Next
LSet DL = DB
txtLong.Text = CStr(DL.Long)
txtBytes(0).SetFocus
End Sub
Private Sub cmdLongToBytes_Click()
Dim I As Integer
DL.Long = CLng(txtLong.Text)
LSet DB = DL
For I = 0 To 3
txtBytes(I).Text = Right$("0" & Hex$(DB.Bytes(I)), 2)
Next
txtLong.SetFocus
End Sub
I'd like to store the contents of a data structure, a few arrays, and a dozen or so variables in a file that can be saved and reloaded by my software as well as optionally edited in a text editor by a user reloaded. For the text editing, I need the data to be clearly labeled, like in a good ole .ini file:
AbsMaxVoltage = 17.5
There's a GUI, and one could argue that the user should just load and save and modify from the GUI, but the customer wants to be able to read and modify the data as text.
It's easy enough to write code to save it and reload it (assuming all the labels are in the same place and only the data has changed). With more work (or using some of the INI R/W code that's already out there I could pay attention to the label so if a line gets deleted or moved around the variables still get stuffed correctly, but both of these approaches seem pretty old-school. So I'm interested in how the brightest minds in programming would approach this today (using decade-old VB6 which I have to admit I still love).
Disclaimer: I'm an electrical engineer, not a programmer. This isn't my day job. Well maybe it's a few % of my day job.
Cheers!
Lots of people will recommend XML to you. The problem is XML is still so trendy, some people use it everywhere without really thinking about it.
Like Jeff Atwood said, it's hard for non-programmers to read XML and particularly to edit it. There are too many rules, like escaping special characters and closing the tags in the correct order. Some experts recommend you treat XML as a binary format, not a text format at all.
I recommend using INI files, provided the maximum size limit of 32K is not a problem. I've never reached that limit in many similar situations in my own VB6. INI files are easy for ordinary folk to edit, and it's easy to read and write them from VB6. Just use some of the excellent drop-in code freely available on the web.
I'm sure the class Jay Riggs
provided in his answer is excellent, because
it's from VBAccelerator.
I would also recommend this class,
because anything by Karl Peterson
will be excellent too.
A couple of other points to think about:
Have you considered which directory to put the files into?
You mentioned "Unicode-friendly" in the question. INI files aren't Unicode, but that doesn't matter in practise. Unless you want to store characters that aren't supported on the current code page - like Chinese on an English computer - an unusual requirement, and one that will cause you other problems in a VB6 program anyway.
Legendary Windows guru Raymond Chen described the advantages of XML configuration files over INI files. Many of them rely on the XML file being read-only. The one legitimate advantage is if the data is highly structured - class heirarchies or the like. From your description that doesn't apply.
Consider using XML. It's completely standard, many text editors will highlight/manage it properly, every programming language and script language on Earth has good support for reading it, and it handles Unicode perfectly.
For simple name/value pairs as you suggest, it's quite readable. But you have the added advantage that if someday you need something more complex -- e.g. multi-lined values or a list of distinct values -- XML provides natural, easy ways of representing that.
P.S. Here's how to read XML in VB6.
Back in the olden days this class helped me use INI files with my VB6 programs:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cInifile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' =========================================================
' Class: cIniFile
' Author: Steve McMahon
' Date : 21 Feb 1997
'
' A nice class wrapper around the INIFile functions
' Allows searching,deletion,modification and addition
' of Keys or Values.
'
' Updated 10 May 1998 for VB5.
' * Added EnumerateAllSections method
' * Added Load and Save form position methods
' =========================================================
Private m_sPath As String
Private m_sKey As String
Private m_sSection As String
Private m_sDefault As String
Private m_lLastReturnCode As Long
#If Win32 Then
' Profile String functions:
Private Declare Function WritePrivateProfileString Lib "KERNEL32" Alias
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As
Long
Private Declare Function GetPrivateProfileString Lib "KERNEL32" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal
lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As
String, ByVal nSize As Long, ByVal lpFileName As String) As Long
#Else
' Profile String functions:
Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal
lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As
Any, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal
lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As
Any, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal
lpFileName As String) As Integer
#End If
Property Get LastReturnCode() As Long
LastReturnCode = m_lLastReturnCode
End Property
Property Get Success() As Boolean
Success = (m_lLastReturnCode <> 0)
End Property
Property Let Default(sDefault As String)
m_sDefault = sDefault
End Property
Property Get Default() As String
Default = m_sDefault
End Property
Property Let Path(sPath As String)
m_sPath = sPath
End Property
Property Get Path() As String
Path = m_sPath
End Property
Property Let Key(sKey As String)
m_sKey = sKey
End Property
Property Get Key() As String
Key = m_sKey
End Property
Property Let Section(sSection As String)
m_sSection = sSection
End Property
Property Get Section() As String
Section = m_sSection
End Property
Property Get Value() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer
sBuf = Space$(255)
iSize = Len(sBuf)
iRetCode = GetPrivateProfileString(m_sSection, m_sKey, m_sDefault, sBuf,
iSize, m_sPath)
If (iSize > 0) Then
Value = Left$(sBuf, iRetCode)
Else
Value = ""
End If
End Property
Property Let Value(sValue As String)
Dim iPos As Integer
' Strip chr$(0):
iPos = InStr(sValue, Chr$(0))
Do While iPos <> 0
sValue = Left$(sValue, (iPos - 1)) & Mid$(sValue, (iPos + 1))
iPos = InStr(sValue, Chr$(0))
Loop
m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, sValue,
m_sPath)
End Property
Public Sub DeleteKey()
m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, 0&,
m_sPath)
End Sub
Public Sub DeleteSection()
m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, 0&, m_sPath)
End Sub
Property Get INISection() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer
sBuf = Space$(8192)
iSize = Len(sBuf)
iRetCode = GetPrivateProfileString(m_sSection, 0&, m_sDefault, sBuf, iSize,
m_sPath)
If (iSize > 0) Then
INISection = Left$(sBuf, iRetCode)
Else
INISection = ""
End If
End Property
Property Let INISection(sSection As String)
m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, sSection,
m_sPath)
End Property
Property Get Sections() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer
sBuf = Space$(8192)
iSize = Len(sBuf)
iRetCode = GetPrivateProfileString(0&, 0&, m_sDefault, sBuf, iSize, m_sPath)
If (iSize > 0) Then
Sections = Left$(sBuf, iRetCode)
Else
Sections = ""
End If
End Property
Public Sub EnumerateCurrentSection(ByRef sKey() As String, ByRef iCount As Long)
Dim sSection As String
Dim iPos As Long
Dim iNextPos As Long
Dim sCur As String
iCount = 0
Erase sKey
sSection = INISection
If (Len(sSection) > 0) Then
iPos = 1
iNextPos = InStr(iPos, sSection, Chr$(0))
Do While iNextPos <> 0
sCur = Mid$(sSection, iPos, (iNextPos - iPos))
If (sCur <> Chr$(0)) Then
iCount = iCount + 1
ReDim Preserve sKey(1 To iCount) As String
sKey(iCount) = Mid$(sSection, iPos, (iNextPos - iPos))
iPos = iNextPos + 1
iNextPos = InStr(iPos, sSection, Chr$(0))
End If
Loop
End If
End Sub
Public Sub EnumerateAllSections(ByRef sSections() As String, ByRef iCount As
Long)
Dim sIniFile As String
Dim iPos As Long
Dim iNextPos As Long
Dim sCur As String
iCount = 0
Erase sSections
sIniFile = Sections
If (Len(sIniFile) > 0) Then
iPos = 1
iNextPos = InStr(iPos, sIniFile, Chr$(0))
Do While iNextPos <> 0
If (iNextPos <> iPos) Then
sCur = Mid$(sIniFile, iPos, (iNextPos - iPos))
iCount = iCount + 1
ReDim Preserve sSections(1 To iCount) As String
sSections(iCount) = sCur
End If
iPos = iNextPos + 1
iNextPos = InStr(iPos, sIniFile, Chr$(0))
Loop
End If
End Sub
Public Sub SaveFormPosition(ByRef frmThis As Object)
Dim sSaveKey As String
Dim sSaveDefault As String
On Error GoTo SaveError
sSaveKey = Key
If Not (frmThis.WindowState = vbMinimized) Then
Key = "Maximised"
Value = (frmThis.WindowState = vbMaximized) * -1
If (frmThis.WindowState <> vbMaximized) Then
Key = "Left"
Value = frmThis.Left
Key = "Top"
Value = frmThis.Top
Key = "Width"
Value = frmThis.Width
Key = "Height"
Value = frmThis.Height
End If
End If
Key = sSaveKey
Exit Sub
SaveError:
Key = sSaveKey
m_lLastReturnCode = 0
Exit Sub
End Sub
Public Sub LoadFormPosition(ByRef frmThis As Object, Optional ByRef lMinWidth =
3000, Optional ByRef lMinHeight = 3000)
Dim sSaveKey As String
Dim sSaveDefault As String
Dim lLeft As Long
Dim lTOp As Long
Dim lWidth As Long
Dim lHeight As Long
On Error GoTo LoadError
sSaveKey = Key
sSaveDefault = Default
Default = "FAIL"
Key = "Left"
lLeft = CLngDefault(Value, frmThis.Left)
Key = "Top"
lTOp = CLngDefault(Value, frmThis.Top)
Key = "Width"
lWidth = CLngDefault(Value, frmThis.Width)
If (lWidth < lMinWidth) Then lWidth = lMinWidth
Key = "Height"
lHeight = CLngDefault(Value, frmThis.Height)
If (lHeight < lMinHeight) Then lHeight = lMinHeight
If (lLeft < 4 * Screen.TwipsPerPixelX) Then lLeft = 4 *
Screen.TwipsPerPixelX
If (lTOp < 4 * Screen.TwipsPerPixelY) Then lTOp = 4 * Screen.TwipsPerPixelY
If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
lLeft = Screen.Width - 4 * Screen.TwipsPerPixelX - lWidth
If (lLeft < 4 * Screen.TwipsPerPixelX) Then lLeft = 4 *
Screen.TwipsPerPixelX
If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
lWidth = Screen.Width - lLeft - 4 * Screen.TwipsPerPixelX
End If
End If
If (lTOp + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
lTOp = Screen.Height - 4 * Screen.TwipsPerPixelY - lHeight
If (lTOp < 4 * Screen.TwipsPerPixelY) Then lTOp = 4 *
Screen.TwipsPerPixelY
If (lTOp + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
lHeight = Screen.Height - lTOp - 4 * Screen.TwipsPerPixelY
End If
End If
If (lWidth >= lMinWidth) And (lHeight >= lMinHeight) Then
frmThis.Move lLeft, lTOp, lWidth, lHeight
End If
Key = "Maximised"
If (CLngDefault(Value, 0) <> 0) Then
frmThis.WindowState = vbMaximized
End If
Key = sSaveKey
Default = sSaveDefault
Exit Sub
LoadError:
Key = sSaveKey
Default = sSaveDefault
m_lLastReturnCode = 0
Exit Sub
End Sub
Public Function CLngDefault(ByVal sString As String, Optional ByVal lDefault As
Long = 0) As Long
Dim lR As Long
On Error Resume Next
lR = CLng(sString)
If (Err.Number <> 0) Then
CLngDefault = lDefault
Else
CLngDefault = lR
End If
End Function
Would and XML file be acceptable:-
<config>
<someAppPart
AbsMaxVoltage="17.5"
AbsMinVoltage="5.5"
/>
<someOtherAppPart
ForegroundColor="Black"
BackgroundColor="White"
/>
</config>
Its very easy to consume in VB6, you don't need to worry about positioning etc.
The downside is its the user tweaking it can make it unparsable, however thats true if you write your own parser for a config file.
If we can assume your saved settings are simply a set of name/value pairs without a two-level hierarchy requirement (i.e. INI "Keys" within "Sections") you might just persist them as such:
AbsMaxVoltage=17.5
AbsMinVoltage=5.5
For writing the persistence format this is a case where you might consider the FSO, since the access volume is low anyway. The FSO can handle read/writing Unicode text files.
I think I'd do something like read lines and parse them using a Split() on "=" specifying just 2 parts (thus allowing "=" within values as well). For loading these I'd store them into a simple Class instance where the Class has two properties (Name and Value) and add each one to a Collection using Name as the Key. Make Value the default property if desired.
Maybe even implement some form of comment text line too using a generated sequence-numbered special Name value stored as say Name="%1" Value="comment text" with generated unique Names to avoid Collection Key collisions. Blank lines might be similarly preserved.
Then persisting as necessary means simply using a For Each on the Collection and using the FSO to write Name=Value out to disk.
To simulate a hierarchy you could simply use Names like:
%Comment: somAppPart settings
someAppPart.AbsMaxVoltage=17.5
someAppPart.AbsMinVoltage=5.5
%someOtherPart settings
someOtherAppPart.ForegroundColor=Black
someOtherAppPart.BackgroundColor=White
The parsing is cheap, so any probing of the Collection might be preceded by a full reparse (as the INI API calls do). Any changing of values in the program might do a full rewrite to disk (like the INI API calls do).
Some of this can be automated by just wrapping the Collection with some logic in another Class. The result could be syntax like:
Settings("someOtherAppPart", "ForegroundColor") = "Red"
aka
Settings.Value("someOtherAppPart", "ForegroundColor") = "Red"
This would reload the Collection, then probe the Collection for an Item keyed "someOtherAppPart.ForegroundColor" and create it or set its Value to "Red" and then flush the Collection to disk. Or you might eschew frequent rewriting and use distinct Load and Save methods.
Make it as simple or fancy as desired.
In any case, the result is a text file users can hack at with Notepad. The only reason for the FSO is to have an easy way of read/writing Unicode text. One could also screw around with Byte array I/O and explicit conversions (array to String) and line level parsing as required to avoid the FSO. If so just don't forget about the UTF-16LE BOM.