Calibrar Cores
Hola
eu tenho o seguinte codigo para fazer a calibraçao de cores de um bmp procedure TForm1.Imagebitmap2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var QQ,li,lj:integer; begin QQ:=(strtoint(EditQQ.Text))div 2; if ((y>QQ)and(x>QQ)and (y<(imgheight-QQ))and(x>QQ)and (x<(imgwidth-QQ))and(y>QQ) and (y<(imgheight-QQ)) and (x<(imgwidth-QQ))) then begin imageZoomDinam.canvas.copyrect(rect(0,0,200,200),bitmap2.Canvas,rect(x-QQ,y-QQ,x+QQ,y+QQ)); //bitmap2.CleanupInstance; Imagebitmap2.Canvas.FrameRect(rect((x-QQ),(y-QQ),(x+QQ),(y+QQ))); Imagebitmap2.CleanupInstance; imageZoomDinam.CleanupInstance; for li:=(x-QQ) to (x+QQ)do for lj:=(y-QQ) to (y+QQ)do begin if ssleft in Shift then begin CuboRGB[imagem[imgheight-lj,li].B,imagem[imgheight-lj,li].G,imagem[imgheight-lj,li].R].B:=Form2.azul; CuboRGB[imagem[imgheight-lj,li].B,imagem[imgheight-lj,li].G,imagem[imgheight-lj,li].R].G:=Form2.verde; CuboRGB[imagem[imgheight-lj,li].B,imagem[imgheight-lj,li].G,imagem[imgheight-lj,li].R].R:=Form2.vermelho; end; end; end; end; procedure tform1.calibrar(); var KA,KB:integer; begin for KA:=0 to (imgheight-1) do for KB:=0 to (imgwidth-1) do begin if (((CuboRGB[imagem[KA,KB].B,imagem[KA,KB].G,imagem[KA,KB].R].B<>0) or (CuboRGB[imagem[KA,KB].B,imagem[KA,KB].G,imagem[KA,KB].R].G<>0)) or (CuboRGB[imagem[KA,KB].B,imagem[KA,KB].G,imagem[KA,KB].R].R<>0)) then begin IMGblack[KA,KB].B:=CuboRGB[imagem[KA,KB].B,imagem[KA,KB].G,imagem[KA,KB].R].B; IMGblack[KA,KB].G:=CuboRGB[imagem[KA,KB].B,imagem[KA,KB].G,imagem[KA,KB].R].G; IMGblack[KA,KB].R:=CuboRGB[imagem[KA,KB].B,imagem[KA,KB].G,imagem[KA,KB].R].R; end; end; end; a minha pergunta é se ha outra maneira mais rapida. saludos |
Creo que desplazando bytes...
|
como assim??
|
Puedes adaptar este código en C para Pascal: http://www.codepedia.com/1/CppVclGraphics
|
La franja horaria es GMT +2. Ahora son las 18:30:18. |
Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi