Einzelnen Beitrag anzeigen

Volker Z.

Registriert seit: 3. Dez 2012
Ort: Augsburg, Bayern, Süddeutschland
419 Beiträge
 
Delphi XE4 Ultimate
 
#2

AW: Größe von Objecten ändern

  Alt 12. Aug 2013, 02:21
Hallo,

das folgende bezieht sich nur auf die Größenänderung Deiner Objekte.
Ist nur so 'ne Idee. Klatsche mal ein paar Controls auf ein Form (oder auch in eine ScrollBox; es ist nicht zwingend, dass es sich um die unten angegebenen Controls handelt) und leg noch eine PaintBox dazu.
Dann zeichnet Dir nachfolgender Code einen (5 Pixel dicken) Rahmen um ein selektiertes Control. Du kannst den Rahmen (im Beispiel) rechts oder unten mit der Maus packen und – mit gedrückter Maustaste – die Größe der PaintBox – und damit die Größe des Controls – ändern.
Delphi-Quellcode:
type
  TForm5 = class(TForm)
    ScrollBox1: TScrollBox;
    ListBox1: TListBox;
    Shape1: TShape;
    SpeedButton1: TSpeedButton;
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TshiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private-Deklarationen }
    FControl : TControl;
    FMouse : TPoint;
    FSizing : Boolean;
    procedure ControlMouseDown (Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  public
    { Public-Deklarationen }
  end;

const
  BORDER_WIDTH = 5;

procedure TForm5.FormCreate(Sender: TObject);
begin
  ListBox1.OnMouseDown := ControlMouseDown;
  Edit1.OnMouseDown := ControlMouseDown;
  Label1.OnMouseDown := ControlMouseDown;
  Shape1.OnMouseDown := ControlMouseDown;
  Button1.OnMouseDown := ControlMouseDown;
  SpeedButton1.OnMouseDown := ControlMouseDown;
  Image1.OnMouseDown := ControlMouseDown;

  FControl := nil;
  FSizing := False
end;

procedure TForm5.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSizing := True;
  FMouse.X := X;
  FMouse.Y := Y
end;

procedure TForm5.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  dx, dy : Integer;
  r : TRect;
begin
  if not (FSizing and Assigned (FControl)) then
    Exit;

  dx := X - FMouse.X;
  dy := Y - FMouse.Y;
  r := PaintBox1.BoundsRect;
  Inc (r.Right, dx);
  Inc (r.Bottom, dy);
  PaintBox1.BoundsRect := r;

  Inc (r.Left, BORDER_WIDTH);
  Inc (r.Top, BORDER_WIDTH);
  Dec (dx, BORDER_WIDTH);
  Dec (dy, BORDER_WIDTH);
  Inc (r.Right, dx);
  Inc (r.Bottom, dy);
  FControl.BoundsRect := r;

  FMouse.X := X;
  FMouse.Y := Y
end;

procedure TForm5.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FSizing := False
end;

procedure TForm5.PaintBox1Paint(Sender: TObject);
begin
  if not Assigned (FControl) then
    Exit;

  PaintBox1.Canvas.Brush.Color := clBlack;
  PaintBox1.Canvas.Brush.Style := bsSolid;
  PaintBox1.Canvas.Rectangle (PaintBox1.ClientRect)
end;

procedure TForm5.ControlMouseDown (Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
var
  r : TRect;
begin
  if not (Sender is TControl) then
    begin
      FControl := nil;
      Exit
    end;

  FControl := TControl (Sender);

  r := FControl.BoundsRect;
  Dec (r.Left, BORDER_WIDTH);
  Dec (r.Top, BORDER_WIDTH);
  Inc (r.Right, BORDER_WIDTH);
  Inc (r.Bottom, BORDER_WIDTH);

  PaintBox1.BoundsRect := r;
  PaintBox1.BringToFront;
  FControl.BringToFront;
end;
Wenn dies Deinen Anforderungen entspricht, dann sollte der Rest (links, oben bzw. in den Ecken packen, selektiertes Control und Paintbox nach vorne bringen etc.) nur noch Fleißaufgabe sein

Gruß
Volker Zeller
  Mit Zitat antworten Zitat