egal.pas

这个例子让你的程序可以在运行期间对控件进行选取、移动、动态更改所选对象尺寸等可视操作

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(nil);
    panels[i].Visible:=False;
    panels[i].BevelOuter := bvNone;
    panels[i].Width     := 5;
    panels[i].Height    := 5;
    panels[i].Color     := clBlack;
    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;
  for i := 0 to 7 do
  begin
  panels[i].Parent    := Komponente.Parent;
  panels[i].Visible:=true;
  end;
  LblPos    := TPanel.Create(nil); //gibt beim Verschieben gr??e bzw Position an
  with LblPos do 
  begin
    Visible    := False;
    BevelOuter := bvRaised;
    Color      := $00E8FFFF;
    Height     := 16;
    Width      := 50;
  end;
end;

procedure Markierungen.NewPos();
begin
  panels[0].Left := Komp.Left - 2;
  panels[0].Top  := Komp.Top - 2;
  panels[0].Cursor:= crSizeNWSE;
  panels[1].Left := Komp.Left + Komp.Width div 2;
  panels[1].Top  := Komp.Top - 2;
  panels[1].Cursor:=crSizeNS;
  panels[2].Left := Komp.Left + Komp.Width - 2;
  panels[2].Top  := Komp.Top - 2;
  panels[2].Cursor:=crSizeNESW;
  panels[3].Left := Komp.Left + Komp.Width - 2;
  panels[3].Top  := Komp.Top + Komp.Height - 2;
  panels[3].Cursor:=crSizeNWSE;
  panels[4].Left := Komp.Left + Komp.Width div 2;
  panels[4].Top  := Komp.Top + Komp.Height - 2;
  panels[4].Cursor:=crSizeNS;
  panels[5].Left := Komp.Left - 2;
  panels[5].Top  := Komp.Top + Komp.Height - 2;
  panels[5].Cursor:=crSizeNESW;
  panels[6].Left := Komp.Left - 2;
  panels[6].Top  := Komp.Top + Komp.Height div 2 - 1;
  panels[6].Cursor:=crSizeWE;
  panels[7].Left := Komp.Left + Komp.Width - 2;
  panels[7].Top  := Komp.Top + Komp.Height div 2 - 1;
  panels[7].Cursor:=crSizeWE;
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
  begin
  panels[i].Free;
  panels[i]:=nil; 
  end;
  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.Parent     := Komp.Parent;
  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.