Sorry your browser is not supported!

DeclareDBPEventHandler "TestEvent", fp_Test1()

Make Object Cube 1, 50

do
	
	CallingFunction()
	DBPDoEvents
	If Inkey$() <> "" then Goto ENDPROGRAM
loop

function fp_Test1()
	value = Get PTR to Next Function()
endfunction value

function Test1()
	color object 1, rgb(0,255,0)
	Rotate Object 1, Object Angle X(1) +.001, Object Angle Y(1) +.001, 0
endfunction

function CallingFunction()
	color object 1, rgb(255,0,0)
	RaiseDBPEvent "TestEvent"
endfunction

ENDPROGRAM:
UnloadEventHandling

Imports System.Windows.Forms
Imports System.Runtime.InteropServices

Public Class EventManager

		'This calls the CallFunctionPtr function from the Matrix1Util_20.dll
		'NOTE: I have tried this as a cdecl, stdcall, and even a winapi call.
		'There was no visible difference in results for any method I used.
    <DllImport("Matrix1Util_20.dll", EntryPoint:="CallFunctionPtr", CallingConvention:=CallingConvention.StdCall)> _
    Private Shared Sub CallFunctionPtr(ByVal FunctionPointer As Long)
    End Sub

		'Pretty self explanitory. This is the structure of the message as stored in MessageQueue
    Public Structure EventMessage
        Public EventType As String
        Public Handler As Long
        Public ArgumentList As List(Of Object)
    End Structure

		'This keeps a list of  key/value pairs of EventName/FunctionAddress
    Private Shared HandlerList As Dictionary(Of String, Long)

		'Again it is self explanitory. This is a first-in, first-out collection.
    Private Shared MessageQueue As Queue(Of EventMessage) = New Queue(Of EventMessage)

		'Initializes what needs to be initialized.
    Public Shared Sub InitEventHandling()
        HandlerList = New Dictionary(Of String, Long)
    End Sub

		'Disposes of a few resources just to be safe and eliminate them as a cause.
    Public Shared Sub UnloadEventHandling()
        HandlerList = Nothing
        MessageQueue = Nothing
    End Sub

		'Adds an EventName and FunctionAddress to the Dictionary list.
    Public Shared Sub DeclareDBPEventHandler(ByVal EventName As String, ByVal FunctionAddress As Long)
        HandlerList.Add(EventName, FunctionAddress)
    End Sub
    
    'Used to raise an event with no arguments in DBPro code.
    Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String)
    		'Checks to make sure that the Event has been declared and is in the Dictionary
        If HandlerList.ContainsKey(EventName) Then
        		'makes a new message to go in the queue.
            Dim message As New EventMessage
            'set the message attributes.
            message.EventType = EventName
            message.Handler = HandlerList.Item(EventName)
            'put the message at the end of the queue
            MessageQueue.Enqueue(message)
        End If
    End Sub

		'Handles events by poping them out of the MessageQueue
    Public Shared Sub DBPDoEvents()
    
    		'This will be the message that gets Dequeued from the MessageQueue
        Dim currentmessage As EventMessage = New EventMessage

				'Keep handling until the MessageQueue is empty.
        Do While MessageQueue.Count > 0

						'Just in case to keep things from being locked up.
            Application.DoEvents()

						'Pop the message out of the MessageQueue
            currentmessage = MessageQueue.Dequeue

						'So that I don't have to keep adding this onto the beginning of come items
            With currentmessage

								'This code is in place to later deal with calls that have more arguments.
								'As of right now argcount will always be 0 with my example and the code
								'is not setup to handle more.
                Dim argcount As Integer

                If .ArgumentList Is Nothing Then
                    argcount = 0
                Else
                    argcount = .ArgumentList.Count
                End If

								'Again, set up to handle more than one argument.
                Select Case argcount
                    Case 0

												'NOTE: this is the culprit.
                        Try
                            CallFunctionPtr(.Handler)
                        Catch ex As Exception
                        		'With this line enabled, you can see the error that it is giving
                        		'however you will have to end task it. With this line disabled you can
                        		'see that the code works except for the crash bug at the end.
                            MessageBox.Show(ex.ToString)
                        End Try

												'CODE THAT IS COMMENTED OUT IS INTENDED FOR LATER HANDLING MULTIPLE ARGUMENTS

                        'Case 1
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0))
                        'Case 2
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1))
                        'Case 3
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2))
                        'Case 4
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2), .ArgumentList(3))
                        'Case 5
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2), .ArgumentList(3), .ArgumentList(4))
                        'Case 6
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2), .ArgumentList(3), .ArgumentList(4), .ArgumentList(5))
                        'Case 7
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2), .ArgumentList(3), .ArgumentList(4), .ArgumentList(5), .ArgumentList(6))
                        'Case 8
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2), .ArgumentList(3), .ArgumentList(4), .ArgumentList(5), .ArgumentList(6), .ArgumentList(7))
                        'Case 9
                        '    MatrixFunctionPointers.CallFunctionPtr(.Handler, .ArgumentList(0), .ArgumentList(1), .ArgumentList(2), .ArgumentList(3), .ArgumentList(4), .ArgumentList(5), .ArgumentList(6), .ArgumentList(7), .ArgumentList(8))
                End Select
            End With
        Loop
    End Sub
    
    'NOTE: The rest of the code is commented out as it is for calls with arguments.
    'Not sure which type I should use for arguments, but figured Object was the most
    'likely choice, I could be wrong though.
    
    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object, ByVal Argument4 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        message.ArgumentList.Add(Argument4)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object, ByVal Argument4 As Object, ByVal Argument5 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        message.ArgumentList.Add(Argument4)
    '        message.ArgumentList.Add(Argument5)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object, ByVal Argument4 As Object, ByVal Argument5 As Object, ByVal Argument6 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        message.ArgumentList.Add(Argument4)
    '        message.ArgumentList.Add(Argument5)
    '        message.ArgumentList.Add(Argument6)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object, ByVal Argument4 As Object, ByVal Argument5 As Object, ByVal Argument6 As Object, ByVal Argument7 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        message.ArgumentList.Add(Argument4)
    '        message.ArgumentList.Add(Argument5)
    '        message.ArgumentList.Add(Argument6)
    '        message.ArgumentList.Add(Argument7)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object, ByVal Argument4 As Object, ByVal Argument5 As Object, ByVal Argument6 As Object, ByVal Argument7 As Object, ByVal Argument8 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        message.ArgumentList.Add(Argument4)
    '        message.ArgumentList.Add(Argument5)
    '        message.ArgumentList.Add(Argument6)
    '        message.ArgumentList.Add(Argument7)
    '        message.ArgumentList.Add(Argument8)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub

    'Public Overloads Shared Sub RaiseDBPEvent(ByVal EventName As String, ByVal Argument1 As Object, ByVal Argument2 As Object, ByVal Argument3 As Object, ByVal Argument4 As Object, ByVal Argument5 As Object, ByVal Argument6 As Object, ByVal Argument7 As Object, ByVal Argument8 As Object, ByVal Argument9 As Object)
    '    If HandlerList.ContainsKey(EventName) Then
    '        Dim message As New EventMessage
    '        message.EventType = EventName
    '        message.Handler = HandlerList.Item(EventName)
    '        message.ArgumentList.Add(Argument1)
    '        message.ArgumentList.Add(Argument2)
    '        message.ArgumentList.Add(Argument3)
    '        message.ArgumentList.Add(Argument4)
    '        message.ArgumentList.Add(Argument5)
    '        message.ArgumentList.Add(Argument6)
    '        message.ArgumentList.Add(Argument7)
    '        message.ArgumentList.Add(Argument8)
    '        message.ArgumentList.Add(Argument9)
    '        MessageQueue.Enqueue(message)
    '    End If
    'End Sub


