Shapeのサイズ変更
解決設計時には、Shape(に限らずですが)のサイズをマウスで変更する事が出来ます。
これと全く同じように、実行時にサイズ変更するにはどうすればいいでしょうか？
FAQとは思うのですが、なかなか探せなく・・・宜しくお願いします。
設計時とコンパイル後は全く別ですので
残念ながら簡単にはできません。
自分で１からコードする必要があります。
type
TDownLocation = (dlLeft,dlTop,dlRight,dlBottom);
TDownLocations = set of TDownLocation;
const
SIZE = 10;
var
FMouseDown: Boolean;
FMouseX,FMouseY,FMouseZ: Integer;
DownLocations : TDownLocations;
implementation
{$R *.dfm}
procedure TForm2.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (X < SIZE) or (Y < SIZE) or (X > Shape1.Width - SIZE - 1 ) or (Y > Shape1.Height - SIZE - 1 ) then
begin
FMouseDown := True;
FMouseX := X;
FMouseY := Y;
DownLocations := [];
if (X < SIZE) then DownLocations := DownLocations + [dlLeft];
if (Y < SIZE) then DownLocations := DownLocations + [dlTop];
if (X > Shape1.Width - SIZE -1) then DownLocations := DownLocations + [dlRight];
if (Y > Shape1.Height - SIZE -1) then DownLocations := DownLocations + [dlBottom];
end;
end;
procedure TForm2.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (X < SIZE) then
begin
if (Y < SIZE) then
begin
Shape1.Cursor := crSizeNWSE;
end
else
if (Y > Shape1.Height - SIZE -1) then
begin
Shape1.Cursor := crSizeNESW;
end
else
begin
Shape1.Cursor := crSizeWE;
end;
end
else
if (X > Shape1.Width - SIZE -1) then
begin
if (Y < SIZE) then
begin
Shape1.Cursor := crSizeNESW;
end
else
if (Y > Shape1.Height - SIZE -1) then
begin
Shape1.Cursor := crSizeNWSE;
end
else
begin
Shape1.Cursor := crSizeWE;
end;
end
else
if (Y < SIZE) then
begin
Shape1.Cursor := crSizeNS;
end
else
if (Y > Shape1.Height - SIZE -1) then
begin
Shape1.Cursor := crSizeNS;
end
else
begin
Shape1.Cursor := crDefault;
end;
if FMouseDown = True then
begin
//左(増)
if ( X < SIZE) and (X < FMouseX) and (dlLeft in DownLocations) then
begin
Shape1.Left := Shape1.Left - (FMouseX - X);
Shape1.Width := Shape1.Width + (FMouseX - X);
end;
//左(減)
if (X > SIZE) and (X > FMouseX) and (dlLeft in DownLocations) then
begin
Shape1.Left := Shape1.Left + (X - FMouseX);
Shape1.Width := Shape1.Width - (X - FMouseX);
end;
//上(増)
if (Y < SIZE) and (Y < FMouseY) and (dlTop in DownLocations) then
begin
Shape1.Top := Shape1.Top - (FMouseY - Y);
Shape1.Height := Shape1.Height + (FMouseY - Y);
end;
//上(減)
if (Y > SIZE) and (Y > FMouseY) and (dlTop in DownLocations) then
begin
Shape1.Top := Shape1.Top + (Y - FMouseY);
Shape1.Height := Shape1.Height - (Y - FMouseY);
end;
//右(減)
if ( X < Shape1.Width -SIZE -1) and (X < FMouseX) and (dlRight in DownLocations) then
begin
Shape1.Width := Shape1.Width - (FMouseX - X);
FMouseX := X;
end;
//右(増)
if (X > Shape1.Width - SIZE -1) and (X > FMouseX) and (dlRight in DownLocations) then
begin
Shape1.Width := Shape1.Width + (X - FMouseX);
FMouseX := X;
end;
//下(減)
if ( Y < Shape1.Height -SIZE -1) and (Y < FMouseY) and (dlBottom in DownLocations) then
begin
Shape1.Height := Shape1.Height - (FMouseY - Y);
FMouseY := Y;
end;
//下(増)
if (Y > Shape1.Height - SIZE -1) and (Y > FMouseY) and (dlBottom in DownLocations) then
begin
Shape1.Height := Shape1.Height + (Y - FMouseY);
FMouseY := Y;
end;
end;
end;
procedure TForm2.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FMouseDown := False;
end;
反転させたら反応しなくなる
Mr.XRAYさんのホームページに
コントロール移動リサイズコンポーネント
http://mrxray.on.coocan.jp/Delphi/plDragResize/index.htm
monaa さん、KHE00221 さん、TS さん、ありがとうございました。
KHE00221 さんの方法で一応サイズ変更が出来ました！！
ただ「反転させたら反応しなくなる」とのことで、
反転しないようにコードをいじってみようと思います。
Mr.XRAYさんのところにコンポがあったんですね・・・
これも十分使用できそうです。ありがとうございました。
| ツイート |  |