Français
Source/ Codesnippets

la couleur trouver Hpic Pixel chercher

 

KompilierenMarqueSéparationou
KompilierenMarqueSéparation
 $H windows.ph
STRUCT BITMAPINFOHEADER=BISIZE&,BIWIDTH&,BIHEIGHT&,BIPLANES%,BIBITCOUNT%,BICOMPRESSION&,BISIZEIMAGE&,BIXPELSPERMETER&,BIYPELSPERMETER&,BICLRUSED&,BICLRIMPORTANT&
RANDOMIZE
CLS
var HPIC&=CREATE(hNewPic,1024,1024,0)
var X&=RND(1024)
var Y&=RND(1024)
var COL&=$00FF00
STARTPAINT HPIC&
SETPIXEL X&,Y&,COL&
ENDPAINT
var SOMEPOS&=HPIC.PIXELSEARCH(HPIC&,COL&,1024,1024)
PRINT X&,Y&
PRINT HIWORD(SOMEPOS&),LOWORD(SOMEPOS&)
WAITINPUT
FIN

proc HPIC.BGR2STRING

    PARAMETERS H&,_WIDTH&,_HEIGHT&
    var SZ&=( (_WIDTH&*328-1) | 3 +1) * ABS(_HEIGHT&)
    DECLARE MEM#
    DIM MEM#,BITMAPINFOHEADER

    WITH MEM#

        .BISIZE&=SIZEOF(MEM#)
        .BIWIDTH&=_WIDTH&
        .BIHEIGHT&=_HEIGHT&
        .BIPLANES%=1
        .BIBITCOUNT%=32
        .BICOMPRESSION&=0
        .BISIZEIMAGE&=SZ&

    ENDWITH

    DECLARE DATA#
    DIM DATA#,SZ&
    var RET$=

    IF ~GetDIBits(%HDC,H&,0,_HEIGHT&,DATA#,MEM#,0)

        RET$=CHAR$(DATA#,0,SZ&)

    ENDIF

    DISPOSE DATA#
    DISPOSE MEM#
    RETOUR +RET$

endproc

proc HPIC.PIXELSEARCH

    PARAMETERS H&,COLORTOFIND&,_WIDTH&,_HEIGHT&
    var RAWDATA$=HPIC.BGR2STRING(H&,_WIDTH&,_HEIGHT&)
    var _FND&=HPIC.FINDCOLORINRAWDATA(COLORTOFIND&,RAWDATA$)

    IF _FND&=-1

        RETOUR _FND&

    ENDIF

    var X&=_FND& MOD _WIDTH&
    var Y&=0

    IF _FND& > 0

        Y&=_FND&\_WIDTH&

    ENDIF

    RETOUR X&*65536+(_HEIGHT&-Y&-1)

endproc

proc HPIC.FINDCOLORINRAWDATA

    PARAMETERS COL&,DATA$
    var C&=1
    var P&=0
    var RET&=-1
    var SCOL$=CHR$(GETBVALUE(COL&))+CHR$(GETGVALUE(COL&))+CHR$(GETRVALUE(COL&))

    WHILE 1

        P&=INSTR(SCOL$,DATA$,C&)

        IFNOT P&

            BREAK

        ENDIF

        IFNOT (P&-1) MOD 4

            RET&=P&*0.25
            BREAK

        ENDIF

        C&=P&+1

    ENDWHILE

    RETOUR RET&

endproc

end

426 kB
Hochgeladen:03.03.2009
Downloadcounter81
Download
 
03.03.2009  
 



allô, si je qui cherche 3x Hintereinander einzeln eingebe, funktioniert es.
mais dans einer Tandis que-Boucle venez qui Fehlermeldung : Scol$ pas declariert.
KompilierenMarqueSéparation
 $H windows.ph
STRUCT BITMAPINFOHEADER=BISIZE&,BIWIDTH&,BIHEIGHT&,BIPLANES%,BIBITCOUNT%,BICOMPRESSION&,BISIZEIMAGE&,BIXPELSPERMETER&,BIYPELSPERMETER&,BICLRUSED&,BICLRIMPORTANT&
RANDOMIZE
CLS
var HPIC&=CREATE(hNewPic,1024,1024,0)
var X&=RND(1024)
var Y&=RND(1024)
var COL&=$00FF00
STARTPAINT HPIC&
SETPIXEL X&,Y&,COL&
ENDPAINT
var SOMEPOS&=HPIC.PIXELSEARCH(HPIC&,COL&,1024,1024)
PRINT X&,Y&
PRINT HIWORD(SOMEPOS&),LOWORD(SOMEPOS&)
SOMEPOS&=HPIC.PIXELSEARCH(HPIC&,COL&,1024,1024)
PRINT X&,Y&
PRINT HIWORD(SOMEPOS&),LOWORD(SOMEPOS&)
SOMEPOS&=HPIC.PIXELSEARCH(HPIC&,COL&,1024,1024)
PRINT X&,Y&
PRINT HIWORD(SOMEPOS&),LOWORD(SOMEPOS&)

whileloop 1,10

    SOMEPOS&=HPIC.PIXELSEARCH(HPIC&,COL&,1024,1024)
    PRINT X&,Y&
    PRINT HIWORD(SOMEPOS&),LOWORD(SOMEPOS&)

endwhile

WAITINPUT
END

proc HPIC.BGR2STRING

    PARAMETERS H&,_WIDTH&,_HEIGHT&
    var SZ&=( (_WIDTH&*328-1) | 3 +1) * ABS(_HEIGHT&)
    DECLARE MEM#
    DIM MEM#,BITMAPINFOHEADER

    WITH MEM#

        .BISIZE&=SIZEOF(MEM#)
        .BIWIDTH&=_WIDTH&
        .BIHEIGHT&=_HEIGHT&
        .BIPLANES%=1
        .BIBITCOUNT%=32
        .BICOMPRESSION&=0
        .BISIZEIMAGE&=SZ&

    ENDWITH

    DECLARE DATA#
    DIM DATA#,SZ&
    var RET$=

    IF ~GetDIBits(%HDC,H&,0,_HEIGHT&,DATA#,MEM#,0)

        RET$=CHAR$(DATA#,0,SZ&)

    ENDIF

    DISPOSE DATA#
    DISPOSE MEM#
    RETURN +RET$

endproc

proc HPIC.PIXELSEARCH

    PARAMETERS H&,COLORTOFIND&,_WIDTH&,_HEIGHT&
    var RAWDATA$=HPIC.BGR2STRING(H&,_WIDTH&,_HEIGHT&)
    var _FND&=HPIC.FINDCOLORINRAWDATA(COLORTOFIND&,RAWDATA$)

    IF _FND&=-1

        RETURN _FND&

    ENDIF

    var X&=_FND& MOD _WIDTH&
    var Y&=0

    IF _FND& > 0

        Y&=_FND&\_WIDTH&

    ENDIF

    RETURN X&*65536+(_HEIGHT&-Y&-1)

endproc

proc HPIC.FINDCOLORINRAWDATA

    PARAMETERS COL&,DATA$
    var C&=1
    var P&=0
    var SCOL$=CHR$(GETBVALUE(COL&))+CHR$(GETGVALUE(COL&))+CHR$(GETRVALUE(COL&))

    WHILE 1

        P&=INSTR(SCOL$,DATA$,C&)

        IFNOT P&

            BREAK

        ENDIF

        IFNOT (P&-1) MOD 4

            RETURN P&*0.25

        ENDIF

        C&=P&+1

    ENDWHILE

    RETURN ass=s2>-1

endproc

 
05.03.2009  
 



Jupp, mon Code hat den faute dedans einer Tandis que-Boucle un Retour abzusetzen.

Muss je paraphraser...
 
05.03.2009  
 




Christian
Schneider
Aktualisiert: fonctionne maintenant aussi dans Schleifen:
KompilierenMarqueSéparation
 $H windows.ph
STRUCT BITMAPINFOHEADER=BISIZE&,BIWIDTH&,BIHEIGHT&,BIPLANES%,BIBITCOUNT%,BICOMPRESSION&,BISIZEIMAGE&,BIXPELSPERMETER&,BIYPELSPERMETER&,BICLRUSED&,BICLRIMPORTANT&
Declare SEARCHPOSITION&,SOMEPOS&[],Rawdata$
RANDOMIZE
CLS
var HPIC&=CREATE(hNewPic,1024,1024,0)
var X&=RND(1024)
var Y&=RND(1024)
var COL&=$00FF00
STARTPAINT HPIC&
SETPIXEL 1,999,COL&
SETPIXEL 100,230,COL&
SETPIXEL 100,220,COL&
SETPIXEL 100,231,COL&
ENDPAINT

Whileloop 10

    suchfunktion(1024,1024,COL&)

    Whileloop Sizeof(Somepos&[])

        PRINT HIWORD(SOMEPOS&[&Loop-1]),LOWORD(SOMEPOS&[&loop-1])

    Endwhile

Endwhile

WAITINPUT
END

proc suchfunktion

    SEARCHPOSITION&=1
    Clear Rawdata$
    Clear Somepos&[]
    Parameters searchx&,searchy&,color&
    var durchlauf&=0
    var arraysize&=2
    Somepos&[0]=0

    Whilenot SOMEPOS&[arraysize&-2]=-709309

        SOMEPOS&[durchlauf&]=HPIC.PIXELSEARCH(HPIC&,color&,1024,1024)
        SOMEPOS&[durchlauf&+1]=0
        arraysize&=sizeof(somepos&[])
        inc durchlauf&

    Endwhile

    SetSize Somepos&[], (Sizeof(Somepos&[])-2)
    clear durchlauf&

endproc

proc HPIC.BGR2STRING

    PARAMETERS H&,_WIDTH&,_HEIGHT&
    var SZ&=( (_WIDTH&*328-1) | 3 +1) * ABS(_HEIGHT&)
    DECLARE MEM#
    DIM MEM#,BITMAPINFOHEADER

    WITH MEM#

        .BISIZE&=SIZEOF(MEM#)
        .BIWIDTH&=_WIDTH&
        .BIHEIGHT&=_HEIGHT&
        .BIPLANES%=1
        .BIBITCOUNT%=32
        .BICOMPRESSION&=0
        .BISIZEIMAGE&=SZ&

    ENDWITH

    DECLARE DATA#
    DIM DATA#,SZ&
    var RET$=

    IF ~GetDIBits(%HDC,H&,0,_HEIGHT&,DATA#,MEM#,0)

        RET$=CHAR$(DATA#,0,SZ&)

    ENDIF

    DISPOSE DATA#
    DISPOSE MEM#
    RETURN +RET$

endproc

proc HPIC.PIXELSEARCH

    PARAMETERS H&,COLORTOFIND&,_WIDTH&,_HEIGHT&

    if @len(rawdata$)<1

        RAWDATA$=HPIC.BGR2STRING(H&,_WIDTH&,_HEIGHT&)

    endif

    var _FND&=HPIC.FINDCOLORINRAWDATA(COLORTOFIND&,RAWDATA$)

    IF _FND&=-1

        RETURN _FND&

    ENDIF

    var X&=_FND& MOD _WIDTH&
    var Y&=0

    IF _FND& > 0

        Y&=_FND&\_WIDTH&

    ENDIF

    RETURN X&*65536+(_HEIGHT&-Y&-1)

endproc

proc HPIC.FINDCOLORINRAWDATA

    PARAMETERS COL&,DATA$
    var C&=SEARCHPOSITION&
    var P&=0
    var SCOL$=CHR$(GETBVALUE(COL&))+CHR$(GETGVALUE(COL&))+CHR$(GETRVALUE(COL&))
    P&=INSTR(SCOL$,DATA$,C&)
    SEARCHPOSITION&=P&+1

    IFNOT P&

        RETURN -1000000000000

    ENDIF

    IFNOT (P&-1) MOD 4

        RETURN P&*0.25

    EndIF

    C&=P&+1
    RETOUR -1

endproc

 
XProfan 11| Vista(64) SP2
05.03.2009  
 



qui Solution cherche je pas. je voudrais durable une Punkt überprüfen laisser, solange qui Grafik qui Position modifié.

mfg
 
05.03.2009  
 



tu peux pour diesem procéder sogar entier fix komplexe Körper dans qui Grafik trouver laisser - Zeilenweise.

(tant pis le moi maintenant ici aucun Programmierumgebung hab)
 
05.03.2009  
 



tout autor ca va mir oui. tout autor qui Whileloop... qui hoffentlich bientôt allez...

mfg
 
05.03.2009  
 




Christian
Schneider
Habe mon obiges Beispiel aktualisiert. aussi si du qui Mehrfachsuche pas brauchst: es fonctionne maintenant aussi dans Schleifen. qui 1. Fundstelle peux du simple per
KompilierenMarqueSéparation
HIWORD(SOMEPOS&[0]),LOWORD(SOMEPOS&[0])
>
auslesen.
 
XProfan 11| Vista(64) SP2
05.03.2009  
 




Christian
Schneider
Hat quelqu'un une concept comment on am Besten Toleranzen chez den Farbwerten performant einbauen pourrait (z.B. +/- 5 chez R G B). qui Möglichen Farben generieren et einzeln abarbeiten dauert wohl viel trop longtemps.
 
XProfan 11| Vista(64) SP2
05.03.2009  
 



un Pass sur alle Bytes poser z.B. den ByteWert par 8 partager.
 
05.03.2009  
 



Integerzahl par 8 = 2^3
cls
declare a%
a% = 16
imprimer a%>>3
WaitInput
end
 
05.03.2009  
 



Habe den Retour-Bug qui Codes im Ausgangsposting behoben.

@Peter: tant pis cela MAT pas avec Cordes funktioniert bzw. Cordes sich pas nativ dans Byte Arrays (et zurück) konvertieren laisser.
 
05.03.2009  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

7.662 Views

Untitledvor 0 min.
Sven Bader18.08.2021
Normann Strübli09.06.2020
Ernst10.04.2014
funkheld12.01.2014
plus...

Themeninformationen



Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie