Bon revoici le code du Soldat inconu , je le remet car un procedure.f
a ete transformé en procedure tout court !!
ce qui donne un moirage dans la petite sphere , c'est domage non ,
pis si le soldat voit ça , je vais me faire allumer !
revoici le code correcte !
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 = 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 )
j'ai meme pas d'imprimante ! 
