Форум: "Media";
Текущий архив: 2005.09.11;
Скачать: [xml.tar.bz2];

Вниз

Лассо на изображение   Найти похожие ветки 

← →
seregka   (2005-04-18 16:16) [0]

Скажите, есть ли вариант создать лассо (на подобии Фотошоповского)?

---

← →
Grief ©   (2005-04-20 18:31) [1]

подробнее!

---

← →
Katy   (2005-04-20 18:50) [2]

Может поможет:
Выделение области прямоугольничком при движении мышкой по кантинке (Image1).


procedure TPhotoFrm.ImMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Button = mbLeft then
   if not StartSelect then
   begin
     StartSelect := true;
     BegPoints[0] := X;
     BegPoints[1] := Y;
   end;
end;

procedure TPhotoFrm.ImMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var
 tmp: integer;
begin
 if StartSelect then
 begin
   EndPoints[0] := X;
   EndPoints[1] := Y;
 end;
 DrawFrame
end;

procedure TPhotoFrm.ImMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 tmp: integer;
begin
if Button = mbLeft then
 if StartSelect then
 begin
   EndPoints[0] := X;
   EndPoints[1] := Y;
   StartSelect := false
 end
end;

procedure TPhotoFrm.DrawFrame;
var
 ARect: TRect;
 BM: TBitmap;
 i: integer;
begin
 BM := TBitmap.Create;
 try
   BM.Assign(Image1.Picture.Bitmap)
   if Assigned(BM) then
   begin
     BM.Canvas.Brush.Color := clBlue;
     for i := 0 to 2 do
     begin
       if BegPoints[0]>EndPoints[0] then
       begin
         ARect.Left := EndPoints[0]+i;
         ARect.Right := BegPoints[0]+i
       end
       else
       begin
         ARect.Left := BegPoints[0]+i;
         ARect.Right := EndPoints[0]+i
       end;
       if BegPoints[1]>EndPoints[1] then
       begin
         ARect.Top := EndPoints[1]+i;
         ARect.Bottom := BegPoints[1]+i
       end
       else
       begin
         ARect.Top := BegPoints[1]+i;
         ARect.Bottom := EndPoints[1]+i
       end;
       BM.Canvas.DrawFocusRect(ARect)
     end; {for}
     Im.Picture.Assign(BM);
 finally  
   BM.Free
 end;
end;

---

← →
seregka   (2005-04-20 19:09) [3]

спасибо, но прямоугольником я умею. А надо произвольную ломаную с началом и концом в одной точке.

---

← →
Gero ©   (2005-04-20 19:21) [4]

Pen.Mode := pmXor и рисуй.

---

← →
Магнитоныч   (2005-04-20 22:51) [5]

> seregka  (20.04.05 19:09) [3]
> А надо произвольную ломаную с началом и концом в одной точке.

Polygon, PolyLine

---

← →
Магнитоныч   (2005-04-20 23:01) [6]

http://www.undu.com/DN961001/00000016.htm

---

← →
Grief ©   (2005-04-21 12:37) [7]

берешь черный битмап на нем ресуешь любую фигню белым цветом и складывешь картинки - получается - и будет выделенная область!

---

← →
Katy ©   (2005-04-25 14:34) [8]

Аналогично рисованию прямоугольника:
на события ImageMouseDown и ImageMouseMove с помощью Canvas.MoveTo и Canvas.LineTo

---

← →
Delta ©   (2005-04-30 14:05) [9]

Можно реализовать так:
1) при  нажатии  и движении мыши по рисунку рисуешь линию (это будет рамочка типо рисунка). И сохраняешь каждые координаты Point(x,y)  в динамическом массиве.
2) При отпускании мышки творишь следующее: Вычисляешь мин(x,y) и макс(x,y) у динам массива.
От макс отнимаешь мин, получаешь ширину и высоту будиющей вырезанной картинки.
Создаешь битмапку, на ней рисуешь закрашенный черным полигон на белом фоне при помощи того массива который ты забил при рисовании линии.
Далее ScanLine проверяещь если точка на созданном битмапе черная то на заранее созданном той же точке даещь тотже цвет, если точка белая то на заранее созданном цвет точки делаешь Transparent.
дальше можно догнать самому, если я понятно описал :).
ну это общее описание, если че могу выслать работающий код.

---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2005.09.11;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.014 c