End Class

InitEventHandling

DeclareDBPEventHandler "TestEvent", fp_Test1()

Make Object Cube 1, 50

do
	
	CallingFunction()
	DBPDoEvents
	If Inkey$() <> "" then Goto ENDPROGRAM
loop

function fp_Test1()
	value = Get PTR to Next Function()
endfunction value

function Test1()
	color object 1, rgb(0,255,0)
	Rotate Object 1, Object Angle X(1) +.001, Object Angle Y(1) +.001, 0
endfunction

function CallingFunction()
	color object 1, rgb(255,0,0)
	RaiseDBPEvent "TestEvent"
endfunction

ENDPROGRAM:
UnloadEventManager

#define EXPORTC extern "C" __declspec(dllexport)

// Inlined & overloaded functions, simply forwarding the work
inline void MyFunc(int a) { ExternalFunc1(a); }
inline void MyFunc(float b) { ExternalFunc2(b); }

// Actual workers that will also be exported
EXPORTC void ExternalFunc1(int a) { /* Do work here */ }
EXPORTC void ExternalFunc2(float b) { /* Do work here */ }

MyString as string
CompareString as string

MyString = "Fun***on"
CompareString = "Function"

text 10,10, StringMatch(MyString, CompareString)

wait key

end

function StringMatch(Source1 as string, Source2 as string)

	`checking a variable is faster than repeated function calls.
	SLen1 = len(Source1)
	SLen2 = len(Source2)
	
	`if strings are different lengths they won't match
	if SLen1 <> SLen2
		exitfunction "No Match"
	endif

	`If they are identical they match.
	if Source1 = Source2
		exitfunction "Match"
	endif
	
	`For everthing else there is ... a manual comparison.
	for counter = 1 to SLen1
		
		`variables are faster... blah blah blah
		S1$ = Mid$(Source1, counter, 1)
		S2$ = Mid$(Source2, counter, 1)	
	
		`if either string has a wildcard in this position, skip it.
		if S1$ <> "*" and S2$ <> "*"
				`if the characters don't match, might as well hang it up.
				if S1$ <> S2$
					exitfunction "No Match"
				endif			
		endif
	next counter
`if you have made it here, then they match.
endfunction "Match"

