Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Call a DLL from Delphi 7?

bigdutch
Beginner
669 Views
Hi

Forgive my freshman ignorance but has anybody got a simple subroutine (that passes variables) and is called by Delphi example -showing both the Fortran and Delphi code (for Win32).

Regards

Richard
0 Kudos
2 Replies
joerg_kuthe
Novice
669 Views
Quoting - bigdutch
Hi

Forgive my freshman ignorance but has anybody got a simple subroutine (that passes variables) and is called by Delphi example -showing both the Fortran and Delphi code (for Win32).

Regards

Richard
A few years ago I have developed a Fortran routine (qtGINOGraphicsWindow) with Compaq Visual Fortran which is called within a Delphi program. Due to legal reasons, I can only supply a bit of that code.

Here is the Delphi side:

procedure TfrmAusgabe.tbQT3DClick(Sender: TObject);

Type TFileName = array[0..259] of Char;

Var hParentWindow : Integer;
Var hInstance : Integer;
Var iSteuerung : Integer;
Var dpcDateiname : TFileName;
Var cTrennzeichen : Char;
Var iXSpaltenNr : Integer;
Var iYSpaltenNr : Integer;
Var iZSpaltenNr : Integer;
Var iLiesAbZeile : Integer;
Var dpcXAchsenText : ShortString;
Var dpcYAchsenText : ShortString;
Var dpcZAchsenText : ShortString;
Var dpcDiagrammtitel : ShortString;
Var iTitelPosition : Integer;
Var iFehler : Integer;


begin

hParentWindow := frmAusgabe.Handle;
hInstance := 0;
iSteuerung := 0;
Case cb3D_Auswahl.ItemIndex of
1 : dpcDateiname := 'C:TEMPLastverteilung_050_1.TXT';
0,2 : dpcDateiname := 'C:TEMPLastverteilung_100_1.TXT';
3 : dpcDateiname := 'C:TEMPLastverteilung_150_1.TXT';
4 : dpcDateiname := 'C:TEMPLastverteilung_050_2.TXT';
5 : dpcDateiname := 'C:TEMPLastverteilung_100_2.TXT';
6 : dpcDateiname := 'C:TEMPLastverteilung_150_2.TXT';
End;

if not(FileExists(dpcDateiname)) then
Begin
ShowMessage (dpcDateiname+ ' nicht vorhanden!');
end;
cTrennzeichen := '#';
iXSpaltenNr := 2;
iYSpaltenNr := 3;
iZSpaltenNr := 5;
iLiesAbZeile := 1;
dpcXAchsenText := 'Eingriffsstrecke [mm]';
dpcYAchsenText := 'Verzahnungsbreite [mm]';
dpcZAchsenText := 'pH [N/mm]';
dpcDiagrammtitel := 'Hertzsche Pressung';
iTitelPosition := 1;
iFehler := 0 ;

qtGINOGraphicsWindow (
hParentWindow ,
hInstance,
iSteuerung,
dpcDateiname,
cTrennzeichen,
iXSpaltenNr,
iYSpaltenNr,
iZSpaltenNr,
iLiesAbZeile,
dpcXAchsenText,
dpcYAchsenText,
dpcZAchsenText,
dpcDiagrammtitel,
iTitelPosition,
iFehler );


Here is the head of my Fortran routine:

