die DLL ist mit FreeBASIC programmiert worden.
Mit Euphoria, C oder Delphi kenn ich mich nicht aus.
Ich bin auch kein Programmierprofi, bin selber noch am lernen.
FreeBASIC ist ein Open-Source-Compiler. Für diesen Compiler gibt es
mehrere verschiedene IDE's. Ich benutze die IDE FBEdit 1.0.7.6c.
Sie verfügt über einen Editor, mit der man grafische Oberflächen erstellen
kann (bei Delphi ist das glaube ich ähnlich).
Da es bei FreeBasic keine objektorientierte Programmierung gibt, muss die
Handhabung der Controlls über WinAPI-Funktionen erfolgen.
Hier mal der Code der DLL (geht bestimmt effizenter, also nicht lachen!):
Code: Alles auswählen
#Include Once "windows.bi"
#Define IDD_DLG1 1000
#Define IDC_BTN1 1001
#Define IDC_BTN2 1002
#Define IDC_CBO1 1003
#Define IDC_CBO2 1004
Dim Shared hInstance As HMODULE
'----- Deklaration von Sub's und Functionen -----
' Diese Function wird nach öffnen des User-Dialogs
' immer wieder aufgerufen um z.B:
' - Comboboxen mit Werten zu füllen
' - Überwacht ob ein Button angeklickt wurde
' - usw.
Declare Function DlgProc(ByVal hWin As HWND, _
ByVal uMsg As UINT, _
ByVal wParam As WPARAM, _
ByVal lParam As LPARAM) As Integer
' Diese Function ermittelt die Instance des User-Dialogs.
' Sonst wird es nicht von Windows dargestelt.
Declare Function GetModuleInstance() As Integer
'------------------------------------------------
Dim Shared Combobox1 As Short ' Anzahl Kanäle
Dim Shared Combobox2 As Short ' LED Ausgabe Ja/Nein
Dim Shared a As UByte ' wird zur Beschriftung der Ausgänge benötigt
Dim Shared b As UByte ' wird zur Beschriftung der Ausgänge benötigt
' Die ProfiLab Routinen müssen zwischen "Extern" und "End Extern" stehen
Extern "windows-ms"
' Beginn ProfiLab Routinen
Function CNumInputsEx (PUser As Double Ptr) As UByte Export
Return PUser[0] + 1 ' Rückgabe der Bauteileingänge (+1 für Use-Pin)
End Function
Function CNumOutputsEx (PUser As Double Ptr) As UByte Export
If PUser[1] = 1 Then
Return (2 * PUser[0]) + 3 ' Rückgabe der Bauteilausgänge (+3 für Min/Max/Mittel)
Else
Return 3
EndIf
End Function
Sub GetInputName (ByVal Channel As UByte, InputName As ZString) Export
If Channel = 0 Then
InputName = "Use"
Else
InputName = "K" & LTrim(Str(Channel))
EndIf
End Sub
Sub GetOutputName (ByVal Channel As UByte, OutputName AS ZString) Export
If Channel = 0 Then
OutputName = "Max"
ElseIf Channel = 1 Then
OutputName = "Mittel"
ElseIf Channel = 2 Then
OutputName = "Min"
a = 1
b = 1
Else
If a = 1 Then
OutputName = "K" & Str(b) & "_Max"
a = a + 1
Else
OutputName = "K" & Str(b) & "_Min"
a = 1
b = b + 1
EndIf
EndIf
End Sub
Sub CSimStart (PInput AS Double Ptr, POutput AS Double Ptr, PUser AS Double Ptr) Export
' nothing to be done
End Sub
Sub CSimStop (PInput As Double Ptr, POutput As Double Ptr, PUser As Double Ptr) Export
' nothing to be done
End Sub
Sub CCalculate (PInput As Double Ptr, POutput AS Double Ptr, PUser AS Double Ptr) Export
Dim Min_Wert As Double
Dim Max_wert As Double
Dim Mittelwert As Double
Dim Summe As Double
Dim Use_Channel As UByte
Dim n As UByte
Dim x As UByte
If PInput[0] < 2 Or PInput[0] > PUser[0] Then
Use_Channel = PUser[0]
Else
Use_Channel = PInput[0]
EndIf
x = 0
Min_wert = 0
Max_wert = 0
Mittelwert = 0
Min_Wert = PInput[1]
Max_Wert = PInput[1]
Mittelwert = 0
For n = 1 To Use_Channel
If Min_Wert > PInput[n] Then Min_Wert = PInput[n]
If Max_Wert < PInput[n] Then Max_Wert = PInput[n]
Summe = Summe + PInput[n]
Next
Mittelwert = Summe / Use_Channel
POutput[0] = Max_Wert
POutput[1] = Mittelwert
POutput[2] = Min_Wert
If PUser[1] = 1 Then
If Min_Wert < Max_Wert Then
For n = 1 To Use_Channel
If PInput[n] >= Max_wert Then
x = (n * 2) + 1
POutput[x] = 5
x = x + 1
POutput[x] = 0
ElseIf PInput[n] <= Min_Wert Then
x = (n * 2) + 1
POutput[x] = 0
x = x + 1
POutput[x] = 5
Else
x = (n * 2) + 1
POutput[x] = 0
x = x + 1
POutput[x] = 0
EndIf
Next
Else
' alle Kanäle haben den gleichen Wert (Min=Max)
For n = 1 To Use_Channel
x = (n * 2) + 1
POutput[x] = 5
x = x + 1
POutput[x] = 5
Next
EndIf
' LED's nicht benutzter Kanäle ausschalten
For n = Use_Channel To PUser[0]
x = (n * 2) + 3
POutput[x] = 0
x = x + 1
POutput[x] = 0
Next
End If
End Sub
Sub CConfigure (PUser As Double Ptr) Export
'----- aktuelle Werte von PUser an Dialog übergeben -----
' Kanäle
If Puser[0] < 2 Then ' PUser[0] muss mind. 2 sein
Combobox1 = 0 ' 2 Kanäle
Else
Combobox1 = PUser[0] - 2 ' auf Index der Combobox setzen (0=2 Kanäle 1=3 Kanäle usw.)
EndIf
' LED Ausgabe
Combobox2 = PUser[1]
'--------------------------------------------------------
'----- Aufruf des Dialog's -----
DialogBoxParam(GetModuleInstance(), Cast(ZString Ptr,IDD_DLG1), NULL, @DlgProc, NULL)
'-------------------------------
'----- neue Werte an PUser übergeben -----
PUser[0] = Combobox1 + 2 ' Kanäle: +2 wegen Index von Combobox (0-46)
PUser[1] = Combobox2 ' LED Ausgabe Ja=1/Nein=0
'-----------------------------------------
End Sub
End Extern
Function DlgProc(ByVal hDlg As HWND, _
ByVal uMsg As UINT, _
ByVal wParam As WPARAM, _
ByVal lParam As LPARAM) As Integer
Dim id As Long
Dim Event As Long
Dim n As UByte
Dim Text As String
Select Case uMsg
Case WM_INITDIALOG
' ------ Comboboxen mit Werten füllen -----
' Combobox 1
For n = 2 To 48
Text = Str(n)
SendMessage(GetDlgItem(hDlg, IDC_CBO1), CB_ADDSTRING, 0 , StrPtr(Text))
Next
' Index setzen
SendMessage(GetDlgItem(hDlg, IDC_CBO1), CB_SETCURSEL, Combobox1, 0 )
' Combobox 2
SendMessage(GetDlgItem(hDlg, IDC_CBO2), CB_ADDSTRING, 0 , StrPtr("Nein"))
SendMessage(GetDlgItem(hDlg, IDC_CBO2), CB_ADDSTRING, 0 , StrPtr("Ja"))
' Index setzen
SendMessage(GetDlgItem(hDlg, IDC_CBO2), CB_SETCURSEL, Combobox2, 0 )
'
' [X] geklickt
Case WM_CLOSE
EndDialog(hDlg, 0) ' Beendet das Dialogfenster
'
Case WM_COMMAND
id = LoWord(wParam)
Event = HiWord(wParam)
Select Case id
' OK Button gedrückt
Case IDC_BTN1
' Wert von Combobox an Variable übergeben
Combobox1 = SendMessage(GetDlgItem(hDlg,IDC_CBO1), CB_GETCURSEL, 0, 0)
Combobox2 = SendMessage(GetDlgItem(hDlg,IDC_CBO2), CB_GETCURSEL, 0, 0)
EndDialog(hDlg, 0) ' Beendet das Dialogfenster
' Cancel Button gedrückt
Case IDC_BTN2
EndDialog(hDlg, 0) ' Beendet das Dialogfenster
End Select
Case WM_SIZE
'
Case Else
Return FALSE
'
End Select
Return TRUE
End Function
Function GetModuleInstance() As Integer
Dim mbi As MEMORY_BASIC_INFORMATION
VirtualQuery( @DlgProc, @mbi, SizeOf(mbi) )
Return Cast(HANDLE ,mbi.AllocationBase)
End Function
Hier noch ein Link der evtl. hilft
http://www.willemer.de/informatik/windo ... htm#simple
Ich hoffe ich konnte dir etwas weiterhelfen.
Gruß
)
mpander.