Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > Со строкой, как с массивом

Автор: Baa 15.5.2004, 13:10

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

Автор: Skywalker 15.5.2004, 20:26

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

Автор: -Mikle- 15.5.2004, 21:31

Я не знаю сработает ли это в 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

Автор: Baa 18.5.2004, 01:18

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

Код


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

Автор: Vach 19.5.2004, 17:22

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

Код

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

Автор: Akina 19.5.2004, 18:07

Цитата

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

Код


...
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
...

Автор: Baa 20.5.2004, 14:18

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

Теперь надо составить еще одну %)

Цитата

Левое поддерево 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.

Автор: Vach 20.5.2004, 16:19

Можно в старой таблице дерево строить. Так проще.

Изменения
Добавь поля: 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

Автор: Alexei 21.5.2004, 08:27

Байты в строку и наоборот:
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))

Автор: Baa 22.5.2004, 00:46

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