Accelerer l'affichage des courbes en VB6.

Version imprimable

Voir 40 message(s) de cette discussion en une page

17/04/2007, 01h47
maritime

Bonjour,
J'ai essayé l'api "gdi32", la fonction SetPixel ne règle pas la problème.
17/04/2007, 11h27
OhMonBato

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.
17/04/2007, 14h12
maritime

1 pièce(s) jointe(s)

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
Code:

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
Il faut remplacer les deux ArcSin = "" par ArcSin = 0

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

17/04/2007, 15h51
Delbeke

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

Code:

For delta = -85 To 85 Step 0.04

et aussi

Code:

For Alpha = 0 To 23 Step 0.004

la précision du trait est moins bonne mais la vitesse * 4

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.

Code:

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

Il faut ajouter en début de procédure les déclarations suivantes :

Code:

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

J'espère que cela t'aidera un peu...

17/04/2007, 16h43
Delbeke

Diantre, tu as radicalement diminué le nombres d'itérations !
Ca va être instanané sur ma machine !
17/04/2007, 17h30
Mat.M

Citation:

Envoyé par maritime

Bonjour,
J'ai essayé l'api "gdi32", la fonction SetPixel ne règle pas la problème.

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++
Au besoin utiliser le multithreading
17/04/2007, 17h46
OhMonBato

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.

Citation:

Au besoin utiliser le multithreading

pour tracer une grille ?

Sinon, une petite erreur dasn mon code, la deuxième boucle sur alpha devrait être de 0 à 24 au lieu de 0 à 23
17/04/2007, 20h38
Delbeke

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 :wow: essaye une lattidue de zero , par exemple :)

Sinon c'est probablement génial, parceque je ne comprends rien aux formules trigo 8O
17/04/2007, 21h19
Mat.M

Citation:

Envoyé par OhMonBato

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 ?

Si si je vois très bien :D
Si j'ai une seconde je te ferai un exemple sinon fouiller sur planet-source-code

Citation:

pour tracer une grille ?

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ère
8-)
17/04/2007, 21h34
OhMonBato

Bien vu Delbeke ;) J'avoue ne pas avoir pris le temps de beaucoup tester, il suffit de remplacer le test

Code:

If i = 0 Then

par

Code:

If i = 0 Or delta = -85 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... ;)
Je blague mais j'avoue que j'aimerais bien que tu ais une seoncde parce que le StretchBlt, il me laisse perplexe :?
17/04/2007, 21h48
Delbeke

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é
:pc:

Citation:

Envoyé par Delbeke

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 :?
:pc:

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 API

Tiens essaie un peu ça et on verra la différence
;)

Code:

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

17/04/2007, 22h50
OhMonBato

J'ai presque honte :oops: (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 ;) )
18/04/2007, 01h48
Mat.M

Citation:

Envoyé par OhMonBato

J'ai presque honte :oops: (quoique modérément à cette heure en fait) mais c'est sensé faire quoi ce code ?

non y'a pas de honte faut le dire :D
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 :D
18/04/2007, 11h35
maritime

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.
18/04/2007, 11h41
OhMonBato

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 !
18/04/2007, 11h58
La Praline

Citation:

Envoyé par OhMonBato

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 !

+1, qui plus est si tu es amené à t'absenter souvent...

Citation:

Envoyé par maritime

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 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...

Personne n'est là pour bosser à TA place, je le rappel...

Cordialement...
18/04/2007, 12h09
maritime

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.

Voir 40 message(s) de cette discussion en une page