Forum Liberty Basic France

Le 10/12/2020 à 09h55

Libertynaute Actif

Groupe: Membre

Inscrit le: 17/12/2010
Messages: 106
Fonction GetPixelValue$()
Renvoie la couleur d'un pixel comme une chaine "r g b"

Codé initialement par uncleBen, add-on 16 bits par tsh73

Attention : Parce qu'il sauve le pixel vers un fichier sur disque, il est plutôt lent.
Les tests indiquent environ 500 pixels par secondes sur une box 3Gz. Prenez cela en compte.

Caché:
GetPixelValue$ function
returns pixel color as "r g b" string

code by uncleBen, 16-bit add-on by tsh73

Warning. Because it saves pixel to file on disk, it's pretty slow
my tests shows about 500 pixels per second on 3GGz box. Just be aware of it.

Source du code : https://justbasiccom.proboards.com/thread/179/complete-commands-lookingfor-specific-functionality


Code VB :
 
open "test" for graphics as #gr
#gr "trapclose [quit]"
#gr "home; down; posxy cx cy"
 
#gr "font times_new_roman italic 24 "
#gr "\x"
#gr "place ";cx+14;" ";cy+7
#gr "font times_new_roman italic 16 bold"
#gr "\B"
#gr "flush"
 
i = 0
maxXLtr=22
print "maxXLtr=";maxXLtr
print "dim ltr$(maxXLtr) 'Times New Roman italic via GetPixelValue$ "
for y = cy-15 to cy-15+maxXLtr-1
SCAN
    i =i+1
    print "ltr$(";using("##",i);")="+chr$(34);
    for x = cx-2 to cx+28
        c$=" "
'        if GetPixelValue$(x, y, "#gr")="  0   0   0" then c$="*"
        if GetPixelValue$(x, y, "#gr")<>"255 255 255" then c$="*"
        print c$;
    next
    print chr$(34)
next
 
wait
 
[quit]
close #gr
end
 
'------------------------------
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)
 
'Grab a 1*1 bitmap
    #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
 
'Save in a bmp file
    bmpsave "gpv", "getpvaluetemp.bmp"
 
'Open the file for string input and get it's full contents
    open "getpvaluetemp.bmp" for input as #gpv
    s$ = input$(#gpv, lof(#gpv))
    close #gpv
 
'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
    bpp =  asc(mid$(s$, 29, 1))
    select case bpp
    case 32
        red = asc(mid$(s$, 69, 1))
        green = asc(mid$(s$, 68, 1))
        blue = asc(mid$(s$, 67, 1))
    case 24
        red = asc(mid$(s$, 57, 1))
        green = asc(mid$(s$, 56, 1))
        blue = asc(mid$(s$, 55, 1))
    case 16
        bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
        red =  (bytes AND 63488) /256       '0xF800
        green =  (bytes AND 2016) / 32 * 4  '0x7E0
        blue =  (bytes AND 31) * 8          '0x1F
    end select
 
'concatenate the return value, delete temporary file and free memory
    GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue)
    kill "getpvaluetemp.bmp"
    unloadbmp "gpv"
end function
 
 




Edité par joan74 Le 10/12/2020 à 16h26
____________________
"L'urgent c'est fait ! L'impossible est en cours... pour les miracles, merci de prévoir un délai supplémentaire !"

   
Le 10/12/2020 à 11h01

Modérateur

Groupe: Modérateur

Inscrit le: 09/02/2015
Messages: 696
C'est fait ! Merci pour avoir déniché cette fonction. Pour la traduction, le contexte d'origine n'y est plus, donc il peut y avoir des phrases surprenantes) :

Fonction GetPixelValue$
Renvoie la couleur d'un pixel comme une chaine "r g b" (utile pour JB).
Cette très utile fonction n'est pas à placer ici ! (conseil : vous pouvez charger n'importe quel BMP et prendre ses couleurs)
Repris d'un forum JB.
Codé par uncleBen, add-on 16 bits par tsh73
Attention : Parce qu'il sauve le pixel vers un fichier sur disque, il est plutot lent - mes test indiquent environ 500 pixels par secondes sur une box 3GGz. Prenez compte de ce fait.

Code VB :
 
'GetPixelValues$ renvoie une chaine avec les composantes RVB d'un pixel
'dans les coordonnées x et y d'une fenêtre/graphicbox nommée handle$ (par exemple, "main.graph)
function GetPixelValue$(x, y, handle$)
 
'créée un bitmap (ndt. : ici, une capture d'écran) de 1 pixel de côté
 #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1
 
'sauve le bitmap sur disque
 bmpsave "gpv", "getpvaluetemp.bmp"
 
'ouvre le fichier en entrée chaine et le lit en entier
 open "getpvaluetemp.bmp" for input as #gpv
 s$ = input$(#gpv, lof(#gpv))
 close #gpv
 
'Vérifie si l'écran de l'utilisateur est en 32-bit, et lit les composantes rouge-vert-bleu
'Si l'affichage est en 16 bit, alors les couleurs sont masquées. Aussi, quelques derniers bits
'(3 pour rouge, 2 pour vert et 3 pour bleu) sont toujours à zéro.
'Cela veut dire que vous n'aurez jamais 255 255 255 pour blanc - (248 252 248) à la place.
'Vous devez expérimenter, autrement la fonction ne retourne rien (le support pour d'autre types d'affichages
'pourrait être ajouté (?))

bpp = asc(mid$(s$, 29, 1))
select case bpp
 
    case 32
        red = asc(mid$(s$, 69, 1))
        green = asc(mid$(s$, 68, 1))
        blue = asc(mid$(s$, 67, 1))
 
    case 16
        bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
        red = (bytes AND 63488) /256 '0xF800
        green = (bytes AND 2016) / 32 * 4 '0x7E0
        blue = (bytes AND 31) * 8 '0x1F

end select
 
'met en chaine les valeurs retournées, efface le fichier temporaire et libère la mémoire
 GetPixelValue$ = str$(red)+" "+str$(green)+" "+str$(blue)
kill "getpvaluetemp.bmp"
unloadbmp "gpv"
end function
 




Edité par Christophe Le 10/12/2020 à 11h20
____________________
Just BASIC v2.0 :
  • utilisation courante avec GNU/Linux Mageia7+ Wine (Pas trouvé d'incohérences ou de bug de compilation à ce jour)
  • utilisation occasionnelle ou vérification/débugage difficile avec Windows XP sur un petit eeepc

   
Le 10/12/2020 à 12h36

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2371
Bah, c'est la fonction que j'ai utilisée dans l'effaceur de grille, avec les problèmes attenants.
Joan, comme les carabiniers d'Offenbachn arrive après la bataille.
____________________
Roro

   

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie