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

Вниз

Как сделать кроп картинки как в Фотошопе?   Найти похожие ветки 

 
igorium ©   (2011-10-14 12:26) [0]

Всем привет.
Есть Image.
На неё кидаю картинку Jpeg.

Задача - нарисовать поверх картинки прямоугольник с определенным соотношением сторон (3х4), который можно увеличивать, уменьшать и двигать (все действия только внутри Image).
После нажатия на кнопку скопировать картинку, которая оказалось внутри прямоугольника в другой Image.

Собственно непонятно из чего делать прямоугольник, чтобы он соответствовал моим требованиям ???


 
Ega23 ©   (2011-10-14 12:37) [1]

Код старый, ему уже лет 10

procedure TFPreviewPhoto.imgPhotoMouseMove(Sender: TObject;
 Shift: TShiftState; X, Y: Integer);
var
Top, Bottom, Left, Right : Integer;
begin

if IsFrame then if MouseInFrame(X,Y) then
   pbMain.Cursor:=crSizeAll else pbMain.Cursor:=crDefault;

if not IsFrameDrawing then Exit;

// Отрисовать Frame по старым координатам
DrawFrame;

Top:=CutFrame.Top+(Y-DragPoint.y);
Bottom:=CutFrame.Bottom+(Y-DragPoint.y);

if (Top>0) and (Bottom<pbMain.Height) then
 begin
  CutFrame.Top:=Top;
  CutFrame.Bottom:=Bottom;
 end;

Left:=CutFrame.Left+(X-DragPoint.x);
Right:=CutFrame.Right+(X-DragPoint.x);

if (Left>0) and (Right<pbMain.Width) then
 begin
  CutFrame.Left:=Left;
  CutFrame.Right:=Right;
 end;

DragPoint.x:=X;
DragPoint.y:=Y;

DrawFrame;
end;

function TFPreviewPhoto.MouseInFrame(const X, Y: Integer): Boolean;
var
Xreal, Yreal : Double;
begin

if (X>=CutFrame.Left) and (X<=CutFrame.Right) and
   (Y>=CutFrame.Top) and (Y<=CutFrame.Bottom) then
 Result:=True
else Result:=False;
end;

//******************************************************************************** *****

procedure TFPreviewPhoto.DrawFrame;
var
OldPenMode:TPenMode;
OldPenStyle:TPenStyle;
begin

With pbMain.Canvas do
 begin
  OldPenMode:=Pen.Mode;
  OldPenStyle:=Pen.Style;

  Pen.Style:=psDot;
  Pen.Mode:=pmXOR;

  MoveTo(CutFrame.Left,CutFrame.Top);
  LineTo(CutFrame.Right,CutFrame.Top);
  LineTo(CutFrame.Right,CutFrame.Bottom);
  LineTo(CutFrame.Left,CutFrame.Bottom);
  LineTo(CutFrame.Left,CutFrame.Top);

  Pen.Style:=OldPenStyle;
  Pen.Mode:=OldPenMode;
 end;

FrameFl:=not FrameFl;
end;

//******************************************************************************** *****

procedure TFPreviewPhoto.InitFrame;
var
Width, Height : Integer;
begin
// ширина и высота в относительных координатах (на PaintBox"e)
Width:=Trunc(CutFrameWidth*pbMain.Width/MainBitmap.Width);
Height:=Trunc(CutFrameHeight*pbMain.Height/MainBitmap.Height);

CutFrame.Left:=(pbMain.Width div 2) - (Width div 2);
CutFrame.Right:=(pbMain.Width div 2) + (Width div 2);
CutFrame.Top:=(pbMain.Height div 2) - (Height div 2);
CutFrame.Bottom:=(pbMain.Height div 2) + (Height div 2);

end;

//******************************************************************************** *****



Суть такова: в Image попадала фотография с цифровика. Потом отрисовывалась рамка определённого размера. Но MouseMove можно было её подвигать. В конце из фотографии вырезался тот кусок, который в рамке.


 
Inovet ©   (2011-10-14 13:47) [2]

Ещё есть стандартная рамка, которая на раьочем столе и проводнике:
DrawFocusRect
http://msdn.microsoft.com/en-us/library/dd162479%28VS.85%29.aspx


 
igorium ©   (2011-10-15 11:48) [3]

Спасибо буду разбираться.



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

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

Наверх





Память: 0.46 MB
Время: 0.003 c
15-1318451402
Юрий
2011-10-13 00:30
2012.01.29
С днем рождения ! 13 октября 2011 четверг


2-1319009272
Cobalt
2011-10-19 11:27
2012.01.29
[Pascal Error] E2250 There is no overloaded version of <function>


2-1318595246
Handle
2011-10-14 16:27
2012.01.29
список процедур


15-1318345230
Awesome-o 4000
2011-10-11 19:00
2012.01.29
Прошу дать совет


15-1317960201
Smile
2011-10-07 08:03
2012.01.29
Anatoly Podgoretsky - с Юбилеем!





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