VBNet - Форум - Объединение массивов

Вопрос: Объединение массивов Добавлено: 24.05.07 21:37

Автор вопроса: -АлександР- | Web-сайт: sham.clan.su

двумерных массивов типа Single

Как объединить их значения без прохождения в цикле и поочередного присвоения?

может есть функция какая?

делаю так:

Public Function Stack(A() As Single, B() As Single) As Single()
    Dim fStack() As Single
    ReDim fStack(UBound(A, 1) + UBound(B, 1), UBound(A, 2))
    fStack = A

    Stack = fStack
End Function

как сделать типа, fStack = A + B

?
Ответить

Ответы Всего ответов: 12

Номер ответа: 1 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #1	Добавлено: 24.05.07 22:03
	упрощенно так Public Function Stack(a() As Single, b() As Single) As Single() Dim fStack() As Single ReDim fStack(UBound(a, 1) + UBound(b, 1), UBound(a, 2)) CopyMemory ByVal VarPtr(fStack(11, 0)), ByVal VarPtr(b(0, 0)), LenB(b(0, 0)) * UBound(b, 1) Stack = fStack End Function Private Sub Form_Load() Dim a() As Single Dim b() As Single ReDim a(10, 0) ReDim b(11, 0) b(0, 0) = 33.44 Dim ret() As Single ret = Stack(a(), b()) Debug.Print ret(11, 0) End Sub Ответить

Номер ответа: 2 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008	Web-сайт: sham.clan.su Профиль \| \| #2	Добавлено: 24.05.07 22:52
	я что-то уже замутил, что вб6 завис прошу меня проконтролировать: Option Base 1 везде стоит, поэтому полагаю так: Public Function Stack(A() As Single, B() As Single) As Single() Dim fStack() As Single ReDim fStack(UBound(A, 1) + UBound(B, 1), UBound(A, 2)) CopyMemory ByVal VarPtr(fStack(3, 2)), _ ByVal VarPtr(B(1, 1)), LenB(B(1, 1)) * UBound(B, 1) * UBound(B, 2) CopyMemory ByVal VarPtr(fStack(7, 2)), _ ByVal VarPtr(A(1, 1)), LenB(A(1, 1)) * UBound(A, 1) * UBound(A, 2) Stack = fStack End Function и Dim o() As Single Dim dv(7, 2) As Single Dim n(3, 2) As Single Private Sub Command2_Click() o = Stack(dv, n) Command1.Caption = o(10, 2) End Sub что-то не так... Ответить

Номер ответа: 3 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008	Web-сайт: sham.clan.su Профиль \| \| #3	Добавлено: 24.05.07 22:55
	я еще помимо этого заполняю массив: Private Sub Form_Load() n(3, 2) = 10 dv(1, 1) = 0.05 dv(2, 1) = 0.1 dv(3, 1) = 0.25 dv(4, 1) = 0.5 dv(5, 1) = 2 dv(6, 1) = 10 dv(7, 1) = 200 dv(1, 2) = 0.25 dv(2, 2) = 0.75 dv(3, 2) = 0 dv(4, 2) = 0 dv(5, 2) = 0 dv(6, 2) = 0 dv(7, 2) = 0 End Sub и при Private Sub Command2_Click() o = Stack(dv, n) Command1.Caption = o(10, 2) End Sub имхо должно быть выведено значение n(3, 2) = 10 но выходит ноль в любом случае, имхо копирование не происходит, в чем дело? Ответить

Номер ответа: 4 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #4	Добавлено: 24.05.07 23:40
	погоди с кодом, важен принцип. а он таков: адрес в памяти первого (нулевого) элемента массива есть адрес самого массива, скопировать один массив(SOURSE) в другой(DEST) в твоем случае это: определить адрес элемента в DEST куда будет записан первый(нул.) элемент SOURSE, определить длину в байтах всего массива SOURSE, ну и не выходить за пределы диапазона, иначе крах. Ответить

Номер ответа: 5 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008	Web-сайт: sham.clan.su Профиль \| \| #5	Добавлено: 25.05.07 20:24
	угу, вроде понял хотя вот только какая-то странная ошибка стала выскакивать при Public Function Stack(A() As Single, B() As Single) As Single() Dim fStack() As Single ReDim fStack(UBound(A, 1) + UBound(B, 1), UBound(A, 2)) fStack = A CopyMemory _ ByVal VarPtr(fStack(UBound(A, 1) - LBound(A, 1), UBound(A, 2) - LBound(A, 2)), _ ByVal VarPtr(B(1, 1)), _ LenB(B(1, 1)) * UBound(B, 1) * UBound(B, 2)) Stack = fStack End Function на первом аргументе CopyMemory, что неправльный номер аргумента или неверное назначение свойства ЗЫ, обявил так: Public Declare Sub CopyMemory Lib "kernel32" Alias _ "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Ответить

