Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Задачи на Visual Basic (VB).

Автор: NEOMATRIX
Дата сообщения: 08.12.2005 16:55
dneprcomp
Куда же мне думать, мне нужно работу уже сдать. У меня теории полно, особо думать времени нету! Покажите плз код примерный.
Автор: Troitsky
Дата сообщения: 08.12.2005 17:43
dneprcomp

Цитата:
Дайте человеку подумать.

Ну тогда не будем полностью открывать карты


NEOMATRIX

Ну, ёлы-палы! Написано вроде подробно. Тут кода-то не больше 10 строчек будет, добрая половина из которых - объявление переменных, ввод и вывод данных.

Цикл Do, функция InStr(), тандем Mid() & Mid() (или как альтернатива Left() & Right()) для склейки, ну и примитивные познания об операциях - вот, пожалуй, и все, что нужно для решения задачи.
Автор: dneprcomp
Дата сообщения: 08.12.2005 19:03
NEOMATRIX
А когда сдавать? Ну хоть что-нибудь написал? Покажи.
Автор: NEOMATRIX
Дата сообщения: 08.12.2005 19:27
dneprcomp
Извините, ну я ничего непойму, простите за тупизм. Словестно я то понимаю, а реализацию в коде нет. Сдать завтро.
Автор: dneprcomp
Дата сообщения: 08.12.2005 22:49
NEOMATRIX
Ну, ладно. Только из-за моей врожденной приязни к экономистам
Вот тебе код. А камрада Troitsky попросим проверить Код можно поставить на любое событие формы, на кнопку и т.п.
[more] Dim strSource As String 'для исходного стринга
'объявляем динамический массив, т.к. не знаем сколько будет слов
Dim arWord() As String
'в этом массиве держим встречаемость
Dim arQuant() As Integer
Dim strTemp As String
Dim Count As Integer
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim Found As Boolean

'инициализируем динамические массивы сразу на 50 элементов(чтобы не переобъявлять слишком часто)
Y = 50
ReDim arWord(Y)
ReDim arQuant(Y)
Count = 0

strSource = 'инициализируем исходным стрингом

'по совету Troitsky добавляем пробел в конец
strSource = LTrim(strSource) & Space(1)
'крутим код, пока стринг не закончится или не будет состоять из одних пробелов
Do While Trim(strSource) <> ""
Found = False
'находим первое слово
strTemp = Left(strSource, InStr(strSource, " ") - 1)
'проверяем на наличие в массиве
For X = 0 To Y
'если дошли до пустого значения элемента массива(или первый элемент оказался пустым), то сразу присваиваем значение и увеличиваем счетчик
If arWord(X) = "" Then
arWord(X) = strTemp
arQuant(X) = arQuant(X) + 1
Found = True
Exit For
'если нашли совпадение, то только увеличиваем счетчик
ElseIf arWord(X) = strTemp Then
arQuant(X) = arQuant(X) + 1
Found = True
'прекращаем цикл, т.к. нет смысла крутить дальше
Exit For
End If
Next X

'если не нашли или не присвоили значение, значит нет свободных элементов массива. Пора переобъявить.
If Found = False Then
Y = Y + 50
'переобъявляем с сохранением значений
ReDim Preserve arWord(Y)
ReDim Preserve arQuant(Y)
'сохраняем текущий индекс переменной
X = X + 1
arWord(X) = strTemp
arQuant(X) = arQuant(X) + 1
End If

'отрезаем первое вхождение слова, используя функцию Replace
strSource = Space(1) & LTrim(Replace(strSource, strTemp, "", 1, 1, vbTextCompare))
'проверяем, встречается ли слово еще
If Trim(strSource) <> "" Then
strTemp = Space(1) & strTemp & Space(1)
Z = InStr(strSource, strTemp)
Do While Z <> 0
arQuant(X) = arQuant(X) + 1
strSource = Replace(strSource, Trim(strTemp), "", 1, 1, vbTextCompare)
Z = InStr(strSource, strTemp)
Loop
strSource = LTrim(strSource)
End If
DoEvents
Loop

