Effet de loupe sur votre bureau

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
garzul
Messages : 683
Inscription : mer. 26/mai/2004 0:33

Message par garzul »

Je suis a 5 Fps :D ( C'est mon pc ou c'est ton prog sachant que j'ai pas de fenetre ouverte vu que je l'ai redemarer :? ) ?
Haut
comtois
Messages : 5191
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

Dobro a écrit :le truc conciste a remplacer les boucles for next (tres longue) par des while wend !!!
mais ça seulement ceux qui on une grande experience en prog basic savent que les boucle for next sont les boucles les plus lente !!! :D :D
Cette affirmation m'a intrigué , j'ai voulu tester ,et j'obtiens exactement le contraire de ce que tu dis .

J'ai fait ce test .

Pour la boucle for next j'obtiens > 250
Pour la boucle While wend j'obtiens > 360

Où est mon erreur dans ce test ??

Code : Tout sélectionner

c = 10000000
Temps = ElapsedMilliseconds()
For i=0 To c
  b + 1
Next i
Total1 = ElapsedMilliseconds()-Temps

Temps = ElapsedMilliseconds()
i = 0
While i <= c
  b + 1
  i + 1
Wend
Total2 = ElapsedMilliseconds()-Temps

Debug Total1
Debug Total2
Sinon bravo pour ton code le soldat inconnu , très intéressant :)
Haut
Paneric
Messages : 66
Inscription : dim. 25/janv./2004 19:03
Contact :
Contacter Paneric

Message par Paneric »

Avec les pointeurs c'est un peu plus véloce!

