Button mit Maus verschieben

[dominikkv]

http://www.swissdelphicenter.ch/de/showcode.php?id=2307

Delphi-Quellcode:

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 Dieser Tip enthält eine Klasse mit der man zur Laufzeit Komponenten
 in der Größe verändern bzw verschieben kann so wie man es aus der
 Entwicklungsumgebung her gewohnt ist.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 This Tip provides a tool class that implements the functionality of
 moving or resizing any component at runtime (as in the IDE)
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

//Als eigne Unit
unit Egal;

interface

uses Controls, ExtCtrls, QGraphics, Classes, SysUtils, StdCtrls;

type
  Markierungen = class
    constructor Create(Komponente: TControl);
    destructor Destroy();
  private
    panels: array[0..7] of TPanel;
    LblPos: TPanel;
    Komp: TControl;
    FDownX, FDownY: Integer;
    FDragging: Boolean;
    OrgMDown, OrgMUp: TMouseEvent;
    OrgMMove: TMouseMoveEvent;
    OrgMClick: TNotifyEvent;
    procedure panelsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure panelsMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure panelsMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NewPos();
  end;

implementation

type
  TMoveCracker = class(TControl);

constructor Markierungen.Create(Komponente: TControl);
var 
  i: Byte;
begin
  Komp := Komponente;
  for i := 0 to 7 do 
  begin //Die acht Markierungspunkte erstellen.
    panels[i]           := TPanel.Create(Komponente);
    panels[i].Parent    := Komponente.Parent;
    panels[i].Width     := 5;
    panels[i].Height    := 5;
    panels[i].Color     := clBlack;
    panels[i].BevelOuter := bvNone;
    panels[i].OnMouseDown := panelsMouseDown;
    panels[i].OnMouseMove := panelsMouseMove;
    panels[i].OnMouseUp := panelsMouseUp;
    panels[i].Tag       := i;
  end;
  NewPos(); //Die Markierungen an die richtige Position bringen
  OrgMDown  := TPanel(Komp).OnMouseDown; //Sicheren der orginalen Mousereignisse
  OrgMUp    := TPanel(Komp).OnMouseUp;
  OrgMMove  := TPanel(Komp).OnMouseMove;
  OrgMClick := TPanel(Komp).OnClick;
  TPanel(Komp).OnClick := nil;    //für funktionen benötige Ereignisse zuweisen
  TPanel(Komp).OnMouseDown := panelsMouseDown;
  TPanel(Komp).OnMouseUp := panelsMouseUp;
  TPanel(Komp).OnMouseMove := panelsMouseMove;
  LblPos    := TPanel.Create(Komp); //gibt beim Verschieben größe bzw Position an
  with LblPos do 
  begin
    Parent     := Komp.Parent;
    Visible    := False;
    BevelOuter := bvNone;
    Color      := clYellow;
    Height     := 16;
    Width      := 50;
  end;
end;

procedure Markierungen.NewPos();
begin
  panels[0].Left := Komp.Left - 2;
  panels[0].Top  := Komp.Top - 2;
  panels[1].Left := Komp.Left + Komp.Width div 2;
  panels[1].Top  := Komp.Top - 2;
  panels[2].Left := Komp.Left + Komp.Width - 2;
  panels[2].Top  := Komp.Top - 2;
  panels[3].Left := Komp.Left + Komp.Width - 2;
  panels[3].Top  := Komp.Top + Komp.Height - 2;
  panels[4].Left := Komp.Left + Komp.Width div 2;
  panels[4].Top  := Komp.Top + Komp.Height - 2;
  panels[5].Left := Komp.Left - 2;
  panels[5].Top  := Komp.Top + Komp.Height - 2;
  panels[6].Left := Komp.Left - 2;
  panels[6].Top  := Komp.Top + Komp.Height div 2 - 1;
  panels[7].Left := Komp.Left + Komp.Width - 2;
  panels[7].Top  := Komp.Top + Komp.Height div 2 - 1;
end;

destructor Markierungen.Destroy();
var 
  i: Byte;
begin
  TPanel(Komp).OnMouseDown := OrgMDown; //Rückgabe der Orginalen Eregnissprozeduren
  TPanel(Komp).OnMouseUp   := OrgMUp;
  TPanel(Komp).OnMouseMove := OrgMMove;
  TPanel(Komp).OnClick     := OrgMClick;
  for i := 0 to 7 do panels[i].Free;
  LblPos.Free;
