![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
|
Всем здрасти. Помогите пожалуйста. Есть изображение, надо выделить произвольную область. Потом эту область вырезать(копировать)бвставить,или сохранить в файл.Помогите плиз советом(как все это реализовать в программе) или ссылочкой на статьи или исходники. Буду счастлив и очень благодарен, если поможете исходниками уже готовой проги. Заранее, спасибо оогромное.
|
|
#2
|
||||
|
||||
|
Этот код позволяет выделить мышкой прямоугольную область и сохраняет координаты выделения в SRect
Код:
var
AncX, AncY, CurX, CurY: Integer;
Select: Boolean = False;
SRect:TRect;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not Select then
begin
AncX := X;
CurX := X;
AncY := Y;
CurY := Y;
SRect.Left:=X;
SRect.Top:=Y;
Select := True;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Select then
begin
Image1.Canvas.Pen.Mode := pmNotXor;
Image1.Canvas.Pen.Style:= psDot;
Image1.Canvas.Pen.Width := 1;
Image1.Canvas.Brush.Style := bsClear;
Image1.Canvas.Rectangle(AncX, AncY, CurX, CurY);
CurX := X;
CurY := Y;
Image1.Canvas.Rectangle(AncX, AncY, CurX, CurY);
Image1.Canvas.Pen.Style:= psSolid;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Select then
if (AncX <> CurX) and (AncY <> CurY) then
begin
Select := False;
Image1.Canvas.Pen.Mode := pmXor;
Image1.Canvas.Brush.Style := bsClear;
Image1.Canvas.Rectangle(AncX, AncY, CurX, CurY);
SRect.Right:=X;
SRect.Bottom:=Y;
Close;
end;
end;Код не полный. Я его немного урезал чтоб не загромождать. |