XProfan

Hallo, wenn ich die Cerca 3x Hintereinander einzeln eingebe, funktioniert es.
Aber in einer While-Schleife kommt die Fehlermeldung : Scol$ nicht declariert.
Kompilieren Markieren Separieren

 $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

Jupp, mein Code hat den Fehler innerhalb einer While-Schleife ein Return abzusetzen.

Muss ich umschreiben...

Christian
Schneider

Aktualisiert: corre jetzt auch in Schleifen:
Kompilieren Markieren Separieren

 $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
    RETURN -1

endproc

XProfan 11| Vista(64) SP2

Die Lösung suche ich nicht. Ich möchte dauernd einen Punkt überprüfen lassen, solange die Grafik die Position verändert.

mfg

Du kannst nach diesem Verfahren sogar ganz fix komplexe Körper in der Grafik finden lassen - Zeilenweise.

(schade das ich jetzt hier keine Programmierumgebung hab)

Darum geht es mir ja. Darum die Whileloop...

die hoffentlich bald geht...

mfg

Christian
Schneider

Habe mein obiges Beispiel aktualisiert. Auch wenn du die Mehrfachsuche nicht brauchst: es corre jetzt auch in Schleifen. Die 1. Fundstelle kannst du einfach per
Kompilieren Markieren Separieren

HIWORD(SOMEPOS&[0]),LOWORD(SOMEPOS&[0])

auslesen.

XProfan 11| Vista(64) SP2

Christian
Schneider

Hat jemand eine Idee wie man am Besten Toleranzen bei den Farbwerten performant einbauen potuto (z.B. +/- 5 bei R G B). Die Möglichen Farben generieren und einzeln abarbeiten dauert wohl viel zu lange.

XProfan 11| Vista(64) SP2

Ein Pass circa alle Bytes legen z.B. den ByteWert durch 8 Teilen.

Integerzahl durch 8 = 2^3
cls
declare a%
a% = 16
print a%>>3
WaitInput
end

Habe den Return-Bug der Codes im Ausgangsposting behoben.

@Peter: Schade das MAT nicht mit Strings funktioniert bzw. Strings sich nicht nativ in Byte Arrays (und zurück) konvertieren lassen.