end;

procedure Markierungen.panelsMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer); //Funktion aus Swissdelphicenter entnommen
begin                     //Tip: "Komponenten während der Laufzeit verschieben?"
  FDownX         := X;
  FDownY         := Y;
  FDragging      := True;
  TMoveCracker(Sender).MouseCapture := True;
  LblPos.Visible := True;
end;

procedure Markierungen.panelsMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragging then
    with Sender as TControl do 
    begin
      if Sender = Komp then 
      begin
        Left := X - FDownX + Left; //Es wurde direkt auf die Komponente geklickt
        Top  := Y - FDownY + Top;
        LblPos.Caption := '[' + IntToStr(Left) + ',' + IntToStr(Top) + ']';
      end 
      else 
      begin
        case TPanel(Sender).Tag of
          0: 
            begin //oben links
              Komp.Top    := Y - FDownY + TPanel(Sender).Top + 2;
              Komp.Height := Komp.Height - (Y - FDownY);
              Komp.Left   := X - FDownX + TPanel(Sender).Left + 2;
              Komp.Width  := Komp.Width - (X - FDownX);
            end;
          1: 
            begin //oben mitte
              Komp.Top    := Y - FDownY + TPanel(Sender).Top + 2;
              Komp.Height := Komp.Height - (Y - FDownY);
            end;
          2: 
            begin //oben rechts
              Komp.Width  := X - FDownX + Komp.Width - 2;
              Komp.Top    := Y - FDownY + TPanel(Sender).Top + 2;
              Komp.Height := Komp.Height - (Y - FDownY);
            end;
          3: 
            begin //unten rechts
              Komp.Width  := X - FDownX + Komp.Width - 2;
              Komp.Height := Y - FDownY + Komp.Height - 2;
            end;
          4: Komp.Height := Y - FDownY + Komp.Height - 2; //unten mitte
          5: 
            begin //unten links
              Komp.Left   := X - FDownX + TPanel(Sender).Left + 2;
              Komp.Width  := Komp.Width - (X - FDownX);
              Komp.Height := Y - FDownY + Komp.Height - 2;
            end;
          6: 
            begin //nach links
              Komp.Left  := X - FDownX + TPanel(Sender).Left + 2;
              Komp.Width := Komp.Width - (X - FDownX);
            end;
          7: Komp.Width := X - FDownX + Komp.Width - 2; //nach rechts
        end;
        LblPos.Caption := '[' + IntToStr(Komp.Width) + ',' + IntToStr(Komp.Height) + ']';
      end;
      newPos(); //zum Nachführen der Markierungspanel
      LblPos.Left := TControl(Sender).Left + X;
      LblPos.Top  := TControl(Sender).Top + Y + 20;
      LblPos.BringToFront;
      LblPos.Refresh;
    end;
end;

procedure Markierungen.panelsMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer); //Funktion aus Swissdelphicenter entnommen
begin                     //Tip: "Komponenten während der Laufzeit verschieben?"
  if FDragging then
  begin
    FDragging      := False;
    TMoveCracker(Sender).MouseCapture := False;
    LblPos.Visible := False;
  end;
end;

end.

//In eigenes Programm muss nur noch:

uses Egal;

var 
  Veraendern: Markierungen;

  //In diesem Beispiel über ein Onclickereigniss welches jedes auf dem Form befindliche
  //Komponente und das Form selbst bekommt. (Auf Komponente Klicken löst Möglichkeit
  //zum größe ändern und verschieben aus und ein Klick wo anders beendet sie wieder.

procedure TForm1.FormClick(Sender: TObject);
  begin  if Assigned(Veraendern) then 
begin
  Veraendern.Destroy;
  Veraendern := nil;
end 
else 
Veraendern := Markierungen.Create(TControl(Sender));

end;

//Will man eine PaintBox benutzen muss man diese noch sichtbar machen.
//Z.B. so:

procedure TForm1.FormShow(Sender: TObject);
  begin  PaintBox1Paint(Sender);
  end;

  procedure TForm1.PaintBox1Paint(Sender: TObject);
    begin  with PaintBox1 do 
  begin
    Canvas.Pen.Style := psDash;
    Canvas.Rectangle(0, 0, Width, Height);
  end;
  end;