Pour bouger la loupe, avec la souris
pour agrandir ou réduire la taille : flèches haut et bas
pour augmenter ou diminuer l'effet de loupe : flèches droite et gauche
Voici la version sans lissage du contenu de la loupe :
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
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)mais si je fais un lissage, catasthrophe, c'est trop lent
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
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)
