pour les mals voyants
qui moi ?Super tu as créé la fonction imprimer qui manqué terriblement à PureBasic
j'ai meme pas d'imprimante ! 
@ Dri , c'est quant meme le mien qui est le plus complet pour l'instant !!
coloration:
des chaines de charactere
des Fonctions purebasic
des Commentaires
des Constantes
et t'a meme les bugs fourni gratos en plus !
Gillou a écrit :thyphoon, tu as quoi comme os pour savoir ce que je dois corrigé comme erreur
Dobro, manque plus que :
les fonctions assembleur
les séparateurs
les labels
les opérateurs
les séprateurs
les pointeurs
les constantes
et puis ça devrait le faire
Non je déconne c'est déjà super vos progs
c'est pas vraiment le plus dur a faire !
seulement, le choix des couleurs pour le forum est quand meme limité
pour que ça reste "acceptable"
par contre continuer le develloppement pour en faire un outils de
generation de page html, pourquoi pas !
de toute façon je vais bientot donner le source !!
comme ça chacun pourra s'amuser avec ,vu que c'est programmer
tres simple, sans prise de tete !
mais avant , je le pauffine un peu , et je nettoierai le code en
mettant des annotations dedans
.....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 !
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 )
Ben j'espère bien que tu vas te faire allumer
CASSEZ-VOUS, VITE, DOBRO EST EN FLAMME
Je me disais aussi, je me rappelais pas que la sphère était comme ça
bon autrement c'est une bonne idée, je vais regardé ça de plus près
CASSEZ-VOUS, VITE, DOBRO EST EN FLAMME
Je me disais aussi, je me rappelais pas que la sphère était comme ça
bon autrement c'est une bonne idée, je vais regardé ça de plus près
Dernière modification par Gillou le mar. 01/nov./2005 19:58, modifié 1 fois.
@Dobro
faudrait arrêter le hors sujet... je vais te faire la liste de ce que mon pb2html supporte ^^
la couleur de fond
les chaines
les fonctions (interfaces comprises)
les structures (interfaces comprises)
les opérateurs
les séparateurs
les commentaires
les nombres (+ binaire et hexa)
les types (var.b, couleur du "b")
les pointeurs
Dri
faudrait arrêter le hors sujet... je vais te faire la liste de ce que mon pb2html supporte ^^
la couleur de fond
les chaines
les fonctions (interfaces comprises)
les structures (interfaces comprises)
les opérateurs
les séparateurs
les commentaires
les nombres (+ binaire et hexa)
les types (var.b, couleur du "b")
les pointeurs
Dri
