Quellcode Rock n ride VB 4 für falcon 4.0
 

Hallole, bin jetzt schon mehrfach von rock and ride besitzern wegen dem quellcode in vb 4 für den rock n ride und falcon als besipiel angemailt worden,mir wurde sogar schon geld dafür angeboten, aber logisch den gibts umsonst für die community von mir, bei fragen dazu schreibt bitte direkt an volker.metzger@t-online.de, mit ein bischen zeit kann er ohne umstände an jede simulation die pitch und rolldaten zur verfügung stellt angepasst werden, also fs 2004 und x-plane und lomac, bnitte mailt mir direkt für den ganzen quellcode ist zu lang fürs forum hier

Gruß an alle rock n rider

Volker




Attribute VB_Name = "Modul1"

Dim wert
Dim pause
Dim start
Dim ende
Dim nase1
Dim drehung1
Dim xachse
Dim yachse

Public Type FlightData
x As Single
y As Single
z As Single
xDot As Single
yDot As Single
zDot As Single
alpha As Single
beta As Single
gamma As Single
pitch As Single
roll As Single
yaw As Single
mach As Single
kias As Single
vt As Single
gs As Single
windOffset As Single
nozzlePos As Single
internalFuel As Single
externalFuel As Single
fuelFlow As Single
rpm As Single
ftit As Single
gearPos As Single
speedBrake As Single
epuFuel As Single
oilPressure As Single
lightBits As Integer
End Type

Global F As FlightData, L(29)
Global SharedMemHandle As Long, SharedMemPointer As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numbytes As Long)
Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long



Sub Main()

zahler = 1
Form1.MSComm1.Settings = "2400,n,8,1"
Form1.MSComm1.CommPort = 2
pause = 0.1
Form1.MSComm1.PortOpen = True
xachse = 1
yachse = 1
SharedMemHandle = OpenFileMapping(FILE_MAP_READ, True, "FalconSharedMemoryArea")
SharedMemPointer = MapViewOfFile(SharedMemHandle, FILE_MAP_READ, 0, 0, 0)
CopyMemory F, ByVal SharedMemPointer, Len(F)


If SharedMemHandle Then
While zahler < 2000

zahler = zahler + 1
SharedMemPointer = MapViewOfFile(SharedMemHandle, FILE_MAP_READ, 0, 0, 0)
CopyMemory F, ByVal SharedMemPointer, Len(F)



drehung = (F.roll) * 57.298
nase = (F.pitch) * 57.2958
drehung1 = Fix(drehung)
nase1 = Fix(nase)
If nase1 < -88 Then
nase1 = 0
Else
If nase1 < -85 And nase1 >= -88 Then
nase1 = 2
Else
usw....

If drehung1 < -88 Then
drehung1 = 0
Else
If drehung1 < -85 And drehung1 >= -88 Then
drehung1 = 2
Else
If drehung1 < -82 And drehung1 >= -85 Then
drehung1 = 3
Else
If drehung1 < -79 And drehung1 >= -82 Then
drehung1 = 6
Else
If drehung1 < -76 And drehung1 >= -79 Then
usw...



Form1.MSComm1.Output = Chr$(80) + Chr$(drehung1) + Chr$(nase1)
start = Timer

Do While Timer < pause + start
DoEvents

Loop
Wend
Form1.MSComm1.Output = Chr$(80) + Chr$(127) + Chr$(127)
Form1.MSComm1.PortOpen = False
MsgBox ("fertig")
Else
While zahler < 10

zahler = zahler + 1
Form1.MSComm1.Output = Chr$(80) + Chr$(xachse) + Chr$(yachse)
start = Timer

Do While Timer < pause + start

Loop
xachse = xachse + 15
yachse = yachse + 15
drehung = Val(roll) * 57.2958

nase = Val(pitch) * 57.2958



Form1.MSComm1.OutBufferCount = 0


Wend
MsgBox ("fertig")
MsgBox (zahler)
MsgBox (xachse)
MsgBox (yachse)
CloseHandle (ShadeMemHandle)
End

End If






End Sub