strTemp = ""
For X = 0 To UBound(arWord)
If arWord(X) = "" Then
Exit For
End If
strTemp = strTemp & arWord(X) & Space(3) & arQuant(X) & vbNewLine
Next X
MsgBox strTemp

[/more]
Автор: MrHitman
Дата сообщения: 09.12.2005 00:22
Моя задача посложнее.
Возможно ли на VB написать прогу, эмулирующую USB устройство, к которому обращается другая программа? И чтобы для той программы все было прозрачно и незаметно?
Желательны примеры!
Автор: Troitsky
Дата сообщения: 09.12.2005 12:52
dneprcomp
NEOMATRIX

Я по другому немного сварганил. Вначале я думал что искать нужно только одно слово - для этого написал функцию HowMuch(). Если нужно иметь полную статистику по словам в строке пример расширяется.
[more]

Код: Private Type Table
Word As String
Count As Integer
End Type

Public Function HowMuch(ByVal strSource As String, ByVal strWord As String) As Integer
Dim intPos As Integer
Dim intCounter As Integer

strSource = Space(1) & strSource & Space(1)
strWord = Space(1) & Trim(strWord) & Space(1)

intPos = 0
intCounter = 0

Do
intPos = InStr(strSource, strWord)
If intPos > 0 Then
intCounter = intCounter + 1
strSource = Space(1) & Trim(Left(strSource, intPos - 1) & Right(strSource, Len(strSource) - intPos - Len(strWord) + 2)) & Space(1)
End If
Loop Until intPos = 0

HowMuch = intCounter
End Function


Private Sub Form_Load()
Dim CountList() As Table
Dim intPos As Integer
Dim strSource As String
Dim strWord As String
Dim i As Integer ' счетчик

ReDim CountList(0)

strSource = "123 при вал приз упри п ри при прии при пре "
strSource = Trim(strSource)

Do
intPos = InStr(strSource, " ")
If intPos > 0 Then
strWord = Left(strSource, intPos-1)
CountList(UBound(CountList)).Word = strWord
CountList(UBound(CountList)).Count = HowMuch(strSource, strWord)
strSource = Space(1) & strSource & Space(1)
strWord = Space(1) & Trim(strWord) & Space(1)
strSource = Trim(Replace(strSource, strWord, " ")) & Space(1)
End If

If strSource = Space(1) Then
Exit Do
Else
ReDim Preserve CountList(UBound(CountList) + 1)
End If
Loop

For i = 0 To UBound(CountList)
MsgBox CountList(i).Word & Space(10) & CountList(i).Count
Next i
End Sub
Автор: MrHitman
Дата сообщения: 09.12.2005 16:22

Цитата:
Эмуляция ключа аппаратной защиты Хм...


Можно сказать и так, но скорее это "устройство для ввода данных в программу".
Сделать логи оригинального устройства нет возможности, т.к. этой штуковины просто нету у меня. Вот и решил методом исследования разобраться в протоколах обмена.
Ну дык, кто в курсе как с USB через VB работать?
Автор: Troitsky
Дата сообщения: 09.12.2005 17:14
MrHitman

Эта тема для типовых задач на VB, а твоя проблема не тривиальна. Поищи фильтром по форуму и если ничего подобного не найдешь, то, думаю, лучше создать отдельную тему (для верности желательно у модератора спросить) - в эту тему заходят далеко не все специалисты, особенно аппаратчики.

Добавлено:
MrHitman
http://forum.ru-board.com/forum.cgi?action=filter&forum=33&filterby=topictitle&word=USB
http://forum.ru-board.com/forum.cgi?action=filter&forum=33&filterby=topictitle&word=%FD%EC%F3%EB

ну и т.д.
Автор: dneprcomp
Дата сообщения: 09.12.2005 20:01
Troitsky
Через тайп я специально не сделал. Преподаватель может не поверить Я и 2 массива сделал вместо одного 2-уравневого именно по этой причине.