Code : Tout sélectionner

 ProcedureDLL.l GetImageBits2(ImageID, HList) ; Transfert d'une image vers un tableau 
    Protected bmi.BITMAPINFO, hdc.l, Resultat, Mem, n, nn, bm.BITMAP 
    
    Resultat = 0 
    
    GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP) 
    
    bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER) 
    bmi\bmiHeader\biWidth = bm\bmWidth 
    bmi\bmiHeader\biHeight = bm\bmHeight 
    bmi\bmiHeader\biPlanes = 1 
    bmi\bmiHeader\biBitCount = 32 
    bmi\bmiHeader\biCompression = #BI_RGB 
    aze=bm\bmWidth * bm\bmHeight * 4 
    Mem = AllocateMemory(aze) 
    If Mem 
        
        hdc = CreateCompatibleDC_(GetDC_(ImageID)) 
        If hdc 
            GetDIBits_(hdc, ImageID, 0, bm\bmHeight, Mem, @bmi, #DIB_RGB_COLORS) ; on envoie la liste dans l'image 
            ReleaseDC_(0, hdc) 
            Resultat = ImageID 
        EndIf 
        
        ; On convertit la liste dans le bon format 
        n=0 
       ; For n = 0 To bm\bmHeight - 1 
        ww2=bm\bmHeight - 1 
        While n<ww2 
            
            n+1 
            nn=0 
            ;For nn = 0 To bm\bmWidth - 1 
            ww=bm\bmWidth - 1 
            While nn<ww 
                nn+1 
                zzz=Mem + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4 
                rrrr=HList + n * 4 + nn * bm\bmHeight * 4 
                CopyMemory(zzz,rrrr, 4) 
            Wend 
       Wend 
        
        FreeMemory(Mem) 
    EndIf 
    
    ProcedureReturn Resultat 
EndProcedure 

Procedure.f Longueur(x1.f, y1.f, x2.f, y2.f) 
    ProcedureReturn Sqr(Pow(x1 - x2, 2) + Pow(y1 - y2, 2)) 
EndProcedure 

#Pi.f = 3.14 

; Copie d'écran 
Largeur_Ecran = GetSystemMetrics_(#SM_CXSCREEN) 
Hauteur_Ecran = GetSystemMetrics_(#SM_CYSCREEN) 

DC = GetDC_(0) 
CreateImage(0, Largeur_Ecran, Hauteur_Ecran) 
Dessin = StartDrawing(ImageOutput()) 
BitBlt_(Dessin, 0, 0, Largeur_Ecran, Hauteur_Ecran, DC, 0, 0, #SRCPAINT) 
StopDrawing() 
ReleaseDC_(0, DC) 

OpenWindow(0, 0, 0, 100, 100, #WS_MAXIMIZE | #PB_Window_BorderLess, "Sphère") 
SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; Pour mettre la fenêtre toujours au premier plan 
UpdateWindow_(WindowID()) 

; On copie l'image dans un Tableau 
Dim Image.l(Largeur_Ecran - 1, Hauteur_Ecran - 1) 
GetImageBits2(UseImage(0), @Image()) 

; On ouvre l'openscreen 
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 
    MessageRequester("Erreur", "Impossible d'initialiser la souris ,le clavier ou l'écran. Vérifiez la présence de DirectX 7 ou supérieur.", 0) 
    End 
EndIf 

If OpenScreen(Largeur_Ecran, Hauteur_Ecran, 32, "Sphère") = 0 
    MessageRequester("Erreur", "Impossible d'ouvrir l'écran.", 0) 
    End 
EndIf 

CreateSprite(1, Largeur_Ecran, Hauteur_Ecran) 
StartDrawing(SpriteOutput(1)) 
DrawImage(UseImage(0), 0, 0) 
StopDrawing() 

Rayon = 100 
Loupe.f = 0.5 

Repeat 
    ; On lit les évènements clavier et souris 
    ExamineMouse() 
    ExamineKeyboard() 
    
    ; Position de la souris 
    x = MouseX() 
    y = MouseY() 
    
    ; Agrandir ou réduire la sphère 
    If KeyboardPushed(#PB_Key_Up) And Rayon < 100 
        Rayon + 2 
    ElseIf KeyboardPushed(#PB_Key_Down) And Rayon > 0 
        Rayon - 2 
    EndIf 
    
    ; Augmenter ou diminuer l'effet de loupe 
    If KeyboardPushed(#PB_Key_Right) And Loupe < 1 
        Loupe + 0.05 
    ElseIf KeyboardPushed(#PB_Key_Left) And Loupe > 0 
        Loupe - 0.05 
    EndIf 
    
    ; On affiche l'image 
    DisplaySprite(1, 0, 0) 
    
    StartDrawing(ScreenOutput())
    ; Calcul du FPS 
    cpt + 1 
    If cpt = 10 
        cpt = 0 
        fps = 10000 / (ElapsedMilliseconds() - Temps) 
        Temps = ElapsedMilliseconds() 
    EndIf 
    Locate(5, 5) 
    DrawText(Str(fps)) 
    
    ; On édite l'image 
    *Memoire.long = DrawingBuffer() 
    *Pixel_Memoire.long=*Memoire
   ; For n = -Rayon To Rayon 
    n = -Rayon 
    While n<Rayon 
    n+1 
    tt=x + n  
        If tt > 0 And tt < Largeur_Ecran - 1 ; Si on est sur l'image en x 
            nn=-Rayon 
            While nn <Rayon 
                nn+1 
                tt2=x + n : tt3=y + nn 
                If tt3 > 0 And tt3 < Hauteur_Ecran - 1 ; Si on est sur l'image en y 
                    Longueur.f = Longueur(x, y,tt2 , tt3) ; On calcul la distance d'un point de la sphère à partir du centre 
                    If Longueur <= Rayon ; Si le pixel est situé dans le rayon du cercle 
                        ppp.f=Longueur / Rayon * Loupe + (1 - Loupe) 
                        ppp2.f=2 / #Pi * Longueur 
                        
                        Longueur2.f = ASin(ppp.f) * ppp2 ; on calcul la distance du point de l'image correspondant à celui de la sphère 
                        If Longueur > 0 
                            aaaa.f=Longueur2 / Longueur :bbbbb.f=Longueur2 / Longueur 
                            uuu=x + n * aaaa.f 
                            uuu2=y + nn * bbbbb.f 
                            PosX.f = uuu 
                            PosY.f = uuu2 
                            
                            ; Avec lissage 
                            PosX_Int = Int(PosX) 
                            PosY_Int = Int(PosY) 
                            Rouge.f = 0 : Vert.f = 0 : bleu.f = 0 : SommeFacteur.f = 0 
                            
                            ;For i = PosX_Int - 1 To PosX_Int + 1 
                            i = PosX_Int - 1 
                            While i< PosX_Int + 1 
                                i+1 
                               ; For ii = PosY_Int - 1 To PosY_Int + 1 
                                ii = PosY_Int - 1 
                                While ii<PosY_Int + 1 
                                    ii+1 
                                    facteur.f = 1 - Longueur(i, ii, PosX, PosY) 
                                    If facteur > 0 
                                        Rouge + Red(Image(i, ii)) * facteur 
                                        Vert + Green(Image(i, ii)) * facteur 
                                        bleu + Blue(Image(i, ii)) * facteur 
                                        SommeFacteur + facteur 
                                    EndIf 
                               Wend 
                        Wend 
                        yu=Rouge / SommeFacteur 
                        yu1=Vert / SommeFacteur 
                        yu2=bleu / SommeFacteur 
                            Couleur.l = RGB(Int(yu), Int(yu1), Int(yu2)) 
                            
                            ; Sans lissage 
                            ; Couleur.l = Image(Int(PosX + 0.5), Int(PosY + 0.5)) 
                            
                        Else ; Cas particulier, le centre de la sphère 
                            Couleur.l = Image(x, y) 
                        EndIf 
                        ; On affiche le pixel 
                        ooa=4 * (y + nn) * Largeur_Ecran 
                        oo=4 * (x + n) + ooa 
                        ;Pixel_Memoire = Memoire + oo 
                        ;PokeL(Pixel_Memoire, Couleur) 
                        *Pixel_Memoire=*Memoire+oo
                        *Pixel_memoire\l=couleur
                    EndIf 
                EndIf 
            Wend 
        EndIf 
  Wend 
    
    StopDrawing() 
    
    FlipBuffers(0) 
    
    If IsScreenActive() = 0 
        End 
    EndIf 
    
Until KeyboardPushed(#PB_Key_Escape)
Paneric
Haut
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :
Contacter Le Soldat Inconnu

Message par Le Soldat Inconnu »

ça sert à quoi de bidouiller le code qui n'intervient pas dans la boucle ??

Code : Tout sélectionner

aaaa.f=Longueur2 / Longueur :bbbbb.f=Longueur2 / Longueur 
uuu=x + n * aaaa.f 
uuu2=y + nn * bbbbb.f
très joli :lol:

en passant, le lissage en mort avec ton code et vu le bazar que tu y a mis, je ne sais pas d'ou ça vient
trouvé, stocké un float dans un long, c'est sur que ça va plus après :roll:
regarde :

Code : Tout sélectionner

uuu=x + n * aaaa.f 
uuu2=y + nn * bbbbb.f 
PosX.f = uuu 
PosY.f = uuu2
encore une horreur

Code : Tout sélectionner

While n<Rayon 
    n+1 
    tt=x + n  
        If tt > 0 And tt < Largeur_Ecran - 1 ; Si on est sur l'image en x 
            nn=-Rayon 
            While nn <Rayon 
                nn+1 
                tt2=x + n : tt3=y + nn 
                If tt3 > 0 And tt3 < Hauteur_Ecran - 1
tt et tt3, c'est pas la même valeur ?

on vire les boucle while qui ne servent à rien

code final :

Code : Tout sélectionner

ProcedureDLL.l GetImageBits2(ImageID, HList) ; Transfert d'une image vers un tableau 
  Protected bmi.BITMAPINFO, hdc.l, Resultat, Mem, n, nn, bm.BITMAP 
  
  Resultat = 0 
  
  GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP) 
  
  bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER) 
  bmi\bmiHeader\biWidth = bm\bmWidth 
  bmi\bmiHeader\biHeight = bm\bmHeight 
  bmi\bmiHeader\biPlanes = 1 
  bmi\bmiHeader\biBitCount = 32 
  bmi\bmiHeader\biCompression = #BI_RGB 
  
  Mem = AllocateMemory(bm\bmWidth * bm\bmHeight * 4) 
  If Mem 
    
    hdc = CreateCompatibleDC_(GetDC_(ImageID)) 
    If hdc 
      GetDIBits_(hdc, ImageID, 0, bm\bmHeight, Mem, @bmi, #DIB_RGB_COLORS) ; on envoie la liste dans l'image 
      ReleaseDC_(0, hdc) 
      Resultat = ImageID 
    EndIf 
    
    ; On convertit la liste dans le bon format 
    For n = 0 To bm\bmHeight - 1 
      For nn = 0 To bm\bmWidth - 1 
        CopyMemory(Mem + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4, HList + n * 4 + nn * bm\bmHeight * 4, 4) 
      Next 
    Next 
    
    FreeMemory(Mem) 
  EndIf 
  
  ProcedureReturn Resultat 
EndProcedure 

Procedure.f Longueur(x1.f, y1.f, x2.f, y2.f) 
  ProcedureReturn Sqr(Pow(x1 - x2, 2) + Pow(y1 - y2, 2)) 
EndProcedure 

#Pi.f = 3.14159265 

; Copie d'écran 
Largeur_Ecran = GetSystemMetrics_(#SM_CXSCREEN) 
Hauteur_Ecran = GetSystemMetrics_(#SM_CYSCREEN) 

DC = GetDC_(0) 
CreateImage(0, Largeur_Ecran, Hauteur_Ecran) 
Dessin = StartDrawing(ImageOutput()) 
  BitBlt_(Dessin, 0, 0, Largeur_Ecran, Hauteur_Ecran, DC, 0, 0, #SRCPAINT) 
StopDrawing() 
ReleaseDC_(0, DC) 

; OpenWindow(0, 0, 0, 100, 100, #WS_MAXIMIZE | #PB_Window_BorderLess, "Sphère") 
; SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; Pour mettre la fenêtre toujours au premier plan 
; UpdateWindow_(WindowID()) 

; On copie l'image dans un Tableau 
Dim Image.l(Largeur_Ecran - 1, Hauteur_Ecran - 1) 
GetImageBits2(UseImage(0), @Image()) 

; On ouvre l'openscreen 
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 
  MessageRequester("Erreur", "Impossible d'initialiser la souris ,le clavier ou l'écran. Vérifiez la présence de DirectX 7 ou supérieur.", 0) 
  End 
EndIf 

If OpenScreen(Largeur_Ecran, Hauteur_Ecran, 32, "Sphère") = 0 
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.", 0) 
  End 
EndIf 

CreateSprite(1, Largeur_Ecran, Hauteur_Ecran) 
StartDrawing(SpriteOutput(1)) 
  DrawImage(UseImage(0), 0, 0) 
StopDrawing() 

Rayon = 25 
Loupe.f = 0.5 

Repeat 
  ; On lit les évènements clavier et souris 
  ExamineMouse() 
  ExamineKeyboard() 
  
  ; Position de la souris 
  x = MouseX() 
  y = MouseY() 
  
  ; Agrandir ou réduire la sphère 
  If KeyboardPushed(#PB_Key_Up) And Rayon < 100 
    Rayon + 2 
  ElseIf KeyboardPushed(#PB_Key_Down) And Rayon > 0 
    Rayon - 2 
  EndIf 
  
  ; Augmenter ou diminuer l'effet de loupe 
  If KeyboardPushed(#PB_Key_Right) And Loupe < 1 
    Loupe + 0.05 
  ElseIf KeyboardPushed(#PB_Key_Left) And Loupe > 0 
    Loupe - 0.05 
  EndIf 
  
  ; On affiche l'image 
  DisplaySprite(1, 0, 0) 
  
  StartDrawing(ScreenOutput()) 
    ; Calcul du FPS 
    cpt + 1 
    If cpt = 10 
      cpt = 0 
      fps = 10000 / (ElapsedMilliseconds() - Temps) 
      Temps = ElapsedMilliseconds() 
    EndIf 
    Locate(5, 5) 
    DrawText(Str(fps)) 
    
    ; On édite l'image 
    Memoire = DrawingBuffer() 
    For n = -Rayon To Rayon 
      x2 = x + n 
      If x2 > 0 And x2 < Largeur_Ecran - 1 ; Si on est sur l'image en x 
        For nn = -Rayon To Rayon 
          y2 = y + nn 
          If y2 > 0 And y2 < Hauteur_Ecran - 1 ; Si on est sur l'image en y 
            Longueur.f = Longueur(x, y, x2, y2) ; On calcul la distance d'un point de la sphère à partir du centre 
            If Longueur <= Rayon ; Si le pixel est situé dans le rayon du cercle 
              
              If Longueur > 0 
                Longueur2.f = ASin(Longueur / Rayon * Loupe + (1 - Loupe)) * 2 / #Pi * Longueur ; on calcul la distance du point de l'image correspondant à celui de la sphère 
                
                Temp.f = Longueur2 / Longueur 
                PosX.f = x + n * Temp 
                PosY.f = y + nn * Temp 
                
                ; Avec lissage 
                PosX_Int = Int(PosX) 
                PosY_Int = Int(PosY) 
                Rouge.f = 0 : Vert.f = 0 : Bleu.f = 0 : SommeFacteur.f = 0 
                For i = PosX_Int - 1 To PosX_Int + 1 
                  For ii = PosY_Int - 1 To PosY_Int + 1 
                    Facteur.f = 1 - Longueur(i, ii, PosX, PosY) 
                    If Facteur > 0 
                      Rouge = Rouge + Red(Image(i, ii)) * Facteur 
                      Vert = Vert + Green(Image(i, ii)) * Facteur 
                      Bleu = Bleu + Blue(Image(i, ii)) * Facteur 
                      SommeFacteur = SommeFacteur + Facteur 
                    EndIf 
                  Next 
                Next 
                Couleur.l = RGB(Int(Rouge / SommeFacteur), Int(Vert / SommeFacteur), Int(Bleu / SommeFacteur)) 
                
                ; Sans lissage 
                ; Couleur.l = Image(Int(PosX + 0.5), Int(PosY + 0.5)) 
                
              Else ; Cas particulier, le centre de la sphère 
                Couleur.l = Image(x, y) 
              EndIf 
              ; On affiche le pixel 
              Pixel_Memoire = Memoire + 4 * (x + n) + 4 * (y + nn) * Largeur_Ecran 
              PokeL(Pixel_Memoire, Couleur) 
            EndIf 
          EndIf 
        Next 
      EndIf 
    Next 
    
  StopDrawing() 
  
  FlipBuffers() 
  
  If IsScreenActive() = 0 
    End 
  EndIf 
  
Until KeyboardPushed(#PB_Key_Escape)
Dobro, tu est trop fort pour optimiser les codes 8O :lol:
Dernière modification par Le Soldat Inconnu le dim. 10/oct./2004 11:28, modifié 1 fois.
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Haut
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :
Contacter Le Soldat Inconnu

Message par Le Soldat Inconnu »

Bon, j'ai trouvé une fonction qui ralentissait le code assez violament.
il s'agit de Pow() que j'utilisait pour mettre au carré une valeur.

en la supprimant, j'ai multiplié par 2 la vitesse du code.

FPS de 12 sur mon 900 avec lissage et taille à fond.

Code : Tout sélectionner

ProcedureDLL.l GetImageBits2(ImageID, HList) ; Transfert d'une image vers un tableau
  Protected bmi.BITMAPINFO, hdc.l, Resultat, Mem, n, nn, bm.BITMAP
  
  Resultat = 0
  
  GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP)
  
  bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
  bmi\bmiHeader\biWidth = bm\bmWidth
  bmi\bmiHeader\biHeight = bm\bmHeight
  bmi\bmiHeader\biPlanes = 1
  bmi\bmiHeader\biBitCount = 32
  bmi\bmiHeader\biCompression = #BI_RGB
  
  Mem = AllocateMemory(bm\bmWidth * bm\bmHeight * 4)
  If Mem
    
    hdc = CreateCompatibleDC_(GetDC_(ImageID))
    If hdc
      GetDIBits_(hdc, ImageID, 0, bm\bmHeight, Mem, @bmi, #DIB_RGB_COLORS) ; on envoie la liste dans l'image
      ReleaseDC_(0, hdc)
      Resultat = ImageID
    EndIf
    
    ; On convertit la liste dans le bon format
    For n = 0 To bm\bmHeight - 1
      For nn = 0 To bm\bmWidth - 1
        CopyMemory(Mem + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4, HList + n * 4 + nn * bm\bmHeight * 4, 4)
      Next
    Next
    
    FreeMemory(Mem)
  EndIf
  
  ProcedureReturn Resultat
EndProcedure

Procedure.f Longueur(x.f, y.f)
  ProcedureReturn Sqr(x * x + y * y)
EndProcedure

#Pi.f = 3.14159265

; Copie d'écran
Largeur_Ecran = GetSystemMetrics_(#SM_CXSCREEN)
Hauteur_Ecran = GetSystemMetrics_(#SM_CYSCREEN)

DC = GetDC_(0)
CreateImage(0, Largeur_Ecran, Hauteur_Ecran)
Dessin = StartDrawing(ImageOutput())
  BitBlt_(Dessin, 0, 0, Largeur_Ecran, Hauteur_Ecran, DC, 0, 0, #SRCPAINT)
StopDrawing()
ReleaseDC_(0, DC)

; OpenWindow(0, 0, 0, 100, 100, #WS_MAXIMIZE | #PB_Window_BorderLess, "Sphère")
; SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; Pour mettre la fenêtre toujours au premier plan
; UpdateWindow_(WindowID())

; On copie l'image dans un Tableau
Dim Image.l(Largeur_Ecran - 1, Hauteur_Ecran - 1)
GetImageBits2(UseImage(0), @Image())

; On ouvre l'openscreen
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser la souris ,le clavier ou l'écran. Vérifiez la présence de DirectX 7 ou supérieur.", 0)
  End
EndIf

If OpenScreen(Largeur_Ecran, Hauteur_Ecran, 32, "Sphère") = 0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.", 0)
  End
EndIf

CreateSprite(1, Largeur_Ecran, Hauteur_Ecran)
StartDrawing(SpriteOutput(1))
  DrawImage(UseImage(0), 0, 0)
StopDrawing()

Rayon = 100
Loupe.f = 0.5

Repeat
  ; On lit les évènements clavier et souris
  ExamineMouse()
  ExamineKeyboard()
  
  ; Position de la souris
  x = MouseX()
  y = MouseY()
  
  ; Agrandir ou réduire la sphère
  If KeyboardPushed(#PB_Key_Up) And Rayon < 100
    Rayon + 2
  ElseIf KeyboardPushed(#PB_Key_Down) And Rayon > 0
    Rayon - 2
  EndIf
  
  ; Augmenter ou diminuer l'effet de loupe
  If KeyboardPushed(#PB_Key_Right) And Loupe < 1
    Loupe + 0.05
  ElseIf KeyboardPushed(#PB_Key_Left) And Loupe > 0
    Loupe - 0.05
  EndIf
  
  ; On affiche l'image
  DisplaySprite(1, 0, 0)
  
  StartDrawing(ScreenOutput())
    ; Calcul du FPS
    cpt + 1
    If cpt = 10
      cpt = 0
      fps = 10000 / (ElapsedMilliseconds() - Temps)
      Temps = ElapsedMilliseconds()
    EndIf
    Locate(5, 5)
    DrawText(Str(fps))
    
    ; On édite l'image
    Memoire = DrawingBuffer()
    For n = -Rayon To Rayon
      x2 = x + n
      If x2 > 0 And x2 < Largeur_Ecran - 1 ; Si on est sur l'image en x
        For nn = -Rayon To Rayon
          y2 = y + nn
          If y2 > 0 And y2 < Hauteur_Ecran - 1 ; Si on est sur l'image en y
            Longueur.f = Longueur(n, nn) ; On calcul la distance d'un point de la sphère à partir du centre
            If Longueur <= Rayon ; Si le pixel est situé dans le rayon du cercle
              If Longueur > 0
                Longueur2.f = ASin(Longueur / Rayon * Loupe + (1 - Loupe)) * 2 / #Pi ; on calcul la distance du point de l'image correspondant à celui de la sphère

                ; Avec lissage
                PosX.f = x + n * Longueur2
                PosY.f = y + nn * Longueur2
                PosX_Int = PosX
                PosY_Int = PosY
                Rouge.f = 0 : Vert.f = 0 : Bleu.f = 0 : SommeFacteur.f = 0
                For i = PosX_Int - 1 To PosX_Int + 1
                  For ii = PosY_Int - 1 To PosY_Int + 1
                    Facteur.f = 1 - Longueur(i - PosX, ii - PosY)
                    If Facteur > 0
                      Rouge = Rouge + Red(Image(i, ii)) * Facteur
                      Vert = Vert + Green(Image(i, ii)) * Facteur
                      Bleu = Bleu + Blue(Image(i, ii)) * Facteur
                      SommeFacteur = SommeFacteur + Facteur
                    EndIf
                  Next
                Next
                Couleur.l = RGB(Int(Rouge / SommeFacteur), Int(Vert / SommeFacteur), Int(Bleu / SommeFacteur))
                
                ; Sans lissage
                ; Couleur.l = Image(Int(x + n * Longueur2 + 0.5), Int(y + nn * Longueur2 + 0.5))
                
              Else ; Cas particulier, le centre de la sphère
                Couleur.l = Image(x, y)
              EndIf
              ; On affiche le pixel
              Pixel_Memoire = Memoire + 4 * (x + n) + 4 * (y + nn) * Largeur_Ecran
              PokeL(Pixel_Memoire, Couleur)
            EndIf
          EndIf
        Next
      EndIf
    Next
    
  StopDrawing()
  
  FlipBuffers()
  
  If IsScreenActive() = 0
    End
  EndIf
  
Until KeyboardPushed(#PB_Key_Escape)
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Haut
garzul
Messages : 683
Inscription : mer. 26/mai/2004 0:33

Message par garzul »

:D Effectivement sa tourne beaucoup mieux Bravo LSI :D
Haut
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :
Contacter Le Soldat Inconnu

Message par Le Soldat Inconnu »

j'ai délocalisé le calcul avec l'arcsin qui était également gourmand.

pour cela, j'ai fait des calculs préliminaires que j'ai stocké dans une liste puis je récupère dans la liste la valeur voulue pour les calculs.

FPS de 16 sur mon PC

Code : Tout sélectionner

ProcedureDLL.l GetImageBits2(ImageID, HList) ; Transfert d'une image vers un tableau
  Protected bmi.BITMAPINFO, hdc.l, Resultat, Mem, n, nn, bm.BITMAP
  
  Resultat = 0
  
  GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP)
  
  bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
  bmi\bmiHeader\biWidth = bm\bmWidth
  bmi\bmiHeader\biHeight = bm\bmHeight
  bmi\bmiHeader\biPlanes = 1
  bmi\bmiHeader\biBitCount = 32
  bmi\bmiHeader\biCompression = #BI_RGB
  
  Mem = AllocateMemory(bm\bmWidth * bm\bmHeight * 4)
  If Mem
    
    hdc = CreateCompatibleDC_(GetDC_(ImageID))
    If hdc
      GetDIBits_(hdc, ImageID, 0, bm\bmHeight, Mem, @bmi, #DIB_RGB_COLORS) ; on envoie la liste dans l'image
      ReleaseDC_(0, hdc)
      Resultat = ImageID
    EndIf
    
    ; On convertit la liste dans le bon format
    For n = 0 To bm\bmHeight - 1
      For nn = 0 To bm\bmWidth - 1
        CopyMemory(Mem + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4, HList + n * 4 + nn * bm\bmHeight * 4, 4)
      Next
    Next
    
    FreeMemory(Mem)
  EndIf
  
  ProcedureReturn Resultat
EndProcedure

Procedure.f Longueur(x.f, y.f)
  ProcedureReturn Sqr(x * x + y * y)
EndProcedure

#Pi.f = 3.14159265

; Copie d'écran
Largeur_Ecran = GetSystemMetrics_(#SM_CXSCREEN)
Hauteur_Ecran = GetSystemMetrics_(#SM_CYSCREEN)

DC = GetDC_(0)
CreateImage(0, Largeur_Ecran, Hauteur_Ecran)
Dessin = StartDrawing(ImageOutput())
  BitBlt_(Dessin, 0, 0, Largeur_Ecran, Hauteur_Ecran, DC, 0, 0, #SRCPAINT)
StopDrawing()
ReleaseDC_(0, DC)

; OpenWindow(0, 0, 0, 100, 100, #WS_MAXIMIZE | #PB_Window_BorderLess, "Sphère")
; SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; Pour mettre la fenêtre toujours au premier plan
; UpdateWindow_(WindowID())

; On copie l'image dans un Tableau
Dim Image.l(Largeur_Ecran - 1, Hauteur_Ecran - 1)
GetImageBits2(UseImage(0), @Image())

; On ouvre l'openscreen
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser la souris ,le clavier ou l'écran. Vérifiez la présence de DirectX 7 ou supérieur.", 0)
  End
EndIf

If OpenScreen(Largeur_Ecran, Hauteur_Ecran, 32, "Sphère") = 0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.", 0)
  End
EndIf

; Création du sprite représentant l'écran
CreateSprite(1, Largeur_Ecran, Hauteur_Ecran)
StartDrawing(SpriteOutput(1))
  DrawImage(UseImage(0), 0, 0)
StopDrawing()

; Calcul préliminaire
#DefinitionArcSin = 2000
Dim ArcSin.f(#DefinitionArcSin)
For n = 0 To #DefinitionArcSin
  ArcSin(n) = ASin(n / #DefinitionArcSin) * 2 / #Pi
Next


; Initialisation des variables
#RayonMax = 150
Rayon = 100

Repeat
  ; On lit les évènements clavier et souris
  ExamineMouse()
  ExamineKeyboard()
  
  ; Position de la souris
  x = MouseX()
  y = MouseY()
  
  ; Agrandir ou réduire la sphère
  If KeyboardPushed(#PB_Key_Up) And Rayon < #RayonMax
    Rayon + 2
  ElseIf KeyboardPushed(#PB_Key_Down) And Rayon > 0
    Rayon - 2
  EndIf
  
  ; On affiche l'image
  DisplaySprite(1, 0, 0)
  
  StartDrawing(ScreenOutput())
    ; Calcul du FPS
    #DefinitionFPS = 20
    cpt + 1
    If cpt = #DefinitionFPS
      cpt = 0
      fps.f = #DefinitionFPS * 1000 / (ElapsedMilliseconds() - Temps)
      Temps = ElapsedMilliseconds()
    EndIf
    Locate(5, 5)
    DrawText(StrF(fps, 1))
    
    ; On édite l'image
    Memoire = DrawingBuffer()
    For n = -Rayon To Rayon
      x2 = x + n
      If x2 > 0 And x2 < Largeur_Ecran - 1 ; Si on est sur l'image en x
        For nn = -Rayon To Rayon
          y2 = y + nn
          If y2 > 0 And y2 < Hauteur_Ecran - 1 ; Si on est sur l'image en y
            Longueur.f = Longueur(n, nn) ; On calcul la distance d'un point de la sphère à partir du centre
            If Longueur <= Rayon ; Si le pixel est situé dans le rayon du cercle
              Longueur2.f = ArcSin(Int((Longueur / Rayon * 0.25 + 0.75) * #DefinitionArcSin)) ; on calcul la distance du point de l'image correspondant à celui de la sphère
              
              ; Avec lissage
              PosX.f = x + n * Longueur2
              PosY.f = y + nn * Longueur2
              PosX_Int = PosX
              PosY_Int = PosY
              Rouge.f = 0 : Vert.f = 0 : Bleu.f = 0 : SommeFacteur.f = 0
              For i = PosX_Int - 1 To PosX_Int + 1
                For ii = PosY_Int - 1 To PosY_Int + 1
                  Facteur.f = 1 - Longueur(i - PosX, ii - PosY)
                  If Facteur > 0
                    Rouge = Rouge + Red(Image(i, ii)) * Facteur
                    Vert = Vert + Green(Image(i, ii)) * Facteur
                    Bleu = Bleu + Blue(Image(i, ii)) * Facteur
                    SommeFacteur = SommeFacteur + Facteur
                  EndIf
                Next
              Next
              Couleur.l = RGB(Int(Rouge / SommeFacteur), Int(Vert / SommeFacteur), Int(Bleu / SommeFacteur))
              
              ; Sans lissage
              ; Couleur.l = Image(Int(x + n * Longueur2 + 0.5), Int(y + nn * Longueur2 + 0.5))
              
              ; On affiche le pixel
              Pixel_Memoire = Memoire + 4 * (x + n) + 4 * (y + nn) * Largeur_Ecran
              PokeL(Pixel_Memoire, Couleur)
            EndIf
          EndIf
        Next
      EndIf
    Next
    
  StopDrawing()
  
  FlipBuffers()
  
  If IsScreenActive() = 0
    End
  EndIf
  
Until KeyboardPushed(#PB_Key_Escape)
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Haut
garzul
Messages : 683
Inscription : mer. 26/mai/2004 0:33

Message par garzul »

18 FPS chez moi :D
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

@comtois
Cette affirmation m'a intrigué , j'ai voulu tester ,et j'obtiens exactement le contraire de ce que tu dis
bon j'ai eu des amelioration sur le code du soldat !
alors j'ai pensé ..... mais bon il etait 2:30 du mat, et j'aurai mieux fait de dormir !! :lol:

le truc conciste a remplacer les boucles for next (tres longue) par des while wend !!!
mais ça seulement ceux qui on une grande experience en prog basic savent que les boucle for next sont les boucles les plus lente !!! Very Happy Very Happy
ben le probleme c'est que comtois le sait pas !! , c'est pour ça qu'il trouve un resultat inverse !! :D :D :D






@soldat :

ben en fait j'ai laisser des erreur car j'etais en cour de recherche !! :)
et je voulais voir si t'allais trouver mes erreurs posé expres ,
et je te donnais un coup de main pour encoder ton code que je trouvais un peut trop simple pour moi !!

maintenant c'est facile de critiquer , apres tout t'a qu'a pas poster des codes a la noix , en posant des questions kon !! <---- :lol: :lol: :lol: :lol: :lol:
pis il etait plus de 2 heures , le poisson faisait des bulles , et pleins d'autres truc (garzul me prenait la tete :lol: )
c'est de la faute a Garzul de toute façon !!
GARZUL VIENS ICI !!

....... ben oui la !
vous le savez maintenant Garzul passe ses nuits avec moi !! :oops: :oops:

:lol:


ps : que personne ne dise que je suis de mauvaise foie !! :lol:
Haut
garzul
Messages : 683
Inscription : mer. 26/mai/2004 0:33

Message par garzul »

:lol: Lol Dobro on etait pas bien toi et moi dans ton forum hier soir toi a m'expliquer et moi a comprendre ( ah c'est beaux l'amour :lol: ) . PS : C'est pas moi qui tes deconcentrer c'est pas de ma faute si je suis tomber du lit ^^ .
Haut
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :
Contacter Le Soldat Inconnu

Message par Le Soldat Inconnu »

Vous feriez mieux de dormir :D

Allez Dobro, tu m'en veux pas d'avoir dis que tu avais fait que des bétises, hein ?
De toute façon il a l'habitude, pourquoi je m'en fais ...
:jesors:
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Haut
Répondre

Revenir à « Trucs et astuces »