Zoom

SPH · Message par **SPH** » sam. 23/févr./2008 9:14

Ce serait bien d'avoir une instruction "zoom" pour zoomer une image; soit en plus petit, soit en plus grand; en prenant aussi en compte le flip H et V et le "lissage" des couleurs.

Merci

Backup · Message par **Backup** » sam. 23/févr./2008 12:37

peut etre une voie a suivre

Code : Tout sélectionner


; Le Soldat inconnu
 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

; 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(0))
BitBlt_(dessin, 0, 0, Largeur_Ecran, Hauteur_Ecran, DC, 0, 0, #SRCPAINT)
StopDrawing()
ReleaseDC_(0, DC)

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

; On copie l'image dans un Tableau
Dim Image.l(Largeur_Ecran - 1, Hauteur_Ecran - 1)
GetImageBits2(ImageID(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(ImageID(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
   
    DrawText(5,5,Str(fps))
    
    ; On édite l'image
    Memoire = DrawingBuffer()
    For n = -Rayon To Rayon
        If x + n > 0 And x + n < Largeur_Ecran - 1 ; Si on est sur l'image en x
            For nn = -Rayon To Rayon
                If Y + nn > 0 And Y + nn < Hauteur_Ecran - 1 ; Si on est sur l'image en y
                    longueur.f = Longueur(x, Y, x + n, Y + 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 = ASin(longueur / Rayon * Loupe + (1 - Loupe)) * 2 / #PI * longueur ; on calcul la distance du point de l'image correspondant à celui de la sphère
                        If longueur > 0
                            PosX.f = x + n * Longueur2 / longueur
                            PosY.f = Y + nn * Longueur2 / longueur
                            
                            ; 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)

Anonyme2 · Message par **Anonyme2** » sam. 23/févr./2008 16:37

SPH a écrit :Ce serait bien d'avoir une instruction "zoom" pour zoomer une image; soit en plus petit, soit en plus grand; en prenant aussi en compte le flip H et V et le "lissage" des couleurs.

Merci

Si tu utilises Windows, As-tu regardé avec GDI+ ?

dans la doc qe j'ai écrite, il y a des exemples pour faire des zoom en 2 lignes de code (ou presque), le lissage (anti-crénelage) fait partie des possibilités de GDI+ également.

A+
Denis

Thyphoon · Message par **Thyphoon** » sam. 23/févr./2008 18:59

j'aime pas les codes qui utilises des Apis windows

ça devrait être interdit au nom de la portabilité !

On peut déjà zoomer sur une image il me semble bien qu'on peut spécifier la largeur et la hauteur de l'image lorsqu'on l'affiche
DrawImage(ImageID, x, y [, Largeur, Hauteur])
c'est pas suffisant ?
apres pour le flip horizontal et vertical on doit pouvoir faire ça en purebasic natif !

SPH · Message par **SPH** » sam. 23/févr./2008 22:51

Sur mon matos, en PB4.02, le code ci dessus présente un bug graphique.
Ce code est sencé faire quoi exactement ???

Backup · Message par **Backup** » dim. 24/févr./2008 12:36

SPH a écrit :Sur mon matos, en PB4.02, le code ci dessus présente un bug graphique.
Ce code est sencé faire quoi exactement ???

une loupe !! qui affiche ce qui se trouve sous le pointeur de la souris

a tout hasard, voici la derniere version que le Soldat avait posté :
(a lancer sans le debugger parceque sinon, c'est lent !! )

Code : Tout sélectionner

; Loupe 3
; programmé par le Soldat Inconnu
; purebasic 4.00



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 



; 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 (0)) 
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( ImageID (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 ( ImageID (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 
    
    DrawText ( 5,5,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 )

SPH · Message par **SPH** » dim. 24/févr./2008 20:46

Non ca ne marche pas. Ce probleme est typique a purebasic qui a un reel bug avec certaines cartes graphiques.
Il y a un décallage dans la "loupe"; exactement ce bug que j'expliquais ici :
http://www.purebasic.fr/french/viewtopic.php?t=7542

J'avais codé un truc avec une logique implacable mais "case" a trouvé le "bug" que je n'ai jamais vraiment analysé.

Mais là, avec cette loupe, j'ai aussi ce décallage. Donc, soit le code a un bug, soit c'est PB (je penche pour la 2eme solution car j'ai rencontré ca plusieurs fois)

Backup · Message par **Backup** » dim. 24/févr./2008 21:04

SPH a écrit :Donc, soit le code a un bug, soit c'est PB (je penche pour la 2eme solution car j'ai rencontré ca plusieurs fois)

chez moi ça marche nickel pourtant , donc je crois plus a une incompatibilité materiel plutot qu'un bug ....

pour info , j'ai une carte pilote Nvidia , winfast 7600 GT monté en PCI normale (pas express !) ..

Anonyme · Message par **Anonyme** » dim. 24/févr./2008 21:09

l'accès à la mémoire vidéo est mauvaise , essaye ca , je peut pas testé sous nux :

Code : Tout sélectionner

; Loupe 3
; programmé par le Soldat Inconnu
; purebasic 4.00



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



; 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 (0))
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( ImageID (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 ( ImageID (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
   
    DrawText ( 5,5,StrF (fps, 1))
   
    ; On édite l'image
    Memoire = DrawingBuffer ()
    PixelFormat = DrawingBufferPixelFormat()
    BufferLineSize = DrawingBufferPitch()
     
              Select PixelFormat 
                          Case  #PB_PixelFormat_8Bits         : PixFrt = 1   
                          Case  #PB_PixelFormat_15Bits        : PixFrt = 2   
                          Case  #PB_PixelFormat_16Bits        : PixFrt = 2   
                          Case  #PB_PixelFormat_24Bits_RGB    : PixFrt = 3   
                          Case  #PB_PixelFormat_24Bits_BGR    : PixFrt = 3   
                          Case  #PB_PixelFormat_32Bits_RGB    : PixFrt = 4   
                          Case  #PB_PixelFormat_32Bits_BGR    : PixFrt = 4   
                EndSelect 
    
    
    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
                        ;FAUX ---> Pixel_Memoire = Memoire + 4 * (x + n) + 4 * (Y + nn) * Largeur_Ecran
                        Pixel_Memoire = Memoire +(x*PixFrt) + (BufferLineSize/PixFrt) *(y*PixFrt)
                        
                        
                        PokeL (Pixel_Memoire, Couleur)
                    EndIf
                EndIf
            Next
        EndIf
    Next
   
    StopDrawing ()
   
    FlipBuffers ()
   
    If IsScreenActive () = 0
        End
    EndIf
   
  Until KeyboardPushed ( #PB_Key_Escape )

SPH · Message par **SPH** » dim. 24/févr./2008 23:10

@Cpl.Bator :

Cette fois-ci, plus du tout de loupe. Que l'image capturée et un chiffre qui change parfois en haut a gauche...

Anonyme · Message par **Anonyme** » dim. 24/févr./2008 23:37

y a sûrement à revoir le code , au niveau de l'écriture sur le buffer , j'ai omis les n & nn je crois. donc rien à l'écran

edit :

Code : Tout sélectionner

; Loupe 3
; programmé par le Soldat Inconnu
; purebasic 4.00



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



; 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 (0))
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( ImageID (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 ( ImageID (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
  
  DrawText ( 5,5,StrF (fps, 1))
  
  ; On édite l'image
  Memoire = DrawingBuffer ()
  PixelFormat = DrawingBufferPixelFormat()
  BufferLineSize = DrawingBufferPitch()
  
  Select PixelFormat
    Case  #PB_PixelFormat_8Bits         : PixFrt = 1   
    Case  #PB_PixelFormat_15Bits        : PixFrt = 2   
    Case  #PB_PixelFormat_16Bits        : PixFrt = 2   
    Case  #PB_PixelFormat_24Bits_RGB    : PixFrt = 3   
    Case  #PB_PixelFormat_24Bits_BGR    : PixFrt = 3   
    Case  #PB_PixelFormat_32Bits_RGB    : PixFrt = 4   
    Case  #PB_PixelFormat_32Bits_BGR    : PixFrt = 4   
  EndSelect
  
  
  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
            ;FAUX ---> Pixel_Memoire = Memoire + 4 * (x + n) + 4 * (Y + nn) * Largeur_Ecran
            Pixel_Memoire = Memoire +((X+n)*PixFrt) + (BufferLineSize/PixFrt) *((Y+nn)*PixFrt)
            
            
            PokeL (Pixel_Memoire, Couleur)
          EndIf
        EndIf
      Next
    EndIf
  Next
  
  StopDrawing ()
  
  FlipBuffers ()
  
  If IsScreenActive () = 0
    End
  EndIf
  
Until KeyboardPushed ( #PB_Key_Escape )

SPH · Message par **SPH** » lun. 25/févr./2008 2:28

Ok, là, ca fonctionne impec.

Donc, raconte nous précisement ce qui n'allait pas dans les précédents codes ?????

PS : reste que je souhaite une fonction zoom intégré dans PB

Anonyme · Message par **Anonyme** » lun. 25/févr./2008 6:36

C'était l'écriture sur le buffer vidéo qui était foireux.

Le problème , c'est qu'en règle générale , la taille d'une ligne du buffer , est égale à la taille de l'écran en X , mais pas toujours....
donc pour avoir la bonne taille , il faut récupérer la taille en octets de cette ligne , puis de diviser cette taille par le format du pixel.

Code : Tout sélectionner

Memoire +((X+n)*PixFrt) + (BufferLineSize/PixFrt) *((Y+nn)*PixFrt)

SPH · Message par **SPH** » lun. 25/févr./2008 8:00

Cpl.Bator a écrit :C'était l'écriture sur le buffer vidéo qui était foireux.

Le problème , c'est qu'en règle générale , la taille d'une ligne du buffer , est égale à la taille de l'écran en X , mais pas toujours....

Voila, on est d'accord, NORMALEMENT, en toute logique, une ligne de buffer devrait correspondre a la largeur de l'ecran !
Mais helas, PAS TOUJOURS...

J'ai vu plusieurs code faisant cette erreur sans savoir si ca venait du code ou de PB. Et je me rapelle un code en openGL ou je ne sais plus quoi qui avait ce bug. Mais dans ce cas, je me demande si le coupable etait vraiment le code...

PureBasic

Zoom

Zoom

Re: Zoom