Растягивание имиджа!

[Marsik]

Здравствуйте!У меня есть image1,и мне нужно чтобы он спокойно растягивался и сужался при помощи курсора(как окна windows).Помогите пожалуйста!

[mutabor]

Это называется масштабирование.
У имиджа есть свойства и методы к-рые позволяют это делать. Для начала нужно ознакомится с ними, разобраться какое и для чего, и попробовать сначала (временно) масштабировать по нажатию кнопки или клавиши, как тебе удобнее, чтобы убедиться что все работает. Общий принцип такой - изменяешь размеры имиджа, при этом свойство Stretched должно быть True.

А затем можно начинать пробовать привязывать это все к событиям мыши.
Как это сделать, я расскажу.

[Marsik]

Кнопками то получается!Но мне ведь надо чтобы с помощью мыши.Расскажи пожалуйста

[Stilet]

Как вариант (уже такое предлагал) запихни рисунок в окно, а окно сделай дочерним по отношению другого окна, избавься от капшина, поставь рисунку Stretch и Align на Client и растягивай скок хош.
Эффект будет такой как будто ты тянеш именно картинку. (меня это однажды выручило)

[mutabor]

Кнопками то получается!Но мне ведь надо чтобы с помощью мыши.Расскажи пожалуйста

Рассказываю
Добавляем глобальные переменные:
RightEdge, BottomEdge, HStretch, VStretch: boolean;
Затем добавляем в процедуру FormMouseMove этот код:

//это после обработки MouseOnCard
if (x >= cx+imw) and (x < cx+imw+3) and (y > cy) and (y < cy+imh) then
  begin
  if not RightEdge then
    begin
    RightEdge:=true;
    Cursor:=crHSplit;
    end;
  end
else
if RightEdge then
  begin
  RightEdge:=false;
  Cursor:=crDefault;
  if MouseOnCard then Cursor:=crHandPoint;
  end;

if (x > cx) and (x < cx+imw) and (y >= cy+imh) and (y < cy+imh+3) then
  begin
  if not BottomEdge then
    begin
    BottomEdge:=true;
    Cursor:=crVSplit;
    end;
  end
else
if BottomEdge then
  begin
  BottomEdge:=false;
  Cursor:=crDefault;
  if MouseOnCard then Cursor:=crHandPoint;
  end;

//это после обработки catch
if HStretch then
  begin
  imw:=x-cx;
  Image1.Width:=imw;
  end;

if VStretch then
  begin
  imh:=y-cy;
  Image1.Height:=imh;
  end;
end;

Далее в процедуру FormMouseDown добавляем:

if RightEdge then HStretch:=True;
if BottomEdge then VStretch:=True;

И в процедуру FormMouseUp

if HStretch then HStretch:=false;
if VStretch then VStretch:=false;

[Marsik]

Мутабор,кажется все как ты писал сделал,но мало того что рисунок не сжимался,так он и перемащатся перестал!!!Наверно я где нить ошибся,Пожалуйста просмотри код,может я что-то неверно сделал

PHP код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  cx,cy,fx,fy: integer;
MouseOnCard, catch: boolean;
imw,imh: integer;//øèðèíà è âûñîòà èìèäæà
RightEdge, BottomEdge, HStretch, VStretch: boolean;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
imw:=image1.width;
imh:=image1.height;
cx:=image1.left;
cy:=image1.top;
DoubleBuffered:=true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if (x > cx) and (x < cx+imw) and (y > cy) and (y < cy+imh) then
begin
if not MouseOnCard then
begin
MouseOnCard:=true;
Cursor:=crHandPoint;
end;
end
else
if MouseOnCard then
begin
MouseOnCard:=false;
Cursor:=crDefault;
end;
if (x >= cx+imw) and (x < cx+imw+3) and (y > cy) and (y < cy+imh) then
  begin
  if not RightEdge then
    begin
    RightEdge:=true;
    Cursor:=crHSplit;
    end;
  end
else
if RightEdge then
  begin
  RightEdge:=false;
  Cursor:=crDefault;
  if MouseOnCard then Cursor:=crHandPoint;
  end;

if (x > cx) and (x < cx+imw) and (y >= cy+imh) and (y < cy+imh+3) then
  begin
  if not BottomEdge then
    begin
    BottomEdge:=true;
    Cursor:=crVSplit;
    end;
  end
