VPF::Помогите написать программу! - Форум программистов

Marisha

Дата 17.1.2004, 10:24 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

О каждой из 12 отраслей известно: название, общее количество работников, занятых в ней и количество человек, работающих во вредных условиях. Определить отрасли, в которых процент работающих во вредных условиях больше среднего по всем отраслям, расположив список отраслей в порядке возрастания процента.

Заранее благодарная!!!

Vach

Дата 17.1.2004, 14:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 304
Регистрация: 17.10.2003
Где: Санкт-Петербург

Репутация: 8
Всего: 18

Создай новый проект

На форму помести TextBox
Установи MultiLine = True, ScrollBars = 2 - Vertical и растяни его на всю форму (чтобы лучше видеть)

В код Form1 помести текст:

Код

Option Explicit
Private mR          As New mRecord
Private average     As Integer
Private T           As TextBox

Private Sub Form_Load()

  Dim localCRec As New cRec

    Set T = Text1
    T.Text = ""
    With localCRec
        .Branch_Name = "a1"
        .Harmful_conditions = 23
        .Quantity_of_workers = 12
        mR.Add_Last localCRec
        .Branch_Name = "a2"
        .Harmful_conditions = 45
        .Quantity_of_workers = 2
        mR.Add_Last localCRec
        .Branch_Name = "a3"
        .Harmful_conditions = 344
        .Quantity_of_workers = 45
        mR.Add_Last localCRec
        .Branch_Name = "a4"
        .Harmful_conditions = 64
        .Quantity_of_workers = 63
        mR.Add_Last localCRec
        .Branch_Name = "a5"
        .Harmful_conditions = 222
        .Quantity_of_workers = 5
        mR.Add_Last localCRec
        .Branch_Name = "a6"
        .Harmful_conditions = 238
        .Quantity_of_workers = 78
        mR.Add_Last localCRec
        .Branch_Name = "a7"
        .Harmful_conditions = 243
        .Quantity_of_workers = 47
        mR.Add_Last localCRec
        .Branch_Name = "a8"
        .Harmful_conditions = 123
        .Quantity_of_workers = 12
        mR.Add_Last localCRec
        .Branch_Name = "a9"
        .Harmful_conditions = 923
        .Quantity_of_workers = 0
        mR.Add_Last localCRec
        .Branch_Name = "a10"
        .Harmful_conditions = 223
        .Quantity_of_workers = 5
        mR.Add_Last localCRec
        .Branch_Name = "a11"
        .Harmful_conditions = 31
        .Quantity_of_workers = 22
        mR.Add_Last localCRec
        .Branch_Name = "a12"
        .Harmful_conditions = 911
        .Quantity_of_workers = 120
        mR.Add_Last localCRec
    End With
    
    PrintRec "Список отраслей в предоставленной последовательности", T, mR
    Calculate_average_Quantity mR, average
    PrintText "Средний процент по отраслям: " & average, T
    Calculate_average_QuantityProcent mR, average
    Sort mR
    PrintSort "Список отраслей отсортированный в порядке возрастания процента", T, mR

End Sub

Добавь модуль с именем «myModule» и помести туда текст

Код

Option Explicit

Public Sub Calculate_average_Quantity(recColl As mRecord, _
                                      average As Integer)

  Dim nSumm1 As Double
  Dim nSumm2 As Double

    recColl.MoveFirst
    Do
        With recColl
            nSumm1 = nSumm1 + .item.Quantity_of_workers
            nSumm2 = nSumm2 + .item.Harmful_conditions
            .MoveNext
        End With
        DoEvents
    Loop While Not recColl.cCurent.NextCell Is Nothing
    average = (nSumm1 * 100) / nSumm2

End Sub

Public Sub Calculate_average_QuantityProcent(recColl As mRecord, _
                                             ByVal average As Integer)

    recColl.MoveFirst
    Do
        recColl.item.QuantityProcent = (recColl.item.Quantity_of_workers * 100) / recColl.item.Harmful_conditions
        recColl.MoveNext
        DoEvents
    Loop While Not recColl.cCurent.NextCell Is Nothing

End Sub

