I am studying modem i/o and am setting the uart through com1: and the base address x03f8 and am wondering if the uart connection to the modem must be equal? I am doing this in QB64.
If you're referring to the baud rate, then the com port setting must be the same or higher than the modem baud rate desired.
Found this DLAB subroutine:
' sets port dlab (Divisor Latch Access Bit)
SUB SetBPS (Var)
SELECT CASE Var
CASE 1 ' 19200
LByte = 6
CASE 2 ' 38400
LByte = 3
CASE 3 ' 57600
LByte = 2
CASE 4 ' 115200
LByte = 1
END SELECT
Var2 = Base.Address
IF Var2 = 0 THEN
SELECT CASE Port
CASE 0
Var2 = &H3F8
CASE 1
Var2 = &H2F8
CASE 2
Var2 = &H3E8
CASE 3
Var2 = &H2E8
CASE 4
Var2 = &H3E0
CASE 5
Var2 = &H2E0
CASE 6
Var2 = &H338
CASE 7
Var2 = &H238
CASE ELSE
EXIT SUB
END SELECT
END IF
' divisor latch low
LSB = Var2 ' 3F8x
' divisor latch high
MSB = Var2 + 1 ' 3F9x
' line control register
LCR = Var2 + 3 ' 3FBx
MSBSave = INP(MSB)
OUT MSB, 0
OUT LCR, 128 ' dlab
' set baud rate
OUT LSB, LByte ' least significant byte
OUT MSB, 0 ' most significant byte
OUT LCR, 3 ' n,8,1
OUT MSB, MSBSave
END SUB
After opening the communications device as a file can you adjust the uart baud rate and set it to match the modem baud using the dlab register?
Related
Typically the accepted approach is to do the following
Number to Letter
public function numberToLetter(ByVal i as long) as string
Dim s as string: s = cells(1,i).address(false,false)
numberToLetter = left(s,len(s)-1)
end function
Letter to Number
Public Function letterToNumber(ByVal s As String) As Long
letterToNumber = Range(s & 1).Column
End Function
However neither of these are particular optimal, as in each case we are creating an object, and then calling a property accessor on the object. Is there a faster approach?
Summary
The core thing to realise is that the lettering system used in Excel is also known as Base26. NumberToLetter is encoding to Base26 from decimal, and LetterToNumber is decoding from Base26 to decimal.
Base conversion can be done with simple loops and
Function base26Encode(ByVal iDecimal As Long) As String
if iDecimal <= 0 then Call Err.Raise(5, "base26Encode" ,"Argument cannot be less than 0")
if iDecimal >= 16384 then Call Err.Raise(5, "base26Encode" ,"There are only 16384 columns in a spreadsheet, thus this function is limited to this number.")
Dim s As String: s = ""
Do
Dim v As Long
v = (iDecimal - 1) Mod 26 + 1
iDecimal = (iDecimal - v) / 26
s = Chr(v + 64) & s
Loop Until iDecimal = 0
base26Encode = s
End Function
Function base26Decode(ByVal sBase26 As String) As Long
sBase26 = UCase(sBase26)
Dim sum As Long: sum = 0
Dim iRefLen As Long: iRefLen = Len(sBase26)
For i = iRefLen To 1 Step -1
sum = sum + (Asc((Mid(sBase26, i))) - 64) * 26 ^ (iRefLen - i)
Next
base26Decode = sum
End Function
Performance
I tested the performance of these functions against the original functions. To do this I used the stdPerformance class of stdVBA.
The code used for testing is as follows:
Sub testPerf()
Dim cMax As Long: cMax = 16384
With stdPerformance.Measure("Encode Original")
For i = 1 To cMax
Call numberToLetter(i)
Next
End With
With stdPerformance.Measure("Encode Optimal")
For i = 1 To cMax
Call base26Encode(i)
Next
End With
With stdPerformance.Measure("Decode Original")
For i = 1 To cMax
Call letterToNumber(base26Encode(i))
Next
End With
With stdPerformance.Measure("Decode Optimal")
For i = 1 To cMax
Call base26Decode(base26Encode(i))
Next
End With
End Sub
The results for which are as follows:
Encode Original: 78 ms
Encode Optimal: 31 ms
Decode Original: 172 ms
Decode Optimal: 63 ms
As shown this is a slightly faster approach (2-3x faster). I am fairly surprised that object creation and property access performed so well however.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
So, I have two strings that are each a max length of 100.
Dim a as String ''has a max length of 100
Dim b as String ''has a max length of 100
These two strings need to be truncated and combined into a new string.
Dim c as String 'has a max length of 100
I need to be able to truncate each string appropriately so that I can get string c as close to 100. I was going to do a bunch of statements by 25 to truncate each one.
if a.length = 100 and b.length =0 then
return a
else if a.length = 100 andalso b.length <= 25 then
return a.truncate(75) & b
else if a.length = 100 andalso b.length <= 50 then
return a.truncate(50) & b
else if....
and so one to hit all the scenarios...
I feel like there is a better way to do this and a more efficient way so that i may not hit scenarios like a.length = 100 and b.length = 51. I would be truncating more characters then needed.
Any suggestions?? Please critique me as needed.
EDIT, This is vb.Net..not C# (I'm between Projects) Sorry!
The reason i do not want to just add them together and truncate them is because if both strings are 100 in length, it will completely truncate off the second string. If they are both 100 then I would want to truncate string a to 50 in length and string b to 50 in length so when they are combined they are 100 total. In other words I need some text from both strings.
If the total length of the strings is greater than the limit then you could take a fraction of each in proportion to their lengths:
Module Module1
Function CombineWithLengthConstraint(a As String, b As String, totalLength As Integer) As String
' trivial case 1:
If totalLength < 1 Then
Return String.Empty
End If
Dim aLen = Len(a)
Dim bLen = Len(b)
' trivial case 2:
If aLen + bLen <= totalLength Then
Return a & b
End If
' impossible-to-satisfy-equably case:
If totalLength = 1 Then
If aLen > 0 Then
Return a.Substring(0, 1)
ElseIf bLen > 0 Then
Return b.Substring(0, 1)
Else
Return String.Empty
End If
End If
' aportion the lengths of the strings to be taken in the ratio of their lengths:
Dim aFrac = CInt(Math.Round(aLen / (aLen + bLen) * totalLength, MidpointRounding.AwayFromZero))
Dim bFrac = CInt(Math.Round(bLen / (aLen + bLen) * totalLength, MidpointRounding.AwayFromZero))
' ensure there is at least one character from each string...
If aFrac = 0 Then
aFrac = 1
bFrac -= 1
End If
If bFrac = 0 Then
bFrac = 1
aFrac -= 1
End If
Dim aPart = a.Substring(0, aFrac)
Dim bPart = b.Substring(0, bFrac)
Return aPart & bPart
End Function
Sub Main()
Dim a = New String("A"c, 10)
Dim b = New String("b"c, 40)
Dim c = CombineWithLengthConstraint(a, b, 10)
Console.WriteLine(c)
Console.WriteLine(Len(c))
Console.ReadLine()
End Sub
End Module
Outputs:
AAbbbbbbbb
10
As you can see, the first string, which was 1/5 of the total number of characters, ended up contributing 1/5 of the result.
The VB.NET Len function gives 0 if its argument is Nothing.
I tested it as working with all lengths from 0 to 100 of both strings being combined into one string of length 100 just in case I had made a mistake with the rounding or anything.
Of course, you could return, say, the ending part of string b instead of the starting part if that made sense in the particular application.
Although not exactly what you asked for, here's another option...
Public Function WeirdConcatinate(a As String, b As String) As String
Dim totalLen = a.Length + b.Length
If totalLen > 100 Then
Dim aLen = 100 * a.Length \ totalLen
Dim bLen = 100 - aLen
Return a.Remove(aLen) & b.Remove(bLen)
Else
Return a & b
End If
End Function
This will give you a number of characters from each string (approximately) proportional to how long they are compared to each other. If both strings are the same length, you'll get 50 from each. If a.Length = 100 and b.Length = 50, you'll end up with 66 from a and 34 from b.
Truncate them after concatenating them, then:
Dim c = a & b
If c.Length > 100 Then c = c.Remove(100)
If you want to preserve as much as possible of the start of each string:
Dim c = ""
If(a.Length > 50 AndAlso b.Length < 50)
c = a.Remove(100 - b.Length) & b
Else If a.Length > 50 AndAlso b.Length > 50
c= a.Remove(50) & b.Remove(50)
Else
c = a & b
End if
If c.Length > 100 Then c = c.Remove(100)
As with some other answers, the algorithm is open to interpretation. My method takes from each string until 100 total characters are taken or the string runs out of characters.
Private Function concat(a As String, b As String, length As Integer) As String
Dim ca As New System.Text.StringBuilder()
Dim cb As New System.Text.StringBuilder()
For i As Integer = 0 To length - 1
ca.Append(If(i >= a.Length, "", a(i)))
cb.Append(If(i >= b.Length, "", b(i)))
If ca.Length + cb.Length >= length Then Exit For
Next
Return (ca.ToString() & cb.ToString() & New String(" "c, 100)).Substring(0, length)
End Function
Sub Main()
Dim a As String = New String("a"c, 0)
Dim b As String = New String("b"c, 5)
Dim c As String = concat(a, b, 100)
Console.WriteLine($"'{c}'")
End Sub
'bbbbb '
(padded to 100 characters, doesn't render in block quote)
Dim a As String = New String("a"c, 30)
Dim b As String = New String("b"c, 90)
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'
Dim a As String = New String("a"c, 72)
Dim b As String = New String("b"c, 64)
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'
(your example in a comment. 72 >> 50, 64 >> 50)
I am new to VB and I am trying to get a program to output text instead of hex. I found the code online, a program called maxiCOM. Here is the link http://www.innovatic.dk/knowledg/SerialCOM/SerialCOM.htm. The source code can be downloaded at the bottom of the page.
Unfortunately, the level of coding in the program is far above my level of understanding, and I don't really get how to change the output from hex to text. I would greatly appreciate it if someone could explain to me how to do this. The snippet of the code is
Public Class MaxiTester
Dim SpaceCount As Byte = 0
Dim LookUpTable As String = "0123456789ABCDEF"
Dim RXArray(2047) As Char ' Text buffer. Must be global to be accessible from more threads.
Dim RXCnt As Integer ' Length of text buffer. Must be global too.
' Make a new System.IO.Ports.SerialPort instance, which is able to fire events.
Dim WithEvents COMPort As New SerialPort
Private Sub Receiver(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs) Handles COMPort.DataReceived
Dim RXByte As Byte
Do
'----- Start of communication protocol handling -----------------------------------------------------------
' The code between the two lines does the communication protocol. In this case, it simply emties the
' receive buffer and converts it to text, but for all practical applications, you must replace this part
' with a code, which can collect one entire telegram by searching for the telegram
' delimiter/termination. In case of a simple ASCII protocol, you may just use ReadLine and receive
' in a global string instead of a byte array.
' Because this routine runs on a thread pool thread, it does not block the UI, so if you have any data
' convertion, encryption, expansion, error detection, error correction etc. to do, do it here.
RXCnt = 0
Do
RXByte = COMPort.ReadByte
RXArray(RXCnt) = LookUpTable(RXByte >> 4) ' Convert each byte to two hexadecimal characters
RXCnt = RXCnt + 1
RXArray(RXCnt) = LookUpTable(RXByte And 15)
RXCnt = RXCnt + 1
RXArray(RXCnt) = " "
RXCnt = RXCnt + 1
SpaceCount = (SpaceCount + 1) And 31 ' Insert spaces and CRLF for better readability
If SpaceCount = 0 Then ' Insert CRLF after 32 numbers
RXArray(RXCnt) = Chr(13) ' CR
RXCnt = RXCnt + 1
RXArray(RXCnt) = Chr(10) ' LF
RXCnt = RXCnt + 1
Else
If (SpaceCount And 3) = 0 Then ' Insert two extra spaces for each 4 numbers
RXArray(RXCnt) = " "
RXCnt = RXCnt + 1
RXArray(RXCnt) = " "
RXCnt = RXCnt + 1
End If
End If
Loop Until (COMPort.BytesToRead = 0)
'----- End of communication protocol handling -------------------------------------------------------------
Me.Invoke(New MethodInvoker(AddressOf Display)) ' Start "Display" on the UI thread
Loop Until (COMPort.BytesToRead = 0) ' Don't return if more bytes have become available in the meantime
End Sub
' Text display routine, which appends the received string to any text in the Received TextBox.
Private Sub Display()
Received.AppendText(New String(RXArray, 0, RXCnt))
End Sub
System.Text.Encoding.Unicode.GetString(bytes) 'bytes is your byte array'
Notice the first line after Do in your inner loop:
RXByte = COMPort.ReadByte
This is the only point in your code where you have the actual byte value read from the COM port. After this point the code converts the byte into two hex values using bit-shifting. You should create a global variable of string type and append the read byte value to this string before it is lost.
Add the following line immediately after the above line:
YourString &= Convert.ToChar(RXByte).ToString()
where YourString is your global string variable.
Note that you can attain some efficiency by using StringBuilder instead of string, but I'm leaving that for you as exercise.
I'm going through this GNU awk example. This program needs the ord() and chr() library functions.
And that's where I get a little confused. I don't understand what does this code snippet does:
BEGIN { _ord_init() }
function _ord_init( low, high, i, t)
{
low = sprintf("%c", 7) # BEL is ascii 7
if (low == "\a") { # regular ascii
low = 0
high = 127
} else if (sprintf("%c", 128 + 7) == "\a") {
# ascii, mark parity
low = 128
high = 255
} else { # ebcdic(!)
low = 0
high = 255
}
for (i = low; i <= high; i++) {
t = sprintf("%c", i)
_ord_[t] = i
}
}
If you remove it (BEGIN { _ord_init() }) and run the split.awk example, it works but in a strange way: there's a file called "xa?" that appear and the file "xab" is missing.
This is the input I have:
1 2 3 hello
1 3 4 world
2 4 5 india
4 2 1 china
I run the split program as such:
awk -f split.awk -2 input.txt
And the content of split.awk is as such: well its the code in the two preivous urls put into one file "split.awk".
So again, what does the function _ord_init do exactly?
It define the character set to use at runtime.
It uses a local response to a specific request ( sprintf("%c", 7) and sprintf("%c", 128 + 7) == "\a") to allow chr() and ord() to answer in the same character set.
3 main family set are treated (other are untreated here)
- ascii (most used at development time of awk)
- parity ascii (ASCII but with the 8th bit is always set to 1 instead of 0 or parity breaker in transmission [to insure there is always an odd number of 1])
- ebcdic (typically mainframe)
I want to determine the color of a current cell.
When I
Debug.Print ActiveCell.Font.Color
I get back a number. In this case 24832
How do I determine the proper RGB value of this color given that I only have this number?
Is there some function that turns an int into RGB(0,0,0)?
There is no built-in VBA conversion to RGB, you will need to write your own.
Try This
Function ColorToRgb(Color As Variant) As Variant
' return #Value Error for invalid colors
If Color < 0 Or Color > 16777215 Then
ColorToRgb = CVErr(xlErrValue)
End If
ReDim Res(1 To 3) As Variant
' Treating Color as a 24 bit number
Res(1) = Color Mod 256 ' Red value: left most 8 bits
Res(2) = Color \ 256 Mod 256 ' Green value: middle 8 bits
Res(3) = Color \ 65536 Mod 256 ' Blue value: right most 8 bits
ColorToRgb = Res
End Function
This is a much quicker bit mask for RGB components:
Function RGBComp(Clr As Variant) As Variant
If Clr >= 0 Or Clr <= 16777215 Then
RGBComp = Array(Clr And &HFF, (Clr And &HFF00&) \ &H100&, (Clr And &HFF0000) \ &H10000)
Else
RGBComp = CVErr(xlErrValue)
End If
End Function