Добавлено:
Troitsky
Посмотрел твой код. Пришлось в свой вывод добавить. А то как-то не хорошо
Только вот тайп у меня не заработал, пока я в модуль его не поместил ??
Автор: NEOMATRIX
Дата сообщения: 09.12.2005 22:55
Troitsky
dneprcomp
Огромное вам спасибо, за то что мне помогаете.
Автор: dneprcomp
Дата сообщения: 10.12.2005 02:55
NEOMATRIX
Расскажешь как сдал. Будут вопросы, заходи
Автор: Fil75
Дата сообщения: 10.12.2005 19:55
Подскажите как в VB6 сворачивать программу в трей - причем чтобы она не видна была в Таскбаре
Автор: dneprcomp
Дата сообщения: 10.12.2005 20:51
Fil75
Писал и использовал давно, т.ч. ....
Создаешь модуль с именем systray. В него помещаешь следующее
[more]Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Required Public constants, types & declares
'for the Shell_Notify API method
Public Const NIM_ADD As Long = &H0
Public Const NIM_MODIFY As Long = &H1
Public Const NIM_DELETE As Long = &H2

Public Const NIF_ICON As Long = &H2 'adding an ICON
Public Const NIF_TIP As Long = &H4 'adding a TIP
Public Const NIF_MESSAGE As Long = &H1 'want return messages

'rodent constant we'll need for the callback
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK As Long = &H203

Public Const WM_MBUTTONDOWN As Long = &H207
Public Const WM_MBUTTONUP As Long = &H208
Public Const WM_MBUTTONDBLCLK As Long = &H209

Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLCLK As Long = &H206

'the actual workhorse
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Public NID As NOTIFYICONDATA

Declare Function Shell_NotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long[/more]

Еще один с именем winproc. В него помещаешь следующее
[more]Option Explicit

'defWindowProc: Variable to hold the ID of the
' default window message processing
' procedure. Returned by SetWindowLong.
Public defWindowProc As Long

'isSubclassed: flag indicating that subclassing
' has been done. Provides the means
' to call the correct message-handler.
Public isSubclassed As Boolean

'Activates and displays a window.
'If the window is minimized or maximized,
'the system restores it to its original size and position.
'An application should specify this flag when displaying
'the window for the first time.
Public Const SW_SHOWNORMAL = 1
'Private Const SW_HIDE = 0
'Private Const SW_SHOW = 5

Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long

'Get/SetWindowLong messages
Public Const GWL_WNDPROC As Long = (-4)
Public Const GWL_HWNDPARENT As Long = (-8)
Public Const GWL_ID As Long = (-12)
Public Const GWL_STYLE As Long = (-16)
Public Const GWL_EXSTYLE As Long = (-20)
Public Const GWL_USERDATA As Long = (-21)

'general windows messages
Public Const WM_USER As Long = &H400
Public Const WM_MYHOOK As Long = WM_USER + 1
Public Const WM_NOTIFY As Long = &H4E
Public Const WM_COMMAND As Long = &H111
Public Const WM_CLOSE As Long = &H10

Public Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long

Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Any) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long


'our own window message procedure
Public Function WindowProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

'window message procedure
'
'If the handle returned is to our form,
'call a form-specific message handler to
'deal with the tray notifications. If it
'is a general system message, pass it on to
'the default window procedure.
'
'If its ours, we look at lParam for the
'message generated, and react appropriately.
On Error Resume Next

Select Case hWnd

'form-specific handler
Case frmOrder.hWnd

Select Case uMsg
'check uMsg for the application-defined
'identifier (NID.uID) assigned to the
'systray icon in NOTIFYICONDATA (NID).

'WM_MYHOOK was defined as the message sent
'as the .uCallbackMessage member of
'NOTIFYICONDATA the systray icon
Case WM_MYHOOK

'lParam is the value of the message
'that generated the tray notification.
Select Case lParam
Case WM_RBUTTONUP:

