PureBasic

Forums PureBasic
Nous sommes le Sam 24/Aoû/2019 23:31

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 45 messages ]  Aller à la page 1, 2, 3  Suivante
Auteur Message
 Sujet du message: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 15:08 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
Salut,

je viens de faire mes derniers effets speciaux en 2D (la prochaine fois, ce sera de la 3D car il faut que je m'y mette)

La démo (et le .pb) est telechargeable ici : http://xmas.free.fr/demo_dog.zip

Pas mal ce qu'on peux faire en PB 8) :idea: :!: :wink:

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 19:51 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3484
Tu peux pas poster le source ? Je n'accède pas aux zips.

Et il est où ton topo sur le logarithme de base 10 ? Tu l'as viré?

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 20:06 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
Ollivier a écrit:
Tu peux pas poster le source ? Je n'accède pas aux zips.

Tu n'as pas un logiciel style winzip ?
Le code source se trouvait dans le zip...
Code:
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser l'écran.")
  End
EndIf
If InitSound() = 0
  MessageRequester("Error", "Sound system not available.") : End
EndIf

LoadMusic(0, "MOD.mod")


ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

If OpenScreen(ddw,ddh,32,"DOG")=0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

If LoadSprite(0,"dog.bmp")=0
  MessageRequester("Erreur", "Image introuvable.")
  End
EndIf

ClearScreen(0)





xxx.f=1.4
yyy.f=1.1
rx.f=200
ry.f=220
oldyyy=0
deca=0


FlipBuffers()
Delay(1000)

LoadFont (0, "Courier", 30)            ; Load Courrier Font, Size 15

For i= 5 To 255 Step 5
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-30,ddh/2-4, "DOG", RGB(i,i,i))
  StopDrawing()
  FlipBuffers()
  Delay(1)
Next
Delay(2000)

For i= 250 To 0 Step -10
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-30,ddh/2-4, "DOG", RGB(i,i,i))
  StopDrawing()
  FlipBuffers()
  Delay(1)
Next


ClearScreen(0)
FlipBuffers()

;;;;;;;;;;;;;;;;;;;;;;;;

ClipSprite(0,0,0,514,604)
DisplaySprite(0,0,0)

Dim p(514,604)
Dim p2(514,604)


StartDrawing(ScreenOutput())
For i=0 To 514
  For u=0 To 604
    p(i,u)=Point(i,u)
    p2(i,u)=p(i,u)
  Next
Next
StopDrawing()
ClearScreen(0)


;;;;;;;;;;


; LoadFont (0, "Courier", 30)            ; Load Courrier Font, Size 15
StartDrawing(ScreenOutput())
DrawingMode(0)                          ; Transparent TextBackground

DrawingFont(FontID(0))                 ; Use the 'Courier' font
DrawText(ddw/2+ddw/64,ddh/2-46, "Code : SPH", RGB(255, 255,255))    ; Print our text
DrawText(ddw/2+ddw/64,ddh/2+0, "GFX : Cougar", RGB(255, 255,255))   ; Print our text
DrawText(ddw/2+ddw/64,ddh/2+46, "Music : Tristan LORACH", RGB(255, 255,255))    ; Print our text
                                                                                ; Box(ddw/2+ddw/64,ddh/2-46,530,130,RGB(255,0,0))
StopDrawing()
GrabSprite(1,ddw/2+ddw/64,ddh/2-46,530,130)


temps= ElapsedMilliseconds()

;Goto la

PlayMusic(0)








;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  FlipBuffers()
  DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  FlipBuffers()
 
Repeat
  If all=0
    ClipSprite(0,0,0,514,604)
    DisplaySprite(0,120,ddh/8-50)
  EndIf
 
;   DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
 
  If ElapsedMilliseconds()-temps>7950
    Goto la4
  EndIf ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
  For i=600+ddh/8 To 600+200+ddh/8
    ;    Debug Cos(Radian(yyy))*ry
    u=Cos(Radian(yyy+i*3))*ry+Sin(Radian(xxx+i*2))*rx
    If u>604
      u-604
    EndIf
    If u<0
      u+604
    EndIf

   
    ClipSprite(0,0,u,514,1)
    DisplaySprite(0,120,i)
    yyy+0.1
  Next
 
 
  xxx=oldxxx+3.14
  oldxxx=xxx
  yyy=oldyyy+2.74
  oldyyy=yyy
 
  FlipBuffers()
  ExamineKeyboard()
 
