Visual Basic 6 Problem
Miscellaneous Forums/General Discussion/Visual Basic 6 Problem
Hi, i am currently working on a project for my advanced higher course, i am currently having some problems with passing a varialbe in a procedure to sort a list, the program is an address book, it uses a type 'contact' with fields like first_name, Last_name etc... On the form i am using a combo box to list these fields but in the form of text, and in the procedure for sorting i call in the text in this combo box to go in place of the varaible field:
call sort(contacts(), com_field.text, ...)
sub sort(contact_arr() as contact, Field as string, ...)
....
Contact(group,Contactnum).Field
...
This is passed into the procedure as a string, but it does not work, does anyone know how i can pass a type field as a parameter in a procedure?
Thanks
You have me a bit confused on what you are doing but...
type Contact
first_name as string
last_name as string
text as string
end type
dim contact_arr(20) as contact
contact_arr(1).text = "text 1"
contact_arr(1).first_name = "First Name 1"
contact_arr(1).last_name = "Last Name 1"
call dostuff(contact_ARR(),contact_arr(1).text)
sub dostuff(contact_arr() as contact, l_field as string)
...
end sub
(I forgot the exact type syntax, but the rest should be correct)
You don't really need to pass the element as this will be accessible via the array - just pass the index of the record you are interested in:
Private Sub Main()
With contact_arr(1)
.text = "text 1"
.first_name = "First Name 1"
.last_name = "Last Name 1"
End With
Call dostuff(contact_arr(), 1)
End Sub
Private Sub dostuff(ByRef TempArray() As Contact, ByVal Index As Long)
Dim TempString As String
TempString = TempArray(Index).text
' do whatever you want with it here...
End SubOr if you prefer you could pass a copy of the record:
Call dostuff(contact_arr(), contact_arr(1).text)
Private Sub dostuff(ByRef TempArray() As Contact, ByVal TempString As string)
' do whatever you want with it here...
End Sub
Either way you need to be careful when passing parameters ByRef instead of ByVal. In dynaman's example (and the first parameter in mine) you would not be passing actual values, but pointers to each (since ByRef is the default mode). This could cause you problems when you point to a whole array in one parameter, and an element of the same array in another - particularly if you plan to sort the array within the procedure...
Ok, thats not realy what i'm trying to achieve, i'll try and explain it abit better:
ok i have the type contact as so:
type contact
first_name as string
last_name as string
etc...
end type
my form that i will be using the procedure on has a combobox, in this combo box it lists text:
'First_name'
'Last_Name'
etc...
The sorting proedure i have writen should work something like so:
sub sort_contacts(byref contacts as contact, byval field as field type)
for tmp = 1 to totcontacts
if contacts(tmp).field > contacts(tmp+1).field then
tmp2 = contacts(tmp)
contacts(tmp) = contacts(tmp+1)
contacts(tmp+1) = tmp2
endif
next
end sub
the procedure would be call as so:
call sort_contacts(contacts(), com_Fields.text)
but i dont know how to do this, at the moment field is defined as a string, so say i select First_name in the combo box, i would then put field as 'First_name' which is the same as the field name in type contact, what the procedure tries to do is put the variable field as a string the put it in as the field on contacts(tmp).field as you can probably see, but it doesn't work. can anyone see how to do this properly the way i'm trying.
thanks
Ah - now I see: you want to sort your contacts array by whatever field the user selects via the combo? Hmmm. First problem is that your sort code is totally wrong. There are several methods you could use, but the following should do what you want:
Option Explicit
Type Contact
first_name As String
last_name As String
text As String
sort_key As String
End Type
Dim contact_arr(20) As Contact
Private Sub Main()
With contact_arr(1)
.text = "text 1"
.first_name = "First Name 1"
.last_name = "Last Name 1"
End With
Call SortContacts(contact_arr())
End Sub
Private Sub SortContacts(ArrayList() As Contact)
Dim SortType As Long
Dim k As Long
SortType = Form1.Combo1.ListIndex
For k = 0 To UBound(ArrayList)
Select Case SortType
Case 0 ' whatever your 1st dropdown entry is: eg. first_name
ArrayList(k).sort_key = ArrayList(k).first_name
Case 1 ' whatever your 2nd dropdown entry is: eg. last_name
ArrayList(k).sort_key = ArrayList(k).last_name
' add other Case statements for each field - ordered to match the combo dropdown list
End Select
Next k
Call QuickSortContacts(contact_arr(), 0, UBound(contact_arr))
End Sub
Private Sub QuickSortContacts(ArrayList() As Contact, ALbound As Long, AUbound As Long)
Dim ArrayMid As Contact
Dim ArrayBuffer As Contact
Dim CurLow As Long
Dim CurHigh As Long
Dim CurMidpoint As Long
If AUbound > ALbound Then
CurLow = ALbound
CurHigh = AUbound
CurMidpoint = (ALbound + AUbound) \ 2
ArrayMid = ArrayList(CurMidpoint)
Do While (CurLow <= CurHigh)
Do While ArrayList(CurLow).sort_key < ArrayMid.sort_key
CurLow = CurLow + 1
If CurLow = AUbound Then
Exit Do
End If
Loop
Do While ArrayMid.sort_key < ArrayList(CurHigh).sort_key
CurHigh = CurHigh - 1
If CurHigh = ALbound Then
Exit Do
End If
Loop
If (CurLow <= CurHigh) Then
ArrayBuffer = ArrayList(CurLow)
ArrayList(CurLow) = ArrayList(CurHigh)
ArrayList(CurHigh) = ArrayBuffer
CurLow = CurLow + 1
CurHigh = CurHigh - 1
End If
Loop
If ALbound < CurHigh Then
Call QuickSortContacts(ArrayList(), ALbound, CurHigh)
End If
If CurLow < AUbound Then
Call QuickSortContacts(ArrayList(), CurLow, AUbound)
End If
End If
End Sub
As you can see I have added field 'sort_key' to your Contact type, and populate this using your ComboBox's ListIndex value via subroutine SortContacts (obviously you will need to change 'Form1.Combo1.ListIndex' accordingly!!). I then call QuickSortContacts which sorts the array based on whatever value is stored in field 'sort_key'.
Let me know if you need any more help.
Ok, i think i've pretty much adapted your concept to my coding, only having one problem know and that that i get an error 'subscript out of range' when the highlighted error gives:
contacts(tmp(0)).sort_key = <subscript out of range>
i get this error when doing the select case sorttype, i'm not sure why here the code:
Sub Sort_contacts(ByRef Contacts() As Contact, ByVal Method As String, ByVal field As String, ByRef comparisions As Integer)
comparisions = 0
sort_type = Form1.Comfield(0).ListIndex
For tmp(0) = 1 To TotContacts
Select Case sort_type
Case 0
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).First_Name
Case 1
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Last_Name
Case 2
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Add_Line1
Case 3
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Add_Line2
Case 4
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Add_Line3
Case 5
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Post_code
Case 6
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Tel
Case 7
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Mob
Case 8
Contacts(tmp(0)).Sort_key = Contacts(tmp(0)).Email
End Select
Next
Select Case Method
Case "simple"
For OUTER = 1 To TotContacts
For INNER = OUTER + 1 To TotContacts
If Contacts(Group, OUTER).Sort_key > Contacts(Group, INNER).Sort_key Then
tmp2 = Contacts(Group, OUTER)
Contacts(Group, OUTER) = Contacts(Group, INNER)
Contacts(Group, INNER) = tmp2
End If
comparisions = comparisions + 1
'sortprog.Value = (100 / UBound(Contacts())) + Comparisons
Next
Next
Case "bubble"
FLAG = True
Do While FLAG
FLAG = False
For Counter = 0 To TotContacts - 1
If Contacts(Group, Counter).Sort_key > Contacts(Group, Counter + 1).Sort_key Then
tmp2 = Contacts(Group, Counter)
Contacts(Group, Counter) = Contacts(Group, Counter + 1)
Contacts(Group, Counter + 1) = tmp2
FLAG = True
End If
comparisions = comparisions + 1
'sortprog.Value = (100 / UBound(Contacts())) + Comparisons
Next
Loop
End Select
End Sub
i've declared all the varialbe types correctly, what could be the problem?
Thanks
sorry problem solved, thanks for the help with the sorting.
Ok, i have one more question, i keep getting an error when trying to write to file: the error is run-time error '59' - bad record length, can anyone explain why i would get this error, from what i have in my code there is nothing wrong with my method not even to my teacher. thanks
Sorry Kain - can't even begin to suggest what is going wrong without the offending code. If you could copy & paste the routine(s) causing the error then maybe we can help...
ok I've sorted that problem, i'm now trying to make an option for printing a contacts details (these are all displaying in different text boxes) only problem is that i don't know how to print, i'm using the common dialog box for printing but i can't find any good/basic tutorials for printing. can anyone help. thanks
It's been a while, and I don't have my books here. But look in the VB help for "Printer object"
it may be as simple as printer.print if I remember correctly.
yea, i've looked at some of the msdn docs and it is something like that, the problem is that the printer i'm trying to access in on a network, i think that is the problem but don't have any idea of sorting that.
Dynaman is right - the printer object has methods similar to those of forms and pictureboxes - but I assume as you've looked at the msdn docs you know that already. For accessing network printers you need to work with the 'Printers Collection'. There are loads of examples on how to do this on the web (and some pretty concise information in the VB help system itself). Google 'vb planet source code' and have a look on there.
Becareful about the printer object if you're doing drawing commands (i.e. treating it like a plotter by drawing directly to specific X/Y positions).
If I re-call, it doesn't take the printer driver into consideration and just issues a command directly to the printer.
This means whatever you print on your printer may not looks the same on someone elses.
The GetDeviceCaps API will return all information required to calculate the printable area of the current printer object. You will need to call the API for each parameter you are interested in:
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Type PRINTERAREA
DpiX As Long ' Horizontal Resolution
DpiY As Long ' Vertical Resolution
Height As Long ' Printer.Height equivalent
Width As Long ' Printer.Width equivalent
Left As Long ' Left Gutter Margin
Top As Long ' Top Gutter Margin
HorRes As Long ' Printable Width (MM)
VerRes As Long ' Printable Height (MM)
HorSize As Long ' Paper Width (MM)
VerSize As Long ' Paper Height (MM)
End Type
Const PHYSICALWIDTH = 110
Const PHYSICALHEIGHT = 111
Const PHYSICALOFFSETX = 112
Const PHYSICALOFFSETY = 113
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const HORZRES = 8
Const HORZSIZE = 4
Const VERTRES = 10
Const VERTSIZE = 6
Const IFACT = 1440 'Inch to Twip Factor
Public Prt_Area As PRINTERAREA
' load current settings into structure
Call GetPrintArea
Private Sub GetPrintArea()
With Prt_Area
.DpiX = GetDeviceCaps(Printer.hdc, LOGPIXELSX)
.DpiY = GetDeviceCaps(Printer.hdc, LOGPIXELSY)
.Left = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX) / .DpiX * IFACT
.Top = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY) / .DpiY * IFACT
.Width = GetDeviceCaps(Printer.hdc, PHYSICALWIDTH) / .DpiX * IFACT
.Height = GetDeviceCaps(Printer.hdc, PHYSICALHEIGHT) / .DpiY * IFACT
.HorRes = GetDeviceCaps(Printer.hdc, HORZRES) / .DpiX * IFACT
.VerRes = GetDeviceCaps(Printer.hdc, VERTRES) / .DpiY * IFACT
.HorSize = GetDeviceCaps(Printer.hdc, HORZSIZE)
.VerSize = GetDeviceCaps(Printer.hdc, VERTSIZE)
End With
End Sub
You must call this every time the user changes the current printer (the simplest way to do this is to call it every time you start a new print job). You can then offset all your drawing/text calls with the appropriate left/top margins as you send them to the printer, thus ensuring your printout looks the same on every device.