Объясните мне, товарищи, могу ли я работать со строкой, как с массивом?
Я создаю в аксесе форму. Кладу на неё EditBox. Мне надо текст оттуда вытаскивать посимвольно. Я использую для этого функцию mid, но нельзя ли как-нибудь проще?

в Accesse есть возможность использовать большинство комманд и функций vb... попробуй тогда left() и right()

Я не знаю сработает ли это в Access, но в VB работает без проблем

Код

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Sub Example()   Dim b() As Byte   Dim s As String     s = "Hello world"   ReDim b(1 To Len(s))     CopyMemory b(1), ByVal s, Len(s)     MsgBox ChrB(b(7)) & ChrB(b(8)) & ChrB(b(9)) & ChrB(b(11)) 'Вернет " word " End Sub

Мой код ниже
Вот как бы его улучшить? некрасивый он, на мой взгляд. Притом мне совсем не нраится именно выдерание символов из строки при помощи функции.

Код

Dim strTemp As String    Dim strSymbol As String    strTemp = txtMemo.Value        If strTemp <> "" Then        For i = 1 To Len(txtMemo.Value)            strSymbol = Mid(strTemp, i, 1)            rstTemp.Open "SELECT * FROM tblHaf WHERE Symbol = '" & strSymbol & "'", CurrentProject.Connection, adOpenDynamic, adLockOptimistic            If rstTemp.BOF = True And rstTemp.EOF = True Then                rstTemp.AddNew                rstTemp("Symbol") = strSymbol                rstTemp("Quant") = 1                rstTemp("Frequency") = 1 / Len(txtMemo.Value)                rstTemp.Update            Else                rstTemp("Quant") = rstTemp("Quant") + 1                rstTemp("Frequency") = rstTemp("Quant") / Len(txtMemo.Value)                rstTemp.Update            End If                                rstTemp.Close        Next i    End If

Вот вариант, должен работать быстрее, но я не мерил.
А зачем это нужно, если не секрет?

Код

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Sub Command1_Click()    Dim rstTemp As Recordset    Dim strTemp As String    Dim nLen As Integer    Dim b() As Byte    strTemp = Text1.Text    nLen = Len(strTemp) If strTemp = "" Then Exit Sub ReDim b(1 To nLen)   CopyMemory b(1), ByVal strTemp, nLen Set rstTemp = DataEnvironment1.rstTemp rstTemp.Source = "SELECT * FROM tblHaf" rstTemp.Open For i = 1 To nLen    rstTemp.Find "Symbol = '" & Chr(b(i)) & "'"    If rstTemp.EOF = True Then        rstTemp.AddNew        rstTemp("Symbol") = Chr(b(i))        rstTemp("Quant") = 1        rstTemp("Frequency") = 1 / nLen        rstTemp.Update    Else        rstTemp("Quant") = rstTemp("Quant") + 1        rstTemp("Frequency") = rstTemp("Quant") / nLen        rstTemp.Update    End If    rstTemp.MoveFirst Next i rstTemp.Close Set rstTemp = Nothing End Sub

Цитата

Мой код ниже Вот как бы его улучшить?

Код

... With rstTemp .Open "SELECT * FROM tblHaf WHERE Symbol = '" & strSymbol & "'", CurrentProject.Connection, adOpenDynamic, adLockOptimistic If .RecordCount = 0 Then               .AddNew               !Symbol = strSymbol               !Quant = 1 Else               !Quant = !Quant + 1 End If !Frequency = !Quant / Len(txtMemo.Value) .Update .Close End With ...

Зачем это нужно? знанимаюсь реализацией кода Хаффмана...
Дальше еще интересней... вот только не знаю, стоит ли отдельную тему создавать? Вобщем, если что, прошу прощения у модератора.
Смотрим, составили мы нашу табличку. Все ок Теперь надо составить еще одну %)

Цитата

Левое поддерево Text LNode Содержимое вершины Text TopSource Частота Double Frequency Правое поддерево Text RNode