Until KeyboardPushed(#PB_Key_Escape)
End

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

la4:
u= 604
;    DisplaySprite(0,120,ddh/8-50)
Repeat
 
  StartDrawing(ScreenOutput())
  For i=0 To 514
    LineXY(i+120,u+ddh/8-50,i+120,ddh,p(i,u))
  Next
  StopDrawing()
  FlipBuffers()
  ExamineKeyboard()
 
  u-2
Until u<0 Or KeyboardPushed(#PB_Key_Escape)

If u>=0
  End
EndIf



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;






Repeat
 
  For i=0 To ddh-1
   
    u=Cos(Radian(yyy+i/5))*ry+Cos(Radian(xxx))*rx
   
    If u>604
      u-604
    EndIf
    If u<0
      u+604
    EndIf
    ClipSprite(0,0,u,514,1)
    DisplaySprite(0,120,i)
    yyy+0.35
    ;     ry+1
   
  Next
 
 
  xxx=oldxxx+1.14
  oldxxx=xxx
  yyy=oldyyy+0.74
  oldyyy=yyy
 
  ;  End 
  If ElapsedMilliseconds()-temps>27000
    Goto la5
  EndIf
 
 
  FlipBuffers()
  ExamineKeyboard()
 
Until KeyboardPushed(#PB_Key_Escape)

End

la5:









;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;; 2 ;;;;;
la:


ClipSprite(0,0,0,514,604)

ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)

FlipBuffers()
ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)

sq2=0
;;;;;;;;;;;
Repeat
 
 
  StartDrawing(ScreenOutput())
  For i=0 To 514
    For u=0 To 604
      rvb=p2(i,u)
      r.w=Red(rvb)
      If r>01
        r-2
      EndIf
      v.w=Green(rvb)
      If v>01
        v-2
      EndIf
      b.w=Blue(rvb)
      If b>01
        b-2
      EndIf
      p2(i,u)=RGB(r,v,b)
      rvb=(r+v+b)/3
      Plot(i+Random(sq2)-sq2/2+120,u+Random(sq2)-sq2/2+ddh/8,RGB(rvb,rvb,rvb))
     
    Next
  Next
  StopDrawing()
 
  sq2+1
 
  FlipBuffers()
  If sq2=1
    Delay(2000)
  EndIf
 
 
  ExamineKeyboard()
Until sq2>108 Or KeyboardPushed(#PB_Key_Escape)

If sq2<108
  End
EndIf


x1.f=10
y1.f=51
x2.f=100
y2.f=78
x3.f=23
y3.f=91

Dim r(514,604)
Dim v(514,604)
Dim b(514,604)

cmb=0

ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)

FlipBuffers()
ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)


Repeat
 
;   DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  StartDrawing(ScreenOutput())
 
 
  For i=-20 To 30
    For u=-20 To 30
     
      xx1=i+257+Cos(Radian(x1))*120-Cos(Radian(x2))*120
      yy1=u+302+Sin(Radian(y1))*150+Cos(Radian(x2))*150
      xx2=i+257+Cos(Radian(x2))*120+Cos(Radian(x3))*120
      yy2=u+302+Cos(Radian(y2))*150-Sin(Radian(x3))*150
      xx3=i+257+Cos(Radian(x3))*120+Cos(Radian(x1))*120
      yy3=u+302+Sin(Radian(y3))*150+Sin(Radian(x1+y1))*150
     
      If xx1>0 And xx1<514
        If yy1>0 And yy1<604
          r(xx1,yy1)=Red(p(xx1,yy1))
          ;           ok1=1
          Plot(xx1+120,yy1+ddh/8,RGB(r(xx1,yy1),v(xx1,yy1),b(xx1,yy1)))
        EndIf
      EndIf
      If xx2>0 And xx2<514
        If yy2>0 And yy2<604
          v(xx2,yy2)=Green(p(xx2,yy2))
          ;           ok2=1
          Plot(xx2+120,yy2+ddh/8,RGB(r(xx2,yy2),v(xx2,yy2),b(xx2,yy2)))
        EndIf
      EndIf
      If xx3>0 And xx3<514
        If yy3>0 And yy3<604
          b(xx3,yy3)=Blue(p(xx3,yy3))
          ;           ok3=1
          Plot(xx3+120,yy3+ddh/8,RGB(r(xx3,yy3),v(xx3,yy3),b(xx3,yy3)))
        EndIf
      EndIf
     
     
    Next
  Next
 
  StopDrawing()
 
  x1+1.2
  y1+0.52
  x2+0.7
  y2+1.14
  x3+1.35
  y3+0.88
  cmb+1
 
 
  FlipBuffers()
  ExamineKeyboard()
 
Until cmb>2100 Or KeyboardPushed(#PB_Key_Escape)

If cmb<2100
  End
EndIf


FlipBuffers()
ClearScreen(0)
FlipBuffers()
ClearScreen(0)
Delay(500)

LoadFont (0, "Courier", 30)            ; Load Courrier Font, Size 15

For i= 5 To 255 Step 5
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-250,ddh/2-4, "Thanks for watching", RGB(i,i,i))
  StopDrawing()
  FlipBuffers()
  Delay(1)
