Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2006.08.13;
Скачать: [xml.tar.bz2];

Вниз

Выделение части картинки   Найти похожие ветки 

 
xsid   (2006-07-01 03:15) [0]

Здравствуйте!
Посоветуйте, плиз, компонент или пример кода для выделения части картинки, чтоб можно было менять размер выделения, ухватившись за угол рамки. Типа как рисуется обрамление вокруг компонентов в Делфи. За угос схватил иышкой и изменяешь размер компонента. Но надо что бы выделялась часть, ну например в TImage.

Заранее благодарю за ответы.


 
Loginov Dmitry ©   (2006-07-01 08:29) [1]

А в чем проблема?

Canvas.Pen.Style := psXor;
Canvas.Rectangle()

И вперед!


 
PSPF2003 ©   (2006-07-01 08:33) [2]

Фленов D2005


 
xsid   (2006-07-02 04:02) [3]

>А в чем проблема?

> Canvas.Pen.Style := psXor;
> Canvas.Rectangle()

>И вперед!

А как квадратики в углах, за которые растягивается квадрат выделения, рисовать? А по какому событию определять, что курсо надо поменять на другой (который указывает, что можно изменять размеры, стрелочка)?

хотелось бы пример кода или компонент, а так ... я и сам догадался, что можно
Canvas.Pen.Style := psXor;
Canvas.Rectangle()


 
Мефисто   (2006-07-02 18:33) [4]


> хотелось бы пример кода или компонент, а так ... я и сам
> догадался, что можно Canvas.Pen.Style := psXor; Canvas.Rectangle()


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

Компонекнт: TStretchHandle (units Handles.pas) - ищится в гугле (только он для работы с TControl). Но глянув в сиходники нужное можно будет позаимствовать.

Пример (недоделан):

var
 SFocusX, SFocusY, EFocusX, EFocusY: Integer;
 RLT, RRT, RLB, RRB: TRect;
 StartZoom: Boolean;

procedure InitRectMarkers;
begin
 RLT.TopLeft.X := SFocusX - 2;
 RLT.TopLeft.Y := SFocusY - 2;
 RLT.BottomRight.X := SFocusX + 2;
 RLT.BottomRight.Y := SFocusY + 2;

 RRT.TopLeft.X := EFocusX - 2;
 RRT.TopLeft.Y := SFocusY - 2;
 RRT.BottomRight.X := EFocusX + 2;
 RRT.BottomRight.Y := SFocusY + 2;
end;

procedure DrawMarkers(ACanvas: TCanvas);
 var
   C: TColor;
begin
 C := ACanvas.Brush.Color;
 with ACanvas do
 Begin
   Brush.Color := clLime;
   FillRect(RLT);
   FillRect(RRT);
   Brush.Color := C;
 end;
end;

procedure StartRegionZoom(X, Y: Integer);
Begin
 StartZoom := True;
 SFocusX := X; SFocusY := Y;
 EFocusX := 0; EFocusY := 0;
End;

procedure ResizeRegionZoom(ACanvas: TCanvas; X, Y: Integer);
Begin
 with ACanvas do
 Begin
   Pen.Mode := pmXor;
   DrawFocusRect(Rect(SFocusX, SFocusY, EFocusX, EFocusY));
   Pen.Mode := pmXor;
   DrawFocusRect(Rect(SFocusX, SFocusY, X, Y));
   EFocusX := X; EFocusY := Y;
 End;
End;

procedure EndRegionZoom(ACanvas: TCanvas; X, Y: Integer);
Begin
 ACanvas.Pen.Mode := pmCopy;
 ACanvas.Refresh;
 StartZoom := False;
End;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 StartRegionZoom(X, Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if StartZoom then ResizeRegionZoom(Canvas, X, Y);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 EndRegionZoom(Canvas, X, Y);
 InitRectMarkers;
 DrawMarkers(Canvas);
end;



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

Форум: "Основная";
Текущий архив: 2006.08.13;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.044 c
15-1152683047
Den_is
2006-07-12 09:44
2006.08.13
Обман. Как бороться?


2-1153720810
DimonS
2006-07-24 10:00
2006.08.13
Вложенные запросы. Нужен совет.


8-1140421786
DVM
2006-02-20 10:49
2006.08.13
Wavelet - сжатие изображений.


15-1153344084
Footballer
2006-07-20 01:21
2006.08.13
Не найду картинку...


15-1153226037
AlexanderMS
2006-07-18 16:33
2006.08.13
Программа для побайтового сравнения файлов.





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский