Page 1 sur 1

[v4 beta 3] Dll... [Résolu]

Publié : jeu. 16/févr./2006 9:06
par Good07
Bonjour à tous.
Je ne sais pas si c'est un bug, mais toujours est-il que l'appel de la Dll "Swedll32" (calcul Astronomie et Astrologie) ne fonctionne pas en PureBasic.
J'avais arrêté mes essais avec la version 3.94 en supposant que c'était le manque de gestion des nombres en double précision qui en empechait le fonctionnement, mais avec la version 4.0 le résulat est le même.
çà fonctionne très bien en visual basic, de même avec Ibasicpro et absolument pas avec PureBasic. :(
Le résultat obtenu est bien un chiffre mais pas celui qu'on attendrai. De plus on peut changer l'année, le mois, le jour ou l'heure le résultat est toujours le même. :(
Preuve que ça ne fonctionne pas du tous.
Voici les exemples d'appel dans les trois languages:

Code : Tout sélectionner

; Déclaration des variables en VB. La Dll fonctionne très bien

; Private Declare Function swe_julday Lib "swedll32.dll" _
;         Alias "_swe_julday@24" ( _
;           ByVal Year As Long, _
;           ByVal Month As Long, _
;           ByVal Day As Long, _
;           ByVal hour As Double, _
;           ByVal gregflg As Long _
;         ) As Double

;--------------------------------------Appel de la DLL avec IbasicPro---------------------------------------------------------------
;DEF W As WINDOW
;DEF LU As UINT
;Declare CDECL EXTERN swe_julday ALIAS _swe_julday@24(Year As INT64,Month As INT64,Day As INT64,Hour As DOUBLE, gregflg As INT64),DOUBLE
;$USE "swedll32.lib"

;Year=1988
;Month=1
;Day=1
;Hour=12.23

;OPENWINDOW w,0,0,320,200,@size|@minbox|@maxbox,0,"ASTROLOGIE",&main
;SETWINDOWCOLOR w,RGB(186,214,177)
;centerwindow w
;FRONTPEN w,RGB(0,0,0)
;DRAWMODE w,@TRANSPARENT
;run=1
;tjd_ut=swe_julday(Year,Month,Day,Hour,0)

;move w,10,10
;print w, "Jour Julien ="+str$(tjd_ut)

;waituntil run=0
;closewindow w
;End
; 
;Sa fonctionne aussi parfaitement 

;------------------------------------Appel avec PureBasic Version 4.0 Beta 3

Procedure Initswedll32(libid,libname.s)
  If OpenLibrary(libid,libname)
    Global *swe_julday
    *swe_julday=GetFunction(libid,"_swe_julday@24")
    Global *swe_julday_d
    *swe_julday_d=GetFunction(libid,"_swe_julday_d@24")
  Else
    MessageRequester("error!","Can't open library!",0)
  EndIf
EndProcedure

Initswedll32(1,"swedll32.dll")
year.l=1988
mois.l=1
jour.l=1
flag.l=0
julday.d=0
heure.d=12.23


julday=CallCFunctionFast(*swe_julday,year,mois,jour,heure,flag)
Debug julday

; Comme avec la version 3.94 ça ne fonctionne toujours pas....
ça ne fonctionne pas même en utilisant:
CallCFunction
CallCFunctionFast
CallFunction
CallFonctionFast
Quel que soit l'appel utilisé le résultat est toujous le même. :(

Mais peut-être que c'est moi qui fait une erreur. Si quelqu'un veux tenter sa chance, la Dll peut être téléchargée en faisant une recherche sur google, sinon contactez-moi je l'enverrai par E-Mail si ça passe...

Merci de vous pencher sur le problème, je continu à chercher mais je n'ai plus grand chose à tenter. :cry:

Le résultat avec la date indiquée devrait-être:
Jour Julien=2447175,01
avec PureBasic, résultat imuable qu'elle que soit la date:
Jour Julien=2088856911,0

Publié : jeu. 16/févr./2006 9:50
par Flype
Bonjour,

Dans la déclaration iBasicPro que tu nous montres là

Code : Tout sélectionner

Declare CDECL EXTERN swe_julday ALIAS _swe_julday@24(Year As INT64,Month As INT64,Day As INT64,Hour As DOUBLE, gregflg As INT64),DOUBLE
;$USE "swedll32.lib"
>> les paramêtres sont en DOUBLE, 64bits, et non en LONG

Ton problème vient de là à mon avis, non ?

Avec PB4.0, qui supporte dorénavant les DOUBLE, tu dois pouvoir accéder à cette fonction...

Publié : jeu. 16/févr./2006 10:26
par Good07
Bonjour Flype.

Ben en fait, en Ibasic j'ai utilisé ce format parceque le long n'existe pas sous cette appelation, mais si tu regardes au début, les parametres en VB, c'est bien des longs qu'il faut employer sauf sur l'heure qui où c'est un double.
Tu m'as mis le doute et j'ai essayé en employant des doubles partout, cela ne change pas le résultat. C'est toujours egal à:2088856911,0 :(

Publié : jeu. 16/févr./2006 10:35
par Flype
bonne nouvelle, je crois que çà marche...
attends un peu...

Publié : jeu. 16/févr./2006 10:44
par Flype
PB4.0, c'est de la bombe... :D

Code : Tout sélectionner

Prototype.d swe_julday(annee.l,mois.l,jour.l,heure.d,flag.l)


If OpenLibrary(1,"swedll32.dll")
  
  
  JulDay.swe_julday = GetFunction(1,"_swe_julday@24")
  
  
  Debug JulDay(1988,1,1,12.23,0)
  Debug JulDay(2006,1,5, 8.30,0)
  
  
  CloseLibrary(1)
  
  
Else
  
  
  MessageRequester("Error!","Can't open library!",#MB_ICONERROR)
  
  
EndIf
PS: Je suis très intéressé par cette DLL, je l'ai trouvé sur Google.
Mais as-tu l'API complète ? Les fichiers includes .h, le fichier .lib, la doc, etc... Parceque par exemple, pour le flag, les constantes je les ai pas...
Et cette DLL mérite qu'on y regarde de plus près, en tout cas pour un de mes softs. Merci d'avance.

Publié : jeu. 16/févr./2006 10:56
par Flype
Preuve que çà marche nickel parceque le reverse fonctionne...

Code : Tout sélectionner


; swedll32.dll - wrapper for purebasic 4.0.x


Macro swe_disp(annee,mois,jour,heure)
  RSet(Str(jour),2,"0")+"/"+RSet(Str(mois),2,"0")+"/"+RSet(Str(annee),4,"0")+" "+StrD(heure,2)
EndMacro


Prototype.d swe_julday(annee.l,mois.l,jour.l,heure.d,flag.l)
Prototype.l swe_revjul(tjd.d,flag.l,annee.l,mois.l,jour.l,heure.l)


If OpenLibrary(1,"swedll32.dll")
  
  
  JulDay.swe_julday = GetFunction(1,"_swe_julday@24")
  RevJul.swe_revjul = GetFunction(1,"_swe_revjul@28")
  
  
  Resultat1.d = JulDay(1988,1,1,12.23,0)
  Debug Resultat1
  RevJul(Resultat1,0,@annee.l,@mois.l,@jour.l,@heure.d)
  Debug swe_disp(annee,mois,jour,heure)
  
  
  Resultat2.d = JulDay(2006,1,5, 8.30,0)
  Debug Resultat2
  RevJul(Resultat2,0,@annee.l,@mois.l,@jour.l,@heure.d)
  Debug swe_disp(annee,mois,jour,heure)
  
  
  CloseLibrary(1)
  
  
Else
  
  
  MessageRequester("Error!","Can't open library!",#MB_ICONERROR)
  
  
EndIf

pour ceux qui veulent tester, j'ai bricolé une ch'tite archive en piochant
à gauche, à droite des includes et la dll bien sûr...

SWEDLL32.zip
Image

Publié : jeu. 16/févr./2006 11:37
par Good07
Merci Flype c'est super ! :D

J'ai aussi la doc au format PDF, mais je ne sais pas comment te l'envoyer.
En passant par E-mail du forum on peux pas joindre de pièce ou alors j'ai pas vu.
:oops:

La doc est en anglais mais ça ce lit bien.

Publié : jeu. 16/févr./2006 11:41
par Flype
Pas de problème, envoi ici :D flype44@hotmail.fr

Penses à corriger le titre de ce topic en mettant [Résolu]

Et regardes, tout marche, c'est super...

Code : Tout sélectionner


; swedll32.dll - wrapper for purebasic 4.0.x


Macro SWE_DEBUG(annee,mois,jour,heure)
  RSet(Str(jour),2,"0")+"/"+RSet(Str(mois),2,"0")+"/"+RSet(Str(annee),4,"0")+" "+StrD(heure,2)
EndMacro
Macro SWE_JD(pbdate)
  JulDay(Year(pbdate),Month(pbdate),Day(pbdate),Hour(pbdate),1)
EndMacro


Prototype.d swe_julday(annee.l,mois.l,jour.l,heure.d,flag.l)
Prototype.l swe_revjul(juliandate.d,flag.l,annee.l,mois.l,jour.l,heure.l)
Prototype.d swe_degnorm(angle.d)
Prototype.l swe_day_of_week(juliandate.d)


If OpenLibrary(1,"swedll32.dll")
  
  
  JulDay.swe_julday = GetFunction(1,"_swe_julday@24")
  RevJul.swe_revjul = GetFunction(1,"_swe_revjul@28")
  DegNorm.swe_degnorm = GetFunction(1,"_swe_degnorm@8")
  DayOfWeek2.swe_day_of_week = GetFunction(1,"_swe_day_of_week@8")
  
  
  RevJul(JulDay(1988,1,1,12.23,0),0,@annee.l,@mois.l,@jour.l,@heure.d)
  Debug SWE_DEBUG(annee,mois,jour,heure)
  
  
  RevJul(JulDay(2006,1,5, 8.30,0),0,@annee.l,@mois.l,@jour.l,@heure.d)
  Debug SWE_DEBUG(annee,mois,jour,heure)
  
  
  Debug DegNorm(580.63333)
  
  
  Select DayOfWeek2(SWE_JD(Date()))
    Case 0: Debug "Lundi"
    Case 1: Debug "Mardi"
    Case 2: Debug "Mercredi"
    Case 3: Debug "Jeudi"
    Case 4: Debug "Vendredi"
    Case 5: Debug "Samedi"
    Case 6: Debug "Dimanche"
  EndSelect
  
  
  CloseLibrary(1)
  
  
Else
  
  
  MessageRequester("Error!","Can't open library!",#MB_ICONERROR)
  
  
EndIf


Publié : jeu. 16/févr./2006 11:42
par Backup
Good07 a écrit :Merci Flype c'est super ! :D

J'ai aussi la doc au format PDF, mais je ne sais pas comment te l'envoyer.
En passant par E-mail du forum on peux pas joindre de pièce ou alors j'ai pas vu.
:oops:

La doc est en anglais mais ça ce lit bien.
et simplement par email avec attachement (archive zip) ? ça marche pas ? 8O

tu me l'envoie et je met un lien a partir de mon site
pour que tout le monde puisse recuperer la dll +la doc + les exemples si vous en faites(le tout enfermé dans un zip ou rar..)... :D

Publié : jeu. 16/févr./2006 11:58
par Good07
Merci Flype.
Je viens de t'envoyer la doc en PDF. Tu pourras la joindre dans ton Zip. Je dois être nul, mais comment on fait pour marquer Résolu au sujet du post. :oops:

Merci pour tes exemples, je vais étudier ça ce soir en rentrant, car là il faut que j'aille manger et puis au boulot. :(

A+

Publié : jeu. 16/févr./2006 12:02
par Good07
Bon, pour résolu c'est fait, j'ai trouvé. :D

Publié : jeu. 16/févr./2006 14:51
par Flype
Merci pour la doc mais pour finir j'ai refait l'archive après avoir trouvé le site officiel.
http://www.astro.com/swisseph/swephprg.htm

Cette fois elle est relativement complète et comporte, en plus,
un dossier purebasic qui montre comment implémenter les fonctions

1/ depuis la librairie partagée <swedll32.DLL> avec OpenLibrary/Prototype
2/ depuis la librairie statique <swedll32.LIB> avec Import/EndImport

SwissEphemeris->SwissEphemeris_Light.zip
Image

Cordialement.

Publié : ven. 17/févr./2006 0:14
par Good07
Merci flype, c'est vraiment super. :D
Depuis que je voulais bricolé quelque chose avec cette DLL...Je vois que la version 4 n'a pas fini de nous étonner. VB va vraiment prendre un coup de vieux si ça continue comme ça. :D
Merci aussi à Dobro popour sa proposition.
Moi je crois que je vais me coucher tard pour étudier tout ça. :wink:

A+
André.

Publié : ven. 17/févr./2006 0:32
par Flype
M. le modo, ya moyen de déplacer ce topic ailleurs ?
Pas de bugs ici.