Next
Delay(2000)

For i= 250 To 0 Step -10
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-250,ddh/2-4, "Thanks for watching", RGB(i,i,i))
  StopDrawing()
  FlipBuffers()
  Delay(1)
Next

Delay(500)

End


_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Dernière édition par SPH le Ven 24/Mai/2019 16:36, édité 4 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 20:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8742
Yeah sympa !
Quel retour vers le passé que de voir cette image ! :mrgreen:
@Ollivier : voilà l'image : http://share.ldvmultimedia.com/dog.bmp

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 20:33 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2788
Localisation: Klyntar
SPH a écrit:
Tu n'as pas un logiciel style winzip ?


Il pourrait même dezipper avec Purebasic 8)






@++

_________________
Windows 10 x64, PureBasic 5.71 Beta 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 20:38 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
Ar-S a écrit:
Yeah sympa !

Tu l'as vu jusqu'a la "reconstruction" RGB ?

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 20:49 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8742
Oui, l'effet marche au poil. Un peu trop long à mon goût mais il marche nickel.
Le 1er effet aussi est bien (le genre de déformation reflet) mais tu ne devrais pas le répéter. (un seul reflet suffirait).
Le second en loop passe bien par contre.
Voilà pour mon résumé :D
Bravo en tous cas.
Tu me surprendras toujours. Pas fichu de faire une GUI fonctionnelle et des codes 2D toujours surprenant :mrgreen:

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 20:52 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
:mrgreen:

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 22:21 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3484
ArS a écrit:
@Ollivier : voilà l'image

Eh ! Mais c'est pas du CGA ça !
J'espère que tu ne vas pas me comptabiliser ça dans les trois images que tu m'as accordées !!

@SPH

Merci pour le code source. Je regarderai ça prochainement. Et tu ne te souviendrais pas où tu as fourré l'équation de calcul des factorielles avec un sinus dedans ? Ça doit dater de 2011, je ne sais pas pourquoi tu l'avais pondu. Ça semblait hors contexte, mais c'est une super équation. Donc si ça te dit quelquechose, ça m'intéresse...

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mar 14/Mai/2019 22:39 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
Ollivier a écrit:
Et tu ne te souviendrais pas où tu as fourré l'équation de calcul des factorielles avec un sinus dedans ? Ça doit dater de 2011, je ne sais pas pourquoi tu l'avais pondu. Ça semblait hors contexte, mais c'est une super équation. Donc si ça te dit quelquechose, ça m'intéresse...

[HS] Si tu parles du code que j'ai pondu il y a quelques jours, je l'ai retiré du forum... pas simplement pour le retirer mais pour le perfectionner. Je le ressortirais dans quelques jours [/HS]

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mer 15/Mai/2019 10:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6645
Localisation: Isere
Sympa la démo spécial épileptique :mrgreen:
Merci 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: "Dog" en N&B
MessagePosté: Mer 15/Mai/2019 19:57 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
Salut,

curieusement, ce code ne transforme pas l'image couleur en noire et blanche.
Pkoi ??

Code:
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser l'écran.")
  End
EndIf


ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

If OpenScreen(ddw,ddh,32,"DOG N&B")=0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

If LoadSprite(0,"dog.bmp")=0
  MessageRequester("Erreur", "Image introuvable.")
  End
EndIf


ClipSprite(0,0,0,514,604)
DisplaySprite(0,0,0)

Dim p(514,604)

StartDrawing(ScreenOutput())
For i=0 To 514
  For u=0 To 604
    p(i,u)=Point(i,u)
  Next
Next
StopDrawing()
ClearScreen(0)

;;;;;;;;;;;

StartDrawing(ScreenOutput())
For i=0 To 514
  For u=0 To 604
    rvb=p(i,u)
    r.w=Red(rvb)
    v.w=Green(rvb)
    b.w=Blue(rvb)
   
    Plot(i,u,(r+v+b)/3) ;;;;;;;;;;;;;  curieux, ca ne donne pas une image en noire et blanche
   
  Next
Next
StopDrawing()

FlipBuffers()

Repeat
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End


_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mer 15/Mai/2019 21:04 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2788
Localisation: Klyntar
J'imagine que tu recherche un "niveau de gris" pas un vrai "noir et blanc".

ce code récupère chaque pixel, additionne le R+G+B et verifie si le pixel et supperieur ou inferieur a 255 <-- (cette valeur peut être changer pour avoir plus ou moins de blanc. Ligne 48 et 50) :wink: Si c'est inférieur, on transforme le pixel en noir. Si c'est supérieur on met un pixel blanc.

