Осуществлять поиск данных по наименованию продукции - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д