'This assures that focus is restored to
'the form when the menu is closed. If the
'form is hidden, it (correctly) has no effect.
Call SetForegroundWindow(frmOrder.hWnd)

'show the menu
frmOrder.PopupMenu frmOrder.mnuPopUp
Case WM_LBUTTONDBLCLK:
frmOrder.mnuPopUpShow_Click
End Select


'handle any other form messages by
'passing to the default message proc
Case Else

WindowProc = CallWindowProc(defWindowProc, _
hWnd, _
uMsg, _
wParam, _
lParam)
Exit Function

End Select


'this takes care of messages when the
'handle specified is not that of the form
Case Else

WindowProc = CallWindowProc(defWindowProc, _
hWnd, _
uMsg, _
wParam, _
lParam)
End Select

End Function[/more]

В проект добавляешь функции. Вызываешь все это функцией AddToTray.
[more]Public Function AddToTray()
'add an icon to the system tray. If is
'is successful (returns 1) then subclass
'to intercept messages
If ShellTrayAdd = 1 Then

'prepare to receive the systray messages
SubClass Me.hWnd
Me.Hide
End If
End Function

Public Function ShellTrayAdd() As Long

'prepare the NOTIFYICONDATA type with the
'required parameters:

'.cbSize: Size of this structure, in bytes.
'
'.hwnd: Handle of the window that will receive
' notification messages associated with
' an icon in the taskbar status area.
'
'uID: Application-defined identifier of
' the taskbar icon. In an application
' with a single tray icon, this can be
' an arbitrary number. For apps with
' multiple icons, each icon ID must be
' different as this member identifies
' which of the icons was selected.
'
'.uFlags: flags that indicate which of the other
' members contain valid data. This member
' can be a combination of the following:
' NIF_ICON hIcon member is valid.
' NIF_MESSAGE uCallbackMessage member is valid.
' NIF_TIP szTip member is valid.
'
'uCallbackMessage: Application-defined message identifier.
' The system uses this identifier for
' notification messages that it sends
' to the window identified in hWnd.
' These notifications are sent when a
' mouse event occurs in the bounding
' rectangle of the icon. (Note: 'callback'
' is a bit misused here (in the context of
' other callback demonstrations); there is
' no systray-specific callback defined -
' instead the form itself must be subclassed
' to respond to this message.
'
'hIcon: Handle to the icon to add, modify, or delete.
'
'szTip: Tooltip text to display for the icon. Must
' be terminated with a Chr$(0).

'Shell_NotifyIcon messages:
'dwMessage: Message value to send. This parameter
' can be one of these values:
' NIM_ADD Adds icon to status area
' NIM_DELETE Deletes icon from status area
' NIM_MODIFY Modifies icon in status area
'
'pnid: Address of the prepared NOTIFYICONDATA.
' The content of the structure depends
' on the value of dwMessage.


strTemp = "abcd"
With NID
.cbSize = LenB(NID)
.hWnd = Me.hWnd
.uID = 125&
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MYHOOK
.hIcon = Me.Icon
If strTemp <> "" Then
.szTip = LoadResString(1192) & "[" & strTemp & "]" & Chr$(0)
Else
.szTip = LoadResString(1192) & Chr$(0)
End If
End With

ShellTrayAdd = Shell_NotifyIcon(NIM_ADD, NID)

End Function

Private Sub SubClass(hWnd As Long)

'assign our own window message
'procedure (WindowProc)

On Error Resume Next
defWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)

End Sub

Private Sub UnSubClass()

'restore the default message handling
'before exiting
If defWindowProc Then
SetWindowLong frmOrder.hWnd, GWL_WNDPROC, defWindowProc
defWindowProc = 0
End If

End Sub

Private Sub ShellTrayRemove()

'Remove the icon from the taskbar
Call Shell_NotifyIcon(NIM_DELETE, NID)

End Sub