je balance le code si jamais ça peut servir a d'autre.
Code:

Structure img
     x.l
     y.l
     color.l
EndStructure

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UsePNGImageEncoder()

file$ = OpenFileRequester("fichier image", "", "image compatible|*.bmp;*.jpg;*.png;*.tga;*.tif", 0) ; <---- ont choisit une image bitmap
If LoadImage(1, file$) ; <--- ont charge l'image du dessus
     If StartDrawing(ImageOutput(1))
         width = ImageWidth(1) ; <--- ont prend la largeur de l'image
         height = ImageHeight(1) ; <--- ont prend la hauteur de l'image
         size = width * height ; <--- ont multiplie la largeur par la hauteur pour savoir le nombre de pixels au total
         Dim Array.img(size)
         
         ; <------------------------- ont récupère la  couleur de chaque pixel -----------------------
         i = 0
         For y = 0 To height - 1
           For x = 0 To width - 1
             color = Point(x, y)
             Array(i)\x = x
             Array(i)\y = y
             Array(i)\color = color
             i + 1
           Next
         Next
         ; <------------------------------------------------------------------------------------------
       StopDrawing()
     EndIf
EndIf

If OpenWindow(0, 0, 0, ImageWidth(1), ImageHeight(1), "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) ; <------------------------- ont ouvre une fenêtre a la taille de l'image
     If CreateImage(0, ImageWidth(1), ImageHeight(1)) ; <------------------------- ont charge l'environnement image
       If StartDrawing(ImageOutput(0))
           
           For i = 0 To size - 1
             i = 0
             For y = 0 To height - 1
               For x = 0 To width - 1
                 i + 1
                 color = Point(x, y)
              If Red(Array(i)\color) + Green(Array(i)\color) + Blue(Array(i)\color) < 255 ; <---- on verifie si chaque pixel R + G + B est inferieur a 382
                Plot(Array(i)\x, Array(i)\y, RGB(0, 0, 0)) ; <---- on creer un pixel noir
              ElseIf Red(Array(i)\color) + Green(Array(i)\color) + Blue(Array(i)\color) > 255 ; <---- on verifie si chaque pixel R + G + B est supperieur a 382
                Plot(Array(i)\x, Array(i)\y, RGB(255, 255, 255)) ; <---- on creer un pixel blanc
              EndIf
               Next
             Next
           Next
   
         StopDrawing()
       EndIf
     EndIf
     
     ImageGadget(0, 0, 0, 0, 0, ImageID(0))

     Repeat
       EventID = WaitWindowEvent()
     Until EventID = #PB_Event_CloseWindow
EndIf
; <------------------------- et ont quitte







@++

_________________
Windows 10 x64, PureBasic 5.71 Beta 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mer 15/Mai/2019 21:23 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4046
Sorry, je cherche toute la palette de gris (du noir au blanc) :|

Curieux que mon "Plot(i,u,(r+v+b)/3)" ne marche pas !

EDIT : je viens de trouver !!!!!!

look : Plot(i,u,RGB((r+v+b)/3,(r+v+b)/3,(r+v+b)/3))

Vicieux mais ca marche !! :arrow: 8)

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Démo "Dog"
MessagePosté: Mer 15/Mai/2019 22:46 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8742
Oui c'est l'équivalent de RGBA(gray,gray,gray,255) de la proce ci dessous.. C'est tout de même plus lisible non ?
En reprenant ton code.. Mais en le modifiant. (une proce dans ta face :))

Code:
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser l'écran.")
  End
EndIf

Declare NB()



; La proce qui va convertir ton sprite en N&B
Procedure NB()
 
  Protected Old, R, G, B, Color, x, y, Gray
  StartDrawing(SpriteOutput(0))
 
  For y = 0 To SpriteHeight(0)-1
    For x = 0 To SpriteWidth(0)-1
     
      Color = Point(x,y)
     
      R = Red(Color)
      G = Green(Color)
      B = Blue(Color)
     
      Gray = (R + G + B) / 3
      Old = RGBA(gray,gray,gray,255) 
      Plot ( x, y, Old)
     
    Next x
  Next  y
 
  StopDrawing()
 
EndProcedure





ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

If OpenScreen(ddw,ddh,32,"DOG N&B")=0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

If LoadSprite(0,"dog.bmp")=0
  MessageRequester("Erreur", "Image introuvable.")
  End
EndIf



; Appel de la proce
NB()

; Il serait pas mal de bosser ton affichage dans la boucle...

Repeat
  ExamineKeyboard()
  ClearScreen(0)
  DisplaySprite(0,0,0)
  FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)
End

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 45 messages ]  Aller à la page 1, 2, 3  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye