var
preA : array[1..50,1..50] of TColor; //Массив цветов откуда начинается смазывание
const s=20; //Размер кисти
//Процедура преобразования из TColor в R G B
procedure GetRGB(C:TColor; Var R, G, B :byte);
begin
r := C;
g := C shr 8;
b := C shr 16;
end;
//Процедура смазывания цвета
//Тут сила смазывания зависит от значения при DIV'e
//здесь число 10 (preCol div 10) это по идее чем больше число тем сильнее смазывание
Function DevColor(Var Col, preCol:byte):byte;
begin
if Col>preCol then
begin
if (Col - preCol div 10)<0 then
Result:=0 else Result:=Col - preCol div 10;
end
else
if (Col + preCol div 10)>255 then Result:=255
else Result:=Col + preCol div 10;
end;
//Сама процедура смазывания
//Size - сторона квадрата, X, Y - Координаты верхнего левого угла
procedure Palec(IM:TImage; X,Y, Size :integer);
Var i, j:integer;
C, preC:Tcolor;
R,G,B, preR, preG, preB: byte;
begin
For I:=1 to S do
For j:=1 to S do
Begin
GetRGB(IM.Canvas.Pixels[x+i,y+j], R,G,B);
GetRGB(preA[i,j], preR, preG, preB);
IM.Canvas.Pixels[X+i,Y+j]:=RGB(DevColor(r, prer), DevColor(g, preg), DevColor(g, preg));
End;
IM.Canvas.TextOut(0,0, IntTOStr(X) + ' ' + IntTOstr(Y));
end;
//Рисуем кружок
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Canvas.Brush.Color:=clred;
Image1.Canvas.Ellipse(200,200,400,400);
end;
//Процедура запоминания цветов
//Лучше наверно запоминать одну точку и уже от нее вычислять а не использовать массив. Пока оставим как есть.
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var i,j:integer;
begin
for i:=1 to s do
for j:=1 to s do
preA[i,j]:=Image1.Canvas.Pixels[x+i,y+j];
end;
//Смазывается когда мышка двигается, тут нужно условие сделать чтоб она переставала рисовать ))
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Palec(IMage1, X, Y);
end;