Private Sub Form_Resize()
'If Tray = vbChecked Then
If Me.WindowState = vbMinimized Then
AddToTray
End If
'End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Tray = vbChecked Then
'Remove the icon added to the taskbar
ShellTrayRemove

'remove subclassing
UnSubClass
End If

'assure unloading proceeds
Cancel = False

End Sub
[/more]
Автор: Advanced_Guest
Дата сообщения: 11.12.2005 03:16
Есть идеи, как можно отловить нажатие клавиши ? (причём мне надо узнать, какая клавиша нажата).

Основная проблема - надо отловить не стандартную, а специальную клавишу..
Что то типа "выключить комьпютер" "перейти в слип режим" и тд .
Автор: dneprcomp
Дата сообщения: 11.12.2005 04:19
Advanced_Guest
А что Debug.Print KeyCode 'for Key_Up, Key_Down или Debug.Print KeyAscii 'for KeyPress показывают?

Добавлено:
Похоже, что тебе вот это подойдет SendKeys using the API
Автор: Lkardin
Дата сообщения: 11.12.2005 15:14
Помогите потжалуйста решить следующие задачи:
1) Пусть .
Дано действительное E>0 . Найти первый член , для которого выполнено

2) Найти сумму квадратов номеров строк всех нулевых элементов матрицы.
Автор: ShIvADeSt
Дата сообщения: 12.12.2005 00:49
dneprcomp

Цитата:
А что Debug.Print KeyCode 'for Key_Up, Key_Down или Debug.Print KeyAscii 'for KeyPress показывают?

Ему больше всего подойдут хуки, так как отлавливать все равно придется судя по заданию не в своем приложении.

Цитата:
Есть идеи, как можно отловить нажатие клавиши ? (причём мне надо узнать, какая клавиша нажата).

Основная проблема - надо отловить не стандартную, а специальную клавишу..
Что то типа "выключить комьпютер" "перейти в слип режим" и тд .

Вот только есть проблемка, даже отловив при помощи хука, что нажата кнопка выключения, ты не сможешь ее подменить, так как ловушка на клавиатуру не позволяет изменять коды клавиш, надо будет писать драйвер клавиатуры, кто то этим делом здесь занимался.
Автор: dneprcomp
Дата сообщения: 12.12.2005 01:52
ShIvADeSt
Не смотрел по моему линку 'SendKeys using the API' ? Я не разбирался долго, но похоже на то, что ты рекомендуешь. Интересно твое мнение.
"не в своем приложении" я у него пока не вижу.
Автор: ShIvADeSt
Дата сообщения: 12.12.2005 02:00
dneprcomp
Этот код видел уже давно (причем у меня есть адаптированная под дельфи его модификация) это не совсем то, то нужно автору. Так как там эмулируются нажатия клавиш при помщи Keybd_event, а ему нужно отследить их нажатия, в своем приложении это можно сделать обрабатывая WM_KEYDOWN (это если юзать АПИшный обработчик мессаг) и в нем смотреть на код нажатой клавиши, главное чтобы этот код не был специфичен для каждой клавиатуры. так как у меня стандартная клава, то проверить это нет возможности.
Автор: dneprcomp
Дата сообщения: 12.12.2005 02:45
ShIvADeSt
Спасибо
Автор: Troitsky
Дата сообщения: 12.12.2005 08:31
Lkardin

1) Заводишь переменную для yk-1, записываешь туда 0. Заводишь переменную для yk, будешь проверять ее на условие выхода из цикла. В цикле увеличиваешь счетчик k=1,2,..., считаешь результат и в случае неудовлетворения его условию выхода из цикла записываешь его в переменную для yk-1 и соответственно увеличив счетчик считаешь снова. Ну и в результате из цикла ты не выйдешь никогда, т.к.условие в твоей записи никогда не выполнится. Дальше думай сам.

Добавлено:
Хотя в принципе можно обойтись и одной переменнной для y
Автор: grek99
Дата сообщения: 14.12.2005 23:58
sorry!
Автор: Lkardin
Дата сообщения: 15.12.2005 15:12

