| Вопрос: ROL, ROR | Добавлено: 19.10.04 02:15 |
Автор вопроса:  CyRax  | Web-сайт: basicproduction.nm.ru | ICQ: 204447456 |
| Понадобилось тут биты вращать. А этой хрени у меня нет для VB. Может у кого завалялась? Киньте пожалуйста. |
| Ответы | Всего ответов: 23 |
|
Номер ответа: 1 Автор ответа:  CyRax  Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #1 | Добавлено: 19.10.04 02:18 |
Оказывается оно у меня есть  ))
Тогда может кто свой вариант покажет чтобы тема не пропала. |
||
|
Номер ответа: 2 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #2 | Добавлено: 19.10.04 02:33 |
| В смысле на VB сделать? | ||
|
Номер ответа: 3 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #3 | Добавлено: 19.10.04 02:44 |
|
Можно и сделать. Я думал может у кого завалялось.
А вот что я придумал. Получить нужное количество бит по размеру. Использовать так. Указываешь номер бита и количество бит. В результате число очистится от всех бит, кроме указанных. А последние будут сдвинуты в начало числа. Т.е., было 00011100, а стало 00000111 Function ExtractBits(ByVal Src As Byte, ByVal Pos As Byte, ByVal Length As Byte) As Byte ' Original: BP (bp@pochtamt.com, cyraxua@hotmail.com) ' a) Move bits to left, b) Move bits to right ' Example: 01110000 | 4 | 3 ' a) 11100000 ; b) 00000111 Dim LeftCount As Byte 'Count to shift by position and length LeftCount = 7 - (Pos + (Length - 1)) 'Shift logical left If LeftCount > 0 Then Src = SHL_B(Src, LeftCount) 'Shift logical right ExtractBits = SHR_B(Src, 8 - Length) End Function Public Function SHL_B(ByVal Arg As Byte, ByVal Sh As Byte) As Byte 'Unknow author. Rebuild for byte by BP Dim Cast As Integer Cast = CInt(Arg) * 2 ^ Sh Cast = Cast And &HFF 'If Cast > 127 Then MsgBox Cast: Cast = Cast - 256 SHL_B = Cast End Function Public Function SHR_B(ByVal Arg As Byte, ByVal Sh As Byte) As Byte 'Unknow author. Rebuild for byte by BP Dim Cast As Integer Cast = CInt(Arg) \ 2 ^ Sh Cast = Cast And &HFF& If Cast > 128 Then Cast = Cast - 256 SHR_B = Cast End Function А это аналог BIN$ Public Function BIN1$(nByte As Byte) ' Original: by Donald, donald@xbeat.net, 20001206 ' Rebuild for byte: by BP BIN1$ = String$(8, 48) ' CHR$(0) For EnumBits = 0 To 7 If nByte And 2 ^ EnumBits Then Mid$(BIN1$, 8 - EnumBits) = "1" End If Next EnumBits End Function |
||
|
Номер ответа: 4 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #4 | Добавлено: 19.10.04 03:10 |
|
Что-то ты про rol спрашивал, а тут shl?
Вот что я с rol придумал: Function ROL(Value As Byte, ShiftCount As Long) As Byte
On Error Resume Next Dim overflow As Byte For i = 1 To ShiftCount Err.Clear overflow = Value * 2 If Err.Number = 6 Then Value = Value And 127 Value = Value * 2 + 1 Else Value = Value * 2 End If Next i ROL = Value End Function |
||
|
Номер ответа: 5 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #5 | Добавлено: 19.10.04 03:18 |
|
Потому и спрашивал. У меня такое есть:
Public Function ROL(ByVal Arg As Integer, ByVal Sh As Byte) As Integer ROL = (SHL(Arg, Sh)) Or (SHR(Arg, 16 - Sh)) End Function Public Function ROR(ByVal Arg As Integer, ByVal Sh As Byte) As Integer ROR = (SHR(Arg, Sh)) Or (SHL(Arg, 16 - Sh)) End Function Это кстати кто то здесь выкидывал. Может даже Fallout. |
||
|
Номер ответа: 6 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #6 | Добавлено: 19.10.04 03:24 |
|
Работает! То что надо. Давай заодно и ROR
|
||
|
Номер ответа: 7 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #7 | Добавлено: 19.10.04 03:29 |
|
Заодно что ты думаешь по такому поводу:
Есть числа запакованные LZW алгоритмом. Допустим 9-битные и упакованы подряд в байты. Т.е. непрерывно идут друг за другом по 9 бит. Как лучше всего их извлекать? Я думал смещать с помощью SHL/R, а потом крутить ROL/ROR. |
||
|
Номер ответа: 8 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #8 | Добавлено: 19.10.04 03:44 |
|
А вот ещё вариация на тему.
Sub SetBit1(Variable As Byte, ByVal BitNum As Byte, ByVal Value As Boolean) '(c) BASIC Production 2004 Select Case Value Case True If Not CBool(Variable And 2 ^ BitNum) Then Variable = Variable + (2 ^ BitNum) End If Case False If CBool(Variable And 2 ^ BitNum) Then Variable = Variable - (2 ^ BitNum) End If End Select End Sub Так скоро можно будет и эмулятор ПиСи написать Кстати неплохо бы раздел по этой дряни открыть.
|
||
|
Номер ответа: 9 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #9 | Добавлено: 19.10.04 04:05 |
|
А с ROR ещё проще оказалось:
Function ROR(Value As Byte, ShiftCount As Long) As Byte
Dim carry As Byte For i = 1 To ShiftCount carry = Value And 1 Value = Value \ 2 If carry = 1 Then Value = Value + 128 Next i ROR = Value End Function |
||
|
Номер ответа: 10 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #10 | Добавлено: 19.10.04 04:08 |
| Про LZW ничего сказать не могу, не смотрел никогда. По идее должны ведь быть отработанные алгоритмы распаковки и примеры. Технология ж уже достаточно старая и объезженная. | ||
|
Номер ответа: 11 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #11 | Добавлено: 19.10.04 04:15 |
|
Старая и объезженная, а никто ничего сказать не может
За ROR спасибо. Скорее всего что оно тоже работает, но всё равно проверю 
|
||
|
Номер ответа: 12 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #12 | Добавлено: 19.10.04 04:35 |
|
Проверяй, а я отчаливаю
|
||
|
Номер ответа: 13 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #13 | Добавлено: 19.10.04 04:50 |
|
Напоследок оптимизированный ROR:
Function ROR(Value As Byte, ShiftCount As Long) As Byte
For i = 1 To ShiftCount Value = (Value \ 2) + (Value And 1) * 128 Next i ROR = Value End Function |
||
|
Номер ответа: 14 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #14 | Добавлено: 19.10.04 05:23 |
|
И измененный ROL впридачу:
Function ROL(Value As Byte, ShiftCount As Long) As Byte
For i = 1 To ShiftCount If (Value And 128) \ 128 = 1 Then Value = (Value And 127 * (Value And 128) \ 128) * 2 + (Value And 128) \ 128 Else Value = Value * 2 End If Next i ROL = Value End Function |
||
|
Номер ответа: 15 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #15 | Добавлено: 19.10.04 06:17 |
|
И ещё один ROL, без IF - END IF:
Function ROL(Value As Byte, ShiftCount As Long) As Byte
overflow = Value For i = 1 To ShiftCount overflow = (overflow * 2 And 255) + (overflow * 2 And 256) \ 256 Next i ROL = overflow End Function |
||