Номер ответа: 6 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008	Web-сайт: sham.clan.su Профиль \| \| #6	Добавлено: 25.05.07 20:33
	а, блин я тормоз стыдно, стыдно скобку просто не поставил (( но вот так не выходит: Public Function Stack(A() As Single, B() As Single) As Single() Dim fStack() As Single ReDim fStack(UBound(A, 1) + UBound(B, 1), UBound(A, 2)) fStack = A CopyMemory _ ByVal VarPtr(fStack(UBound(A, 1), UBound(A, 2))), _ ByVal VarPtr(B(1, 1)), _ LenB(B(1, 1)) * UBound(B, 1) * UBound(B, 2) Stack = fStack End Function выходит массив размерностью 7, 2 Ответить

Номер ответа: 7 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #7	Добавлено: 26.05.07 01:14
	попробуй так Option Explicit Option Base 1' независимо Private Declare Sub CpyAdr Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) Private Sub Command1_Click() Dim A() As Single Dim B() As Single Dim R() As Single Dim lb As Long ReDim A(3, 11) ReDim B(3, 21) lb = LBound Dim x As Integer Dim y As Integer For x = lb To UBound(A, 1) For y = lb To UBound(A, 2) A(x, y) = x + (y) / 10 ' ebug.Print "A " & A(x, y) Next Next For x = lb To UBound(B, 1) For y = lb To UBound(B, 2) B(x, y) = x + (y) / 100 ' Debug.Print "B " & B(x, y) Next Next '--- R() = Stack(A(), B()) '--- For y = lb To UBound(A, 2) For x = lb To UBound(A, 1) Debug.Print R(x, y) & " " & A(x, y) Next Next For y = lb To UBound(B, 2) For x = lb To UBound(B, 1) Debug.Print R(x, y + UBound(A, 2) + (1 - lb)) & " " & B(x, y) Next Next End Sub Public Function Stack(A() As Single, B() As Single) As Single() Dim fStack() As Single Dim Au1 As Long, Au2 As Long, Bu1 As Long, Bu2 As Long Dim lnbt1 As Long, lnbt2 As Long, adr1 As Long, adr2 As Long, adr3 As Long, adr4 As Long, optbas As Long Au1 = UBound(A, 1): Au2 = UBound(A, 2) Bu1 = UBound(B, 1): Bu2 = UBound(B, 2) If (Au1 <> Bu1) Then Exit Function ' первая размерность дожна быть одинаковой !!! optbas = LBound(A, 1)' option base is 1 ? ReDim fStack(Au1, Au2 + Bu2 + 1 - optbas) lnbt1 = 4 * (Au1 + 1) * (Au2 + 1 - optbas) lnbt2 = 4 * (Bu1 + 1 - optbas) * (Bu2 + 1 - optbas) adr1 = VarPtr(fStack(optbas, optbas))' адрес fStack adr2 = VarPtr(fStack(optbas, Au2 + 1))' адрес вставки adr3 = VarPtr(A(optbas, optbas))' адрес A adr4 = VarPtr(B(optbas, optbas))' адрес B CpyAdr adr1, adr3, lnbt1 CpyAdr adr2, adr4, lnbt2 Stack = fStack End Function Ответить

Номер ответа: 8 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #8	Добавлено: 26.05.07 01:17
	sorry. lnbt1 = 4 * (Au1 + 1 - optbas) * (Au2 + 1 - optbas) lnbt2 = 4 * (Bu1 + 1 - optbas) * (Bu2 + 1 - optbas) Ответить

Номер ответа: 9 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #9	Добавлено: 26.05.07 02:27
	ReDim fStack(UBound(A, 1) + UBound(B, 1), UBound(A, 2)) fStack = A ReDim fStack (...) ebug.Print UBound(fStack, 2) fStack = A ebug.Print UBound(fStack, 2) таким способом ты не массив копируешь а присваеваешь переменную Ответить

Номер ответа: 10 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008	Web-сайт: sham.clan.su Профиль \| \| #10	Добавлено: 26.05.07 13:12
	Private Declare Sub CpyAdr Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) я нигде не нашел описание этой функции ReDim fStack (...) ebug.Print UBound(fStack, 2) fStack = A ebug.Print UBound(fStack, 2) таким способом ты не массив копируешь а присваеваешь переменную так весь массив же копируется, в чем разница? и как по-другому? fStack() = A() ? Ответить

Номер ответа: 11 Автор ответа: -АлександР- Вопросов: 55 Ответов: 1008	Web-сайт: sham.clan.su Профиль \| \| #11	Добавлено: 26.05.07 13:21
	If (Au1 <> Bu1) Then Exit Function ' первая размерность дожна быть одинаковой !!! это плохо, у меня по условию - именно вторая всегда одинакова, а второая может быть любой ладно, спасибо, EUGY, большое, ты ввел меня в функцию CopyMemory но по-видимому пока не судьба Ответить

Номер ответа: 12 Автор ответа: EUGY Вопросов: 0 Ответов: 454	Профиль \| \| #12	Добавлено: 26.05.07 13:30
	1: Private Declare Sub QWERTYCpyAdrZXCVB Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) 'это просто объявление синонима функции RtlMoveMemory с нужной сигнатурой. 2: Элементы массива в памяти раполагаются последовательно так: A(0,0) A(0,1) A(0,2) ... A(1,0) A(1,1) A(1,2)... это означает что правая размерность изменяется быстрее, если у тебя правые размерности одинаковые тогда нужно предусмотреть постраничную запись. Ответить

Страница: 1 |