Цитата:
Lkardin

1) Заводишь переменную для yk-1, записываешь туда 0. Заводишь переменную для yk, будешь проверять ее на условие выхода из цикла. В цикле увеличиваешь счетчик k=1,2,..., считаешь результат и в случае неудовлетворения его условию выхода из цикла записываешь его в переменную для yk-1 и соответственно увеличив счетчик считаешь снова. Ну и в результате из цикла ты не выйдешь никогда, т.к.условие в твоей записи никогда не выполнится. Дальше думай сам.

Добавлено:
Хотя в принципе можно обойтись и одной переменнной для y

Troitsky
Скажите пожалуйста как примерно это должно выглядить в коде ?
Автор: Mirotvorec
Дата сообщения: 16.12.2005 23:51
Помогите сделать задачи:

1)Подсчитать число всех делителей заданного натурального числа.

2)Все элементы целочисленного вектора с нечетными значениями умножить на 2.

3)Найти элемент над главной диагональю квадратной целочисленной матрицы, значение которого принадлежит заданному отрезку( предполагается, что такой элемент найдется).

4)Упорядочить буквы заданного слова по алфавиту.
Автор: ASProg
Дата сообщения: 17.12.2005 09:50
Mirotvorec

Если я правильно понял задание, то к № 1 код будет следующий:

Dim i, n, c As Integer
c = Val(Text1.Text) 'само число
n = 0 'кол-во делителей
For i = 2 To c
If c Mod i = 0 Then n = n + 1 'если делится без остатка, то оно нам подходит
Next i
MsgBox (Str(n))


Добавлено:
Mirotvorec

Приведу код для № 2:


Код:
Dim a() As Integer
Dim n, i As Integer
n = Val(Text1.Text)
ReDim a(n)
Label1.Caption = "" 'будем выводить сюда исходный массив
Label2.Caption = "" 'а сюда полученный массив
For i = 0 To n
a(i) = Int(Rnd * 100)
Label1.Caption = Label1.Caption + Str(a(i)) + " "
If a(i) Mod 2 <> 0 Then a(i) = a(i) * 2 'было нечетным - станет наоборот
Label2.Caption = Label2.Caption + Str(a(i)) + " "
Next i
Автор: NEOMATRIX
Дата сообщения: 22.12.2005 23:48
А как нарисовать блок-схему для задачи которая была решена выше dneprcomp и Troitsky


Цитата:
Дан текстовый ряд. Группы символов, разделенные пробелами (одним или несколькими) и не имея пробелов в середине себя, будем называть словами. Подсчитать сколько раз можно слово встретить в тексте.

Автор: aezh
Дата сообщения: 23.12.2005 17:10
Прошу прощения, но может подскажете мне, как с помощью VBS удалить из оперделенного каталога на жестком диске файлы в зависимости от даты их создания?
Автор: dneprcomp
Дата сообщения: 23.12.2005 20:19
aezh
Попробуй спросить в http://forum.ru-board.com/topic.cgi?forum=33&topic=1491&start=60#lt
Автор: Dianira
Дата сообщения: 24.12.2005 22:06
у меня тут большой довольно вопрос...*смущённо*
значится вопрос такой. мне было дано задание "Написать подпрограммы сложения и транспонирования матриц" Но у меня написано без подпрограмм.
Вышло вот это:

' Транспонирование

Public Sub TranspMatrix()
Dim avarMatrix() As Variant
Dim avarMatrixTransp() As Variant
Dim intI As Integer
Dim intJ As Integer

ReDim avarMatrix(1 To 3, 1 To 2)

Randomize

Debug.Print "Исходная матрица: "

For intI = LBound(avarMatrix, 1) To UBound(avarMatrix, 1)
For intJ = LBound(avarMatrix, 2) To UBound(avarMatrix, 2)
avarMatrix(intI, intJ) = Int(Rnd * 10) + 1
Debug.Print avarMatrix(intI, intJ);
Next intJ
Debug.Print ""
Next intI

