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 Sub

Or 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.