Public Sub PrintRec(ByVal sTitle As String, _
                    conText As TextBox, _
                    recColl As mRecord)

    recColl.MoveFirst
    conText = conText & "Title: " & sTitle & vbCrLf
    conText = conText & vbCrLf
    Do
        With recColl
            conText = conText & "Branch Name: " & .cCurent.Value.Branch_Name & vbCrLf
            conText = conText & "Harmful conditions: " & .cCurent.Value.Harmful_conditions & vbCrLf
            conText = conText & "Quantity of workers: " & .cCurent.Value.Quantity_of_workers & vbCrLf
            conText = conText & "Quantity(%): " & .cCurent.Value.QuantityProcent & vbCrLf
        End With
        conText = conText & vbCrLf
        recColl.MoveNext
    Loop While Not recColl.cCurent.NextCell Is Nothing

End Sub

Public Sub PrintSort(ByVal sTitle As String, _
                     conText As TextBox, _
                     recColl As mRecord)

    Set recColl.cCurent = recColl.cFirstSort
    conText = conText & "Title: " & sTitle & vbCrLf
    conText = conText & vbCrLf
    Do
        Set recColl.cCurent = recColl.cCurent.NextSort
        DoEvents
        With recColl
            conText = conText & "Branch Name: " & .cCurent.Value.Branch_Name & vbCrLf
            conText = conText & "Harmful conditions: " & .cCurent.Value.Harmful_conditions & vbCrLf
            conText = conText & "Quantity of workers: " & .cCurent.Value.Quantity_of_workers & vbCrLf
            conText = conText & "Quantity(%): " & .cCurent.Value.QuantityProcent & vbCrLf
        End With
        conText = conText & vbCrLf
    Loop While Not recColl.cCurent.NextSort Is Nothing

End Sub

Public Sub PrintText(ByVal sTitle As String, _
                     conText As TextBox)

    conText = conText & "Title: " & sTitle & vbCrLf
    conText = conText & vbCrLf

End Sub

Public Sub Sort(recColl As mRecord)

  Dim LocMin       As Integer
  Dim LocMax       As Integer
  Dim LocVal       As Integer
  Dim nCount       As Integer
  Dim new_cFirst   As New Cel
  Dim new_cCurents As Cel

  Dim locArr()     As Cel
    LocMin = 100
    LocMax = 0
    recColl.MoveFirst
    Do
        LocVal = recColl.item.QuantityProcent
        If LocVal > LocMax Then
            LocMax = LocVal
        End If
        If LocVal < LocMin Then
            LocMin = LocVal
        End If
        recColl.MoveNext
    Loop While Not recColl.cCurent.NextCell Is Nothing
    ReDim locArr(LocMin To LocMax)
    recColl.MoveFirst
    Do
        With recColl
            Set .cCurent.NextSort = locArr(.item.QuantityProcent)
            Set locArr(.item.QuantityProcent) = .cCurent
            .MoveNext
        End With
    Loop While Not recColl.cCurent.NextCell Is Nothing
    Set new_cFirst.NextSort = locArr(LocMin)
    Set new_cCurents = new_cFirst
    Set recColl.cFirstSort = new_cFirst
    For nCount = LocMin To LocMax
        If Not locArr(nCount) Is Nothing Then
            Set new_cCurents.NextSort = locArr(nCount)
            Set new_cCurents = new_cCurents.NextSort
            Do
                If Not locArr(nCount).NextSort Is Nothing Then
                    Set locArr(nCount) = locArr(nCount).NextSort
                    Set new_cCurents.NextSort = locArr(nCount)
                    Set new_cCurents = new_cCurents.NextSort
                End If
                DoEvents
            Loop While Not locArr(nCount).NextSort Is Nothing
        End If
    Next nCount

End Sub

Добавь модуль класса с именем «Cel» и помести туда текст

Код

Option Explicit
Public Value        As New cRec
Private CFm_PrevCell     As Cel
Private CFm_NextCell     As Cel
Private CFm_NextSort     As Cel

Public Property Set PrevCell(PropVal As Cel)

    Set CFm_PrevCell = PropVal

End Property

Public Property Get PrevCell() As Cel

    Set PrevCell = CFm_PrevCell

End Property

Public Property Set NextCell(PropVal As Cel)

    Set CFm_NextCell = PropVal

End Property

Public Property Get NextCell() As Cel

    Set NextCell = CFm_NextCell

End Property

Public Property Set NextSort(PropVal As Cel)

    Set CFm_NextSort = PropVal

End Property

Public Property Get NextSort() As Cel

    Set NextSort = CFm_NextSort

End Property

Добавь модуль класса с именем «cRec» и помести туда текст

Код

