Calibrar Cores

[Mike Deet]

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

[MAXIUM]

Creo que desplazando bytes...

[Mike Deet]

como assim??

[MAXIUM]

Puedes adaptar este código en C para Pascal: http://www.codepedia.com/1/CppVclGraphics