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

Option Explicit
'
'    '© FelixMacintosh (CiberForum.ru)
'    'Средняя цена
'
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
Dim MyFile$, ini As ini
Const c = 1, Section$ = "Товар и цена"
 
Private Sub Command2_Click()
    Dim f&, l&, i&, j1$(), j2$(), j$(), s$, sb$, n&
    Dim o
 
    s = InputBox("Введите товар и цену:", , "Портфель=10")
    
    If Len(s) Then
        For Each o In Me: If TypeName(o) = "Frame" Then f = o.Index
        Next
        f = f + 1
        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
        On Error Resume Next
        For Each o In Me: If TypeName(o) = "TextBox" Then i = o.Index
        Next: i = i + 1
        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
            Err.Clear
            Text1(i).Text = Split(s, "=")(l)
            Text1(i).Visible = True
            i = i + 1
        Next
        If Err = 0 Then
            Text1(i - 2) = Trim(Text1(i - 2))
            Text1(i - 1) = Trim(Text1(i - 1))
            Call ini.SaveSetting(Section, Text1(i - 2), Text1(i - 1))
        End If
        
    End If
 
End Sub
 
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$(), j$(), s$, sb$, n&
    Dim v
    On Error Resume Next
    For Each v In Me: If i > 0 Then v.Visible = False
    Next: i = i + 1
    Set ini = New ini
    v = ini.GetKeys(Section)
    If Len(Join(v, "")) Then
        For f = 0 To UBound(v)
            If v(f) <> "" Then
                ReDim Preserve j1(n), j2(n)
                j1(n) = v(f): j2(f) = ini.GetSetting(Section, j1(f))
                n = n + 1
            End If
        Next
    Else
        Do
            n = n + 1
            s = InputBox("Введите " & n & "-ую товар и цену:", , "Тетрадь=10") & ";"
            sb = sb & s
        Loop While s <> ";"
 
        j1 = Split(sb, ";")
        j2 = j1
        For f = 0 To UBound(j1)
            If j2(f) = "" Then Exit For
            j = Split(j2(f), "=", 2)
            j1(f) = j(0): j2(f) = j(1)
        Next
        On Error Resume Next
        ReDim Preserve j1(f - 1), j2(f - 1)
        If Err Then End
        For f = 0 To UBound(j1)
            Call ini.SaveSetting(Section, j1(f), j2(f))
        Next
    End If
    
    Text2 = "": Command2.Caption = "Добавить"
    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