Так вот Надо эту новую табличку заполнить
Великое извращение делать это в аксесе, но приходится.
Соотв. заполнить её по этому алгоритму, беря данные из таблицы, которую заполняли выше.
http://www.avhohlov.narod.ru/p2500ru.htm
Но что-то у меня ну никак не получается придумать алгоритм заполнения...
Буду благодарен за идеи. Да, кстати, тему не стоит переносить в алгоритмы, ибо алгоритм сам я знаю и могу реализовать в других условиях (языках).

Добавлено @ 14:24
Akina, использование конструкции with считается некорректным с точки зрения структурного программирования т.к. она больше запутывает, чем дает реальную выгоду.
RecordCount использовать также не рекомендуется.

Цитата

Use the RecordCount property to find out how many records are in a Recordset object. The property returns -1 when ADO cannot determine the number of records or if the provider or cursor type does not support RecordCount. Reading the RecordCount property on a closed Recordset causes an error. If the Recordset object supports approximate positioning or bookmarks—that is, Supports (adApproxPosition) or Supports (adBookmark), respectively, return True—this value will be the exact number of records in the Recordset, regardless of whether it has been fully populated. If the Recordset object does not support approximate positioning, this property may be a significant drain on resources because all records will have to be retrieved and counted to return an accurate RecordCount value. The cursor type of the Recordset object affects whether the number of records can be determined. The RecordCount property will return -1 for a forward-only cursor; the actual count for a static or keyset cursor; and either -1 or the actual count for a dynamic cursor, depending on the data source.

Можно в старой таблице дерево строить. Так проще.
Изменения
Добавь поля: Level, id_Next_Level, LR. Все Integer
(Замени тип "Symbol" на Integer и работай с ASCII кодом, так избежишь проблем с непечатными символами.) - ето так, мысли в слух

После выполнения получится запись с Level = 1 это и есть верх дерева
От "Symbol" поднимайся на верх по "id_Next_Level" и составляй код по "LR"

Код

Dim db As New Recordset Dim db2 As New Recordset Dim RC As Integer Dim Quant1 As Integer Dim Quant2 As Integer Dim nF1 As Integer db.CursorLocation = adUseClient db2.CursorLocation = adUseClient db2.Open "SELECT tblHaf.id, tblHaf.Quant, tblHaf.Level, tblHaf.id_Next_Level, tblHaf.LR FROM tblHaf WHERE (((tblHaf.Level) = 0));", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic Do db.Open "SELECT tblHaf.id, tblHaf.Quant, tblHaf.Level, tblHaf.id_Next_Level, tblHaf.LR FROM tblHaf WHERE (((tblHaf.Level) = 1)) ORDER BY tblHaf.Quant;", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic RC = db.RecordCount If RC = 1 Then Exit Sub db2.AddNew db2("Level") = 1 db2.Update Quant1 = db("Quant") db("Level") = db("Level") + 1 db("id_Next_Level") = db2("id") db("LR") = 1 db.Update db.MoveNext Quant2 = db("Quant") db("Level") = db("Level") + 1 db("id_Next_Level") = db2("id") db("LR") = 0 db.Update db2("Quant") = Quant1 + Quant2 db2.Update DoEvents db.Close Loop Until RC = 1 db2.Close

Байты в строку и наоборот:
Private Declare Function lstrcpyToArray Lib "kernel32" Alias "lstrcpyA" (deststring As Byte, ByVal srcstring$) As Long
Private Declare Function lstrcpyFromArray Lib "kernel32" Alias "lstrcpyA" (ByVal deststring$, srcstring As Byte) As Long

Использовать так:
Call lstrcpyToArray(buffer(0), string)
Call lstrcpyFromArray(string, buffer(0))

Это сообщение отредактировал(а) Alexei - 21.5.2004, 08:27

Alexei, да неправильный это подход... цель была найти какой-нить простой способ без объявления дополнительных функций. А так и с функцией mid неплохо работает.