ich habe folgenden Ansatz dazu:
Code: Alles auswählen
procedure TGUIControl.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var R: TRect;
begin
if MouseL then
begin
if ContainsMouse(X,Y) then
begin
FMouseMoved := true;
FDeltaX := X - FStartX;
FDeltaY := Y - FStartY;
OutTextXY(MouseX,MouseY+20,'DELTAX = '+IntToStr(FDeltaX)+' DELTAY = '+IntToStr(FDeltaY));
If FCanResizeControl then
begin
R := Canvas.ClipRect;
FRight := FRight - FStartX + X;
FBottom := FBottom - FStartY + Y;
R.Right := FRight;
R.Bottom := FBottom;
Canvas.ClipRect := R;
FWidth := FRight - FLeft;
FHeight := FBottom - FTop;
end
else
if FCanMoveControl then
begin
FLeft := FLeft - FStartX + X;
FTop := FTop - FStartY + Y;
end;
end;
end;
end;
procedure TGUIControl.MouseDown(Sender: TObject; Button: TMouseButtons; Shift: TShiftState; X,Y: Integer);
begin
if (Button = MouseBtnLeft) {and ContainsMouse(X,Y)} then
begin
ButtonDown := true;
ButtonUp := false;
if not StartPosValid then
begin
FStartX := X;
FStartY := Y;
StartPosValid := true;
end;
end;
end;
procedure TGUIControl.MouseUp(Sender: TObject; Button: TMouseButtons; Shift: TShiftState; X,Y: Integer);
begin
if not MouseL then
begin
ButtonUp := true;
ButtonDown := false;
StartPosValid := false;
FStartX := -1; FStartY := -1;
FDeltaX := 0; FDeltaY := 0;
end;
end;
procedure TGUIControl.Paint;
begin
Canvas.Rectangle(Left,Top,Right,Bottom);
end;
procedure TGUIControl.PaintXY(x, y: Integer);
var R: TRect;
begin
R := Canvas.ClipRect;
if FCanMoveControl //Wenn CanMoveControl -> true dann
then ... //CanResizeControl -> false und umhekehrt
else
if FCanResizeControl then
begin
R.Right := R.Right + x;
R.Bottom := R.Bottom + y;
Canvas.ClipRect := R;
Canvas.Rectangle(R.Left,R.Top,R.Right+x,R.Bottom+y);
end;
end;
Verschieben funktioniert, aber Größe ändern nicht.
Was mache ich falsch?