function StringMatch2(Source1 as string, Source2 as string)
	
	`if the two strings are the same size continue
	`else return a "No Match"
	If Len(Source1) = Len(Source2)
		
		`This works by replacement
		`It looks for the * character and erases it
		`It then erases the corresponding positioned
		`character in the other string then when all
		`of the *'s have been replaced it compares the
		`results for a match.
		` Fu***ion Function
		` Fu**ion Fuction
		` Fu*ion Fution
		` Fuion Fuion = Match
		while Instr(Source1, "*", 1) <> 0
			pos = Instr(Source1, "*", 1)
			Source1 = Replace$(Source1, pos, 1, "")
			Source2 = Replace$(Source2, pos, 1, "")
		endwhile
		
		`A simple compare of strings
		if Source1 = Source2
			exitfunction "Match"
		else
			exitfunction "No Match"
		endif
		
	else
		exitfunction "No Match"
	endif

endfunction "No Match"

      do
         pos = Instr(Source1, "*", 1)

         if pos = 0 then exit

         Source1 = Remove$(Source1, pos, 1)
         Source2 = Remove$(Source2, pos, 1)
      loop

extern "C" {

  // We will declare all of our function prototypes here
  EXPORT int ReturnValue(void);
  EXPORT DWORD CopyString(LPSTR OldStr, LPSTR OrigStr);
  EXPORT DWORD TestCPP(DWORD FirstNumber, DWORD SecondNumber);
}

EXPORT int TestCPP(int FirstNumber, int SecondNumber)
{
	int d_retval = FirstNumber + SecondNumber;
	return d_retval;
}

Test CPP[%LLL%TestCPP

make bank 1, 1234

for i = 0 to 1233
   write bank byte 1, i, i mod 255
next

open datafile to write 1, "TEST.DAT"
WriteDatafileBank(1, 1)
close datafile 1

delete bank 1

open datafile to read 1, "TEST.DAT"
DatafileBank(1, 1)
close datafile 1

` Verify that the bank is correct
for i = 0 to 1233
   if bank byte(1, i) <> i mod 255
      report error "Bank did not load or save correctly"
   endif
next

print "All done"

wait key
end


function WriteDatafileBank(Datafile as integer, Bank as integer)
   local Current as integer
   local Size as integer

   Size = get bank size( Bank )

   ` Write the banks size to the datafile
   write datafile dword Datafile, Size

   ` Write the bank 8 bytes at a time to the datafile
   Current = 0
   while Size >= 8
      write datafile double integer Datafile, bank double integer(Bank, Current)
      inc Current, 8
      dec Size, 8
   endwhile

   ` Write any left-over bytes to the datafile
   while Size > 0
      write datafile byte Datafile, bank byte(Bank, Current)
      inc Current
      dec Size
   endwhile
endfunction

function DatafileBank(Datafile as integer, Bank as integer)
   local Size as integer
   local Current as integer

   ` Get the bank size from the datafile and create the bank
   Size = datafile dword(Datafile)
   if bank exist(Bank) then delete bank Bank
   make bank Bank, Size

   ` Read 8 bytes at a time from the datafile into the bank
   Current = 0
   while Size >= 8
      write bank double integer Bank, Current, datafile double integer(Datafile)
      inc Current, 8
      dec Size, 8
   endwhile

   ` Read any leftover bytes from the datafile into the bank
   while Size > 0
      write bank byte Bank, Current, datafile byte(Datafile)
      inc Current
      dec Size
   endwhile

   exitfunction get bank size(Bank)
endfunction 0

dbGetLimbTransparency%DLL%GetLimbTransparency%ObjectID, LimbID

APPEND LIMB[%LLLS%AppendLimb_3%Object number, Mesh number, Limb name
APPEND LIMB[%LLL%AppendLimb_2%Object number, Mesh number
APPEND LIMB%LLS%AppendLimb_3%Object number, Mesh number, Limb name

ZONE[%DFF%CheckZone2%Zone, XCoord, YCoord
ZONE[%DFFF%CheckZone3%Zone, XCoord, YCoord, ZCoord

s$ = "abc**123*def"

split string s$, "*"
for k = 1 to split count()
	print str$( k ) + ". " + get split word$( k )
next k

print

split string s$, "**"
for k = 1 to split count()
	print str$( k ) + ". " + get split word$( k )
next k

wait key
end