SUBROUTINE qtGINOGraphicsWindow( hParentWindow, &
hInstance, &
iSteuerung, &
szDateiname, &
cTrennzeichen, &
iXSpaltenNr, &
iYSpaltenNr, &
iZSpaltenNr, &
iLiesAbZeile, &
dssXAchsenText, &
dssYAchsenText, &
dssZAchsenText, &
dssDiagrammtitel, &
iTitelPosition, &
iFehler )
!DEC$ ATTRIBUTES STDCALL :: qtGINOGraphicsWindow
!DEC$ ATTRIBUTES DLLEXPORT :: qtGINOGraphicsWindow
!DEC$ ATTRIBUTES ALIAS : 'qtGINOGraphicsWindow' :: qtGINOGraphicsWindow
! all arguments "by reference".
!DEC$ ATTRIBUTES REFERENCE :: hParentWindow
!DEC$ ATTRIBUTES REFERENCE :: hInstance
!DEC$ ATTRIBUTES REFERENCE :: iSteuerung
!DEC$ ATTRIBUTES REFERENCE :: szDateiname
!DEC$ ATTRIBUTES REFERENCE :: cTrennzeichen
!DEC$ ATTRIBUTES REFERENCE :: iXSpaltenNr
!DEC$ ATTRIBUTES REFERENCE :: iYSpaltenNr
!DEC$ ATTRIBUTES REFERENCE :: iZSpaltenNr
!DEC$ ATTRIBUTES REFERENCE :: iLiesAbZeile
!DEC$ ATTRIBUTES REFERENCE :: dssXAchsenText
!DEC$ ATTRIBUTES REFERENCE :: dssYAchsenText
!DEC$ ATTRIBUTES REFERENCE :: dssZAchsenText
!DEC$ ATTRIBUTES REFERENCE :: dssDiagrammtitel
!DEC$ ATTRIBUTES REFERENCE :: iTitelPosition
!DEC$ ATTRIBUTES REFERENCE :: iFehler
USE KERNEL32, ONLY: lstrcpy
USE qtGINOGraphicsWindowMODULE
IMPLICIT NONE

INCLUDE 'qtGINOGraphicsWindow.fi'
! Because CVF doesn't like CHARACTER(*), a "dummy" length is specified
INTEGER, PARAMETER :: LSTR = 1000 ! dummy

INTEGER (HANDLE), INTENT(IN) :: hParentWindow ! Handle des ParentWindow
INTEGER (HANDLE), INTENT(IN) :: hInstance ! Handle des Programms
INTEGER, INTENT(IN) :: iSteuerung ! ??? wird das gebraucht (evt. spter) ???
CHARACTER (LSTR), INTENT(IN) :: szDateiname ! file name (null terminated)
CHARACTER (1), INTENT(IN) :: cTrennzeichen ! Spaltentrennung z.B. durch TAB
INTEGER, INTENT(IN) :: iLiesAbZeile ! 1. Zeile Erste Zeile fr den Import (Lesebeginn)
INTEGER, INTENT(IN) :: iXSpaltenNr ! X-Spalte Spaltennummer (1..) der x-Koordinaten
INTEGER, INTENT(IN) :: iYSpaltenNr ! Y-Spalte Spaltennummer (1..) der y-Koordinaten
INTEGER, INTENT(IN) :: iZSpaltenNr ! Z-Spalte Spaltennummer (1..) der z-Koordinaten
TYPE (qT_DelphiShortString), INTENT(IN) :: dssXAchsenText ! X-Beschriftungstext Text zur Beschriftung der X-Achse
TYPE (qT_DelphiShortString), INTENT(IN) :: dssYAchsenText ! Y-Beschriftungstext Text zur Beschriftung der Y-Achse
TYPE (qT_DelphiShortString), INTENT(IN) :: dssZAchsenText ! Z-Beschriftungstext Text zur Beschriftung der Z-Achse
TYPE (qT_DelphiShortString), INTENT(IN) :: dssDiagrammtitel ! Titel Text Diagrammtitel
INTEGER, INTENT(IN) :: iTitelPosition ! Position Titel; = 0: unterhalb, oder = 1: oberhalb

INTEGER, INTENT(OUT) :: iFehler ! Fehlerwert (=0: kein Fehler, /=0: Fehlercode)


Sorry that I did not translate all of the German comments. I have translated only those into English which are relevant.
Most of the KINDs and TYPEs being used can be found in IFWINTY.f90 (use ifwin). Add'l you need:

! Delphi Short String
TYPE qT_DelphiShortString
SEQUENCE
INTEGER (1) Length
CHARACTER (255) String ! check Delphi description if length is 255
END TYPE

I hope that helps.

Good luck

Joerg Kuthe
www.qtsoftware.de



0 Kudos
bigdutch
Beginner
669 Views

Many thanks

I had lost this forum!

0 Kudos
Reply