Форум: "Основная";
Текущий архив: 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