else
if BottomEdge then
  begin
  BottomEdge:=false;
  Cursor:=crDefault;
  if MouseOnCard then Cursor:=crHandPoint;

if catch then
begin
cx:=x-fx;
cy:=y-fy;
Image1.Left:=cx;
Image1.Top:=cy;
end;
if HStretch then
  begin
  imw:=x-cx;
  Image1.Width:=imw;
  end;

if VStretch then
  begin
  imh:=y-cy;
  Image1.Height:=imh;
  end;

end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if MouseOnCard then
begin
catch:=true;
fx:=x-cx;
fy:=y-cy;
if RightEdge then HStretch:=True;
if BottomEdge then VStretch:=True;
end;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if catch then catch:=false;
if HStretch then HStretch:=false;
if VStretch then VStretch:=false;
end;

end. 


[Marsik]

Стилет а что такое капшина?и как его убрать?

[mutabor]

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (x > cx) and (x < cx+imw) and (y > cy) and (y < cy+imh) then
  begin
  if not MouseOnCard then
    begin
    MouseOnCard:=true;
    Cursor:=crHandPoint;
    end;
  end
else
  if MouseOnCard then
    begin
    MouseOnCard:=false;
    Cursor:=crDefault;
    end;

if (x >= cx+imw) and (x < cx+imw+3) and (y > cy) and (y < cy+imh) then
  begin
  if not RightEdge then
    begin
    RightEdge:=true;
    Cursor:=crHSplit;
    end;
  end
else
if RightEdge then
  begin
  RightEdge:=false;
  Cursor:=crDefault;
  if MouseOnCard then Cursor:=crHandPoint;
  end;

if (x > cx) and (x < cx+imw) and (y >= cy+imh) and (y < cy+imh+3) then
  begin
  if not BottomEdge then
    begin
    BottomEdge:=true;
    Cursor:=crVSplit;
    end;
  end
else
if BottomEdge then
  begin
  BottomEdge:=false;
  Cursor:=crDefault;
  if MouseOnCard then Cursor:=crHandPoint;
  end;

if catch then
  begin
  cx:=x-fx;
  cy:=y-fy;
  Image1.Left:=cx;
  Image1.Top:=cy;
  end;

if HStretch then
  begin
  imw:=x-cx;
  Image1.Width:=imw;
  end;

if VStretch then
  begin
  imh:=y-cy;
  Image1.Height:=imh;
  end;

//end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if MouseOnCard then
  begin
  catch:=true;
  fx:=x-cx;
  fy:=y-cy;
  end;
if RightEdge then HStretch:=True;
if BottomEdge then VStretch:=True;
//end;
end;

p.s.
Красным цветом я выделил то что я изменил, тебе менять ничего не надо, просто скопируй.
Свойство Stretch этого имиджа должно быть True.
кэпшин = caption = заголовок

[Marsik]

Мутабор спасибо,спасибо получилось
А вот можно чтобы со всех сторон можно было растягивать?
Кстати я еще по одному методу научился имидж перемещать,вот он:

PHP код:

var
  Form1: TForm1;
  x0: integer;
  y0: integer;
  move: boolean;
implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button <> mbleft
then
move:=false
else begin
move:=true;
x0:=x;
y0:=y
end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if move then begin
image1.SetBounds(image1.Left+x-x0,image1.Top+y-y0,image1.Width,image1.Height);
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
move:=false;
end;

end. 


[Stilet]

Вот ребята еще один прием:

Итак имеем на форме Image в который пихнули рисунок.
После запуска рисунок получает возможность растягиваться и таскаться по форме удобным и привычным способом.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var   f:TForm;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i:cardinal;
begin
  f:=TForm.Create(form1);
  f.Parent:=Form1;
  f.Show;
  i:=GetWindowLong(f.Handle,GWL_STYLE);
  i:=i and not WS_CAPTION;
  if SetWindowLong(f.Handle,GWL_STYLE,i)=0 then RaiseLastWin32Error;
  Image1.Parent:=f;
  Image1.Align:=alClient;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  Sc_dragmove = $F012;
begin
  ReleaseCapture;
  f.Perform(WM_SYSCOMMAND, Sc_dragmove, 0);
end;

end.

Пробуй, если что спрашивай.