Осуществлять поиск данных по наименованию продукции - VB

Узнай цену своей работы

Формулировка задачи:

По данным о наименовании продукции и её оценок(по 5-ти бальной шкале) в номинациях: цена, качество, дизайн, функциональность разработать проект позволяющий: а) вводить и редактировать данные с сохранением в файле б) Осуществлять поиск данных по наименованию продукции в)Рассчитывать средние оценки для каждой продукции г) Выводить результат в порядке убывания средней продукции

Решение задачи: «Осуществлять поиск данных по наименованию продукции»

textual
Листинг программы
Option Explicit
'
'    '© FelixMacintosh (CiberForum.ru)
'    'Средняя цена !
'
'=============================================
'Эти значения можно подгрузить из файла !
'Или ввести самостоятельно
Const p1 = "тетрадь, ручка, карандаш, линейка, ластик, альбом, дневник, краски, пенал"
 
'Цены соответственно
Const p2 = "80.46//93.93//25.24//59.89//38.95//46.51//8.37//12.99//97.26//43.77"
'=============================================
 
 
Private Const GWL_EXSTYLE = (-20)
Private Const ICC_STANDARD_CLASSES = &H4000&
Private Const WS_EX_LAYERED As Long = &H80000
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
 
'-----------------------------------------[Типы]
Private Type InitCommonControlsExStruct
    lngSize As Long
    lngICC As Long
End Type
 
Private Type TNotifyIconData
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type
Dim Nid As TNotifyIconData
'-----------------------------------------[Api функции]
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsExStruct) As Boolean
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As TNotifyIconData) As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
 
 
 
 
Private Sub Command1_Click()
    Dim f&, d#, n&
    For f = 0 To Text1.Count - 1
        If f Mod 2 = 1 Then
            n = n + 1
            d = d + Val(Text1(f))
        End If
    Next
    Text2 = "Средняя цена = " & FormatCurrency(d / n)
End Sub
 
Private Sub Form_Load()
    Dim f&, l&, i&, j1$(), j2$()
    Const c = 1
    j1 = Split(p1, ",")
    j2 = Split(p2, "//")
    '----------------
    Text2 = ""
    i = c + c
    For f = 1 To UBound(j1)
        Load Frame1(f): Frame1(f).Visible = True
        Load Picture1(f)
        SetParent Picture1(f).hwnd, Frame1(f).hwnd
 
        With Frame1(f - 1)
            Frame1(f).Move .Left, .Top + .Height
        End With
        Picture1(f).Visible = True
 
        For l = 0 To c
            Load Text1(i)
            SetParent Text1(i).hwnd, Picture1(f).hwnd
            With Text1(l)
                Text1(i).Move .Left, .Top, .Width, .Height
            End With
            
            Text1(i).Visible = True
            i = i + 1
        Next
    Next
    i = 0: l = 0
    On Error Resume Next
    For f = 0 To Text1.Count
        If f Mod (c + 1) = 0 Then
            Text1(f) = Trim(j1(i))
             i = i + 1
        ElseIf f Mod (c + 1) = 1 Then
            Text1(f) = Trim(j2(l))
             l = l + 1
        End If
   
    Next
 
    
    Dim o As Object
    
    Nid = TrayAddIcon(Me)
    Me.TrayMenu.Visible = 0
 
    For Each o In Me
        If TypeName(o) = "PictureBox" Then o.BorderStyle = 0
    Next
End Sub
 
Private Sub Proz_Click()
    Const Alpha = 200 'Прозрачность от 0 до 255
    Proz.Checked = Not Proz.Checked
    If Proz.Checked Then
        sndPlaySound "notify", 1
        SetWindowLong hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
        SetLayeredWindowAttributes hwnd, 0, Alpha, 2
    Else
        SetWindowLong hwnd, GWL_EXSTYLE, 0
    End If
End Sub
 
Private Sub Colaps_Click()
    Me.Hide
End Sub
 
 
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Y <> 0 Then Exit Sub
 
    If Button = 1 And Me.Visible = False Then
        Me.Show
    ElseIf Button = 2 Then
        Me.PopupMenu Me.TrayMenu, 1, X, Screen.Height
    End If
End Sub
 
'*** Tray Icon ***
Private Function TrayAddIcon(ByVal mForm As Form) As TNotifyIconData
    TrayAddIcon.cbSize = Len(Nid)
    TrayAddIcon.hIcon = mForm.Icon
    TrayAddIcon.hwnd = mForm.hwnd
    TrayAddIcon.szTip = mForm.Caption & vbNullChar
    TrayAddIcon.ucallbackMessage = 512
    TrayAddIcon.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
    TrayAddIcon.uId = 1
    Call Shell_NotifyIcon(NIM_ADD, TrayAddIcon)
End Function
 
Private Sub TrayRemoveIcon(IconData As TNotifyIconData)
    Call Shell_NotifyIcon(NIM_DELETE, IconData)
End Sub
 
Private Sub TrayModifyIcon(IconData As TNotifyIconData)
    Call Shell_NotifyIcon(NIM_MODIFY, IconData)
End Sub
 
Private Sub Exit_Click()
    Unload Me
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Call TrayRemoveIcon(Nid)
End Sub
 
 
 
Private Sub Form_Initialize()
    'Инициализация стиля НЕ УДОЛЯТЬ !
    Dim iccex As InitCommonControlsExStruct, hMod As Long
 
    With iccex
        .lngSize = LenB(iccex)
        .lngICC = ICC_STANDARD_CLASSES 'встроенные элементы управления VB (кнопки, текстового поля _
        и т.д.)
    End With
    On Error Resume Next 'если произошла ...
    hMod = LoadLibrary("shell32.dll")
    InitCommonControlsEx iccex
 
    If Err Then
        InitCommonControls 'попробовать версию Win9x
        Err.Clear
    End If
    On Error GoTo 0
    If hMod Then FreeLibrary hMod
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 3.533 из 5
Похожие ответы