Bonjour,
J'ai essayé l'api "gdi32", la fonction SetPixel ne règle pas la problème.
Bonjour,
J'ai essayé l'api "gdi32", la fonction SetPixel ne règle pas la problème.
J'avoue etre sceptique sur le gain de performance pour une application aussi "restreinte" (ce n'est pas péjoratif pour ton programme maritime )
Ce serait mieux si tu mettais le code en download ici (dans un zip par exemple)
Dans le principe tout dépend de ton "pas" de tracé, si tu traces des segments toutes les minutes d'angle ca peut etre long mais est-ce nécessaire ?
J'ai fait des tracés de route orthodromique ou le pas était variable en fonction de l'échelle utilisée mais cela pouvait aller jusqu'au degré au moins pour des routes transatlantiques par exemple.
Pour VB6 : N'oubliez pas d'aller voir la FAQ et les Tutoriels
Vous trouvez une reponse particulierement utile ? Votez pour !
la route orthodromique n'est qu'une simple sinusoïde sur une projection Mercator
Mais là, c'est autre chose, car il s'agit d'afficher plusieurs courbes qui s'entrecroisent en formant une grille qui ressemble a une sphère maillée.
s'agissant d'une seule courbe, cela marche très bien, d'ailleurs je n'ai aucune
difficulté a représenter les plans fondamentaux "Ecliptique" et "Equateur celeste".
En mettant l'application a votre disposition vous verrez mieux où son les blocages et les insuffisances.
Je viens de charger ton projet dans vb.
Premier click sur command1 sans toucher aux deux textbox, Erreur 13
Dans ce Code
Il faut remplacer les deux ArcSin = "" par ArcSin = 0
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11 Public Static Function ArcSin(ByVal ArgX) As Double Dim valX As Double If Not IsNumeric(ArgX) Then ArcSin = "": Exit Function valX = Val(ArgX) If Abs(valX) > 1 Then ArcSin = "": Exit Function If ArgX = 0 Then ArcSin = 0: Exit Function If ArgX = 1 Then ArcSin = Pi / 2: Exit Function If ArgX = -1 Then ArcSin = -Pi / 2: Exit Function ArcSin = Atn(valX / Sqr(-valX * valX + 1)) End Function
Deuxieme exécution : division par zéro sur ArcSin = Atn(valX / Sqr(-valX * valX + 1))
je force un peu, re plantage
Désolé, je vais pas passer mon aprem a debugger
En général, on ne demande de conseils que pour ne pas les suivre ou, si on les a suivis, reprocher à quelqu'un de les avoir donnés
(ALEXANDRE DUMAS)
N'hésitez pas à visiter ma page de contributions
Je viens de modifier mon séparateur decimal dans les reglages de windows pour mettre le point à la place du point virgule, ton programme re-fonctionne.
Je ne trouves pas que ton ton programme soit lent. A vue de nez, moins d'une seconde pour redessiner le tout ! A moint d'augmenter ta valeur d'increment, je ne vois d'amélioration de vitesse importante à réaliser
Essaye quand même
et aussi
Code : Sélectionner tout - Visualiser dans une fenêtre à part For delta = -85 To 85 Step 0.04
la précision du trait est moins bonne mais la vitesse * 4
Code : Sélectionner tout - Visualiser dans une fenêtre à part For Alpha = 0 To 23 Step 0.004
En général, on ne demande de conseils que pour ne pas les suivre ou, si on les a suivis, reprocher à quelqu'un de les avoir donnés
(ALEXANDRE DUMAS)
N'hésitez pas à visiter ma page de contributions
Bon alors, j'ai regardé pour essayer de tracer par lignes plutot que par suite de points.
Telle qu'était faites tes boucles effectivement, les points étaient calculés un peu dans le désordre si je peux me permettre et non pas pour un arc puis un autre (pour le tracé des arcs d'ascension par exemple), j'ai donc simplement modifié les boucles comme ceci, ce qui me permet d'augmenter considérablement le pas des boucles.
Delbeke doit avoir une bonne machine, parce que sur mon petit laptop j'etais à 4 secondes pour rafraichir avec ta procedure, là je suis en dessous de la seconde.
Il faut ajouter en début de procédure les déclarations suivantes :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48 'Dessine les 24 arcs d'ascensions droites , entre 85°N et 85°S . For Alpha = 0 To 24 For delta = -85 To 85 Step 1 'For delta = -85 To 85 Step 0.01 H = Hauteur(glst, Lat, Alpha, delta) 'Appel de fonctions, retournent Azm = Azimut(glst, Lat, Alpha, delta, H) 'Hauteur et azimut Azm = 90 + Azm dz = (90 - H) * Rayon / 90 'dz, distance zenithale. i = i + 1 If Abs(dz) < Rayon Then 'Limite l'affichage a l'interieur du cercle x = Xpos + dz * Cos(Azm * rad) 'Calcul de x,y pour l'affichage y = YPos - dz * Sin(Azm * rad) If i = 0 Then PicSky.PSet (x, y), &HFF8080 ElseIf i - Last = 1 Then PicSky.Line -(x, y), &HFF8080 Else PicSky.PSet (x, y), &HFF8080 End If Last = i End If Next delta Next Alpha 'Dessine les arcs de Declinaison entre 75°N to 75°S avec un espacement de 15° For delta = 75 To -75 Step -15 For Alpha = 0 To 23 Step 0.1 'For Alpha = 0 To 23 Step 0.001 delta = delta '+ 15 H = Hauteur(glst, Lat, Alpha, delta) Azm = Azimut(glst, Lat, Alpha, delta, H) Azm = 90 + Azm dz = (90 - H) * Rayon / 90 If Abs(dz) < Rayon Then PrevX = x: PrevY = y x = Xpos + dz * Cos(Azm * rad) y = YPos - dz * Sin(Azm * rad) Dist = Sqr((x - PrevX) ^ 2 + (y - PrevY) ^ 2) 'On ne trace pas de ligne quand on passe d'un côté à l'autre du graphique, d'où ce test un peu alambiqué If (((PrevX - PicSky.ScaleWidth / 2) / (x - PicSky.ScaleWidth / 2)) < 0 And Dist > PicSky.ScaleWidth / 10) Or Alpha = 0 Then PicSky.PSet (x, y), &HFF8080 Else PicSky.Line -(x, y), &HFF8080 End If End If Next Alpha Next delta
J'espère que cela t'aidera un peu...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Dim i As Long Dim Last As Long Dim PrevX As Double Dim PrevY As Double Dim Dist As Double
Pour VB6 : N'oubliez pas d'aller voir la FAQ et les Tutoriels
Vous trouvez une reponse particulierement utile ? Votez pour !
Diantre, tu as radicalement diminué le nombres d'itérations !
Ca va être instanané sur ma machine !
En général, on ne demande de conseils que pour ne pas les suivre ou, si on les a suivis, reprocher à quelqu'un de les avoir donnés
(ALEXANDRE DUMAS)
N'hésitez pas à visiter ma page de contributions
C'est plus complexe que cela ; il faut utiliser des HDC en mémoire dessiner dedans et faire un StrecthBlt...chercher sur les forums Dev Windows et C/C++Envoyé par maritime
Au besoin utiliser le multithreading
Je ne vois pas trop ce que StretchBlt vient faire là dedans ? On ne parle pas d'étirer une image bitmap, à moins qu'il y ait une autre utilité à cette fonction que j'avoue ne pas connaître plus que ça ?
As tu un exemple concret Mat.M, disons remplacer l'affichage d'une ligne droite faite de 1000Pset (ce qui est assez bourrin je l'avoue) par des appels de GDI ?
Parce que j'avoue que aller chercher dans les sections Dev Windows et C/C++ ne me serait pas venu instantanément à l'esprit pour ce genre de chose.
pour tracer une grille ?Au besoin utiliser le multithreading
Sinon, une petite erreur dasn mon code, la deuxième boucle sur alpha devrait être de 0 à 24 au lieu de 0 à 23
Pour VB6 : N'oubliez pas d'aller voir la FAQ et les Tutoriels
Vous trouvez une reponse particulierement utile ? Votez pour !
J'ai essayé ton code OhMonBato, Effectivement, ca va vite, tres vite même, quelques fractions de secondes en fait sur ma machine.
Les tests alambiqués pourraient l'etre encore plus essaye une lattidue de zero , par exemple
Sinon c'est probablement génial, parceque je ne comprends rien aux formules trigo
En général, on ne demande de conseils que pour ne pas les suivre ou, si on les a suivis, reprocher à quelqu'un de les avoir donnés
(ALEXANDRE DUMAS)
N'hésitez pas à visiter ma page de contributions
Si si je vois très bienEnvoyé par OhMonBato
Si j'ai une seconde je te ferai un exemple sinon fouiller sur planet-source-code
Si le CPU est un double...quad core ça peut peut-être booster mais c'est vrai que rien ne prouve que cela accélèrepour tracer une grille ?
Bien vu Delbeke J'avoue ne pas avoir pris le temps de beaucoup tester, il suffit de remplacer le test
par
Code : Sélectionner tout - Visualiser dans une fenêtre à part If i = 0 Then
Sinon Mat.M j'imagine que si l'arbre à came est en tête ça doit aller encore plus vite, peut etre même que sur un Cray si on pouvait...
Code : Sélectionner tout - Visualiser dans une fenêtre à part If i = 0 Or delta = -85 Then
Je blague mais j'avoue que j'aimerais bien que tu ais une seoncde parce que le StretchBlt, il me laisse perplexe
Pour VB6 : N'oubliez pas d'aller voir la FAQ et les Tutoriels
Vous trouvez une reponse particulierement utile ? Votez pour !
Je ne vois pas ce que créer un Device Context en memoire pour dessiner dessus , puis le copier sur le Device Context du PictureBox peut bien être plus rapide que de dessiner directement sur le Device Context du PitureBox
Ensuite Appeler l'api Windows pour faire les Pset ne fera gagner qu'un ou deux cycles d'horloge (voire même aucun) par rapport a un Pset natif de Vb
Pas de gain appréciable de ce coté là je pense.
Mais, Il y a un Mais, on peut pas oublier la grande règle des informaticiens. Pourquoi faire simple si on peut le faire compliqué
En général, on ne demande de conseils que pour ne pas les suivre ou, si on les a suivis, reprocher à quelqu'un de les avoir donnés
(ALEXANDRE DUMAS)
N'hésitez pas à visiter ma page de contributions
Ehh je veux bien mais j'ai bossé sur des dizaines de projets pro en entreprises avec diagrammes c'était pas avec PSET ni PictureBOx mais bien APIEnvoyé par Delbeke
Tiens essaie un peu ça et on verra la différence
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74 'dans un module bas Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Public Const HORZRES = 8 ' Horizontal width in pixels Public Const VERTRES = 10 ' Vertical width in pixels Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Public Type BITMAP '14 bytes bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Public Type POINTAPI x As Long y As Long End Type Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long '''''''''''''''''' ' dans une form Private Sub Form_Load() InitMemEcran Me.hdc End Sub Public Sub InitMemEcran(hdcScreen As Long) hdcMemScreen = CreateCompatibleDC(hdcScreen) hbm = CreateCompatibleBitmap(hdcScreen, GetDeviceCaps(hdcScreen, HORZRES), GetDeviceCaps(hdcScreen, VERTRES)) SelectObject hdcMemScreen, hbm ' pour effacer le contexte en mem Rectangle hdcMemScreen, 0, 0, GetDeviceCaps(hdcScreen, HORZRES), GetDeviceCaps(hdcScreen, VERTRES) End Sub Private Sub Form_Paint() Dim x As Integer Dim y As Integer Dim maxY As Long Dim maxX As Long Dim p As POINTAPI maxX = GetDeviceCaps(Me.hdc, HORZRES) maxY = GetDeviceCaps(Me.hdc, VERTRES) For y = 0 To 768 Step 10 For x = 0 To 1024 Step 10 MoveToEx hdcMemScreen, x, y, p LineTo hdcMemScreen, x, 768 MoveToEx hdcMemScreen, x, y, p LineTo hdcMemScreen, 1024, y Next x Next y 'utiliser StretchBlt au besoin BitBlt Me.hdc, 0, 0, 1024, 768, hdcMemScreen, 0, 0, SRCCOPY End Sub Private Sub Form_Unload(Cancel As Integer) ' s'assurer que TOUS les objets soient bien DESALLOUES DeleteObject hbm DeleteDC hdcMemScreen End Sub
J'ai presque honte (quoique modérément à cette heure en fait) mais c'est sensé faire quoi ce code ? Parce que là moi je vois rien quand je l'exécute (au passage il manque la déclaration de fonction :
Public Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Long) As Long )
Pour VB6 : N'oubliez pas d'aller voir la FAQ et les Tutoriels
Vous trouvez une reponse particulierement utile ? Votez pour !
Envoyé par OhMonBato
non y'a pas de honte faut le dire
Ce code est censé créer une zone mémoire un HDC donc dessiner dedans et lorsque tu re-sollicites l'affichage tu restitues cette zone mémoire vers me.hdc qui est le contexte de périphérique de la form.
Un HDC c'est en quelque sorte un descripteur de zone de dessin , compatible comme compatible avec le matériel graphique ,l'utilisateur n'ayant pas à ce soucier du bas-niveau (le matériel en l'occurence)
Si le mode graphique courant de la carte est 24 bits Windows va crée en mémoire une zone compatible avec le 24 bits et de même pour 16,32...
L'intérêt principal est que créer une zone en mémoire cela évite les scintillements d'écran lorsque tu dessines beaucoup d'objets ( "flickering")
C'est la techique du double tampon.
Ceci dit si cela fonctionne bien avec des picturebox et des contrôles Line c'est vrai que pas besoin de faire compliqué comme le précse Delbeke
Comme je suis appelé a m'absenter souvent je n'ai pas pu suivre les discussions
en temps réel.
Concernant les fonctions trigo. elles fonctionnent correctement et, il n'y a rien a debbuger, le programme fonctionne sur plusieurs machines sous Xp et Win98.
La division par 0 est du a la présence de la virgule au lieu du point comme décimale "Option regionale".
le delai d'affichage s'est nettement amélioré suite a la modification du code par
OhMonBato.
néanmoins des imperfections subsistes !
avez-vous essaye de changer les valeurs lat et Ahso ?
Il se trouve que pour certaines valeurs de lat. et Ahso, certaines mailles restent ouvertes.
C'est possible de preciser les valeurs en question ?
Vraiment pénible de devoir A CHAQUE FOIS demander à préciser les questions... Faites un effort si vous voulez pas decourager ceux qui vous aident !
Pour VB6 : N'oubliez pas d'aller voir la FAQ et les Tutoriels
Vous trouvez une reponse particulierement utile ? Votez pour !
+1, qui plus est si tu es amené à t'absenter souvent...Envoyé par OhMonBato
C'est gentil de souligner que TON programme n'est pas parfait et que TU aurais dû essayer de changer les valeurs en question et de NOUS dire ce que ca fait...Envoyé par maritime
Personne n'est là pour bosser à TA place, je le rappel...
Cordialement...
Le code tel que je l'ai repris ne cause pas a priori de deformations, sauf qu' un fuseau reste ouvert.
dans la partie arcs des declinaisons J'ai modifié la boucle alpha = 0 to 24 au lieu de 23.
c'est après cette modification que certaines lignes se sont deformées:
Pour Lat = 45 AHso =115 il y a une maille déformée au NW.
Tu maintiens AHso=115 et tu fais varier Lat, tu verras qu'elle se déforme
de plus en plus.
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager