Осуществлять поиск данных по наименованию продукции - 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