13.02.2021, 09:20
|
Новичок
|
|
Регистрация: 22.04.2012
Сообщения: 99
Репутация: 10
|
|
Image size
Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Shape1: TShape;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
x0,y0:integer;
move:boolean;
k:integer;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Shape1.Shape:=stCircle;
Shape1.Pen.Color:=clred;
Shape1.Brush.Color:=clred;
Shape1.Height:=5;
Shape1.Width:=5;
Shape1.Top:=Image1.Top +Image1.Height;
Shape1.Left:=Image1.Left+Image1.Width;
Shape1.Visible:=False;
end;
procedure TForm1.Image1DblClick(Sender: TObject);
begin
k:=k+1;
if k = 1 then
begin
Shape1.Visible:=True;
end
else
begin
Shape1.Visible:=False;k:=0;
end;
end;
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
Shape1.Visible:=False;
image1.Left:=image1.Left+x-x0; // Изменяем позицию левого края
image1.Top:=image1.Top+y-y0; // Изменяем позицию верхнего края
Shape1.Top:=Image1.Top +Image1.Height+y-y0+1;
Shape1.Left:=Image1.Left+Image1.Width+x-x0+1;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=false;
end;
procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button<>mbLeft then move:=false
else
begin
move:=true;
end;
end;
procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Shape1.Cursor:=crSizeNWSE;
if move then
begin
image1.Height:=image1.Height + 1;
image1.Width:=image1.Width + 1 ;
Shape1.Top:=Image1.Top + Image1.Height;
Shape1.Left:=Image1.Left + Image1.Width ;
end;
end;
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=false;
end;
end.
Помогите реализовать уменьшение картинки! т.е. если я тяну картинку за правый нижний угол в право в низ она увеличивается, а вот с уменьшением не знаю как.
|