Показать сообщение отдельно
  #5  
Старый 29.06.2007, 20:46
Burka Burka вне форума
Начинающий
 
Регистрация: 10.06.2007
Сообщения: 163
Репутация: 10
Подмигивание Каряво, но работает))

Вот что я смог сделать на скорую руку. Думаю главное идея))
Проблема тока в запоминании той позиции с которой начинаем смазывать и местом где смазывание завершается(то есть там где мышка отпускается)
В этом коде смазывается когда мышка двигается, а клик это место запоминания цветов.
Код:
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;
Ответить с цитированием