Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "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.012 c
14-1123825588
PVOzerski
2005-08-12 09:46
2005.09.11
Как интерпретировать некоторые моменты вот такой лицензии?


3-1122994392
Oleg_S
2005-08-02 18:53
2005.09.11
TQuery


2-1123531110
Nox7777
2005-08-08 23:58
2005.09.11
Как убрать мелькания при прорисовке изображений


1-1124246971
Киря
2005-08-17 06:49
2005.09.11
Как ускорить работу программы


14-1124074481
Alexander Panov
2005-08-15 06:54
2005.09.11
Просьба потестировать.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский