Чтение и изменение бита в числе

@Forgot · Регистрация: 16.06.2015

Доброго времени суток!
Столкнулся с такой проблемой - через СOM порт от контроллера получаю массив байт данных, сохраняю их в виде переменной Double.

Visual Basic
1
2
3
4
5
6
Case Is = 2         
        intInf(0) = Asc(MSComm1.Input) '
        intInf(1) = Asc(MSComm1.Input) ' 
        intInf(2) = Asc(MSComm1.Input) ' 
        intInf(3) = Asc(MSComm1.Input) ' 
       ' и т.д

Каждый установленный бит в числе имеет смысловую нагрузку. Вопрос -каким образом можно обращаться к отдельным битам в числе (Аналог команды в ассемблере setb Acc.N (установить бит N в "1") и clr Acc.N (установить бит N в "0")). Пока что додумался только до преобразования полученного числа в бинарный вид при помощи функции

Visual Basic
1
2
3
4
5
6
7
8
9
10
Public Function ToBin(ByVal bByte As Byte) As String
Dim i As Integer
For i = 0 To 7
If bByte And 2 ^ i Then
ToBin = 1 & ToBin
 Else
ToBin = 0 & ToBin
 End If
Next i
End Function

@MU-GK · 06.12.2017, 04:27

Возможно, кому-то понадобятся функции побитового преобразования числа в строку и наоборот:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function MaskL(ByVal MaskS As String) As Long
 Dim p As Long, m As Long, L As Long
 L = Len(MaskS)
 m = 0
 For p = 0 To L - 1
  If Mid(MaskS, p + 1, 1) = "1" Then m = BitPut(m, p)
 Next p
 MaskL = m
End Function
Function MaskS(ByVal MaskL As Long) As String
 Dim p As Long, S As String
 S = ""
 For p = 0 To 15
  If BitGet(MaskL, p) Then
   S = S & "1"
  Else
   S = S & "0"
  End If
 Next p
 MaskS = S
End Function

Проверочная программка:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub MaskCheck()
 Dim m1 As Long, m2 As Long, m3 As Long
 Dim s1 As String, s2 As String, s3 As String
 Dim rA As String, rB As String
 
 Call InitDeg2
 s1 = "011000":
 s2 = "000011"
 s3 = "011111"
 m1 = MaskL(s1)
 m2 = MaskL(s2)
 m3 = MaskL(s3)
 
 rA = Mid(MaskS(m1 Xor m3), 1, 5)
 rB = Mid(MaskS(m2 ND m3), 1, 5)
End Sub

@testuser2 · 21.07.2024, 14:54

32бит версия )

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Deg2(1 To 32) As Long
Function MaskS(ByVal lNum As Long) As String
    Static init As Boolean
    Dim i As Long, bAr(63) As Byte
    If init Then Else InitDeg2: init = True
'    MaskS2 = String(32, vbNullChar)
    For i = 1 To 32
'        Mid$(MaskS2, i, 1) = CBool(lNum And Deg2(i)) And 1
        bAr((i - 1) * 2) = (CBool(lNum And Deg2(i)) And 1) + 48
    Next
    MaskS = bAr
End Function
Function MaskL(sInp As String) As Long
    Static init As Boolean
    Dim i As Long, bAr() As Byte
    If init Then Else InitDeg2: init = True
    bAr = sInp
    For i = 1 To Len(sInp)
'        If Mid$(sInp, i, 1) = "1" Then
        If bAr((i - 1) * 2) = 49 Then MaskL = MaskL Or Deg2(i)
    Next
End Function
Sub InitDeg2()
    Dim p As Long
    
    Deg2(1) = 1
    For p = 2 To 31
        Deg2(p) = 2 * Deg2(p - 1)
    Next
    Deg2(32) = -2 * Deg2(31)
End Sub

Code
1
2
?MaskL(MaskS(-548722587))
-548722587

@testuser2 · 23.11.2024, 08:00

Добавлю еще битовые сдвиги

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) '2 ^ bitCnt
End Function
Function RightBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    RightBitShift = lVal \ Deg2(bitCnt) '2 ^ bitCnt
End Function

