Quelltexte/ Codesnippets | | | | |  |
KompilierenMarkierenSeparieren {$cleq}
randomize
const xx=1024
const yy=1024
cls
long hPic=create(hNewPic,xx,yy,0)
long x=rnd(xx),y=rnd(yy)
long col=$00FF00
startPaint hPic
setPixel x,y,col
endPaint
long somePos=hPic.PixelSearch(hPic,col,xx,yy)
print x,y
print hiWord(somePos),loWord(somePos)
waitInput
end
string hPic.bgr2String(long h,_width,_height){
long sz=( (_width*328-1) | 3 +1) * abs(_height)
mem mem=bitmapInfoHeader
with mem
.biSize& = sizeof(mem)
.biWidth& = _width
.biHeight& = _height
.biPlanes% = 1
.biBitCount% = 32
.biCompression& = BI_RGB
.biSizeImage& = sz
endwith
mem data=sz
string ret=error
case ~getDIBits(hDC,h,,_height,data,mem,) : ret=char$(data,0,sz)
dispose data
dispose mem
return ret
}
long hPic.PixelSearch(long h,colorToFind,_width,_height){
string rawData=hPic.bgr2String(h,_width,_height)
long _fnd=hPic.findColorInRawData(colorToFind,rawData)
case _fnd==-1 : return _fnd
long x=_fnd mod _width,y
case _fnd > 0 : y=_fnd\_width
return x*65536+(_height-y-1)
}
long hPic.findColorInRawData(long col,string data){
long c=1,p,ret=-1
string sCol=chr$(getBValue(col))+chr$(getGValue(col))+chr$(getRValue(col))
do {
p=instr(sCol,data,c)
casenot p : break
ifnot (p-1) mod 4 {
ret=p*0.25
break
}
c=p+1
}
return ret
}
KompilierenMarkierenSeparieren $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
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 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
RETURN RET&
endproc
end
|
 | | | | | | |
| |  | Hallo, wenn ich die Suche 3x Hintereinander einzeln eingebe, funktioniert es.
Aber in einer While-Schleife kommt die Fehlermeldung : Scol$ nicht declariert.
KompilierenMarkierenSeparieren $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 -1
endproc
|
| | | | | | |
| | | Jupp, mein Code hat den Fehler innerhalb einer While-Schleife ein Return abzusetzen.
Muss ich umschreiben... |
| | | | | | |
| | 
Christian
Schneider | Aktualisiert: läuft jetzt auch in Schleifen:
KompilierenMarkierenSeparieren $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
|
| | | | | | |
| | | 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 läuft jetzt auch in Schleifen. Die 1. Fundstelle kannst du einfach per
KompilierenMarkierenSeparieren auslesen. |
| | | | | | |
| |
Christian
Schneider | | Hat jemand eine Idee wie man am Besten Toleranzen bei den Farbwerten performant einbauen könnte (z.B. +/- 5 bei R G B). Die Möglichen Farben generieren und einzeln abarbeiten dauert wohl viel zu lange. |
| | | | | | |
| | | | Ein Pass über 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. |
| | | | | | |
|
Zum QuelltextThemenoptionen | 7.637 Betrachtungen |
ThemeninformationenDieses Thema hat 4 Teilnehmer: |
(1.112)
Deutsch
English
Français
Español
Italia