PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

remplacer Point()

http://forums.purebasic.com/french/viewtopic.php?t=4296

Page 1 sur 1

remplacer Point()

Publié : dim. 15/janv./2006 18:32
par Backup
bon en fait c'est surtout la fonction point()
qui est treeeees longue (pour juste une lecture memoire c'est fort de café !! :? )

aussi, j'etait parti pour remplacer cette fonction, en faisant une lecture direct de l'ecran... comme ça ..



InitSprite ()
InitMouse ()
Declare point_dob(dc2,Largeur,X,Y)
Resultat = OpenScreen (1024, 768, 32, "hello" )
Repeat ; Start of the event loop
     ExamineMouse ()
     If MouseButton (2)
         End
     EndIf
    StartDrawing ( ScreenOutput ())
    dc2= DrawingBuffer ()
    Largeur=1024
    couleur=point_dob(dc2,Largeur,100,100)
     Locate (10,10)
     DrawText ( Str (dc2))
     Locate (10,50)
     DrawText ( Str (couleur))
      Delay (200)
     StopDrawing ()
     FlipBuffers ()
     ClearScreen (0,0,255)
ForEver




Procedure point_dob(dc2,Largeur,X,Y)
    AdresseMemoire =dc2
    couleur= PeekL (AdresseMemoire+(X*4)+Largeur*(Y*4))
     ProcedureReturn couleur
EndProcedure






ça marche avec l'ecran , mais pas si l'on utilise une image
il semble que la fonction "dc2=DrawingBuffer()" renvoi toujour zero
si c'est pas l'ecran !! est-ce normal ?

sinon comment recuperer l'adresse du debut d'une image a votre avis ? 8O

Publié : dim. 15/janv./2006 18:52
par Backup
comment faire pour une image ?


InitSprite ()
InitMouse ()
Declare point_dob(dc2,Largeur,X,Y)

CreateImage (1,1024,768 )

Resultat = OpenScreen (1024, 768, 32, "hello" )
Repeat ; Start of the event loop
     ExamineMouse ()
     If MouseButton (2)
         End
     EndIf
     UseImage (1)
  
     StartDrawing ( ImageOutput ())
dc2= DrawingBuffer () ;<--- COMMENT REMPLACER ça ??
    Largeur=1024
     Box (0,0,1024,768, RGB (255,0,0)) ; on cree du rouge dans l'image
    couleur=point_dob(dc2,Largeur,100,100) ; on lit un point
     StopDrawing ()
    
     ; en principe on ecrit le resultat
     StartDrawing ( ScreenOutput ())
     Locate (10,10)
     DrawText ( Str (dc2))
     Locate (10,50)
     DrawText ( Str (couleur))
     Delay (200)
     StopDrawing ()
     FlipBuffers ()
    
ForEver




Procedure point_dob(dc2,Largeur,X,Y)
    AdresseMemoire =dc2
    couleur= PeekL (AdresseMemoire+(X*4)+Largeur*(Y*4))
     ProcedureReturn couleur
EndProcedure

Publié : dim. 15/janv./2006 19:30
par Gillou
le principe que j'utilise est de passer par un tableau


ProcedureDLL ImageToTable(Image, Table) ; Retourne 1 si l'image a été chargée dans le tableau ImageID=#Image : Table=@Tableau(), ex : Dim Tableau(ImageWidth(), ImageHeight()) -> @Tableau()
If Image>=0 And Table
UseImage (Image)
ImageID = ImageID ()
  Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
   If HDC
    bmi.BITMAPINFO
    bm.BITMAP
     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
    HList = AllocateMemory (bm\bmWidth*bm\bmHeight*4)
     GetDIBits_ (hDC, ImageID ,0,bm\bmHeight,HList,bmi, #DIB_RGB_COLORS )
    
     For nn = 0 To bm\bmWidth - 1
       For n = 0 To bm\bmHeight - 1
        s = HList + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
        d = Table + n * 4 + nn * bm\bmHeight * 4
         CopyMemory (s + 2, d, 1)
         CopyMemory (s + 1, d + 1, 1)
         CopyMemory (s, d + 2, 1)
       Next n
      Table+4
     Next nn
     FreeMemory (HList)
   Else
     ProcedureReturn
   EndIf
   ProcedureReturn 1
EndIf
EndProcedure

ProcedureDLL TableToImage(Image, Table) ; Crée une image à partir du tableau Image=#Image, Table=@Tableau(), ex : Dim Tableau(ImageWidth(),ImageHeight()) -> @Tableau()
If IsImage (Image) And Table
ImageID = UseImage (Image)
bm.BITMAP
GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
bmi.BITMAPINFO
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
pixel= AllocateMemory (bm\bmHeight*bm\bmWidth*4)
     For nn = 0 To bm\bmwidth - 1
       For n = 0 To bm\bmheight - 1
        s = Table + n * 4 + nn * bm\bmHeight * 4
        d = pixel + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
         CopyMemory (s, d + 2, 1)
         CopyMemory (s + 1, d + 1, 1)
         CopyMemory (s + 2, d, 1)
       Next
      table + 4
     Next
HDC= StartDrawing ( ImageOutput ())
SetDIBits_ (HDC, ImageID ,0, ImageHeight (), pixel, bmi, #DIB_RGB_COLORS )
StopDrawing ()
FreeMemory (pixel)
ProcedureReturn 1
EndIf
EndProcedure



Dim image(1024,768)
For x=0 To 1023
For y=0 To 767
image(x,y)=255
Next
Next
TableToImage(1,image())

Publié : dim. 15/janv./2006 19:32
par Backup
regardez ceci

echanger la ligne 133 par 134

133 == Ma Fonction point()

134 == la fonction purebasic

cherchez l'erreur :lol: :lol:


; Code par Dobro !!
; system solaire
; avec raytracing pour l'affichage des parties éclairés
; Purebasic 4.00

Declare.f RotationX(X, angle.f, dist)
Declare.f RotationY(Y, angle.f, dist)
Declare calcul()
Declare point_dob(dc2,X,Y) ; nouvelle fonction point()<---


Enumeration
   #dobro
   #Police
   #soleil
   #terre
   #lune
   #ecran
EndEnumeration

Structure soleil
  X.l
  Y.l
EndStructure
Global Dim soleil.soleil(1)

Structure lune
  X.l
  Y.l
EndStructure
Global Dim lune.lune(1)

Structure terre
  X.l
  Y.l
EndStructure
Global Dim terre.terre(1)

; ***********************************
Resultat = InitSprite ()
FontID = LoadFont ( #Police , "arial" , 18, #PB_Font_Bold )
EcranX = GetSystemMetrics_ ( #SM_CXSCREEN ): ;=largeur de l'ecran
EcranY = GetSystemMetrics_ ( #SM_CYSCREEN ): ;=hauteur de l'ecran
   WindowID = OpenWindow (1, 0, 0,EcranX, EcranY, "system solaire maintenir un appuis sur ESC pour quitter" , #PB_Window_SystemMenu|#PB_Window_BorderLess |#PB_Window_ScreenCentered )
  Result = OpenWindowedScreen ( WindowID (1) ,0,0,EcranX, EcranY, 1, 0,0)
  
  Resultat = InitMouse ()
  Resultat = InitKeyboard ()
  
   ; creation de notre ecran
   CreateSprite ( #ecran , EcranX, EcranY)
   StartDrawing ( SpriteOutput ( #ecran ) )
   For etoiles=1 To 1000
    x_etoile= Random (EcranX-10)+5
    y_etoile= Random (EcranY-10)+5
     Plot ( x_etoile, y_etoile, RGB ($FF,$CD,$FC))
   Next etoiles
   StopDrawing ()
  
   ; creation du soleil
   CreateSprite ( #soleil , 64,64)
   StartDrawing ( SpriteOutput ( #soleil ) ) ; on dessine dedans
   Circle (32, 32, 32 , RGB ($FF,$FF,$97))
   StopDrawing ()
  
   ; creation de la terre
   CreateSprite ( #terre , 32, 32)
   StartDrawing ( SpriteOutput ( #terre ) ) ; on dessine dedans
   Circle (16, 16, 16 , RGB ($71,$88,$F9))
   StopDrawing ()
  
   ; creation de la lune
   CreateSprite ( #lune , 16, 16)
   StartDrawing ( SpriteOutput ( #lune ) ) ; on dessine dedans
   Circle (8, 8, 8 , RGB ($A6,$A6,$A6))
   StopDrawing ()
  
  taille_du_cercle_terre=180
  taille_du_cercle_lune=50
  nombre_de_jour_terre=360 ; ceci determine la resolution (nombre de points)
  nombre_de_jour_lune=21 ; ceci determine la resolution (nombre de points)
  soleil(1)\X=EcranX/2-64
  soleil(1)\Y=EcranY/2-64
   Repeat
     ExamineMouse ()
     ExamineKeyboard ()
     WindowEvent ()
     Delay (2)
    
     If MouseButton (2)
       End
     EndIf
    
    compt_terre+1
    compt_lune+1
     If compt_terre=nombre_de_jour_terre :compt_terre=0: EndIf ; on a fait le tour ??
     If compt_lune=nombre_de_jour_lune :compt_lune=0: EndIf ; on a fait le tour ??
    
    
    terre(1)\X=taille_du_cercle_terre* Cos ( compt_terre*(2*3.1415926/nombre_de_jour_terre)) + (soleil(1)\X+8 ) ; la formule du cercle /360 = 360 points
    terre(1)\Y=taille_du_cercle_terre * Sin ( compt_terre*(2*3.1415926/nombre_de_jour_terre)) + (soleil(1)\Y+8 ) ; la formule du cercle
    
    lune(1)\X=taille_du_cercle_lune* Cos ( compt_lune*(2*3.1415926/nombre_de_jour_lune)) + (terre(1)\X) ; la formule du cercle /360 = 360 points
    lune(1)\Y=taille_du_cercle_lune * Sin ( compt_lune*(2*3.1415926/nombre_de_jour_lune)) + (terre(1)\Y) ; la formule du cercle
    
    
    calcul() ; saut vers le raytracing maison Smile
    
     FlipBuffers (): ; affiche l'ecran
     ClearScreen ( RGB (0, 0, 0)) : ;efface l'ecran
   Until Event= #PB_Event_CloseWindow
  
  
   Procedure.f RotationX(X, angle.f, dist)
     ProcedureReturn X + Cos (angle.f* #PI /180)*dist
   EndProcedure
  
  
   Procedure.f RotationY(Y, angle.f, dist)
     ProcedureReturn Y + Sin (angle.f* #PI /180)*dist
   EndProcedure
  
   Procedure calcul()
     ; DisplaySprite ( #ecran , 0, 0)
     DisplayTransparentSprite ( #soleil , soleil(1)\X, soleil(1)\Y)
     DisplayTransparentSprite ( #terre , terre(1)\X, terre(1)\Y)
     DisplayTransparentSprite ( #lune , lune(1)\X, lune(1)\Y)
    lumiere= RGB ($FF,$FF,$97) ; lumiere du soleil
     StartDrawing ( ScreenOutput ())
    dc2= DrawingBuffer ()
     For i=1 To 360
       For distance=100 To 250 Step 2
        coul=point_dob(dc2,RotationX(soleil(1)\X+32, i, distance) ,RotationY(soleil(1)\Y+32, i, distance)) ; <-- Ma Fonction
         ;coul= Point (RotationX(soleil(1)\X+32, i, distance) ,RotationY(soleil(1)\Y+32, i, distance)) ; La fonction PUREBASIC
        
         If coul= RGB ($A6,$A6,$A6) ;la lumiere rencontre la lune
          lumiere= RGB ($FF,$FF,$97) ; lumiere du soleil
           Box (RotationX(soleil(1)\X+32, i, distance) , RotationY(soleil(1)\Y+32, i, distance),1,1,lumiere)
           Box (RotationX(soleil(1)\X+32, i, distance+1) , RotationY(soleil(1)\Y+32, i, distance+1),1,1,lumiere)
           Box (RotationX(soleil(1)\X+32, i, distance+2) , RotationY(soleil(1)\Y+32, i, distance+2),1,1,lumiere)
           Box (RotationX(soleil(1)\X+32, i, distance+3) , RotationY(soleil(1)\Y+32, i, distance+3),1,1,lumiere)
           Box (RotationX(soleil(1)\X+32, i, distance+4) , RotationY(soleil(1)\Y+32, i, distance+4),1,1,lumiere)
           Box (RotationX(soleil(1)\X+32, i, distance+5) , RotationY(soleil(1)\Y+32, i, distance+5),1,1,lumiere)
          Break 1
         Else
          lumiere= RGB ($FF,$FF,$97) ; lumiere du soleil
           Plot (RotationX(soleil(1)\X+32, i, distance) , RotationY(soleil(1)\Y+32, i, distance),lumiere)
         EndIf
         If KeyboardPushed ( #PB_Key_All )
           End
         EndIf
         While WindowEvent () : Wend
       Next distance
      flag=0
     Next i
     StopDrawing ()
   EndProcedure
  
  
  
   Procedure point_dob(dc2,X2,Y2)
  EcranX = GetSystemMetrics_ ( #SM_CXSCREEN ): ;=largeur de l'ecran
    AdresseMemoire =dc2
    couleur= PeekL (AdresseMemoire+(X2*4)+ EcranX*(Y2*4))
     ProcedureReturn couleur
   EndProcedure

Publié : dim. 15/janv./2006 19:33
par Dr. Dri
le drawingbuffer ne fonctionne que pour les objets directx il me semble

Dri

Publié : dim. 15/janv./2006 19:50
par Gillou
Franchement, j'aurais pas du picoler comme ça hier soir

Mais je vois pas pourquoi tu ne peux utiliser ce principe pour mettre ton image en rouge

Publié : dim. 15/janv./2006 20:06
par Backup
vous avez testé la difference de vitesse entre la ligne 133 et 134 sur mon dernier listing ? 8O


pour mon prg anaglyphe , le probleme c'est que je travaille avec des UseImage(#xxx)

et que ma fonction point_dob() a besoin d'une adresse memoire
pour recuperer celle de l'ecran pas de probleme avec DrawingBuffer()

mais pour une image ?? impossible en l'etat de recuperer l'adresse d'une image que l'on a soit chargé soit Crée !! :?

le GFABasic commence a me manquer la ! :?


ps [Reedit]

j'utilise aussi les tableau , mais de façon bien plus simple que ta version :D

Publié : dim. 15/janv./2006 20:14
par Gillou
Regarde dans la fonction Imagetotable
je charge l'image
Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
If HDC
bmi.BITMAPINFO
bm.BITMAP
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
HList = AllocateMemory (bm\bmWidth*bm\bmHeight*4)
GetDIBits_ (hDC, ImageID ,0,bm\bmHeight,HList,bmi, #DIB_RGB_COLORS )

et HList retourne l'adressememoire de l'image

Publié : dim. 15/janv./2006 20:17
par Backup
Gillou a écrit :Regarde dans la fonction Imagetotable
je charge l'image
Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
If HDC
bmi.BITMAPINFO
bm.BITMAP
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
HList = AllocateMemory (bm\bmWidth*bm\bmHeight*4)
GetDIBits_ (hDC, ImageID ,0,bm\bmHeight,HList,bmi, #DIB_RGB_COLORS )

et HList retourne l'adressememoire de l'image
oui :D
c'est une façon detourné car en fait tu met l'image dans un objet et tu recupere l'adresse de l'objet

j'aurai bien aimé un system integré au Purebasic
Mais , je retiens ta soluce ... Merci . :D
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru