Example Intro and HalPromIde24

[Frank Brübach]

Hello all

I am working at a new update of halProment

Next to See will be a simple OpenGL example and a new gui example Double Buffer Just for Testing

Pics below

[Frank Brübach]

OK Here four new example they are running all with latest Update

First example : Timer Array Speed example

'

Code Select Expand

' speed timer example with array redim
'
Type SYSTEMTIME
    word wYear
    word wMonth
    word wDayOfWeek
    word wDay 
    word wHour 
    word wMinute
    word wSecond
    word wMilliseconds
End Type

Declare GetSystemTime LIB "KERNEL32.DLL" ( SYSTEMTIME *lpSystemTime )
Declare GetLocalTime  Lib "kernel32.dll" ( ByRef lpSystemTime As SYSTEMTIME )

  function TimeLapsesMis(SYSTEMTIME *ti1,*ti2) as long
  =====================================================
  '<60 second timer
  long tad = ti2.wMilliSeconds-ti1.wMilliseconds+
  ((ti2.wSecond-ti1.wSecond)*1000)+
  ((ti2.wMinute-ti1.wMinute)*60000)+
  ((ti2.wHour-ti1.wHour)*3600000)+
  ((ti2.wDayOfWeek-ti1.wDayOfWeek)*86400000)
  '
  'end of week crossing
  if tad<0 then tad+=604800000
  return tad
  end function

'---Variables declaration
dim MaxCount  as long
maxCount = 1e7 '10 million

'maxCount = 10000000
SYSTEMTIME  thisTime0
SYSTEMTIME  thisTime1

'---Start time
GetSystemTime thisTime0

'---Dimension the array
redim pro MyArray(maxcount)

dim count as long

'---Fill the array
for Count = lbound(MyArray) to ubound(MyArray)
  MyArray(Count) = Count*Count '^2
next

'---End time
GetSystemTime thisTime1

'format 'str better here
print "total time to fill an EXT array of " + MaxCount + " elements: " + str(TimeLapsesMis(thisTime0,thisTime1), "###") + " msecs"



[Frank Brübach]

Here three new functions Like extract, retain, remain for String manipulations

Extract example

Code Select Expand

' -- extract function go, halProment, 6-6-24
'
Function Extract( ByRef nStart as Integer, _
                  ByRef sMainString   As String, _
                  ByRef sMatchPattern As String) As String

    Dim nLenMain As Integer = Len(sMainString)             
    Dim i As Integer
   
    If (nStart = 0) Or (nStart > nLenMain) Then Return ""
    If nStart < 0 Then nStart = nLenMain + nStart + 1
   
    i = Instr(nStart, sMainString, sMatchPattern)
    If i Then
       Function = Mid(sMainString, nStart, i-nStart )
    Else
       Function = Mid(sMainString, nStart)
    End If
End Function


dim a as string
dim i as long
i=1
a = Extract(1,"abacadabra","cad")
print a  ' aba


[Frank Brübach]

Remain example

Code Select Expand

' -- remain function go, halProment, 6-6-24
'

Function Remain(ByRef nStart        As Integer, _
                ByRef sMainString   As String, _
                ByRef sMatchPattern As String) As String

    Dim nLenMain As Integer = Len(sMainString)
    Dim i As Integer
    If nStart = 0 Or nStart > nLenMain Then Return ""
    If nStart < 0 Then nStart = nLenMain + nStart + 1
   
    i = Instr(nStart, sMainString, sMatchPattern)
    If i Then
       Function = Mid(sMainString,i+Len(sMatchPattern))
    Else
       Function = ""
    End If   
End Function

dim a as string
dim i as integer
i=1
     a = Remain(i,"yes, I have two big porsche matchbox cars in my garage", ",")
     print a ' result: I have two big porsche matchbox cars in my garage

'print "ok"

If you have questions to this and other examples please ask thx, Frank

[Frank Brübach]

Retain example

Code Select Expand

' retain

Function my_RetainAny( ByRef sMainString   As String, _
                       ByRef sMatchPattern As String) As String

    Dim nLenMain  As Integer = Len(sMainString)
    Dim nLenMatch As Integer = Len(sMatchPattern)
    If nLenMatch = 0 Then Return ""
   
    Dim y     As Integer = 1
    Dim i     As Integer = 1
    Dim sChar As String
    Dim s     As String
   
    For y = 1 To Len(sMainString)     
        sChar = Mid(sMainString, y, 1)
        i = Instr( sMatchPattern, sChar )
        If i > 0 Then s = s + sChar
    Next
    Return s
End Function

string a,b,c

a = "<ts>y2334958690xdu7v<ab;db;d>y2334958690xdu7v</ts>"

b = my_RetainAny(a,"<;/ts>")
print b

c = my_RetainAny(a,"123456789") ' any
print c


[Frank Brübach]

Good morning Here I add Last Not least a Tally function I have forgotten to send Yesterday

Code Select Expand

'
' tally example, halProment, 06-06-2024, go
'
' Declare the Tally function
' DECLARE FUNCTION Tally(search AS STRING, data AS STRING) AS INTEGER

' Define the Tally function
FUNCTION Tally(string search, datas ) AS INTEGER
    DIM count AS INTEGER = 0 ' Initialize the counter
    DIM i AS INTEGER ' Loop variable

    ' Loop through each occurrence of the delimiter in the data string
    FOR i = 1 TO LEN(datas) STEP LEN(search)
        ' If the substring at this position is equal to the search string, increment the counter
        IF MID(datas, i, LEN(search)) = search THEN
            count = count + 1
        END IF
    NEXT i

    ' Return the count
    RETURN count
END FUNCTION

' Example usage
DIM datas AS STRING = "BJF1, BJF2, BJF1, BJF3, BJF1, BJF4"
PRINT "The string 'BJF1' occurs " + STR(Tally("BJF1", datas)) + " times in the data."

' result 3 times