Option Explicit
Private CFm_Branch_Name              As String
Private CFm_Quantity_of_workers      As Integer
Private CFm_Harmful_conditions       As Integer
Private CFm_QuantityProcent          As Integer

Public Property Let Branch_Name(PropVal As String)

    CFm_Branch_Name = PropVal

End Property

Public Property Get Branch_Name() As String

    Branch_Name = CFm_Branch_Name

End Property

Public Property Let Quantity_of_workers(PropVal As Integer)

    CFm_Quantity_of_workers = PropVal

End Property

Public Property Get Quantity_of_workers() As Integer

    Quantity_of_workers = CFm_Quantity_of_workers

End Property

Public Property Let Harmful_conditions(PropVal As Integer)

    CFm_Harmful_conditions = PropVal

End Property

Public Property Get Harmful_conditions() As Integer

    Harmful_conditions = CFm_Harmful_conditions

End Property

Public Property Let QuantityProcent(PropVal As Integer)

    CFm_QuantityProcent = PropVal

End Property

Public Property Get QuantityProcent() As Integer

    QuantityProcent = CFm_QuantityProcent

End Property

Добавь модуль класса с именем «mRecord» и помести туда текст

Код

Option Explicit
Public cFirst         As New Cel    ' до первой записи
Public cFirstSort     As New Cel    ' до первой записи Sort
Public cLast          As New Cel    ' после последней записи
Public cCurent        As New Cel    ' текущая запись
Private CFm_cCount         As Integer

Public Property Get cCount() As Integer

    cCount = CFm_cCount

End Property

Public Property Let cCount(PropVal As Integer)

    CFm_cCount = PropVal

End Property

Public Sub Add_Last(ByVal Value As cRec)   'Добавить запис последней

  Dim newCel As New Cel

    With newCel
        .Value.Branch_Name = Value.Branch_Name
        .Value.Harmful_conditions = Value.Harmful_conditions
        .Value.Quantity_of_workers = Value.Quantity_of_workers
        Set .NextCell = cLast
        Set .PrevCell = cLast.PrevCell
        Set .PrevCell.NextCell = newCel
    End With
    Set cLast.PrevCell = newCel
    Set cCurent = cLast.PrevCell
    CFm_cCount = CFm_cCount + 1

End Sub

Private Sub Class_Initialize() 'Открытие класса

    Set cFirst.NextCell = cLast
    Set cLast.PrevCell = cFirst

End Sub

Private Sub Class_Terminate() 'Закрытие класса

  Dim delCel As Cel

    Set delCel = cFirst.NextCell
    Do While Not (delCel Is cLast)
        Set delCel.PrevCell = Nothing
        Set delCel = delCel.NextCell
    Loop
    Set cCurent = Nothing
    Set cFirst.NextCell = Nothing
    Set cLast.PrevCell = Nothing

End Sub

Public Function item() As cRec 'Обратится к записи

    Set item = cCurent.Value

End Function

Public Sub MoveFirst() 'Перейти к первой записи

    Set cCurent = cFirst.NextCell

End Sub

Public Sub MoveNext() 'Перейти к следующей записи

    If Not (cCurent.NextCell Is Nothing) Then
        Set cCurent = cCurent.NextCell
    End If

End Sub

ЗАПУСКАЙ(F5)!
Удачи

cardinal

Дата 17.1.2004, 20:30 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

Vach, ты только счет банковский указать забыл

--------------------

Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино". А. и Б. Стругацкие

Vach

Дата 17.1.2004, 21:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 304
Регистрация: 17.10.2003
Где: Санкт-Петербург

Репутация: 8
Всего: 18

cardinal. Эта программа не имеет никакой ценность, тат как никому не нужна.
Cчет излишен.

Unregistered

Дата 21.1.2004, 15:55 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Vach а ты добрый!

Гость_Marisha

Дата 22.1.2004, 10:06 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Vach! Спасибо тебе огромнейшее!!! Мне даже стыдно стало,
когда я увидела как много потратил времени на выпольнение моей просьбы.

Vach

Дата 22.1.2004, 14:47 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 304
Регистрация: 17.10.2003
Где: Санкт-Петербург

Репутация: 8
Всего: 18

Да не за что. На счет времени ты ошибаешься.
Все модули были готовы и взяты из разных старых программ.
Двусвязные списки и сортировка(кстати не самая быстрая), модуль cRec+cCel это билдер.
Накапливай свою коллекцию удобных тебе модулей - потом только клеить будешь.

Это экономит кучу времени!

Удачи.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »