[Arriello]

Завал с курсовой по информатике.. нужно сделать простенький графический редактор, с инструментом пальца (как в фотошопе, т.е. он тащит за собой и смазывает ту часть изображения по которой проходит).. хоть убей, не знаю даже примерно как его делать искал, искал.. нигде нет ни уроков, ни примеров.. даже похожего ничего нет! Если кто подскажет хотя бы с чего начать - уже буду премного благодарен!

[Wipahacker]

Спроси у Модераторов они наверняка знают!

[Winny]

Раз такое задали тебе сделать по информатике - значит выход есть, если бы это было-бы нереализуемо, то тебе бы не задавали этого. Дерзай, пробуй. Сам не знаю как это сделать.

[Burka]

Прикольное задание. Там больше математики, тебе нужно усреднять цвет который был и по которому проходишь сейчас. Щас посижу может что получится)

[Burka]

Вот что я смог сделать на скорую руку. Думаю главное идея))
Проблема тока в запоминании той позиции с которой начинаем смазывать и местом где смазывание завершается(то есть там где мышка отпускается)
В этом коде смазывается когда мышка двигается, а клик это место запоминания цветов.

Код:

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;

[Burka]

Вот работающий "палец"))