@HackerVlad · 23.11.2024, 08:07

Сообщение от testuser2

Добавлю еще битовые сдвиги

какой из этих битовых сдвигов нужно использовать чтобы написать ту функцию узнавания "размера окна" LZX

@testuser2 · 23.11.2024, 08:10

Левый конечно же )

@HackerVlad · 23.11.2024, 08:26

testuser2, о, спасибо, осталось теперь только написать эту функцию

Добавлено через 10 минут
testuser2, что-то у меня не работает, можешь найти где у меня ошибка?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Private Const tcompSHIFT_LZX_WINDOW As Long = 8
Private Const tcompTYPE_LZX As Long = 3
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Private Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) ' 2 ^ bitCnt
End Function
 
Private Function TCOMPfromLZXWindow(ByVal w As Long) As Long
    TCOMPfromLZXWindow = LeftBitShift(w, tcompSHIFT_LZX_WINDOW) Or tcompTYPE_LZX
End Function
 
Private Sub Command1_Click()
    MsgBox TCOMPfromLZXWindow(21), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(21)) ' 3 это неправильно...
End Sub

Что я не так написал?

@testuser2 · 23.11.2024, 08:33

Сообщение от HackerVlad

Что я не так написал?

Надо Deg2 инициализировать

Добавлено через 1 минуту
Можно проще сделать

Visual Basic
1
2
3
4
Public Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
    TCOMPfromLZXWindow = w * 2 ^ tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
End Function

@HackerVlad · 23.11.2024, 08:34

Сообщение от testuser2

Надо Deg2 не инициализировал

А как его инициализировать? И почему ты не указал об этом в своём коде?

@testuser2 · 23.11.2024, 08:37

HackerVlad, так там же процедура инициализации есть. Ты бы тему прочитал от начала, понял бы что к чему.

@HackerVlad · 23.11.2024, 08:40

Сообщение от testuser2

Ты бы тему прочитал от начала, понял бы что к чему

Ну да, поленился всё читать просто.

Вот короче:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
 
Private Const tcompSHIFT_LZX_WINDOW As Long = 8
Private Const tcompTYPE_LZX As Long = 3
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Private Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) ' 2 ^ bitCnt
End Function
 
'Private Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    TCOMPfromLZXWindow = LeftBitShift(w, tcompSHIFT_LZX_WINDOW) Or tcompTYPE_LZX
'End Function
 
Public Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
    TCOMPfromLZXWindow = w * 2 ^ tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
End Function
 
Private Sub Command1_Click()
    MsgBox TCOMPfromLZXWindow(21), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(21)) ' 5379 тут уже правильно...
End Sub
 
Private Sub Form_Load()
    Dim i As Long
    
    For i = 0 To 31
        Deg2(i) = 0
    Next
End Sub

Так правильно 5379

Добавлено через 28 секунд
А как сделать так чтобы LeftBitShift всё-таки заработал тут

@testuser2 · 23.11.2024, 08:47

Сообщение от HackerVlad

А как сделать так чтобы LeftBitShift всё-таки заработал тут

Хорош прикалываться, нужно выполнить initDeg2 просто перед вычислениями

@HackerVlad · 23.11.2024, 08:53

testuser2, а что ж ты мне сразу не сказал!? я всё не понимал, почему меня не работает

Добавлено через 2 минуты

Сообщение от testuser2

Хорош прикалываться

Я реально не понимал. Неужели сложно было сказать что процедуру нужно запускать в Form_Load.
Ура! Теперь всё работает.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Explicit
Private Const tcompSHIFT_LZX_WINDOW As Long = 8
Private Const tcompTYPE_LZX As Long = 3
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Private Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) ' 2 ^ bitCnt
End Function
 
Private Function TCOMPfromLZXWindow(ByVal w As Long) As Long
    TCOMPfromLZXWindow = LeftBitShift(w, tcompSHIFT_LZX_WINDOW) Or tcompTYPE_LZX
End Function
 