Debug.Print "=========================="

ReDim avarMatrixTransp(1 To UBound(avarMatrix, 2), 1 To UBound(avarMatrix, 1))

Debug.Print "Транспонированая матрица: "

For intJ = LBound(avarMatrix, 2) To UBound(avarMatrix, 2)
For intI = LBound(avarMatrix, 1) To UBound(avarMatrix, 1)
avarMatrixTransp(intJ, intI) = avarMatrix(intI, intJ)
Debug.Print avarMatrixTransp(intJ, intI);
Next intI
Debug.Print ""
Next intJ
End Sub

' Суммирование
Public Sub SummMatrix()
Dim avarMatrix1() As Variant
Dim avarMatrix2() As Variant
Dim avarMatrixSumm() As Variant
Dim intI As Integer
Dim intJ As Integer

ReDim avarMatrix1(1 To 3, 1 To 2)
ReDim avarMatrix2(1 To 3, 1 To 2)
ReDim avarMatrixSumm(1 To 3, 1 To 2)

Randomize

Debug.Print "Матрица 1: "

For intI = LBound(avarMatrix1, 1) To UBound(avarMatrix1, 1)
For intJ = LBound(avarMatrix1, 2) To UBound(avarMatrix1, 2)
avarMatrix1(intI, intJ) = Int(Rnd * 10) + 1
Debug.Print avarMatrix1(intI, intJ);
Next intJ
Debug.Print ""
Next intI

Debug.Print "=========================="
Debug.Print "Матрица 2: "

For intI = LBound(avarMatrix2, 1) To UBound(avarMatrix2, 1)
For intJ = LBound(avarMatrix2, 2) To UBound(avarMatrix2, 2)
avarMatrix2(intI, intJ) = Int(Rnd * 10) + 1
Debug.Print avarMatrix2(intI, intJ);
Next intJ
Debug.Print ""
Next intI

Debug.Print "=========================="
Debug.Print "Суммированная матрица: "

For intI = LBound(avarMatrixSumm, 1) To UBound(avarMatrixSumm, 1)
For intJ = LBound(avarMatrixSumm, 2) To UBound(avarMatrixSumm, 2)
avarMatrixSumm(intI, intJ) = avarMatrix1(intI, intJ) + avarMatrix2(intI, intJ)
Debug.Print avarMatrixSumm(intI, intJ);
Next intJ
Debug.Print ""
Next intI
End Sub


преподавателя это не устроило и он попросил меня переделать, так, чтобы было с под программами.
часть он написал:
Option Explicit
Const min1 = 1, min2 = 3, max1 = 3, max2 = 7
Sub Test()
Dim intA(min1 To max1, min2 To max2) As Integer
Dim intB(min1 To max1, min2 To max2) As Integer
Dim intC(min1 To max1, min2 To max2) As Integer
Dim intFor1 As Integer
Dim intFor2 As Integer

For intFor1 = min1 To max1
For intFor2 = min2 To max2
intA(intFor1, intFor2) = intFor1
intB(intFor1, intFor2) = -intFor1
intC(intFor1, intFor2) = -intFor1
Next intFor2
Next intFor1
' SumMatrix intA, intB, intC
PrintMatr intA
PrintMatr intB
PrintMatr intC
End Sub
Sub PrintMatr(intA() As Integer)
Dim intI As Integer
Dim intJ As Integer
Debug.Print "Печать матрицы"
For intI = LBound(intA, 1) To UBound(intA, 1)
For intJ = LBound(intA, 2) To UBound(intA, 2)
Debug.Print intA(intI, intJ);
Next intJ
Debug.Print
Next intI
End Sub

не составило бы вам большого труда объяснить в чём здесь смысл вообще этой подпрограммы, т.к. я тут почти ничего не понимаю. заранее спасибо.

Страницы: 12345678910111213141516171819202122232425262728293031323334353637383940

Предыдущая тема: для Hiper-six (индексы .nsx .smt) хоть что нибудь Опции


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.