Einzelnen Beitrag anzeigen

dominikkv

Registriert seit: 30. Sep 2006
Ort: Gundelfingen
1.109 Beiträge
 
Delphi 2007 Professional
 
#5

Re: Button mit Maus verschieben

  Alt 23. Dez 2006, 18:58
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;
Dominik
  Mit Zitat antworten Zitat