Private Sub Command1_Click()
    MsgBox TCOMPfromLZXWindow(21), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(21)) ' 5379 тут уже правильно...
End Sub
 
Private Sub Command2_Click()
    MsgBox TCOMPfromLZXWindow(15), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(15)) ' 3843 теперь всё правильно
End Sub
 
Private Sub Form_Load()
    initDeg2
End Sub

@testuser2 · 23.11.2024, 09:30

Cамый оптимум вариант для VB6/VBA

Visual Basic
1
2
3
4
5
Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
'    2 ^ tcompSHIFT_LZX_WINDOW = &H100
    TCOMPfromLZXWindow = w * &H100 Or tcompTYPE_LZX
End Function

@Mikle Quits · 23.11.2024, 10:04

Сообщение от testuser2

там же процедура инициализации есть

А зачем старый вариант на умножениях заменён на новый на степенях? Я понимаю, что он выполняется один раз на старте, поэтому не влияет на производительность, но смысла менять не вижу.

@testuser2 · 23.11.2024, 10:09

Сообщение от Mikle Quits

производительность, но смысла менять не вижу.

Просто чтоб понятнее суть была )

@HackerVlad · 23.11.2024, 10:23

Ну разницы в скорости всё равно думаю никакой не будет, какой бы вы способ ни выбрали...

Новые блоги и статьи Все статьи Все блоги /
[golang] Конкурентный fetcher с ограничением максимального количества одновременных HTTP запросов. alhaos 10.06.2026 Задача Реализовать конкурентный fetcher с ограничением максимального количества одновременных HTTP запросов. Сигнатура func Fetch(urls string, maxConcurrent int) Result Пример urls :=. . .	[golang] Состояние гонки (race condition) alhaos 10.06.2026 Состояние гонки (race condition) Состояние гонки (Race Condition) — это ошибка, возникающая при одновременном доступе нескольких горутин к одним и тем же данным без должной синхронизации. При этом. . .	Взрослые отношения, и почему они не получаются kumehtar 09.06.2026 Когда в детстве ребёнок не получает от родителей чего-то важного, он лишается не просто приятных переживаний, а основы для формирования определённых внутренних качеств и навыков. Если ребёнок не. . .	[golang] Worker Pool alhaos 09.06.2026 Worker Pool Worker Pool — паттерн конкурентной обработки задач в Go. Суть: фиксированное количество горутин-воркеров читают задачи из общего канала и пишут результаты в общий канал результатов. . . .
[golang] Pipeline alhaos 08.06.2026 Pipeline Pipeline — паттерн конкурентной обработки данных в Go. Суть: данные проходят через цепочку независимых стадий, каждая из которых работает в своей горутине и общается с соседями через. . .	Свет внутри себя kumehtar 07.06.2026 Пусть это будет здесь lIs4oanZS9Y	Программа для com-порта Uhbif79 05.06.2026 Всем привет, давно хотел изучить Qt, начинал, бросал, потом снова начинал. И сейчас вот смог написать свою первую программу. До этого имел опыт программирования микроконтроллеров, писал прошивки на. . .	Транскрипция 55-минутного видео через Whisper: WhisperDesktop облажался, спас Google Colab[ anaschu 01.06.2026 Понадобилось получить текст из свежезагруженного видео на YouTube. Казалось бы, задача на пять минут. Заняла полтора часа. Делюсь опытом — может кому пригодится последовательность решений. . . .

@testuser2 1401 / 860 / 92 Регистрация: 08.02.2017 Сообщений: 3,657 Записей в блоге: 2
	23.11.2024, 08:10
	Левый конечно же ) 1

@testuser2 1401 / 860 / 92 Регистрация: 08.02.2017 Сообщений: 3,657 Записей в блоге: 2
	23.11.2024, 08:37
	HackerVlad, так там же процедура инициализации есть. Ты бы тему прочитал от начала, понял бы что к чему. 0

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786
	23.11.2024, 10:23
	Ну разницы в скорости всё равно думаю никакой не будет, какой бы вы способ ни выбрали... 0